mirror of
https://github.com/PDP-10/its.git
synced 2026-01-28 04:57:43 +00:00
67 lines
2.4 KiB
Common Lisp
Executable File
67 lines
2.4 KiB
Common Lisp
Executable File
;;-*-lisp-*-
|
||
;; It is often desirable in maclisp to get the efficiency possible
|
||
;; by using non-reentrant static storage, while at the same time
|
||
;; allowing for buffer reallocations if calls are made recusively
|
||
;; or in breakpoints. Example usages are the tokenization level
|
||
;; of a parser, adaptive numerical integrators, graph calculators.
|
||
|
||
;; Here is one way to formalize,in terms of the STATE-VARIABLES
|
||
;; of a process, a need which can can otherwize lead
|
||
;; to some rather messy programs simply for the sake of efficiency.
|
||
|
||
;; Note: These macros are also usefull in any application with state
|
||
;; variables and clean-up, for example, Assemblers and Compilers,
|
||
;; in fact, any file processor.
|
||
|
||
;; Usage: (DEFSTATE <NAME> <VARIABLE-SPEC> <VARIABLE-SPEC> ...)
|
||
;; <VARIABLE-SPEC> : (<VARIABLE> <TOP-LEVEL-VAL>
|
||
;; <RECURSIVE-VAL>
|
||
;; <CLEAN-UP-CODE>)
|
||
;; Produces: (APPLY-IN-<NAME>-STATE ...) a function.
|
||
;; (<NAME>-STATE-VARS) a function.
|
||
;; (<NAME>-STATE-VALS) a function.
|
||
;; (<NAME>-STATE-RECL) a function.
|
||
|
||
;; From my private macros 1:07pm Wednesday, 25 February 1981 -GJC
|
||
|
||
(DECLARE (*LEXPR SYMBOLCONC))
|
||
|
||
;; This should be built-in
|
||
(eval-when (eval compile)
|
||
(DEFMACRO (VARS . BODY) `#'(LAMBDA ,VARS . ,BODY)))
|
||
|
||
(HERALD DEFSTATE)
|
||
|
||
(DEFMACRO DEFSTATE (NAME . VARIABLE-SPECS)
|
||
(DO ((APPLY-FUN (SYMBOLCONC "APPLY-IN-" NAME "-STATE"))
|
||
(VAR-FUN (SYMBOLCONC NAME "-STATE-VARS"))
|
||
(VAL-FUN (SYMBOLCONC NAME "-STATE-VALS"))
|
||
(REC-FUN (SYMBOLCONC NAME "-STATE-RECL"))
|
||
(SPECS VARIABLE-SPECS (CDR SPECS))
|
||
(VARS NIL)
|
||
(VALS-TOP NIL)
|
||
(VALS-REC NIL)
|
||
(RECL NIL))
|
||
((NULL SPECS)
|
||
(SETQ VARS (NREVERSE VARS)
|
||
VALS-TOP (NREVERSE VALS-TOP)
|
||
VALS-REC (NREVERSE VALS-REC)
|
||
RECL (NREVERSE RECL))
|
||
`(PROGN
|
||
'COMPILE
|
||
,@(MAPCAR ( (A B) `(DEFVAR ,A ,B)) VARS VALS-TOP)
|
||
(DEFUN ,VAR-FUN () ',VARS)
|
||
(DEFUN ,VAL-FUN () (LIST ,@VALS-REC))
|
||
(DEFUN ,REC-FUN () ,@RECL)
|
||
(DEFUN ,APPLY-FUN (F L)
|
||
(PROGV (,VAR-FUN)
|
||
(,VAL-FUN)
|
||
(UNWIND-PROTECT (APPLY F L)
|
||
(,REC-FUN))))))
|
||
(LET ((SPEC (IF (EQ (TYPEP (CAR SPECS)) 'LIST)
|
||
(CAR SPECS)
|
||
(ERROR "Bad variable spec" (CAR SPECS)))))
|
||
(PUSH (POP SPEC) VARS)
|
||
(PUSH (POP SPEC) VALS-TOP)
|
||
(PUSH (POP SPEC) VALS-REC)
|
||
(PUSH (POP SPEC) RECL)))) |