mirror of
https://github.com/PDP-10/its.git
synced 2026-05-02 22:33:27 +00:00
96 lines
2.5 KiB
Common Lisp
Executable File
96 lines
2.5 KiB
Common Lisp
Executable File
;;;-*-lisp-*-
|
|
;;; (DECLARE-FILE-MAKE) takes the include-file-style files
|
|
;;; of declarations and makes them into a loadable file
|
|
;;; which may be compiled.
|
|
;;; George Carrette 4:15pm Thursday, 21 August 1980
|
|
|
|
(DEFVAR DCL-OUTPUT "DSK:MAXDOC;DCL LOAD")
|
|
(DEFVAR DCL-INPUT '("DSK:MAXDOC;DCL FCTNS"
|
|
"DSK:MAXDOC;DCL VARS"
|
|
"DSK:MAXDOC;DCL FEXPR"
|
|
))
|
|
|
|
#.(PROGN (SETQ FILE-NAME-MAX-LENGTH 6) NIL)
|
|
|
|
(DEFUN TEMP-FILENAME (NAME)
|
|
; returns a temporary file name by convention.
|
|
(SETQ NAME (NAMELIST NAME))
|
|
`(,(CAR NAME)
|
|
,(CADR NAME)
|
|
,(IMPLODE (CONS #/_
|
|
(NCONC (LET ((L (EXPLODEN (CADDR NAME))))
|
|
(COND ((< (LENGTH L)
|
|
(1- #.FILE-NAME-MAX-LENGTH))
|
|
L)
|
|
(T
|
|
(NREVERSE
|
|
(NTHCDR (- (LENGTH L)
|
|
(- #.FILE-NAME-MAX-LENGTH 2))
|
|
(NREVERSE L))))))
|
|
'(#/_))))))
|
|
|
|
(DEFUN DCL-FILE-FORM-MUNGER (FORM STREAM)
|
|
(COND ((ATOM FORM))
|
|
((EQ (CAR FORM) 'DECLARE)
|
|
(POP FORM)
|
|
(DO ()
|
|
((NULL FORM))
|
|
(DCL-FILE-FORM-MUNGER (POP FORM) STREAM)))
|
|
((EQ (CAR FORM) 'COMMENT))
|
|
(T
|
|
(CORRECT-PRINT FORM STREAM))))
|
|
|
|
(DEFVAR DCL-FILE-FORM-MUNGER #'DCL-FILE-FORM-MUNGER)
|
|
|
|
(DEFUN CORRECT-PRINT (FORM STREAM)
|
|
(LET ((PRINLEVEL NIL)
|
|
(PRINLENGTH NIL)
|
|
(BASE 10.)
|
|
(*NOPOINT NIL))
|
|
(PRINT FORM STREAM)))
|
|
|
|
|
|
(DEFUN DECLARE-FILE-MAKE ()
|
|
(LET ((FO (OPEN (TEMP-FILENAME DCL-OUTPUT) '(OUT DSK ASCII BLOCK)))
|
|
(FI NIL)
|
|
(EOF (LIST NIL))) ;unique EOF object.
|
|
(UNWIND-PROTECT
|
|
(DO ((L (PROGN (CORRECT-PRINT
|
|
`(DEFPROP DCL
|
|
,(TIME:PRINT-CURRENT-TIME NIL)
|
|
VERSION)
|
|
FO)
|
|
DCL-INPUT)
|
|
(CDR L)))
|
|
((NULL L)
|
|
(CLOSE FO)
|
|
(AND (PROBEF DCL-OUTPUT)
|
|
(DELETEF DCL-OUTPUT))
|
|
(RENAMEF FO DCL-OUTPUT))
|
|
(SETQ FI (OPEN (CAR L) '(IN DSK ASCII BLOCK)))
|
|
(DO ((FORM (READ FI EOF) (READ FI EOF)))
|
|
((EQ FORM EOF)
|
|
(CLOSE FI))
|
|
(FUNCALL DCL-FILE-FORM-MUNGER FORM FO)))
|
|
(AND FI (CLOSE FI))
|
|
(CLOSE FO))))
|
|
|
|
(DEFUN MAP-FILES (DCL-FILE-FORM-MUNGER DCL-INPUT DCL-OUTPUT)
|
|
(DECLARE-FILE-MAKE))
|
|
|
|
(DEFUN LISPM-DCL-FILE-FORM-MUNGER (FORM STREAM)
|
|
(COND ((ATOM FORM))
|
|
((EQ (CAR FORM) 'DECLARE)
|
|
(POP FORM)
|
|
(DO ()
|
|
((NULL FORM))
|
|
(DCL-FILE-FORM-MUNGER (POP FORM) STREAM)))
|
|
((EQ (CAR FORM) 'COMMENT))
|
|
((EQ (CAR FORM) 'SPECIAL)
|
|
(CORRECT-PRINT FORM STREAM))))
|
|
|
|
(DEFUN LISPM-DECLARE-FILE-MAKE ()
|
|
(LET ((DCL-OUTPUT "DSK:MAXDOC;DCL LISPM")
|
|
(DCL-FILE-FORM-MUNGER #'LISPM-DCL-FILE-FORM-MUNGER))
|
|
(DECLARE-FILE-MAKE)))
|