diff --git a/library/MSANALYZE b/library/MSANALYZE index bb3d2a74d..a7ea6e582 100644 --- a/library/MSANALYZE +++ b/library/MSANALYZE @@ -1,10 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "20-Feb-2024 09:28:38" {DSK}larry>il>medley>library>MSANALYZE.;2 61022 +(FILECREATED " 2-Oct-2025 23:05:25" {WMEDLEY}MSANALYZE.;4 61409 - :EDIT-BY "lmm" + :EDIT-BY rmk - :PREVIOUS-DATE "17-Feb-2024 22:10:56" {DSK}larry>il>medley>library>MSANALYZE.;3) + :CHANGES-TO (FNS CALLS) + + :PREVIOUS-DATE "20-Feb-2024 09:28:38" {WMEDLEY}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 diff --git a/library/MSANALYZE.DFASL b/library/MSANALYZE.DFASL index 9798dac71..69c945fa8 100644 Binary files a/library/MSANALYZE.DFASL and b/library/MSANALYZE.DFASL differ diff --git a/sources/ACODE b/sources/ACODE index d9923361c..b830abd43 100644 --- a/sources/ACODE +++ b/sources/ACODE @@ -1,14 +1,14 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "12-Mar-2021 11:17:48" {DSK}larry>ilisp>med>sources>ACODE.;6 71741 - changes to%: (FNS PRINTCODENT) +(FILECREATED " 2-Oct-2025 22:55:53" {DSK}kaplan>Local>medley3.5>working-medley>sources>ACODE.;2 70570 - previous date%: "12-Mar-2021 09:50:45" {DSK}larry>ilisp>med>sources>ACODE.;4) + :EDIT-BY rmk + :CHANGES-TO (FNS CALLSCCODE) + + :PREVIOUS-DATE "12-Mar-2021 11:17:48" +{DSK}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 (ADD1 LC))) + (LOGOR (LLSH (CODEBASELT DEF (IPLUS 2 LC)) BITSPERBYTE) - (CODEBASELT DEF (IPLUS 2 LC]) + (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 diff --git a/sources/ACODE.LCOM b/sources/ACODE.LCOM index c34af1c3d..583d2431f 100644 Binary files a/sources/ACODE.LCOM and b/sources/ACODE.LCOM differ