diff --git a/sources/LLNEW b/sources/LLNEW index fdfec3cbf..c70005f42 100644 --- a/sources/LLNEW +++ b/sources/LLNEW @@ -1,18 +1,19 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 2-Feb-95 16:21:44" {DSK}sources>LLNEW.;15 69572 - changes to%: (RECORDS CONSPAGE) +(FILECREATED "27-Jul-2022 21:35:24" {DSK}larry>medley>sources>LLNEW.;4 69231 - previous date%: "24-Aug-94 10:56:08" {DSK}sources>LLNEW.;14) + :CHANGES-TO (FNS \GETBASEPTR \RPLPTR \RPLPTR.UFN) + + :PREVIOUS-DATE "27-Jul-2022 13:21:34" {DSK}larry>medley>sources>LLNEW.;3) (* ; " -Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1990, 1992, 1993, 1994, 1995 by Venue & Xerox Corporation. All rights reserved. +Copyright (c) 1981-1987, 1990, 1992-1995, 2022 by Venue & Xerox Corporation. ") (PRETTYCOMPRINT LLNEWCOMS) -(RPAQQ LLNEWCOMS +(RPAQQ LLNEWCOMS ((PROPS (LLNEW FILETYPE)) (DECLARE%: DONTCOPY EVAL@COMPILE (FILES (LOADCOMP) LLCODE)) @@ -82,15 +83,13 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1990, 1992, 1993, 1994, (DECLARE%: DONTCOPY (EXPORT (MACROS LOCAL ALLOCAL)) (ADDVARS (MKI.SUBFNS (CHECK . *) (RAID . HELP) - (UNINTERRUPTABLY - . PROGN) + (UNINTERRUPTABLY . PROGN) (\StatsAdd1 . *) (EVQ . I.\COPY) (COPY . I.\COPY)) (RD.SUBFNS (CHECK . *) (RAID . HELP) - (UNINTERRUPTABLY - . PROGN) + (UNINTERRUPTABLY . PROGN) (\StatsAdd1 . *) (EVQ . V\COPY) (COPY . V\COPY) @@ -100,7 +99,7 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1990, 1992, 1993, 1994, (ADDVARS (DONTCOMPILEFNS MAKEINITFIRST \COPY MAKEINITLAST \UNCOPY] (LOCALVARS . T))) -(PUTPROPS LLNEW FILETYPE :BCOMPL) +(PUTPROPS LLNEW FILETYPE :BCOMPL) (DECLARE%: DONTCOPY EVAL@COMPILE (FILESLOAD (LOADCOMP) @@ -215,12 +214,14 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1990, 1992, 1993, 1994, BYTE]) (\GETBASEPTR - [LAMBDA (X D) (* ; "Edited 24-Aug-94 09:29 by sybalsky") + [LAMBDA (X D) (* ; "Edited 27-Jul-2022 21:19 by larry") + (* ; "Edited 24-Aug-94 09:29 by sybalsky") - (* ;; - "usually done in microcode; this def. uses GETBASE, VAG2, etc. and handles overflows too") + (* ;; "usually done in microcode; this def. used by makeinit") + + (* ;; "usually not done here unless interpreted") - (\VAG2 (\GETBASE X D) + (\VAG2 (LOGAND 4095 (\GETBASE X D)) (\GETBASE (\ADDBASE X 1) D]) @@ -255,24 +256,27 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1990, 1992, 1993, 1994, (.COERCE.TO.SMALLPOSP. L]) (\RPLPTR - [LAMBDA (OBJ OFFSET VAL) (* lmm " 3-NOV-81 12:10") + [LAMBDA (OBJ OFFSET VAL) (* ; + "Edited 27-Jul-2022 21:25 by larry: Only called interpreted or (renamed) during MAKEINIT") + (* lmm " 3-NOV-81 12:10") (UNINTERRUPTABLY (\ADDREF VAL) (\DELREF (\GETBASEPTR (SETQ OBJ (\ADDBASE OBJ OFFSET)) 0)) - (\PUTBASEBYTE OBJ 1 (\HILOC VAL)) (* ; - "\PUTBASEPTR smashes the high byte") + (\PUTBASE OBJ 0 (LOGOR (LOGAND 61440 (\GETBASE OBJ 0)) + (\HILOC VAL))) (* ; "\PUTBASEPTR smashes the high ") (\PUTBASE OBJ 1 (\LOLOC VAL)) VAL)]) (\RPLPTR.UFN - [LAMBDA (OBJ VAL OFFSET) (* ; "Edited 14-Jan-87 16:34 by Pavel") + [LAMBDA (OBJ VAL OFFSET) (* ; "Edited 27-Jul-2022 21:30 by larry") + (* ; "Edited 14-Jan-87 16:34 by Pavel") (* ;;; "The UFN is different from the function since the offset (inline) gets pushed last.") (LET ((SLOT (\ADDBASE OBJ OFFSET))) (UNINTERRUPTABLY - + (* ;; "Fix up the reference counts.") (\ADDREF VAL) @@ -280,7 +284,8 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1990, 1992, 1993, 1994, (* ;; "\PUTBASEPTR smashes the high byte, so we use two calls instead.") - (\PUTBASEBYTE SLOT 1 (\HILOC VAL)) + (\PUTBASE SLOT 0 (LOGOR (LOGAND 61440 (\GETBASE SLOT 0)) + (\HILOC VAL))) (\PUTBASE SLOT 1 (\LOLOC VAL)) (* ;; "Be sure to return the OBJ; code generated by the new compiler counts on it.") @@ -330,7 +335,7 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1990, 1992, 1993, 1994, (CL::COMPLEX-IMAGPART Y]) ) -(PUTPROPS EQL BYTEMACRO COMP.EQ) +(PUTPROPS EQL BYTEMACRO COMP.EQ) (DEFINEQ (LOC @@ -377,55 +382,55 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1990, 1992, 1993, 1994, (* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE (ACCESSFNS POINTER [(PAGE# (IPLUS (LLSH (\HILOC DATUM) - 8) - (LRSH (\LOLOC DATUM) - 8))) - (WORDINPAGE (LOGAND (\LOLOC DATUM) - 255)) - (CELLINPAGE (LRSH (fetch WORDINPAGE of DATUM) - 1)) - (BYTEINPAGE (LLSH (fetch WORDINPAGE of DATUM) - 1)) - (SEGMENT# (\HILOC DATUM)) - (WORDINSEGMENT (\LOLOC DATUM)) - (CELLINSEGMENT (LRSH (fetch WORDINSEGMENT of DATUM) - 1)) - (WORD# (fetch WORDINPAGE of DATUM)) - (DBLWORD# (fetch CELLINPAGE of DATUM)) - (PAGEBASE (\VAG2 (\HILOC DATUM) - (LOGAND (\LOLOC DATUM) - 65280] - (CREATE (\VAG2 (LRSH PAGE# 8) - (LLSH (LOGAND PAGE# 255) - 8)))) + 8) + (LRSH (\LOLOC DATUM) + 8))) + (WORDINPAGE (LOGAND (\LOLOC DATUM) + 255)) + (CELLINPAGE (LRSH (fetch WORDINPAGE of DATUM) + 1)) + (BYTEINPAGE (LLSH (fetch WORDINPAGE of DATUM) + 1)) + (SEGMENT# (\HILOC DATUM)) + (WORDINSEGMENT (\LOLOC DATUM)) + (CELLINSEGMENT (LRSH (fetch WORDINSEGMENT of DATUM) + 1)) + (WORD# (fetch WORDINPAGE of DATUM)) + (DBLWORD# (fetch CELLINPAGE of DATUM)) + (PAGEBASE (\VAG2 (\HILOC DATUM) + (LOGAND (\LOLOC DATUM) + 65280] + (CREATE (\VAG2 (LRSH PAGE# 8) + (LLSH (LOGAND PAGE# 255) + 8)))) (ACCESSFNS WORD ((HIBYTE (LRSH DATUM 8)) - (LOBYTE (LOGAND DATUM 255))) - (CREATE (IPLUS (LLSH HIBYTE 8) - LOBYTE))) + (LOBYTE (LOGAND DATUM 255))) + (CREATE (IPLUS (LLSH HIBYTE 8) + LOBYTE))) ) (DECLARE%: EVAL@COMPILE -[PUTPROPS PTRGTP MACRO (OPENLAMBDA (X Y) - (OR (IGREATERP (\HILOC X) - (\HILOC Y)) - (AND (EQ (\HILOC X) - (\HILOC Y)) - (IGREATERP (\LOLOC X) - (\LOLOC Y] - -[PUTPROPS .COERCE.TO.SMALLPOSP. DMACRO (OPENLAMBDA (X) - (COND - ((SMALLPOSP X) - X) - (T (\ILLEGAL.ARG X] - -[PUTPROPS .COERCE.TO.BYTE. DMACRO (OPENLAMBDA (X) +(PUTPROPS PTRGTP MACRO [OPENLAMBDA (X Y) + (OR (IGREATERP (\HILOC X) + (\HILOC Y)) + (AND (EQ (\HILOC X) + (\HILOC Y)) + (IGREATERP (\LOLOC X) + (\LOLOC Y]) + +(PUTPROPS .COERCE.TO.SMALLPOSP. DMACRO [OPENLAMBDA (X) (COND - ([AND (SMALLPOSP X) - (ILESSP X (CONSTANT (LLSH 1 BITSPERBYTE] + ((SMALLPOSP X) X) - (T (\ILLEGAL.ARG X] + (T (\ILLEGAL.ARG X]) + +(PUTPROPS .COERCE.TO.BYTE. DMACRO [OPENLAMBDA (X) + (COND + ([AND (SMALLPOSP X) + (ILESSP X (CONSTANT (LLSH 1 BITSPERBYTE] + X) + (T (\ILLEGAL.ARG X]) ) (* "END EXPORTED DEFINITIONS") @@ -435,40 +440,40 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1990, 1992, 1993, 1994, (ADDTOVAR INEWCOMS (FNS \GETBASEBYTE \PUTBASEBYTE CREATEPAGES \NEW4PAGE)) (ADDTOVAR RDCOMS (FNS \CAR.UFN \CDR.UFN) - (FNS \COPY \UNCOPY) - (FNS \GETBASEBYTE \PUTBASEBYTE)) + (FNS \COPY \UNCOPY) + (FNS \GETBASEBYTE \PUTBASEBYTE)) (ADDTOVAR INITPTRS (\LISTPDTD)) (ADDTOVAR MKI.SUBFNS (\ADDBASE . I.ADDBASE) - (\GETBASE . I.GETBASE) - (\PUTBASE . I.PUTBASE) - (\GETBASEPTR . I.GETBASEPTR) - (\PUTBASEPTR . I.PUTBASEPTR) - (\HILOC . I.HILOC) - (\LOLOC . I.LOLOC) - (\VAG2 . I.VAG2) - (.COERCE.TO.SMALLPOSP. . PROG1) - (.COERCE.TO.BYTE. . PROG1) - (LOCKEDPAGEP . MKI.LOCKEDPAGEP) - (\RPLPTR . I.PUTBASEPTR) - (CONS . I.\CONS.UFN)) + (\GETBASE . I.GETBASE) + (\PUTBASE . I.PUTBASE) + (\GETBASEPTR . I.GETBASEPTR) + (\PUTBASEPTR . I.PUTBASEPTR) + (\HILOC . I.HILOC) + (\LOLOC . I.LOLOC) + (\VAG2 . I.VAG2) + (.COERCE.TO.SMALLPOSP. . PROG1) + (.COERCE.TO.BYTE. . PROG1) + (LOCKEDPAGEP . MKI.LOCKEDPAGEP) + (\RPLPTR . I.PUTBASEPTR) + (CONS . I.\CONS.UFN)) (ADDTOVAR RD.SUBFNS (\ADDBASE . VADDBASE) - (\GETBASE . VGETBASE) - (\PUTBASE . VPUTBASE) - (\GETBASEPTR . VGETBASEPTR) - (\PUTBASEPTR . VPUTBASEPTR) - (\HILOC . VHILOC) - (\LOLOC . VLOLOC) - (\VAG2 . VVAG2) - (.COERCE.TO.SMALLPOSP. . PROG1) - (.COERCE.TO.BYTE. . PROG1) - (PTRGTP . IGREATERP) - (\RPLPTR . VPUTBASEPTR) - (CAR . V\CAR.UFN) - (CDR . V\CDR.UFN) - (CAR/CDRERR . T)) + (\GETBASE . VGETBASE) + (\PUTBASE . VPUTBASE) + (\GETBASEPTR . VGETBASEPTR) + (\PUTBASEPTR . VPUTBASEPTR) + (\HILOC . VHILOC) + (\LOLOC . VLOLOC) + (\VAG2 . VVAG2) + (.COERCE.TO.SMALLPOSP. . PROG1) + (.COERCE.TO.BYTE. . PROG1) + (PTRGTP . IGREATERP) + (\RPLPTR . VPUTBASEPTR) + (CAR . V\CAR.UFN) + (CDR . V\CDR.UFN) + (CAR/CDRERR . T)) EVAL@COMPILE (ADDTOVAR DONTCOMPILEFNS CREATEPAGES) @@ -902,40 +907,40 @@ EVAL@COMPILE (* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE (BLOCKRECORD LISTP ( - (* ;; "Describes a CONS cell.") + (* ;; "Describes a CONS cell.") - (CAR POINTER) - (CDR POINTER)) - (CREATE (CREATECELL \LISTP)) + (CAR POINTER) + (CDR POINTER)) + (CREATE (CREATECELL \LISTP)) - (* ;; "FOLLOWING ARE CDR-CODE FIELDS") + (* ;; "FOLLOWING ARE CDR-CODE FIELDS") - (BLOCKRECORD LISTP ((CDRCODE BITS 4) - (CARFIELD XPOINTER))) + (BLOCKRECORD LISTP ((CDRCODE BITS 4) + (CARFIELD XPOINTER))) - (* ;; "For chaining together free cells on a page:") + (* ;; "For chaining together free cells on a page:") - (BLOCKRECORD LISTP ((NEXTFREE BYTE) - (NIL BITS 24))) - [ACCESSFNS LISTP ((FULLCARFIELD NIL (\PUTBASEPTR DATUM 0 NEWVALUE] + (BLOCKRECORD LISTP ((NEXTFREE BYTE) + (NIL BITS 24))) + [ACCESSFNS LISTP ((FULLCARFIELD NIL (\PUTBASEPTR DATUM 0 NEWVALUE] - (* ;; "because replace of XPOINTER is slow, the CAR field is stored with PUTBASEPTR, even though that smashes the hi byte") + (* ;; "because replace of XPOINTER is slow, the CAR field is stored with PUTBASEPTR, even though that smashes the hi byte") - ) + ) (BLOCKRECORD CONSPAGE ( - (* ;; - "Describes a page of CONS cells, which (when free) are chained together thru the top byte.") - - (NIL 2 FIXP) (* ; - "Empty cells, space for another 2 CONS cells if we can figure out how.") - (CNT BYTE) (* ; "# of cells free on this page") - (NEXTCELL BYTE) (* ; - "WORD offset of next free cell (not guaranteed to be 0 if no free cells)") - (NIL WORD) (* ; "Padding") - (NEXTPAGE FIXP) (* ; - "Next CONS page on the DTD's free list, for searching for cells.") - )) + (* ;; + "Describes a page of CONS cells, which (when free) are chained together thru the top byte.") + + (NIL 2 FIXP) (* ; + "Empty cells, space for another 2 CONS cells if we can figure out how.") + (CNT BYTE) (* ; "# of cells free on this page") + (NEXTCELL BYTE) (* ; + "WORD offset of next free cell (not guaranteed to be 0 if no free cells)") + (NIL WORD) (* ; "Padding") + (NEXTPAGE FIXP) (* ; + "Next CONS page on the DTD's free list, for searching for cells.") + )) ) (RPAQQ CONSCONSTANTS (\CDR.ONPAGE \CDR.NIL \CDR.INDIRECT \CDR.MAXINDIRECT \CONSPAGE.LAST)) @@ -960,128 +965,118 @@ EVAL@COMPILE (DECLARE%: EVAL@COMPILE -[PUTPROPS .MAKECONSCELL. MACRO (OPENLAMBDA (PAGE A D) - (PROG [(.MK.NEWCELL (\ADDBASE PAGE (fetch (CONSPAGE - NEXTCELL) - of PAGE] - (CHECK (NEQ (fetch (CONSPAGE CNT) of PAGE) - 0) - (EVENP (fetch (CONSPAGE NEXTCELL) of - PAGE))) - (replace (CONSPAGE NEXTCELL) of PAGE - with (fetch (LISTP NEXTFREE) of - .MK.NEWCELL - )) - (CHECK (EVENP (fetch (CONSPAGE NEXTCELL) of - PAGE))) - (add (fetch (CONSPAGE CNT) of PAGE) - -1) - (replace (LISTP FULLCARFIELD) of .MK.NEWCELL - with A) - (replace (LISTP CDRCODE) of .MK.NEWCELL - with D) - (RETURN .MK.NEWCELL] - -[PUTPROPS .FINDCLOSEPRIOR. MACRO - (OPENLAMBDA (PG A D) - (LET ((CDROFFSET (LOGAND (\LOLOC D) - 255)) - (OFFSET (fetch (CONSPAGE NEXTCELL) of PG)) - CELL PRIOR) - (WHILE (NEQ OFFSET 0) - DO (COND - ((AND (ILEQ OFFSET CDROFFSET) - (IGEQ OFFSET (IDIFFERENCE CDROFFSET 14))) - - (* ;; - "There's a cell close enough. Take it off the chain and return it.") - - [COND - [PRIOR - (* ;; - "There was a prior entry in the chain; detach this one.") - - (REPLACE (LISTP NEXTFREE) OF (\ADDBASE PG - PRIOR) - WITH (FETCH (LISTP NEXTFREE) - OF (SETQ CELL (\ADDBASE PG OFFSET] - (T - (* ;; "No prior entry; set the conspage's NEXTCELL entry.") - - (REPLACE (CONSPAGE NEXTCELL) OF PG - WITH (FETCH (LISTP NEXTFREE) - OF (SETQ CELL (\ADDBASE PG OFFSET] - (add (fetch (CONSPAGE CNT) of PG) - -1) - (replace (LISTP FULLCARFIELD) of CELL with A) - (replace (LISTP CDRCODE) of CELL - with (LOGOR \CDR.ONPAGE (LRSH (IDIFFERENCE CDROFFSET OFFSET) - 1))) - (RETURN CELL))) +(PUTPROPS .MAKECONSCELL. MACRO (OPENLAMBDA (PAGE A D) + (PROG [(.MK.NEWCELL (\ADDBASE PAGE (fetch (CONSPAGE NEXTCELL) + of PAGE] + (CHECK (NEQ (fetch (CONSPAGE CNT) of PAGE) + 0) + (EVENP (fetch (CONSPAGE NEXTCELL) of PAGE))) + (replace (CONSPAGE NEXTCELL) of PAGE + with (fetch (LISTP NEXTFREE) of .MK.NEWCELL)) + (CHECK (EVENP (fetch (CONSPAGE NEXTCELL) of PAGE))) + (add (fetch (CONSPAGE CNT) of PAGE) + -1) + (replace (LISTP FULLCARFIELD) of .MK.NEWCELL with A) + (replace (LISTP CDRCODE) of .MK.NEWCELL with D) + (RETURN .MK.NEWCELL)))) + +(PUTPROPS .FINDCLOSEPRIOR. MACRO [OPENLAMBDA (PG A D) + (LET ((CDROFFSET (LOGAND (\LOLOC D) + 255)) + (OFFSET (fetch (CONSPAGE NEXTCELL) of PG)) + CELL PRIOR) + (WHILE (NEQ OFFSET 0) + DO (COND + ((AND (ILEQ OFFSET CDROFFSET) + (IGEQ OFFSET (IDIFFERENCE CDROFFSET 14))) + + (* ;; + "There's a cell close enough. Take it off the chain and return it.") + + [COND + [PRIOR + (* ;; + "There was a prior entry in the chain; detach this one.") + + (REPLACE (LISTP NEXTFREE) + OF (\ADDBASE PG PRIOR) + WITH (FETCH (LISTP NEXTFREE) + OF (SETQ CELL (\ADDBASE PG + OFFSET] + (T + (* ;; + "No prior entry; set the conspage's NEXTCELL entry.") + + (REPLACE (CONSPAGE NEXTCELL) OF PG + WITH (FETCH (LISTP NEXTFREE) + OF (SETQ CELL (\ADDBASE PG OFFSET] + (add (fetch (CONSPAGE CNT) of PG) + -1) + (replace (LISTP FULLCARFIELD) of CELL with A) + (replace (LISTP CDRCODE) of CELL + with (LOGOR \CDR.ONPAGE (LRSH (IDIFFERENCE + CDROFFSET OFFSET) + 1))) + (RETURN CELL))) + (SETQ PRIOR OFFSET) + (SETQ OFFSET (FETCH (LISTP NEXTFREE) + OF (\ADDBASE PG OFFSET]) + +(PUTPROPS .FINDCDRABLEPAIR. MACRO + [OPENLAMBDA (PG A D) + (LET ((OFFSET (fetch (CONSPAGE NEXTCELL) of PG)) + CELL PRIOR PRIORPRIOR) + (AND (IGEQ (FETCH (CONSPAGE CNT) OF PG) + 2) + (WHILE (NEQ OFFSET 0) + DO (COND + ((AND PRIOR (ILEQ OFFSET PRIOR) + (IGEQ OFFSET (IDIFFERENCE PRIOR 14))) + + (* ;; + "There's a cell close enough. Take it off the chain and return it.") + + [COND + [PRIORPRIOR + + (* ;; + "There was a prior entry in the chain; detach this one.") + + (REPLACE (LISTP NEXTFREE) OF (\ADDBASE PG PRIORPRIOR) + WITH (FETCH (LISTP NEXTFREE) OF (SETQ CELL + (\ADDBASE PG OFFSET] + (T + (* ;; "No prior entry; set the conspage's NEXTCELL entry.") + + (REPLACE (CONSPAGE NEXTCELL) OF PG + WITH (FETCH (LISTP NEXTFREE) OF (SETQ CELL (\ADDBASE PG + OFFSET] + (add (fetch (CONSPAGE CNT) of PG) + -2) + (\PUTBASEPTR (\ADDBASE PG PRIOR) + 0 D) + (REPLACE (LISTP FULLCARFIELD) OF CELL WITH A) + (REPLACE (LISTP CDRCODE) OF CELL WITH (LRSH (IDIFFERENCE PRIOR OFFSET + ) + 1)) + (RETURN CELL))) + (SETQ PRIORPRIOR PRIOR) (SETQ PRIOR OFFSET) - (SETQ OFFSET (FETCH (LISTP NEXTFREE) OF (\ADDBASE PG OFFSET] - -[PUTPROPS .FINDCDRABLEPAIR. MACRO - (OPENLAMBDA (PG A D) - (LET ((OFFSET (fetch (CONSPAGE NEXTCELL) of PG)) - CELL PRIOR PRIORPRIOR) - (AND (IGEQ (FETCH (CONSPAGE CNT) OF PG) - 2) - (WHILE (NEQ OFFSET 0) - DO (COND - ((AND PRIOR (ILEQ OFFSET PRIOR) - (IGEQ OFFSET (IDIFFERENCE PRIOR 14))) - - (* ;; - "There's a cell close enough. Take it off the chain and return it.") - - [COND - [PRIORPRIOR - - (* ;; - "There was a prior entry in the chain; detach this one.") - - (REPLACE (LISTP NEXTFREE) OF (\ADDBASE - PG PRIORPRIOR) - WITH (FETCH (LISTP NEXTFREE) - OF (SETQ CELL (\ADDBASE PG - OFFSET] - (T - (* ;; - "No prior entry; set the conspage's NEXTCELL entry.") - - (REPLACE (CONSPAGE NEXTCELL) OF PG - WITH (FETCH (LISTP NEXTFREE) - OF (SETQ CELL (\ADDBASE PG OFFSET] - (add (fetch (CONSPAGE CNT) of PG) - -2) - (\PUTBASEPTR (\ADDBASE PG PRIOR) - 0 D) - (REPLACE (LISTP FULLCARFIELD) OF CELL WITH A) - (REPLACE (LISTP CDRCODE) OF CELL - WITH (LRSH (IDIFFERENCE PRIOR OFFSET) - 1)) - (RETURN CELL))) - (SETQ PRIORPRIOR PRIOR) - (SETQ PRIOR OFFSET) - (SETQ OFFSET (FETCH (LISTP NEXTFREE) OF (\ADDBASE PG - OFFSET] - -[PUTPROPS .FINDPAIR. MACRO (OPENLAMBDA (A D) - (LET ((PG (fetch DTDNEXTPAGE of \LISTPDTD)) - CELL CPG) - [WHILE (IGREATERP PG 0) - DO (COND - ((SETQ CELL (.FINDCDRABLEPAIR. (SETQ CPG - (CREATE - POINTER - PAGE# _ PG)) - A D)) - (RETURN CELL)) - (T (SETQ PG (FETCH (CONSPAGE NEXTPAGE) - OF CPG] - (OR CELL (.FINDCDRABLEPAIR. (\NEXTCONSPAGE) - A D] + (SETQ OFFSET (FETCH (LISTP NEXTFREE) OF (\ADDBASE PG OFFSET]) + +(PUTPROPS .FINDPAIR. MACRO [OPENLAMBDA (A D) + (LET ((PG (fetch DTDNEXTPAGE of \LISTPDTD)) + CELL CPG) + [WHILE (IGREATERP PG 0) + DO (COND + ((SETQ CELL (.FINDCDRABLEPAIR. (SETQ CPG + (CREATE POINTER + PAGE# _ PG)) + A D)) + (RETURN CELL)) + (T (SETQ PG (FETCH (CONSPAGE NEXTPAGE) OF CPG] + (OR CELL (.FINDCDRABLEPAIR. (\NEXTCONSPAGE) + A D]) ) @@ -1138,8 +1133,8 @@ EVAL@COMPILE (DECLARE%: DONTCOPY (DECLARE%: EVAL@COMPILE -[PUTPROPS !CHECK MACRO ((X) - (OR X (RAID 'X] +(PUTPROPS !CHECK MACRO [(X) + (OR X (RAID 'X]) ) ) @@ -1390,10 +1385,10 @@ EVAL@COMPILE (DECLARE%: DONTCOPY (* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE -(PUTPROPS LOCAL MACRO ((X) +(PUTPROPS LOCAL MACRO ((X) X)) -(PUTPROPS ALLOCAL MACRO ((X) +(PUTPROPS ALLOCAL MACRO ((X) X)) ) @@ -1402,21 +1397,19 @@ EVAL@COMPILE (ADDTOVAR MKI.SUBFNS (CHECK . *) - (RAID . HELP) - (UNINTERRUPTABLY - . PROGN) - (\StatsAdd1 . *) - (EVQ . I.\COPY) - (COPY . I.\COPY)) + (RAID . HELP) + (UNINTERRUPTABLY . PROGN) + (\StatsAdd1 . *) + (EVQ . I.\COPY) + (COPY . I.\COPY)) (ADDTOVAR RD.SUBFNS (CHECK . *) - (RAID . HELP) - (UNINTERRUPTABLY - . PROGN) - (\StatsAdd1 . *) - (EVQ . V\COPY) - (COPY . V\COPY) - (1ST . V\UNCOPY)) + (RAID . HELP) + (UNINTERRUPTABLY . PROGN) + (\StatsAdd1 . *) + (EVQ . V\COPY) + (COPY . V\COPY) + (1ST . V\UNCOPY)) (ADDTOVAR INEWCOMS (FNS MAKEINITFIRST \COPY MAKEINITLAST)) @@ -1429,19 +1422,19 @@ EVAL@COMPILE (LOCALVARS . T) ) (PUTPROPS LLNEW COPYRIGHT ("Venue & Xerox Corporation" 1981 1982 1983 1984 1985 1986 1987 1990 1992 -1993 1994 1995)) +1993 1994 1995 2022)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (5895 12403 (\ADDBASE 5905 . 6712) (\GETBASE 6714 . 6958) (\PUTBASE 6960 . 7236) ( -\PUTBASE.UFN 7238 . 7518) (\PUTBASEPTR.UFN 7520 . 7842) (\PUTBITS.UFN 7844 . 8550) (\GETBASEBYTE 8552 - . 8979) (\PUTBASEBYTE 8981 . 9672) (\GETBASEPTR 9674 . 10012) (\PUTBASEPTR 10014 . 10332) (\HILOC -10334 . 10558) (\LOLOC 10560 . 10784) (\VAG2 10786 . 11161) (\RPLPTR 11163 . 11640) (\RPLPTR.UFN 11642 - . 12401)) (12404 13819 (EQ 12414 . 12632) (EQL 12634 . 13817)) (13858 14608 (LOC 13868 . 14199) (VAG -14201 . 14606)) (14609 15650 (CREATEPAGES 14619 . 15108) (\NEW4PAGE 15110 . 15648)) (20046 38779 (CONS - 20056 . 20362) (\CONS.UFN 20364 . 22782) (\MAIKO.CONS.UFN 22784 . 25037) (CAR 25039 . 25166) ( -\CAR.UFN 25168 . 26271) (CDR 26273 . 26400) (\CDR.UFN 26402 . 28001) (RPLACA 28003 . 28230) ( -\RPLACA.UFN 28232 . 29231) (RPLACD 29233 . 29368) (\RPLACD.UFN 29370 . 33121) (DOCOLLECT 33123 . 33387 -) (\RPLCONS 33389 . 35399) (ENDCOLLECT 35401 . 35609) (\INITCONSPAGE 35611 . 38173) (\NEXTCONSPAGE -38175 . 38777)) (38837 41172 (\RESTLIST.UFN 38847 . 39945) (\FINDKEY.UFN 39947 . 41170)) (51822 53618 -(CHECKCONSPAGES 51832 . 52771) (\CHECKCONSPAGE 52773 . 53616)) (53786 68392 (MAKEINITFIRST 53796 . -54134) (MAKEINITLAST 54136 . 59420) (\COPY 59422 . 61925) (\UNCOPY 61927 . 68390))))) + (FILEMAP (NIL (5793 12801 (\ADDBASE 5803 . 6610) (\GETBASE 6612 . 6856) (\PUTBASE 6858 . 7134) ( +\PUTBASE.UFN 7136 . 7416) (\PUTBASEPTR.UFN 7418 . 7740) (\PUTBITS.UFN 7742 . 8448) (\GETBASEBYTE 8450 + . 8877) (\PUTBASEBYTE 8879 . 9570) (\GETBASEPTR 9572 . 10054) (\PUTBASEPTR 10056 . 10374) (\HILOC +10376 . 10600) (\LOLOC 10602 . 10826) (\VAG2 10828 . 11203) (\RPLPTR 11205 . 11860) (\RPLPTR.UFN 11862 + . 12799)) (12802 14217 (EQ 12812 . 13030) (EQL 13032 . 14215)) (14260 15010 (LOC 14270 . 14601) (VAG +14603 . 15008)) (15011 16052 (CREATEPAGES 15021 . 15510) (\NEW4PAGE 15512 . 16050)) (20177 38910 (CONS + 20187 . 20493) (\CONS.UFN 20495 . 22913) (\MAIKO.CONS.UFN 22915 . 25168) (CAR 25170 . 25297) ( +\CAR.UFN 25299 . 26402) (CDR 26404 . 26531) (\CDR.UFN 26533 . 28132) (RPLACA 28134 . 28361) ( +\RPLACA.UFN 28363 . 29362) (RPLACD 29364 . 29499) (\RPLACD.UFN 29501 . 33252) (DOCOLLECT 33254 . 33518 +) (\RPLCONS 33520 . 35530) (ENDCOLLECT 35532 . 35740) (\INITCONSPAGE 35742 . 38304) (\NEXTCONSPAGE +38306 . 38908)) (38968 41303 (\RESTLIST.UFN 38978 . 40076) (\FINDKEY.UFN 40078 . 41301)) (51554 53350 +(CHECKCONSPAGES 51564 . 52503) (\CHECKCONSPAGE 52505 . 53348)) (53527 68133 (MAKEINITFIRST 53537 . +53875) (MAKEINITLAST 53877 . 59161) (\COPY 59163 . 61666) (\UNCOPY 61668 . 68131))))) STOP diff --git a/sources/LLNEW.LCOM b/sources/LLNEW.LCOM index 552cf7703..e2481a24d 100644 Binary files a/sources/LLNEW.LCOM and b/sources/LLNEW.LCOM differ