aboutsummaryrefslogtreecommitdiff
path: root/src/interp
diff options
context:
space:
mode:
Diffstat (limited to 'src/interp')
-rw-r--r--src/interp/Makefile.in8
-rw-r--r--src/interp/Makefile.pamphlet8
-rw-r--r--src/interp/c-util.boot8
-rw-r--r--src/interp/database.boot1
-rw-r--r--src/interp/debug.lisp18
-rw-r--r--src/interp/define.boot4
-rw-r--r--src/interp/functor.boot4
-rw-r--r--src/interp/g-cndata.boot6
-rw-r--r--src/interp/g-opt.boot4
-rw-r--r--src/interp/g-util.boot2
-rw-r--r--src/interp/guess.boot6
-rw-r--r--src/interp/i-output.boot2
-rw-r--r--src/interp/macros.lisp7
-rw-r--r--src/interp/nrungo.boot4
-rw-r--r--src/interp/preparse.lisp2
-rw-r--r--src/interp/spad.lisp3
-rw-r--r--src/interp/sys-macros.lisp8
-rw-r--r--src/interp/trace.boot2
-rw-r--r--src/interp/types.boot2
-rw-r--r--src/interp/vmlisp.lisp40
-rw-r--r--src/interp/word.boot6
21 files changed, 48 insertions, 97 deletions
diff --git a/src/interp/Makefile.in b/src/interp/Makefile.in
index b15c1ed6..bac06488 100644
--- a/src/interp/Makefile.in
+++ b/src/interp/Makefile.in
@@ -302,18 +302,18 @@ setvart.$(FASLEXT): macros.$(FASLEXT)
## OpenAxiom's compiler
wi2.$(FASLEXT): macros.$(FASLEXT) define.$(FASLEXT)
wi1.$(FASLEXT): macros.$(FASLEXT)
-compiler.$(FASLEXT): msgdb.$(FASLEXT) modemap.$(FASLEXT) \
+compiler.$(FASLEXT): msgdb.$(FASLEXT) \
pathname.$(FASLEXT) define.$(FASLEXT) iterator.$(FASLEXT)
nrunopt.$(FASLEXT): c-util.$(FASLEXT)
nrunfast.$(FASLEXT): c-util.$(FASLEXT)
nruncomp.$(FASLEXT): nrunopt.$(FASLEXT) profile.$(FASLEXT) simpbool.$(FASLEXT)
nrungo.$(FASLEXT): c-util.$(FASLEXT) clam.$(FASLEXT) interop.$(FASLEXT)
iterator.$(FASLEXT): g-util.$(FASLEXT)
-define.$(FASLEXT): g-error.$(FASLEXT) cattable.$(FASLEXT) \
- functor.$(FASLEXT) lisplib.$(FASLEXT) nruncomp.$(FASLEXT)
+define.$(FASLEXT): g-error.$(FASLEXT) modemap.$(FASLEXT) \
+ functor.$(FASLEXT) nruncomp.$(FASLEXT) database.$(FASLEXT)
database.$(FASLEXT): clam.$(FASLEXT) nlib.$(FASLEXT) \
cattable.$(FASLEXT) compat.$(FASLEXT) g-cndata.$(FASLEXT)
-functor.$(FASLEXT): category.$(FASLEXT) c-util.$(FASLEXT) clam.$(FASLEXT)
+functor.$(FASLEXT): category.$(FASLEXT) nrungo.$(FASLEXT) lisplib.$(FASLEXT)
category.$(FASLEXT): g-util.$(FASLEXT) g-cndata.$(FASLEXT)
cattable.$(FASLEXT): simpbool.$(FASLEXT) g-util.$(FASLEXT)
compat.$(FASLEXT): pathname.$(FASLEXT)
diff --git a/src/interp/Makefile.pamphlet b/src/interp/Makefile.pamphlet
index 8d53c817..a1dd3658 100644
--- a/src/interp/Makefile.pamphlet
+++ b/src/interp/Makefile.pamphlet
@@ -551,18 +551,18 @@ setvart.$(FASLEXT): macros.$(FASLEXT)
## OpenAxiom's compiler
wi2.$(FASLEXT): macros.$(FASLEXT) define.$(FASLEXT)
wi1.$(FASLEXT): macros.$(FASLEXT)
-compiler.$(FASLEXT): msgdb.$(FASLEXT) modemap.$(FASLEXT) \
+compiler.$(FASLEXT): msgdb.$(FASLEXT) \
pathname.$(FASLEXT) define.$(FASLEXT) iterator.$(FASLEXT)
nrunopt.$(FASLEXT): c-util.$(FASLEXT)
nrunfast.$(FASLEXT): c-util.$(FASLEXT)
nruncomp.$(FASLEXT): nrunopt.$(FASLEXT) profile.$(FASLEXT) simpbool.$(FASLEXT)
nrungo.$(FASLEXT): c-util.$(FASLEXT) clam.$(FASLEXT) interop.$(FASLEXT)
iterator.$(FASLEXT): g-util.$(FASLEXT)
-define.$(FASLEXT): g-error.$(FASLEXT) cattable.$(FASLEXT) \
- functor.$(FASLEXT) lisplib.$(FASLEXT) nruncomp.$(FASLEXT)
+define.$(FASLEXT): g-error.$(FASLEXT) modemap.$(FASLEXT) \
+ functor.$(FASLEXT) nruncomp.$(FASLEXT) database.$(FASLEXT)
database.$(FASLEXT): clam.$(FASLEXT) nlib.$(FASLEXT) \
cattable.$(FASLEXT) compat.$(FASLEXT) g-cndata.$(FASLEXT)
-functor.$(FASLEXT): category.$(FASLEXT) c-util.$(FASLEXT) clam.$(FASLEXT)
+functor.$(FASLEXT): category.$(FASLEXT) nrungo.$(FASLEXT) lisplib.$(FASLEXT)
category.$(FASLEXT): g-util.$(FASLEXT) g-cndata.$(FASLEXT)
cattable.$(FASLEXT): simpbool.$(FASLEXT) g-util.$(FASLEXT)
compat.$(FASLEXT): pathname.$(FASLEXT)
diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot
index c680e8b9..b859fe80 100644
--- a/src/interp/c-util.boot
+++ b/src/interp/c-util.boot
@@ -357,7 +357,7 @@ printEnv E ==
TERPRI()
SAY("Properties Of: ",first z)
for u in rest z repeat
- PRIN0 first u
+ PRIN1 first u
printString ": "
PRETTYPRINT tran(rest u,first u) where
tran(val,prop) ==
@@ -372,7 +372,7 @@ prEnv E ==
TERPRI()
SAY("Properties Of: ",first z)
for u in rest z repeat
- PRIN0 first u
+ PRIN1 first u
printString ": "
PRETTYPRINT tran(rest u,first u) where
tran(val,prop) ==
@@ -387,7 +387,7 @@ prModemaps E ==
(modemap:= LASSOC("modemap",rest z)) repeat
listOfOperatorsSeenSoFar:= [first z,:listOfOperatorsSeenSoFar]
TERPRI()
- PRIN0 first z
+ PRIN1 first z
printString ": "
PRETTYPRINT modemap
@@ -671,7 +671,7 @@ stackAndThrow(msg, args == nil) ==
printString x == PRINTEXP (STRINGP x => x; PNAME x)
-printAny x == if atom x then printString x else PRIN0 x
+printAny x == if atom x then printString x else PRIN1 x
printSignature(before,op,[target,:argSigList]) ==
printString before
diff --git a/src/interp/database.boot b/src/interp/database.boot
index 011f15c5..1b957c45 100644
--- a/src/interp/database.boot
+++ b/src/interp/database.boot
@@ -792,3 +792,4 @@ displayHiddenConstructors() ==
squeezeAll: %List -> %List
squeezeAll x ==
[SQUEEZE t for t in x]
+
diff --git a/src/interp/debug.lisp b/src/interp/debug.lisp
index fbcdc575..a6cdc383 100644
--- a/src/interp/debug.lisp
+++ b/src/interp/debug.lisp
@@ -724,9 +724,9 @@ EXAMINE (SETQ RECNO (NOTE |$InputStream|))
(DEFUN MONITOR-BLANKS (N) (PRINC (MAKE-FULL-CVEC N " ") CURSTRM))
-(DEFUN MONITOR-EVALBEFORE (X) (EVALFUN (MONITOR-EVALTRAN X NIL)) X)
+(DEFUN MONITOR-EVALBEFORE (X) (EVAL (MONITOR-EVALTRAN X NIL)) X)
-(DEFUN MONITOR-EVALAFTER (X) (EVALFUN (MONITOR-EVALTRAN X 'T)))
+(DEFUN MONITOR-EVALAFTER (X) (EVAL (MONITOR-EVALTRAN X 'T)))
(DEFUN MONITOR-EVALTRAN (X FG)
(if (HAS_SHARP_VAR X) (MONITOR-EVALTRAN1 X FG) X))
@@ -810,7 +810,7 @@ EXAMINE (SETQ RECNO (NOTE |$InputStream|))
((PRINMATHOR0 X CURSTRM)))))))
(DEFUN MONITOR-PRINARGS-1 (L N)
- (COND ((OR (ATOM L) (LESSP N 1)) NIL)
+ (COND ((OR (ATOM L) (< N 1)) NIL)
((EQ N 1) (MONITOR-PRINT (CAR L) CURSTRM))
((MONITOR-PRINARGS-1 (CDR L) (1- N)))))
@@ -821,7 +821,7 @@ EXAMINE (SETQ RECNO (NOTE |$InputStream|))
(DEFUN PRINMATHOR0 (X CURSTRM)
(if |$mathTrace| (|maprinSpecial| (|outputTran| X) /DEPTH 80)
- (PRIN0 X CURSTRM)))
+ (PRIN1 X CURSTRM)))
(DEFUN SMALL-ENOUGH (X) (if /TRACESIZE (SMALL-ENOUGH-COUNT X 0 /TRACESIZE) t))
@@ -997,7 +997,7 @@ EXAMINE (SETQ RECNO (NOTE |$InputStream|))
(RPLACD NOT_TOP_LEVEL (1+ (CDR NOT_TOP_LEVEL))))
(SETQ FUNDEPTH (CDR (ASSOC NAMEID |depthAlist| :test #'eq)))
(SETQ CONDITION (MONITOR-EVALTRAN CONDITION NIL))
- (SETQ YES (EVALFUN CONDITION))
+ (SETQ YES (EVAL CONDITION))
(if (member NAMEID |$mathTraceList| :test #'eq)
(SETQ |$mathTrace| T))
(if (AND YES |$TraceFlag|)
@@ -1006,14 +1006,14 @@ EXAMINE (SETQ RECNO (NOTE |$InputStream|))
(if (EQUAL TRACECODE "000") (RETURN NIL))
(TAB 0 CURSTRM)
(MONITOR-BLANKS (1- /DEPTH))
- (PRIN0 FUNDEPTH CURSTRM)
+ (PRIN1 FUNDEPTH CURSTRM)
(|sayBrightlyNT| (LIST "<enter" '|%b|
NAME1 '|%d|) CURSTRM)
(COND ((EQ 0 C) NIL)
((EQ TYPE 'MACRO)
(PRINT " expanded" CURSTRM))
(T (PRINT " from " CURSTRM)
- (PRIN0 /CALLER CURSTRM)))
+ (PRIN1 /CALLER CURSTRM)))
(MONITOR-PRINARGS
(if (SPADSYSNAMEP NAME)
(NREVERSE (REVERSE (|coerceTraceArgs2E|
@@ -1029,7 +1029,7 @@ EXAMINE (SETQ RECNO (NOTE |$InputStream|))
(if (member '|before| BREAK :test #'eq)
(|break| (LIST "Break on entering" '|%b| NAME1 '|%d| ":")))
(if TIMERNAM (SETQ INIT_TIME (|startTimer|)))
- (SETQ /VALUE (if (EQ TYPE 'MACRO) (MDEFX FUNCT /ARGS)
+ (SETQ /VALUE (if (EQ TYPE 'MACRO) (MDEF FUNCT /ARGS)
(APPLY FUNCT /ARGS)))
(|stopTimer|)
(if TIMERNAM (SETQ EVAL_TIME (- (|clock|) INIT_TIME)) )
@@ -1041,7 +1041,7 @@ EXAMINE (SETQ RECNO (NOTE |$InputStream|))
(if (EQUAL TRACECODE "000") (GO SKIP))
(TAB 0 CURSTRM)
(MONITOR-BLANKS (1- /DEPTH))
- (PRIN0 FUNDEPTH CURSTRM)
+ (PRIN1 FUNDEPTH CURSTRM)
(|sayBrightlyNT| (LIST ">exit " '|%b| NAME1 '|%d|) CURSTRM)
(COND (TIMERNAM
(|sayBrightlyNT| '\( CURSTRM)
diff --git a/src/interp/define.boot b/src/interp/define.boot
index ee85d733..7fb4e2d4 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -33,9 +33,9 @@
import nruncomp
import g_-error
-import lisplib
-import cattable
+import database
import functor
+import modemap
namespace BOOT
diff --git a/src/interp/functor.boot b/src/interp/functor.boot
index 0d9db0d8..e77b50fa 100644
--- a/src/interp/functor.boot
+++ b/src/interp/functor.boot
@@ -32,8 +32,8 @@
-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-import c_-util
-import clam
+import lisplib
+import nrungo
import category
namespace BOOT
diff --git a/src/interp/g-cndata.boot b/src/interp/g-cndata.boot
index d6788b88..c0af28c2 100644
--- a/src/interp/g-cndata.boot
+++ b/src/interp/g-cndata.boot
@@ -112,7 +112,7 @@ getConstructorUnabbreviation op ==
abbreviation?(op) or throwKeyedMsg("S2IL0019",[op])
mkUserConstructorAbbreviation(c,a,type) ==
- if not atom c then c:= CAR c -- Existing constructors will be wrapped
+ if not atom c then c := first c -- Existing constructors will be wrapped
constructorAbbreviationErrorCheck(c,a,type,'abbreviationError)
clearClams()
clearConstructorCache(c)
@@ -135,10 +135,10 @@ constructorNameConflict(name,kind) ==
userError
["The name",:bright name,"conflicts with the name of an existing rule",
"%l","please choose another ",kind]
-
+
constructorAbbreviationErrorCheck(c,a,typ,errmess) ==
siz := SIZE (s := PNAME a)
- if typ = 'category and siz > 7
+ if typ = "category" and siz > 7
then throwKeyedErrorMsg('precompilation,"S2IL0021",NIL)
if siz > 8 then throwKeyedErrorMsg('precompilation,"S2IL0006",NIL)
if s ^= UPCASE s then throwKeyedMsg("S2IL0006",NIL)
diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot
index 8bf239fe..2a67c9c4 100644
--- a/src/interp/g-opt.boot
+++ b/src/interp/g-opt.boot
@@ -132,7 +132,7 @@ optSPADCALL(form is ['SPADCALL,:argl]) ==
null $InteractiveMode => form
-- last arg is function/env, but may be a form
argl is [:argl,fun] =>
- fun is ['ELT,dom,slot] or fun is ['LISPELT,dom,slot] =>
+ fun is ['ELT,dom,slot] =>
optCall ['call,['ELT,dom,slot],:argl]
form
form
@@ -338,7 +338,7 @@ optSETRECORDELT ["SETRECORDELT",name,ind,len,expr] ==
optRECORDCOPY ["RECORDCOPY",name,len] ==
len=1 => ["LIST",["CAR",name]]
len=2 => ["CONS",["CAR",name],["CDR",name]]
- ["MOVEVEC",["MAKE_-VEC",len],name]
+ ["REPLACE",["MAKE_-VEC",len],name]
--mkRecordAccessFunction(ind,len) ==
-- stringOfDs:= $EmptyString
diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot
index 1d0efd2a..39302d6b 100644
--- a/src/interp/g-util.boot
+++ b/src/interp/g-util.boot
@@ -69,7 +69,7 @@ mkList u ==
ELEMN(x, n, d) ==
null x => d
n = 1 => car x
- ELEMN(cdr x, SUB1 n, d)
+ ELEMN(cdr x, n-1, d)
PPtoFile(x, fname) ==
stream := DEFIOSTREAM([['MODE, :'OUTPUT], ['FILE, :fname]], 80, 0)
diff --git a/src/interp/guess.boot b/src/interp/guess.boot
index 1aeefc88..ccf9d9d2 100644
--- a/src/interp/guess.boot
+++ b/src/interp/guess.boot
@@ -69,13 +69,13 @@ wordsOfString(s) == [UPCASE x for x in wordsOfStringKeepCase s]
wordsOfStringKeepCase s == wordsOfString1(s,0) or [COPY s]
wordsOfString1(s,j) ==
- k := or/[i for i in j..SUB1(MAXINDEX(s)) | UPPER_-CASE_-P s.i] =>
+ k := or/[i for i in j..(MAXINDEX(s)-1) | UPPER_-CASE_-P s.i] =>
tailWords:=
UPPER_-CASE_-P s.(k+1) =>
- n:= or/[i for i in (k+2)..SUB1(MAXINDEX(s))|not UPPER_-CASE_-P s.i]
+ n:= or/[i for i in (k+2)..(MAXINDEX(s)-1)|not UPPER_-CASE_-P s.i]
null n => [SUBSTRING(s,k,nil)]
n > k+1 => [SUBSTRING(s,k,n-k-1),:wordsOfString1(s,n-1)]
- m := or/[i for i in (k+2)..SUB1(MAXINDEX(s)) | UPPER_-CASE_-P s.i] =>
+ m := or/[i for i in (k+2)..(MAXINDEX(s)-1) | UPPER_-CASE_-P s.i] =>
[SUBSTRING(s,k,m-k),:wordsOfString1(s,m)]
[SUBSTRING(s,k,nil)]
k > j+1 => [SUBSTRING(s,j,k-j),:tailWords]
diff --git a/src/interp/i-output.boot b/src/interp/i-output.boot
index be25b4ac..4d4841a1 100644
--- a/src/interp/i-output.boot
+++ b/src/interp/i-output.boot
@@ -1667,7 +1667,7 @@ printBasic x ==
x='(Zero) => PRIN1(0,$algebraOutputStream)
IDENTP x => PRINTEXP(PNAME x,$algebraOutputStream)
atom x => PRIN1(x,$algebraOutputStream)
- PRIN0(x,$algebraOutputStream)
+ PRIN1(x,$algebraOutputStream)
charybdis(u,start,linelength) ==
EQ(keyp u,'EQUATNUM) and ^(CDDR u) =>
diff --git a/src/interp/macros.lisp b/src/interp/macros.lisp
index 3426d93a..edb0b652 100644
--- a/src/interp/macros.lisp
+++ b/src/interp/macros.lisp
@@ -158,8 +158,6 @@
; 14.1 Simple Sequence Functions
-(define-function 'getchar #'elt)
-
(defun GETCHARN (A M) "Return the code of the Mth character of A"
(let ((a (if (identp a) (symbol-name a) a))) (char-code (elt A M))))
@@ -177,9 +175,6 @@
(defun NSTRCONC (s1 s2) (concatenate 'string (string s1) (string s2)))
-(define-function '|append| #'APPEND)
-
-
(defun THETACHECK (VAL VAR OP) (if (EQL VAL VAR) (THETA_ERROR OP) val))
; 15 LISTS
@@ -203,8 +198,6 @@
(define-function 'LASTTAIL #'last)
-(define-function 'LISPELT #'ELT)
-
(defun DROP (N X &aux m)
"Return a pointer to the Nth cons of X, counting 0 as the first cons."
(COND ((EQL N 0) X)
diff --git a/src/interp/nrungo.boot b/src/interp/nrungo.boot
index 2acad7a1..b2a2f263 100644
--- a/src/interp/nrungo.boot
+++ b/src/interp/nrungo.boot
@@ -345,10 +345,10 @@ NRTisRecurrenceRelation(op,body,minivectorName) ==
pcl := [x for x in pcl | not (x is [''T,:mess] and
(CONTAINED('throwMessage,mess) or
CONTAINED('throwKeyedMsg,mess)))]
- integer := EVALFUN $Integer
+ integer := eval $Integer
iequalSlot:=compiledLookupCheck("=",[$Boolean,"$","$"],integer)
lesspSlot:=compiledLookupCheck("<",[$Boolean,"$","$"],integer)
- notpSlot:= compiledLookupCheck("not",["$","$"],EVALFUN $Boolean)
+ notpSlot:= compiledLookupCheck("not",["$","$"],eval $Boolean)
for [p,c] in pcl repeat
p is ['SPADCALL,sharpVar,n1,['ELT,=minivectorName,slot]]
and EQ(iequalSlot,$minivector.slot) =>
diff --git a/src/interp/preparse.lisp b/src/interp/preparse.lisp
index 2b92469e..48a44d41 100644
--- a/src/interp/preparse.lisp
+++ b/src/interp/preparse.lisp
@@ -158,7 +158,7 @@
(SETQ A ""))
('T (PUSH (STRCONC (GETFULLSTR N " ")
(SUBSTRING A N ())) $LINELIST)
- (SETQ $INDEX (SUB1 $INDEX))
+ (SETQ $INDEX (1- $INDEX))
(SETQ A (SUBSEQ A 0 N))))
(GO NOCOMS))
((= N OPARSYM) (setq PCOUNT (1+ PCOUNT)))
diff --git a/src/interp/spad.lisp b/src/interp/spad.lisp
index a482848b..83283cfb 100644
--- a/src/interp/spad.lisp
+++ b/src/interp/spad.lisp
@@ -266,7 +266,6 @@
(if (zerop y) (truncate 1 Y)
(multiple-value-call #'cons (TRUNCATE X Y))))
-(define-function 'list1 #'list)
(define-function '|not| #'NOT)
(defun |random| () (random (expt 2 26)))
@@ -452,7 +451,7 @@
(DEFUN DECIMAL-LENGTH (X)
(LET* ((K (FIX (* #.(LOG 2.0 10.) (INTEGER-LENGTH X))))
(X (TRUNCATE (ABS X) (EXPT 10 (1- K)))))
- (IF (LESSP X 10) K (1+ K))))
+ (IF (< X 10) K (1+ K))))
;(DEFUN DECIMAL-LENGTH2 (X)
; (LET ((K (FIX (* #.(LOG 2.0 10.) (INTEGER-LENGTH X)))))
diff --git a/src/interp/sys-macros.lisp b/src/interp/sys-macros.lisp
index 920d71d0..b66eb7c5 100644
--- a/src/interp/sys-macros.lisp
+++ b/src/interp/sys-macros.lisp
@@ -220,12 +220,12 @@
invocation of FN"
(if (LT N 1)
NIL
- (CONS (EVAL FN) (NLIST (SUB1 N) FN))))
+ (CONS (EVAL FN) (NLIST (1- N) FN))))
(defun TAILFN (X N)
(if (LT N 1)
X
- (TAILFN (CDR X) (SUB1 N))))
+ (TAILFN (CDR X) (1- N))))
))
@@ -374,8 +374,6 @@
(defmacro SPADDIFFERENCE (&rest x)
`(- . ,x))
-(define-function 'QSEXPT #'expt)
-
;; following macros assume 0 <= x,y < z
(defmacro QSADDMOD (x y z)
@@ -882,7 +880,7 @@
(defun NREVERSE-N (X AXIS)
(COND ((EQL AXIS 0)
(NREVERSE X))
- ((MAPCAR #'(LAMBDA (Y) (NREVERSE-N Y (SUB1 AXIS))) X))))
+ ((MAPCAR #'(LAMBDA (Y) (NREVERSE-N Y (1- AXIS))) X))))
(defun REDUCE-1 (OP AXIS BOD)
diff --git a/src/interp/trace.boot b/src/interp/trace.boot
index 6d487e1f..e98991b5 100644
--- a/src/interp/trace.boot
+++ b/src/interp/trace.boot
@@ -589,7 +589,7 @@ letPrint(x,val,currentFunction) ==
if (y="all" or MEMQ(x,y)) and
not (IS__GENVAR(x) or isSharpVarWithNum(x) or GENSYMP x) then
sayBrightlyNT [:bright x,": "]
- PRIN0 shortenForPrinting val
+ PRIN1 shortenForPrinting val
TERPRI()
if (y:= hasPair("BREAK",y)) and
(y="all" or MEMQ(x,y) and
diff --git a/src/interp/types.boot b/src/interp/types.boot
index 66f3ce61..219b8d18 100644
--- a/src/interp/types.boot
+++ b/src/interp/types.boot
@@ -137,6 +137,6 @@ namespace BOOT
%Modemap <=> %List -- modemap
%ConstructorKind <=> -- kind of ctor instances
- MEMBER("category","domain","package")
+ MEMBER(category,domain,package)
%Shell <=> SIMPLE_-VECTOR -- constructor instantiation
diff --git a/src/interp/vmlisp.lisp b/src/interp/vmlisp.lisp
index d08e6001..f3b49f6a 100644
--- a/src/interp/vmlisp.lisp
+++ b/src/interp/vmlisp.lisp
@@ -511,10 +511,6 @@
(defmacro subrp (x)
`(compiled-function-p ,x))
-#-:CCL
-(defmacro sub1 (x)
- `(1- ,x))
-
(defmacro throw-protect (exp1 exp2)
`(unwind-protect ,exp1 ,exp2))
@@ -631,8 +627,6 @@
(declare (ignore sd))
(macroexpand `(,arg ,item)))
-(define-function 'MDEFX #'MDEF)
-
; 8.0 Operator Definition and Transformation
; 8.1 Definition and Transformation Operations
@@ -697,8 +691,6 @@
(t (cons (remove-fluids (car arglist))
(remove-fluids (cdr arglist))))))
-(define-function 'KOMPILE #'COMP370)
-
; 9.4 Vectors and Bpis
(defun IVECP (x) (and (vectorp x) (subtypep (array-element-type x) 'integer)))
@@ -826,25 +818,8 @@
(define-function 'FIX #'truncate)
(define-function 'INT2RNUM #'float)
-; 12.2 Predicates
-
-;(define-function 'lessp #'<)
-
-;(define-function 'greaterp #'>)
-
-
-;(define-function 'fixp #'integerp)
-
; 12.3 Computation
-;(define-function 'add1 #'1+)
-;(define-function 'sub1 #'1-)
-;(define-function 'plus #'+)
-;(define-function 'times #'*)
-;(define-function 'difference #'-)
-;(define-function 'minus #'-)
-;(define-function 'absval #'abs)
-
(defun QUOTIENT (x y)
(cond ((or (floatp x) (floatp y)) (/ x y))
(t (truncate x y))))
@@ -915,8 +890,6 @@
; 14.2 Accessing
-;(define-function 'lastnode #'last)
-;(define-function 'lastpair #'last)
(defun |last| (x) (car (lastpair x)))
; 14.3 Searching
@@ -997,8 +970,6 @@
; 16.2 Accessing
-;(define-function 'FETCHCHAR #'char)
-
;; Oddly, LENGTH is more efficient than LIST-LENGTH in CCL, since the former
;; is compiled and the latter is byte-coded!
(defun size (l)
@@ -1036,8 +1007,6 @@
(defun make-cvec (sint) (make-array sint :fill-pointer 0 :element-type 'character))
-;(define-function 'CVECP #'stringp)
-
(define-function 'getstr #'make-cvec)
(defun make-full-cvec (sint &optional (char #\space))
@@ -1114,8 +1083,6 @@
(defun setsize (vector size) (adjust-array vector size))
-(define-function 'changelength #'setsize)
-
(defun trimstring (x) x)
;;-- (defun rplacstr (cvec1 start1 length1 cvec2
@@ -1492,13 +1459,10 @@
; 24.0 Printing
-;(define-function 'prin2cvec #'write-to-string)
(define-function 'prin2cvec #'princ-to-string)
-;(define-function 'stringimage #'write-to-string)
(define-function 'stringimage #'princ-to-string)
(define-function 'printexp #'princ)
-(define-function 'prin0 #'prin1)
(defun |F,PRINT-ONE| (form &optional (stream |$OutputStream|))
(declare (ignore stream))
@@ -1780,10 +1744,6 @@
(defun CALLBELOW (&rest junk) junk) ; to invoke system dependent code?
-(define-function 'EVA1 #'eval) ;EVA1 and VMLISP EVAL make lexicals visible
-(define-function 'EVALFUN #'eval) ;EVALFUN drops lexicals before evaluating
-(define-function 'EVA1FUN #'EVALFUN)
-
(defun PLACEP (item) (eq item *read-place-holder*))
(defun VMREAD (&optional (st |$InputStream|) (eofval *read-place-holder*))
(read st nil eofval))
diff --git a/src/interp/word.boot b/src/interp/word.boot
index 95dfc7a1..dc298f5f 100644
--- a/src/interp/word.boot
+++ b/src/interp/word.boot
@@ -106,13 +106,13 @@ wordsOfString(s) == [UPCASE x for x in wordsOfStringKeepCase s]
wordsOfStringKeepCase s == wordsOfString1(s,0) or [COPY s]
wordsOfString1(s,j) ==
- k := or/[i for i in j..SUB1(MAXINDEX(s)) | isBreakCharacter s.i] =>
+ k := or/[i for i in j..(MAXINDEX(s)-1) | isBreakCharacter s.i] =>
tailWords:=
isBreakCharacter s.(k+1) =>
- n:= or/[i for i in (k+2)..SUB1(MAXINDEX(s))|not isBreakCharacter s.i]
+ n:= or/[i for i in (k+2)..(MAXINDEX(s)-1)|not isBreakCharacter s.i]
null n => [SUBSTRING(s,k,nil)]
n > k+1 => [SUBSTRING(s,k,n-k-1),:wordsOfString1(s,n-1)]
- m := or/[i for i in (k+2)..SUB1(MAXINDEX(s)) | isBreakCharacter s.i] =>
+ m := or/[i for i in (k+2)..(MAXINDEX(s)-1) | isBreakCharacter s.i] =>
[SUBSTRING(s,k,m-k),:wordsOfString1(s,m)]
[SUBSTRING(s,k,nil)]
k > j+1 => [SUBSTRING(s,j,k-j),:tailWords]
generated by cgit v1.2.3 (git 2.39.1) at 2024-07-03 06:58:17 +0000