aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/interp/cfuns.lisp1
-rw-r--r--src/interp/comp.lisp2
-rw-r--r--src/interp/debug.lisp95
-rw-r--r--src/interp/foam_l.lisp29
4 files changed, 24 insertions, 103 deletions
diff --git a/src/interp/cfuns.lisp b/src/interp/cfuns.lisp
index c9e33696..03fcdb0d 100644
--- a/src/interp/cfuns.lisp
+++ b/src/interp/cfuns.lisp
@@ -64,6 +64,7 @@
; (|findString| (namestring p) str) )
+#+:GCL
(defun |getEnv| (var-name) (system::getenv var-name))
;;stolen from AXIOM-XL src/strops.c
diff --git a/src/interp/comp.lisp b/src/interp/comp.lisp
index 23bb75ba..2f10f163 100644
--- a/src/interp/comp.lisp
+++ b/src/interp/comp.lisp
@@ -65,6 +65,8 @@
; (defparameter OptionList nil) defined in nlib.lisp
(defparameter SpecialVars nil)
+(defvar $closedfns nil)
+
(defun |compAndDefine| (L)
(let ((*comp370-apply* (function print-and-eval-defun)))
(declare (special *comp370-apply*))
diff --git a/src/interp/debug.lisp b/src/interp/debug.lisp
index fbef4df2..3e3d28fb 100644
--- a/src/interp/debug.lisp
+++ b/src/interp/debug.lisp
@@ -130,13 +130,13 @@
ISID NBLNK COMMENTCHR $TOKSTACK (/SOURCEFILES |$sourceFiles|)
METAKEYLST DEFINITION_NAME (|$sourceFileTypes| '(|spad| |boot| |lisp| |lsp| |meta|))
($FUNCTION FN) $BOOT $NEWSPAD $LINESTACK $LINENUMBER STACK STACKX BACK OK
- TRAPFLAG |$InteractiveMode| TOK COUNT ERRCOL COLUMN *QUERY CHR LINE
+ TRAPFLAG |$InteractiveMode| TOK ERRCOL COLUMN *QUERY CHR LINE
(*COMP370-APPLY* (if (eq op 'define) #'eval-defun #'compile-defun)))
(declare (special ECHO-META SINGLINEMODE XCAPE XTOKENREADER INPUTSTREAM
SPADERRORSTREAM ISID NBLNK COMMENTCHR $TOKSTACK /SOURCEFILES
METAKEYLST DEFINITION_NAME |$sourceFileTypes|
$FUNCTION $BOOT $NEWSPAD $LINESTACK $LINENUMBER STACK STACKX BACK OK
- TRAPFLAG |$InteractiveMode| TOK COUNT ERRCOL COLUMN *QUERY CHR LINE))
+ TRAPFLAG |$InteractiveMode| TOK ERRCOL COLUMN *QUERY CHR LINE))
(if (PAIRP FN) (SETQ FN (QCAR FN)))
(SETQ INFILE (OR INFILE (|getFunctionSourceFile| FN)))
;; $FUNCTION is freely set in getFunctionSourceFile
@@ -388,7 +388,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 COUNT DATE TIME)
+ (PROG (IFT KEY RECNO ORECNO DATE TIME)
; (if (EQ 0 /VERSION) (RETURN NIL))
(if (EQ 'INPUT FT) (RETURN NIL))
(if (NOT |$createUpdateFiles|) (RETURN NIL))
@@ -741,7 +741,7 @@ EXAMINE (SETQ RECNO (NOTE INPUTSTREAM))
(DEFUN IS_SHARP_VAR (X)
(AND (IDENTP X)
(EQL (ELT (PNAME X) 0) #\#)
- (INTEGERP (lisp:parse-integer (symbol-name X) :start 1))))
+ (INTEGERP (parse-integer (symbol-name X) :start 1))))
(DEFUN MONITOR-GETVALUE (N FG)
(COND ((= N 0)
@@ -1120,47 +1120,6 @@ EXAMINE (SETQ RECNO (NOTE INPUTSTREAM))
(PRINT (LIST "CONTOUR LEVEL" CLEV))
(PRINT (mapcar #'car (car W))))))
-#+:CCL
-(defun break (&rest ignore) (lisp-break ignore) (lisp::unwind))
-
-
-#+:CCL
-(defun lisp-break (&rest ignore)
- (prog (prompt ifile ofile u v)
- (setq ifile (rds *debug-io*))
- (setq ofile (wrs *debug-io*))
- (setq prompt (setpchar "Break loop (:? for help)> "))
-top (setq u (read))
- (cond
- ((equal u ':x) (go exit))
- ((equal u ':q)
- (progn (lisp::enable-backtrace nil)
- (princ "Backtrace now disabled")
- (terpri)))
- ((equal u ':v)
- (progn (lisp::enable-backtrace t)
- (princ "Backtrace now enabled")
- (terpri)))
- ((equal u ':?)
- (progn
- (princ ":Q disables backtrace")
- (terpri)
- (princ ":V enables backtrace")
- (terpri)
- (princ ":X exits from break loop")
- (terpri)
- (princ "else enter LISP expressions for evaluation")
- (terpri)))
- ((equal u #\eof)
- (go exit))
- (t (progn
- (setq v (errorset u nil nil))
- (if (listp v) (progn (princ "=> ") (prinl (car v)) (terpri))))) )
- (go top)
-exit (rds ifile)
- (wrs ofile)
- (setpchar prompt)
- (return nil)))
(defun lisp-break-from-axiom (&rest ignore)
(boot::|handleLispBreakLoop| boot::|$BreakMode|))
@@ -1169,49 +1128,3 @@ exit (rds ifile)
#-:CCL
(defun interrupt (&rest ignore))
-#+:CCL
-(defun interrupt (&rest ignore)
- (prog (prompt ifile ofile u v)
- (setq ifile (rds *debug-io*))
- (setq ofile (wrs *debug-io*))
- (setq prompt (setpchar "Break loop (:? for help)> "))
-top (setq u (read))
- (cond
- ((equal u ':x) (go exit))
- ((equal u ':r) (go resume))
- ((equal u ':q)
- (progn (lisp::enable-backtrace nil)
- (princ "Backtrace now disabled")
- (terpri)))
- ((equal u ':v)
- (progn (lisp::enable-backtrace t)
- (princ "Backtrace now enabled")
- (terpri)))
- ((equal u ':?)
- (progn
- (princ ":Q disables backtrace")
- (terpri)
- (princ ":V enables backtrace")
- (terpri)
- (princ ":R resumes from break")
- (terpri)
- (princ ":X exits from break loop")
- (terpri)
- (princ "else enter LISP expressions for evaluation")
- (terpri)))
- ((equal u #\eof)
- (go exit))
- (t (progn
- (setq v (errorset u nil nil))
- (if (listp v) (progn (princ "=> ") (prinl (car v)) (terpri))))) )
- (go top)
-resume (rds ifile)
- (wrs ofile)
- (setpchar prompt)
- (return nil)
-exit (rds ifile)
- (wrs ofile)
- (setpchar prompt)
- (lisp::unwind)))
-
-
diff --git a/src/interp/foam_l.lisp b/src/interp/foam_l.lisp
index 4a61f1e4..45b9f2da 100644
--- a/src/interp/foam_l.lisp
+++ b/src/interp/foam_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
@@ -467,12 +467,12 @@
;;(defvar |FoamOutputString|
;; (make-array 80 :element-type 'string-char :adjustable t :fill-pointer 0))
(defun |FormatNumber| (c arr i)
- (setq str (format nil "~a" c))
- (replace arr str :start1 i)
+ (let ((str (format nil "~a" c)))
+ (replace arr str :start1 i)
;; (incf i (fill-pointer |FoamOutputString|))
;; (if (> i (length arr)) (error "not enough space"))
;; (setf (fill-pointer |FoamOutputString|) 0)
- (+ i (length str)))
+ (+ i (length str))))
(defmacro |FormatSFlo| (c arr i) `(|FormatNumber| ,c ,arr ,i))
(defmacro |FormatDFlo| (c arr i) `(|FormatNumber| ,c ,arr ,i))
@@ -882,12 +882,14 @@
(defun |fiGetDebugger| (x) ())
;; Output ports
-(setq |G-stdoutVar| t)
-(setq |G-stdinVar| t)
-(setq |G-stderrVar| t)
+(defvar |G-stdoutVar| t)
+(defvar |G-stdinVar| t)
+(defvar |G-stderrVar| t)
;; !! Not portable !!
-(defun foam::|fiStrHash| (x) (boot::|hashString| (subseq x 0 (- (length x) 1))))
+;; ??? find a better way to get this work correctly and portably.
+#+:GCL
+(defun |fiStrHash| (x) (boot::|hashString| (subseq x 0 (- (length x) 1))))
;; These three functions check that two cons's contain identical entries.
;; We use EQL to test numbers and EQ everywhere else. If the structure
@@ -906,8 +908,11 @@
(t (eq u v) )))
(defun |magicEq1| (u v)
- (cond ( (and (atom u) (atom v)) (|politicallySound| u v))
- ( (or (atom u) (atom v)) nil)
- ( (|politicallySound| (car u) (car v)) (|magicEq1| (cdr u) (cdr v)))
- nil ))
+ (cond ((and (atom u) (atom v))
+ (|politicallySound| u v))
+ ((or (atom u) (atom v))
+ nil)
+ ((|politicallySound| (car u) (car v))
+ (|magicEq1| (cdr u) (cdr v)))))
+
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-05 18:05:34 +0000