* Load now skips the first line of a file if that line starts with

a shebang "#!".

lib/libtokenizer.ss

@@ -260,7 +260,9 @@
                   (list->string (reverse (cons c chars))))]))))
   (define tokenize-hash
     (lambda (p)
-      (let ([c (read-char p)])
+      (tokenize-hash/c (read-char p) p)))
+  (define tokenize-hash/c
+    (lambda (c p)
       (cond
         [(eof-object? c) (error 'tokenize "invalid # near end of file")]
         [($char= c #\t) 
@@ -330,7 +332,7 @@
          (tokenize-hashnum p (char->num c))]
         [else 
          (unread-char c p)
-           (error 'tokenize "invalid syntax #~a" c)]))))
+         (error 'tokenize "invalid syntax #~a" c)])))
   (define (tokenize-hashnum p n)
     (let ([c (read-char p)])
       (cond
@@ -357,9 +359,8 @@
                [else (tokenize-bar p (cons c ac))]))]
           [($char= #\| c) ac]
           [else (tokenize-bar p (cons c ac))]))))
-  (define tokenize
+  (define tokenize/c
-    (lambda (p)
+    (lambda (c p)
-      (let ([c (read-char p)])
       (cond
         [(eof-object? c) (eof-object)]
         [(char-whitespace? c) (tokenize p)]
@@ -400,7 +401,29 @@
            (cons 'datum (string->symbol (list->string ls))))]
         [else
          (unread-char c p) 
-           (error 'tokenize "invalid syntax ~a" c)]))))
+         (error 'tokenize "invalid syntax ~a" c)])))
+
+  (define tokenize
+    (lambda (p)
+      (tokenize/c (read-char p) p)))
+
+  (define tokenize-initial
+    (lambda (p)
+      (let ([c (read-char p)])
+        (cond
+          [(eof-object? c) c]
+          [($char= #\# c) 
+           (let ([c (read-char p)])
+             (cond
+               [(eof-object? c)
+                (error 'tokenize "invalid eof after #")]
+               [($char= #\! c)
+                (skip-comment p)
+                (tokenize p)]
+               [else
+                (tokenize-hash/c c p)]))]
+          [else (tokenize/c c p)]))))
+
 
   ;;;
   ;;;--------------------------------------------------------------* READ *---
@@ -554,10 +577,15 @@
            [else (error 'read "invalid token! ~s" t)])]
         [else
          (error 'read "unexpected ~s found" t)])))
+
   (define read-expr
     (lambda (p locs k)
       (parse-token p locs k (read-token p))))
   
+  (define read-expr-initial
+    (lambda (p locs k)
+      (parse-token p locs k (tokenize-initial p))))
+
   (define reduce-loc!
     (lambda (x)
        (let ([loc (cdr x)])
@@ -592,7 +620,17 @@
                (loc-value expr)
                expr)]))))
 
-
+  (define read-initial
+    (lambda (p)
+      (let-values ([(expr locs k) (read-expr-initial p '() void)])
+        (cond
+          [(null? locs) expr]
+          [else
+           (for-each reduce-loc! locs)
+           (k)
+           (if (loc? expr)
+               (loc-value expr)
+               expr)]))))
 
 
   ;;;      
@@ -619,12 +657,16 @@
           (unless (eof-object? x)
             (eval x)
             (read-and-eval p)))))
+
     (primitive-set! 'load
       (lambda (x)
         (unless (string? x)
           (error 'load "~s is not a string" x))
         (let ([p (open-input-file x)])
-          (read-and-eval p)
+          (let ([x (read-initial p)])
+            (unless (eof-object? x)
+              (eval x)
+              (read-and-eval p)))
           (close-input-port p)))))
   )
 

lib/makefile.ss

@@ -116,60 +116,53 @@
     ))
 
 (define system-primitives
-  '(immediate? $unbound-object? $forward-ptr?
+  '(
-    pointer-value 
+
-    primitive-ref primitive-set!
+    immediate? $unbound-object? $forward-ptr?  pointer-value
-    $fx= $fx< $fx<= $fx> $fx>= $fxzero?
+    primitive-ref primitive-set!  $fx= $fx< $fx<= $fx> $fx>=
-    $fx+ $fx- $fx* $fxadd1 $fxsub1 $fxquotient $fxremainder $fxmodulo 
+    $fxzero?  $fx+ $fx- $fx* $fxadd1 $fxsub1 $fxquotient
-    $fxsll $fxsra $fxlognot $fxlogor $fxlogand $fxlogxor
+    $fxremainder $fxmodulo $fxsll $fxsra $fxlognot $fxlogor
-    $fixnum->char $char->fixnum
+    $fxlogand $fxlogxor $fixnum->char $char->fixnum $char= $char<
-    $char= $char< $char<= $char> $char>=
+    $char<= $char> $char>= $car $cdr $set-car! $set-cdr!
-    $car $cdr $set-car! $set-cdr!
     $make-vector $vector-ref $vector-set! $vector-length
     $make-string $string-ref $string-set! $string-length $string
     $symbol-string $symbol-unique-string $symbol-value
-    $set-symbol-string! $set-symbol-unique-string! $set-symbol-value!
+    $set-symbol-string! $set-symbol-unique-string!
-    $make-symbol $set-symbol-plist!  $symbol-plist
+    $set-symbol-value!  $make-symbol $set-symbol-plist!
-    $sc-put-cte 
+    $symbol-plist $sc-put-cte $record? $record/rtd? $record-set!
-    $record? $record/rtd? $record-set! $record-ref $record-rtd
+    $record-ref $record-rtd $make-record $record $base-rtd $code?
-    $make-record $record
+    $code-reloc-vector $code-freevars $code-size $code-ref
-    $base-rtd
+    $code-set!  $code->closure list*->code* make-code code?
-    $code? $code-reloc-vector $code-freevars $code-size $code-ref $code-set!
+    set-code-reloc-vector! code-reloc-vector code-freevars code-size
-    $code->closure list*->code* 
+    code-ref code-set!  $frame->continuation $fp-at-base
-    make-code code? set-code-reloc-vector! code-reloc-vector code-freevars
+    $current-frame $arg-list $seal-frame-and-call
-    code-size code-ref code-set!
-    $frame->continuation $fp-at-base $current-frame $arg-list $seal-frame-and-call
     $make-call-with-values-procedure $make-values-procedure
-    do-overflow collect
+    do-overflow collect $make-tcbucket $tcbucket-next $tcbucket-key
-    $make-tcbucket $tcbucket-next $tcbucket-key $tcbucket-val
+    $tcbucket-val $set-tcbucket-next! $set-tcbucket-val!
-    $set-tcbucket-next! $set-tcbucket-val! $set-tcbucket-tconc!
+    $set-tcbucket-tconc!  $tcbucket-dlink-prev $tcbucket-dlink-next
-    $tcbucket-dlink-prev
+    $set-tcbucket-dlink-prev!  $set-tcbucket-dlink-next!  call/cf
-    $tcbucket-dlink-next
+    trace-symbol! untrace-symbol! make-traced-procedure
-    $set-tcbucket-dlink-prev!
+    fixnum->string vector-memq vector-memv
-    $set-tcbucket-dlink-next!
-    call/cf trace-symbol! untrace-symbol! make-traced-procedure
-    fixnum->string 
-    vector-memq vector-memv
 
-    ;;; must open-code
+    ;;; TODO: must open-code
-    $make-port/input
+
-    $make-port/output
+    $make-port/input $make-port/output $make-port/both
-    $make-port/both
     $make-input-port $make-output-port $make-input/output-port
-    $port-handler
+    $port-handler $port-input-buffer $port-input-index
-    $port-input-buffer $port-input-index $port-input-size 
+    $port-input-size $port-output-buffer $port-output-index
-    $port-output-buffer $port-output-index $port-output-size 
+    $port-output-size $set-port-input-index! $set-port-input-size!
-    $set-port-input-index! $set-port-input-size!
     $set-port-output-index! $set-port-output-size!
 
     ;;; better open-code
+
     $write-char $read-char $peek-char $unread-char
 
     ;;; never open-code 
-    $reset-input-port! $close-input-port
+
-    $close-output-port $flush-output-port
+    $reset-input-port! $close-input-port $close-output-port
-    *standard-output-port* *standard-error-port* *current-output-port*
+    $flush-output-port *standard-output-port* *standard-error-port*
-    *standard-input-port* *current-input-port*
+    *current-output-port* *standard-input-port* *current-input-port*
+    
     ))
  
 
@@ -214,6 +207,7 @@
 
 
 (when (eq? "" "")
+  (error #f "SEVERELY OUT OF DATE!\n")
   (load "chez-compat.ss")
   (set! primitive-ref top-level-value)
   (set! primitive-set! set-top-level-value!)
@@ -300,3 +294,4 @@
 (system
   (format "cat ~a > ikarus.boot"
           (join " " (map caddr scheme-library-files))))
+

lib/psyntax-7.1.ss

@@ -4101,6 +4101,7 @@
       (else (match* (unannotate e) p empty-wrap '())))))
 ))
 
+;;; global macros
 
 (define-syntax with-syntax
    (lambda (x)