aboutsummaryrefslogtreecommitdiff
path: root/src/interp
diff options
context:
space:
mode:
Diffstat (limited to 'src/interp')
-rw-r--r--src/interp/daase.lisp73
-rw-r--r--src/interp/debug.lisp2
-rw-r--r--src/interp/define.boot2
-rw-r--r--src/interp/foam_l.lisp2
-rw-r--r--src/interp/g-util.boot8
-rw-r--r--src/interp/i-syscmd.boot9
-rw-r--r--src/interp/interop.boot8
-rw-r--r--src/interp/lisplib.boot2
-rw-r--r--src/interp/nlib.lisp7
-rw-r--r--src/interp/nrunopt.boot2
-rw-r--r--src/interp/nspadaux.lisp26
-rw-r--r--src/interp/packtran.boot2
-rw-r--r--src/interp/patches.lisp11
-rw-r--r--src/interp/sfsfun-l.lisp6
-rw-r--r--src/interp/spad.lisp27
-rw-r--r--src/interp/spaderror.lisp8
-rw-r--r--src/interp/sys-utility.boot4
-rw-r--r--src/interp/trace.boot1
18 files changed, 72 insertions, 128 deletions
diff --git a/src/interp/daase.lisp b/src/interp/daase.lisp
index 88f599e2..73c1c0a6 100644
--- a/src/interp/daase.lisp
+++ b/src/interp/daase.lisp
@@ -407,9 +407,7 @@
|OneDimensionalArrayAggregate&| |FiniteLinearAggregate&| |PrimitiveArray|
|Integer| |List| |OutputForm|))
(dolist (con constr)
- (let ((c (concatenate 'string
- (|systemRootDirectory|) "/algebra/"
- (string (getdatabase con 'abbreviation)) ".o")))
+ (let ((c (|getSystemModulePath| (string (getdatabase con 'abbreviation)))))
(format t " preloading ~a.." c)
(if (probe-file c)
(progn
@@ -559,7 +557,7 @@
(let (oldop op)
(setq op (car map))
(setq oldop (getdatabase op 'operation))
- (setq oldop (lisp::delete (cdr map) oldop :test #'equal))
+ (setq oldop (delete (cdr map) oldop :test #'equal))
(setf (gethash op *operation-hash*) oldop)))
(dolist (map (getdatabase constructor 'modemaps)) ; in with the new
(let (op newmap)
@@ -784,17 +782,14 @@
(if (consp data)
(setq data
(if (string= (directory-namestring (car data)) "")
- (concatenate 'string (|systemRootDirectory|) "algebra/" (car data) ".o")
+ (|getSystemModulePath| (car data))
(car data)))
(when (and data (string= (directory-namestring data) ""))
- (setq data (concatenate 'string (|systemRootDirectory|) "algebra/" data ".o")))))))
+ (setq data (|getSystemModulePath| data)))))))
data))
; )library top level command -- soon to be obsolete
-(defun |with| (args)
- (|library| args))
-
;; Current directory
;; Contributed by Juergen Weiss.
#+:cmu
@@ -805,44 +800,6 @@
(defun get-current-directory ()
(namestring (truename "")))
-
-; )library top level command
-
-(defun |library| (args)
- (declare (special |$options|))
- (declare (special |$newConlist|))
- (setq original-directory (get-current-directory))
- (setq |$newConlist| nil)
- (localdatabase args |$options|)
-#+:CCL
- (dolist (a args) (check-module-exists a))
- (|extendLocalLibdb| |$newConlist|)
- (|changeDirectory| original-directory)
- (tersyscommand))
-
-;; check-module-exists looks to see if a module exists in one of the current
-;; libraries and, if not, compiles it. If the output-library exists but has not
-;; been opened then it opens it first.
-#+:CCL
-(defun check-module-exists (module)
- (prog (|$options| mdate)
- (if (and (not output-library) (filep (or |$outputLibraryName| "user.lib")))
- (seq (setq |$outputLibraryName|
- (if |$outputLibraryName| (truename |$outputLibraryName|)
- (make-pathname :directory (get-current-directory)
- :name "user.lib")))
- (|openOutputLibrary| |$outputLibraryName|)))
- (setq mdate (modulep module))
- (setq |$options| '((|nolibrary| nil) (|quiet| nil)))
- (|sayMSG| (format nil " Checking for module ~s." (namestring module)))
- (let* ((fn (concatenate 'string (namestring module) ".lsp"))
- (fdate (filedate fn)) )
- (if (and fdate (or (null mdate) (datelessp mdate fdate)))
- (|compileAsharpLispCmd| (list fn))
- (let* ((fn (concatenate 'string (namestring module) ".NRLIB"))
- (fdate (filedate fn)) )
- (if (and fdate (or (null mdate) (datelessp mdate fdate)))
- (|compileSpadLispCmd| (list fn))))))))
; localdatabase tries to find files in the order of:
; NRLIB/index.KAF
@@ -855,15 +812,15 @@
(processOptions (options)
(let (only dir noexpose)
(when (setq only (assoc '|only| options))
- (setq options (lisp::delete only options :test #'equal))
+ (setq options (delete only options :test #'equal))
(setq only (cdr only)))
(when (setq dir (assoc '|dir| options))
- (setq options (lisp::delete dir options :test #'equal))
+ (setq options (delete dir options :test #'equal))
(setq dir (second dir))
(when (null dir)
(|sayKeyedMsg| 'S2IU0002 nil) ))
(when (setq noexpose (assoc '|noexpose| options))
- (setq options (lisp::delete noexpose options :test #'equal))
+ (setq options (delete noexpose options :test #'equal))
(setq noexpose 't) )
(when options
(format t " Ignoring unknown )library option: ~a~%" options))
@@ -876,8 +833,8 @@
(values
(mapcan #'(lambda (f)
(when (string-equal (pathname-type f) "NRLIB")
- (list (concatenate 'string (namestring f) "/"
- *index-filename*)))) allfiles)
+ (list (concatenate 'string (namestring f) "/" *index-filename*))))
+ allfiles)
(mapcan #'(lambda (f)
(when (string= (pathname-type f) "asy")
(push (pathname-name f) skipasos)
@@ -889,12 +846,7 @@
allfiles)
;; At the moment we will only look for user.lib: others are taken care
;; of by localasy and localnrlib.
-#+:CCL
- (mapcan #'(lambda (f)
- (when (and (string= (pathname-type f) "lib") (string= (pathname-name f) "user"))
- (list (namestring f))))
- allfiles)
-#-:CCL nil
+ nil
))))
(let (thisdir nrlibs asos asys libs object only dir key
(|$forceDatabaseUpdate| t) noexpose)
@@ -921,8 +873,6 @@
(concatenate 'string namedir filename ".ao")))
(push (namestring file) asos))
('else (format t " )library cannot find the file ~a.~%" filename)))))
-#+:CCL
- (dolist (file libs) (|addInputLibrary| (truename file)))
(dolist (file (nreverse nrlibs))
(setq key (pathname-name (first (last (pathname-directory file)))))
(setq object (concatenate 'string (directory-namestring file)
@@ -1311,7 +1261,6 @@
(let (opalistpos modemapspos cmodemappos master masterpos obj *print-pretty*
concategory categorypos kind niladic cosig abbrev defaultdomain
ancestors ancestorspos out)
- (declare (special *print-pretty*))
(print "building interp.daase")
(setq out (open "interp.build" :direction :output))
(princ " " out)
@@ -1369,7 +1318,6 @@
(defun write-browsedb ()
"make browse.daase from hash tables"
(let (master masterpos src formpos docpos attpos predpos *print-pretty* out)
- (declare (special *print-pretty*))
(print "building browse.daase")
(setq out (open "browse.build" :direction :output))
(princ " " out)
@@ -1404,7 +1352,6 @@
(defun write-categorydb ()
"make category.daase from scratch. contains the *hasCategory-hash* table"
(let (out master pos *print-pretty*)
- (declare (special *print-pretty*))
(print "building category.daase")
(|genCategoryTable|)
(setq out (open "category.build" :direction :output))
diff --git a/src/interp/debug.lisp b/src/interp/debug.lisp
index 125f352e..95d2145d 100644
--- a/src/interp/debug.lisp
+++ b/src/interp/debug.lisp
@@ -936,7 +936,7 @@ EXAMINE (SETQ RECNO (NOTE INPUTSTREAM))
(|sayBrightly| (LIST '|%b| (PNAME X) '|%d| "unembeded" '|%l|))
(UNEMBED X))) ))
-
+(defvar /breakcondition nil)
(defun /MONITOR (&rest G5)
(PROG (G1 G4 TRACECODE BEFORE AFTER CONDITION
diff --git a/src/interp/define.boot b/src/interp/define.boot
index 9993f44a..d49edfd8 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -83,7 +83,7 @@ maybeInsertViewMorphisms body ==
stmt is ["DEF",["rep",:.],:.]
or stmt is ["DEF",["per",:.],:.] =>
-- ??? We may actually want to stop processing now.
- stackSemanticError(['"Cannot define",:bright per],nil)
+ stackSemanticError(['"Cannot define",:bright "per"],nil)
-- OK, insert synthetized view morphisms
g := GENSYM()
diff --git a/src/interp/foam_l.lisp b/src/interp/foam_l.lisp
index 45b9f2da..78a12f1c 100644
--- a/src/interp/foam_l.lisp
+++ b/src/interp/foam_l.lisp
@@ -73,7 +73,7 @@
(:use "FOAM"))
#+:gcl (in-package "BOOT")
-#+:gcl (in-package "AxiomCore")
+(in-package "AxiomCore")
(import-module "vmlisp")
(in-package "FOAM")
diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot
index 539bf56b..97f96064 100644
--- a/src/interp/g-util.boot
+++ b/src/interp/g-util.boot
@@ -54,10 +54,10 @@ PPtoFile(x, fname) ==
++ Query properties for an entity in a given environment.
-get: (%Thing,%Symbol,%List) -> %List
-get0: (%Thing,%Symbol,%List) -> %List
-get1: (%Thing,%Symbol,%List) -> %List
-get2: (%Thing,%Symbol,%List) -> %List
+get: (%Thing,%Symbol,%List) -> %Thing
+get0: (%Thing,%Symbol,%List) -> %Thing
+get1: (%Thing,%Symbol,%List) -> %Thing
+get2: (%Thing,%Symbol,%List) -> %Thing
get(x,prop,e) ==
$InteractiveMode => get0(x,prop,e)
diff --git a/src/interp/i-syscmd.boot b/src/interp/i-syscmd.boot
index e51b9261..f0005946 100644
--- a/src/interp/i-syscmd.boot
+++ b/src/interp/i-syscmd.boot
@@ -2154,6 +2154,15 @@ reportCount () ==
SAY " "
sayBrightly [:bright " stream",fillerSpaces(29,'".")," ",$streamCount]
+--% )library
+library args ==
+ origDir := GET_-CURRENT_-DIRECTORY()
+ $newConlist := []
+ LOCALDATABASE(args,$options)
+ extendLocalLibdb $newConlist
+ changeDirectory origDir
+ TERSYSCOMMAND()
+
--% )quit
pquit() == pquitSpad2Cmd()
diff --git a/src/interp/interop.boot b/src/interp/interop.boot
index 0854f714..994b7825 100644
--- a/src/interp/interop.boot
+++ b/src/interp/interop.boot
@@ -92,7 +92,7 @@ SExprToDName(sexpr, cosigVal) ==
NOT cosigVal => [DNameOtherID, :sexpr]
if CAR sexpr = '_: then sexpr := CAR CDR CDR sexpr
CAR sexpr = 'Mapping =>
- args := [ SExprToDName(sx, 'T) for sx in CDR sexpr]
+ args := [ SExprToDName(sx,true) for sx in CDR sexpr]
[DNameApplyID,
[DNameStringID,: StringToCompStr '"->"],
[DNameTupleID, : CDR args],
@@ -100,7 +100,7 @@ SExprToDName(sexpr, cosigVal) ==
name0 := [DNameStringID, : StringToCompStr SYMBOL_-NAME CAR sexpr]
CAR sexpr = 'Union or CAR sexpr = 'Record =>
[DNameApplyID, name0,
- [DNameTupleID,: [ SExprToDName(sx, 'T) for sx in CDR sexpr]]]
+ [DNameTupleID,: [ SExprToDName(sx,true) for sx in CDR sexpr]]]
newCosig := CDR GETDATABASE(CAR sexpr, QUOTE COSIG)
[DNameApplyID, name0,
: MAPCAR(function SExprToDName, CDR sexpr, newCosig)]
@@ -169,7 +169,7 @@ oldAxiomCategoryDefaultPackage(catform, dom) ==
hasDefaultPackage opOf catform
oldAxiomPreCategoryDevaluate([op,:args], env) ==
- SExprToDName([op,:devaluateList args], T)
+ SExprToDName([op,:devaluateList args], true)
$oldAxiomPreCategoryDispatch :=
VECTOR('oldAxiomPreCategory,
@@ -476,7 +476,7 @@ hashNewLookupInCategories(op,sig,dom,dollar) ==
valueList := [MKQ val for val in valueList]
nsig := MSUBST(dom.0,dollar.0,sig)
for i in 0..MAXINDEX packageVec |
- (entry := packageVec.i) and entry ^= 'T repeat
+ (entry := packageVec.i) and entry ^= true repeat
package :=
VECP entry =>
if $monitorNewWorld then
diff --git a/src/interp/lisplib.boot b/src/interp/lisplib.boot
index cd3b728d..d925a847 100644
--- a/src/interp/lisplib.boot
+++ b/src/interp/lisplib.boot
@@ -370,7 +370,7 @@ compDefineLisplib(df:=["DEF",[op,:.],:.],m,e,prefix,fal,fn) ==
FRESH_-LINE $algebraOutputStream
sayMSG fillerSpaces(72,'"-")
unloadOneConstructor(op,libName)
- LOCALDATABASE(LIST GETDATABASE(op,'ABBREVIATION),NIL)
+ LOCALDATABASE(LIST SYMBOL_-NAME GETDATABASE(op,'ABBREVIATION),NIL)
$newConlist := [op, :$newConlist] ----------> bound in function "compiler"
if $lisplibKind = 'category
then updateCategoryFrameForCategory op
diff --git a/src/interp/nlib.lisp b/src/interp/nlib.lisp
index fa788f2a..289fa580 100644
--- a/src/interp/nlib.lisp
+++ b/src/interp/nlib.lisp
@@ -35,8 +35,6 @@
(IMPORT-MODULE "macros")
(in-package "BOOT")
-#+:AKCL (defvar *lisp-bin-filetype* "o")
-
#+:AKCL (defvar *lisp-source-filetype* "lsp")
;; definition of our stream structure
@@ -268,9 +266,8 @@
(rshut nrstream)))
filespec)
-#+:AKCL
(defun recompile-lib-file-if-necessary (lfile)
- (let* ((bfile (make-pathname :type *lisp-bin-filetype* :defaults lfile))
+ (let* ((bfile (make-pathname :type |$faslType| :defaults lfile))
(bdate (and (probe-file bfile) (file-write-date bfile)))
(ldate (and (probe-file lfile) (file-write-date lfile))))
(if ldate
@@ -318,7 +315,7 @@
:entrycond (spad-fixed-arg (caar system::arglist))))
(apply #'compile-file fn opts))
(untrace compiler::fast-link-proclaimed-type-p compiler::t1defun)))
-#+:CCL
+#-:GCL
(define-function 'compile-lib-file #'compile-file)
;; (RDROPITEMS filearg keys) don't delete, used in files.spad
diff --git a/src/interp/nrunopt.boot b/src/interp/nrunopt.boot
index d4a05010..a70168d9 100644
--- a/src/interp/nrunopt.boot
+++ b/src/interp/nrunopt.boot
@@ -263,7 +263,7 @@ makePredicateBitVector pl == --called by NRTbuildFunctor
augmentPredCode(n,lastPl) ==
['LIST,:pl] := mungeAddGensyms(lastPl,$predGensymAlist)
delta := 2 ** n
- l := [(u := MKPF([x,['augmentPredVector,$,delta]],'AND);
+ l := [(u := MKPF([x,['augmentPredVector,"$",delta]],'AND);
delta:=2 * delta; u) for x in pl]
augmentPredVector(dollar,value) ==
diff --git a/src/interp/nspadaux.lisp b/src/interp/nspadaux.lisp
index 30e55021..99f7dd50 100644
--- a/src/interp/nspadaux.lisp
+++ b/src/interp/nspadaux.lisp
@@ -1,6 +1,6 @@
;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
;; All rights reserved.
-;; Copyright (C) 2007, Gabriel Dos Reis.
+;; Copyright (C) 2007-2008, Gabriel Dos Reis.
;; All rights reserved.
;;
;; Redistribution and use in source and binary forms, with or without
@@ -41,21 +41,21 @@
(defvar |$abbreviationStack| nil)
(defvar |$knownAttributes| nil "cumulative list of known attributes of a file")
-(setq |$underscoreChar| (|char| '_))
+(defparameter |$underscoreChar| (|char| '_))
(defvar |$back| nil)
-(setq |$markChoices| '(ATOM COLON LAMBDA AUTOSUBSET AUTOHARD AUTOREP REPPER FREESI RETRACT))
-(setq |$convert2NewCompiler| 'T)
-(setq |$AnalyzeOnly| NIL)
-(setq |$categoryPart| 'T)
-(setq |$insideCAPSULE| nil)
-(setq |$insideEXPORTS| nil)
-(setq |$originalSignature| nil)
-(setq |$insideDEF| nil)
-(setq |$insideTypeExpression| nil)
-(setq |$spadTightList| '(\.\. \# \' \:\ \: \:\:))
+(defparameter |$markChoices| '(ATOM COLON LAMBDA AUTOSUBSET AUTOHARD AUTOREP REPPER FREESI RETRACT))
+(defparameter |$convert2NewCompiler| 'T)
+(defparameter |$AnalyzeOnly| NIL)
+(defparameter |$categoryPart| 'T)
+(defparameter |$insideCAPSULE| nil)
+(defparameter |$insideEXPORTS| nil)
+(defparameter |$originalSignature| nil)
+(defparameter |$insideDEF| nil)
+(defparameter |$insideTypeExpression| nil)
+(defparameter |$spadTightList| '(\.\. \# \' \:\ \: \:\:))
-(setq |$PerCentVariableList| '(%1 %2 %3 %4 %5 %6 %7 %8 %9 %10))
+(defparameter |$PerCentVariableList| '(%1 %2 %3 %4 %5 %6 %7 %8 %9 %10))
(mapcar #'(lambda (X) (MAKEPROP (CAR X) 'SPECIAL (CADR X)))
'((PART |compPART|)
diff --git a/src/interp/packtran.boot b/src/interp/packtran.boot
index 9bc69888..84d5f64f 100644
--- a/src/interp/packtran.boot
+++ b/src/interp/packtran.boot
@@ -36,7 +36,7 @@ import '"sys-macros"
)package "BOOT"
rePackageTran(sex, package) ==
- _*PACKAGE_* : fluid := FIND_-PACKAGE STRING package
+ SETQ(_*PACKAGE_*,FIND_-PACKAGE STRING package)
packageTran sex
packageTran sex ==
diff --git a/src/interp/patches.lisp b/src/interp/patches.lisp
index 915efc21..cc49ba90 100644
--- a/src/interp/patches.lisp
+++ b/src/interp/patches.lisp
@@ -32,7 +32,7 @@
;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
(import-module "macros")
-(import-module "debug")
+(import-module "sockio")
(import-module "g-timer")
(in-package "BOOT")
;;patches for now
@@ -81,7 +81,6 @@
(define-function '|isBpiOrLambda| #'FBOUNDP)
;;(defun |isSharpVar| (x) (and (identp x) (char= (elt (pname x) 0) #\#)))
-(setq |$useInternalHistoryTable| T)
(defvar |$internalHistoryTable| ())
(defun |cpCms| (prefix &optional (string (|getSystemCommandLine|)))
(setq string (concat prefix string))
@@ -106,6 +105,7 @@
(defun /RF-1 (ignore)
(declare (ignore ignore))
+ (declare (special echo-meta))
(let* ((input-file (make-input-filename /EDITFILE))
(lfile ())
(type (pathname-type input-file)))
@@ -128,10 +128,6 @@
(defun /EF (&rest foo)
(obey (concat "vi " (namestring (make-input-filename /EDITFILE)))))
-#-:CCL
- (defun user::start () (in-package "BOOT") (boot::|start|))
-#+:CCL
- (defun user::start () (setq *package* (find-package "BOOT")) (boot::|start|))
(setq |$algebraOutputStream|
(setq |$fortranOutputStream|
@@ -172,6 +168,7 @@
(defun |normalizeArgFileName| (l) l)
(defun READSPADEXPR ()
+ (declare (special in-stream))
(let* ((line (cdar (preparse in-stream))))
(cond ((or (not (stringp line)) (zerop (SIZE line)))
(SAY " Scratchpad -- input")
@@ -283,6 +280,7 @@
(defun boot::|printCopyright| ()
(format t "there is no such thing as a simple job -- ((iHy))~%"))
+(defvar |$ViewportProcessToWatch| nil)
(defun |setViewportProcess| ()
(setq |$ViewportProcessToWatch|
(stringimage (CDR
@@ -348,6 +346,5 @@
;; (|xdrRead| xfoo (make-array 10 :element-type 'long-float ))
;; (setq *print-array* NIL)
-(setq echo-meta nil)
(defun /versioncheck (n) (unless (= n /MAJOR-VERSION) (throw 'versioncheck -1)))
diff --git a/src/interp/sfsfun-l.lisp b/src/interp/sfsfun-l.lisp
index 89242508..810cbe21 100644
--- a/src/interp/sfsfun-l.lisp
+++ b/src/interp/sfsfun-l.lisp
@@ -1,6 +1,6 @@
;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
;; All rights reserved.
-;; Copyright (C) 2007, Gabriel Dos Reis.
+;; Copyright (C) 2007-2008, Gabriel Dos Reis.
;; All rights reserved.
;;
;; Redistribution and use in source and binary forms, with or without
@@ -63,10 +63,10 @@
(defun rpsi (n x) (|rPsi| n x) )
(defun cpsi (n z) (c-to-s (|cPsi| n (s-to-c z)) ))
-(defun rbesselj (n x) (c-to-r (|BesselJ| n x)) ))
+(defun rbesselj (n x) (c-to-r (|BesselJ| n x)) )
(defun cbesselj (v z) (c-to-s (|BesselJ| (s-to-c v) (s-to-c z)) ))
-(defun rbesseli (n x) (c-to-r (|BesselI| n x)) ))
+(defun rbesseli (n x) (c-to-r (|BesselI| n x)) )
(defun cbesseli (v z) (c-to-s (|BesselI| (s-to-c v) (s-to-c z)) ))
(defun chyper0f1 (a z) (c-to-s (|chebf01| (s-to-c a) (s-to-c z)) ))
diff --git a/src/interp/spad.lisp b/src/interp/spad.lisp
index 21b3d8b8..5ef272b0 100644
--- a/src/interp/spad.lisp
+++ b/src/interp/spad.lisp
@@ -1,6 +1,6 @@
;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
;; All rights reserved.
-;; Copyright (C) 2007, Gabriel Dos Reis.
+;; Copyright (C) 2007-2008, Gabriel Dos Reis.
;; All rights reserved.
;;
;; Redistribution and use in source and binary forms, with or without
@@ -36,6 +36,8 @@
; PURPOSE: This is an initialization and system-building file for Scratchpad.
(IMPORT-MODULE "bootlex")
+(import-module "postpar")
+(import-module "debug")
(in-package "BOOT")
;;; Common Block
@@ -53,9 +55,6 @@
(defvar |$newCompAtTopLevel| nil "if t uses new compiler")
(defvar |$doNotCompileJustPrint| nil "switch for compile")
(defvar |$Rep| '|$Rep| "should be bound to gensym? checked in coerce")
-;; the following initialization of $ must not be a defvar
-;; since that make $ special
-(setq $ '$) ;; used in def of Ring which is Algebra($)
(defvar |$scanIfTrue| nil "if t continue compiling after errors")
(defvar |$Representation| nil "checked in compNoStacking")
(defvar |$definition| nil "checked in DomainSubstitutionFunction")
@@ -128,7 +127,7 @@
(LIST X " --> " Y '|%b| |yesOrNo| '|%d|)))
(SETQ |$compCount| (1- |$compCount|))
(RETURN U) )))
- (|comp| $x $m $f)
+ (|comp| |$x| |$m| |$f|)
(UNEMBED '|comp|))
(defun READ-SPAD (FN FM TO)
@@ -223,11 +222,6 @@
(defun CPSAY (X) (let (n) (if (EQ 0 (setq N (OBEY X))) NIL (PRINT N))))
-(defun /FLAG (L)
- (MAKEPROP (FIRST L) 'FLAGS (LET ((X (UNION (CDR L)))) (GET (FIRST L) 'FLAGS)))
- (SAY (FIRST L) " has flags: " X)
- (TERSYSCOMMAND))
-
(defun |fin| ()
(SETQ *EOF* 'T)
(THROW 'SPAD_READER NIL))
@@ -351,10 +345,8 @@
(defun |evalSharpOne| (x \#1) (declare (special \#1)) (EVAL x))
-(setq *PROMPT* 'LISP)
-
(defun |New,ENTRY,1| ()
- (let (ZZ str N RLGENSYMFG RLGENSYMLST |NewFLAG| XCAPE *PROMPT*
+ (let (ZZ str N RLGENSYMFG RLGENSYMLST |NewFLAG| XCAPE
SINGLELINEMODE OK ISID NBLNK COUNT CHR ULCASEFG ($LINESTACK 'BEGIN_UNIT)
$TOKSTACK COMMENTCHR TOK LINE BACK INPUTSTREAM XTRANS
XTOKENREADER STACK STACKX TRAPFLAG)
@@ -362,12 +354,11 @@
XTOKENREADER 'NewSYSTOK
SYNTAX_ERROR 'SPAD_SYNTAX_ERROR)
(FLAG |boot-NewKEY| 'KEY)
- (SETQ *PROMPT* 'Scratchpad-II)
(PROMPT)
(SETQ XCAPE '_)
(SETQ COMMENTCHR 'IGNORE)
- (SETQ COLUMN 0)
- (SETQ SINGLINEMODE T) ; SEE NewSYSTOK
+ (SETQ INITCOLUMN 0)
+ (SETQ SINGLELINEMODE T) ; SEE NewSYSTOK
(SETQ NewFLAG T)
(SETQ ULCASEFG T)
(setq STR (|New,ENTRY,2| '|PARSE-NewEXPR| '|process| curinstream))
@@ -379,7 +370,7 @@
(defun |New,ENTRY,2| (RULE FN INPUTSTREAM) (declare (special INPUTSTREAM))
(let (zz)
(INITIALIZE)
- (SETQ $previousTime (TEMPUS-FUGIT))
+ (SETQ |$previousTime| (TEMPUS-FUGIT))
(setq ZZ (CONVERSATION '|PARSE-NewExpr| '|process|))
(REMFLAG |boot-NewKEY| 'KEY)
INPUTSTREAM))
@@ -388,8 +379,6 @@
(init-boot/spad-reader)
(initialize-preparse INPUTSTREAM))
-(setq *prompt* 'new)
-
(defmacro try (X)
`(LET ((|$autoLine|))
(declare (special |$autoLine|))
diff --git a/src/interp/spaderror.lisp b/src/interp/spaderror.lisp
index 0653b75e..aedfc5f9 100644
--- a/src/interp/spaderror.lisp
+++ b/src/interp/spaderror.lisp
@@ -1,6 +1,6 @@
;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
;; All rights reserved.
-;; Copyright (C) 2007, Gabriel Dos Reis.
+;; Copyright (C) 2007-2008, Gabriel Dos Reis.
;; All rights reserved.
;;
;; Redistribution and use in source and binary forms, with or without
@@ -44,16 +44,16 @@
;;(defmacro |trappedSpadEval| (form) form) ;;nop for now
#+:akcl
-(setq |$quitTag| system::*quit-tag*)
+(defconstant |$quitTag| system::*quit-tag*)
#+:akcl
(defun |resetStackLimits| () (system:reset-stack-limits))
#-:akcl
-(setq |$quitTag| (gensym))
+(defconstant |$quitTag| (gensym))
#-:akcl
(defun |resetStackLimits| () nil)
;; failed union branch -- value returned for numeric failure
-(setq |$numericFailure| (cons 1 "failed"))
+(defconstant |$numericFailure| (cons 1 "failed"))
(defvar |$oldBreakMode|)
diff --git a/src/interp/sys-utility.boot b/src/interp/sys-utility.boot
index 3b119a65..d74c74ba 100644
--- a/src/interp/sys-utility.boot
+++ b/src/interp/sys-utility.boot
@@ -171,3 +171,7 @@ $REPLACE(filespec1,filespec2) ==
checkMkdir path ==
mkdir path = 0 => true
systemError ['"cannot create directory",:bright path]
+
+++ return the pathname to the system module designated by `m'.
+getSystemModulePath m ==
+ CONCAT(systemRootDirectory(),'"algebra/",m,'".",$faslType)
diff --git a/src/interp/trace.boot b/src/interp/trace.boot
index 883717c1..d25c4506 100644
--- a/src/interp/trace.boot
+++ b/src/interp/trace.boot
@@ -504,6 +504,7 @@ traceDomainLocalOps(dom,lops,options) ==
-- nil
untraceDomainLocalOps(dom,lops) ==
+ abb := abbreviate dom
sayMSG ['" ",:bright abb,'"has no local functions to untrace."]
NIL
-- lops = "all" => untraceAllDomainLocalOps(dom)
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-27 21:14:54 +0000