skint/src/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*
  '((syntax-quote . syntax-quote) 
    (quote . quote)
    (set! . set!)
    (set& . set&)
    (if . if)
    (lambda . lambda)
    (lambda* . lambda*)
    (letcc . letcc)
    (withcc . withcc)
    (body . body)
    (begin . begin)
    (define . define)
    (define-syntax . define-syntax)
    (syntax-lambda . syntax-lambda)
    (syntax-rules . syntax-rules)
    (syntax-length . syntax-length)
    (syntax-error . syntax-error)
    (define-library . define-library)
    (program . program)
    (import . import)
    (export . export)
    (... . ...)
    (_ . _)))

; 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)))