aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/ChangeLog21
-rw-r--r--src/interp/Makefile.in2
-rw-r--r--src/interp/Makefile.pamphlet2
-rw-r--r--src/interp/br-search.boot2
-rw-r--r--src/interp/compiler.boot2
-rw-r--r--src/interp/debug.lisp42
-rw-r--r--src/interp/fname.lisp3
-rw-r--r--src/interp/i-output.boot44
-rw-r--r--src/interp/i-syscmd.boot2
-rw-r--r--src/interp/lisplib.boot2
-rw-r--r--src/interp/patches.lisp2
-rw-r--r--src/interp/setvart.boot2
-rw-r--r--src/interp/spad.lisp8
-rw-r--r--src/interp/sys-constants.boot5
-rw-r--r--src/interp/sys-globals.boot7
-rw-r--r--src/interp/sys-utility.boot2
-rw-r--r--src/interp/unlisp.lisp3
-rw-r--r--src/interp/vmlisp.lisp4
18 files changed, 79 insertions, 76 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index 2b52f1bb..b9c6a73d 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,26 @@
2008-02-15 Gabriel Dos Reis <gdr@cs.tamu.edu>
+ * interp/unlisp.lisp (|CatchAsCan|): Tidy.
+ * interp/sys-utility.boot (delete): Fix thinko.
+ * interp/sys-globals.boot ($sourceFiles): Define here.
+ (INPUTSTREAM): Likewise.
+ * interp/i-syscmd.boot (UNDERBAR): Move to sys-globals.boot.
+ * interp/fname.lisp: Import "macros".
+ * interp/debug.lisp: Import "parsing".
+ Replace $PRETTYPRINT with $PrettyPrint.
+ (/FN): Define.
+ (depthAlist): Likewise.
+ * interp/br-search.boot (docSearch1): Fix thinko.
+ * interp/Makefile.pamphlet (debug.$(FASLEXT)): Depend on
+ parsing.$(FASLEXT).
+ * interp/i-output.boot (starstarcond): Remove used function.
+ (transcomparg): Likewise.
+ (MATBORCH): Define here.
+ (*TALLPAR): Likewise.
+ * interp/vmlisp.lisp (|char|): Remove duplicate definition.
+
+2008-02-15 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
* boot/parser.boot (bpSimpleCatch): New.
(bTry): Use it.
* boot/strap: Update.
diff --git a/src/interp/Makefile.in b/src/interp/Makefile.in
index 1ccb76b5..cabc92d7 100644
--- a/src/interp/Makefile.in
+++ b/src/interp/Makefile.in
@@ -622,7 +622,7 @@ daase.$(FASLEXT): daase.lisp macros.$(FASLEXT) foam_l.$(FASLEXT)
spaderror.$(FASLEXT): spaderror.lisp macros.$(FASLEXT)
$(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
-debug.$(FASLEXT): debug.lisp macros.$(FASLEXT)
+debug.$(FASLEXT): debug.lisp macros.$(FASLEXT) parsing.$(FASLEXT)
$(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
spad.$(FASLEXT): spad.lisp bootlex.$(FASLEXT)
diff --git a/src/interp/Makefile.pamphlet b/src/interp/Makefile.pamphlet
index 23192b9c..6e4ff654 100644
--- a/src/interp/Makefile.pamphlet
+++ b/src/interp/Makefile.pamphlet
@@ -936,7 +936,7 @@ daase.$(FASLEXT): daase.lisp macros.$(FASLEXT) foam_l.$(FASLEXT)
spaderror.$(FASLEXT): spaderror.lisp macros.$(FASLEXT)
$(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
-debug.$(FASLEXT): debug.lisp macros.$(FASLEXT)
+debug.$(FASLEXT): debug.lisp macros.$(FASLEXT) parsing.$(FASLEXT)
$(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
spad.$(FASLEXT): spad.lisp bootlex.$(FASLEXT)
diff --git a/src/interp/br-search.boot b/src/interp/br-search.boot
index 55d449e5..3cc6fd86 100644
--- a/src/interp/br-search.boot
+++ b/src/interp/br-search.boot
@@ -562,7 +562,7 @@ docSearch1(filter,doc) ==
docSearchAlist := searchDropUnexposedLines doc
count := searchCount docSearchAlist
count = 0 => emptySearchPage('"entry",filter,true)
- count = 1 => showNamedConstruct(or/[x for x in docSearchAlist | CADR x],1)
+ count = 1 => showNamedConstruct(or/[x for x in docSearchAlist | CADR x])
prefix := pluralSay(count,'"entry matches",'"entries match")
emfilter := ['"{\em ",escapeSpecialChars STRINGIMAGE filter,'"}"]
header := [:prefix,'" ",:emfilter]
diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot
index 0a59bdcf..a215cbf9 100644
--- a/src/interp/compiler.boot
+++ b/src/interp/compiler.boot
@@ -1129,7 +1129,7 @@ compileNot(x,m,e) ==
-- do this special case here.
[xcode, xmode, xtrueEnv, xfalseEnv] := compBoolean(y, $Boolean, e)
or return nil
- convert([["NOT", xcode], $Boolean, xfalseEnv], m)
+ convert([["NOT", xcode], xmode, xfalseEnv], m)
--% Case
diff --git a/src/interp/debug.lisp b/src/interp/debug.lisp
index dbf35df7..8eeef9b1 100644
--- a/src/interp/debug.lisp
+++ b/src/interp/debug.lisp
@@ -44,6 +44,7 @@
; PURPOSE: Debugging hooks for Boot code
(import-module "macros")
+(import-module "parsing")
(in-package "BOOT")
(defvar S-SPADKEY NIL) ;" this is augmented by MAKESPADOP"
@@ -54,7 +55,7 @@
(DEFVAR CURSTRM *TERMINAL-IO*)
(DEFVAR /TRACELETNAMES ())
(DEFVAR /PRETTY () "controls pretty printing of trace output")
-(SETANDFILEQ /ECHO NIL) ;;"prevents echo of SPAD or BOOT code with /c"
+(defparameter /ECHO NIL) ;;"prevents echo of SPAD or BOOT code with /c"
(MAKEPROP 'LISP '/TERMCHR '(#\ #\())
(MAKEPROP 'LSP '/TERMCHR '(#\ #\())
(MAKEPROP 'META '/TERMCHR '(#\: #\())
@@ -99,6 +100,8 @@
(defun /COMP () (if (fboundp 'COMP) 'COMP 'COMP370))
+(defvar /fn nil)
+
(DEFUN /D-1 (L OP EFLG TFLG)
(CATCH 'FILENAM
(PROG (TO OPTIONL OPTIONS FNL INFILE OUTSTREAM FN )
@@ -280,7 +283,7 @@
(OR (KAR (KAR (KDR DEF))) NIL)
OP)
(COND
- ( (OR /ECHO $PRETTYPRINT)
+ ( (OR /ECHO $|PrettyPrint|)
(PRETTYPRINT DEF OUTPUTSTREAM) ) )
(COND
( (EQ oft 'LISP)
@@ -333,11 +336,15 @@ EXAMINE (SETQ RECNO (NOTE INPUTSTREAM))
(or (get type '/termchr) '(#\space ))))))))
(define-function '|/D,1| #'/D-1)
+
+(defvar /UPDATESTREAM nil)
+
(DEFUN /INITUPDATES (/VERSION)
- (SETQ FILENAME (STRINGIMAGE /VERSION))
- (SETQ /UPDATESTREAM (open (strconc "/tmp/update." FILENAME) :direction :output
- :if-exists :append :if-does-not-exist :create))
+ (LET ((FILENAME (STRINGIMAGE /VERSION)))
+ (SETQ /UPDATESTREAM (open (strconc "/tmp/update." FILENAME)
+ :direction :output
+ :if-exists :append :if-does-not-exist :create)))
(PRINTEXP
" Function Name Filename Date Time"
/UPDATESTREAM)
@@ -388,7 +395,7 @@ EXAMINE (SETQ RECNO (NOTE INPUTSTREAM))
;;;If A disk is not read-write, then issue msg and return.
;;;If /UPDATESTREAM not set or current /UPDATES file doesnt exist, initialize.
- (PROG (IFT KEY RECNO ORECNO DATE TIME)
+ (PROG (IFT KEY RECNO ORECNO DATE TIME DATETIME)
; (if (EQ 0 /VERSION) (RETURN NIL))
(if (EQ 'INPUT FT) (RETURN NIL))
(if (NOT |$createUpdateFiles|) (RETURN NIL))
@@ -468,7 +475,8 @@ EXAMINE (SETQ RECNO (NOTE INPUTSTREAM))
(PROG (U FNVAL COUNTNAM TRACECODE BEFORE AFTER CONDITION
TRACENAME CALLER VARS BREAK FROM_CONDITION VARBREAK TIMERNAM
ONLYS G WITHIN_CONDITION DEPTH_CONDITION COUNT_CONDITION
- LETFUNCODE MATHTRACE )
+ LETFUNCODE MATHTRACE |$traceNoisely|)
+ (declare (special |$traceNoisely|))
(if (member FN /TRACENAMES :test #'eq) (/UNTRACE-2 FN NIL))
(SETQ OPTIONS (OPTIONS2UC OPTIONS))
(if (AND |$traceDomains| (|isFunctor| FN) (ATOM FN))
@@ -655,7 +663,8 @@ EXAMINE (SETQ RECNO (NOTE INPUTSTREAM))
(DEFUN /UNTRACE-REDUCE (X) (if (ATOM X) X (first X))) ; (CAR X) is now a domain
(DEFUN /UNTRACE-2 (X OPTIONS)
- (let (u y)
+ (let (u y |$traceNoisely|)
+ (declare (special |$traceNoisely|))
(COND ((AND (|isFunctor| X) (ATOM X))
(|untraceDomainConstructor| X))
((OR (|isDomainOrPackage| (SETQ U X))
@@ -744,6 +753,8 @@ EXAMINE (SETQ RECNO (NOTE INPUTSTREAM))
(INTEGERP (parse-integer (symbol-name X) :start 1))))
(DEFUN MONITOR-GETVALUE (N FG)
+ (PROG (/VALUE /caller /args /name)
+ (declare (special /value /caller /args /name))
(COND ((= N 0)
(if FG
(MKQ /VALUE)
@@ -751,7 +762,7 @@ EXAMINE (SETQ RECNO (NOTE INPUTSTREAM))
((= N 9) (MKQ /CALLER))
((<= N (SIZE /ARGS)) (MKQ (ELT /ARGS (1- N))))
((|spadThrowBrightly| (LIST 'function '|%b| /NAME '|%d|
- "does not have" '|%b| N '|%d| "arguments")))))
+ "does not have" '|%b| N '|%d| "arguments"))))))
(DEFUN MONITOR-PRINARGS (L CODE /TRANSFORM)
(let (N)
@@ -953,6 +964,7 @@ EXAMINE (SETQ RECNO (NOTE INPUTSTREAM))
(RETURN G1)))
(defvar |$TraceFlag| t)
+(defvar |depthAlist| nil)
(defun /MONITORX (/ARGS FUNCT OPTS &AUX NAME TYPE TRACECODE COUNTNAM TIMERNAM
BEFORE AFTER CONDITION BREAK TRACEDMODEMAP
@@ -1072,12 +1084,12 @@ EXAMINE (SETQ RECNO (NOTE INPUTSTREAM))
(RPLACA PAIR (BPITRACE (CAR PAIR) ALIAS )) NIL)
(defun BPITRACE (BPI ALIAS &optional OPTIONS)
- (SETQ NEWNAME (GENSYM))
- (IF (identp bpi) (setq bpi (symbol-function bpi)))
- (SET NEWNAME BPI)
- (SETF (symbol-function NEWNAME) BPI)
- (/TRACE-0 (APPEND (LIST NEWNAME (LIST 'ALIAS ALIAS)) OPTIONS))
- NEWNAME)
+ (let ((NEWNAME (GENSYM)))
+ (IF (identp bpi) (setq bpi (symbol-function bpi)))
+ (SET NEWNAME BPI)
+ (SETF (symbol-function NEWNAME) BPI)
+ (/TRACE-0 (APPEND (LIST NEWNAME (LIST 'ALIAS ALIAS)) OPTIONS))
+ NEWNAME))
(defun BPIUNTRACE (X ALIAS) (/UNTRACE-0 (LIST X (LIST 'ALIAS ALIAS))))
diff --git a/src/interp/fname.lisp b/src/interp/fname.lisp
index 926aba92..a3c622d5 100644
--- a/src/interp/fname.lisp
+++ b/src/interp/fname.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
@@ -38,6 +38,7 @@
;; Created: June 20, 1991 (Stephen Watt)
;;
+(import-module "macros")
(in-package "BOOT")
;; E.g. "/" "/u/smwatt" "../src"
diff --git a/src/interp/i-output.boot b/src/interp/i-output.boot
index b9f6e3d4..52073696 100644
--- a/src/interp/i-output.boot
+++ b/src/interp/i-output.boot
@@ -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
@@ -208,6 +208,11 @@ $specialCharacterAlist == '(
(bslash . 16)_
)
+
+MATBORCH == '"*"
+
+_*TALLPAR := false
+
$collectOutput := nil
$algebraOutputStream :=
@@ -1850,20 +1855,6 @@ appsub(u, x, y, d) ==
temparg3 := APP(CADR u, x, y, d)
appagg(CDDR u, temparg1, temparg2, temparg3)
-starstarcond(l, iforwhen) ==
- null l => l
- EQ((a := CAAR l), 1) =>
- LIST('CONCAT, CADR first l, '" OTHERWISE")
- EQCAR(a, 'COMPARG) =>
- starstarcond(CONS(transcomparg(CADR a), rest l), iforwhen)
- null rest l =>
- LIST('CONCAT, CADR first l,
- LIST('CONCAT, iforwhen, CAAR l))
- true => LIST('VCONCAT,
- starstarcond(CONS(first l, nil), iforwhen),
- LIST('VCONCAT, '" ",
- starstarcond(rest l, iforwhen)))
-
eq0(u) == 0
height(u) ==
@@ -1992,7 +1983,6 @@ boxLApp(u, x, y, d) ==
a := superspan u.1+1
b := subspan u.1+1
w := MAX(lw, 2 + WIDTH u.1)
- -- next line used to have h instead of lh
top := y + a + lh
d := appvertline(MATBORCH, x, y - b, top, d)
d := appHorizLine(x + 1, x + w, top, d)
@@ -2001,7 +1991,7 @@ boxLApp(u, x, y, d) ==
nil or
lw < w => d := appvertline(MATBORCH, x + lw + 1, y + a, top - 1, d)
d := APP(u.1, 2 + x, y, d)
- d := appHorizLine(x + 1, x + w, y - b, top, d)
+ d := appHorizLine(x + 1, x + w, y - b, d)
d := appvertline(MATBORCH, x + w + 1, y - b, top, d)
boxSub(x) ==
@@ -2357,26 +2347,6 @@ superSubSuper u ==
suScWidth u ==
WIDTH u.1 + aggwidth CDDR u
-transcomparg(x) ==
- y := first x
- args := first _*NTH(STANDARGLIST, 1 + LENGTH y)
- repeat
- if true then
- null y => return(nil)
- (atom first y) and member(first y, FRLIS_*) =>
- conds := CONS(LIST('EQUAL1, first args, first y), conds)
- y := SUBST(first args, first y, y)
- x := SUBST(first args, first y, x)
- (first y = first args) => nil
- true => conds := CONS(LIST('EQUAL1, first args, first y), conds)
- y := rest y
- args := rest args
- conds :=
- null conds => rest CADR x
- ANDSIMP(CONS('AND, APPEND(REVERSEWOC conds,
- LIST(rest CADR x) ) ) )
- LIST((conds => conds; true => 1), CADR rest x)
-
vconcatapp(u, x, y, d) ==
w := vConcatWidth u
y := y + superspan u.1 + 1
diff --git a/src/interp/i-syscmd.boot b/src/interp/i-syscmd.boot
index c738fda3..6a942e06 100644
--- a/src/interp/i-syscmd.boot
+++ b/src/interp/i-syscmd.boot
@@ -46,8 +46,6 @@ $existingFiles := MAKE_-HASHTABLE "UEQUAL"
$SYSCOMMANDS := [CAR x for x in $systemCommands]
-UNDERBAR == '"__"
-
$NonNullStream ==
'"NonNullStream"
diff --git a/src/interp/lisplib.boot b/src/interp/lisplib.boot
index 8f46262c..5c75ede6 100644
--- a/src/interp/lisplib.boot
+++ b/src/interp/lisplib.boot
@@ -277,7 +277,7 @@ compileConstructorLib(l,op,editFlag,traceFlag) ==
res
compConLib1(fun,infileOrNil,outfileOrNil,auxOp,editFlag,traceFlag) ==
- $PRETTYPRINT: local := 'T
+ $PrettyPrint: local := 'T
$LISPLIB: local := 'T
$lisplibAttributes: local := NIL
$lisplibPredicates: local := NIL
diff --git a/src/interp/patches.lisp b/src/interp/patches.lisp
index 8a882005..5bce910d 100644
--- a/src/interp/patches.lisp
+++ b/src/interp/patches.lisp
@@ -176,8 +176,6 @@
(READSPADEXPR))
(t (|parseTransform| (|postTransform| (|string2SpadTree| line)))))))
-(setq |$sourceFiles| ()) ;; set in readSpad2Cmd
-
(define-function 'SUBSTQ #'SUBSTEQ) ;; needed for substNames (always copy)
#+(and :lucid (not :ibm/370))
(define-function 'RUN-AIX-PROGRAM #'SYS:RUN-AIX-PROGRAM)
diff --git a/src/interp/setvart.boot b/src/interp/setvart.boot
index 2ddc7bcf..e2c3ca28 100644
--- a/src/interp/setvart.boot
+++ b/src/interp/setvart.boot
@@ -1639,7 +1639,7 @@ $setOptions := '(
"prettyprint BOOT func's as they compile"
development
LITERALS
- $PRETTYPRINT
+ $PrettyPrint
(on off)
off)
))
diff --git a/src/interp/spad.lisp b/src/interp/spad.lisp
index e8ceeec2..21b3d8b8 100644
--- a/src/interp/spad.lisp
+++ b/src/interp/spad.lisp
@@ -71,8 +71,6 @@
(defvar |$HiFiAccess| nil "if true maintain history file")
(defvar |$mapReturnTypes| nil)
-(defvar INPUTSTREAM t "bogus initialization for now")
-
(defvar |boot-NewKEY| NIL)
(DEFVAR _ '&)
@@ -386,7 +384,9 @@
(REMFLAG |boot-NewKEY| 'KEY)
INPUTSTREAM))
-(defun INITIALIZE () (init-boot/spad-reader) (initialize-preparse INPUTSTREAM))
+(defun INITIALIZE ()
+ (init-boot/spad-reader)
+ (initialize-preparse INPUTSTREAM))
(setq *prompt* 'new)
@@ -456,7 +456,6 @@
(return TERMTOK)))
; **** X. Random tables
-(defvar MATBORCH "*")
(defvar $MARGIN 3)
(defvar TEMPGENSYMLIST '(|s| |r| |q| |p|))
(defvar ALPHLIST '(|a| |b| |c| |d| |e| |f| |g|))
@@ -467,7 +466,6 @@
(defvar INITPARLST '(|x| |y| |z| |u| |v| |w| |r| |s| |t|))
(defvar LITTLEA '|a|)
(defvar LITTLEI '|i|)
-(defvar *TALLPAR NIL)
(defvar ALLSTAR NIL)
(defvar PLUSS "+")
(defvar PERIOD ".")
diff --git a/src/interp/sys-constants.boot b/src/interp/sys-constants.boot
index 0f008f5a..5a9196ec 100644
--- a/src/interp/sys-constants.boot
+++ b/src/interp/sys-constants.boot
@@ -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
@@ -629,3 +629,6 @@ _*ATTRIBUTES_* ==
+++
BLANK == '" "
+
+++
+UNDERBAR == '"__"
diff --git a/src/interp/sys-globals.boot b/src/interp/sys-globals.boot
index eb642e79..4d326287 100644
--- a/src/interp/sys-globals.boot
+++ b/src/interp/sys-globals.boot
@@ -442,3 +442,10 @@ $useRepresentationHack := true
++
$insideCanCoerceFrom := nil
+
+++
+$sourceFiles := []
+
+++ ??? bogus initialization for now
+INPUTSTREAM := "T"
+
diff --git a/src/interp/sys-utility.boot b/src/interp/sys-utility.boot
index ab20480b..faf4708d 100644
--- a/src/interp/sys-utility.boot
+++ b/src/interp/sys-utility.boot
@@ -53,7 +53,7 @@ delete(item,sequence) ==
SYMBOLP item =>
REMOVE(item,sequence,KEYWORD::TEST,function EQ)
atom item and not ARRAYP item =>
- REMOVE(item,SEQUENCE)
+ REMOVE(item,sequence)
REMOVE(item,sequence,KEYWORD::TEST,function EQUALP)
++ returns true if `x' is contained in `y'.
diff --git a/src/interp/unlisp.lisp b/src/interp/unlisp.lisp
index fcef6fd0..146a27ce 100644
--- a/src/interp/unlisp.lisp
+++ b/src/interp/unlisp.lisp
@@ -66,8 +66,7 @@
#-:Lucid
(defmacro |CatchAsCan| (tagvar expr)
- `(progn
- (setq ,tagvar nil)
+ `(let ((,tagvar nil))
,expr ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
diff --git a/src/interp/vmlisp.lisp b/src/interp/vmlisp.lisp
index b70d317e..4be165ea 100644
--- a/src/interp/vmlisp.lisp
+++ b/src/interp/vmlisp.lisp
@@ -101,10 +101,6 @@
#+:CCL
(defun bintp (n) (and (integerp n) (not (fixp n))))
-(defmacro |char| (x)
- (if (and (consp x) (eq (car x) 'quote)) (character (cadr x))
- `(character ,x)))
-
(defmacro closedfn (form)
`(function ,form))
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-28 06:21:16 +0000