* interp/lexing.boot (getNumberToken): New.

	(getArgumentDesignator): Likewise.
	(getToken): Use it.
	* interp/parsing.lisp (GET-NUMBER-TOKEN): Remove.
	* interp/bootlex.lisp (INIT-BOOT/SPAD-READER): Move to spad.lisp.
	(SPAD): Likewise.
	(READ-SPAD1): Likewise.
	(TEST): Remove.
	(GET-ARGUMENT-DESIGNATOR-TOKEN): Likewise.

4 files changed, 102 insertions, 117 deletions

diff --git a/src/interp/bootlex.lisp b/src/interp/bootlex.lisp
index 93d6b997..0f8768b7 100644
--- a/src/interp/bootlex.lisp
+++ b/src/interp/bootlex.lisp
@@ -1,6 +1,6 @@
 ;; Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
 ;; All rights reserved.
-;; Copyright (C) 2007-2011, Gabriel Dos Reis.
+;; Copyright (C) 2007-2012, Gabriel Dos Reis.
 ;; All rights reserved.
 ;;
 ;; Redistribution and use in source and binary forms, with or without
@@ -49,25 +49,8 @@
 (IMPORT-MODULE "nlib")
 (in-package "BOOT")
 
-; *** 0. Global parameters
-
 ; *** 1. BOOT file handling
 
