;;;;;;;;;;;;;;;;;;; -*- 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)))))