\RPLPTR when run interpreted doesn't work with large vmem pointers (#866)
* \RPLPTR when run interpreted doesn't work with large vmem pointers * oops, misread maiko N_OP_rplptr; this is closer * Make LLNEW UFNs and functions run renamed match maiko interp wrt high 4 bits
This commit is contained in:
Larry Masinter
GitHub
513
sources/LLNEW
513
sources/LLNEW
@@ -1,18 +1,19 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED " 2-Feb-95 16:21:44" {DSK}<lispcore>sources>LLNEW.;15 69572
|
||||
|
||||
changes to%: (RECORDS CONSPAGE)
|
||||
(FILECREATED "27-Jul-2022 21:35:24" {DSK}<home>larry>medley>sources>LLNEW.;4 69231
|
||||
|
||||
previous date%: "24-Aug-94 10:56:08" {DSK}<lispcore>sources>LLNEW.;14)
|
||||
:CHANGES-TO (FNS \GETBASEPTR \RPLPTR \RPLPTR.UFN)
|
||||
|
||||
:PREVIOUS-DATE "27-Jul-2022 13:21:34" {DSK}<home>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")
|
||||
|
||||
(\VAG2 (\GETBASE X D)
|
||||
(* ;; "usually not done here unless interpreted")
|
||||
|
||||
(\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 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 .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.")
|
||||
(* ;;
|
||||
"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.")
|
||||
))
|
||||
(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 .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)))
|
||||
(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.")
|
||||
(* ;;
|
||||
"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.")
|
||||
[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 (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)))
|
||||
(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]
|
||||
(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]
|
||||
(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
|
||||
|
||||
Binary file not shown.
Reference in New Issue
Block a user