mirror of
https://github.com/PDP-10/its.git
synced 2026-01-20 01:45:49 +00:00
101 lines
2.9 KiB
Common Lisp
Executable File
101 lines
2.9 KiB
Common Lisp
Executable File
;;-*-LISP-*-
|
|
;; For mapping over da objects in da FASL files
|
|
;; of Macsyma. 6:36pm Wednesday, 15 July 1981
|
|
;; -George Carrette.
|
|
|
|
;; Functions of interest:
|
|
|
|
;; (MACSYMA-RUNTIME-MODULES) returns list of module names.
|
|
|
|
;; (MAP-OVER-FASL-INFO-IN-MODULE
|
|
;; <FUNCTION> <MODULE-NAME> &optional <FASLREADOPEN-OPTIONS>)
|
|
;; During the mapping the following special variables are bound:
|
|
;; CURRENT-MODULE
|
|
;; MACSYMA-SOURCE-FILE
|
|
;; FASLREAD-TYPE
|
|
|
|
;; (ADDPROP? <SYMBOL> <OBJECT> <KEY>) good for gathering info.
|
|
|
|
|
|
(eval-when (eval compile)
|
|
(or (get 'defmfile 'version)
|
|
(load '((Maxtul)defile))))
|
|
|
|
(declare (special faslread-type)
|
|
(*expr faslread faslreadclose)
|
|
(*lexpr faslreadopen))
|
|
|
|
|
|
(defvar current-module)
|
|
(defvar macsyma-source-file)
|
|
(defvar faslread-object)
|
|
|
|
(DEFUN ADDPROP? (SYMBOL OBJECT KEY)
|
|
;; Returns NIL if it is info already known, non-nil if not known.
|
|
(LET ((L (GET SYMBOL KEY)))
|
|
(IF (MEMQ OBJECT L)
|
|
NIL
|
|
(PUTPROP SYMBOL (CONS OBJECT L) KEY))))
|
|
|
|
(defun macsyma-runtime-modules ()
|
|
(sort (mapcan #'(lambda (u)
|
|
(if (not (macro-file-p u))
|
|
(list (macsyma-source-file-name u))))
|
|
macsyma-source-files)
|
|
#'alphalessp))
|
|
|
|
(DEFUN MAP-OVER-FASL-INFO-IN-MODULE (F CURRENT-MODULE
|
|
&OPTIONAL
|
|
(OPTIONS () OPTIONS-P))
|
|
(LET ((MACSYMA-SOURCE-FILE (ASS #'(LAMBDA (A B)
|
|
(EQ A (MACSYMA-SOURCE-FILE-NAME B)))
|
|
CURRENT-MODULE
|
|
MACSYMA-SOURCE-FILES)))
|
|
(IF (NULL MACSYMA-SOURCE-FILE)
|
|
(FORMAT MSGFILES "~&; Module not a macsyma-source-file : ~S~%"
|
|
current-module)
|
|
(LET ((SOURCE-FILE (NAMESTRING `((DSK ,(MACSYMA-SOURCE-FILE-DIR))
|
|
,(MACSYMA-SOURCE-FILE-NAME)
|
|
>)))
|
|
(FASL-FILES (CONS (MACSYMA-SOURCE-FILE-NAME)
|
|
(MACSYMA-SOURCE-FILE-SPLIT))))
|
|
(IF (MEMQ (CAR FASL-FILES) (CDR FASL-FILES))
|
|
(SETQ FASL-FILES (CDR FASL-FILES)))
|
|
(FORMAT MSGFILES
|
|
"~&; For source file ~A~%" source-file)
|
|
(do ((l fasl-files (cdr l)))
|
|
((null l))
|
|
(LET ((Filename (NAMESTRING `((DSK ,(MACSYMA-SOURCE-FILE-FASL-DIR))
|
|
,(CAR L) FASL)))
|
|
(ff-object))
|
|
(IF (NOT (PROBEF Filename))
|
|
(FORMAT MSGFILES
|
|
"~&; Possible file ~A not found.~%" Filename)
|
|
(unwind-protect
|
|
(map-over-fasl-info-in-object
|
|
f
|
|
(setq ff-object
|
|
(if options-p
|
|
(faslreadopen filename options)
|
|
(faslreadopen filename))))
|
|
(faslreadclose ff-object)))))))))
|
|
|
|
(defun map-over-fasl-info-in-object (f ff-object)
|
|
(let ((faslread-type nil)
|
|
(faslread-object ff-object)
|
|
#+complr
|
|
(fast-f (or (and (symbolp f)
|
|
(eq (car (getl f '(subr lsubr expr fexpr fsubr)))
|
|
'subr)
|
|
(get f 'subr))
|
|
;; ask me about this code someday. -gjc
|
|
(boole 7 13._27.
|
|
(lsh 1 23.)
|
|
(maknum f)))))
|
|
(do ((form))
|
|
(nil)
|
|
(setq form (faslread ff-object))
|
|
(if (eq faslread-type 'eof) (return nil))
|
|
#+complr (subrcall nil fast-f form)
|
|
#-complr (funcall f form)
|
|
))) |