diff options
| -rw-r--r-- | src/ChangeLog | 12 | ||||
| -rw-r--r-- | src/interp/fortcall.boot | 8 | ||||
| -rw-r--r-- | src/interp/i-analy.boot | 2 | ||||
| -rw-r--r-- | src/interp/i-output.boot | 182 | ||||
| -rw-r--r-- | src/interp/i-util.boot | 12 | ||||
| -rw-r--r-- | src/interp/setvars.boot | 4 | ||||
| -rw-r--r-- | src/interp/vmlisp.lisp | 14 |
7 files changed, 116 insertions, 118 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index bedb47dd..af3a87e1 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,15 @@ +2012-04-30 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * interp/fortcall.boot: Use copyTree, not COPY-TREE. + * interp/i-intern.boot: Likewise. + * interp/setvars.boot: Likewise. + * interp/i-output.boot: Use abstractChar, not EBCDIC. + * interp/i-util.boot: Likewise. + * interp/vmlisp.lisp (EBCDIC): Remove. + (CALLBELOW): Likewise. + (RE-ENABLE-INT): Likewise. + (QUOREM): Likewise. + 2012-04-29 Gabriel Dos Reis <gdr@cs.tamu.edu> * lisp/core.lisp.in (fixnum?): New. 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))) |