mirror of
https://github.com/PDP-10/its.git
synced 2026-04-28 12:57:56 +00:00
145 lines
4.1 KiB
Common Lisp
Executable File
145 lines
4.1 KiB
Common Lisp
Executable File
;;-*-LISP-*-
|
|
;; FIND 'DEM FSUBRS!
|
|
;; We want to find all places that define FSUBRS,
|
|
;; and all places that knowingly call FSUBRS as if
|
|
;; they were regular functions. This is for getting rid
|
|
;; of such hackery to help Transportability to NIL. -gjc
|
|
|
|
;; If somebody has done (declare (*fexpr foobar)) then
|
|
;; (foobar ...) the not very common case, or,
|
|
;; (apply 'foobar <...>) the common case we are really after,
|
|
;; compiles into
|
|
;; (JCALL 17 'FOOBAR)
|
|
;; which is a UUO that, when FOOBAR has an FSUBR property,
|
|
;; acts the same as (JCALL1 'FOOBAR) if FOOBAR had a SUBR property.
|
|
;; That is, just like a regular subr call of one argument.
|
|
|
|
(eval-when (eval compile)
|
|
(or (get 'defmfile 'version)
|
|
|
|
(load '((Maxtul)defile)))
|
|
(or (get 'toolm 'version)
|
|
(load '((maxtul)toolm))))
|
|
|
|
(declare (special current-module macsyma-source-file faslread-type))
|
|
|
|
;; For each FSUBR keep a FSUBR-DEFINED-IN property.
|
|
;; For each FSUBR keep a FSUBR-REFERENCED-IN property.
|
|
|
|
(defun fsubr-snoop (frob)
|
|
(caseq faslread-type
|
|
(call
|
|
(if (= (cadr frob) #o17)
|
|
(if (addprop? (caddr frob)
|
|
current-module
|
|
'fsubr-referenced-in)
|
|
(format msgfiles
|
|
"~&; Got an fsubr reference! -> ~S~%"
|
|
(caddr frob)))))
|
|
(entry
|
|
(if (eq (cadr frob) 'fsubr)
|
|
(if (addprop? (car frob)
|
|
current-module
|
|
'fsubr-defined-in)
|
|
(format msgfiles
|
|
"~&; Got an fsubr definition! -> ~S~%"
|
|
(car frob)
|
|
))))))
|
|
|
|
(defun find-fsubrs-in-module (m)
|
|
(map-over-fasl-info-in-module
|
|
#'fsubr-snoop
|
|
m
|
|
'(entry call)))
|
|
|
|
(defun find-all-fsubrs (&aux (modules (macsyma-runtime-modules)))
|
|
(format msgfiles
|
|
"~&; Looking in the following modules for FSUBRS:~
|
|
~%~S~%"
|
|
modules)
|
|
(mapc #'find-fsubrs-in-module modules))
|
|
|
|
(defvar report-on-fsubrs ())
|
|
|
|
(defun report-on-fsubrs (&AUX report-on-fsubrs)
|
|
(mapatoms #'(lambda (p)
|
|
(if (or (get p 'fsubr-defined-in)
|
|
(get p 'fsubr-referenced-in))
|
|
(push p report-on-fsubrs))))
|
|
(setq report-on-fsubrs (sort report-on-fsubrs #'alphalessp))
|
|
(mapc #'(lambda (p)
|
|
(format MSGFILES "~
|
|
~&(~S~
|
|
~% fsubr-defined-in ~S~
|
|
~% fsubr-referenced-in ~S) ~%"
|
|
p
|
|
(get p 'fsubr-defined-in)
|
|
(get p 'fsubr-referenced-in)))
|
|
report-on-fsubrs)
|
|
report-on-fsubrs)
|
|
|
|
(defun read-a-module ()
|
|
(car (completing-read "Module-> " (macsyma-runtime-modules))))
|
|
|
|
(deftoolage module-fsubrs ()
|
|
"look for FSUBR hackery in a module"
|
|
(find-fsubrs-in-module (read-a-module)))
|
|
|
|
|
|
(deftoolage report-on-fsubrs ()
|
|
"Output a report of all info in the environment on fsubrs"
|
|
(report-on-fsubrs))
|
|
|
|
(deftoolage find-all-fsubrs ()
|
|
"Map over all FASL files for FSUBRS finding."
|
|
"Use the Report-on-fsubrs command after this to see summary"
|
|
(find-all-fsubrs))
|
|
|
|
|
|
(defun defmspec-entries-in-module (m)
|
|
(map-over-fasl-info-in-module
|
|
#'(lambda (entry)
|
|
(cond ((eq (cadr entry) 'mfexpr*s)
|
|
(format msgfiles "~&; Got one: ~S~%" (car entry))
|
|
(putprop (car entry) t '*fexpr))))
|
|
m
|
|
'(entry)))
|
|
|
|
(deftoolage defmspec-forms-in-module ()
|
|
"Find DEFMSPEC definitions in a module"
|
|
(defmspec-entries-in-module (read-a-module)))
|
|
|
|
(deftoolage find-all-defmspecs ()
|
|
"Map over modules gathering DEFMSPEC properties"
|
|
(let ((Modules (macsyma-runtime-modules)))
|
|
(format msgfiles
|
|
"~&; Looking for DEFMSPEC in the following modules:~%~S"
|
|
modules)
|
|
(mapc #'Defmspec-entries-in-module modules)))
|
|
|
|
|
|
(deftoolage generate-defmspec-declare-file ()
|
|
"Generate the file MAXDOC;DCL FEXPR"
|
|
(let ((stream))
|
|
(unwind-protect
|
|
(progn (setq stream (open "DSK:MAXDOC;DCL _FEXP_" 'OUT))
|
|
(format stream
|
|
"~&; *FEXPR declarations are fake, actually these are~
|
|
~%; all DEFMSPEC's and this information is used only~
|
|
~%; by the Macsyma->Lisp translator. -gjc~%~%")
|
|
(format stream
|
|
"(*FEXPR ")
|
|
(let ((out-stream stream)
|
|
(j 0))
|
|
(declare (special out-stream j))
|
|
(mapatoms #'(lambda (a)
|
|
(cond ((get a '*fexpr)
|
|
(if (zerop (\ j 5.))
|
|
(terpri out-stream))
|
|
(setq j (1+ j))
|
|
(princ " " out-stream)
|
|
(prin1 a out-stream))))))
|
|
(princ ") " stream)
|
|
(renamef stream "* FEXPR"))
|
|
(if stream (close stream)))))
|