aboutsummaryrefslogtreecommitdiff
path: root/src/interp
diff options
context:
space:
mode:
Diffstat (limited to 'src/interp')
-rw-r--r--src/interp/fortcall.boot8
-rw-r--r--src/interp/i-analy.boot2
-rw-r--r--src/interp/i-output.boot182
-rw-r--r--src/interp/i-util.boot12
-rw-r--r--src/interp/setvars.boot4
-rw-r--r--src/interp/vmlisp.lisp14
6 files changed, 104 insertions, 118 deletions
diff --git a/src/interp/fortcall.boot b/src/interp/fortcall.boot
index a5907f06..849def4f 100644
--- a/src/interp/fortcall.boot
+++ b/src/interp/fortcall.boot
@@ -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
@@ -750,7 +750,7 @@ multiToUnivariate f ==
vars := CDADR f -- throw away '%Comma at start of variable list
else
vars := [second f]
- body := COPY_-TREE third f
+ body := copyTree third f
newVariable := gensym()
for index in 0..#vars-1 repeat
-- Remember that AXIOM lists, vectors etc are indexed from 1
@@ -769,7 +769,7 @@ functionAndJacobian f ==
vars := [second f]
#(vars) ~= #(CDADDR f) =>
error "number of variables should equal number of functions"
- funBodies := COPY_-TREE CDADDR f
+ funBodies := copyTree CDADDR f
jacBodies := [:[DF(f,v) for v in vars] for f in funBodies] where
DF(fn,var) ==
["@",["convert",["differentiate",fn,var]],"InputForm"]
@@ -795,7 +795,7 @@ vectorOfFunctions f ==
vars := CDADR f -- throw away '%Comma at start of variable list
else
vars := [second f]
- funBodies := COPY_-TREE CDADDR f
+ funBodies := copyTree CDADDR f
newVariable := gensym()
for index in 0..#vars-1 repeat
-- Remember that AXIOM lists, vectors etc are indexed from 1
diff --git a/src/interp/i-analy.boot b/src/interp/i-analy.boot
index c54043c5..862f4212 100644
--- a/src/interp/i-analy.boot
+++ b/src/interp/i-analy.boot
@@ -757,7 +757,7 @@ bottomUpFormRetract(t,op,opName,argl,amsl) ==
ms := [m, :ms]
b:= true
m.first := objMode(object)
- ms := [COPY_-TREE m, :ms]
+ ms := [copyTree m, :ms]
putAtree(x,'retracted,true)
putValue(x,object)
putModeSet(x,[objMode(object)])
diff --git a/src/interp/i-output.boot b/src/interp/i-output.boot
index 497e9ae1..2ec7b3b1 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-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
@@ -46,103 +46,103 @@ namespace BOOT
--% Output display routines
$defaultSpecialCharacters == [
- EBCDIC( 28), -- upper left corner
- EBCDIC( 27), -- upper right corner
- EBCDIC( 30), -- lower left corner
- EBCDIC( 31), -- lower right corner
- EBCDIC( 79), -- vertical bar
- EBCDIC( 45), -- horizontal bar
- EBCDIC(144), -- APL quad
- EBCDIC(173), -- left bracket
- EBCDIC(189), -- right bracket
- EBCDIC(192), -- left brace
- EBCDIC(208), -- right brace
- EBCDIC( 59), -- top box tee
- EBCDIC( 62), -- bottom box tee
- EBCDIC( 63), -- right box tee
- EBCDIC( 61), -- left box tee
- EBCDIC( 44), -- center box tee
- EBCDIC(224) -- back slash
+ abstractChar( 28), -- upper left corner
+ abstractChar( 27), -- upper right corner
+ abstractChar( 30), -- lower left corner
+ abstractChar( 31), -- lower right corner
+ abstractChar( 79), -- vertical bar
+ abstractChar( 45), -- horizontal bar
+ abstractChar(144), -- APL quad
+ abstractChar(173), -- left bracket
+ abstractChar(189), -- right bracket
+ abstractChar(192), -- left brace
+ abstractChar(208), -- right brace
+ abstractChar( 59), -- top box tee
+ abstractChar( 62), -- bottom box tee
+ abstractChar( 63), -- right box tee
+ abstractChar( 61), -- left box tee
+ abstractChar( 44), -- center box tee
+ abstractChar(224) -- back slash
]
$plainSpecialCharacters0 == [
- EBCDIC( 78), -- upper left corner (+)
- EBCDIC( 78), -- upper right corner (+)
- EBCDIC( 78), -- lower left corner (+)
- EBCDIC( 78), -- lower right corner (+)
- EBCDIC( 79), -- vertical bar
- EBCDIC( 96), -- horizontal bar (-)
- EBCDIC(111), -- APL quad (?)
- EBCDIC(173), -- left bracket
- EBCDIC(189), -- right bracket
- EBCDIC(192), -- left brace
- EBCDIC(208), -- right brace
- EBCDIC( 78), -- top box tee (+)
- EBCDIC( 78), -- bottom box tee (+)
- EBCDIC( 78), -- right box tee (+)
- EBCDIC( 78), -- left box tee (+)
- EBCDIC( 78), -- center box tee (+)
- EBCDIC(224) -- back slash
+ abstractChar( 78), -- upper left corner (+)
+ abstractChar( 78), -- upper right corner (+)
+ abstractChar( 78), -- lower left corner (+)
+ abstractChar( 78), -- lower right corner (+)
+ abstractChar( 79), -- vertical bar
+ abstractChar( 96), -- horizontal bar (-)
+ abstractChar(111), -- APL quad (?)
+ abstractChar(173), -- left bracket
+ abstractChar(189), -- right bracket
+ abstractChar(192), -- left brace
+ abstractChar(208), -- right brace
+ abstractChar( 78), -- top box tee (+)
+ abstractChar( 78), -- bottom box tee (+)
+ abstractChar( 78), -- right box tee (+)
+ abstractChar( 78), -- left box tee (+)
+ abstractChar( 78), -- center box tee (+)
+ abstractChar(224) -- back slash
]
$plainSpecialCharacters1 == [
- EBCDIC(107), -- upper left corner (,)
- EBCDIC(107), -- upper right corner (,)
- EBCDIC(125), -- lower left corner (')
- EBCDIC(125), -- lower right corner (')
- EBCDIC( 79), -- vertical bar
- EBCDIC( 96), -- horizontal bar (-)
- EBCDIC(111), -- APL quad (?)
- EBCDIC(173), -- left bracket
- EBCDIC(189), -- right bracket
- EBCDIC(192), -- left brace
- EBCDIC(208), -- right brace
- EBCDIC( 78), -- top box tee (+)
- EBCDIC( 78), -- bottom box tee (+)
- EBCDIC( 78), -- right box tee (+)
- EBCDIC( 78), -- left box tee (+)
- EBCDIC( 78), -- center box tee (+)
- EBCDIC(224) -- back slash
+ abstractChar(107), -- upper left corner (,)
+ abstractChar(107), -- upper right corner (,)
+ abstractChar(125), -- lower left corner (')
+ abstractChar(125), -- lower right corner (')
+ abstractChar( 79), -- vertical bar
+ abstractChar( 96), -- horizontal bar (-)
+ abstractChar(111), -- APL quad (?)
+ abstractChar(173), -- left bracket
+ abstractChar(189), -- right bracket
+ abstractChar(192), -- left brace
+ abstractChar(208), -- right brace
+ abstractChar( 78), -- top box tee (+)
+ abstractChar( 78), -- bottom box tee (+)
+ abstractChar( 78), -- right box tee (+)
+ abstractChar( 78), -- left box tee (+)
+ abstractChar( 78), -- center box tee (+)
+ abstractChar(224) -- back slash
]
$plainSpecialCharacters2 == [
- EBCDIC( 79), -- upper left corner (|)
- EBCDIC( 79), -- upper right corner (|)
- EBCDIC( 79), -- lower left corner (|)
- EBCDIC( 79), -- lower right corner (|)
- EBCDIC( 79), -- vertical bar
- EBCDIC( 96), -- horizontal bar (-)
- EBCDIC(111), -- APL quad (?)
- EBCDIC(173), -- left bracket
- EBCDIC(189), -- right bracket
- EBCDIC(192), -- left brace
- EBCDIC(208), -- right brace
- EBCDIC( 78), -- top box tee (+)
- EBCDIC( 78), -- bottom box tee (+)
- EBCDIC( 78), -- right box tee (+)
- EBCDIC( 78), -- left box tee (+)
- EBCDIC( 78), -- center box tee (+)
- EBCDIC(224) -- back slash
+ abstractChar( 79), -- upper left corner (|)
+ abstractChar( 79), -- upper right corner (|)
+ abstractChar( 79), -- lower left corner (|)
+ abstractChar( 79), -- lower right corner (|)
+ abstractChar( 79), -- vertical bar
+ abstractChar( 96), -- horizontal bar (-)
+ abstractChar(111), -- APL quad (?)
+ abstractChar(173), -- left bracket
+ abstractChar(189), -- right bracket
+ abstractChar(192), -- left brace
+ abstractChar(208), -- right brace
+ abstractChar( 78), -- top box tee (+)
+ abstractChar( 78), -- bottom box tee (+)
+ abstractChar( 78), -- right box tee (+)
+ abstractChar( 78), -- left box tee (+)
+ abstractChar( 78), -- center box tee (+)
+ abstractChar(224) -- back slash
]
$plainSpecialCharacters3 == [
- EBCDIC( 96), -- upper left corner (-)
- EBCDIC( 96), -- upper right corner (-)
- EBCDIC( 96), -- lower left corner (-)
- EBCDIC( 96), -- lower right corner (-)
- EBCDIC( 79), -- vertical bar
- EBCDIC( 96), -- horizontal bar (-)
- EBCDIC(111), -- APL quad (?)
- EBCDIC(173), -- left bracket
- EBCDIC(189), -- right bracket
- EBCDIC(192), -- left brace
- EBCDIC(208), -- right brace
- EBCDIC( 78), -- top box tee (+)
- EBCDIC( 78), -- bottom box tee (+)
- EBCDIC( 78), -- right box tee (+)
- EBCDIC( 78), -- left box tee (+)
- EBCDIC( 78), -- center box tee (+)
- EBCDIC(224) -- back slash
+ abstractChar( 96), -- upper left corner (-)
+ abstractChar( 96), -- upper right corner (-)
+ abstractChar( 96), -- lower left corner (-)
+ abstractChar( 96), -- lower right corner (-)
+ abstractChar( 79), -- vertical bar
+ abstractChar( 96), -- horizontal bar (-)
+ abstractChar(111), -- APL quad (?)
+ abstractChar(173), -- left bracket
+ abstractChar(189), -- right bracket
+ abstractChar(192), -- left brace
+ abstractChar(208), -- right brace
+ abstractChar( 78), -- top box tee (+)
+ abstractChar( 78), -- bottom box tee (+)
+ abstractChar( 78), -- right box tee (+)
+ abstractChar( 78), -- left box tee (+)
+ abstractChar( 78), -- center box tee (+)
+ abstractChar(224) -- back slash
]
$plainRTspecialCharacters == [
@@ -462,7 +462,7 @@ newlineIfDisplaying() ==
specialChar(symbol) ==
-- looks up symbol in $specialCharacterAlist, gets the index
- -- into the EBCDIC table, and returns the appropriate character
+ -- into the abstractChar table, and returns the appropriate character
null (code := IFCDR objectAssoc(symbol,$specialCharacterAlist)) => '"?"
$specialCharacters.code
@@ -529,12 +529,12 @@ appChar(string,x,y,d) ==
if maxIndex string = 1 and stringChar(string,0) = char "%" then
stringChar(string,1) = char "b" =>
bumpDeltaIfTrue:= true
- stringChar(string,0) := EBCDIC 29
- stringChar(string,1) := EBCDIC 200
+ stringChar(string,0) := abstractChar 29
+ stringChar(string,1) := abstractChar 200
stringChar(string,1) = char "d" =>
bumpDeltaIfTrue:= true
- stringChar(string,0) := EBCDIC 29
- stringChar(string,1) := EBCDIC 65
+ stringChar(string,0) := abstractChar 29
+ stringChar(string,1) := abstractChar 65
shiftedX:= (y=0 => x+$highlightDelta; x)
--shift x for brightening characters -- presently only if y=0
RPLACSTR(line,shiftedX,n:=#string,string,0,n)
diff --git a/src/interp/i-util.boot b/src/interp/i-util.boot
index 4f29b071..d635f34d 100644
--- a/src/interp/i-util.boot
+++ b/src/interp/i-util.boot
@@ -45,18 +45,18 @@ inputPrompt str ==
p := first(x) - 2
y := $OLDLINE
SETQ($OLDLINE,nil)
- y => _$SHOWLINE(strconc(str,EBCDIC 19,y),p)
+ y => _$SHOWLINE(strconc(str,abstractChar 19,y),p)
0 = # str => nil
- _$SHOWLINE(strconc(str,EBCDIC 19),p)
+ _$SHOWLINE(strconc(str,abstractChar 19),p)
protectedPrompt(:p) ==
[str,:br] := p
0 = # str => inputPrompt str
- msg := EBCDIC 29 -- start of field
+ msg := abstractChar 29 -- start of field
msg :=
- if br then strconc(msg,EBCDIC 232) -- bright write protect
- else strconc(msg,EBCDIC 96) -- write protect
- msg := strconc(msg,str,EBCDIC 29,EBCDIC 64) -- unprotect again
+ if br then strconc(msg,abstractChar 232) -- bright write protect
+ else strconc(msg,abstractChar 96) -- write protect
+ msg := strconc(msg,str,abstractChar 29,abstractChar 64) -- unprotect again
inputPrompt msg
MKPROMPT() ==
diff --git a/src/interp/setvars.boot b/src/interp/setvars.boot
index 1907a738..f3be891c 100644
--- a/src/interp/setvars.boot
+++ b/src/interp/setvars.boot
@@ -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
@@ -149,7 +149,7 @@ resetWorkspaceVariables() ==
SETQ($functionTable , nil)
SETQ($echoLineStack , nil)
SETQ($slamFlag , nil)
- SETQ($CommandSynonymAlist , COPY($InitialCommandSynonymAlist))
+ SETQ($CommandSynonymAlist , copyTree($InitialCommandSynonymAlist))
SETQ($UserAbbreviationsAlist , nil)
SETQ($msgDatabase , nil)
SETQ($msgDatabaseName , nil)
diff --git a/src/interp/vmlisp.lisp b/src/interp/vmlisp.lisp
index 059994da..017b42ed 100644
--- a/src/interp/vmlisp.lisp
+++ b/src/interp/vmlisp.lisp
@@ -1293,10 +1293,6 @@
(defun $screensize () '(24 80)) ; You tell me!!
-; 97.0 Stuff In The Manual But Wierdly Documented
-
-(defun EBCDIC (x) (code-char x))
-
;; This isn't really compatible but is as close as you can get in common lisp
;; In place of ((one-of 1 2 3) l) you should use
;; (funcall (one-of 1 2 3) l)
@@ -1385,8 +1381,6 @@
(defun LAM\,FILEACTQ (name form)
(if *FILEACTQ-APPLY* (FUNCALL *FILEACTQ-APPLY* name form)))
-(defun CALLBELOW (&rest junk) junk) ; to invoke system dependent code?
-
(defun PLACEP (item) (eq item *read-place-holder*))
(defun VMREAD (&optional (st |$InputStream|) (eofval *read-place-holder*))
(read st nil eofval))
@@ -1426,11 +1420,3 @@
(function-lambda-expression func)
(declare (ignore l c))
n)))
-
-
-(defun RE-ENABLE-INT (number-of-handler) number-of-handler)
-
-
-(defun QUOREM (i j r) ; never used, refed in parini.boot
- (multiple-value-bind (x y) (truncate i j)
- (rplaca (the cons r) x) (rplacd (the cons r) y)))
generated by cgit v1.2.3 (git 2.39.1) at 2024-07-01 16:12:06 +0000