Merge pull request #556 from Interlisp/lmm9
ACCESSFNS VCELL had bogus computation
This commit is contained in:
rmkaplan
GitHub
commit
ca069578c3
406
sources/LLBASIC
406
sources/LLBASIC
@ -1,19 +1,19 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "31-Jan-98 09:55:50" {DSK}<disk>disk2>jdstools>lc3>lispcore3.0>sources>LLBASIC.;13 118684
|
||||
|
||||
changes to%: (RECORDS PNAMEINDEX)
|
||||
(FILECREATED "27-Oct-2021 21:23:51" {DSK}<home>larry>medley>sources>LLBASIC.;2 120519
|
||||
|
||||
previous date%: "31-Jan-98 09:30:10"
|
||||
{DSK}<disk>disk2>jdstools>lc3>lispcore3.0>sources>LLBASIC.;12)
|
||||
changes to%: (FNS \SETGLOBALVAL.UFN \CREATE.SYMBOL)
|
||||
|
||||
previous date%: "31-Jan-98 09:55:50" {DSK}<home>larry>medley>sources>LLBASIC.;1)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1993, 1994, 1995, 1998 by Syntelligence Systems, Inc. This program or documentation contains confidential information and trade secrets of Syntelligence Systems, Inc. Reverse engineering, reverse compiling and disassembling of object code are prohibited. Use of this program or documentation is governed by written agreement with Syntelligence Systems, Inc. Use of copyright notice is precautionary and does not imply publication or disclosure of trade secrets. All rights reserved.
|
||||
Copyright (c) 1981-1988, 1990-1995, 1998 by Syntelligence Systems, Inc. This program or documentation contains confidential information and trade secrets of Syntelligence Systems, Inc. Reverse engineering, reverse compiling and disassembling of object code are prohibited. Use of this program or documentation is governed by written agreement with Syntelligence Systems, Inc. Use of copyright notice is precautionary and does not imply publication or disclosure of trade secrets.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT LLBASICCOMS)
|
||||
|
||||
(RPAQQ LLBASICCOMS
|
||||
(RPAQQ LLBASICCOMS
|
||||
((FNS LISTP LITATOM FIXP SMALLP NLISTP ARRAYP FLOATP NUMBERP STACKP)
|
||||
(FUNCTIONS ATOM)
|
||||
(DECLARE%: DONTCOPY (EXPORT (MACROS CHECK \StatsZero \StatsAdd1 IPLUS16 SMALLPOSP SETXVAR
|
||||
@ -207,56 +207,59 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992,
|
||||
(DECLARE%: DONTCOPY
|
||||
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
|
||||
|
||||
[PUTPROPS CHECK MACRO (ARGS (COND
|
||||
[(AND (BOUNDP 'CHECK)
|
||||
CHECK)
|
||||
(CONS 'PROGN (for I in ARGS
|
||||
collect (LIST 'OR I
|
||||
(LIST 'RAID
|
||||
(KWOTE (LIST
|
||||
'Check-failure%:
|
||||
I]
|
||||
(T (CONS COMMENTFLG ARGS]
|
||||
(PUTPROPS CHECK MACRO [ARGS (COND
|
||||
[(AND (BOUNDP 'CHECK)
|
||||
CHECK)
|
||||
(CONS 'PROGN
|
||||
(for I in ARGS
|
||||
collect (LIST 'OR I
|
||||
(LIST 'RAID
|
||||
(KWOTE (LIST
|
||||
'
|
||||
Check-failure%:
|
||||
I]
|
||||
(T (CONS COMMENTFLG ARGS])
|
||||
|
||||
(PUTPROPS \StatsZero BYTEMACRO (OPENLAMBDA (N)
|
||||
(\PUTBASE N 0 0)
|
||||
(\PUTBASE N 1 0)))
|
||||
(PUTPROPS \StatsZero BYTEMACRO (OPENLAMBDA (N)
|
||||
(\PUTBASE N 0 0)
|
||||
(\PUTBASE N 1 0)))
|
||||
|
||||
[PUTPROPS \StatsAdd1 DMACRO (OPENLAMBDA (A)
|
||||
(PROG ((LO (IPLUS16 (\GETBASE A 1)
|
||||
1)))
|
||||
(DECLARE (LOCALVARS LO))
|
||||
(PUTPROPS \StatsAdd1 DMACRO [OPENLAMBDA (A)
|
||||
(PROG ((LO (IPLUS16 (\GETBASE A 1)
|
||||
1)))
|
||||
(DECLARE (LOCALVARS LO))
|
||||
(* ; "Increment double word at A by 1")
|
||||
(\PUTBASE A 1 LO)
|
||||
(COND
|
||||
((EQ LO 0)
|
||||
(\PUTBASE A 0 (ADD1 (\GETBASE A 0]
|
||||
(\PUTBASE A 1 LO)
|
||||
(COND
|
||||
((EQ LO 0)
|
||||
(\PUTBASE A 0 (ADD1 (\GETBASE A 0])
|
||||
|
||||
[PUTPROPS IPLUS16 MACRO ((X Y) (* ; "Kludge to do 16-bit plus")
|
||||
(\LOLOC (\ADDBASE X Y]
|
||||
(PUTPROPS IPLUS16 MACRO ((X Y) (* ; "Kludge to do 16-bit plus")
|
||||
(\LOLOC (\ADDBASE X Y))))
|
||||
|
||||
[PUTPROPS SMALLPOSP MACRO (OPENLAMBDA (X)
|
||||
(AND (SMALLP X)
|
||||
(IGEQ X 0]
|
||||
(PUTPROPS SMALLPOSP MACRO (OPENLAMBDA (X)
|
||||
(AND (SMALLP X)
|
||||
(IGEQ X 0))))
|
||||
|
||||
[PROGN [PUTPROPS SETXVAR MACRO (X `(SETQ.NOREF %, (CADAR X)
|
||||
%,
|
||||
(CADR X]
|
||||
(PUTPROPS SETXVAR DMACRO (X (OR (AND (EQ (CAAR X)
|
||||
'QUOTE)
|
||||
(LITATOM (CADAR X)))
|
||||
(SHOULDNT))
|
||||
(GLOBALVARS \VALSPACE)
|
||||
(LIST 'SETQ.NOREF (CADAR X)
|
||||
(CADR X]
|
||||
[PROGN (PUTPROPS SETXVAR MACRO [X `(SETQ.NOREF %, (CADAR X)
|
||||
%,
|
||||
(CADR X])
|
||||
(PUTPROPS SETXVAR DMACRO (X (OR (AND (EQ (CAAR X)
|
||||
'QUOTE)
|
||||
(LITATOM (CADAR X)))
|
||||
(SHOULDNT))
|
||||
(GLOBALVARS \VALSPACE)
|
||||
(LIST 'SETQ.NOREF (CADAR X)
|
||||
(CADR X))))]
|
||||
|
||||
(PUTPROPS SETQ.NOREF DMACRO ((VAR VAL)
|
||||
(\PUTBASEPTR (LOCF (fetch (LITATOM VALUE) of 'VAR))
|
||||
0 VAL)))
|
||||
(PUTPROPS SETQ.NOREF DMACRO ((VAR VAL)
|
||||
(\PUTBASEPTR (LOCF (fetch (LITATOM VALUE)
|
||||
of 'VAR))
|
||||
0 VAL)))
|
||||
|
||||
(PROGN (PUTPROPS IEQ MACRO ((X Y)
|
||||
(IEQP X Y)))
|
||||
(PUTPROPS IEQ DMACRO (= . EQ)))
|
||||
(PROGN (PUTPROPS IEQ MACRO ((X Y)
|
||||
(IEQP X Y)))
|
||||
(PUTPROPS IEQ DMACRO (= . EQ)))
|
||||
)
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
@ -318,8 +321,12 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992,
|
||||
(replace (LITATOM VALUE) of ATM with VAL])
|
||||
|
||||
(\SETGLOBALVAL.UFN
|
||||
[LAMBDA (V A) (* bvm%: " 6-Jun-85 11:54")
|
||||
(replace (VALINDEX VALUE) of A with V])
|
||||
[LAMBDA (V A) (* ;
|
||||
"Edited 27-Oct-2021 21:18 by larry")
|
||||
(* ;
|
||||
"Edited 27-Oct-2021 21:13 by larry")
|
||||
(* bvm%: " 6-Jun-85 11:54")
|
||||
(replace (VCELL VALUE) of (\VALCELL A) with V])
|
||||
|
||||
(\SETFVAR.UFN
|
||||
[LAMBDA (V VCELL) (* edited%: " 3-Apr-85 16:40")
|
||||
@ -370,8 +377,8 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992,
|
||||
)
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
[PUTPROPS \PROPCELL MACRO ((ATOM)
|
||||
(\ATOMCELL ATOM (CONSTANT \PLIST.HI]
|
||||
(PUTPROPS \PROPCELL MACRO ((ATOM)
|
||||
(\ATOMCELL ATOM (CONSTANT \PLIST.HI))))
|
||||
)
|
||||
|
||||
(DEFOPTIMIZER \ATOMCELL (&REST X)
|
||||
@ -492,7 +499,11 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992,
|
||||
NEWATOM))])
|
||||
|
||||
(\CREATE.SYMBOL
|
||||
[LAMBDA (BASE OFFSET LEN FATP FATCHARSEENP) (* ; "Edited 8-Feb-93 16:48 by jds")
|
||||
[LAMBDA (BASE OFFSET LEN FATP FATCHARSEENP) (* ;
|
||||
"Edited 27-Oct-2021 21:21 by larry")
|
||||
(* ;
|
||||
"Edited 27-Oct-2021 21:13 by larry")
|
||||
(* ; "Edited 8-Feb-93 16:48 by jds")
|
||||
|
||||
(* ;;; "Creates a new symbol whose pname is as indicated. FATP means the presented string is fat, while FATCHARSEENP means that there actually is a fat char in there (otherwise we will store a thin pname) --- Must be called UNINTERRUPTABLY and the caller is responsible for interning the symbol wherever it belongs")
|
||||
|
||||
@ -522,7 +533,7 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992,
|
||||
(* ;; "Now, just create us a NEW-ATOM, and keep going:")
|
||||
|
||||
(SETQ ATM (CREATECELL \NEW-ATOM))
|
||||
(REPLACE (VALINDEX VALUE) OF ATM WITH 'NOBIND))
|
||||
(replace (VCELL VALUE) of (\VALCELL ATM) with 'NOBIND))
|
||||
((EVENP ATM 256) (* ;
|
||||
"Can fit 256 new atoms into 10 pages.")
|
||||
|
||||
@ -764,17 +775,18 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992,
|
||||
)
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS MDSTYPE# MACRO ((PAGE#)
|
||||
(LOGAND (\GETBASE \MDSTypeTable (LRSH PAGE# 1))
|
||||
\TT.TYPEMASK)))
|
||||
(PUTPROPS MDSTYPE# MACRO ((PAGE#)
|
||||
(LOGAND (\GETBASE \MDSTypeTable (LRSH PAGE# 1))
|
||||
\TT.TYPEMASK)))
|
||||
|
||||
[PUTPROPS .ALLOCATED.PER.PAGE. MACRO (OPENLAMBDA (SIZE) (* Maybe change this some day to a
|
||||
(PUTPROPS .ALLOCATED.PER.PAGE. MACRO (OPENLAMBDA (SIZE)
|
||||
(* Maybe change this some day to a
|
||||
fetch of a flag from the DTD)
|
||||
(AND (IGEQ (LISPVERSION)
|
||||
37384)
|
||||
(ILESSP (IREMAINDER WORDSPERPAGE SIZE)
|
||||
(LRSH SIZE 1))
|
||||
(ILESSP SIZE WORDSPERPAGE]
|
||||
(AND (IGEQ (LISPVERSION)
|
||||
37384)
|
||||
(ILESSP (IREMAINDER WORDSPERPAGE SIZE)
|
||||
(LRSH SIZE 1))
|
||||
(ILESSP SIZE WORDSPERPAGE))))
|
||||
)
|
||||
|
||||
|
||||
@ -790,7 +802,7 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992,
|
||||
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS READSYS.HAS.PACKAGES MACRO (NIL (NEQ 1 READSYS.PACKAGE.FROM.NAME)))
|
||||
(PUTPROPS READSYS.HAS.PACKAGES MACRO (NIL (NEQ 1 READSYS.PACKAGE.FROM.NAME)))
|
||||
)
|
||||
|
||||
(RPAQQ READSYS.PACKAGE.FROM.NAME 1)
|
||||
@ -1715,91 +1727,91 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992,
|
||||
)
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS \DEFCELL MACRO ((ATOM)
|
||||
(\ATOMCELL ATOM \DEF.HI)))
|
||||
(PUTPROPS \DEFCELL MACRO ((ATOM)
|
||||
(\ATOMCELL ATOM \DEF.HI)))
|
||||
|
||||
(PUTPROPS \VALCELL MACRO ((ATOM)
|
||||
(\ATOMCELL ATOM \VAL.HI)))
|
||||
(PUTPROPS \VALCELL MACRO ((ATOM)
|
||||
(\ATOMCELL ATOM \VAL.HI)))
|
||||
|
||||
(PUTPROPS \PNAMECELL MACRO ((ATOM)
|
||||
(\ATOMCELL ATOM \PNAME.HI)))
|
||||
(PUTPROPS \PNAMECELL MACRO ((ATOM)
|
||||
(\ATOMCELL ATOM \PNAME.HI)))
|
||||
)
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
[PUTPROPS \ATOMVALINDEX DMACRO (OPENLAMBDA (X)
|
||||
(COND
|
||||
((EQ (NTYPX X)
|
||||
\LITATOM) (* ; "Original litatoms")
|
||||
(\LOLOC X))
|
||||
((EQ (NTYPX X)
|
||||
\NEW-ATOM) (* ; "new 3-byte symbols")
|
||||
X)
|
||||
(T (SHOULDNT]
|
||||
(PUTPROPS \ATOMVALINDEX DMACRO [OPENLAMBDA (X)
|
||||
(COND
|
||||
((EQ (NTYPX X)
|
||||
\LITATOM) (* ; "Original litatoms")
|
||||
(\LOLOC X))
|
||||
((EQ (NTYPX X)
|
||||
\NEW-ATOM) (* ; "new 3-byte symbols")
|
||||
X)
|
||||
(T (SHOULDNT])
|
||||
|
||||
[PUTPROPS \ATOMDEFINDEX DMACRO (OPENLAMBDA (X)
|
||||
(COND
|
||||
((EQ (NTYPX X)
|
||||
\LITATOM) (* ; "Original litatoms")
|
||||
(\LOLOC X))
|
||||
((EQ (NTYPX X)
|
||||
\NEW-ATOM) (* ; "new 3-byte symbols")
|
||||
X)
|
||||
(T (SHOULDNT]
|
||||
(PUTPROPS \ATOMDEFINDEX DMACRO [OPENLAMBDA (X)
|
||||
(COND
|
||||
((EQ (NTYPX X)
|
||||
\LITATOM) (* ; "Original litatoms")
|
||||
(\LOLOC X))
|
||||
((EQ (NTYPX X)
|
||||
\NEW-ATOM) (* ; "new 3-byte symbols")
|
||||
X)
|
||||
(T (SHOULDNT])
|
||||
|
||||
[PUTPROPS \ATOMPNAMEINDEX DMACRO (OPENLAMBDA (X)
|
||||
(COND
|
||||
((EQ (NTYPX X)
|
||||
\LITATOM) (* ; "Original litatoms")
|
||||
(\LOLOC X))
|
||||
((EQ (NTYPX X)
|
||||
\NEW-ATOM) (* ; "new 3-byte symbols")
|
||||
X)
|
||||
(T (SHOULDNT]
|
||||
(PUTPROPS \ATOMPNAMEINDEX DMACRO [OPENLAMBDA (X)
|
||||
(COND
|
||||
((EQ (NTYPX X)
|
||||
\LITATOM) (* ; "Original litatoms")
|
||||
(\LOLOC X))
|
||||
((EQ (NTYPX X)
|
||||
\NEW-ATOM)(* ; "new 3-byte symbols")
|
||||
X)
|
||||
(T (SHOULDNT])
|
||||
|
||||
[PUTPROPS \ATOMPROPINDEX DMACRO ((X)
|
||||
(COND
|
||||
((EQ (NTYPX X)
|
||||
\LITATOM) (* ; "Original litatoms")
|
||||
(\LOLOC X))
|
||||
((EQ (NTYPX X)
|
||||
\NEW-ATOM) (* ; "new 3-byte symbols")
|
||||
X)
|
||||
(T (SHOULDNT]
|
||||
(PUTPROPS \ATOMPROPINDEX DMACRO [(X)
|
||||
(COND
|
||||
((EQ (NTYPX X)
|
||||
\LITATOM) (* ; "Original litatoms")
|
||||
(\LOLOC X))
|
||||
((EQ (NTYPX X)
|
||||
\NEW-ATOM) (* ; "new 3-byte symbols")
|
||||
X)
|
||||
(T (SHOULDNT])
|
||||
|
||||
[PUTPROPS \INDEXATOMPNAME DMACRO (OPENLAMBDA (X)
|
||||
(COND
|
||||
[(FIXP X) (* ; "Xerox Lisp traditional symbol")
|
||||
(COND
|
||||
((SMALLP X)
|
||||
(\VAG2 \AtomHI X))
|
||||
(T (\VAG2 (LRSH X 16)
|
||||
(LOGAND X 65535]
|
||||
(T (* ; "New symbol")
|
||||
X]
|
||||
(PUTPROPS \INDEXATOMPNAME DMACRO (OPENLAMBDA (X)
|
||||
(COND
|
||||
[(FIXP X) (* ; "Xerox Lisp traditional symbol")
|
||||
(COND
|
||||
((SMALLP X)
|
||||
(\VAG2 \AtomHI X))
|
||||
(T (\VAG2 (LRSH X 16)
|
||||
(LOGAND X 65535]
|
||||
(T (* ; "New symbol")
|
||||
X))))
|
||||
|
||||
[PUTPROPS \INDEXATOMVAL DMACRO (OPENLAMBDA (X)
|
||||
(COND
|
||||
[(FIXP X) (* ; "Xerox Lisp traditional symbol")
|
||||
(COND
|
||||
((SMALLP X)
|
||||
(\VAG2 \AtomHI X))
|
||||
(T (\VAG2 (LRSH X 16)
|
||||
(LOGAND X 65535]
|
||||
(T (* ; "New symbol")
|
||||
X]
|
||||
(PUTPROPS \INDEXATOMVAL DMACRO (OPENLAMBDA (X)
|
||||
(COND
|
||||
[(FIXP X) (* ; "Xerox Lisp traditional symbol")
|
||||
(COND
|
||||
((SMALLP X)
|
||||
(\VAG2 \AtomHI X))
|
||||
(T (\VAG2 (LRSH X 16)
|
||||
(LOGAND X 65535]
|
||||
(T (* ; "New symbol")
|
||||
X))))
|
||||
|
||||
[PUTPROPS \INDEXATOMDEF DMACRO (OPENLAMBDA (X)
|
||||
(COND
|
||||
[(FIXP X) (* ; "Xerox Lisp traditional symbol")
|
||||
(COND
|
||||
((SMALLP X)
|
||||
(\VAG2 \AtomHI X))
|
||||
(T (\VAG2 (LRSH X 16)
|
||||
(LOGAND X 65535]
|
||||
(T (* ; "New symbol")
|
||||
X]
|
||||
(PUTPROPS \INDEXATOMDEF DMACRO (OPENLAMBDA (X)
|
||||
(COND
|
||||
[(FIXP X) (* ; "Xerox Lisp traditional symbol")
|
||||
(COND
|
||||
((SMALLP X)
|
||||
(\VAG2 \AtomHI X))
|
||||
(T (\VAG2 (LRSH X 16)
|
||||
(LOGAND X 65535]
|
||||
(T (* ; "New symbol")
|
||||
X))))
|
||||
|
||||
(PUTPROPS \ATOMNUMBER DMACRO (= . \LOLOC))
|
||||
(PUTPROPS \ATOMNUMBER DMACRO (= . \LOLOC))
|
||||
)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
@ -1842,35 +1854,36 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992,
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
[PUTPROPS COMPUTE.ATOM.HASH MACRO ((BASE OFFST LEN FIRSTBYTE FATP)
|
||||
(PUTPROPS COMPUTE.ATOM.HASH MACRO [(BASE OFFST LEN FIRSTBYTE FATP)
|
||||
(* ;
|
||||
"Sets variable HASH to atom hash of indicated string")
|
||||
(SETQ HASH (LLSH FIRSTBYTE 8))
|
||||
(for CHAR# from (ADD1 OFFST)
|
||||
to (SUB1 (IPLUS OFFST LEN))
|
||||
do (SETQ HASH
|
||||
(IPLUS16 (IPLUS16 (SETQ HASH
|
||||
(IPLUS16 HASH
|
||||
(LLSH (LOGAND HASH 4095)
|
||||
2)))
|
||||
(LLSH (LOGAND HASH 255)
|
||||
8))
|
||||
(UNLESSRDSYS (COND
|
||||
(FATP (LOGAND (\GETBASEFAT
|
||||
BASE CHAR#)
|
||||
255))
|
||||
(T (\GETBASETHIN BASE CHAR#)))
|
||||
(NTHCHARCODE BASE CHAR#]
|
||||
(SETQ HASH (LLSH FIRSTBYTE 8))
|
||||
(for CHAR# from (ADD1 OFFST)
|
||||
to (SUB1 (IPLUS OFFST LEN))
|
||||
do (SETQ HASH
|
||||
(IPLUS16 (IPLUS16 (SETQ HASH
|
||||
(IPLUS16 HASH
|
||||
(LLSH (LOGAND HASH
|
||||
4095)
|
||||
2)))
|
||||
(LLSH (LOGAND HASH 255)
|
||||
8))
|
||||
(UNLESSRDSYS
|
||||
(COND
|
||||
(FATP (LOGAND (\GETBASEFAT BASE
|
||||
CHAR#)
|
||||
255))
|
||||
(T (\GETBASETHIN BASE CHAR#)))
|
||||
(NTHCHARCODE BASE CHAR#])
|
||||
|
||||
[PUTPROPS ATOM.HASH.REPROBE MACRO ((HASH FIRSTBYTE)
|
||||
(LOGAND 63 (LOGOR 1 (LOGXOR FIRSTBYTE HASH]
|
||||
(PUTPROPS ATOM.HASH.REPROBE MACRO [(HASH FIRSTBYTE)
|
||||
(LOGAND 63 (LOGOR 1 (LOGXOR FIRSTBYTE HASH])
|
||||
)
|
||||
|
||||
|
||||
(ADDTOVAR DONTCOMPILEFNS
|
||||
INITATOMS COPYATOM UNCOPYATOM READATOM MAKE.LOCAL.ATOM SYMBOL.VALUE SYMBOL.PNAME
|
||||
SYMBOL.PACKAGE OLD.FIND.SYMBOL LOOKUP-SYMBOL FIND.PACKAGE FIND.SYMBOL PACKAGE.NAME
|
||||
GETDEFN PUTDEFN FSETVAL)
|
||||
(ADDTOVAR DONTCOMPILEFNS INITATOMS COPYATOM UNCOPYATOM READATOM MAKE.LOCAL.ATOM SYMBOL.VALUE
|
||||
SYMBOL.PNAME SYMBOL.PACKAGE OLD.FIND.SYMBOL LOOKUP-SYMBOL
|
||||
FIND.PACKAGE FIND.SYMBOL PACKAGE.NAME GETDEFN PUTDEFN FSETVAL)
|
||||
)
|
||||
|
||||
|
||||
@ -2079,17 +2092,17 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992,
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS .CLEARNWORDS. MACRO (OPENLAMBDA (BASE NWORDS)
|
||||
(PUTPROPS .CLEARNWORDS. MACRO (OPENLAMBDA (BASE NWORDS)
|
||||
|
||||
(* ;; "Clear NWORDS words starting at base. Assumes NWORDS is smallp and greater than zero. Compiler refuses to optimize out an IGREATERP test here, so push back to caller")
|
||||
|
||||
(\PUTBASE BASE (SUB1 NWORDS)
|
||||
0)
|
||||
[COND
|
||||
((NEQ NWORDS 1)
|
||||
(\BLT BASE (\ADDBASE BASE 1)
|
||||
(SUB1 NWORDS]
|
||||
NIL))
|
||||
(\PUTBASE BASE (SUB1 NWORDS)
|
||||
0)
|
||||
[COND
|
||||
((NEQ NWORDS 1)
|
||||
(\BLT BASE (\ADDBASE BASE 1)
|
||||
(SUB1 NWORDS]
|
||||
NIL))
|
||||
)
|
||||
)
|
||||
|
||||
@ -2100,10 +2113,10 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992,
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS \MOVEWORDS MACRO (OPENLAMBDA (SBASE SOFFSET DBASE DOFFSET NWORDS)
|
||||
(\BLT (\ADDBASE DBASE DOFFSET)
|
||||
(\ADDBASE SBASE SOFFSET)
|
||||
NWORDS)))
|
||||
(PUTPROPS \MOVEWORDS MACRO (OPENLAMBDA (SBASE SOFFSET DBASE DOFFSET NWORDS)
|
||||
(\BLT (\ADDBASE DBASE DOFFSET)
|
||||
(\ADDBASE SBASE SOFFSET)
|
||||
NWORDS)))
|
||||
)
|
||||
|
||||
(* "END EXPORTED DEFINITIONS")
|
||||
@ -2181,39 +2194,38 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992,
|
||||
(\ATOMNUMBER . VATOMNUMBER)
|
||||
(\CREATE.SYMBOL . VNOSUCHATOM))
|
||||
|
||||
(ADDTOVAR RDCOMS
|
||||
(FNS UNCOPYATOM MAKE.LOCAL.ATOM SYMBOL.VALUE SYMBOL.PNAME SYMBOL.PACKAGE OLD.FIND.SYMBOL
|
||||
LOOKUP-SYMBOL FIND.PACKAGE FIND.SYMBOL PACKAGE.NAME \MKATOM GETTOPVAL GETPROPLIST
|
||||
SETTOPVAL GETDEFN \ATOMCELL)
|
||||
(FNS LISTP)
|
||||
(VARS (COPYATOMSTR)))
|
||||
(ADDTOVAR RDCOMS (FNS UNCOPYATOM MAKE.LOCAL.ATOM SYMBOL.VALUE SYMBOL.PNAME SYMBOL.PACKAGE
|
||||
OLD.FIND.SYMBOL LOOKUP-SYMBOL FIND.PACKAGE FIND.SYMBOL PACKAGE.NAME \MKATOM
|
||||
GETTOPVAL GETPROPLIST SETTOPVAL GETDEFN \ATOMCELL)
|
||||
(FNS LISTP)
|
||||
(VARS (COPYATOMSTR)))
|
||||
|
||||
(ADDTOVAR RD.SUBFNS (\RPLPTR . VPUTBASEPTR))
|
||||
|
||||
(ADDTOVAR RDVALS (\AtomFrLst))
|
||||
)
|
||||
|
||||
(PUTPROPS LLBASIC FILETYPE CL:COMPILE-FILE)
|
||||
(PUTPROPS LLBASIC FILETYPE CL:COMPILE-FILE)
|
||||
(PUTPROPS LLBASIC COPYRIGHT (
|
||||
"Syntelligence Systems, Inc. This program or documentation contains confidential information and trade secrets of Syntelligence Systems, Inc. Reverse engineering, reverse compiling and disassembling of object code are prohibited. Use of this program or documentation is governed by written agreement with Syntelligence Systems, Inc. Use of copyright notice is precautionary and does not imply publication or disclosure of trade secrets"
|
||||
1981 1982 1983 1984 1985 1986 1987 1988 1990 1991 1992 1993 1994 1995 1998))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (9820 12218 (LISTP 9830 . 10413) (LITATOM 10415 . 10682) (FIXP 10684 . 10921) (SMALLP
|
||||
10923 . 11178) (NLISTP 11180 . 11393) (ARRAYP 11395 . 11650) (FLOATP 11652 . 11907) (NUMBERP 11909 .
|
||||
12055) (STACKP 12057 . 12216)) (15995 19501 (GETTOPVAL 16005 . 16161) (SETTOPVAL 16163 . 16532) (
|
||||
FSETVAL 16534 . 16881) (\SETGLOBALVAL.UFN 16883 . 17054) (\SETFVAR.UFN 17056 . 17226) (GETPROPLIST
|
||||
17228 . 17388) (\ATOMCELL 17390 . 19319) (SETPROPLIST 19321 . 19499)) (20325 34368 (\MKATOM 20335 .
|
||||
27567) (\CREATE.SYMBOL 27569 . 31866) (\MKATOM.FULL 31868 . 32345) (\INITATOMPAGE 32347 . 34366)) (
|
||||
34369 43358 (MAPATOMS 34379 . 37686) (ATOMHASH#PROBES 37688 . 42551) (\SFLHASHLOOKUP 42553 . 43356)) (
|
||||
45385 74528 (INITATOMS 45395 . 47439) (COPYATOM 47441 . 51860) (UNCOPYATOM 51862 . 52659) (
|
||||
MAKE.LOCAL.ATOM 52661 . 53408) (SYMBOL.VALUE 53410 . 54190) (SYMBOL.PNAME 54192 . 55353) (
|
||||
SYMBOL.PACKAGE 55355 . 56469) (OLD.FIND.SYMBOL 56471 . 63826) (LOOKUP-SYMBOL 63828 . 67022) (
|
||||
FIND.PACKAGE 67024 . 69226) (FIND.SYMBOL 69228 . 74357) (PACKAGE.NAME 74359 . 74526)) (74802 81505 (
|
||||
\DEFINEDP 74812 . 75015) (PUTD 75017 . 75815) (\PUTD 75817 . 78533) (GETD 78535 . 79167) (PUTDEFN
|
||||
79169 . 81347) (GETDEFN 81349 . 81503)) (81506 85926 (\STKMIN 81516 . 85924)) (104646 107529 (
|
||||
\RESETSYSTEMSTATE 104656 . 104813) (INITIALEVALQT 104815 . 106420) (SIMPLEPRINT 106422 . 107527)) (
|
||||
107624 108423 (PAGEFAULTS 107634 . 107828) (\SETTOTALTIME 107830 . 108247) (\SERIALNUMBER 108249 .
|
||||
108421)) (108487 113398 (\BLT 108497 . 109395) (\MOVEBYTES 109397 . 110841) (\CLEARWORDS 110843 .
|
||||
111537) (\CLEARBYTES 111539 . 112343) (\CLEARCELLS 112345 . 113396)) (114545 115996 (\MOVEWORDS 114555
|
||||
. 114758) (\ZEROBYTES 114760 . 114932) (\ZEROWORDS 114934 . 115994)))))
|
||||
(FILEMAP (NIL (9717 12115 (LISTP 9727 . 10310) (LITATOM 10312 . 10579) (FIXP 10581 . 10818) (SMALLP
|
||||
10820 . 11075) (NLISTP 11077 . 11290) (ARRAYP 11292 . 11547) (FLOATP 11549 . 11804) (NUMBERP 11806 .
|
||||
11952) (STACKP 11954 . 12113)) (16335 20191 (GETTOPVAL 16345 . 16501) (SETTOPVAL 16503 . 16872) (
|
||||
FSETVAL 16874 . 17221) (\SETGLOBALVAL.UFN 17223 . 17744) (\SETFVAR.UFN 17746 . 17916) (GETPROPLIST
|
||||
17918 . 18078) (\ATOMCELL 18080 . 20009) (SETPROPLIST 20011 . 20189)) (21034 35427 (\MKATOM 21044 .
|
||||
28276) (\CREATE.SYMBOL 28278 . 32925) (\MKATOM.FULL 32927 . 33404) (\INITATOMPAGE 33406 . 35425)) (
|
||||
35428 44417 (MAPATOMS 35438 . 38745) (ATOMHASH#PROBES 38747 . 43610) (\SFLHASHLOOKUP 43612 . 44415)) (
|
||||
46558 75701 (INITATOMS 46568 . 48612) (COPYATOM 48614 . 53033) (UNCOPYATOM 53035 . 53832) (
|
||||
MAKE.LOCAL.ATOM 53834 . 54581) (SYMBOL.VALUE 54583 . 55363) (SYMBOL.PNAME 55365 . 56526) (
|
||||
SYMBOL.PACKAGE 56528 . 57642) (OLD.FIND.SYMBOL 57644 . 64999) (LOOKUP-SYMBOL 65001 . 68195) (
|
||||
FIND.PACKAGE 68197 . 70399) (FIND.SYMBOL 70401 . 75530) (PACKAGE.NAME 75532 . 75699)) (75975 82678 (
|
||||
\DEFINEDP 75985 . 76188) (PUTD 76190 . 76988) (\PUTD 76990 . 79706) (GETD 79708 . 80340) (PUTDEFN
|
||||
80342 . 82520) (GETDEFN 82522 . 82676)) (82679 87099 (\STKMIN 82689 . 87097)) (106399 109282 (
|
||||
\RESETSYSTEMSTATE 106409 . 106566) (INITIALEVALQT 106568 . 108173) (SIMPLEPRINT 108175 . 109280)) (
|
||||
109377 110176 (PAGEFAULTS 109387 . 109581) (\SETTOTALTIME 109583 . 110000) (\SERIALNUMBER 110002 .
|
||||
110174)) (110240 115151 (\BLT 110250 . 111148) (\MOVEBYTES 111150 . 112594) (\CLEARWORDS 112596 .
|
||||
113290) (\CLEARBYTES 113292 . 114096) (\CLEARCELLS 114098 . 115149)) (116344 117795 (\MOVEWORDS 116354
|
||||
. 116557) (\ZEROBYTES 116559 . 116731) (\ZEROWORDS 116733 . 117793)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
293
sources/LLINTERP
293
sources/LLINTERP
@ -1,13 +1,14 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED " 2-Feb-95 17:31:23" {DSK}<lispcore>sources>LLINTERP.;3 120814
|
||||
|
||||
changes to%: (VARS LLINTERPCOMS)
|
||||
(FILECREATED "27-Oct-2021 21:03:21" {DSK}<home>larry>medley>sources>LLINTERP.;2 127414
|
||||
|
||||
previous date%: "31-Aug-94 14:38:32" {DSK}<lispcore>sources>LLINTERP.;2)
|
||||
changes to%: (FNS \STKSCAN)
|
||||
|
||||
previous date%: " 2-Feb-95 17:31:23" {DSK}<home>larry>medley>sources>LLINTERP.;1)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1994, 1995 by Venue & Xerox Corporation. All rights reserved.
|
||||
Copyright (c) 1981-1988, 1990-1992, 1994-1995 by Venue & Xerox Corporation.
|
||||
The following program was created in 1981 but has not been published
|
||||
within the meaning of the copyright law, is furnished under license,
|
||||
and may not be used, copied and/or disclosed except in accordance
|
||||
@ -16,7 +17,7 @@ with the terms of said license.
|
||||
|
||||
(PRETTYCOMPRINT LLINTERPCOMS)
|
||||
|
||||
(RPAQQ LLINTERPCOMS
|
||||
(RPAQQ LLINTERPCOMS
|
||||
[(COMS (* ; "Compilation pre-requisites")
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
|
||||
LLBASIC LLSTK LLCODE LLPARAMS ACODE)))
|
||||
@ -368,35 +369,36 @@ with the terms of said license.
|
||||
(DECLARE%: DONTCOPY
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
[PUTPROPS .APPLY. MACRO ((U V) (* body for APPLY, used by RETAPPLY
|
||||
(PUTPROPS .APPLY. MACRO [(U V) (* body for APPLY, used by RETAPPLY
|
||||
too)
|
||||
(PROG ((DEF U))
|
||||
LP [COND
|
||||
((LITATOM DEF)
|
||||
(COND
|
||||
((NOT (fetch (LITATOM CCODEP) of DEF))
|
||||
(PROG ((DEF U))
|
||||
LP [COND
|
||||
((LITATOM DEF)
|
||||
(COND
|
||||
((NOT (fetch (LITATOM CCODEP) of DEF))
|
||||
(* EXPR)
|
||||
(SETQ DEF (fetch (LITATOM DEFPOINTER) of DEF)))
|
||||
((EQ (fetch (LITATOM ARGTYPE) of DEF)
|
||||
3)
|
||||
(GO NLSTAR))
|
||||
(T (GO NORMAL]
|
||||
[COND
|
||||
((LISTP DEF)
|
||||
(SELECTQ (CAR DEF)
|
||||
(NLAMBDA (AND (NLISTP (CADR DEF))
|
||||
(CADR DEF)
|
||||
(GO NLSTAR)))
|
||||
(FUNARG (SETQ DEF (CADR DEF))
|
||||
(GO LP))
|
||||
NIL))
|
||||
((NULL DEF)
|
||||
(RETURN (FAULTAPPLY U V]
|
||||
NORMAL
|
||||
(RETURN (SPREADAPPLY U V))
|
||||
NLSTAR
|
||||
(SETQ DEF (fetch (LITATOM DEFPOINTER) of
|
||||
DEF)))
|
||||
((EQ (fetch (LITATOM ARGTYPE) of DEF)
|
||||
3)
|
||||
(GO NLSTAR))
|
||||
(T (GO NORMAL]
|
||||
[COND
|
||||
((LISTP DEF)
|
||||
(SELECTQ (CAR DEF)
|
||||
(NLAMBDA (AND (NLISTP (CADR DEF))
|
||||
(CADR DEF)
|
||||
(GO NLSTAR)))
|
||||
(FUNARG (SETQ DEF (CADR DEF))
|
||||
(GO LP))
|
||||
NIL))
|
||||
((NULL DEF)
|
||||
(RETURN (FAULTAPPLY U V]
|
||||
NORMAL
|
||||
(RETURN (SPREADAPPLY U V))
|
||||
NLSTAR
|
||||
(* NLAMBDA*)
|
||||
(RETURN (SPREADAPPLY* U V]
|
||||
(RETURN (SPREADAPPLY* U V])
|
||||
)
|
||||
)
|
||||
|
||||
@ -444,7 +446,9 @@ with the terms of said license.
|
||||
(GO LP])])
|
||||
|
||||
(\STKSCAN
|
||||
[LAMBDA (VAR) (* ; "Edited 27-Jan-91 14:48 by jds")
|
||||
[LAMBDA (VAR) (* ;
|
||||
"Edited 27-Oct-2021 20:51 by larry")
|
||||
(* ; "Edited 27-Jan-91 14:48 by jds")
|
||||
|
||||
(* ;; "Returns pointer to place where VAR is bound")
|
||||
|
||||
@ -455,7 +459,7 @@ with the terms of said license.
|
||||
[COND
|
||||
((fetch (FX INVALIDP) of FX) (* ;
|
||||
"Reached top of stack without finding a binding")
|
||||
(RETURN (fetch (VALINDEX VCELL) of ATOM#]
|
||||
(RETURN (\VALCELL VAR]
|
||||
(SETQ NT (fetch (FX NAMETABLE) of FX))
|
||||
(SETQ NTSIZE (fetch (FNHEADER NTSIZE) of NT))
|
||||
(SETQ NT (\ADDBASE NT (fetch (FNHEADER OVERHEADWORDS) of T)))
|
||||
@ -1216,9 +1220,8 @@ with the terms of said license.
|
||||
)
|
||||
)
|
||||
|
||||
(RPAQ? OPENFNS
|
||||
'(APPLY* SETQ AND OR COND SELECTQ PROG PROGN PROG1 ARG SETARG ERSETQ NLSETQ RESETFORM RESETLST
|
||||
RESETVARS RPTQ SAVESETQ SETN UNDONLSETQ XNLSETQ))
|
||||
(RPAQ? OPENFNS '(APPLY* SETQ AND OR COND SELECTQ PROG PROGN PROG1 ARG SETARG ERSETQ NLSETQ
|
||||
RESETFORM RESETLST RESETVARS RPTQ SAVESETQ SETN UNDONLSETQ XNLSETQ))
|
||||
|
||||
(RPAQQ \BLIPNAMES (*TAIL* *FORM* *FN* *ARGVALS*))
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
@ -1433,7 +1436,7 @@ with the terms of said license.
|
||||
)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
|
||||
(RPAQQ RAIDCOMS
|
||||
(RPAQQ RAIDCOMS
|
||||
((MACROS PSTKFLD PRINTSTKFIELDS PSTK PRINTVA)
|
||||
(ADDVARS (RDCOMS (FNS RAIDCOMMAND RAIDSHOWFRAME RAIDSTACKCMD RAIDROOTFRAME PRINTADDRS PRINTVA
|
||||
READVA READOCT READATOM SHOWSTACKBLOCKS SHOWSTACKBLOCK1 PRINCOPY
|
||||
@ -1445,29 +1448,30 @@ with the terms of said license.
|
||||
NOSUCHATOM))))
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
[PUTPROPS PSTKFLD MACRO ((FLD STR TEST FMT STR2)
|
||||
(PROG ((FLD (fetch (FX FLD) of FRAME)))
|
||||
(DECLARE (LOCALVARS FLD))
|
||||
(COND
|
||||
(TEST (PRIN1 'STR)
|
||||
(SELECTQ (CONSTANT (NTHCHAR 'STR -1))
|
||||
(= (printout NIL %, FLD STR2))
|
||||
NIL)
|
||||
T]
|
||||
(PUTPROPS PSTKFLD MACRO [(FLD STR TEST FMT STR2)
|
||||
(PROG ((FLD (fetch (FX FLD) of FRAME)))
|
||||
(DECLARE (LOCALVARS FLD))
|
||||
(COND
|
||||
(TEST (PRIN1 'STR)
|
||||
(SELECTQ (CONSTANT (NTHCHAR 'STR -1))
|
||||
(= (printout NIL %, FLD STR2))
|
||||
NIL)
|
||||
T])
|
||||
|
||||
[PUTPROPS PRINTSTKFIELDS MACRO (FIELDS (CONS 'PROGN (MAPCAR FIELDS (FUNCTION (LAMBDA (X)
|
||||
(CONS 'PSTKFLD X]
|
||||
(PUTPROPS PRINTSTKFIELDS MACRO [FIELDS (CONS 'PROGN (MAPCAR FIELDS (FUNCTION (LAMBDA (X)
|
||||
(CONS
|
||||
'PSTKFLD X])
|
||||
|
||||
(PUTPROPS PSTK MACRO ((N . FIELDS)
|
||||
(\PRINTSTK (IPLUS FRAME N))
|
||||
(PRINTSTKFIELDS . FIELDS)
|
||||
(TERPRI)))
|
||||
(PUTPROPS PSTK MACRO ((N . FIELDS)
|
||||
(\PRINTSTK (IPLUS FRAME N))
|
||||
(PRINTSTKFIELDS . FIELDS)
|
||||
(TERPRI)))
|
||||
|
||||
[PUTPROPS PRINTVA MACRO (LAMBDA (X)
|
||||
(printout NIL "{" (HILOC X)
|
||||
","
|
||||
(LOLOC X)
|
||||
"}"]
|
||||
(PUTPROPS PRINTVA MACRO [LAMBDA (X)
|
||||
(printout NIL "{" (HILOC X)
|
||||
","
|
||||
(LOLOC X)
|
||||
"}"])
|
||||
)
|
||||
|
||||
(ADDTOVAR RDCOMS (FNS RAIDCOMMAND RAIDSHOWFRAME RAIDSTACKCMD RAIDROOTFRAME PRINTADDRS PRINTVA
|
||||
@ -1628,29 +1632,29 @@ with the terms of said license.
|
||||
(* ; "Translation machinery for new LAMBDA words")
|
||||
|
||||
|
||||
(PUTPROPS LAMBDATRANFNS VARTYPE ALIST)
|
||||
(PUTPROPS LAMBDATRANFNS VARTYPE ALIST)
|
||||
|
||||
(ADDTOVAR LAMBDATRANFNS )
|
||||
(DECLARE%: DONTCOPY
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
[PUTPROPS \CCODENARGS MACRO ((FNH)
|
||||
([LAMBDA (N)
|
||||
(COND
|
||||
((ILESSP N 0)
|
||||
1)
|
||||
(T N]
|
||||
(fetch (FNHEADER NA) of FNH]
|
||||
(PUTPROPS \CCODENARGS MACRO ((FNH)
|
||||
([LAMBDA (N)
|
||||
(COND
|
||||
((ILESSP N 0)
|
||||
1)
|
||||
(T N]
|
||||
(fetch (FNHEADER NA) of FNH))))
|
||||
|
||||
[PUTPROPS \CCODEFNTYP MACRO ((FNH)
|
||||
(SELECTQ (\CCODEARGTYPE FNH)
|
||||
(0 'CEXPR)
|
||||
(1 'CFEXPR)
|
||||
(2 'CEXPR*)
|
||||
'CFEXPR*]
|
||||
(PUTPROPS \CCODEFNTYP MACRO ((FNH)
|
||||
(SELECTQ (\CCODEARGTYPE FNH)
|
||||
(0 'CEXPR)
|
||||
(1 'CFEXPR)
|
||||
(2 'CEXPR*)
|
||||
'CFEXPR*)))
|
||||
|
||||
(PUTPROPS \CCODEARGTYPE MACRO ((FNH)
|
||||
(fetch (FNHEADER ARGTYPE) of FNH)))
|
||||
(PUTPROPS \CCODEARGTYPE MACRO ((FNH)
|
||||
(fetch (FNHEADER ARGTYPE) of FNH)))
|
||||
)
|
||||
)
|
||||
|
||||
@ -1714,9 +1718,8 @@ with the terms of said license.
|
||||
)
|
||||
|
||||
|
||||
(ADDTOVAR CONSTANTFOLDFNS
|
||||
PLUS IPLUS TIMES ITIMES DIFFERENCE IDIFFERENCE QUOTIENT IQUOTIENT IMIN IMAX IABS LLSH LRSH
|
||||
LOGOR LOGXOR LOGAND OR AND)
|
||||
(ADDTOVAR CONSTANTFOLDFNS PLUS IPLUS TIMES ITIMES DIFFERENCE IDIFFERENCE QUOTIENT IQUOTIENT IMIN
|
||||
IMAX IABS LLSH LRSH LOGOR LOGXOR LOGAND OR AND)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS COMPVARMACROHASH CONSTANTFOLDFNS)
|
||||
@ -1743,33 +1746,119 @@ with the terms of said license.
|
||||
|
||||
(ADDTOVAR LAMA APPLY* \INTERPRETER)
|
||||
)
|
||||
(PRETTYCOMPRINT LLINTERPCOMS)
|
||||
|
||||
(RPAQQ LLINTERPCOMS
|
||||
[(COMS (* ; "Compilation pre-requisites")
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
|
||||
LLBASIC LLSTK LLCODE LLPARAMS ACODE)))
|
||||
[E (* ;
|
||||
"Don't fontify these common functions")
|
||||
(SETQ FNSLST
|
||||
(LDIFFERENCE FNSLST
|
||||
'(EVALV PROG SET SETQ RETURN GO QUOTE AND OR PROGN COND PROG1 FUNCTION EVAL
|
||||
APPLY]
|
||||
(COMS (* ;
|
||||
"For calling interpreted functions")
|
||||
(FNS \INTERPRETER \INTERPRETER1 \SETUP-COMPILED-CLOSURE-CALL \STKNAME))
|
||||
(COMS (* ; "EVCALL ufn.")
|
||||
(FNS \ENVCALL.UFN \SETUP-ENVIRONMENT-CALL))
|
||||
(COMS (* ; "recursive interpreter")
|
||||
(FNS EVAL \EVAL \EVALFORM \EVALFORMASLAMBDA \EVALOTHER APPLY APPLY* \CHECKAPPLY*
|
||||
\CKAPPLYARGS DEFEVAL)
|
||||
(DECLARE%: DONTCOPY (MACROS .APPLY.))
|
||||
(COMS (* ; "Free variable manipulation")
|
||||
(FNS EVALV \EVALV1 \EVALVAR BOUNDP SET \SETVAR SETQ \STKSCAN \SETFVARSLOT))
|
||||
(COMS (* ; "PROG and friends")
|
||||
(FNS PROG \PROG0 \EVPROG1 RETURN GO EVALA \EVALA ERRORSET
|
||||
SI::ERRORSET-PRINT-FUNCTION))
|
||||
(COMS (* ;
|
||||
"LET and friends -- need these in the init")
|
||||
(FNS LET LET* \LET0 \LET*))
|
||||
(FNS QUOTE AND OR PROGN COND \EVPROGN PROG1)
|
||||
(COMS (VARS (\DEFEVALFNS NIL)
|
||||
(\EVALHOOK))
|
||||
(SPECVARS *EVALHOOK*)
|
||||
(ADDVARS (LAMBDASPLST LAMBDA NLAMBDA CL:LAMBDA OPENLAMBDA))
|
||||
(GLOBALVARS \DEFEVALFNS \EVALHOOK LAMBDASPLST CLISPARRAY)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (VARS (CLISPARRAY))
|
||||
(P (MOVD? 'SETQ 'SETN NIL T)))
|
||||
(GLOBALVARS CLISPARRAY))
|
||||
[COMS (* ;
|
||||
"Evaluating in different stack environment")
|
||||
(FNS ENVEVAL ENVAPPLY FUNCTION \FUNCT1 \MAKEFUNARGFRAME STKEVAL STKAPPLY RETEVAL
|
||||
RETAPPLY)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (* ;
|
||||
"For bootstrapping, IL:FUNCTION is as good as CL:FUNCTION")
|
||||
(P (MOVD? 'FUNCTION 'CL:FUNCTION NIL T]
|
||||
(COMS (* ; "Blip and other stack funniness")
|
||||
(FNS BLIPVAL SETBLIPVAL BLIPSCAN)
|
||||
(FNS \REALFRAMEP)
|
||||
[INITVARS (OPENFNS '(APPLY* SETQ AND OR COND SELECTQ PROG PROGN PROG1 ARG SETARG
|
||||
ERSETQ NLSETQ RESETFORM RESETLST RESETVARS RPTQ
|
||||
SAVESETQ SETN UNDONLSETQ XNLSETQ]
|
||||
(VARS \BLIPNAMES)
|
||||
(GLOBALVARS BRKINFOLST)
|
||||
(GLOBALVARS \BLIPNAMES OPENFNS)))
|
||||
(COMS (FNS RAIDCOMMAND RAIDSHOWFRAME RAIDSTACKCMD RAIDROOTFRAME PRINTADDRS PRINTVA READVA
|
||||
READATOM READOCT SHOWSTACKBLOCKS SHOWSTACKBLOCK1 PRINCOPY NOSUCHATOM)
|
||||
(FNS BACKTRACE \BACKTRACE \SCANFORNTENTRY \PRINTSTK \PRINTFRAME \PRINTBF)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (COMS * RAIDCOMS)))
|
||||
(COMS (FNS CCODEP EXPRP SUBRP FNTYP ARGTYPE NARGS ARGLIST \CCODEARGLIST \CCODEIVARSCAN)
|
||||
(COMS (* ;
|
||||
"Translation machinery for new LAMBDA words")
|
||||
(PROP VARTYPE LAMBDATRANFNS)
|
||||
(ALISTS (LAMBDATRANFNS)))
|
||||
(DECLARE%: DONTCOPY (MACROS \CCODENARGS \CCODEFNTYP \CCODEARGTYPE)))
|
||||
(COMS (* ; "CONSTANTS mechanism")
|
||||
(FNS CONSTANTS CONSTANTEXPRESSIONP)
|
||||
(INITVARS (COMPVARMACROHASH (HASHARRAY 100)))
|
||||
(* ; "We need this initialized for the INIT, so don't put it off. (It used to start out NIL and get set later)")
|
||||
(ADDVARS (CONSTANTFOLDFNS PLUS IPLUS TIMES ITIMES DIFFERENCE IDIFFERENCE QUOTIENT
|
||||
IQUOTIENT IMIN IMAX IABS LLSH LRSH LOGOR LOGXOR LOGAND OR AND))
|
||||
(GLOBALVARS COMPVARMACROHASH CONSTANTFOLDFNS))
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY DONTEVAL@LOAD (LOCALVARS . T))
|
||||
(SPECVARS *TAIL* *FN* *FORM* *ARGVAL*)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (ADDVARS (LAMS FAULTEVAL FAULTAPPLY)))
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
|
||||
(ADDVARS (NLAMA CONSTANTS PROG1 COND PROGN OR AND QUOTE LET* LET GO PROG SETQ)
|
||||
(NLAML FUNCTION RETURN)
|
||||
(LAMA BOUNDP APPLY* \INTERPRETER])
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
|
||||
|
||||
(ADDTOVAR NLAMA CONSTANTS PROG1 COND PROGN OR AND QUOTE LET* LET GO PROG SETQ)
|
||||
|
||||
(ADDTOVAR NLAML FUNCTION RETURN)
|
||||
|
||||
(ADDTOVAR LAMA BOUNDP APPLY* \INTERPRETER)
|
||||
)
|
||||
(PUTPROPS LLINTERP COPYRIGHT ("Venue & Xerox Corporation" T 1981 1982 1983 1984 1985 1986 1987 1988
|
||||
1990 1991 1992 1994 1995))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (6448 23709 (\INTERPRETER 6458 . 11054) (\INTERPRETER1 11056 . 17624) (
|
||||
\SETUP-COMPILED-CLOSURE-CALL 17626 . 22773) (\STKNAME 22775 . 23707)) (23738 29150 (\ENVCALL.UFN 23748
|
||||
. 23880) (\SETUP-ENVIRONMENT-CALL 23882 . 29148)) (29189 34066 (EVAL 29199 . 29299) (\EVAL 29301 .
|
||||
29511) (\EVALFORM 29513 . 30744) (\EVALFORMASLAMBDA 30746 . 30936) (\EVALOTHER 30938 . 31145) (APPLY
|
||||
31147 . 31254) (APPLY* 31256 . 32371) (\CHECKAPPLY* 32373 . 33478) (\CKAPPLYARGS 33480 . 33823) (
|
||||
DEFEVAL 33825 . 34064)) (35868 43313 (EVALV 35878 . 36087) (\EVALV1 36089 . 36244) (\EVALVAR 36246 .
|
||||
36609) (BOUNDP 36611 . 36827) (SET 36829 . 37195) (\SETVAR 37197 . 37567) (SETQ 37569 . 38241) (
|
||||
\STKSCAN 38243 . 41763) (\SETFVARSLOT 41765 . 43311)) (43347 56354 (PROG 43357 . 45873) (\PROG0 45875
|
||||
. 49505) (\EVPROG1 49507 . 49710) (RETURN 49712 . 50253) (GO 50255 . 51070) (EVALA 51072 . 53001) (
|
||||
\EVALA 53003 . 55596) (ERRORSET 55598 . 56203) (SI::ERRORSET-PRINT-FUNCTION 56205 . 56352)) (56413
|
||||
69065 (LET 56423 . 58566) (LET* 58568 . 60716) (\LET0 60718 . 64378) (\LET* 64380 . 69063)) (69066
|
||||
70642 (QUOTE 69076 . 69107) (AND 69109 . 69317) (OR 69319 . 69567) (PROGN 69569 . 69848) (COND 69850
|
||||
. 70184) (\EVPROGN 70186 . 70399) (PROG1 70401 . 70640)) (71130 78021 (ENVEVAL 71140 . 71390) (
|
||||
ENVAPPLY 71392 . 71649) (FUNCTION 71651 . 71881) (\FUNCT1 71883 . 74332) (\MAKEFUNARGFRAME 74334 .
|
||||
76531) (STKEVAL 76533 . 76681) (STKAPPLY 76683 . 76852) (RETEVAL 76854 . 77458) (RETAPPLY 77460 .
|
||||
78019)) (78142 85650 (BLIPVAL 78152 . 82053) (SETBLIPVAL 82055 . 84797) (BLIPSCAN 84799 . 85648)) (
|
||||
85651 86346 (\REALFRAMEP 85661 . 86344)) (86722 96117 (RAIDCOMMAND 86732 . 90338) (RAIDSHOWFRAME 90340
|
||||
. 90723) (RAIDSTACKCMD 90725 . 91906) (RAIDROOTFRAME 91908 . 92170) (PRINTADDRS 92172 . 92698) (
|
||||
PRINTVA 92700 . 92845) (READVA 92847 . 92925) (READATOM 92927 . 93509) (READOCT 93511 . 94142) (
|
||||
SHOWSTACKBLOCKS 94144 . 95390) (SHOWSTACKBLOCK1 95392 . 95543) (PRINCOPY 95545 . 95677) (NOSUCHATOM
|
||||
95679 . 96115)) (96118 104746 (BACKTRACE 96128 . 96485) (\BACKTRACE 96487 . 97593) (\SCANFORNTENTRY
|
||||
97595 . 99225) (\PRINTSTK 99227 . 99414) (\PRINTFRAME 99416 . 103399) (\PRINTBF 103401 . 104744)) (
|
||||
107255 116599 (CCODEP 107265 . 107540) (EXPRP 107542 . 107801) (SUBRP 107803 . 107858) (FNTYP 107860
|
||||
. 108620) (ARGTYPE 108622 . 109236) (NARGS 109238 . 109725) (ARGLIST 109727 . 110976) (\CCODEARGLIST
|
||||
110978 . 115374) (\CCODEIVARSCAN 115376 . 116597)) (117516 119747 (CONSTANTS 117526 . 117817) (
|
||||
CONSTANTEXPRESSIONP 117819 . 119745)))))
|
||||
(FILEMAP (NIL (6396 23657 (\INTERPRETER 6406 . 11002) (\INTERPRETER1 11004 . 17572) (
|
||||
\SETUP-COMPILED-CLOSURE-CALL 17574 . 22721) (\STKNAME 22723 . 23655)) (23686 29098 (\ENVCALL.UFN 23696
|
||||
. 23828) (\SETUP-ENVIRONMENT-CALL 23830 . 29096)) (29137 34014 (EVAL 29147 . 29247) (\EVAL 29249 .
|
||||
29459) (\EVALFORM 29461 . 30692) (\EVALFORMASLAMBDA 30694 . 30884) (\EVALOTHER 30886 . 31093) (APPLY
|
||||
31095 . 31202) (APPLY* 31204 . 32319) (\CHECKAPPLY* 32321 . 33426) (\CKAPPLYARGS 33428 . 33771) (
|
||||
DEFEVAL 33773 . 34012)) (36106 43695 (EVALV 36116 . 36325) (\EVALV1 36327 . 36482) (\EVALVAR 36484 .
|
||||
36847) (BOUNDP 36849 . 37065) (SET 37067 . 37433) (\SETVAR 37435 . 37805) (SETQ 37807 . 38479) (
|
||||
\STKSCAN 38481 . 42145) (\SETFVARSLOT 42147 . 43693)) (43729 56736 (PROG 43739 . 46255) (\PROG0 46257
|
||||
. 49887) (\EVPROG1 49889 . 50092) (RETURN 50094 . 50635) (GO 50637 . 51452) (EVALA 51454 . 53383) (
|
||||
\EVALA 53385 . 55978) (ERRORSET 55980 . 56585) (SI::ERRORSET-PRINT-FUNCTION 56587 . 56734)) (56795
|
||||
69447 (LET 56805 . 58948) (LET* 58950 . 61098) (\LET0 61100 . 64760) (\LET* 64762 . 69445)) (69448
|
||||
71024 (QUOTE 69458 . 69489) (AND 69491 . 69699) (OR 69701 . 69949) (PROGN 69951 . 70230) (COND 70232
|
||||
. 70566) (\EVPROGN 70568 . 70781) (PROG1 70783 . 71022)) (71512 78403 (ENVEVAL 71522 . 71772) (
|
||||
ENVAPPLY 71774 . 72031) (FUNCTION 72033 . 72263) (\FUNCT1 72265 . 74714) (\MAKEFUNARGFRAME 74716 .
|
||||
76913) (STKEVAL 76915 . 77063) (STKAPPLY 77065 . 77234) (RETEVAL 77236 . 77840) (RETAPPLY 77842 .
|
||||
78401)) (78524 86032 (BLIPVAL 78534 . 82435) (SETBLIPVAL 82437 . 85179) (BLIPSCAN 85181 . 86030)) (
|
||||
86033 86728 (\REALFRAMEP 86043 . 86726)) (87109 96504 (RAIDCOMMAND 87119 . 90725) (RAIDSHOWFRAME 90727
|
||||
. 91110) (RAIDSTACKCMD 91112 . 92293) (RAIDROOTFRAME 92295 . 92557) (PRINTADDRS 92559 . 93085) (
|
||||
PRINTVA 93087 . 93232) (READVA 93234 . 93312) (READATOM 93314 . 93896) (READOCT 93898 . 94529) (
|
||||
SHOWSTACKBLOCKS 94531 . 95777) (SHOWSTACKBLOCK1 95779 . 95930) (PRINCOPY 95932 . 96064) (NOSUCHATOM
|
||||
96066 . 96502)) (96505 105133 (BACKTRACE 96515 . 96872) (\BACKTRACE 96874 . 97980) (\SCANFORNTENTRY
|
||||
97982 . 99612) (\PRINTSTK 99614 . 99801) (\PRINTFRAME 99803 . 103786) (\PRINTBF 103788 . 105131)) (
|
||||
107892 117236 (CCODEP 107902 . 108177) (EXPRP 108179 . 108438) (SUBRP 108440 . 108495) (FNTYP 108497
|
||||
. 109257) (ARGTYPE 109259 . 109873) (NARGS 109875 . 110362) (ARGLIST 110364 . 111613) (\CCODEARGLIST
|
||||
111615 . 116011) (\CCODEIVARSCAN 116013 . 117234)) (118282 120513 (CONSTANTS 118292 . 118583) (
|
||||
CONSTANTEXPRESSIONP 118585 . 120511)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Loading…
x
Reference in New Issue
Block a user