diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/ChangeLog | 24 | ||||
| -rw-r--r-- | src/interp/cparse.boot | 27 | ||||
| -rw-r--r-- | src/interp/i-analy.boot | 2 | ||||
| -rw-r--r-- | src/interp/i-funsel.boot | 2 | ||||
| -rw-r--r-- | src/interp/i-intern.boot | 2 | ||||
| -rw-r--r-- | src/interp/patches.lisp | 91 | ||||
| -rw-r--r-- | src/interp/spad.lisp | 3 | ||||
| -rw-r--r-- | src/lisp/core.lisp.in | 4 |
8 files changed, 61 insertions, 94 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index a9fc5f80..8649fc30 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,27 @@ +2012-01-14 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * lisp/core.lisp.in (mkIntArray): New. Export. + * interp/patches.lisp (/RF): Move to cparse.boot. + (/RQ): Likewise. + (/RQ,LIB): Likewise. + (/RF-1): Likewise. + (/EF): Move to spad.lisp. + (construct): Remove. + (READSPADEXPR): Likewise. + (SHAREDITEMS): Likewise. + (installStandardTestPackages): Likewise. + (spadtestValueHook): Likewise. + (testError): Likewise. + ($TestOptions): Likewise. + (rebuild): Likewise. + ($ViewportProcessToWatch): Likewise. + (setViewportProcess): Likewise. + (waitForViewport): Likewise. + * interp/i-analy.boot (pushDownOp?): Use mkIntArray in place of + GETZEROVEC. + * interp/i-funsel.boot (argCouldBelongToSubdomain): Likewise. + * interp/i-intern.boot (flagArguments): Likewise. + 2012-01-12 Gabriel Dos Reis <gdr@cs.tamu.edu> * interp/category.boot: Rename AncestorP to ancestor?. diff --git a/src/interp/cparse.boot b/src/interp/cparse.boot index 0c8465fd..79de955f 100644 --- a/src/interp/cparse.boot +++ b/src/interp/cparse.boot @@ -1087,3 +1087,30 @@ npMoveTo n== (npNext();npMoveTo n) npEqKey "SETTAB" => npMoveTo(n+1) (npNext();npMoveTo n) + +--% + +_/RF(:x) == + $Echo: local := true + _/RF_-1 nil + +_/RQ(:x) == + $Echo: local := false + _/RF_-1 nil + +_/RQ_,LIB(:x) == + $Echo: local := false + _/RF_-1 nil + + +_/RF_-1 x == + ifile := MAKE_-INPUT_-FILENAME _/EDITFILE + lfile := nil + type := PATHNAME_-TYPE ifile + type = '"boot" => + lfile := MAKE_-PATHNAME(type <- '"lisp",defaults <- ifile) + BOOT(ifile,lfile) + LOAD lfile + type = '"lisp" => LOAD ifile + type = '"input" => ncINTERPFILE(ifile,$Echo) + SPAD ifile diff --git a/src/interp/i-analy.boot b/src/interp/i-analy.boot index e0624236..54d576b1 100644 --- a/src/interp/i-analy.boot +++ b/src/interp/i-analy.boot @@ -188,7 +188,7 @@ pushDownOp?(op,n) == -- [domain of implementation, target, arg1, arg2, ...] -- sameAsTarg is a vector that counts the number of modemaps that -- have the corresponding argument equal to the target type - sameAsTarg := GETZEROVEC n + sameAsTarg := mkIntArray n numMms := # ops for [.,targ,:argl] in ops repeat for arg in argl for i in 0.. repeat diff --git a/src/interp/i-funsel.boot b/src/interp/i-funsel.boot index 611882e2..65f5d292 100644 --- a/src/interp/i-funsel.boot +++ b/src/interp/i-funsel.boot @@ -509,7 +509,7 @@ argCouldBelongToSubdomain(op, nargs) == -- if ^0, this indicates that there exists a modemap for the -- op that needs a subdomain in that position nargs = 0 => nil - v := GETZEROVEC nargs + v := mkIntArray nargs isMap(op) => v mms := getModemapsFromDatabase(op,nargs) mms = nil => v diff --git a/src/interp/i-intern.boot b/src/interp/i-intern.boot index eefc2a55..2dc3e34a 100644 --- a/src/interp/i-intern.boot +++ b/src/interp/i-intern.boot @@ -298,7 +298,7 @@ mkAtree3(x,op,argl) == ++ positive entry indicates that modemaps for `op' takes flag arguments ++ in that position. flagArguments(op, nargs) == - v := GETZEROVEC nargs + v := mkIntArray nargs sigs := [signatureFromModemap m for m in getModemapsFromDatabase(op, nargs)] checkCallingConvention(sigs, nargs) diff --git a/src/interp/patches.lisp b/src/interp/patches.lisp index 62e8eb3e..a4299431 100644 --- a/src/interp/patches.lisp +++ b/src/interp/patches.lisp @@ -40,8 +40,6 @@ (defun CATCHALL (a &rest b) a) ;; not correct but ok for now (defvar |$demoFlag| nil) -(define-function '|construct| #'list) ;; NEEDED , SPAD-COMPILER generated Lisp code - (defmacro dribinit (streamvar) `(if (is-console ,streamvar) (setq ,streamvar *terminal-io*))) @@ -64,56 +62,6 @@ #+(and :GCL :IEEE-FLOATING-POINT ) (setq system:*print-nans* T) -(defun /RF (&rest foo &aux (|$Echo| 'T)) - (declare (special |$Echo|)) - (/RF-1 nil)) - -(defun /RQ (&rest foo &aux (|$Echo| nil)) - (declare (special |$Echo|)) - (/RF-1 nil)) - -(defun |/RQ,LIB| (&rest foo &aux (|$Echo| nil)) - (declare (special |$Echo|)) - (/RF-1 nil)) - -(defun /RF-1 (ignore) - (declare (ignore ignore)) - (declare (special |$Echo|)) - (let* ((input-file (make-input-filename /EDITFILE)) - (lfile ()) - (type (pathname-type input-file))) - (cond - ((string= type "boot") - (boot input-file - (setq lfile (make-pathname :type "lisp" - :defaults input-file))) - (load lfile)) - ((string= type "lisp") (load input-file)) - ((string= type "bbin") (load input-file)) - ((string= type "input") - (|ncINTERPFILE| input-file |$Echo|)) - (t (spad input-file))))) - -(defun /EF (&rest foo) - (|runCommand| (concat "vi " (namestring (make-input-filename /EDITFILE))))) - -(defun SHAREDITEMS (x) T) ;;checked in history code - -(defun GETZEROVEC (n) (MAKE-ARRAY n :initial-element 0)) - -(defun READSPADEXPR () - (declare (special in-stream)) - (let* ((line (cdar (preparse in-stream)))) - (cond ((or (not (stringp line)) (zerop (SIZE line))) - (SAY " Scratchpad -- input") - (READSPADEXPR)) - (t (|parseTransform| (|postTransform| (|string2SpadTree| line))))))) - -;; following are defined in spadtest.boot and stantest.boot -(defun |installStandardTestPackages| () ()) -(defun |spadtestValueHook| (val type) ()) -(defun |testError| (errotype erroValue) ()) -(defvar |$TestOptions| ()) ;; following in defined in word.boot (defun |bootFind| (word) ()) @@ -147,43 +95,4 @@ (cacheKeyedMsg |$defaultMsgDatabaseName|)) (gethash key *msghash*)) -#+:AKCL (proclaim '(ftype (function (t) t) identity)) -#+:AKCL (defun identity (x) x) - (|initializeTimedNames| |$interpreterTimedNames| |$interpreterTimedClasses|) - -(defun |rebuild| (filemode) - "rebuild MODEMAP.DAASE, exit lisp with bad return code on failure" - (let ((returncode -16)) - (unwind-protect - (let (|$databaseQueue| |$e|) - (declare (special |$databaseQueue| |$e|)) - (|clearConstructorAndLisplibCaches|) - (setq |$databaseQueue| nil) - (setq |$e| (cons (cons nil nil) nil)) - (|buildDatabase| filemode t) - (setq |$IOindex| 1) - (setq |$InteractiveFrame| (cons (cons nil nil) nil)) - (setq returncode 0)) - (unless (zerop returncode) (bye returncode))))) - -(defvar |$ViewportProcessToWatch| nil) -(defun |setViewportProcess| () - (setq |$ViewportProcessToWatch| - (stringimage (CDR - (|processInteractive| '(|key| (|%%| -2)) NIL) )))) - -(defun |waitForViewport| () - (progn - (do () - ((not (zerop (|runCommand| - (concat - "ps " - |$ViewportProcessToWatch| - " > /dev/null"))))) - ()) - (|sockSendInt| |$MenuServer| 1) - (|setIOindex| (- |$IOindex| 3)) - ) -) - diff --git a/src/interp/spad.lisp b/src/interp/spad.lisp index dfd21b81..31628a03 100644 --- a/src/interp/spad.lisp +++ b/src/interp/spad.lisp @@ -175,6 +175,9 @@ ('T (/RF)) ) (|terminateSystemCommand|)) +(defun /EF (&rest foo) + (|runCommand| (concat "vi " (namestring (make-input-filename /EDITFILE))))) + (defun /EDIT (L) (SETQ /EDITFILE L) (/EF) diff --git a/src/lisp/core.lisp.in b/src/lisp/core.lisp.in index 7535ba70..5fc563c9 100644 --- a/src/lisp/core.lisp.in +++ b/src/lisp/core.lisp.in @@ -150,6 +150,7 @@ "makeBitVector" "makeString" "mkVector" + "mkIntArray" "listToString" "%hasFeature" @@ -1419,6 +1420,9 @@ (defmacro |mkVector| (n) `(make-array ,n :initial-element nil)) +(defmacro |mkIntArray| (n) + `(make-array ,n :initial-element 0)) + ;; native data type translation table (defconstant |$NativeTypeTable| '((|void| . @void_type@) |