Compare commits
1 Commits
fgh_specif
...
rmk143--So
| Author | SHA1 | Date | |
|---|---|---|---|
|
55da53966b |
@@ -1,10 +1,12 @@
|
||||
(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)
|
||||
@@ -72,11 +74,13 @@
|
||||
(CADDR (CALLS FN USEDATABASE 'FREEVARS])
|
||||
|
||||
(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)")
|
||||
(* ;
|
||||
"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)
|
||||
FNDEF FLG)
|
||||
[COND
|
||||
@@ -84,19 +88,20 @@
|
||||
(GETD 'UPDATEFN))
|
||||
(UPDATEFN EXPR NIL 'ERROR)
|
||||
[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.")
|
||||
(if (OR (FMEMB VAR GLOBALVARS)
|
||||
(EQ (GETPROP VAR 'GLOBALVAR)
|
||||
T))
|
||||
then (pushnew GLOBALS VAR)
|
||||
NIL
|
||||
else T](* ; "Edited by TT (Date : 8-May-1990)")
|
||||
(if (OR (FMEMB VAR GLOBALVARS)
|
||||
(EQ (GETPROP VAR 'GLOBALVAR)
|
||||
T))
|
||||
then (pushnew GLOBALS VAR)
|
||||
NIL
|
||||
else T]
|
||||
(SETQ GLOBALS (SORT GLOBALS))
|
||||
(RETURN (LIST [AND (NOT VARSFLG)
|
||||
(GETRELATION EXPR '(CALL NOTERROR]
|
||||
(AND (NEQ VARSFLG 'FREEVARS)
|
||||
(GETRELATION EXPR 'BIND))
|
||||
(SORT (GETRELATION EXPR '(CALL NOTERROR]
|
||||
[AND (NEQ VARSFLG 'FREEVARS)
|
||||
(SORT (GETRELATION EXPR 'BIND]
|
||||
FREES GLOBALS]
|
||||
GETDLP
|
||||
(SETQ FNDEF (COND
|
||||
@@ -170,11 +175,13 @@
|
||||
then (pushnew GLOBALS VAR)
|
||||
NIL
|
||||
else T]
|
||||
(* ; "Edited by TT (Date : 8-May-1990)")
|
||||
(RETURN (LIST [COLLECTFNDATA (CONSTANT (MSVBNOTICED 'CALL
|
||||
(RETURN (LIST [SORT (COLLECTFNDATA (CONSTANT (MSVBNOTICED
|
||||
'CALL
|
||||
'NOTERROR]
|
||||
[COLLECTFNDATA (CONSTANT (MSVBNOTICED 'BIND]
|
||||
FREES GLOBALS]
|
||||
[SORT (COLLECTFNDATA (CONSTANT (MSVBNOTICED
|
||||
'BIND]
|
||||
(SORT FREES)
|
||||
(SORT GLOBALS]
|
||||
(T '?])
|
||||
|
||||
(COLLECTFNDATA
|
||||
@@ -1270,11 +1277,11 @@ DONTCOPY
|
||||
(BLOCK%: MSFINDP MSFINDP)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3487 10938 (VARS 3497 . 3636) (FREEVARS 3638 . 3789) (CALLS 3791 . 10089) (
|
||||
COLLECTFNDATA 10091 . 10462) (CALLS3 10464 . 10936)) (13187 51210 (ALLCALLS 13197 . 13797) (
|
||||
MSINITFNDATA 13799 . 14029) (MSPRGE 14031 . 21284) (MSPRGMACRO 21286 . 21997) (MSPRGCALL 21999 . 22316
|
||||
) (MSBINDVAR 22318 . 22825) (MSPRGRECORD 22827 . 29604) (MSPRGERR 29606 . 29769) (MSPRGTEMPLATE1 29771
|
||||
. 38819) (MSPRGTEMPLATE 38821 . 39424) (MSPRGLAMBDA 39426 . 48039) (MSPRGLST 48041 . 48203) (ADDTO
|
||||
48205 . 48985) (NLAMBDAFNP 48987 . 49713) (MSPRGDWIM 49715 . 50554) (MSDWIMTRAN 50556 . 51208)) (60485
|
||||
60921 (MSFINDP 60495 . 60919)))))
|
||||
(FILEMAP (NIL (3482 11325 (VARS 3492 . 3631) (FREEVARS 3633 . 3784) (CALLS 3786 . 10476) (
|
||||
COLLECTFNDATA 10478 . 10849) (CALLS3 10851 . 11323)) (13574 51597 (ALLCALLS 13584 . 14184) (
|
||||
MSINITFNDATA 14186 . 14416) (MSPRGE 14418 . 21671) (MSPRGMACRO 21673 . 22384) (MSPRGCALL 22386 . 22703
|
||||
) (MSBINDVAR 22705 . 23212) (MSPRGRECORD 23214 . 29991) (MSPRGERR 29993 . 30156) (MSPRGTEMPLATE1 30158
|
||||
. 39206) (MSPRGTEMPLATE 39208 . 39811) (MSPRGLAMBDA 39813 . 48426) (MSPRGLST 48428 . 48590) (ADDTO
|
||||
48592 . 49372) (NLAMBDAFNP 49374 . 50100) (MSPRGDWIM 50102 . 50941) (MSDWIMTRAN 50943 . 51595)) (60872
|
||||
61308 (MSFINDP 60882 . 61306)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
310
sources/ACODE
310
sources/ACODE
@@ -1,14 +1,14 @@
|
||||
(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)
|
||||
|
||||
@@ -35,7 +35,7 @@ Copyright (c) 1982-1988, 1990-1992, 1995, 2017, 2021 by Venue & Xerox Corporatio
|
||||
LLGC LLCODE LLBASIC MODARITH RENAMEMACROS))
|
||||
(ADDVARS (IGNOREFNS)))
|
||||
(COMS (* ;
|
||||
"Maintaining ref count consistency in code")
|
||||
"Maintaining ref count consistency in code")
|
||||
(FNS \COPYCODEBLOCK \COPYFNHEADER \RECLAIMCODEBLOCK))
|
||||
(COMS (* ; "Low-level break")
|
||||
(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
|
||||
CODEBASELT2 CODEBASESETA CODEBASESETA2
|
||||
PRINTCODEHEADERDECODE]
|
||||
(COMS (* ;
|
||||
"reference to opcodes symbolically")
|
||||
(COMS (* ; "reference to opcodes symbolically")
|
||||
(FNS PRINTOPCODES)
|
||||
(GLOBALVARS \OPCODES))
|
||||
(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
|
||||
|
||||
(PUTPROPS PCVAR MACRO [(IND LST NAME) (* lmm "11-AUG-81 22:27")
|
||||
(ALLOCAL (PROG NIL
|
||||
(PRIN2 [CADR (OR (ASSOC IND LST)
|
||||
(RETURN (printout OUTF "[" NAME IND
|
||||
"]"]
|
||||
OUTF])
|
||||
(PUTPROPS PCVAR MACRO [(IND LST NAME) (* lmm "11-AUG-81 22:27")
|
||||
(ALLOCAL (PROG NIL
|
||||
(PRIN2 [CADR (OR (ASSOC IND LST)
|
||||
(RETURN (printout OUTF "[" NAME IND "]"]
|
||||
OUTF])
|
||||
|
||||
(PUTPROPS PRINJUMP MACRO [LAMBDA (N)
|
||||
(PRIN1 "->" OUTF)
|
||||
(PRINTNUM I4 [SETQ N (IPLUS N (IDIFFERENCE CODELOC (ADD1 LEN]
|
||||
OUTF)
|
||||
(COND
|
||||
(LEVEL (PUTHASH N (SELECTQ LEVADJ
|
||||
((NCJUMP JUMP)
|
||||
LEVEL)
|
||||
(SUB1 LEVEL))
|
||||
\PRINTCODE.LEVEL)
|
||||
(PUTHASH N STK \PRINTCODE.STKSTATE])
|
||||
(PRIN1 "->" OUTF)
|
||||
(PRINTNUM I4 [SETQ N (IPLUS N (IDIFFERENCE CODELOC (ADD1 LEN]
|
||||
OUTF)
|
||||
(COND
|
||||
(LEVEL (PUTHASH N (SELECTQ LEVADJ
|
||||
((NCJUMP JUMP)
|
||||
LEVEL)
|
||||
(SUB1 LEVEL))
|
||||
\PRINTCODE.LEVEL)
|
||||
(PUTHASH N STK \PRINTCODE.STKSTATE])
|
||||
|
||||
(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)
|
||||
[for NAME in (CDR (RECORDFIELDNAMES 'FNHEADER T))
|
||||
when (AND NAME (CL:SYMBOLP NAME))
|
||||
do
|
||||
[SETQ I (EVAL `(INDEXF (fetch (FNHEADER
|
||||
,NAME]
|
||||
(COND
|
||||
((EQ NAME '%#FRAMENAME)
|
||||
(add I 1)))
|
||||
(COND
|
||||
((SETQ THERE (ASSOC I INDICES))
|
||||
(push (CDR THERE)
|
||||
NAME))
|
||||
(T (push INDICES (LIST I NAME]
|
||||
do [SETQ I
|
||||
(EVAL `(INDEXF (fetch (FNHEADER ,NAME]
|
||||
(COND
|
||||
((EQ NAME '%#FRAMENAME)
|
||||
(add I 1)))
|
||||
(COND
|
||||
((SETQ THERE (ASSOC I INDICES))
|
||||
(push (CDR THERE)
|
||||
NAME))
|
||||
(T (push INDICES (LIST I NAME]
|
||||
`(SELECTQ ,INDEX
|
||||
(\,@ [for PAIR in INDICES
|
||||
collect
|
||||
@@ -447,8 +444,8 @@ Copyright (c) 1982-1988, 1990-1992, 1995, 2017, 2021 by Venue & Xerox Corporatio
|
||||
(SELECTQ NAME
|
||||
((NATIVE CLOSUREP)
|
||||
`(AND
|
||||
(fetch
|
||||
(FNHEADER ,NAME)
|
||||
(fetch (FNHEADER
|
||||
,NAME)
|
||||
of ,CODEBASE)
|
||||
(PRIN1 ,(CONCAT "[" NAME
|
||||
"]")
|
||||
@@ -459,14 +456,13 @@ Copyright (c) 1982-1988, 1990-1992, 1995, 2017, 2021 by Venue & Xerox Corporatio
|
||||
(L-CASE (MKSTRING
|
||||
NAME))
|
||||
": ")
|
||||
(fetch (FNHEADER
|
||||
,NAME)
|
||||
(fetch (FNHEADER ,NAME)
|
||||
of ,CODEBASE]
|
||||
[(EQ (CADR PAIR)
|
||||
'%#FRAMENAME)
|
||||
`((printout ,OUTF " frame name: " .P2
|
||||
(1ST (fetch (FNHEADER
|
||||
%#FRAMENAME)
|
||||
(1ST (fetch (FNHEADER
|
||||
%#FRAMENAME)
|
||||
of ,CODEBASE]
|
||||
(T
|
||||
`((PRIN1
|
||||
@@ -491,10 +487,11 @@ Copyright (c) 1982-1988, 1990-1992, 1995, 2017, 2021 by Venue & Xerox Corporatio
|
||||
|
||||
(CALLSCCODE
|
||||
[LAMBDA (DEF OPTION FNAPPLY) (* DECLARATIONS%: (RECORD RESULT
|
||||
(LNCALLED CALLED BOUND USEDFREE
|
||||
GLOBALS)))
|
||||
(LNCALLED CALLED BOUND USEDFREE
|
||||
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:")
|
||||
@@ -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")
|
||||
(SETQ NTSIZE (fetch (FNHEADER NTSIZE) of CODEBASE))
|
||||
(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)
|
||||
BYTESPERWORD))
|
||||
(UNFOLD NTSIZE BYTESPERWORD)) by (BYTESPERNTOFFSETENTRY)
|
||||
BYTESPERWORD))
|
||||
(UNFOLD NTSIZE BYTESPERWORD)) by (BYTESPERNTOFFSETENTRY)
|
||||
until [NULL (SETQ NAME (\INDEXATOMVAL (GETNAMEENTRY CODEBASE NT1]
|
||||
do (SETQ TYPE (SELECTQ (NTSLOT-VARTYPE (GETNTOFFSET CODEBASE NT2))
|
||||
((IVARCODE PVARCODE)
|
||||
'BOUND)
|
||||
'USEDFREE)) (* ; "Top two bits of the entry indicate kind of name: 00(\NT.IVARCODE) = IVAR, 10(\NT.PVARCODE) = PVAR, 11 = FVAR")
|
||||
(SELECTQ OPTION
|
||||
((VARAPPLY APPLY)
|
||||
(CL:FUNCALL FNAPPLY NAME TYPE))
|
||||
(SELECTQ TYPE
|
||||
(BOUND (pushnew BOUND NAME))
|
||||
(pushnew USEDFREE NAME]
|
||||
((IVARCODE PVARCODE)
|
||||
'BOUND)
|
||||
'USEDFREE)) (* ; "Top two bits of the entry indicate kind of name: 00(\NT.IVARCODE) = IVAR, 10(\NT.PVARCODE) = PVAR, 11 = FVAR")
|
||||
(SELECTQ OPTION
|
||||
((VARAPPLY APPLY)
|
||||
(CL:FUNCALL FNAPPLY NAME TYPE))
|
||||
(SELECTQ TYPE
|
||||
(BOUND (pushnew BOUND NAME))
|
||||
(pushnew USEDFREE NAME]
|
||||
(PROG ((CODELOC (fetch (FNHEADER STARTPC) of CODEBASE))
|
||||
B B1 B2 B3 B4 B5 FN LEN)
|
||||
LP (SETQ B (NEXTBYTE))
|
||||
@@ -651,7 +648,7 @@ Copyright (c) 1982-1988, 1990-1992, 1995, 2017, 2021 by Venue & Xerox Corporatio
|
||||
(GO LP)
|
||||
COMPILED-CLOSURE
|
||||
(* ;
|
||||
"Compiled subfunction, recursively analyze it")
|
||||
"Compiled subfunction, recursively analyze it")
|
||||
[LET ((RESULT (CALLSCCODE FN OPTION FNAPPLY)))
|
||||
(AND RESULT (COND
|
||||
((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)
|
||||
NIL)
|
||||
(T (* ; "All free var references")
|
||||
(RUNION USEDFREE GLOBALS))
|
||||
(SORT (RUNION USEDFREE GLOBALS)))
|
||||
(create RESULT
|
||||
LNCALLED _ (REVERSE LNCALLED)
|
||||
CALLED _ (REVERSE CALLED)
|
||||
BOUND _ (REVERSE BOUND)
|
||||
USEDFREE _ (REVERSE USEDFREE)
|
||||
GLOBALS _ (REVERSE GLOBALS])
|
||||
LNCALLED _ (SORT LNCALLED)
|
||||
CALLED _ (SORT CALLED)
|
||||
BOUND _ (SORT BOUND)
|
||||
USEDFREE _ (SORT USEDFREE)
|
||||
GLOBALS _ (SORT GLOBALS])
|
||||
|
||||
(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)
|
||||
@@ -906,122 +903,120 @@ Copyright (c) 1982-1988, 1990-1992, 1995, 2017, 2021 by Venue & Xerox Corporatio
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS CODEBASELT MACRO [OPENLAMBDA (CODEBASE OFFSET)
|
||||
(COND
|
||||
((fetch (FNHEADER BYTESWAPPED) of CODEBASE)
|
||||
(\GETBASEBYTE CODEBASE (LOGXOR OFFSET 3)))
|
||||
(T (\GETBASEBYTE CODEBASE OFFSET])
|
||||
(COND
|
||||
((fetch (FNHEADER BYTESWAPPED) of CODEBASE)
|
||||
(\GETBASEBYTE CODEBASE (LOGXOR OFFSET 3)))
|
||||
(T (\GETBASEBYTE CODEBASE OFFSET])
|
||||
|
||||
(PUTPROPS CODEBASELT2 MACRO [OPENLAMBDA (DEF LC)
|
||||
(LOGOR (LLSH (CODEBASELT DEF LC)
|
||||
BITSPERBYTE)
|
||||
(CODEBASELT DEF (ADD1 LC])
|
||||
(LOGOR (LLSH (CODEBASELT DEF LC)
|
||||
BITSPERBYTE)
|
||||
(CODEBASELT DEF (ADD1 LC])
|
||||
|
||||
(PUTPROPS CODEBASESETA MACRO [OPENLAMBDA (CODEBASE OFFSET NEWVALUE)
|
||||
(COND
|
||||
((fetch (FNHEADER BYTESWAPPED) of CODEBASE)
|
||||
(\PUTBASEBYTE CODEBASE (LOGXOR OFFSET 3)
|
||||
NEWVALUE))
|
||||
(T (\PUTBASEBYTE CODEBASE OFFSET NEWVALUE])
|
||||
(COND
|
||||
((fetch (FNHEADER BYTESWAPPED) of CODEBASE)
|
||||
(\PUTBASEBYTE CODEBASE (LOGXOR OFFSET 3)
|
||||
NEWVALUE))
|
||||
(T (\PUTBASEBYTE CODEBASE OFFSET NEWVALUE])
|
||||
|
||||
(PUTPROPS CODEBASESETA2 MACRO [OPENLAMBDA (DEF LC VALUE)
|
||||
(CODEBASESETA DEF LC (LRSH VALUE BITSPERBYTE))
|
||||
(CODEBASESETA DEF (ADD1 LC)
|
||||
(IMOD VALUE (CONSTANT (LLSH 1 BITSPERBYTE])
|
||||
(CODEBASESETA DEF LC (LRSH VALUE BITSPERBYTE))
|
||||
(CODEBASESETA DEF (ADD1 LC)
|
||||
(IMOD VALUE (CONSTANT (LLSH 1 BITSPERBYTE])
|
||||
|
||||
(PUTPROPS CODEBASELT3 MACRO [OPENLAMBDA (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))
|
||||
(BIG-VMEM-CODE [\VAG2 (LOGOR (LLSH (CODEBASELT DEF LC)
|
||||
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)
|
||||
(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))
|
||||
(BIG-VMEM-CODE [\VAG2 (LOGOR (LLSH (CODEBASELT DEF LC)
|
||||
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)
|
||||
(CODEBASESETA DEF LC (\HILOC VALUE))
|
||||
(CODEBASESETA DEF (ADD1 LC)
|
||||
(LRSH (\LOLOC VALUE)
|
||||
BITSPERBYTE))
|
||||
(CODEBASESETA DEF (IPLUS 2 LC)
|
||||
(IMOD (\LOLOC VALUE)
|
||||
(CONSTANT (LLSH 1 BITSPERBYTE])
|
||||
(CODEBASESETA DEF LC (\HILOC VALUE))
|
||||
(CODEBASESETA DEF (ADD1 LC)
|
||||
(LRSH (\LOLOC VALUE)
|
||||
BITSPERBYTE))
|
||||
(CODEBASESETA DEF (IPLUS 2 LC)
|
||||
(IMOD (\LOLOC VALUE)
|
||||
(CONSTANT (LLSH 1 BITSPERBYTE])
|
||||
|
||||
(PUTPROPS CODEBASESETA4 MACRO [OPENLAMBDA (DEF LC VALUE)
|
||||
(CODEBASESETA DEF LC (LRSH (\HILOC VALUE)
|
||||
BITSPERBYTE))
|
||||
[CODEBASESETA DEF (ADD1 LC)
|
||||
(IMOD (\HILOC VALUE)
|
||||
(CONSTANT (LLSH 1 BITSPERBYTE]
|
||||
(CODEBASESETA DEF (IPLUS 2 LC)
|
||||
(LRSH (\LOLOC VALUE)
|
||||
BITSPERBYTE))
|
||||
(CODEBASESETA DEF (IPLUS 3 LC)
|
||||
(IMOD (\LOLOC VALUE)
|
||||
(CONSTANT (LLSH 1 BITSPERBYTE])
|
||||
(CODEBASESETA DEF LC (LRSH (\HILOC VALUE)
|
||||
BITSPERBYTE))
|
||||
[CODEBASESETA DEF (ADD1 LC)
|
||||
(IMOD (\HILOC VALUE)
|
||||
(CONSTANT (LLSH 1 BITSPERBYTE]
|
||||
(CODEBASESETA DEF (IPLUS 2 LC)
|
||||
(LRSH (\LOLOC VALUE)
|
||||
BITSPERBYTE))
|
||||
(CODEBASESETA DEF (IPLUS 3 LC)
|
||||
(IMOD (\LOLOC VALUE)
|
||||
(CONSTANT (LLSH 1 BITSPERBYTE])
|
||||
)
|
||||
|
||||
|
||||
(DEFOPTIMIZER CODEBASESETATOM (DEFINITION OFFSET SYMBOL &ENVIRONMENT ENV)
|
||||
[COND
|
||||
[(FMEMB :4-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV))
|
||||
`(CODEBASESETA4 ,DEFINITION ,OFFSET ,SYMBOL]
|
||||
[(FMEMB :3-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV))
|
||||
`(CODEBASESETA3 ,DEFINITION ,OFFSET ,SYMBOL]
|
||||
(T `(CODESETA2 ,DEFINITION ,OFFSET ,SYMBOL])
|
||||
[COND
|
||||
[(FMEMB :4-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV))
|
||||
`(CODEBASESETA4 ,DEFINITION ,OFFSET ,SYMBOL]
|
||||
[(FMEMB :3-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV))
|
||||
`(CODEBASESETA3 ,DEFINITION ,OFFSET ,SYMBOL]
|
||||
(T `(CODESETA2 ,DEFINITION ,OFFSET ,SYMBOL])
|
||||
|
||||
(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
|
||||
[(FMEMB :4-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV))
|
||||
`(CODEBASELT4 ,DEFINITION ,OFFSET]
|
||||
[(FMEMB :3-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV))
|
||||
`(CODEBASELT3 ,DEFINITION ,OFFSET]
|
||||
(T `(CODEBASELT2 ,DEFINITION ,OFFSET ,SYMBOL])
|
||||
[COND
|
||||
[(FMEMB :4-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV))
|
||||
`(CODEBASELT4 ,DEFINITION ,OFFSET]
|
||||
[(FMEMB :3-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV))
|
||||
`(CODEBASELT3 ,DEFINITION ,OFFSET]
|
||||
(T `(CODEBASELT2 ,DEFINITION ,OFFSET ,SYMBOL])
|
||||
|
||||
(DEFOPTIMIZER CODEBASEGETNAME (BASE OFFSET &ENVIRONMENT ENV)
|
||||
[COND
|
||||
[(FMEMB :4-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV))
|
||||
`(CODEBASEGETATOM ,BASE ,OFFSET]
|
||||
[(FMEMB :3-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV))
|
||||
`(CODEBASEGETATOM ,BASE ,OFFSET]
|
||||
(T `(CODEBASELT2 ,BASE ,OFFSET])
|
||||
[COND
|
||||
[(FMEMB :4-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV))
|
||||
`(CODEBASEGETATOM ,BASE ,OFFSET]
|
||||
[(FMEMB :3-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV))
|
||||
`(CODEBASEGETATOM ,BASE ,OFFSET]
|
||||
(T `(CODEBASELT2 ,BASE ,OFFSET])
|
||||
|
||||
(DEFOPTIMIZER BYTESPERCODEATOM (&ENVIRONMENT ENV)
|
||||
[COND
|
||||
((FMEMB :4-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV))
|
||||
`(CONSTANT 4))
|
||||
((FMEMB :3-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV))
|
||||
`(CONSTANT 3))
|
||||
(T `(CONSTANT 2])
|
||||
[COND
|
||||
((FMEMB :4-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV))
|
||||
`(CONSTANT 4))
|
||||
((FMEMB :3-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE ENV))
|
||||
`(CONSTANT 3))
|
||||
(T `(CONSTANT 2])
|
||||
|
||||
(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
|
||||
((FMEMB :4-BYTE COMPILER::*HOST-ARCHITECTURE*)
|
||||
,NEW-SYMBOL-FORM)
|
||||
(T ,OLD-SYMBOL-FORM)))
|
||||
`(COND
|
||||
((FMEMB :4-BYTE COMPILER::*HOST-ARCHITECTURE*)
|
||||
,NEW-SYMBOL-FORM)
|
||||
(T ,OLD-SYMBOL-FORM)))
|
||||
|
||||
|
||||
(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 EXPANDMACROFNS NEXTBYTE PCVAR PRINJUMP CODEBASELT CODEBASELT2 CODEBASESETA
|
||||
CODEBASESETA2 PRINTCODEHEADERDECODE)
|
||||
(ADDTOVAR EXPANDMACROFNS NEXTBYTE PCVAR PRINJUMP CODEBASELT CODEBASELT2 CODEBASESETA CODEBASESETA2
|
||||
PRINTCODEHEADERDECODE)
|
||||
)
|
||||
|
||||
|
||||
@@ -1157,14 +1152,11 @@ Copyright (c) 1982-1988, 1990-1992, 1995, 2017, 2021 by Venue & Xerox Corporatio
|
||||
(LOCALVARS . T)
|
||||
)
|
||||
)
|
||||
(PUTPROPS ACODE COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1988 1990 1991
|
||||
1992 1995 2017 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3011 22577 (PRINTCODE 3021 . 20376) (PRINTCODENT 20378 . 22575)) (28577 40734 (
|
||||
CALLSCCODE 28587 . 40590) (RUNION 40592 . 40732)) (40735 49443 (CHANGECCODE 40745 . 44227) (CCCSUBFN?
|
||||
44229 . 44940) (\SUBFNDEF 44942 . 45204) (CCCSCAN 45206 . 47961) (\CODEBLOCKP 47963 . 49441)) (49444
|
||||
54537 (\MAP-CODE-POINTERS 49454 . 50997) (\MAP-CODE-LITERALS 50999 . 54535)) (62696 65130 (
|
||||
\COPYCODEBLOCK 62706 . 63401) (\COPYFNHEADER 63403 . 64284) (\RECLAIMCODEBLOCK 64286 . 65128)) (65163
|
||||
70492 (LLBREAK 65173 . 65672) (BROKENDEF 65674 . 70490)) (70819 71445 (PRINTOPCODES 70829 . 71443))))
|
||||
)
|
||||
(FILEMAP (NIL (2919 22485 (PRINTCODE 2929 . 20284) (PRINTCODENT 20286 . 22483)) (28176 40396 (
|
||||
CALLSCCODE 28186 . 40252) (RUNION 40254 . 40394)) (40397 49105 (CHANGECCODE 40407 . 43889) (CCCSUBFN?
|
||||
43891 . 44602) (\SUBFNDEF 44604 . 44866) (CCCSCAN 44868 . 47623) (\CODEBLOCKP 47625 . 49103)) (49106
|
||||
54199 (\MAP-CODE-POINTERS 49116 . 50659) (\MAP-CODE-LITERALS 50661 . 54197)) (61652 64086 (
|
||||
\COPYCODEBLOCK 61662 . 62357) (\COPYFNHEADER 62359 . 63240) (\RECLAIMCODEBLOCK 63242 . 64084)) (64119
|
||||
69448 (LLBREAK 64129 . 64628) (BROKENDEF 64630 . 69446)) (69771 70397 (PRINTOPCODES 69781 . 70395)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Reference in New Issue
Block a user