mirror of
https://github.com/PDP-10/its.git
synced 2026-01-14 15:45:47 +00:00
85994ed770
Resolves #284. Commented out uses of time-origin in maxtul; mcldmp (init) until we can figure out why it gives arithmetic overflows under the emulators. Updated the expect script statements in build_macsyma_portion to not attempt to match expected strings, but simply sleep for some time since in some cases the matching appears not to work.
61 lines
2.1 KiB
Common Lisp
61 lines
2.1 KiB
Common Lisp
;;;;;;;;;;;;;;;;;;; -*- Mode: Lisp; Package: Macsyma -*- ;;;;;;;;;;;;;;;;;;;
|
||
;;; (c) Copyright 1981 Massachusetts Institute of Technology ;;;
|
||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
||
(macsyma-module ermsgm)
|
||
|
||
;;; Functions for MACSYMA error messages, run-time stuff.
|
||
;;; Note: This file must be loaded before any files which use error messages.
|
||
;;; -GJC 11:24pm Saturday, 25 October 1980
|
||
|
||
;; **NOTE** The definition for STRING-FILE-NAME *MUST* come before any and
|
||
;; all use of out-of-core strings *including* DEFVAR's.
|
||
|
||
(defun string-file-name (name)
|
||
name ;ignore
|
||
())
|
||
|
||
; Make sure the LOADER's version will be used. It is an EXPR version that
|
||
; will latter be flushed.
|
||
|
||
(eval-when (load)
|
||
(if (get 'STRING-FILE-NAME 'EXPR)
|
||
(putprop 'STRING-FILE-NAME (get 'STRING-FILE-NAME 'EXPR) 'EXPR)))
|
||
|
||
(defvar string-files nil)
|
||
(defvar incore-files nil
|
||
"set up ONLY during the LOADING of a macsyma for
|
||
the SUSPEND operation. Then it is an ALIST of (file . offset)")
|
||
(defvar incore-message-file nil
|
||
"Set up ONLY during the LOADING of a macsyma for
|
||
the SUSPEND operation. Then it is the filename of
|
||
the common message file for all incore files.")
|
||
|
||
(defvar string-filearray
|
||
; name a file I know will be open, so that I can
|
||
; get a file object. Ah, the NUL device.
|
||
(open '((NUL)) '(in fixnum dsk block)))
|
||
(close string-filearray)
|
||
|
||
|
||
(DEFMFUN ALLOCATE-MESSAGE-INDEX (FILE ERROR-MESSAGE-INDEX)
|
||
(LET ((TEMP (ASSOC FILE INCORE-FILES)))
|
||
(IF TEMP
|
||
(SETQ FILE INCORE-MESSAGE-FILE
|
||
ERROR-MESSAGE-INDEX (+ ERROR-MESSAGE-INDEX (CDR TEMP)))))
|
||
(CONS (CAR (OR (MEMBER FILE STRING-FILES) ; For cons-sharing, intern
|
||
(PUSH FILE STRING-FILES))) ; the FILE name list.
|
||
ERROR-MESSAGE-INDEX))
|
||
|
||
(DEFMFUN CHECK-OUT-OF-CORE-STRING (STRING &AUX (A STRING-FILEARRAY))
|
||
(COND ((OR (ATOM STRING) (NOT (MEMBER (CAR STRING) STRING-FILES))) STRING)
|
||
(T (CNAMEF A (CAR STRING))
|
||
(UNWIND-PROTECT
|
||
(PROGN
|
||
(OPEN A)
|
||
(FILEPOS A (CDR STRING))
|
||
(FILEPOS A (IN A))
|
||
(DO ((L NIL (CONS W L)) (W (IN A) (IN A)))
|
||
((= W 0) (PNPUT (NREVERSE L) NIL))))
|
||
(CLOSE A)))))
|
||
|