skint/pre/k.sf

;------------------------------------------------------------------------------
;
;  SKINT Startup code (minimal) 
;
;------------------------------------------------------------------------------

(load "n-service.sf") ; needed for constants (pairs, strings, symbols)


;---------------------------------------------------------------------------------------------
; Runtime globals
;---------------------------------------------------------------------------------------------

(%localdef "#include \"i.h\"")

(define *globals* (make-vector 991 '())) ; nice prime number

(define *dynamic-state* (list #f)) ; for dynamic-wind

(define *current-input* #f)
(define *current-output* #f)
(define *current-error* #f)


;---------------------------------------------------------------------------------------------
; Code deserializer and Evaluator (use built-ins)
;---------------------------------------------------------------------------------------------

(define execute-thunk-closure
  (%prim "{ /* define execute-thunk-closure */
    static obj c[] = { obj_from_objptr(vmcases+0) }; 
    $return objptr(c); }"))

(define make-closure
  (%prim "{ /* define make-closure */
    static obj c[] = { obj_from_objptr(vmcases+1) };
    $return objptr(c); }"))

(define decode-sexp
  (%prim "{ /* define decode-sexp */
    static obj c[] = { obj_from_objptr(vmcases+2) };
    $return objptr(c); }"))

(define decode
  (%prim "{ /* define decode */
    static obj c[] = { obj_from_objptr(vmcases+3) };
    $return objptr(c); }"))


;---------------------------------------------------------------------------------------------
; Initial environment
;---------------------------------------------------------------------------------------------

; initial transformers
(define *transformers* '())

; adapter code for continuation closures produced by letcc 
(define continuation-adapter-code #f) ; inited via (decode "k!...") in i.c

; adapter closure for values/call-with-values pair
(define callmv-adapter-closure (make-closure (decode "K5")))

(define install-global-lambdas
  (%prim "{ /* define install-global-lambdas */
    static obj c[] = { obj_from_objptr(vmcases+6) };
    $return objptr(c); }"))

(install-global-lambdas)

(define initialize-modules
  (%prim "{ /* define initialize-modules */
    static obj c[] = { obj_from_objptr(vmcases+7) };
    $return objptr(c); }"))

(initialize-modules)


;---------------------------------------------------------------------------------------------
; Main
;---------------------------------------------------------------------------------------------

(define (tcode-repl) 
  (execute-thunk-closure (make-closure (decode "${@(y4:repl)[00}"))))

(define (main argv)
  ; if we fell out of tcode repl on error, go back
  (unless (eq? (tcode-repl) #t) (main #f)))