(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