(FILECREATED " 6-Feb-85 21:54:58" {ROSEBOWL}<BIRD>BTMP>BTMP.;29 34384 changes to: (FNS \BTMP.DO.LOGNOT) previous date: "20-Jan-85 08:36:59" {ROSEBOWL}<BIRD>BTMP>BTMP.;26) (* Copyright (c) 1984, 1985 by Xerox Corporation. All rights reserved.) (PRETTYCOMPRINT BTMPCOMS) (RPAQQ BTMPCOMS ((DECLARE: EVAL@COMPILE DONTCOPY (MACROS \BTMP.FRAME.AND.SOURCE \BTMP.OPENDIVERSION \BTMP.NULL \BTMP.SINK)) (FILES PIPES) (FNS * \BTMP.FNS.KERNEL) (FNS * \BTMP.FNS.HOOKS) (FNS * \BTMP.FNS.UTILITY) [BLOCKS * (LIST (APPEND (QUOTE (NIL)) \BTMP.FNS.KERNEL \BTMP.FNS.HOOKS \BTMP.FNS.UTILITY (QUOTE ((ENTRIES BTMP) (GLOBALVARS \BTMP.BUILTIN.FNS \BTMP.NULLSTREAM \BTMP.SYNTAX.DEFS) (LOCALVARS . T) (SPECVARS \BTMP.ARGS \BTMP.STATE] (RECORDS \BTMP.DB \BTMP.STATE \BTMP.SYNTAX) (VARS \BTMP.BUILTIN.FNS \BTMP.SYNTAX.DEFS))) (DECLARE: EVAL@COMPILE DONTCOPY (DECLARE: EVAL@COMPILE (PUTPROPS \BTMP.FRAME.AND.SOURCE MACRO [(\BTMP.STATE) (freplace (\BTMP.STATE \BTMP.CURRENT.FRAME) of \BTMP.STATE with (CAR (ffetch (\BTMP.STATE \BTMP.BAK.STK) of \BTMP.STATE))) (freplace (\BTMP.STATE \BTMP.CURRENT.SOURCE) of \BTMP.STATE with (CAR (ffetch (\BTMP.STATE \BTMP.CURRENT.FRAME) of \BTMP.STATE]) (PUTPROPS \BTMP.OPENDIVERSION MACRO (NIL (OPENSTREAM (QUOTE {NODIRCORE}) (QUOTE BOTH) (QUOTE NEW)))) (PUTPROPS \BTMP.NULL MACRO (NIL \BTMP.NULLSTREAM)) (PUTPROPS \BTMP.SINK MACRO [(\BTMP.STATE) (freplace (\BTMP.STATE \BTMP.CURRENT.SINK) of \BTMP.STATE with (if (ffetch (\BTMP.STATE \BTMP.FWD.STK) of \BTMP.STATE) then (CADAAR (ffetch (\BTMP.STATE \BTMP.FWD.STK) of \BTMP.STATE)) else (CAR (ffetch (\BTMP.STATE \BTMP.DIV.STK) of \BTMP.STATE]) ) ) (FILESLOAD PIPES) (RPAQQ \BTMP.FNS.KERNEL (BTMP \BTMP.CLOSE \BTMP.COPY \BTMP.DUP \BTMP.ERROR \BTMP.EVALUATE \BTMP.FIND \BTMP.INITIALIZE \BTMP.RESET \BTMP.SETSYNTAX \BTMP.STORE)) (DEFINEQ (BTMP [LAMBDA (INF OUTF ARGLIST) (* edited: "20-Jan-85 08:36") (* * Basic Text Macro Processor) (RESETLST (PROG [[\BTMP.STATE (create \BTMP.STATE \BTMP.OUTPUT.STREAM ←(OPENRESETSTREAM OUTF (QUOTE OUTPUT] (INS (OPENRESETSTREAM INF (QUOTE INPUT] (\BTMP.INITIALIZE \BTMP.STATE INS ARGLIST) (bind (BLOCKCOUNT ← 0) QUOTING while (ffetch (\BTMP.STATE \BTMP.BAK.STK) of \BTMP.STATE) do (bind BYTE PENDING until (EOFP (ffetch (\BTMP.STATE \BTMP.CURRENT.SOURCE) of \BTMP.STATE)) do (if (MINUSP (SETQ BLOCKCOUNT (SUB1 BLOCKCOUNT))) then (SETQ BLOCKCOUNT 100) (BLOCK)) (SETQ BYTE (BIN (ffetch (\BTMP.STATE \BTMP.CURRENT.SOURCE) of \BTMP.STATE))) (if PENDING then (PROG ((D (\BTMP.OPENDIVERSION))) (BOUT D BYTE) (\BTMP.EVALUATE \BTMP.STATE PENDING (LIST D))) (SETQ PENDING NIL) else (OR [AND (ffetch (\BTMP.STATE \BTMP.FWD.STK) of \BTMP.STATE) (PROG ((F (CAR (ffetch (\BTMP.STATE \BTMP.FWD.STK) of \BTMP.STATE))) SYNTAX) (SETQ SYNTAX (CDR F)) (RETURN (if (EQ BYTE (ffetch (\BTMP.SYNTAX \BTMP.SYNTAX.KET) of SYNTAX)) then (* Tuple terminator) (pop (ffetch (\BTMP.STATE \BTMP.FWD.STK) of \BTMP.STATE)) (\BTMP.SINK \BTMP.STATE) (\BTMP.EVALUATE \BTMP.STATE SYNTAX (CAAR F)) (SETQ QUOTING NIL) T elseif (EQ BYTE (ffetch (\BTMP.SYNTAX \BTMP.SYNTAX.SEP) of SYNTAX)) then (* Tuple seperator) (TCONC (CAAR (ffetch (\BTMP.STATE \BTMP.FWD.STK) of \BTMP.STATE)) (\BTMP.OPENDIVERSION)) (\BTMP.SINK \BTMP.STATE) T] [AND (NOT QUOTING) (PROG ((SYNTAX (ELT (ffetch (\BTMP.STATE \BTMP.ACTIVE.CHARS) of \BTMP.STATE) BYTE))) (RETURN (AND SYNTAX (PROGN (if (ffetch (\BTMP.SYNTAX \BTMP.SYNTAX.KET) of SYNTAX) then (* Tuple initiator) (push (ffetch (\BTMP.STATE \BTMP.FWD.STK) of \BTMP.STATE) (CONS (CONS) SYNTAX)) (TCONC (CAAR (ffetch (\BTMP.STATE \BTMP.FWD.STK) of \BTMP.STATE)) (\BTMP.OPENDIVERSION)) (\BTMP.SINK \BTMP.STATE) (SETQ QUOTING (ffetch (\BTMP.SYNTAX \BTMP.SYNTAX.FLAG) of SYNTAX)) elseif (ffetch (\BTMP.SYNTAX \BTMP.SYNTAX.FLAG) of SYNTAX) then (* Single character) (SETQ PENDING SYNTAX) else (* Stand alone) (\BTMP.EVALUATE \BTMP.STATE SYNTAX NIL) ) T] (BOUT (ffetch (\BTMP.STATE \BTMP.CURRENT.SINK) of \BTMP.STATE) BYTE))) finally (for A in (ffetch (\BTMP.STATE \BTMP.CURRENT.FRAME) of \BTMP.STATE) when (NEQ A INS) do (\BTMP.CLOSE A)) (pop (ffetch (\BTMP.STATE \BTMP.BAK.STK) of \BTMP.STATE)) (\BTMP.FRAME.AND.SOURCE \BTMP.STATE]) (\BTMP.CLOSE [LAMBDA (S) (* edited: "12-Jan-85 00:49") (if (NEQ S \BTMP.NULLSTREAM) then (CLOSEF? S]) (\BTMP.COPY [LAMBDA (COPYIN COPYOUT) (* edited: "12-Jan-85 00:13") [AND COPYIN (if (STREAMP COPYIN) then (\BTMP.RESET COPYIN) (until (EOFP COPYIN) do (BOUT COPYOUT (BIN COPYIN))) else (PROG ((STRING (MKSTRING COPYIN))) (for I from 1 to (NCHARS STRING) do (BOUT COPYOUT (NTHCHARCODE STRING I] COPYOUT]) (\BTMP.DUP [LAMBDA (SRCE) (* edited: "12-Jan-85 02:58") (PROG ((D (\BTMP.OPENDIVERSION))) (\BTMP.COPY SRCE D) (RETURN (\BTMP.RESET D]) (\BTMP.ERROR [LAMBDA (STRING STREAM) (* edited: "12-Jan-85 05:13") (ERROR (PACK* "(BTMP) " STRING) (\BTMP.PACK STREAM]) (\BTMP.EVALUATE [LAMBDA (\BTMP.STATE SYNTAX ARGLIST) (* edited: "18-Jan-85 05:36") (* * Warning: Check out \BTMP.DO.MAP.STAR + \BTMP.INTERPRET) (PROG [(FNDEF (ffetch (\BTMP.DB \BTMP.DB.VALUE) of (ffetch (\BTMP.SYNTAX \BTMP.SYNTAX.FN.DEF) of SYNTAX] (if (LITATOM FNDEF) then (if FNDEF then (APPLY* FNDEF \BTMP.STATE ARGLIST)) else (push (ffetch (\BTMP.STATE \BTMP.BAK.STK) of \BTMP.STATE) (CONS (\BTMP.DUP FNDEF) (CONS (\BTMP.DUP (ffetch (\BTMP.SYNTAX \BTMP.SYNTAX.FN.NAM) of SYNTAX)) ARGLIST))) (\BTMP.FRAME.AND.SOURCE \BTMP.STATE]) (\BTMP.FIND [LAMBDA (DATABASE KEYSOURCE) (* edited: "29-Dec-84 12:43") (PROG ((DB DATABASE)) (\BTMP.RESET KEYSOURCE) LOOP(SETQ DB (CDR DB)) (if (NOT (EOFP KEYSOURCE)) then (if (NULL (SETQ DB (ASSOC (BIN KEYSOURCE) DB))) then (RETURN NIL)) (GO LOOP)) (SETQ DB (ASSOC NIL DB)) (RETURN (AND DB (CDR DB]) (\BTMP.INITIALIZE [LAMBDA (\BTMP.STATE INS ARGLIST) (* edited: "18-Jan-85 05:10") (freplace (\BTMP.STATE \BTMP.BUILTIN.DEFS) of \BTMP.STATE with (LIST (QUOTE ***BUILTINS***))) (freplace (\BTMP.STATE \BTMP.ACTIVE.CHARS) of \BTMP.STATE with (ARRAY 256 (QUOTE POINTER) NIL 0)) (push (ffetch (\BTMP.STATE \BTMP.DIV.STK) of \BTMP.STATE) (ffetch (\BTMP.STATE \BTMP.OUTPUT.STREAM) of \BTMP.STATE)) (\BTMP.SINK \BTMP.STATE) (freplace (\BTMP.STATE \BTMP.USER.DEFS) of \BTMP.STATE with (LIST (QUOTE ***DIVERSIONS***))) (for X in \BTMP.BUILTIN.FNS do (\BTMP.STORE (ffetch (\BTMP.STATE \BTMP.BUILTIN.DEFS) of \BTMP.STATE) (OPENSTRINGSTREAM (CAR X)) (CDR X) NIL)) [for X in \BTMP.SYNTAX.DEFS do (\BTMP.SETSYNTAX \BTMP.STATE (CHCON1 (CAR X)) (OPENSTRINGSTREAM (CADR X)) (CADDR X) (AND (CADDDR X) (CHCON1 (CADDDR X))) (AND (CAR (CDDDDR X)) (CHCON1 (CAR (CDDDDR X] [push (ffetch (\BTMP.STATE \BTMP.BAK.STK) of \BTMP.STATE) (CONS INS (for A in (CONS (MKSTRING INS) ARGLIST) collect (\BTMP.DUP A] (\BTMP.FRAME.AND.SOURCE \BTMP.STATE) (SETQ \BTMP.NULLSTREAM (OPENRESETSTREAM (QUOTE {NULL}) (QUOTE BOTH]) (\BTMP.RESET [LAMBDA (D) (* edited: "29-Dec-84 06:11") (if D then (SETFILEPTR D 0)) D]) (\BTMP.SETSYNTAX [LAMBDA (\BTMP.STATE CHBRA FNNAME FLAG CHKET CHSEP) (* edited: "18-Jan-85 05:37") (SETA (ffetch (\BTMP.STATE \BTMP.ACTIVE.CHARS) of \BTMP.STATE) CHBRA (create \BTMP.SYNTAX \BTMP.SYNTAX.KET ← CHKET \BTMP.SYNTAX.SEP ← CHSEP \BTMP.SYNTAX.FN.DEF ←(OR (\BTMP.FIND (ffetch (\BTMP.STATE \BTMP.BUILTIN.DEFS) of \BTMP.STATE) FNNAME) (\BTMP.FIND (ffetch (\BTMP.STATE \BTMP.USER.DEFS) of \BTMP.STATE) FNNAME) (PROGN (\BTMP.ERROR "Undefined function in %"syntax%": " FNNAME) (\BTMP.STORE (ffetch (\BTMP.STATE \BTMP.USER.DEFS) of \BTMP.STATE) FNNAME NIL NIL))) \BTMP.SYNTAX.FLAG ← FLAG \BTMP.SYNTAX.FN.NAM ← FNNAME]) (\BTMP.STORE [LAMBDA (DATABASE KEYSOURCE VALUE DEVICE) (* edited: "18-Jan-85 04:45") (PROG (BYTE (DB DATABASE) ITEM DBREC OLDVAL) (\BTMP.RESET KEYSOURCE) (until (EOFP KEYSOURCE) do (SETQ BYTE (BIN KEYSOURCE)) (if [NULL (SETQ ITEM (ASSOC BYTE (CDR DB] then (SETQ ITEM (LIST BYTE)) (push (CDR DB) ITEM)) (SETQ DB ITEM)) (if [NULL (SETQ ITEM (ASSOC NIL (CDR DB] then [SETQ ITEM (CONS NIL (SETQ DBREC (create \BTMP.DB \BTMP.DB.NAME ←(\BTMP.DUP KEYSOURCE] (push (CDR DB) ITEM) elseif [STREAMP (SETQ OLDVAL (ffetch (\BTMP.DB \BTMP.DB.VALUE) of (SETQ DBREC (CDR ITEM] then (\BTMP.CLOSE OLDVAL)) (if DEVICE then (freplace (\BTMP.DB \BTMP.DB.DEVICE) of DBREC with (CAR DEVICE))) (freplace (\BTMP.DB \BTMP.DB.VALUE) of DBREC with (if (ffetch (\BTMP.DB \BTMP.DB.DEVICE) of DBREC) then (PROG ((STREAM (OPENRESETSTREAM (ffetch (\BTMP.DB \BTMP.DB.DEVICE) of DBREC) (QUOTE BOTH) (QUOTE NEW) NIL NIL (QUOTE Y) T))) (if (\BTMP.PREDICATE VALUE) then (\BTMP.COPY VALUE STREAM)) (RETURN STREAM)) elseif VALUE then VALUE else (\BTMP.OPENDIVERSION))) (RETURN DBREC]) ) (RPAQQ \BTMP.FNS.HOOKS (\BTMP.DO.ADD \BTMP.DO.APPLY.STAR \BTMP.DO.ARGS \BTMP.DO.COLLECT \BTMP.DO.CONCATENATE \BTMP.DO.DEFINE \BTMP.DO.DISCARD \BTMP.DO.DIVERT \BTMP.DO.DIVIDE \BTMP.DO.EQ \BTMP.DO.EQUAL \BTMP.DO.ESCAPECHARFN \BTMP.DO.EVAL \BTMP.DO.GE \BTMP.DO.GT \BTMP.DO.IF \BTMP.DO.INCLUDE \BTMP.DO.LE \BTMP.DO.LLSH \BTMP.DO.LOGAND \BTMP.DO.LOGNOT \BTMP.DO.LOGOR \BTMP.DO.LOGXOR \BTMP.DO.LRSH \BTMP.DO.LT \BTMP.DO.MAP.STAR \BTMP.DO.MOD \BTMP.DO.MULTIPLY \BTMP.DO.NE \BTMP.DO.POP \BTMP.DO.PUSH \BTMP.DO.SUBSTRING \BTMP.DO.SUBTRACT \BTMP.DO.SYNTAX)) (DEFINEQ (\BTMP.DO.ADD [LAMBDA (\BTMP.STATE \BTMP.ARGS) (* edited: "12-Jan-85 01:40") (\BTMP.ARITH.N \BTMP.STATE (FUNCTION PLUS) 0 \BTMP.ARGS]) (\BTMP.DO.APPLY.STAR [LAMBDA (\BTMP.STATE \BTMP.ARGS) (* edited: "12-Jan-85 01:40") (\BTMP.INTERPRET \BTMP.STATE \BTMP.ARGS]) (\BTMP.DO.ARGS [LAMBDA (\BTMP.STATE \BTMP.ARGS) (* edited: "12-Jan-85 01:40") (PROG ([N (\BTMP.NUMBER (CAR (NTH \BTMP.ARGS 1] [M (\BTMP.NUMBER (CAR (NTH \BTMP.ARGS 2] (BRA (CAR (NTH \BTMP.ARGS 3))) [SEP (\BTMP.PREDICATE (CAR (NTH \BTMP.ARGS 4] (KET (CAR (NTH \BTMP.ARGS 5))) [REVERSE? (\BTMP.PREDICATE (CAR (NTH \BTMP.ARGS 6] (ARGCOUNT (\BTMP.ARGCOUNT \BTMP.STATE))) (if (ZEROP N) then (SETQ N 1) elseif (MINUSP N) then (add N ARGCOUNT 1)) (if (ZEROP M) then (SETQ M ARGCOUNT) elseif (MINUSP M) then (add M ARGCOUNT 1)) (\BTMP.PRODUCE \BTMP.STATE BRA) [if REVERSE? then (if (LEQ N M) then (for I from M to (ADD1 N) by -1 do (\BTMP.ARG \BTMP.STATE I) (if SEP then (\BTMP.PRODUCE \BTMP.STATE SEP)) finally (\BTMP.ARG \BTMP.STATE N))) else (if (LEQ N M) then (for I from N to (SUB1 M) do (\BTMP.ARG \BTMP.STATE I) (if SEP then (\BTMP.PRODUCE \BTMP.STATE SEP)) finally (\BTMP.ARG \BTMP.STATE M] (\BTMP.PRODUCE \BTMP.STATE KET]) (\BTMP.DO.COLLECT [LAMBDA (\BTMP.STATE \BTMP.ARGS) (* edited: "18-Jan-85 04:57") (for NAME in \BTMP.ARGS when (\BTMP.PREDICATE NAME) do (PROG ((D (\BTMP.LOOKUP (ffetch (\BTMP.STATE \BTMP.USER.DEFS) of \BTMP.STATE) NAME))) (if D then (if (EQ D (CAR (ffetch (\BTMP.STATE \BTMP.DIV.STK) of \BTMP.STATE))) then (\BTMP.POP \BTMP.STATE)) (\BTMP.PRODUCE \BTMP.STATE D) else (\BTMP.ERROR "Undefined diversion in %"collect%": " NAME]) (\BTMP.DO.CONCATENATE [LAMBDA (\BTMP.STATE \BTMP.ARGS) (* edited: "12-Jan-85 01:40") (for A in \BTMP.ARGS do (\BTMP.PRODUCE \BTMP.STATE A]) (\BTMP.DO.DEFINE [LAMBDA (\BTMP.STATE \BTMP.ARGS) (* edited: "18-Jan-85 04:57") (PROG [[NAME (\BTMP.PREDICATE (CAR (NTH \BTMP.ARGS 1] (DEFN (CAR (NTH \BTMP.ARGS 2))) (DEVICE (CAR (NTH \BTMP.ARGS 3] (if NAME then (\BTMP.STORE (ffetch (\BTMP.STATE \BTMP.USER.DEFS) of \BTMP.STATE) NAME DEFN (LIST (\BTMP.PACK DEVICE]) (\BTMP.DO.DISCARD [LAMBDA (\BTMP.STATE \BTMP.ARGS) (* edited: "18-Jan-85 04:55") (RPLACA (ffetch (\BTMP.STATE \BTMP.DIV.STK) of \BTMP.STATE) \BTMP.NULLSTREAM) (\BTMP.SINK \BTMP.STATE]) (\BTMP.DO.DIVERT [LAMBDA (\BTMP.STATE \BTMP.ARGS) (* edited: "18-Jan-85 04:55") (pop (ffetch (\BTMP.STATE \BTMP.DIV.STK) of \BTMP.STATE)) (\BTMP.PUSH \BTMP.STATE \BTMP.ARGS]) (\BTMP.DO.DIVIDE [LAMBDA (\BTMP.STATE \BTMP.ARGS) (* edited: "12-Jan-85 01:40") (\BTMP.ARITH.2 \BTMP.STATE (FUNCTION QUOTIENT) \BTMP.ARGS 1.0]) (\BTMP.DO.EQ [LAMBDA (\BTMP.STATE \BTMP.ARGS) (* edited: "12-Jan-85 01:40") (\BTMP.ARITH.P \BTMP.STATE (FUNCTION EQP) \BTMP.ARGS]) (\BTMP.DO.EQUAL [LAMBDA (\BTMP.STATE \BTMP.ARGS) (* edited: "12-Jan-85 01:40") (if [OR (NULL \BTMP.ARGS) (NULL (CDR \BTMP.ARGS)) (PROG ((X (CAR \BTMP.ARGS)) (L (CDR \BTMP.ARGS))) (for A in \BTMP.ARGS do (\BTMP.RESET A)) LOOP(if (EOFP X) then (RETURN (for Y in L always (EOFP Y))) elseif [for Y in L bind (V ←(BIN X)) always (AND (NOT (EOFP Y)) (EQ V (BIN Y] then (GO LOOP) else (RETURN NIL] then (\BTMP.TRUE \BTMP.STATE]) (\BTMP.DO.ESCAPECHARFN [LAMBDA (\BTMP.STATE \BTMP.ARGS) (* edited: "18-Jan-85 05:18") (if (AND \BTMP.ARGS (\BTMP.PREDICATE (CAR \BTMP.ARGS))) then (PROG [(BYTE (BIN (\BTMP.RESET (CAR \BTMP.ARGS] (SELCHARQ BYTE [(0 1 2 3 4 5 6 7 8 9) (\BTMP.ARG \BTMP.STATE (IDIFFERENCE BYTE (CHARCODE 0] (# (\BTMP.PRODUCE \BTMP.STATE (\BTMP.ARGCOUNT \BTMP.STATE))) (BOUT (ffetch (\BTMP.STATE \BTMP.CURRENT.SINK) of \BTMP.STATE) BYTE]) (\BTMP.DO.EVAL [LAMBDA (\BTMP.STATE \BTMP.ARGS) (* edited: "18-Jan-85 05:10") (if \BTMP.ARGS then [push (ffetch (\BTMP.STATE \BTMP.BAK.STK) of \BTMP.STATE) (CONS (\BTMP.RESET (CAR \BTMP.ARGS)) (CONS (OPENSTRINGSTREAM "<eval>" (QUOTE INPUT)) (CDR \BTMP.ARGS] (\BTMP.FRAME.AND.SOURCE \BTMP.STATE]) (\BTMP.DO.GE [LAMBDA (\BTMP.STATE \BTMP.ARGS) (* edited: "12-Jan-85 01:40") (\BTMP.ARITH.P \BTMP.STATE (FUNCTION GEQ) \BTMP.ARGS]) (\BTMP.DO.GT [LAMBDA (\BTMP.STATE \BTMP.ARGS) (* edited: "12-Jan-85 01:40") (\BTMP.ARITH.P \BTMP.STATE (FUNCTION GREATERP) \BTMP.ARGS]) (\BTMP.DO.IF [LAMBDA (\BTMP.STATE \BTMP.ARGS) (* edited: "12-Jan-85 01:40") (\BTMP.PRODUCE \BTMP.STATE (CAR (NTH \BTMP.ARGS (if (\BTMP.PREDICATE (CAR (NTH \BTMP.ARGS 1))) then 2 else 3]) (\BTMP.DO.INCLUDE [LAMBDA (\BTMP.STATE \BTMP.ARGS) (* edited: "18-Jan-85 05:10") (if \BTMP.ARGS then (PROG ((NAME (CAR \BTMP.ARGS))) (if (\BTMP.PREDICATE NAME) then (push (ffetch (\BTMP.STATE \BTMP.BAK.STK) of \BTMP.STATE) (CONS (OPENRESETSTREAM (\BTMP.PACK NAME) (QUOTE INPUT)) \BTMP.ARGS)) (\BTMP.FRAME.AND.SOURCE \BTMP.STATE]) (\BTMP.DO.LE [LAMBDA (\BTMP.STATE \BTMP.ARGS) (* edited: "12-Jan-85 01:40") (\BTMP.ARITH.P \BTMP.STATE (FUNCTION LEQ) \BTMP.ARGS]) (\BTMP.DO.LLSH [LAMBDA (\BTMP.STATE \BTMP.ARGS) (* edited: "12-Jan-85 01:40") (\BTMP.PRODUCE \BTMP.STATE (LLSH (\BTMP.NUMBER (CAR (NTH \BTMP.ARGS 1))) (\BTMP.NUMBER (CAR (NTH \BTMP.ARGS 2]) (\BTMP.DO.LOGAND [LAMBDA (\BTMP.STATE \BTMP.ARGS) (* edited: "12-Jan-85 01:40") (\BTMP.ARITH.N \BTMP.STATE (FUNCTION LOGAND) -1 \BTMP.ARGS]) (\BTMP.DO.LOGNOT [LAMBDA (\BTMP.STATE \BTMP.ARGS) (* mgb: " 6-Feb-85 21:54") (\BTMP.PRODUCE \BTMP.STATE (LOGNOT (\BTMP.NUMBER (AND \BTMP.ARGS (CAR \BTMP.ARGS]) (\BTMP.DO.LOGOR [LAMBDA (\BTMP.STATE \BTMP.ARGS) (* edited: "12-Jan-85 01:40") (\BTMP.ARITH.N \BTMP.STATE (FUNCTION LOGOR) 0 \BTMP.ARGS]) (\BTMP.DO.LOGXOR [LAMBDA (\BTMP.STATE \BTMP.ARGS) (* edited: "12-Jan-85 01:40") (\BTMP.ARITH.N \BTMP.STATE (FUNCTION LOGXOR) 0 \BTMP.ARGS]) (\BTMP.DO.LRSH [LAMBDA (\BTMP.STATE \BTMP.ARGS) (* edited: "12-Jan-85 01:40") (\BTMP.PRODUCE \BTMP.STATE (LRSH (\BTMP.NUMBER (CAR (NTH \BTMP.ARGS 1))) (\BTMP.NUMBER (CAR (NTH \BTMP.ARGS 2]) (\BTMP.DO.LT [LAMBDA (\BTMP.STATE \BTMP.ARGS) (* edited: "12-Jan-85 01:40") (\BTMP.ARITH.P \BTMP.STATE (FUNCTION LESSP) \BTMP.ARGS]) (\BTMP.DO.MAP.STAR [LAMBDA (\BTMP.STATE \BTMP.ARGS) (* edited: "18-Jan-85 05:10") (* * Warning: Check out \BTMP.EVALUATE + \BTMP.INTERPRET) (if \BTMP.ARGS then (PROG ((FNNAME (CAR \BTMP.ARGS)) (ARGLIST (CDR \BTMP.ARGS)) FNDEF) (if ARGLIST then (if (SETQ FNDEF (\BTMP.LOOKUP (ffetch (\BTMP.STATE \BTMP.BUILTIN.DEFS) of \BTMP.STATE) FNNAME)) then (for A in ARGLIST do (APPLY* FNDEF \BTMP.STATE (LIST A))) elseif (SETQ FNDEF (AND (\BTMP.PREDICATE FNNAME) (\BTMP.LOOKUP (ffetch (\BTMP.STATE \BTMP.USER.DEFS) of \BTMP.STATE) FNNAME))) then (for A in (REVERSE ARGLIST) do (push (ffetch (\BTMP.STATE \BTMP.BAK.STK) of \BTMP.STATE) (LIST (\BTMP.DUP FNDEF) FNNAME A))) (\BTMP.FRAME.AND.SOURCE \BTMP.STATE) else (\BTMP.ERROR "Undefined function in %"map*%": " FNNAME]) (\BTMP.DO.MOD [LAMBDA (\BTMP.STATE \BTMP.ARGS) (* edited: "12-Jan-85 01:40") (\BTMP.PRODUCE \BTMP.STATE (IREMAINDER (\BTMP.NUMBER (CAR (NTH \BTMP.ARGS 1))) (\BTMP.NUMBER (CAR (NTH \BTMP.ARGS 2]) (\BTMP.DO.MULTIPLY [LAMBDA (\BTMP.STATE \BTMP.ARGS) (* edited: "12-Jan-85 01:40") (\BTMP.ARITH.N \BTMP.STATE (FUNCTION TIMES) 1 \BTMP.ARGS]) (\BTMP.DO.NE [LAMBDA (\BTMP.STATE \BTMP.ARGS) (* edited: "12-Jan-85 01:40") (PROG [(VALS (for A in \BTMP.ARGS collect (\BTMP.NUMBER A] (for P on VALS do (for Q on (CDR P) when (EQP (CAR P) (CAR Q)) do (GO FAIL)) finally (\BTMP.TRUE \BTMP.STATE)) FAIL]) (\BTMP.DO.POP [LAMBDA (\BTMP.STATE \BTMP.ARGS) (* edited: "12-Jan-85 01:40") (\BTMP.POP \BTMP.STATE]) (\BTMP.DO.PUSH [LAMBDA (\BTMP.STATE \BTMP.ARGS) (* edited: "12-Jan-85 02:13") (\BTMP.PUSH \BTMP.STATE \BTMP.ARGS]) (\BTMP.DO.SUBSTRING [LAMBDA (\BTMP.STATE \BTMP.ARGS) (* edited: "18-Jan-85 05:18") (PROG [(X (CAR (NTH \BTMP.ARGS 1))) [N (\BTMP.NUMBER (CAR (NTH \BTMP.ARGS 2] (M (\BTMP.NUMBER (CAR (NTH \BTMP.ARGS 3] (if (ZEROP N) then (SETQ N 1) elseif (MINUSP N) then (add N (GETEOFPTR X) 1)) (if (ZEROP M) then (SETQ M (GETEOFPTR X)) elseif (MINUSP M) then (add M (GETEOFPTR X) 1)) (\BTMP.RESET X) (for I from 1 to (SUB1 N) until (EOFP X) do (BIN X)) (for I from N to M until (EOFP X) bind (\BTMP.CURRENT.SINK ←(ffetch (\BTMP.STATE \BTMP.CURRENT.SINK) of \BTMP.STATE)) do (BOUT \BTMP.CURRENT.SINK (BIN X]) (\BTMP.DO.SUBTRACT [LAMBDA (\BTMP.STATE \BTMP.ARGS) (* edited: "12-Jan-85 01:40") (\BTMP.ARITH.2 \BTMP.STATE (FUNCTION DIFFERENCE) \BTMP.ARGS 0]) (\BTMP.DO.SYNTAX [LAMBDA (\BTMP.STATE \BTMP.ARGS) (* edited: "18-Jan-85 04:53") (PROG [(CHBRA (CAR (NTH \BTMP.ARGS 1))) (FNNAME (CAR (NTH \BTMP.ARGS 2))) (FLAG (CAR (NTH \BTMP.ARGS 3))) (CHKET (CAR (NTH \BTMP.ARGS 4))) (CHSEP (CAR (NTH \BTMP.ARGS 5] (if (\BTMP.PREDICATE CHBRA) then (PROG [(CHBRA (BIN (\BTMP.RESET CHBRA))) (FNNAME (\BTMP.PREDICATE FNNAME)) [FLAG (AND (\BTMP.PREDICATE FLAG) (BIN (\BTMP.RESET FLAG] [CHKET (AND (\BTMP.PREDICATE CHKET) (BIN (\BTMP.RESET CHKET] (CHSEP (AND (\BTMP.PREDICATE CHSEP) (BIN (\BTMP.RESET CHSEP] (if FNNAME then (\BTMP.SETSYNTAX \BTMP.STATE CHBRA FNNAME FLAG CHKET CHSEP) else (SETA (ffetch (\BTMP.STATE \BTMP.ACTIVE.CHARS) of \BTMP.STATE) CHBRA NIL]) ) (RPAQQ \BTMP.FNS.UTILITY (\BTMP.ARG \BTMP.ARGCOUNT \BTMP.ARITH.2 \BTMP.ARITH.N \BTMP.ARITH.P \BTMP.INTERPRET \BTMP.LOOKUP \BTMP.NUMBER \BTMP.PACK \BTMP.POP \BTMP.PREDICATE \BTMP.PRODUCE \BTMP.PUSH \BTMP.TRUE)) (DEFINEQ (\BTMP.ARG [LAMBDA (\BTMP.STATE N) (* edited: "18-Jan-85 05:00") (if (IGEQ N 0) then (PROG [(ARG (NTH (CDR (ffetch (\BTMP.STATE \BTMP.CURRENT.FRAME) of \BTMP.STATE)) (ADD1 N] (if ARG then (\BTMP.PRODUCE \BTMP.STATE (CAR ARG]) (\BTMP.ARGCOUNT [LAMBDA (\BTMP.STATE) (* edited: "18-Jan-85 05:00") (LENGTH (CDDR (ffetch (\BTMP.STATE \BTMP.CURRENT.FRAME) of \BTMP.STATE]) (\BTMP.ARITH.2 [LAMBDA (\BTMP.STATE FN ARGLIST DEFAULT) (* edited: "12-Jan-85 01:33") (PROG [(A1 (CAR (NTH ARGLIST 1))) (A2 (CAR (NTH ARGLIST 2] (\BTMP.PRODUCE \BTMP.STATE (if (\BTMP.PREDICATE A2) then (APPLY* FN (\BTMP.NUMBER A1) (\BTMP.NUMBER A2)) else (APPLY* FN DEFAULT (\BTMP.NUMBER A1]) (\BTMP.ARITH.N [LAMBDA (\BTMP.STATE FN INIT ARGLIST) (* edited: "12-Jan-85 01:33") (for A in ARGLIST bind (VAL ← INIT) do (SETQ VAL (APPLY* FN VAL (\BTMP.NUMBER A))) finally (\BTMP.PRODUCE \BTMP.STATE VAL]) (\BTMP.ARITH.P [LAMBDA (\BTMP.STATE FN ARGLIST) (* edited: "12-Jan-85 01:33") (if (OR (NULL ARGLIST) (for ARG in (CDR ARGLIST) bind THIS (PREV ←(\BTMP.NUMBER (CAR ARGLIST))) do (SETQ THIS (\BTMP.NUMBER ARG)) (if (NOT (APPLY* FN PREV THIS)) then (RETURN NIL)) (SETQ PREV THIS) finally (RETURN T))) then (\BTMP.TRUE \BTMP.STATE]) (\BTMP.INTERPRET [LAMBDA (\BTMP.STATE TUPLE) (* edited: "18-Jan-85 05:10") (* * Warning: Check out \BTMP.DO.MAP.STAR + \BTMP.EVALUATE) (if TUPLE then (PROG ((FNNAME (CAR TUPLE)) FNDEF) (if (SETQ FNDEF (\BTMP.LOOKUP (ffetch (\BTMP.STATE \BTMP.BUILTIN.DEFS) of \BTMP.STATE) FNNAME)) then (APPLY* FNDEF \BTMP.STATE (CDR TUPLE)) elseif (AND (\BTMP.PREDICATE FNNAME) (SETQ FNDEF (\BTMP.LOOKUP (ffetch (\BTMP.STATE \BTMP.USER.DEFS) of \BTMP.STATE) FNNAME))) then (push (ffetch (\BTMP.STATE \BTMP.BAK.STK) of \BTMP.STATE) (CONS (\BTMP.DUP FNDEF) TUPLE)) (\BTMP.FRAME.AND.SOURCE \BTMP.STATE) else (\BTMP.ERROR "Unknown function: " (CAR TUPLE]) (\BTMP.LOOKUP [LAMBDA (DATABASE KEYSOURCE) (* edited: "18-Jan-85 04:43") (PROG ((DBREC (\BTMP.FIND DATABASE KEYSOURCE))) (RETURN (AND DBREC (ffetch (\BTMP.DB \BTMP.DB.VALUE) of DBREC]) (\BTMP.NUMBER [LAMBDA (D) (* edited: "12-Jan-85 03:56") (OR (NUMBERP (\BTMP.PACK D)) 0]) (\BTMP.PACK [LAMBDA (NAME) (* edited: "12-Jan-85 03:55") (AND (\BTMP.PREDICATE NAME) (PACKC (first (\BTMP.RESET NAME) until (EOFP NAME) collect (BIN NAME]) (\BTMP.POP [LAMBDA (\BTMP.STATE) (* edited: "18-Jan-85 05:03") (pop (ffetch (\BTMP.STATE \BTMP.DIV.STK) of \BTMP.STATE)) (if (NULL (ffetch (\BTMP.STATE \BTMP.DIV.STK) of \BTMP.STATE)) then (push (ffetch (\BTMP.STATE \BTMP.DIV.STK) of \BTMP.STATE) (ffetch (\BTMP.STATE \BTMP.OUTPUT.STREAM) of \BTMP.STATE))) (\BTMP.SINK \BTMP.STATE]) (\BTMP.PREDICATE [LAMBDA (D) (* edited: "29-Dec-84 07:32") (if [AND D (NOT (ZEROP (GETEOFPTR D] then D]) (\BTMP.PRODUCE [LAMBDA (\BTMP.STATE SRCE) (* edited: "18-Jan-85 05:18") (\BTMP.COPY SRCE (ffetch (\BTMP.STATE \BTMP.CURRENT.SINK) of \BTMP.STATE]) (\BTMP.PUSH [LAMBDA (\BTMP.STATE \BTMP.ARGS) (* edited: "18-Jan-85 05:03") (PROG [(NAME (AND \BTMP.ARGS (\BTMP.PREDICATE (CAR \BTMP.ARGS] (push (ffetch (\BTMP.STATE \BTMP.DIV.STK) of \BTMP.STATE) (if NAME then (ffetch (\BTMP.DB \BTMP.DB.VALUE) of (OR (\BTMP.FIND (ffetch (\BTMP.STATE \BTMP.USER.DEFS) of \BTMP.STATE) NAME) (\BTMP.STORE (ffetch (\BTMP.STATE \BTMP.USER.DEFS) of \BTMP.STATE) NAME NIL NIL))) else (ffetch (\BTMP.STATE \BTMP.OUTPUT.STREAM) of \BTMP.STATE))) (\BTMP.SINK \BTMP.STATE]) (\BTMP.TRUE [LAMBDA (\BTMP.STATE) (* edited: "12-Jan-85 01:33") (\BTMP.PRODUCE \BTMP.STATE "1"]) ) [DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY (BLOCK: NIL BTMP \BTMP.CLOSE \BTMP.COPY \BTMP.DUP \BTMP.ERROR \BTMP.EVALUATE \BTMP.FIND \BTMP.INITIALIZE \BTMP.RESET \BTMP.SETSYNTAX \BTMP.STORE \BTMP.DO.ADD \BTMP.DO.APPLY.STAR \BTMP.DO.ARGS \BTMP.DO.COLLECT \BTMP.DO.CONCATENATE \BTMP.DO.DEFINE \BTMP.DO.DISCARD \BTMP.DO.DIVERT \BTMP.DO.DIVIDE \BTMP.DO.EQ \BTMP.DO.EQUAL \BTMP.DO.ESCAPECHARFN \BTMP.DO.EVAL \BTMP.DO.GE \BTMP.DO.GT \BTMP.DO.IF \BTMP.DO.INCLUDE \BTMP.DO.LE \BTMP.DO.LLSH \BTMP.DO.LOGAND \BTMP.DO.LOGNOT \BTMP.DO.LOGOR \BTMP.DO.LOGXOR \BTMP.DO.LRSH \BTMP.DO.LT \BTMP.DO.MAP.STAR \BTMP.DO.MOD \BTMP.DO.MULTIPLY \BTMP.DO.NE \BTMP.DO.POP \BTMP.DO.PUSH \BTMP.DO.SUBSTRING \BTMP.DO.SUBTRACT \BTMP.DO.SYNTAX \BTMP.ARG \BTMP.ARGCOUNT \BTMP.ARITH.2 \BTMP.ARITH.N \BTMP.ARITH.P \BTMP.INTERPRET \BTMP.LOOKUP \BTMP.NUMBER \BTMP.PACK \BTMP.POP \BTMP.PREDICATE \BTMP.PRODUCE \BTMP.PUSH \BTMP.TRUE (ENTRIES BTMP) (GLOBALVARS \BTMP.BUILTIN.FNS \BTMP.NULLSTREAM \BTMP.SYNTAX.DEFS) (LOCALVARS . T) (SPECVARS \BTMP.ARGS \BTMP.STATE)) ] [DECLARE: EVAL@COMPILE (RECORD \BTMP.DB (\BTMP.DB.VALUE \BTMP.DB.NAME . \BTMP.DB.DEVICE)) (DATATYPE \BTMP.STATE (\BTMP.BAK.STK \BTMP.FWD.STK \BTMP.DIV.STK \BTMP.ACTIVE.CHARS \BTMP.BUILTIN.DEFS \BTMP.USER.DEFS \BTMP.CURRENT.FRAME \BTMP.CURRENT.SOURCE \BTMP.CURRENT.SINK \BTMP.OUTPUT.STREAM)) (RECORD \BTMP.SYNTAX (\BTMP.SYNTAX.KET \BTMP.SYNTAX.SEP \BTMP.SYNTAX.FN.DEF \BTMP.SYNTAX.FLAG . \BTMP.SYNTAX.FN.NAM)) ] (/DECLAREDATATYPE (QUOTE \BTMP.STATE) (QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER))) (RPAQQ \BTMP.BUILTIN.FNS (("+" . \BTMP.DO.ADD) ("-" . \BTMP.DO.SUBTRACT) ("*" . \BTMP.DO.MULTIPLY) ("/" . \BTMP.DO.DIVIDE) ("remainder" . \BTMP.DO.MOD) ("logand" . \BTMP.DO.LOGAND) ("logor" . \BTMP.DO.LOGOR) ("logxor" . \BTMP.DO.LOGXOR) ("lognot" . \BTMP.DO.LOGNOT) ("==" . \BTMP.DO.EQ) (">=" . \BTMP.DO.GE) (">" . \BTMP.DO.GT) ("<=" . \BTMP.DO.LE) ("<" . \BTMP.DO.LT) ("<>" . \BTMP.DO.NE) ("<<" . \BTMP.DO.LLSH) (">>" . \BTMP.DO.LRSH) ("apply*" . \BTMP.DO.APPLY.STAR) ("args" . \BTMP.DO.ARGS) ("collect" . \BTMP.DO.COLLECT) ("concatenate" . \BTMP.DO.CONCATENATE) ("define" . \BTMP.DO.DEFINE) ("discard" . \BTMP.DO.DISCARD) ("divert" . \BTMP.DO.DIVERT) ("equal" . \BTMP.DO.EQUAL) ("escapecharfn" . \BTMP.DO.ESCAPECHARFN) ("eval" . \BTMP.DO.EVAL) ("if" . \BTMP.DO.IF) ("include" . \BTMP.DO.INCLUDE) ("map*" . \BTMP.DO.MAP.STAR) ("pop" . \BTMP.DO.POP) ("push" . \BTMP.DO.PUSH) ("substring" . \BTMP.DO.SUBSTRING) ("syntax" . \BTMP.DO.SYNTAX))) (RPAQQ \BTMP.SYNTAX.DEFS (("[" "apply*" NIL "]" "|") ("~" "escapecharfn" T NIL NIL) ("'" "concatenate" T "'" NIL))) (PUTPROPS BTMP COPYRIGHT ("Xerox Corporation" 1984 1985)) (DECLARE: DONTCOPY (FILEMAP (NIL (2149 12399 (BTMP 2159 . 5928) (\BTMP.CLOSE 5930 . 6109) (\BTMP.COPY 6111 . 6566) ( \BTMP.DUP 6568 . 6796) (\BTMP.ERROR 6798 . 6982) (\BTMP.EVALUATE 6984 . 7727) (\BTMP.FIND 7729 . 8234) (\BTMP.INITIALIZE 8236 . 9769) (\BTMP.RESET 9771 . 9936) (\BTMP.SETSYNTAX 9938 . 10776) (\BTMP.STORE 10778 . 12397)) (13033 26010 (\BTMP.DO.ADD 13043 . 13230) (\BTMP.DO.APPLY.STAR 13232 . 13401) ( \BTMP.DO.ARGS 13403 . 14842) (\BTMP.DO.COLLECT 14844 . 15437) (\BTMP.DO.CONCATENATE 15439 . 15634) ( \BTMP.DO.DEFINE 15636 . 16080) (\BTMP.DO.DISCARD 16082 . 16327) (\BTMP.DO.DIVERT 16329 . 16563) ( \BTMP.DO.DIVIDE 16565 . 16761) (\BTMP.DO.EQ 16763 . 16950) (\BTMP.DO.EQUAL 16952 . 17636) ( \BTMP.DO.ESCAPECHARFN 17638 . 18221) (\BTMP.DO.EVAL 18223 . 18632) (\BTMP.DO.GE 18634 . 18821) ( \BTMP.DO.GT 18823 . 19015) (\BTMP.DO.IF 19017 . 19298) (\BTMP.DO.INCLUDE 19300 . 19773) (\BTMP.DO.LE 19775 . 19962) (\BTMP.DO.LLSH 19964 . 20234) (\BTMP.DO.LOGAND 20236 . 20429) (\BTMP.DO.LOGNOT 20431 . 20650) (\BTMP.DO.LOGOR 20652 . 20842) (\BTMP.DO.LOGXOR 20844 . 21036) (\BTMP.DO.LRSH 21038 . 21308) ( \BTMP.DO.LT 21310 . 21499) (\BTMP.DO.MAP.STAR 21501 . 22660) (\BTMP.DO.MOD 22662 . 22936) ( \BTMP.DO.MULTIPLY 22938 . 23131) (\BTMP.DO.NE 23133 . 23540) (\BTMP.DO.POP 23542 . 23687) ( \BTMP.DO.PUSH 23689 . 23847) (\BTMP.DO.SUBSTRING 23849 . 24808) (\BTMP.DO.SUBTRACT 24810 . 25008) ( \BTMP.DO.SYNTAX 25010 . 26008)) (26244 31411 (\BTMP.ARG 26254 . 26615) (\BTMP.ARGCOUNT 26617 . 26824) (\BTMP.ARITH.2 26826 . 27253) (\BTMP.ARITH.N 27255 . 27539) (\BTMP.ARITH.P 27541 . 28034) ( \BTMP.INTERPRET 28036 . 28959) (\BTMP.LOOKUP 28961 . 29223) (\BTMP.NUMBER 29225 . 29387) (\BTMP.PACK 29389 . 29640) (\BTMP.POP 29642 . 30091) (\BTMP.PREDICATE 30093 . 30283) (\BTMP.PRODUCE 30285 . 30489) (\BTMP.PUSH 30491 . 31256) (\BTMP.TRUE 31258 . 31409))))) STOP