diff --git a/src/ikarus.boot b/src/ikarus.boot index bfe3a4c..d3b34da 100644 Binary files a/src/ikarus.boot and b/src/ikarus.boot differ diff --git a/src/libcompile.ss b/src/libcompile.ss index 84b1cb1..a37f05f 100644 --- a/src/libcompile.ss +++ b/src/libcompile.ss @@ -161,6 +161,7 @@ [$exit 1 effect] [$fp-at-base 0 pred] [$current-frame 0 value] + [$arg-list 0 value] [$seal-frame-and-call 1 tail] [$frame->continuation 1 value] ;;; @@ -2106,6 +2107,7 @@ [(next-continuation) (mem 20 pcr)] [(system-stack) (mem 24 pcr)] [(dirty-vector) (mem 28 pcr)] + [(arg-list) (mem 32 pcr)] [else (error 'pcb-ref "invalid arg ~s" x)]))) (define (primref-loc op) @@ -2824,8 +2826,9 @@ (movb bh (mem idx apr)) (f (cdr arg*) (fxadd1 idx)))])]))] [($current-frame) - (list* (movl (pcb-ref 'next-continuation) eax) - ac)] + (list* (movl (pcb-ref 'next-continuation) eax) ac)] + [($arg-list) + (list* (movl (pcb-ref 'arg-list) eax) ac)] [($seal-frame-and-call) (list* (movl (Simple (car arg*)) cpr) ; proc (movl (pcb-ref 'frame-base) eax) diff --git a/src/libcore.ss b/src/libcore.ss index 914ae11..3e7c0e0 100644 --- a/src/libcore.ss +++ b/src/libcore.ss @@ -1694,3 +1694,10 @@ [else (cons fst (f ($car rest) ($cdr rest)))])))) +(primitive-set! 'command-line-arguments + (make-parameter ($arg-list) + (lambda (x) + (if (and (list? x) (andmap string? x)) + x + (error 'command-list "invalid command-line-arguments ~s\n" x))))) + diff --git a/src/makefile.ss b/src/makefile.ss index a08a9d7..521a19a 100644 --- a/src/makefile.ss +++ b/src/makefile.ss @@ -86,7 +86,7 @@ hash-table? make-hash-table get-hash-table put-hash-table! assembler-output $make-environment - features + features command-line-arguments port? input-port? output-port? make-input-port make-output-port make-input/output-port @@ -98,7 +98,7 @@ port-name input-port-name output-port-name write-char read-char unread-char peek-char newline - reset-input-port! flush-output-port + reset-input-port! flush-output-port close-input-port close-output-port console-input-port current-input-port standard-output-port standard-error-port @@ -138,7 +138,7 @@ $code->closure list*->code* make-code code? set-code-reloc-vector! code-reloc-vector code-freevars code-size code-ref code-set! - $frame->continuation $fp-at-base $current-frame $seal-frame-and-call + $frame->continuation $fp-at-base $current-frame $arg-list $seal-frame-and-call $make-call-with-values-procedure $make-values-procedure do-overflow collect $make-tcbucket $tcbucket-next $tcbucket-key $tcbucket-val