Compare commits
1 Commits
master
...
rmk143--So
| Author | SHA1 | Date | |
|---|---|---|---|
|
55da53966b |
@@ -1,10 +1,12 @@
|
|||||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||||
|
|
||||||
(FILECREATED "20-Feb-2024 09:28:38" {DSK}<home>larry>il>medley>library>MSANALYZE.;2 61022
|
(FILECREATED " 2-Oct-2025 23:05:25" {WMEDLEY}<library>MSANALYZE.;4 61409
|
||||||
|
|
||||||
:EDIT-BY "lmm"
|
:EDIT-BY rmk
|
||||||
|
|
||||||
:PREVIOUS-DATE "17-Feb-2024 22:10:56" {DSK}<home>larry>il>medley>library>MSANALYZE.;3)
|
:CHANGES-TO (FNS CALLS)
|
||||||
|
|
||||||
|
:PREVIOUS-DATE "20-Feb-2024 09:28:38" {WMEDLEY}<library>MSANALYZE.;3)
|
||||||
|
|
||||||
|
|
||||||
(PRETTYCOMPRINT MSANALYZECOMS)
|
(PRETTYCOMPRINT MSANALYZECOMS)
|
||||||
@@ -72,11 +74,13 @@
|
|||||||
(CADDR (CALLS FN USEDATABASE 'FREEVARS])
|
(CADDR (CALLS FN USEDATABASE 'FREEVARS])
|
||||||
|
|
||||||
(CALLS
|
(CALLS
|
||||||
[LAMBDA (EXPR USEDATABASE VARSFLG) (* ; "Edited 12-Jun-90 17:25 by teruuchi")
|
[LAMBDA (EXPR USEDATABASE VARSFLG) (* ; "Edited 2-Oct-2025 23:01 by rmk")
|
||||||
|
(* ; "Edited 12-Jun-90 17:25 by teruuchi")
|
||||||
(* ;
|
(* ;
|
||||||
"This FNS is for the User Interface Function in MSANALYZE(MasterScope)")
|
"This FNS is for the User Interface Function in MSANALYZE(MasterScope)")
|
||||||
(* ;
|
(* ;
|
||||||
"Edited by Tomoru Teruuchi(12-June-90 : for AR#10020)")
|
"Edited by Tomoru Teruuchi(12-June-90 : for AR#10020) ")
|
||||||
|
(* ; "Edited by TT (Date : 8-May-1990)")
|
||||||
(PROG (FREES (GLOBALS NIL)
|
(PROG (FREES (GLOBALS NIL)
|
||||||
FNDEF FLG)
|
FNDEF FLG)
|
||||||
[COND
|
[COND
|
||||||
@@ -84,19 +88,20 @@
|
|||||||
(GETD 'UPDATEFN))
|
(GETD 'UPDATEFN))
|
||||||
(UPDATEFN EXPR NIL 'ERROR)
|
(UPDATEFN EXPR NIL 'ERROR)
|
||||||
[SETQ FREES (GETRELATION EXPR '(USE FREELY]
|
[SETQ FREES (GETRELATION EXPR '(USE FREELY]
|
||||||
[SETQ FREES (SUBSET FREES (FUNCTION (LAMBDA (VAR)
|
[SETQ FREES (SORT (SUBSET FREES (FUNCTION (LAMBDA (VAR)
|
||||||
(* ;
|
(* ;
|
||||||
"This Function is The Predicate whether the variable is global or not.")
|
"This Function is The Predicate whether the variable is global or not.")
|
||||||
(if (OR (FMEMB VAR GLOBALVARS)
|
(if (OR (FMEMB VAR GLOBALVARS)
|
||||||
(EQ (GETPROP VAR 'GLOBALVAR)
|
(EQ (GETPROP VAR 'GLOBALVAR)
|
||||||
T))
|
T))
|
||||||
then (pushnew GLOBALS VAR)
|
then (pushnew GLOBALS VAR)
|
||||||
NIL
|
NIL
|
||||||
else T](* ; "Edited by TT (Date : 8-May-1990)")
|
else T]
|
||||||
|
(SETQ GLOBALS (SORT GLOBALS))
|
||||||
(RETURN (LIST [AND (NOT VARSFLG)
|
(RETURN (LIST [AND (NOT VARSFLG)
|
||||||
(GETRELATION EXPR '(CALL NOTERROR]
|
(SORT (GETRELATION EXPR '(CALL NOTERROR]
|
||||||
(AND (NEQ VARSFLG 'FREEVARS)
|
[AND (NEQ VARSFLG 'FREEVARS)
|
||||||
(GETRELATION EXPR 'BIND))
|
(SORT (GETRELATION EXPR 'BIND]
|
||||||
FREES GLOBALS]
|
FREES GLOBALS]
|
||||||
GETDLP
|
GETDLP
|
||||||
(SETQ FNDEF (COND
|
(SETQ FNDEF (COND
|
||||||
@@ -170,11 +175,13 @@
|
|||||||
then (pushnew GLOBALS VAR)
|
then (pushnew GLOBALS VAR)
|
||||||
NIL
|
NIL
|
||||||
else T]
|
else T]
|
||||||
(* ; "Edited by TT (Date : 8-May-1990)")
|
(RETURN (LIST [SORT (COLLECTFNDATA (CONSTANT (MSVBNOTICED
|
||||||
(RETURN (LIST [COLLECTFNDATA (CONSTANT (MSVBNOTICED 'CALL
|
'CALL
|
||||||
'NOTERROR]
|
'NOTERROR]
|
||||||
[COLLECTFNDATA (CONSTANT (MSVBNOTICED 'BIND]
|
[SORT (COLLECTFNDATA (CONSTANT (MSVBNOTICED
|
||||||
FREES GLOBALS]
|
'BIND]
|
||||||
|
(SORT FREES)
|
||||||
|
(SORT GLOBALS]
|
||||||
(T '?])
|
(T '?])
|
||||||
|
|
||||||
(COLLECTFNDATA
|
(COLLECTFNDATA
|
||||||
@@ -1270,11 +1277,11 @@ DONTCOPY
|
|||||||
(BLOCK%: MSFINDP MSFINDP)
|
(BLOCK%: MSFINDP MSFINDP)
|
||||||
)
|
)
|
||||||
(DECLARE%: DONTCOPY
|
(DECLARE%: DONTCOPY
|
||||||
(FILEMAP (NIL (3487 10938 (VARS 3497 . 3636) (FREEVARS 3638 . 3789) (CALLS 3791 . 10089) (
|
(FILEMAP (NIL (3482 11325 (VARS 3492 . 3631) (FREEVARS 3633 . 3784) (CALLS 3786 . 10476) (
|
||||||
COLLECTFNDATA 10091 . 10462) (CALLS3 10464 . 10936)) (13187 51210 (ALLCALLS 13197 . 13797) (
|
COLLECTFNDATA 10478 . 10849) (CALLS3 10851 . 11323)) (13574 51597 (ALLCALLS 13584 . 14184) (
|
||||||
MSINITFNDATA 13799 . 14029) (MSPRGE 14031 . 21284) (MSPRGMACRO 21286 . 21997) (MSPRGCALL 21999 . 22316
|
MSINITFNDATA 14186 . 14416) (MSPRGE 14418 . 21671) (MSPRGMACRO 21673 . 22384) (MSPRGCALL 22386 . 22703
|
||||||
) (MSBINDVAR 22318 . 22825) (MSPRGRECORD 22827 . 29604) (MSPRGERR 29606 . 29769) (MSPRGTEMPLATE1 29771
|
) (MSBINDVAR 22705 . 23212) (MSPRGRECORD 23214 . 29991) (MSPRGERR 29993 . 30156) (MSPRGTEMPLATE1 30158
|
||||||
. 38819) (MSPRGTEMPLATE 38821 . 39424) (MSPRGLAMBDA 39426 . 48039) (MSPRGLST 48041 . 48203) (ADDTO
|
. 39206) (MSPRGTEMPLATE 39208 . 39811) (MSPRGLAMBDA 39813 . 48426) (MSPRGLST 48428 . 48590) (ADDTO
|
||||||
48205 . 48985) (NLAMBDAFNP 48987 . 49713) (MSPRGDWIM 49715 . 50554) (MSDWIMTRAN 50556 . 51208)) (60485
|
48592 . 49372) (NLAMBDAFNP 49374 . 50100) (MSPRGDWIM 50102 . 50941) (MSDWIMTRAN 50943 . 51595)) (60872
|
||||||
60921 (MSFINDP 60495 . 60919)))))
|
61308 (MSFINDP 60882 . 61306)))))
|
||||||
STOP
|
STOP
|
||||||
|
|||||||
Binary file not shown.
310
sources/ACODE
310
sources/ACODE
@@ -1,14 +1,14 @@
|
|||||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||||
(FILECREATED "12-Mar-2021 11:17:48" {DSK}<home>larry>ilisp>med>sources>ACODE.;6 71741
|
|
||||||
|
|
||||||
changes to%: (FNS PRINTCODENT)
|
(FILECREATED " 2-Oct-2025 22:55:53" {DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>ACODE.;2 70570
|
||||||
|
|
||||||
previous date%: "12-Mar-2021 09:50:45" {DSK}<home>larry>ilisp>med>sources>ACODE.;4)
|
:EDIT-BY rmk
|
||||||
|
|
||||||
|
:CHANGES-TO (FNS CALLSCCODE)
|
||||||
|
|
||||||
|
:PREVIOUS-DATE "12-Mar-2021 11:17:48"
|
||||||
|
{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>ACODE.;1)
|
||||||
|
|
||||||
(* ; "
|
|
||||||
Copyright (c) 1982-1988, 1990-1992, 1995, 2017, 2021 by Venue & Xerox Corporation.
|
|
||||||
")
|
|
||||||
|
|
||||||
(PRETTYCOMPRINT ACODECOMS)
|
(PRETTYCOMPRINT ACODECOMS)
|
||||||
|
|
||||||
@@ -35,7 +35,7 @@ Copyright (c) 1982-1988, 1990-1992, 1995, 2017, 2021 by Venue & Xerox Corporatio
|
|||||||
LLGC LLCODE LLBASIC MODARITH RENAMEMACROS))
|
LLGC LLCODE LLBASIC MODARITH RENAMEMACROS))
|
||||||
(ADDVARS (IGNOREFNS)))
|
(ADDVARS (IGNOREFNS)))
|
||||||
(COMS (* ;
|
(COMS (* ;
|
||||||
"Maintaining ref count consistency in code")
|
"Maintaining ref count consistency in code")
|
||||||
(FNS \COPYCODEBLOCK \COPYFNHEADER \RECLAIMCODEBLOCK))
|
(FNS \COPYCODEBLOCK \COPYFNHEADER \RECLAIMCODEBLOCK))
|
||||||
(COMS (* ; "Low-level break")
|
(COMS (* ; "Low-level break")
|
||||||
(FNS LLBREAK BROKENDEF))
|
(FNS LLBREAK BROKENDEF))
|
||||||
@@ -44,8 +44,7 @@ Copyright (c) 1982-1988, 1990-1992, 1995, 2017, 2021 by Venue & Xerox Corporatio
|
|||||||
(EXPANDMACROFNS NEXTBYTE PCVAR PRINJUMP CODEBASELT
|
(EXPANDMACROFNS NEXTBYTE PCVAR PRINJUMP CODEBASELT
|
||||||
CODEBASELT2 CODEBASESETA CODEBASESETA2
|
CODEBASELT2 CODEBASESETA CODEBASESETA2
|
||||||
PRINTCODEHEADERDECODE]
|
PRINTCODEHEADERDECODE]
|
||||||
(COMS (* ;
|
(COMS (* ; "reference to opcodes symbolically")
|
||||||
"reference to opcodes symbolically")
|
|
||||||
(FNS PRINTOPCODES)
|
(FNS PRINTOPCODES)
|
||||||
(GLOBALVARS \OPCODES))
|
(GLOBALVARS \OPCODES))
|
||||||
(DECLARE%: EVAL@COMPILE DONTCOPY (LOCALVARS . T))))
|
(DECLARE%: EVAL@COMPILE DONTCOPY (LOCALVARS . T))))
|
||||||
@@ -397,24 +396,23 @@ Copyright (c) 1982-1988, 1990-1992, 1995, 2017, 2021 by Venue & Xerox Corporatio
|
|||||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||||
(DECLARE%: EVAL@COMPILE
|
(DECLARE%: EVAL@COMPILE
|
||||||
|
|
||||||
(PUTPROPS PCVAR MACRO [(IND LST NAME) (* lmm "11-AUG-81 22:27")
|
(PUTPROPS PCVAR MACRO [(IND LST NAME) (* lmm "11-AUG-81 22:27")
|
||||||
(ALLOCAL (PROG NIL
|
(ALLOCAL (PROG NIL
|
||||||
(PRIN2 [CADR (OR (ASSOC IND LST)
|
(PRIN2 [CADR (OR (ASSOC IND LST)
|
||||||
(RETURN (printout OUTF "[" NAME IND
|
(RETURN (printout OUTF "[" NAME IND "]"]
|
||||||
"]"]
|
OUTF])
|
||||||
OUTF])
|
|
||||||
|
|
||||||
(PUTPROPS PRINJUMP MACRO [LAMBDA (N)
|
(PUTPROPS PRINJUMP MACRO [LAMBDA (N)
|
||||||
(PRIN1 "->" OUTF)
|
(PRIN1 "->" OUTF)
|
||||||
(PRINTNUM I4 [SETQ N (IPLUS N (IDIFFERENCE CODELOC (ADD1 LEN]
|
(PRINTNUM I4 [SETQ N (IPLUS N (IDIFFERENCE CODELOC (ADD1 LEN]
|
||||||
OUTF)
|
OUTF)
|
||||||
(COND
|
(COND
|
||||||
(LEVEL (PUTHASH N (SELECTQ LEVADJ
|
(LEVEL (PUTHASH N (SELECTQ LEVADJ
|
||||||
((NCJUMP JUMP)
|
((NCJUMP JUMP)
|
||||||
LEVEL)
|
LEVEL)
|
||||||
(SUB1 LEVEL))
|
(SUB1 LEVEL))
|
||||||
\PRINTCODE.LEVEL)
|
\PRINTCODE.LEVEL)
|
||||||
(PUTHASH N STK \PRINTCODE.STKSTATE])
|
(PUTHASH N STK \PRINTCODE.STKSTATE])
|
||||||
|
|
||||||
(PUTPROPS NEXTBYTE MACRO [NIL (CODEBASELT CODEBASE (PROG1 CODELOC (add CODELOC 1])
|
(PUTPROPS NEXTBYTE MACRO [NIL (CODEBASELT CODEBASE (PROG1 CODELOC (add CODELOC 1])
|
||||||
|
|
||||||
@@ -423,17 +421,16 @@ Copyright (c) 1982-1988, 1990-1992, 1995, 2017, 2021 by Venue & Xerox Corporatio
|
|||||||
(INDICES I THERE)
|
(INDICES I THERE)
|
||||||
[for NAME in (CDR (RECORDFIELDNAMES 'FNHEADER T))
|
[for NAME in (CDR (RECORDFIELDNAMES 'FNHEADER T))
|
||||||
when (AND NAME (CL:SYMBOLP NAME))
|
when (AND NAME (CL:SYMBOLP NAME))
|
||||||
do
|
do [SETQ I
|
||||||
[SETQ I (EVAL `(INDEXF (fetch (FNHEADER
|
(EVAL `(INDEXF (fetch (FNHEADER ,NAME]
|
||||||
,NAME]
|
(COND
|
||||||
(COND
|
((EQ NAME '%#FRAMENAME)
|
||||||
((EQ NAME '%#FRAMENAME)
|
(add I 1)))
|
||||||
(add I 1)))
|
(COND
|
||||||
(COND
|
((SETQ THERE (ASSOC I INDICES))
|
||||||
((SETQ THERE (ASSOC I INDICES))
|
(push (CDR THERE)
|
||||||
(push (CDR THERE)
|
NAME))
|
||||||
NAME))
|
(T (push INDICES (LIST I NAME]
|
||||||
(T (push INDICES (LIST I NAME]
|
|
||||||
`(SELECTQ ,INDEX
|
`(SELECTQ ,INDEX
|
||||||
(\,@ [for PAIR in INDICES
|
(\,@ [for PAIR in INDICES
|
||||||
collect
|
collect
|
||||||
@@ -447,8 +444,8 @@ Copyright (c) 1982-1988, 1990-1992, 1995, 2017, 2021 by Venue & Xerox Corporatio
|
|||||||
(SELECTQ NAME
|
(SELECTQ NAME
|
||||||
((NATIVE CLOSUREP)
|
((NATIVE CLOSUREP)
|
||||||
`(AND
|
`(AND
|
||||||
(fetch
|
(fetch (FNHEADER
|
||||||
(FNHEADER ,NAME)
|
,NAME)
|
||||||
of ,CODEBASE)
|
of ,CODEBASE)
|
||||||
(PRIN1 ,(CONCAT "[" NAME
|
(PRIN1 ,(CONCAT "[" NAME
|
||||||
"]")
|
"]")
|
||||||
@@ -459,14 +456,13 @@ Copyright (c) 1982-1988, 1990-1992, 1995, 2017, 2021 by Venue & Xerox Corporatio
|
|||||||
(L-CASE (MKSTRING
|
(L-CASE (MKSTRING
|
||||||
NAME))
|
NAME))
|
||||||
": ")
|
": ")
|
||||||
(fetch (FNHEADER
|
(fetch (FNHEADER ,NAME)
|
||||||
,NAME)
|
|
||||||
of ,CODEBASE]
|
of ,CODEBASE]
|
||||||
[(EQ (CADR PAIR)
|
[(EQ (CADR PAIR)
|
||||||
'%#FRAMENAME)
|
'%#FRAMENAME)
|
||||||
`((printout ,OUTF " frame name: " .P2
|
`((printout ,OUTF " frame name: " .P2
|
||||||
(1ST (fetch (FNHEADER
|
(1ST (fetch (FNHEADER
|
||||||
%#FRAMENAME)
|
%#FRAMENAME)
|
||||||
of ,CODEBASE]
|
of ,CODEBASE]
|
||||||
(T
|
(T
|
||||||
`((PRIN1
|
`((PRIN1
|
||||||
@@ -491,10 +487,11 @@ Copyright (c) 1982-1988, 1990-1992, 1995, 2017, 2021 by Venue & Xerox Corporatio
|
|||||||
|
|
||||||
(CALLSCCODE
|
(CALLSCCODE
|
||||||
[LAMBDA (DEF OPTION FNAPPLY) (* DECLARATIONS%: (RECORD RESULT
|
[LAMBDA (DEF OPTION FNAPPLY) (* DECLARATIONS%: (RECORD RESULT
|
||||||
(LNCALLED CALLED BOUND USEDFREE
|
(LNCALLED CALLED BOUND USEDFREE
|
||||||
GLOBALS)))
|
GLOBALS)))
|
||||||
|
(* ; "Edited 2-Oct-2025 22:55 by rmk")
|
||||||
(* ;
|
(* ;
|
||||||
"Edited 1-Dec-92 00:51 by sybalsky:mv:envos")
|
"Edited 1-Dec-92 00:51 by sybalsky:mv:envos")
|
||||||
|
|
||||||
(* ;;;
|
(* ;;;
|
||||||
"Analyze DEF for function calls and variable references. Action depends on OPTION as follows:")
|
"Analyze DEF for function calls and variable references. Action depends on OPTION as follows:")
|
||||||
@@ -517,21 +514,21 @@ Copyright (c) 1982-1988, 1990-1992, 1995, 2017, 2021 by Venue & Xerox Corporatio
|
|||||||
((NEQ OPTION 'FNAPPLY) (* ; "Get variables out of name table")
|
((NEQ OPTION 'FNAPPLY) (* ; "Get variables out of name table")
|
||||||
(SETQ NTSIZE (fetch (FNHEADER NTSIZE) of CODEBASE))
|
(SETQ NTSIZE (fetch (FNHEADER NTSIZE) of CODEBASE))
|
||||||
(for NT1 from (UNFOLD (fetch (FNHEADER OVERHEADWORDS) of T)
|
(for NT1 from (UNFOLD (fetch (FNHEADER OVERHEADWORDS) of T)
|
||||||
BYTESPERWORD) by (BYTESPERNAMEENTRY) as NT2
|
BYTESPERWORD) by (BYTESPERNAMEENTRY) as NT2
|
||||||
from (IPLUS (CONSTANT (UNFOLD (fetch (FNHEADER OVERHEADWORDS) of T)
|
from (IPLUS (CONSTANT (UNFOLD (fetch (FNHEADER OVERHEADWORDS) of T)
|
||||||
BYTESPERWORD))
|
BYTESPERWORD))
|
||||||
(UNFOLD NTSIZE BYTESPERWORD)) by (BYTESPERNTOFFSETENTRY)
|
(UNFOLD NTSIZE BYTESPERWORD)) by (BYTESPERNTOFFSETENTRY)
|
||||||
until [NULL (SETQ NAME (\INDEXATOMVAL (GETNAMEENTRY CODEBASE NT1]
|
until [NULL (SETQ NAME (\INDEXATOMVAL (GETNAMEENTRY CODEBASE NT1]
|
||||||
do (SETQ TYPE (SELECTQ (NTSLOT-VARTYPE (GETNTOFFSET CODEBASE NT2))
|
do (SETQ TYPE (SELECTQ (NTSLOT-VARTYPE (GETNTOFFSET CODEBASE NT2))
|
||||||
((IVARCODE PVARCODE)
|
((IVARCODE PVARCODE)
|
||||||
'BOUND)
|
'BOUND)
|
||||||
'USEDFREE)) (* ; "Top two bits of the entry indicate kind of name: 00(\NT.IVARCODE) = IVAR, 10(\NT.PVARCODE) = PVAR, 11 = FVAR")
|
'USEDFREE)) (* ; "Top two bits of the entry indicate kind of name: 00(\NT.IVARCODE) = IVAR, 10(\NT.PVARCODE) = PVAR, 11 = FVAR")
|
||||||
(SELECTQ OPTION
|
(SELECTQ OPTION
|
||||||
((VARAPPLY APPLY)
|
((VARAPPLY APPLY)
|
||||||
(CL:FUNCALL FNAPPLY NAME TYPE))
|
(CL:FUNCALL FNAPPLY NAME TYPE))
|
||||||
(SELECTQ TYPE
|
(SELECTQ TYPE
|
||||||
(BOUND (pushnew BOUND NAME))
|
(BOUND (pushnew BOUND NAME))
|
||||||
(pushnew USEDFREE NAME]
|
(pushnew USEDFREE NAME]
|
||||||
(PROG ((CODELOC (fetch (FNHEADER STARTPC) of CODEBASE))
|
(PROG ((CODELOC (fetch (FNHEADER STARTPC) of CODEBASE))
|
||||||
B B1 B2 B3 B4 B5 FN LEN)
|
B B1 B2 B3 B4 B5 FN LEN)
|
||||||
LP (SETQ B (NEXTBYTE))
|
LP (SETQ B (NEXTBYTE))
|
||||||
@@ -651,7 +648,7 @@ Copyright (c) 1982-1988, 1990-1992, 1995, 2017, 2021 by Venue & Xerox Corporatio
|
|||||||
(GO LP)
|
(GO LP)
|
||||||
COMPILED-CLOSURE
|
COMPILED-CLOSURE
|
||||||
(* ;
|
(* ;
|
||||||
"Compiled subfunction, recursively analyze it")
|
"Compiled subfunction, recursively analyze it")
|
||||||
[LET ((RESULT (CALLSCCODE FN OPTION FNAPPLY)))
|
[LET ((RESULT (CALLSCCODE FN OPTION FNAPPLY)))
|
||||||
(AND RESULT (COND
|
(AND RESULT (COND
|
||||||
((EQ OPTION T) (* ; "Just got free variables back")
|
((EQ OPTION T) (* ; "Just got free variables back")
|
||||||
@@ -671,13 +668,13 @@ Copyright (c) 1982-1988, 1990-1992, 1995, 2017, 2021 by Venue & Xerox Corporatio
|
|||||||
((FNAPPLY VARAPPLY APPLY)
|
((FNAPPLY VARAPPLY APPLY)
|
||||||
NIL)
|
NIL)
|
||||||
(T (* ; "All free var references")
|
(T (* ; "All free var references")
|
||||||
(RUNION USEDFREE GLOBALS))
|
(SORT (RUNION USEDFREE GLOBALS)))
|
||||||
(create RESULT
|
(create RESULT
|
||||||
LNCALLED _ (REVERSE LNCALLED)
|
LNCALLED _ (SORT LNCALLED)
|
||||||
CALLED _ (REVERSE CALLED)
|
CALLED _ (SORT CALLED)
|
||||||
BOUND _ (REVERSE BOUND)
|
BOUND _ (SORT BOUND)
|
||||||
USEDFREE _ (REVERSE USEDFREE)
|
USEDFREE _ (SORT USEDFREE)
|
||||||
GLOBALS _ (REVERSE GLOBALS])
|
GLOBALS _ (SORT GLOBALS])
|
||||||
|
|
||||||
(RUNION
|
(RUNION
|
||||||
(LAMBDA (L1 L2) (* bvm%: "14-Mar-86 14:27") (* ;;; "Fast UNION using EQ") (for X in L1 unless (FMEMB X L2) do (push L2 X)) L2)
|
(LAMBDA (L1 L2) (* bvm%: "14-Mar-86 14:27") (* ;;; "Fast UNION using EQ") (for X in L1 unless (FMEMB X L2) do (push L2 X)) L2)
|
||||||
@@ -906,122 +903,120 @@ Copyright (c) 1982-1988, 1990-1992, 1995, 2017, 2021 by Venue & Xerox Corporatio
|
|||||||
(DECLARE%: EVAL@COMPILE
|
(DECLARE%: EVAL@COMPILE
|
||||||
|
|
||||||
(PUTPROPS CODEBASELT MACRO [OPENLAMBDA (CODEBASE OFFSET)
|
(PUTPROPS CODEBASELT MACRO [OPENLAMBDA (CODEBASE OFFSET)
|
||||||
(COND
|
(COND
|
||||||
((fetch (FNHEADER BYTESWAPPED) of CODEBASE)
|
((fetch (FNHEADER BYTESWAPPED) of CODEBASE)
|
||||||
(\GETBASEBYTE CODEBASE (LOGXOR OFFSET 3)))
|
(\GETBASEBYTE CODEBASE (LOGXOR OFFSET 3)))
|
||||||
(T (\GETBASEBYTE CODEBASE OFFSET])
|
(T (\GETBASEBYTE CODEBASE OFFSET])
|
||||||
|
|
||||||
(PUTPROPS CODEBASELT2 MACRO [OPENLAMBDA (DEF LC)
|
(PUTPROPS CODEBASELT2 MACRO [OPENLAMBDA (DEF LC)
|
||||||
(LOGOR (LLSH (CODEBASELT DEF LC)
|
(LOGOR (LLSH (CODEBASELT DEF LC)
|
||||||
BITSPERBYTE)
|
BITSPERBYTE)
|
||||||
(CODEBASELT DEF (ADD1 LC])
|
(CODEBASELT DEF (ADD1 LC])
|
||||||
|
|
||||||
(PUTPROPS CODEBASESETA MACRO [OPENLAMBDA (CODEBASE OFFSET NEWVALUE)
|
(PUTPROPS CODEBASESETA MACRO [OPENLAMBDA (CODEBASE OFFSET NEWVALUE)
|
||||||
(COND
|
(COND
|
||||||
((fetch (FNHEADER BYTESWAPPED) of CODEBASE)
|
((fetch (FNHEADER BYTESWAPPED) of CODEBASE)
|
||||||
(\PUTBASEBYTE CODEBASE (LOGXOR OFFSET 3)
|
(\PUTBASEBYTE CODEBASE (LOGXOR OFFSET 3)
|
||||||
NEWVALUE))
|
NEWVALUE))
|
||||||
(T (\PUTBASEBYTE CODEBASE OFFSET NEWVALUE])
|
(T (\PUTBASEBYTE CODEBASE OFFSET NEWVALUE])
|
||||||
|
|
||||||
(PUTPROPS CODEBASESETA2 MACRO [OPENLAMBDA (DEF LC VALUE)
|
(PUTPROPS CODEBASESETA2 MACRO [OPENLAMBDA (DEF LC VALUE)
|
||||||
(CODEBASESETA DEF LC (LRSH VALUE BITSPERBYTE))
|
(CODEBASESETA DEF LC (LRSH VALUE BITSPERBYTE))
|
||||||
(CODEBASESETA DEF (ADD1 LC)
|
(CODEBASESETA DEF (ADD1 LC)
|
||||||
(IMOD VALUE (CONSTANT (LLSH 1 BITSPERBYTE])
|
(IMOD VALUE (CONSTANT (LLSH 1 BITSPERBYTE])
|
||||||
|
|
||||||
(PUTPROPS CODEBASELT3 MACRO [OPENLAMBDA (DEF LC)
|
(PUTPROPS CODEBASELT3 MACRO [OPENLAMBDA (DEF LC)
|
||||||
(BIG-VMEM-CODE [\VAG2 (LOGOR (LLSH (CODEBASELT DEF LC)
|
(BIG-VMEM-CODE [\VAG2 (LOGOR (LLSH (CODEBASELT DEF LC)
|
||||||
BITSPERBYTE)
|
|
||||||
(CODEBASELT DEF (ADD1 LC)))
|
|
||||||
(LOGOR (LLSH (CODEBASELT DEF
|
|
||||||
(IPLUS 2 LC))
|
|
||||||
BITSPERBYTE)
|
|
||||||
(CODEBASELT DEF (IPLUS 3 LC]
|
|
||||||
(\VAG2 (CODEBASELT DEF LC)
|
|
||||||
(LOGOR (LLSH (CODEBASELT DEF (IPLUS 1 LC))
|
|
||||||
BITSPERBYTE)
|
BITSPERBYTE)
|
||||||
(CODEBASELT DEF (IPLUS 2 LC])
|
(CODEBASELT DEF (ADD1 LC)))
|
||||||
|
(LOGOR (LLSH (CODEBASELT DEF (IPLUS 2 LC))
|
||||||
|
BITSPERBYTE)
|
||||||
|
(CODEBASELT DEF (IPLUS 3 LC]
|
||||||
|
(\VAG2 (CODEBASELT DEF LC)
|
||||||
|
(LOGOR (LLSH (CODEBASELT DEF (IPLUS 1 LC))
|
||||||
|
BITSPERBYTE)
|
||||||
|
(CODEBASELT DEF (IPLUS 2 LC])
|
||||||
|
|
||||||
(PUTPROPS CODEBASELT4 MACRO [OPENLAMBDA (DEF LC)
|
(PUTPROPS CODEBASELT4 MACRO [OPENLAMBDA (DEF LC)
|
||||||
(BIG-VMEM-CODE [\VAG2 (LOGOR (LLSH (CODEBASELT DEF LC)
|
(BIG-VMEM-CODE [\VAG2 (LOGOR (LLSH (CODEBASELT DEF LC)
|
||||||
BITSPERBYTE)
|
|
||||||
(CODEBASELT DEF (ADD1 LC)))
|
|
||||||
(LOGOR (LLSH (CODEBASELT DEF
|
|
||||||
(IPLUS 2 LC))
|
|
||||||
BITSPERBYTE)
|
|
||||||
(CODEBASELT DEF (IPLUS 3 LC]
|
|
||||||
(\VAG2 (CODEBASELT DEF LC)
|
|
||||||
(LOGOR (LLSH (CODEBASELT DEF (IPLUS 1 LC))
|
|
||||||
BITSPERBYTE)
|
BITSPERBYTE)
|
||||||
(CODEBASELT DEF (IPLUS 2 LC])
|
(CODEBASELT DEF (ADD1 LC)))
|
||||||
|
(LOGOR (LLSH (CODEBASELT DEF (IPLUS 2 LC))
|
||||||
|
BITSPERBYTE)
|
||||||
|
(CODEBASELT DEF (IPLUS 3 LC]
|
||||||
|
(\VAG2 (CODEBASELT DEF LC)
|
||||||
|
(LOGOR (LLSH (CODEBASELT DEF (IPLUS 1 LC))
|
||||||
|
BITSPERBYTE)
|
||||||
|
(CODEBASELT DEF (IPLUS 2 LC])
|
||||||
|
|
||||||
(PUTPROPS CODEBASESETA3 MACRO [OPENLAMBDA (DEF LC VALUE)
|
(PUTPROPS CODEBASESETA3 MACRO [OPENLAMBDA (DEF LC VALUE)
|
||||||
(CODEBASESETA DEF LC (\HILOC VALUE))
|
(CODEBASESETA DEF LC (\HILOC VALUE))
|
||||||
(CODEBASESETA DEF (ADD1 LC)
|
(CODEBASESETA DEF (ADD1 LC)
|
||||||
(LRSH (\LOLOC VALUE)
|
(LRSH (\LOLOC VALUE)
|
||||||
BITSPERBYTE))
|
BITSPERBYTE))
|
||||||
(CODEBASESETA DEF (IPLUS 2 LC)
|
(CODEBASESETA DEF (IPLUS 2 LC)
|
||||||
(IMOD (\LOLOC VALUE)
|
(IMOD (\LOLOC VALUE)
|
||||||
(CONSTANT (LLSH 1 BITSPERBYTE])
|
(CONSTANT (LLSH 1 BITSPERBYTE])
|
||||||
|
|
||||||
(PUTPROPS CODEBASESETA4 MACRO [OPENLAMBDA (DEF LC VALUE)
|
(PUTPROPS CODEBASESETA4 MACRO [OPENLAMBDA (DEF LC VALUE)
|
||||||
(CODEBASESETA DEF LC (LRSH (\HILOC VALUE)
|
(CODEBASESETA DEF LC (LRSH (\HILOC VALUE)
|
||||||
BITSPERBYTE))
|
BITSPERBYTE))
|
||||||
[CODEBASESETA DEF (ADD1 LC)
|
[CODEBASESETA DEF (ADD1 LC)
|
||||||
(IMOD (\HILOC VALUE)
|
(IMOD (\HILOC VALUE)
|
||||||
(CONSTANT (LLSH 1 BITSPERBYTE]
|
(CONSTANT (LLSH 1 BITSPERBYTE]
|
||||||
(CODEBASESETA DEF (IPLUS 2 LC)
|
(CODEBASESETA DEF (IPLUS 2 LC)
|
||||||
(LRSH (\LOLOC VALUE)
|
(LRSH (\LOLOC VALUE)
|
||||||
BITSPERBYTE))
|
BITSPERBYTE))
|
||||||
(CODEBASESETA DEF (IPLUS 3 LC)
|
(CODEBASESETA DEF (IPLUS 3 LC)
|
||||||
(IMOD (\LOLOC VALUE)
|
(IMOD (\LOLOC VALUE)
|
||||||
(CONSTANT (LLSH 1 BITSPERBYTE])
|
(CONSTANT (LLSH 1 BITSPERBYTE])
|
||||||
)
|
)
|
||||||
|
|
||||||
|
|
||||||
(DEFOPTIMIZER CODEBASESETATOM (DEFINITION OFFSET SYMBOL &ENVIRONMENT ENV)
|
(DEFOPTIMIZER CODEBASESETATOM (DEFINITION OFFSET SYMBOL &ENVIRONMENT ENV)
|
||||||
[COND
|
[COND
|
||||||
[(FMEMB :4-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV))
|
[(FMEMB :4-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV))
|
||||||
`(CODEBASESETA4 ,DEFINITION ,OFFSET ,SYMBOL]
|
`(CODEBASESETA4 ,DEFINITION ,OFFSET ,SYMBOL]
|
||||||
[(FMEMB :3-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV))
|
[(FMEMB :3-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV))
|
||||||
`(CODEBASESETA3 ,DEFINITION ,OFFSET ,SYMBOL]
|
`(CODEBASESETA3 ,DEFINITION ,OFFSET ,SYMBOL]
|
||||||
(T `(CODESETA2 ,DEFINITION ,OFFSET ,SYMBOL])
|
(T `(CODESETA2 ,DEFINITION ,OFFSET ,SYMBOL])
|
||||||
|
|
||||||
(DEFOPTIMIZER CODEBASEGETATOM (DEFINITION OFFSET SYMBOL &ENVIRONMENT ENV)
|
(DEFOPTIMIZER CODEBASEGETATOM (DEFINITION OFFSET SYMBOL &ENVIRONMENT ENV)
|
||||||
|
|
||||||
(* ;; "Get an atom out of a compiled function definition.")
|
(* ;; "Get an atom out of a compiled function definition.")
|
||||||
|
|
||||||
[COND
|
[COND
|
||||||
[(FMEMB :4-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV))
|
[(FMEMB :4-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV))
|
||||||
`(CODEBASELT4 ,DEFINITION ,OFFSET]
|
`(CODEBASELT4 ,DEFINITION ,OFFSET]
|
||||||
[(FMEMB :3-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV))
|
[(FMEMB :3-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV))
|
||||||
`(CODEBASELT3 ,DEFINITION ,OFFSET]
|
`(CODEBASELT3 ,DEFINITION ,OFFSET]
|
||||||
(T `(CODEBASELT2 ,DEFINITION ,OFFSET ,SYMBOL])
|
(T `(CODEBASELT2 ,DEFINITION ,OFFSET ,SYMBOL])
|
||||||
|
|
||||||
(DEFOPTIMIZER CODEBASEGETNAME (BASE OFFSET &ENVIRONMENT ENV)
|
(DEFOPTIMIZER CODEBASEGETNAME (BASE OFFSET &ENVIRONMENT ENV)
|
||||||
[COND
|
[COND
|
||||||
[(FMEMB :4-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV))
|
[(FMEMB :4-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV))
|
||||||
`(CODEBASEGETATOM ,BASE ,OFFSET]
|
`(CODEBASEGETATOM ,BASE ,OFFSET]
|
||||||
[(FMEMB :3-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV))
|
[(FMEMB :3-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV))
|
||||||
`(CODEBASEGETATOM ,BASE ,OFFSET]
|
`(CODEBASEGETATOM ,BASE ,OFFSET]
|
||||||
(T `(CODEBASELT2 ,BASE ,OFFSET])
|
(T `(CODEBASELT2 ,BASE ,OFFSET])
|
||||||
|
|
||||||
(DEFOPTIMIZER BYTESPERCODEATOM (&ENVIRONMENT ENV)
|
(DEFOPTIMIZER BYTESPERCODEATOM (&ENVIRONMENT ENV)
|
||||||
[COND
|
[COND
|
||||||
((FMEMB :4-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV))
|
((FMEMB :4-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV))
|
||||||
`(CONSTANT 4))
|
`(CONSTANT 4))
|
||||||
((FMEMB :3-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV))
|
((FMEMB :3-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV))
|
||||||
`(CONSTANT 3))
|
`(CONSTANT 3))
|
||||||
(T `(CONSTANT 2])
|
(T `(CONSTANT 2])
|
||||||
|
|
||||||
(DEFOPTIMIZER BIG-VMEM-HOST (NEW-SYMBOL-FORM OLD-SYMBOL-FORM &ENVIRONMENT ENV)
|
(DEFOPTIMIZER BIG-VMEM-HOST (NEW-SYMBOL-FORM OLD-SYMBOL-FORM &ENVIRONMENT ENV)
|
||||||
|
|
||||||
(* ;;
|
(* ;;
|
||||||
"Allow for differences between 4-byte pointers and 3-byte pointers..")
|
"Allow for differences between 4-byte pointers and 3-byte pointers..")
|
||||||
|
|
||||||
`(COND
|
`(COND
|
||||||
((FMEMB :4-BYTE COMPILER::*HOST-ARCHITECTURE*)
|
((FMEMB :4-BYTE COMPILER::*HOST-ARCHITECTURE*)
|
||||||
,NEW-SYMBOL-FORM)
|
,NEW-SYMBOL-FORM)
|
||||||
(T ,OLD-SYMBOL-FORM)))
|
(T ,OLD-SYMBOL-FORM)))
|
||||||
|
|
||||||
|
|
||||||
(FILESLOAD (LOADCOMP)
|
(FILESLOAD (LOADCOMP)
|
||||||
@@ -1133,8 +1128,8 @@ Copyright (c) 1982-1988, 1990-1992, 1995, 2017, 2021 by Venue & Xerox Corporatio
|
|||||||
|
|
||||||
(ADDTOVAR RDCOMS (FNS PRINTCODE PRINTCODENT BROKENDEF))
|
(ADDTOVAR RDCOMS (FNS PRINTCODE PRINTCODENT BROKENDEF))
|
||||||
|
|
||||||
(ADDTOVAR EXPANDMACROFNS NEXTBYTE PCVAR PRINJUMP CODEBASELT CODEBASELT2 CODEBASESETA
|
(ADDTOVAR EXPANDMACROFNS NEXTBYTE PCVAR PRINJUMP CODEBASELT CODEBASELT2 CODEBASESETA CODEBASESETA2
|
||||||
CODEBASESETA2 PRINTCODEHEADERDECODE)
|
PRINTCODEHEADERDECODE)
|
||||||
)
|
)
|
||||||
|
|
||||||
|
|
||||||
@@ -1157,14 +1152,11 @@ Copyright (c) 1982-1988, 1990-1992, 1995, 2017, 2021 by Venue & Xerox Corporatio
|
|||||||
(LOCALVARS . T)
|
(LOCALVARS . T)
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
(PUTPROPS ACODE COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1988 1990 1991
|
|
||||||
1992 1995 2017 2021))
|
|
||||||
(DECLARE%: DONTCOPY
|
(DECLARE%: DONTCOPY
|
||||||
(FILEMAP (NIL (3011 22577 (PRINTCODE 3021 . 20376) (PRINTCODENT 20378 . 22575)) (28577 40734 (
|
(FILEMAP (NIL (2919 22485 (PRINTCODE 2929 . 20284) (PRINTCODENT 20286 . 22483)) (28176 40396 (
|
||||||
CALLSCCODE 28587 . 40590) (RUNION 40592 . 40732)) (40735 49443 (CHANGECCODE 40745 . 44227) (CCCSUBFN?
|
CALLSCCODE 28186 . 40252) (RUNION 40254 . 40394)) (40397 49105 (CHANGECCODE 40407 . 43889) (CCCSUBFN?
|
||||||
44229 . 44940) (\SUBFNDEF 44942 . 45204) (CCCSCAN 45206 . 47961) (\CODEBLOCKP 47963 . 49441)) (49444
|
43891 . 44602) (\SUBFNDEF 44604 . 44866) (CCCSCAN 44868 . 47623) (\CODEBLOCKP 47625 . 49103)) (49106
|
||||||
54537 (\MAP-CODE-POINTERS 49454 . 50997) (\MAP-CODE-LITERALS 50999 . 54535)) (62696 65130 (
|
54199 (\MAP-CODE-POINTERS 49116 . 50659) (\MAP-CODE-LITERALS 50661 . 54197)) (61652 64086 (
|
||||||
\COPYCODEBLOCK 62706 . 63401) (\COPYFNHEADER 63403 . 64284) (\RECLAIMCODEBLOCK 64286 . 65128)) (65163
|
\COPYCODEBLOCK 61662 . 62357) (\COPYFNHEADER 62359 . 63240) (\RECLAIMCODEBLOCK 63242 . 64084)) (64119
|
||||||
70492 (LLBREAK 65173 . 65672) (BROKENDEF 65674 . 70490)) (70819 71445 (PRINTOPCODES 70829 . 71443))))
|
69448 (LLBREAK 64129 . 64628) (BROKENDEF 64630 . 69446)) (69771 70397 (PRINTOPCODES 69781 . 70395)))))
|
||||||
)
|
|
||||||
STOP
|
STOP
|
||||||
|
|||||||
Binary file not shown.
Reference in New Issue
Block a user