* Added a $arg-list system primitive that accesses the pcb->arg_list

field.
* Added a command-line-arguments parameter to the core.
This commit is contained in:
Abdulaziz Ghuloum 2006-12-01 10:02:05 -05:00
parent 4b060b685f
commit 0ff5b0cf75
4 changed files with 15 additions and 5 deletions

Binary file not shown.

View File

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

View File

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

View File

@ -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