-(defun init-boot/spad-reader ()
-  (setq $SPAD_ERRORS (VECTOR 0 0 0))
-  (setq SPADERRORSTREAM |$OutputStream|)
-  (setq File-Closed nil)
-  (Next-Lines-Clear)
-  (setq |$lineStack| nil)
-  (ioclear))
-
-(defmacro test (x &rest y)
-  `(progn
-     (setq spaderrorstream t)
-     (in-boot)
-     (initialize-preparse |$InputStream|)
-     (,(intern (strconc "PARSE-" x)) . ,y)))
-
 (defun print-defun (name body)
    (let* ((sp (assoc 'compiler-output-stream optionlist))
           (st (if sp (cdr sp) |$OutputStream|)))
@@ -77,90 +60,9 @@
      (when (or |$PrettyPrint| (not (is-console st)))
            (print-full body st) (force-output st))))
 
-(defun spad (&optional
-              (*spad-input-file* nil)
-              (*spad-output-file* nil)
-             &aux
-         ;;  (*comp370-apply* (function print-and-eval-defun))
-           (*comp370-apply* (function print-defun))
-           (*fileactq-apply* (function print-defun))
-           ($SPAD T)
-           (OPTIONLIST nil)
-           (*EOF* NIL)
-           (File-Closed NIL)
-           (/editfile *spad-input-file*)
-           in-stream out-stream)
-  (declare (special |$Echo| /editfile *comp370-apply* *EOF*
-                    File-Closed Xcape))
-  (setq |$InteractiveMode| nil)
-  ;; only rebind |$InteractiveFrame| if compiling
-  (progv (if (not |$InteractiveMode|) '(|$InteractiveFrame|))
-         (if (not |$InteractiveMode|)
-             (list (|addBinding|
-                    '|$DomainsInScope|
-                    `((FLUID . |true|)
-                      (|special| . ,(COPY-TREE |$InitialDomainsInScope|)))
-                    (|addBinding| '|$Information| NIL (|makeInitialModemapFrame|)))))
-  (init-boot/spad-reader)
-  (unwind-protect
-    (progn
-      (setq in-stream (if *spad-input-file*
-                         (open *spad-input-file* :direction :input)
-			|$InputStream|))
-      (initialize-preparse in-stream)
-      (setq out-stream (if *spad-output-file*
-                           (open *spad-output-file* :direction :output)
-                         |$OutputStream|))
-      (when *spad-output-file*
-         (format out-stream "~&;;; -*- Mode:Lisp; Package:Boot  -*-~%~%")
-         (print-package "BOOT"))
-      (setq |$OutputStream| out-stream)
-      (loop
-       (if (or *eof* file-closed) (return nil))
-       (catch 'SPAD_READER
-         (if (setq |$lineStack| (PREPARSE in-stream))
-             (let ((LINE (cdar |$lineStack|)))
-               (declare (special LINE))
-               (|parseNewExpr|)
-               (let ((parseout (|popStack1|)) )
-                 (when parseout
-                       (let ((|$OutputStream| out-stream))
-                         (S-PROCESS parseout))
-                       (format out-stream "~&")))
-               ;(IOClear in-stream out-stream)
-               )))
-      (IOClear in-stream out-stream)))
-    (if *spad-input-file* (shut in-stream))
-    (if *spad-output-file* (shut out-stream)))
-  T))
-
-(defun READ-SPAD1 (FN FT FM TO)
-    (LET ((STRM IN-STREAM))
-      (SETQ $MAXLINENUMBER 0)
-      (SETQ $SPAD_ERRORS (VECTOR 0 0 0))
-      (SETQ IN-STREAM (open (strconc fm ">" fn "." ft) :direction :input))
-      ($ERASE (LIST FN 'ERROR 'A))
-      (SETQ OUT-STREAM (if TO (open to :direction :output) OUT-STREAM))
-      (SETQ SPADERRORSTREAM (open (strconc "a>" fn ".error") :direction :output))
-      (READ-SPAD-1)
-      (close SPADERRORSTREAM)
-      (SETQ IN-STREAM STRM)
-      (OR (EQUAL #(0 0 0) $SPAD_ERRORS)
-          (|sayBrightly| (LIST '|%b| (ELT $SPAD_ERRORS 0) '|%d| '|syntax errors|
-            '|%l| '|%b| (ELT $SPAD_ERRORS 1) '|%d| '|precompilation errors|
-            '|%l| '|%b| (ELT $SPAD_ERRORS 2) '|%d| '|semantic errors| '|%l|)))
-      (+ (ELT $SPAD_ERRORS 0) (ELT $SPAD_ERRORS 1) (ELT $SPAD_ERRORS 2))))
-
 
 ;  *** 3. BOOT Token Handling ***
 
-(defun get-argument-designator-token (token)
-  (|advanceChar!|)
-  (get-number-token token)
-  (|tokenInstall| (intern (strconc "#" (format nil "~D" (|tokenSymbol| token))))
-                 'argument-designator token |$nonblank|))
-
-
 ;; -*- Parse an integer number -*-
 ;; The number may be written in plain format, where the radix
 ;; is implicitly taken to be 10.  Or the spelling can explicitly
diff --git a/src/interp/lexing.boot b/src/interp/lexing.boot
index 8b0e1b7e..e63a13cb 100644
--- a/src/interp/lexing.boot
+++ b/src/interp/lexing.boot
@@ -1,4 +1,4 @@
--- Copyright (C) 2011, Gabriel Dos Reis.
+-- Copyright (C) 2011-2012, Gabriel Dos Reis.
 -- All rights reserved.
 --
 -- Redistribution and use in source and binary forms, with or without
@@ -188,6 +188,22 @@ tokenInstall(sym,typ,tok,nonblank == true) ==
   tokenNonblank?(tok) := nonblank
   tok
 
+getNumberToken tok ==
+  buf := nil
+  repeat
+    buf := [currentChar(),:buf]
+    digit? nextChar() => advanceChar!()
+    leave nil
+  advanceChar!()
+  sz := #buf  -- keep track of digit count
+  tokenInstall(readIntegerIfCan listToString reverse! buf,'NUMBER,tok,sz)
+
+getArgumentDesignator tok ==
+  advanceChar!()
+  getNumberToken tok
+  tokenInstall(makeSymbol strconc('"#",formatToString('"~D",tokenSymbol tok)),
+     'ARGUMENT_-DESIGNATOR,tok,$nonblank)
+
 getToken tok ==
   not skipBlankChars() => nil
   tt := tokenLookaheadType currentChar()
@@ -195,7 +211,7 @@ getToken tok ==
   tt is 'ESCAPE =>
     advanceChar!()
     getIdentifier(tok,true)
-  tt is 'ARGUMENT_-DESIGNATOR => GET_-ARGUMENT_-DESIGNATOR_-TOKEN tok
+  tt is 'ARGUMENT_-DESIGNATOR => getArgumentDesignator tok
   tt is 'ID => getIdentifier(tok,false)
   tt is 'NUM => GET_-SPAD_-INTEGER_-TOKEN tok
   tt is 'STRING => getSpadString tok
diff --git a/src/interp/parsing.lisp b/src/interp/parsing.lisp
index 509c6a14..a8bf8ea3 100644
--- a/src/interp/parsing.lisp
+++ b/src/interp/parsing.lisp
@@ -1,6 +1,6 @@
 ;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
 ;; All rights reserved.
-;; Copyright (C) 2007-2011, Gabriel Dos Reis.
+;; Copyright (C) 2007-2012, Gabriel Dos Reis.
 ;; All rights reserved.
 ;;
 ;; Redistribution and use in source and binary forms, with or without
@@ -189,21 +189,6 @@ Symbolics read-line returns embedded newlines in a c-m-Y.")
 (defun make-adjustable-string (n)
   (make-array (list n) :element-type 'character :adjustable t))
  
-(defun get-number-token (token)
-  "Take a number off the input stream."
-  (prog ((buf (make-adjustable-string 0)))
-	nu1 
-	(suffix (|currentChar|) buf)                     ; Integer part
-        (let ((next-chr (|nextChar|)))
-          (cond ((digitp next-chr)
-                 (|advanceChar!|)
-                 (go nu1))))
-        (|advanceChar!|) 
-	(return (|tokenInstall| (read-from-string buf)
-			       'number token
-			       (size buf) ;used to keep track of digit count
-			       ))))
- 
 ; *** 5. META Error Handling
 
 (defparameter $num_of_meta_errors 0)
diff --git a/src/interp/spad.lisp b/src/interp/spad.lisp
index 1fcca89d..5311f73f 100644
--- a/src/interp/spad.lisp
+++ b/src/interp/spad.lisp
@@ -75,6 +75,88 @@
 (defvar |InteractiveMode|)
 (defvar |uc| 'UC)
 
+(defun init-boot/spad-reader ()
+  (setq $SPAD_ERRORS (VECTOR 0 0 0))
+  (setq SPADERRORSTREAM |$OutputStream|)
+  (setq File-Closed nil)
+  (Next-Lines-Clear)
+  (setq |$lineStack| nil)
+  (ioclear))
+
+(defun spad (&optional
+              (*spad-input-file* nil)
+              (*spad-output-file* nil)
+             &aux
+         ;;  (*comp370-apply* (function print-and-eval-defun))
+           (*comp370-apply* (function print-defun))
+           (*fileactq-apply* (function print-defun))
+           ($SPAD T)
+           (OPTIONLIST nil)
+           (*EOF* NIL)
+           (File-Closed NIL)
+           (/editfile *spad-input-file*)
+           in-stream out-stream)
+  (declare (special |$Echo| /editfile *comp370-apply* *EOF*
+                    File-Closed Xcape))
+  (setq |$InteractiveMode| nil)
+  ;; only rebind |$InteractiveFrame| if compiling
+  (progv (if (not |$InteractiveMode|) '(|$InteractiveFrame|))
+         (if (not |$InteractiveMode|)
+             (list (|addBinding|
+                    '|$DomainsInScope|
+                    `((FLUID . |true|)
+                      (|special| . ,(COPY-TREE |$InitialDomainsInScope|)))
+                    (|addBinding| '|$Information| NIL (|makeInitialModemapFrame|)))))
+  (init-boot/spad-reader)
+  (unwind-protect
+    (progn
+      (setq in-stream (if *spad-input-file*
+                         (open *spad-input-file* :direction :input)
+			|$InputStream|))
+      (initialize-preparse in-stream)
+      (setq out-stream (if *spad-output-file*
+                           (open *spad-output-file* :direction :output)
+                         |$OutputStream|))
+      (when *spad-output-file*
+         (format out-stream "~&;;; -*- Mode:Lisp; Package:Boot  -*-~%~%")
+         (print-package "BOOT"))
+      (setq |$OutputStream| out-stream)
+      (loop
+       (if (or *eof* file-closed) (return nil))
+       (catch 'SPAD_READER
+         (if (setq |$lineStack| (PREPARSE in-stream))
+             (let ((LINE (cdar |$lineStack|)))
+               (declare (special LINE))
+               (|parseNewExpr|)
+               (let ((parseout (|popStack1|)) )
+                 (when parseout
+                       (let ((|$OutputStream| out-stream))
+                         (S-PROCESS parseout))
+                       (format out-stream "~&")))
+               ;(IOClear in-stream out-stream)
+               )))
+      (IOClear in-stream out-stream)))
+    (if *spad-input-file* (shut in-stream))
+    (if *spad-output-file* (shut out-stream)))
+  T))
+
+(defun READ-SPAD1 (FN FT FM TO)
+    (LET ((STRM IN-STREAM))
+      (SETQ $MAXLINENUMBER 0)
+      (SETQ $SPAD_ERRORS (VECTOR 0 0 0))
+      (SETQ IN-STREAM (open (strconc fm ">" fn "." ft) :direction :input))
+      ($ERASE (LIST FN 'ERROR 'A))
+      (SETQ OUT-STREAM (if TO (open to :direction :output) OUT-STREAM))
+      (SETQ SPADERRORSTREAM (open (strconc "a>" fn ".error") :direction :output))
+      (READ-SPAD-1)
+      (close SPADERRORSTREAM)
+      (SETQ IN-STREAM STRM)
+      (OR (EQUAL #(0 0 0) $SPAD_ERRORS)
+          (|sayBrightly| (LIST '|%b| (ELT $SPAD_ERRORS 0) '|%d| '|syntax errors|
+            '|%l| '|%b| (ELT $SPAD_ERRORS 1) '|%d| '|precompilation errors|
+            '|%l| '|%b| (ELT $SPAD_ERRORS 2) '|%d| '|semantic errors| '|%l|)))
+      (+ (ELT $SPAD_ERRORS 0) (ELT $SPAD_ERRORS 1) (ELT $SPAD_ERRORS 2))))
+
 (DEFUN INTEGER-BIT (N I) (LOGBITP I N))
 
 (DEFUN /TRANSPAD (X)