Files. master
authorLars Brinkhoff <lars@nocrew.org>
Tue, 30 Apr 2019 06:08:33 +0000 (08:08 +0200)
committerLars Brinkhoff <lars@nocrew.org>
Tue, 30 Apr 2019 10:40:16 +0000 (12:40 +0200)
14 files changed:
README.md [new file with mode: 0644]
zork.z/apply.mud.1 [new file with mode: 0644]
zork.z/getstr.mud.2 [new file with mode: 0644]
zork.z/ibytes.mud.2 [new file with mode: 0644]
zork.z/zac.mud.18 [new file with mode: 0644]
zork.z/zap.mud.171 [new file with mode: 0644]
zork.z/zil.mud.176 [new file with mode: 0644]
zork.z/zilch.mud.188 [new file with mode: 0644]
zork.z/zip.mud.96 [new file with mode: 0644]
zork.z/zipout.mud.2 [new file with mode: 0644]
zork.z/ziputil.mud.3 [new file with mode: 0644]
zork.z/zops.mud.18 [new file with mode: 0644]
zork.z/zstr.mud.2 [new file with mode: 0644]
zork.zftp/zftp.mud.12 [new file with mode: 0644]

diff --git a/README.md b/README.md
new file mode 100644 (file)
index 0000000..b3e156f
--- /dev/null
+++ b/README.md
@@ -0,0 +1,15 @@
+```
+<ZORK.Z>APPLY.MUD.1       Mar  5  1981
+<ZORK.Z>GETSTR.MUD.2      Nov  5  1979
+<ZORK.Z>IBYTES.MUD.2      Oct 26  1979
+<ZORK.Z>ZAC.MUD.18        Nov 13  1979
+<ZORK.Z>ZAP.MUD.171       Jan 18  1980
+<ZORK.Z>ZIL.MUD.176       Oct 29  1980
+<ZORK.Z>ZILCH.MUD.188     Nov  3  1980
+<ZORK.Z>ZIP.MUD.96        Dec 15  1979
+<ZORK.Z>ZIPOUT.MUD.2      Feb 29  1980
+<ZORK.Z>ZIPUTIL.MUD.3     Dec 15  1979
+<ZORK.Z>ZOPS.MUD.18       Jan 17  1980
+<ZORK.Z>ZSTR.MUD.2        Sep  3  1979
+
+<ZORK.ZFTP>ZFTP.MUD.12    Jun  7  1980
diff --git a/zork.z/apply.mud.1 b/zork.z/apply.mud.1
new file mode 100644 (file)
index 0000000..e5dd665
--- /dev/null
@@ -0,0 +1,534 @@
+<DEFINE I$FCN (FUCN NAME FLAG "OPTIONAL" (FORM '<1>)
+                             "AUX" (HATM <>) (SEG <>) ATM ARGL NBIND
+                                   (LPROG %<P-I "LPROG ">) (BODY .FUCN)
+                                   (FRM <CALL CFRAME>) (ARGS <TUPLE !.FORM>)
+                             "NAME" ACT)
+       #DECL ((FUCN BODY ARGL) LIST (FLAG) <PRIMTYPE WORD> (FRM) T$FRAME
+              (NAME LPROG) T$ATOM (SEG) STRUCTURED (FORM) <OR FORM TUPLE>
+              (ATM) ANY (HATM) <OR T$ATOM ADECL FALSE> (NBIND) T$LBIND 
+              (ARGS) TUPLE (ACT) ACTIVATION)
+       <COND (<TYPE? .FORM TUPLE> <SET ARGS .FORM>)
+             (T <SET ARGS <REST .ARGS>>)>
+       <COND (<EMPTY? .BODY>
+              <RETURN <T$ERROR %<P-E "EMPTY-BODY"> .NAME> .ACT>)
+             (<TYPE? <1 .BODY> T$ATOM ADECL>
+              <SET HATM <1 .BODY>>
+              <SET BODY <REST .BODY>>)>
+       <COND (<OR <LENGTH? .BODY 1> <NOT <TYPE? <1 .BODY> LIST>>>
+              <RETURN <T$ERROR %<P-E "BAD-ARGUMENT-LIST"> .NAME> .ACT>)
+             (T
+              <SET ARGL <1 .BODY>>
+              <SET BODY <REST .BODY>>)>
+       <COND (<==? <ANDB .FLAG <+ ,M$$F-APLY ,M$$F-EVAL>> 0>
+              <SET FLAG <ORB .FLAG ,M$$F-AUX>>)>
+       <REPEAT (BND TOKEN VAL (FIXUP <>))
+               #DECL ((BND) <OR FALSE T$LBIND> (FIXUP) <OR FALSE ATOM>
+                      (TOKEN VAL) ANY)
+               <COND (<AND <EMPTY? .ARGS> <EMPTY? .SEG> <NOT .FIXUP>>
+                      <CALL FIXBIND>
+                      <SET FIXUP T>)>
+               <COND (<EMPTY? .ARGL> <RETURN>)
+                     (<AND <TYPE? <SET TOKEN <1 .ARGL>> ADECL>
+                           <TYPE? <SET ATM <1 .TOKEN>> T$ATOM>
+                           <N==? <ANDB .FLAG ,M$$F-DECL> 0>>
+                      <COND (<SET BND <M$$LVAL <1 .TOKEN>>>
+                             <PUT .BND ,M$$DECL <2 .TOKEN>>)>)
+                     (<OR <TYPE? .TOKEN T$ATOM ADECL>
+                          <AND <TYPE? .TOKEN LIST>
+                               <==? <LENGTH .TOKEN> 2>
+                               <TYPE? <1 .TOKEN> T$ATOM ADECL>>
+                          <AND <TYPE? .TOKEN FORM>
+                               <==? <LENGTH .TOKEN> 2>
+                               <==? <1 .TOKEN> %<P-R "QUOTE">>
+                               <TYPE? <2 .TOKEN> T$ATOM>>>
+                      <COND (<TYPE? .TOKEN FORM>
+                             <SET ATM <2 .TOKEN>>)
+                            (<TYPE? .TOKEN LIST>
+                             <SET VAL <T$EVAL <2 .TOKEN>>>
+                             <SET ATM <1 .TOKEN>>)
+                            (T
+                             <SET ATM .TOKEN>
+                             <SET VAL ,M$$UNBOUND>)>
+                      <SET NBIND <CALL BIND>>
+                      <I$SET-ATOM .ATM
+                                  .NBIND
+                                  <COND (<N==? <ANDB .FLAG ,M$$F-OWN> 0>
+                                         <COND (<T$GETPROP .FUCN .ATM>)
+                                               (T
+                                                <T$PUTPROP .FUCN .ATM
+                                                   <CHTYPE (.VAL) T$DEFER>>
+                                                <T$GETPROP .FUCN .ATM>)>)
+                                        (<N==? <ANDB .FLAG ,M$$F-AUX> 0>
+                                         .VAL)
+                                        (<AND <EMPTY? .SEG> <EMPTY? .ARGS>>
+                                         <COND (<N==? <ANDB .FLAG ,M$$F-OPT>
+                                                      0>
+                                                .VAL)
+                                               (T
+                                                <RETURN
+                                                 <T$ERROR
+                                                  %<P-E "TOO-FEW-ARGUMENTS">
+                                                  .NAME>
+                                                 .ACT>)>)
+                                        (<AND <EMPTY? .SEG>
+                                              <OR <SET VAL <1 .ARGS>> T>
+                                              <SET ARGS <REST .ARGS>>
+                                              <OR <NOT <TYPE? .VAL SEGMENT>>
+                                                  <N==? <ANDB .FLAG
+                                                              ,M$$F-APLY>
+                                                        0>>>
+                                         <COND (<AND <NOT <TYPE? .TOKEN FORM>>
+                                                     <==? <ANDB .FLAG
+                                                                ,M$$F-APLY>
+                                                          0>>
+                                                <SET VAL <T$EVAL .VAL>>)>
+                                         .VAL)
+                                        (T
+                                         <COND (<TYPE? .VAL SEGMENT>
+                                                <SET
+                                                 SEG
+                                                 <T$EVAL
+                                                  <CHTYPE .VAL FORM>>>)>
+                                         <SET VAL <1 .SEG>>
+                                         <OR <TYPE? .TOKEN FORM>
+                                             <N==? <ANDB .FLAG ,M$$F-APLY>
+                                                   0>
+                                             <SET VAL <T$EVAL .VAL>>>
+                                         <SET SEG <REST .SEG>>
+                                         .VAL)>
+                                  .FIXUP>)
+                     (<AND <=? .TOKEN "BIND">
+                           <==? <ANDB .FLAG <+ ,M$$F-BIND ,M$$F-REPT
+                                               ,M$$F-REPT ,M$$F-FIRST>>
+                                0>
+                           <NOT <LENGTH? .ARGL 1>>
+                           <TYPE? <SET ATM <2 .ARGL>> T$ATOM ADECL>>
+                      <SET NBIND <CALL BIND>>
+                      <I$SET-ATOM .ATM .NBIND <M$$FRM-PREV .FRM> .FIXUP>
+                      <SET ARGL <REST .ARGL>>)
+                     (<AND <MEMBER .TOKEN '["OPT" "OPTIONAL"]>
+                           <==? <ANDB .FLAG <+ ,M$$F-BIND ,M$$F-REPT
+                                               ,M$$F-PROG ,M$$F-AUX
+                                               ,M$$F-DECL>>
+                                0>>
+                      <SET FLAG <ORB .FLAG ,M$$F-OPT>>)
+                     (<AND <OR <AND <MEMBER .TOKEN '["ARGS" "CALL"]>
+                                    <==? <ANDB .FLAG <+ ,M$$F-BIND ,M$$F-REPT
+                                                        ,M$$F-PROG ,M$$F-ARTU
+                                                        ,M$$F-DECL
+                                                        ,M$$F-APLY>>
+                                         0>>
+                               <AND <=? .TOKEN "TUPLE">
+                                    <==? <ANDB .FLAG <+ ,M$$F-BIND ,M$$F-REPT
+                                                        ,M$$F-PROG ,M$$F-ARTU
+                                                        ,M$$F-DECL>>
+                                         0>>>
+                           <NOT <LENGTH? .ARGL 1>>
+                           <TYPE? <SET ATM <2 .ARGL>> T$ATOM ADECL>>
+                           <SET NBIND <CALL BIND>>
+                           <I$SET-ATOM .ATM
+                                       .NBIND
+                                       <COND (<=? .TOKEN "ARGS">
+                                              <REST .FORM>)
+                                             (<=? .TOKEN "CALL">
+                                              .FORM)
+                                             (T
+                                              <I$FCNTUP .SEG .ARGS .FLAG>)>
+                                       .FIXUP>
+                      <SET ARGL <REST .ARGL>>
+                      <SET ARGS <REST .ARGS <LENGTH .ARGS>>>
+                      <SET FLAG <ORB .FLAG ,M$$F-ARTU>>)
+                     (<AND <MEMBER .TOKEN '["AUX" "EXTRA"]>
+                           <==? <ANDB .FLAG <+ ,M$$F-BIND ,M$$F-REPT
+                                               ,M$$F-PROG ,M$$F-AUX
+                                               ,M$$F-NAM ,M$$F-DECL>>
+                                0>>
+                      <SET FLAG <ORB .FLAG ,M$$F-AUX>>)
+                     (<AND <MEMBER .TOKEN '["NAME" "ACT"]>
+                           <==? <ANDB .FLAG ,M$$F-NAM> 0>
+                           <NOT <LENGTH? .ARGL 1>>
+                           <TYPE? <SET ATM <2 .ARGL>> T$ATOM ADECL>>
+                      <SET NBIND <CALL BIND>>
+                      <I$SET-ATOM .ATM .NBIND .FRM .FIXUP>
+                      <SET ARGL <REST .ARGL>>)
+                     (<AND <=? .TOKEN "DECL">
+                           <==? <ANDB ,FLAG ,M$$F-DECL> 0>>
+                      <SET FLAG <ORB .FLAG ,M$$F-DECL>>)
+                     (<=? .TOKEN "OWN">
+                      <SET FLAG <ORB .FLAG ,M$$F-OWN>>)
+                     (T
+                      <RETURN <T$ERROR %<P-E "BAD-ARGUMENT-LIST"> .NAME>
+                              .ACT>)>
+               <SET ARGL <REST .ARGL>>>
+       <COND (<AND <N==? <ANDB .FLAG <+ ,M$$F-APLY ,M$$F-EVAL>> 0>
+                   <OR <NOT <EMPTY? .ARGS>>
+                       <NOT <EMPTY? .SEG>>>>
+              <RETURN <T$ERROR %<P-E "TOO-MANY-ARGUMENTS"> .NAME> .ACT>)>
+       <COND (.HATM
+              <SET NBIND <CALL BIND>>
+              <I$SET-ATOM .HATM .NBIND .FRM T>)>
+       <COND (<==? <ANDB .FLAG ,M$$F-BIND> 0>
+              <SET NBIND <CALL BIND>>
+              <PUT .LPROG
+                   ,M$$LVAL
+                    <PUT <I$LBIND .LPROG .NBIND>
+                         ,M$$VALU
+                         .FRM>>)>
+       <PROG (ANS "NAME" ACT)
+             #DECL ((ANS) ANY (ACT) ACTIVATION)
+             <CALL ACTIVATION .FRM .ACT>
+             <SET ANS <MAPF <> ,T$EVAL .BODY>>
+             <COND (<N==? <ANDB .FLAG ,M$$F-REPT> 0> <T$AGAIN .FRM>)
+                   (ELSE <T$RETURN .ANS .FRM>)>>>
+
+<SETG M$$DECL-CHECK %<P-R "T">>
+
+<DEFINE I$SET-ATOM (ARG BND VAL "OPTIONAL" (FX T)
+                               "AUX" (DECL %<P-R "ANY">) ATM)
+       #DECL ((ARG) <OR ADECL T$ATOM> (ATM) T$ATOM (BND) T$LBIND (VAL) ANY
+              (DECL) <OR T$ATOM FORM SEGMENT> (FX) <OR ATOM FALSE>)
+       <COND (<TYPE? .ARG ADECL>
+              <SET ATM <1 .ARG>>
+              <COND (<OR <NOT ,M$$DECL-CHECK>
+                         <T$DECL? .VAL <2 .ARG>>
+                         <TYPE? .VAL T$UNBOUND>>
+                     <SET DECL <2 .ARG>>)
+                    (T
+                     <T$ERROR %<P-E "TYPE-MISMATCH">
+                              <1 .ARG>
+                              <2 .ARG>
+                              .VAL
+                              %<P-R "EVAL">>)>)
+             (T <SET ATM .ARG>)>
+       <M$$VALU <M$$DECL <SET BND <I$LBIND .ATM .BND>> .DECL> .VAL>
+       <COND (.FX <PUT .ATM ,M$$LVAL .BND>)>>
+
+<DEFINE I$FCNTUP (SEG ARGS FLAG "AUX" (APLY? <N==? <ANDB .FLAG ,M$$F-APLY>
+                                                  0>) (CNT 0))
+       #DECL ((SEG) STRUCTURED (ARGS) TUPLE (CNT) FIX (FLAG) <PRIMTYPE WORD>
+              (APLY?) <OR ATOM FALSE>)
+       <REPEAT (ARG)
+               #DECL ((ARG) ANY)
+               <COND (<AND <EMPTY? .ARGS> <EMPTY? .SEG>>
+                      <RETURN <CALL TUPLE .CNT>>)
+                     (<EMPTY? .SEG>
+                      <COND (<TYPE? <SET ARG <1 .ARGS>> SEGMENT>
+                             <SET SEG <T$EVAL <CHTYPE .ARG FORM>>>)
+                            (T
+                             <CALL PUSH
+                                   <COND (.APLY? .ARG)
+                                         (T <T$EVAL .ARG>)>>
+                             <SET CNT <+ .CNT 1>>)>
+                      <SET ARGS <REST .ARGS>>)
+                     (T
+                      <CALL PUSH
+                            <COND (.APLY? <1 .SEG>)
+                                  (T <T$EVAL <1 .SEG>>)>>
+                      <SET CNT <+ .CNT 1>>
+                      <SET SEG <REST .SEG>>)>>>
+
+;"Here are the SUBRs themselves."
+
+<DEFINE T$PROG ("ARGS" ARGS) #DECL ((ARGS) LIST)
+       <I$FCN .ARGS %<P-R "PROG"> ,M$$F-PROG>>
+
+<DEFINE T$BIND ("ARGS" ARGS) #DECL ((ARGS) LIST)
+       <I$FCN .ARGS %<P-R "BIND"> ,M$$F-BIND>>
+
+<DEFINE T$REPEAT ("ARGS" ARGS) #DECL ((ARGS) LIST)
+       <I$FCN .ARGS %<P-R "REPEAT"> ,M$$F-REPT>>
+
+<DEFINE T$RETURN ("OPTIONAL" (VAL <T$LOOKUP "T" <T$ROOT>>) FRM)
+       #DECL ((VAL VALUE) ANY (FRM) T$FRAME)
+       <COND (<ASSIGNED? FRM>
+              <CALL RFRAME .FRM>
+              <CALL RETURN .VAL>)
+             (<T$ASSIGNED? %<P-I "LPROG ">>
+               <CALL RFRAME <T$LVAL %<P-I "LPROG">>>
+              <CALL RETURN .VAL>)
+             (ELSE <T$ERROR %<P-E "NO-LPROG"> %<P-R "RETURN">>)>>
+
+<DEFINE T$AGAIN ("OPTIONAL" FRM) #DECL ((FRM) T$FRAME (VALUE) ANY)
+       <COND (<ASSIGNED? FRM> <CALL AGAIN .FRM>)
+             (<T$ASSIGNED? %<P-I "LPROG ">>
+              <CALL AGAIN <T$LVAL %<P-I "LPROG ">>>)
+             (ELSE <T$ERROR %<P-E "NO-LPROG"> %<P-R "AGAIN">>)>>
+
+<DEFINE T$APPLY (FCN "TUPLE" ARGS
+                    "AUX" (TYP <CHTYPE <LSH <CALL TYPE .FCN> -6> FIX>)
+                          (ENTRY <NTH ,M$$TYPE-INFO <+ .TYP 1>>)
+                          (ETYP <NTH .ENTRY ,M$$APPLY>) LEN)
+       #DECL ((FCN VALUE) ANY (ARGS) TUPLE (LEN) FIX (ENTRY) T$TYPE-ENTRY
+              (TYP) FIX (ETYP) <OR T$ATOM T$MSUBR0 APPLICABLE FALSE>)
+       <COND (<==? .ETYP %<P-R "MSUBR">>
+              <I$MSUBR <CHTYPE .FCN T$MSUBR> %<P-R "APPLY"> .ARGS>)
+             (<==? .ETYP %<P-R "FUNCTION">>
+              <I$FCN <CHTYPE .FCN LIST> %<P-R "APPLY"> ,M$$F-APLY .ARGS>)
+             (<MEMQ .ETYP [%<P-R "FIX"> %<P-R "OFFSET">]>
+              <COND (<0? <SET LEN <LENGTH .ARGS>>>
+                     <T$ERROR %<P-E "TOO-FEW-ARGUMENTS"> %<P-R "APPLY">>)
+                    (<1? .LEN>
+                     <T$NTH <NTH .ARGS 1> <T$CHTYPE .FCN .ETYP>>)
+                    (<==? .LEN 2>
+                     <T$PUT <NTH .ARGS 1>
+                            <T$CHTYPE .FCN .ETYP>
+                            <NTH .ARGS 2>>)
+                    (ELSE
+                     <T$ERROR %<P-E "TOO-MANY-ARGUMENTS-SUPPLIED">
+                              %<P-R "APPLY">>)>)
+             (ELSE <T$ERROR %<P-E "NON-APPLICABLE-TYPE"> %<P-R "APPLY">>)>>
+
+ <DEFINE T$EVAL (ARG1 "OPTIONAL" ARG2
+                     "AUX" (OBND <CALL GETS BIND>) FCN ATM VAL LEN (INT? <>)
+                           (ENTRY <NTH ,M$$TYPE-INFO
+                                       <+ <CHTYPE <LSH <CALL TYPE .ARG1> -6>
+                                               FIX> 1>>)
+                           (ETYP <NTH .ENTRY ,M$$NEVAL>))
+       #DECL ((ARG1 ATM VAL VALUE IOVAL) ANY (FCN) <OR APPLICABLE ANY>
+              (ARG2) T$FRAME (OBND) <OR T$LBIND FALSE>
+              (ETYP) <OR APPLICABLE T$ATOM FALSE> (LEN) FIX
+              (ENTRY) T$TYPE-ENTRY (INT?) <OR FALSE T$ATOM>)
+       ;<COND (<SET INT? <M$$C-ENABLE ,M$$EVALCLASS>>
+              <T$INTERRUPT "EVAL" %<P-R "EVAL-IN"> .ARG1>)>
+       <COND (<ASSIGNED? ARG2>
+              <SETG M$$BINDID <+ ,M$$BINDID 1>>
+              <COND (<N==? .ARG2 ,M$$TBIND>
+                     <CALL SETS BIND <M$$FRM-BIND .ARG2>>)>)>
+       <SET VAL
+            <COND
+             (<NOT .ETYP> .ARG1)
+             (<==? .ETYP %<P-R "VECTOR">>
+              <CHTYPE <MAPF ,VECTOR
+                            <FUNCTION (ITM) #DECL ((ITM) ANY)
+                                 <COND (<TYPE? .ITM SEGMENT>
+                                        <MAPRET !<T$EVAL <CHTYPE .ITM FORM>>>)
+                                       (T <T$EVAL .ITM>)>>
+                            .ARG1>
+                      <TYPE .ARG1>>)
+             (<==? .ETYP %<P-R "LIST">> <I$LISTEVAL .ARG1>)
+             (<==? .ETYP <SET ATM %<P-R "LVAL">>>
+              <T$APPLY <T$GVAL .ATM> <CHTYPE .ARG1 T$ATOM>>)
+             (<==? .ETYP <SET ATM %<P-R "GVAL">>>
+              <T$APPLY <T$GVAL .ATM> <CHTYPE .ARG1 T$ATOM>>)
+             (<AND <==? .ETYP %<P-R "FORM">>
+                   <EMPTY? .ARG1>>
+              <>)
+             (<==? .ETYP %<P-R "FORM">>
+              <SET FCN
+                   <COND (<TYPE? <SET ATM <CALL NTHL .ARG1 1>> T$ATOM>
+                          <T$GVAL .ATM>)
+                         (T <T$EVAL .ATM>)>>
+              <COND (<TYPE? .FCN FIX OFFSET>
+                     <COND (<1? <SET LEN <CALL LENL .ARG1>>>
+                            <T$ERROR %<P-E "TOO-FEW-ARGUMENTS">
+                                     %<P-R "EVAL">>)
+                           (<==? .LEN 2>
+                            <T$NTH <T$EVAL <CALL NTHL .ARG1 2>> .FCN>)
+                           (<==? .LEN 3>
+                            <T$PUT <T$EVAL <CALL NTHL .ARG1 2>>
+                                   .FCN
+                                   <T$EVAL <CALL NTHL .ARG1 3>>>)
+                           (T
+                            <T$ERROR %<P-E "TOO-MANY-ARGUMENTS">
+                                     %<P-R "EVAL">>)>)
+                    (<TYPE? .FCN T$MSUBR>
+                     <I$MSUBR .FCN %<P-R "EVAL"> <CHTYPE .ARG1 FORM>>)
+                    (<TYPE? .FCN T$FUNCTION>
+                     <I$FCN <CHTYPE .FCN LIST>
+                            %<P-R "EVAL">
+                            ,M$$F-EVAL
+                            <CHTYPE .ARG1 FORM>>)
+                    (<NTH .ENTRY ,M$$APPLY>
+                     <T$APPLY .FCN !<REST .ARG1>>)
+                    (<TYPE? .FCN T$MACRO>
+                     <T$EVAL <T$EXPAND .ARG1>>)
+                    (T
+                     <T$ERROR %<P-E "NON-APPLICABLE-TYPE"> %<P-R "EVAL">>)>)
+             (<==? .ETYP %<P-R "ADECL">>
+              <COND (<OR <NOT ,M$$DECL-CHECK>
+                         <T$DECL? <SET VAL <T$EVAL <1 .ARG1>>> <2 .ARG1>>>
+                     .VAL)
+                    (T
+                     <T$ERROR %<P-E "DECL-VIOLATION">
+                              .VAL <2 .ARG1> %<P-R "EVAL">>)>)
+             (<==? .ETYP %<P-R "SEGMENT">>
+              <T$ERROR %<P-E "ILLEGAL-SEGMENT"> %<P-R "EVAL">>)
+             (<T$APPLICABLE? .ETYP> <T$APPLY .ETYP .ARG1>)
+             (ELSE .ARG1)>>
+       <COND (<ASSIGNED? ARG2>
+              <SETG M$$BINDID <+ ,M$$BINDID 1>>
+              <COND (<N==? .ARG2 ,M$$TBIND> <CALL SETS BIND .OBND>)>)>
+       ;<COND (.INT? <T$INTERRUPT "EVAL" %<P-R "EVAL-OUT"> .ARG1 .VAL>)>
+       .VAL>
+
+<DEFINE I$LISTEVAL (ARG1 "AUX" (L ()) (LL .L) (TYP <TYPE .ARG1>) ITM)
+       #DECL ((ARG1) <PRIMTYPE LIST> (L LL) LIST (TYP) ATOM (ITM) ANY)
+       <REPEAT ()
+               <COND (<EMPTY? .ARG1>
+                      <RETURN <CHTYPE .LL .TYP>>)
+                     (T
+                      <SET ITM <1 .ARG1>>
+                      <SET ARG1 <REST .ARG1>>
+                      <COND (<TYPE? .ITM SEGMENT>
+                             <SET ITM <T$EVAL <CHTYPE .ITM FORM>>>
+                             <COND (<AND <EMPTY? .ARG1>
+                                         <==? <PRIMTYPE .ITM> LIST>>
+                                    <COND (<EMPTY? .L>
+                                           <RETURN <CHTYPE .ITM LIST>>)
+                                          (T <PUTREST .L .ITM>)>)
+                                   (T
+                                    <REPEAT ()
+                                        <COND (<EMPTY? .ITM> <RETURN>)
+                                              (<EMPTY? .L>
+                                               <SET LL <SET L (<1 .ITM>)>>)
+                                              (T
+                                               <SET L
+                                                    <REST
+                                                       <PUTREST .L
+                                                                (<1 .ITM>)>>>
+                                               <SET ITM <REST .ITM>>)>>)>)
+                            (<EMPTY? .L> <SET LL <SET L (<T$EVAL .ITM>)>>)
+                            (T
+                             <SET L <REST <PUTREST .L (<T$EVAL .ITM>)>>>)>)>>>
+
+<DEFINE T$EXPAND (FRM "AUX" (OBIND <CALL GETS BIND>) VAL FROB NFROB)
+       #DECL ((FRM) FORM (OBIND) <OR FALSE T$LBIND>
+              (FROB NFROB VAL) ANY)
+       <CALL SETS BIND ,M$$TBIND>
+       <COND (<TYPE? <SET FROB <1 .FRM>> T$MACRO>
+              <PUT .FRM 1 <1 .FROB>>
+              <SET VAL <T$EVAL .FRM>>
+              <PUT .FRM 1 .FROB>)
+             (<AND <TYPE? .FROB T$ATOM>
+                   <TYPE? <SET NFROB <T$GVAL .FROB>> T$MACRO>>
+              <PUT .FRM 1 <1 .NFROB>>
+              <SET VAL <T$EVAL .FRM>>
+              <PUT .FRM 1 .FROB>)
+             (T <SET VAL <T$EVAL .FRM>>)> 
+       <CALL SETS BIND .OBIND>
+       .VAL>
+
+<DEFINE I$MSUBRF ("TUPLE" TUP "AUX" VAL (MSBN <M$$MSB-NAME .MSB>))
+       #DECL ((TAFLG) <OR ATOM FALSE> (TUP) TUPLE (VAL) ANY (MSB) MSUBR
+              (MSBN) ATOM)
+       <COND (<AND .TAFLG <NOT <I$MSTUPLE .MSB .TUP>>>)
+             (<T$DECL? <SET VAL <CALL CALL .MSBN !.TUP>> .VDCL>
+              .VAL)
+             (ELSE
+              <T$ERROR %<P-E "TYPE-MISMATCH">
+                       %<P-R "VALUE">
+                       .VDCL
+                       .VAL
+                       .NAME>)>>
+
+<DEFINE I$MSUBR (MSB NAME FORM "AUX" (VDCL %<P-R "ANY">) (SEG ())
+                                    (OPT <>) (VAL <>) (QUOT <>) (TUP <>)
+                                    (DCL <M$$MSB-DECL .MSB>)
+                                    (ARGS <TUPLE !.FORM>) ARG (TAFLG <>))
+       #DECL ((MSB) <SPECIAL T$MSUBR> (ARGS) TUPLE (ARG) ANY
+              (NAME) <SPECIAL T$ATOM> (TAFLG) <SPECIAL <OR ATOM FALSE>>
+              (SEG) STRUCTURED (OPT VAL QUOT TUP) <OR ATOM FALSE>
+              (DCL) <PRIMTYPE LIST> (FORM) <OR TUPLE FORM>
+              (VDCL) <SPECIAL <OR T$ATOM FORM SEGMENT>>)
+       <COND (<TYPE? .FORM TUPLE> <SET ARGS .FORM>)
+             (T <SET ARGS <REST .ARGS>>)>
+       <MAPR ,I$MSUBRF
+             <FUNCTION ("AUX" TOKEN)
+                  #DECL ((TOKEN) ANY)
+                  <COND (.TUP <SET TOKEN <>>)
+                        (<EMPTY? .DCL> <MAPSTOP>)
+                        (T
+                         <SET TOKEN <1 .DCL>>
+                         <SET DCL <REST .DCL>>)>
+                  <COND (.VAL <SET VAL <>> <MAPRET>)
+                        (<OR <TYPE? .TOKEN T$ATOM FORM> .TUP>
+                         <COND (<AND <EMPTY? .SEG> <EMPTY? .ARGS>>
+                                <COND (<OR .OPT .TUP> <MAPSTOP>)
+                                      (T
+                                       <T$ERROR %<P-E "TOO-FEW-ARGUMENTS">
+                                                .NAME>)>)
+                               (<EMPTY? .SEG>
+                                <SET ARG <1 .ARGS>>
+                                <COND (<TYPE? .ARG SEGMENT>
+                                       <SET SEG <T$EVAL <CHTYPE .ARG FORM>>>
+                                       <SET ARG <1 .SEG>>
+                                       <SET SEG <REST .SEG>>)
+                                      (T
+                                       <COND (.QUOT <SET QUOT <>>)
+                                             (<==? .NAME %<P-R "APPLY">>)
+                                             (T <SET ARG <T$EVAL .ARG>>)>)>
+                                <SET ARGS <REST .ARGS>>)
+                               (T
+                                <SET ARG <1 .SEG>>
+                                <SET SEG <REST .SEG>>)>
+                         <COND (<OR .TUP <T$DECL? .ARG .TOKEN>>
+                                .ARG)
+                               (T
+                                <T$ERROR %<P-E "ARG-WRONG-TYPE"> .NAME>)>)
+                        (<MEMBER .TOKEN '["OPT" "OPTIONAL"]>
+                         <SET OPT T>
+                         <MAPRET>)
+                        (<=? .TOKEN "VALUE">
+                         <SET VDCL <1 .DCL>>
+                         <SET VAL T>
+                         <MAPRET>)
+                        (<=? .TOKEN "TUPLE">
+                         <SET TUP T>
+                         <SET TAFLG T>
+                         <MAPRET>)
+                        (<=? .TOKEN "QUOTE">
+                         <SET QUOT T>
+                         <MAPRET>)
+                        (<=? .TOKEN "ARGS">
+                         <COND (<T$DECL? <REST .FORM> <1 .DCL>>
+                                <MAPSTOP <REST .FORM>>)
+                               (T <T$ERROR %<P-E "ARG-WRONG-TYPE"> .NAME>)>)
+                        (<=? .TOKEN "CALL">
+                         <MAPSTOP .FORM>)
+                        (T <T$ERROR %<P-E "BAD-MSUBR-DECL"> .NAME>)>>>>
+
+<DEFINE I$MSTUPLE (MSB TUP "AUX" (DCL <M$$MSB-DECL .MSB>) TOK)
+       #DECL ((MSB) T$MSUBR (TUP) TUPLE (DCL) <PRIMTYPE LIST>
+              (TOK) <OR STRING T$ATOM FORM SEGMENT>)
+       <REPEAT ()
+               <COND (<=? <SET TOK <1 .DCL>> "TUPLE">
+                      <COND (<T$DECL? .TUP <2 .DCL>>
+                             <RETURN T>)
+                            (T
+                             <T$ERROR %<P-E "ARG-WRONG-TYPE">
+                                      <M$$MSB-NAME .MSB>>
+                             <>)>)
+                     (<NOT <TYPE? .TOK STRING>> <SET TUP <REST .TUP>>)
+                     (<=? .TOK "VALUE"> <SET DCL <REST .DCL>>)>
+               <SET DCL <REST .DCL>>>> 
+
+<DEFINE T$DECL-CHECK ("OPTIONAL" NEW "AUX" (OLD ,M$$DECL-CHECK))
+       #DECL ((NEW OLD) <OR T$ATOM FALSE>)
+       <COND (<ASSIGNED? NEW>
+              <SETG M$$DECL-CHECK .NEW>)>
+       .OLD>
+
+<DEFINE T$OVAL (ATM FCN "OPTIONAL" SET
+                       "AUX" (VAL <T$GETPROP <CHTYPE .FCN LIST> .ATM>))
+       #DECL ((FCN) T$FUNCTION (ATM) T$ATOM (VAL) <OR T$DEFER FALSE>
+              (SET) ANY)
+       <COND (.VAL
+              <COND (<ASSIGNED? SET> <PUT .VAL 1 .SET> .SET)
+                    (<TYPE? <1 .VAL> T$UNBOUND>
+                     <T$ERROR %<P-E "UNBOUND-VARIABLE">
+                              .ATM
+                              %<P-R "OWNED-VALUE">>)
+                    (T <1 .VAL>)>)
+             (<ASSIGNED? SET>
+              <T$PUTPROP <CHTYPE .FCN LIST> .ATM <CHTYPE (.SET) T$DEFER>>
+              .SET)
+             (T <T$ERROR %<P-E "UNOWNED-VARIABLE"> .FCN .ATM>)>>
+
+<DEFINE T$UNOWN (ATM FCN)
+       #DECL ((ATM) T$ATOM (FCN) T$FUNCTION)
+       <T$PUTPROP <CHTYPE .FCN LIST> .ATM <>>
+       %<P-R "T">>
+
+<DEFINE T$OWNED? (ATM FCN)
+       #DECL ((ATM) T$ATOM (FCN) T$FUNCTION)
+       <COND (<T$GETPROP <CHTYPE .FCN LIST> .ATM> %<P-R "T">)>>
\ No newline at end of file
diff --git a/zork.z/getstr.mud.2 b/zork.z/getstr.mud.2
new file mode 100644 (file)
index 0000000..7202d9f
--- /dev/null
@@ -0,0 +1,23 @@
+<DEFINE GETSTR (ZPC "AUX" (BYTE1 <>))
+       #DECL ((VALUE) ZSTR
+              (ZPC) FIX
+              (BYTE1) <OR FIX FALSE>)
+       <SET ZPC <POSNUM .ZPC>>
+       <MAPF <FUNCTION ("TUPLE" TUP)
+                       #DECL ((VALUE) ZSTR
+                              (TUP) <TUPLE [REST FIX]>)
+                       <CHTYPE <BYTES 5 !.TUP> ZSTR>>
+             <FUNCTION (BYT "AUX" C1 C2 C3)
+                       #DECL ((BYT C1 C2 C3) FIX)
+                       <AND <NOT .BYTE1> <SET BYTE1 .BYT> <MAPRET>>
+                       <SET BYT <+ <* .BYTE1 256> .BYT>>
+                       <SET BYTE1 <>>
+                       <SET C3 <MOD .BYT 32>>
+                       <SET BYT </ .BYT 32>>
+                       <SET C2 <MOD .BYT 32>>
+                       <SET BYT </ .BYT 32>>
+                       <SET C1 <MOD .BYT 32>>
+                       <SET BYT </ .BYT 32>>
+                       <AND <0? .BYT> <MAPRET .C1 .C2 .C3>>
+                       <MAPSTOP .C1 .C2 .C3>>
+             <REST ,ZCODE .ZPC>>>
\ No newline at end of file
diff --git a/zork.z/ibytes.mud.2 b/zork.z/ibytes.mud.2
new file mode 100644 (file)
index 0000000..b3d7429
--- /dev/null
@@ -0,0 +1,6 @@
+<OR <GASSIGNED? OIBYTES> <SETG OIBYTES ,IBYTES>>
+
+<SETG IBYTES <FUNCTION (BS LEN "OPTIONAL" (VAL 0))
+                      #DECL ((VALUE) BYTES
+                             (BS LEN VAL) FIX)
+                      <OIBYTES .BS .LEN .VAL>>>
diff --git a/zork.z/zac.mud.18 b/zork.z/zac.mud.18
new file mode 100644 (file)
index 0000000..8e7f9ff
--- /dev/null
@@ -0,0 +1,100 @@
+<PACKAGE "ZAC">
+
+<ENTRY DSOPEN DSCLOSE DSPRINT DSREAD>
+
+<TITLE DSOPEN>
+<DECLARE ("VALUE" FIX STRING "OPTIONAL" ATOM)>
+
+       <HLRZ   C*      AB>
+       <PUSH   TP*     (AB)>
+       <AOBJN  AB*     HERE    -1>
+       <CAIE   C*      -2>
+       <JRST   HERE    3>
+       <PUSHJ  P*      ID1>
+       <JRST   FINIS>
+       <PUSHJ  P*      ID2>
+       <JRST   FINIS>
+
+       <INTERNAL-ENTRY ID1 1>
+       <HRLZI  C*      *100001*>
+       <MOVE   D*      [<(*070000*) *200040*>]>
+       <JRST   DOPEN>
+
+       <INTERNAL-ENTRY ID2 2>
+       <ADJSP  TP*     -2>
+       <HRLZI  C*      *600001*>
+       <MOVE   D*      [<(*070000*) *100040*>]>
+DOPEN  <SUBM   M*      (P)>
+       <DPOP   TP*     A>
+       <MOVE   A*      C>
+       <GTJFN>
+       <ERRUUO*        <MQUOTE OPEN-FAILED!-ERRORS>>
+       <MOVE   B*      D>
+       <OPENF>
+       <ERRUUO*        <MQUOTE OPEN-FAILED!-ERRORS>>
+       <HRRZ   B*      A>
+       <MOVSI  A*      <TYPE-CODE FIX>>
+       <JRST   MPOPJ>
+
+<TITLE DSCLOSE>
+<DECLARE ("VALUE" FIX FIX)>
+
+       <DPUSH  TP*     (AB)>
+       <PUSHJ  P*      ID>
+       <JRST   FINIS>
+
+       <INTERNAL-ENTRY ID 1>
+       <SUBM   M*      (P)>
+       <MOVE   A*      (TP)>
+       <CLOSF>
+       <ERRUUO*        <MQUOTE CLOSE-FAILED!-ERRORS>>
+       <DPOP   TP*     A>
+       <JRST   MPOPJ>
+
+<TITLE DSPRINT>
+<DECLARE ("VALUE" STRING STRING FIX)>
+
+       <PUSH   TP*     (AB)>
+       <AOBJN  AB*     HERE    -1>
+       <PUSHJ  P*      ID>
+       <JRST   FINIS>
+
+       <INTERNAL-ENTRY ID 2>
+       <SUBM   M*      (P)>
+       <MOVE   A*      (TP)>
+       <MOVE   B*      -2      (TP)>
+       <HRRZ   C*      -3      (TP)>
+       <MOVN   C*      C>
+       <SOUT>
+       <SETZ   B*>
+       <BOUT>
+       <ADJSP  TP*     -2>
+       <DPOP   TP*     A>
+       <JRST   MPOPJ>
+
+<TITLE DSREAD>
+<DECLARE ("VALUE" STRING FIX FIX STRING)>
+
+       <PUSH   TP*     (AB)>
+       <AOBJN  AB*     HERE    -1>
+       <PUSHJ  P*      ID>
+       <JRST   FINIS>
+
+       <INTERNAL-ENTRY ID 2>
+       <SUBM   M*      (P)>
+       <MOVE   A*      -2      (TP)>
+       <MOVE   B*      -4      (TP)>
+       <SFPTR>
+       <ERRUUO*        <MQUOTE ACCESS-FAILED!-ERRORS>>
+       <MOVE   B*      (TP)>
+       <SETZ   C*>
+       <SIN-JSYS>
+       <MOVE   A*      (TP)>
+       <PSOUT>
+       <DPOP   TP*     A>
+       <ADJSP  TP*     -4>
+       <JRST   MPOPJ>
+
+<END>
+
+<ENDPACKAGE>
diff --git a/zork.z/zap.mud.171 b/zork.z/zap.mud.171
new file mode 100644 (file)
index 0000000..f974c3d
--- /dev/null
@@ -0,0 +1,1057 @@
+<PACKAGE "ZAP">
+
+<ENTRY ZAP LONG-ERRORS? REAL-ERROR? BYTE-SWAP? DTRACE?>
+
+<USE "ZSTR" "ZOPS" "ZAC">
+
+
+"********** ASSORTED GLOBALS **********"
+
+<GDECL (ZPC TABLE-END CUROBJ CURGVAR INS ASSEMERRS DSBOT DSPOS DSJFN) FIX
+       (PASS1? LONG-ERRORS? REAL-ERROR? BYTE-SWAP? DTRACE?) <OR ATOM FALSE>
+       (GLOBALS LOCALS) OBLIST
+       (ZOB) !<LIST OBLIST OBLIST ATOM OBLIST>
+       (ZIN) CHANNEL
+       (OZINS) <LIST [REST CHANNEL]>
+       (ZCODE) <BYTES 8>
+       (STATEMENTS) <LIST [REST LIST]>
+       (SCRIPT) <OR CHANNEL FALSE>
+       (DSYMBOLS) <BYTES 18>
+       (LASTSYM) STRING>
+
+<SETG LONG-ERRORS? T>
+<SETG REAL-ERROR? <>>
+<SETG BYTE-SWAP? <>>
+<SETG DTRACE? T>
+
+<SETG ZAPID 1>
+<MANIFEST ZAPID>
+
+
+"********** ERROR HANDLERS **********"
+
+<DEFINE ASSEMERR ("TUPLE" TUP)
+       #DECL ((TUP) <TUPLE ATOM ATOM>)
+       <ASSEMERR1 !.TUP>
+       <AGAIN .READ-LOOP>>
+
+<DEFINE ASSEMERR1 ("TUPLE" TUP)
+       #DECL ((TUP) <TUPLE ATOM ATOM>)
+       <SETG ASSEMERRS <+ ,ASSEMERRS 1>>
+       <COND (,REAL-ERROR? <ERROR !.TUP>)
+             (T
+              <BLOCK (<GET ERRORS OBLIST> !.OBLIST)>
+              <COND (,LONG-ERRORS? <MAPF <> ,PRINT .TUP> <CRLF>)
+                    (<CRLF>
+                     <PRIN1 <1 .TUP>>
+                     <PRINC <ASCII 32>>
+                     <PRIN1 <2 .TUP>>)>
+              <ENDBLOCK>)>>
+
+"********** RANDOM TYPE DEFINITION STUFF **********"
+
+<NEWTYPE LABEL WORD>
+<NEWTYPE PLABEL WORD>
+<NEWTYPE VAR WORD>
+
+<PUT NUMBER DECL '<OR ATOM FIX>>
+
+
+"********** PSEUDO-OP HANDLERS **********"
+
+<BLOCK (!.OBLIST <SETG GLOBALS <MOBLIST GLOBALS 97>>)>
+<MOBLIST UNDEFINED>
+
+<DEFOPS ,GLOBALS>              ;"DEFINE THE OPERATIONS IN THIS OBLIST"
+
+<MAPF <>
+      <FUNCTION (ATM) <INSERT <REMOVE .ATM> ,GLOBALS>>
+      '[*WORD
+       *BYTE
+       *TRUE
+       *FALSE
+       *ZWORD
+       *GSTR
+       *STR
+       *LEN
+       *STRL
+       *EQUAL
+       *PDEF
+       *SEQ
+       *TABLE
+       *PROP
+       *ENDT
+       *OBJECT
+       *GVAR
+       *FUNCT
+       *INSERT
+       *ENDI
+       *END]>
+
+<DEFINE P*WORD (ARGL)
+       #DECL ((ARGL) <LIST ATOM [REST NUMBER]>)
+       <COND (,PASS1? <SETG ZPC <+ ,ZPC <* 2 <LENGTH <REST .ARGL>>>>>)
+             (<MAPF <> ,OUTWORD <REST .ARGL>>)>>
+
+<DEFINE P*BYTE (ARGL)
+       #DECL ((ARGL) <LIST ATOM [REST NUMBER]>)
+       <COND (,PASS1? <SETG ZPC <+ ,ZPC <LENGTH <REST .ARGL>>>>)
+             (<MAPF <> ,OUTBYTE <REST .ARGL>>)>>
+
+<DEFINE P*TRUE (ARGL)
+       #DECL ((ARGL) !<LIST ATOM>)
+       <SETG STATEMENTS ('(1) !,STATEMENTS)>>
+
+<DEFINE P*FALSE (ARGL)
+       #DECL ((ARGL) !<LIST ATOM>)
+       <SETG STATEMENTS ('(0) !,STATEMENTS)>>
+
+<DEFINE P*ZWORD (ARGL "AUX" (STR <2 .ARGL>) (LEN <LENGTH .STR>))
+       #DECL ((ARGL) !<LIST ATOM ZSTR>
+              (STR) ZSTR
+              (LEN) FIX)
+       <COND (<==? .LEN 6>)
+             (<L? .LEN 6>
+              <SET STR <CHTYPE <SUBSTRUC .STR 0 .LEN <IBYTES 5 6 ,PADCHR>>
+                               ZSTR>>)
+             (<SET STR <CHTYPE <SUBSTRUC .STR 0 6> ZSTR>>)>
+       <SETG STATEMENTS ((.STR) !,STATEMENTS)>>
+
+<DEFINE P*GSTR (ARGL)
+       #DECL ((ARGL) !<LIST ATOM ATOM ZSTR>)
+       <SETG STATEMENTS
+             ((*PDEF <2 .ARGL>)
+              (*STR <3 .ARGL>)
+              !,STATEMENTS)>>
+
+<DEFINE P*STR (ARGL "AUX" (STR <2 .ARGL>))
+       #DECL ((ARGL) !<LIST ATOM ZSTR>
+              (STR) ZSTR)
+       <AND <EMPTY? .STR> <SET STR <CHTYPE <BYTES 5 ,PADCHR> ZSTR>>>
+       <COND (,PASS1?
+              <SETG ZPC <+ ,ZPC <* 2 </ <+ 2 <LENGTH <2 .ARGL>>> 3>>>>)
+             (<OUTSTR <2 .ARGL>>)>>
+
+<DEFINE P*LEN (ARGL)
+       #DECL ((ARGL) !<LIST ATOM ZSTR>)
+       <SETG STATEMENTS ((*BYTE </ <+ 2 <LENGTH <2 .ARGL>>> 3>)
+                         !,STATEMENTS)>> 
+
+<DEFINE P*STRL (ARGL)
+       #DECL ((ARGL) !<LIST ATOM ZSTR>)
+       <SETG STATEMENTS
+             ((*LEN <2 .ARGL>)
+              (*STR <2 .ARGL>)
+              !,STATEMENTS)>>
+
+<DEFINE P*EQUAL (ARGL)
+       #DECL ((ARGL) !<LIST ATOM ATOM NUMBER>)
+       <AND <GASSIGNED? <2 .ARGL>>
+            <NOT <TYPE? ,<2 .ARGL> FIX>>
+            <ASSEMERR ARG-WRONG-TYPE!-ERRORS P*EQUAL .ARGL>>
+       <AND <==? <OBLIST? <2 .ARGL>> ,LOCALS>
+            <ASSEMERR ATTEMPT-TO-ASSIGN-A-LOCAL!-ERRORS P*EQUAL .ARGL>>
+       <INSERT <REMOVE <2 .ARGL>> ,GLOBALS>
+       <SETG <2 .ARGL> <3 .ARGL>>>
+
+<DEFINE P*PDEF (ARGL)
+       #DECL ((ARGL) !<LIST ATOM ATOM>)
+       <AND <1? <CHTYPE <ANDB ,ZPC 1> FIX>> <SETG ZPC <+ ,ZPC 1>>>
+       <AND <GASSIGNED? <2 .ARGL>>
+            <NOT <==? ,<2 .ARGL> <CHTYPE ,ZPC PLABEL>>>
+            <ASSEMERR ARG-WRONG-TYPE!-ERRORS P*PDEF .ARGL>>
+       <INSERT <REMOVE <2 .ARGL>> ,GLOBALS>
+       <SETG <2 .ARGL> <CHTYPE ,ZPC PLABEL>>>
+
+<DEFINE P*SEQ (ARGL "AUX" (N -1))
+       #DECL ((ARGL) <LIST ATOM [REST ATOM]>
+              (N) FIX)
+       <SETG STATEMENTS
+             (!<MAPF ,LIST
+                     <FUNCTION (ATM)
+                               #DECL ((VALUE) LIST
+                                      (ATM) ATOM)
+                               (*EQUAL .ATM !\, <SET N <+ .N 1>>)>
+                     <REST .ARGL>>
+              !,STATEMENTS)>>
+
+<DEFINE P*TABLE (ARGL)
+       #DECL ((ARGL) !<LIST ATOM [OPT FIX]>)
+       <OR <0? ,TABLE-END>
+           <ASSEMERR ILLEGAL-TABLE-NESTING!-ERRORS P*TABLE .ARGL>>
+       <SETG TABLE-END
+             <COND (<LENGTH? .ARGL 2> *377777777777*)
+                   (<+ ,ZPC <3 .ARGL>>)>>>
+
+%%<SETG ERR '<ASSEMERR ARG-WRONG-TYPE!-ERRORS P*PROP .ARGL>>
+<DEFINE P*PROP (ARGL "AUX" (N1 <2 .ARGL>) (N2 <3 .ARGL>))
+       #DECL ((ARGL) !<LIST ATOM NUMBER NUMBER>
+              (N1 N2) NUMBER)
+       <AND <0? ,TABLE-END> <ASSEMERR NOT-IN-TABLE!-ERRORS P*PROP .ARGL>>
+       <AND <OR <AND <TYPE? .N1 ATOM>
+                     <GASSIGNED? .N1>
+                     <NOT <TYPE? ,.N1 FIX>>>
+                <AND <TYPE? .N2 ATOM>
+                     <GASSIGNED? .N2>
+                     <NOT <TYPE? ,.N2 FIX>>>>
+            %,ERR>
+       <SETG STATEMENTS
+             ((*BYTE <COND (,PASS1? 0)
+                           (T
+                            <COND (<TYPE? .N1 ATOM>
+                                   <OR <AND <GASSIGNED? .N1>
+                                            <TYPE? ,.N1 FIX>>
+                                       %,ERR>
+                                   <SET N1 ,.N1>)>
+                            <COND (<TYPE? .N2 ATOM>
+                                   <OR <AND <GASSIGNED? .N2>
+                                            <TYPE? ,.N2 FIX>>
+                                       %,ERR>
+                                   <SET N2 ,.N2>)>
+                            <AND <OR <L? .N1 1>
+                                     <L? .N2 1>
+                                     <G? .N1 8>
+                                     <G? .N2 31>>
+                                 <ASSEMERR NUMBER-OUT-OF-RANGE!-ERRORS
+                                        P*PROP
+                                        .ARGL>>
+                            <CHTYPE <ORB <* <- .N1 1> 32> .N2> FIX>)>)
+              !,STATEMENTS)>>
+
+<DEFINE P*ENDT (ARGL)
+       #DECL ((ARGL) !<LIST ATOM>)
+       <AND <0? ,TABLE-END> <ASSEMERR NOT-IN-TABLE!-ERRORS P*ENDT .ARGL>>
+       <AND <G? ,ZPC ,TABLE-END>
+            <ASSEMERR TABLE-TOO-LARGE!-ERRORS P*ENDT .ARGL ,TABLE-END ,ZPC>>
+       <SETG TABLE-END 0>>
+
+<DEFINE P*OBJECT (ARGL)
+       #DECL ((ARGL) !<LIST ATOM ATOM [5 NUMBER] ATOM>)
+       <SETG STATEMENTS
+             ((*EQUAL <2 .ARGL> !\, <SETG CUROBJ <+ ,CUROBJ 1>>)
+              (*WORD <3 .ARGL> !\, <4 .ARGL>)
+              (*BYTE <5 .ARGL> !\, <6 .ARGL> !\, <7 .ARGL>)
+              (*WORD <8 .ARGL>)
+              !,STATEMENTS)>>
+
+<DEFINE P*GVAR (ARGL "AUX" ATM VAL)
+       #DECL ((ARGL) !<LIST ATOM <OR ATOM <LIST ATOM NUMBER>>>
+              (ATM) ATOM
+              (VAL) NUMBER)
+       <COND (<TYPE? <2 .ARGL> ATOM> <SET ATM <2 .ARGL>> <SET VAL 0>)
+             (<SET ATM <1 <2 .ARGL>>> <SET VAL <2 <2 .ARGL>>>)>
+       <AND <GASSIGNED? .ATM>
+            <N==? ,.ATM <CHTYPE <+ ,CURGVAR 1> VAR>>
+            <ASSEMERR ILLEGAL-SYMBOL-ASSIGNMENT!-ERRORS P*GVAR .ARGL>>
+       <INSERT <REMOVE .ATM> ,GLOBALS>
+       <SETG .ATM <CHTYPE <SETG CURGVAR <+ ,CURGVAR 1>> VAR>>
+       <SETG STATEMENTS ((*WORD .VAL) !,STATEMENTS)>>
+
+<DEFINE P*FUNCT (ARGL "AUX" (CURLVAR 0))
+       #DECL ((ARGL) <LIST ATOM ATOM [REST <OR ATOM <LIST ATOM NUMBER>>]>
+              (CURLVAR) FIX)
+       <AND <1? <CHTYPE <ANDB 1 ,ZPC> FIX>> <SETG ZPC <+ ,ZPC 1>>>
+       <PUT ,ZOB 1 <SETG LOCALS <MOBLIST <2 .ARGL> 5>>>
+       <SETG STATEMENTS
+             ((*PDEF <2 .ARGL>)
+              (*BYTE <- <LENGTH .ARGL> 2>)
+              !<MAPF ,LIST
+                     <FUNCTION (ARG "AUX" ATM VAL)
+                               #DECL ((VALUE) LIST
+                                      (ARG) <OR ATOM <LIST ATOM NUMBER>>
+                                      (ATM) ATOM
+                                      (VAL) NUMBER)
+                               <COND (<TYPE? .ARG ATOM>
+                                      <SET ATM .ARG>
+                                      <SET VAL 0>)
+                                     (<SET ATM <1 .ARG>>
+                                      <SET VAL <2 .ARG>>)>
+                               <OR <GASSIGNED? .ATM> <REMOVE .ATM>>
+                               <SET ATM <OR <LOOKUP <SPNAME .ATM> ,LOCALS>
+                                            <INSERT <SPNAME .ATM> ,LOCALS>>>
+                               <SETG .ATM
+                                     <CHTYPE <SET CURLVAR <+ .CURLVAR 1>>
+                                             VAR>>
+                               (*WORD .VAL)>
+                     <REST .ARGL 2>>
+              !,STATEMENTS)>>
+
+<DEFINE P*INSERT (ARGL "AUX" NZIN)
+       #DECL ((ARGL) !<LIST ATOM ZSTR>)
+       <COND (<SET NZIN <OPEN "READ" <STRING <ZSTR-STRING <2 .ARGL>> ".ZAP">>>
+              <SETG OZINS (,ZIN !,OZINS)>
+              <SETG ZIN .NZIN>)
+             (<ASSEMERR OPEN-FAILED!-ERRORS P*INSERT .ARGL .NZIN>)>>
+
+<DEFINE P*ENDI (ARGL)
+       #DECL ((ARGL) !<LIST ATOM>)
+       <AND <EMPTY? ,OZINS>
+            <ASSEMERR ILLEGAL-OPERATION!-ERRORS P*ENDI .ARGL>>
+       <CLOSE ,ZIN>
+       <SETG ZIN <1 ,OZINS>>
+       <SETG OZINS <REST ,OZINS>>>
+
+<SETG P*END ,ERROR>            ;".END should never get this far"
+
+
+"********** GLOBAL TABLES *********"
+
+<NEWTYPE PSEUDO LIST '<PSEUDO <OR FORM SEGMENT> APPLICABLE>>
+
+<SETG DEFPSEUDO <FUNCTION (PA 'DCL)
+                         <SETG .PA
+                               <CHTYPE (.DCL
+                                        ,<PARSE <STRING "P" <SPNAME .PA>>>)
+                                       PSEUDO>>>>
+<DEFPSEUDO     *WORD   <LIST [REST NUMBER]>>
+<DEFPSEUDO     *BYTE   <LIST [REST NUMBER]>>
+<DEFPSEUDO     *TRUE   <>>
+<DEFPSEUDO     *FALSE  <>>
+<DEFPSEUDO     *ZWORD  !<LIST ZSTR>>
+<DEFPSEUDO     *GSTR   !<LIST ATOM ZSTR>>
+<DEFPSEUDO     *STR    !<LIST ZSTR>>
+<DEFPSEUDO     *LEN    !<LIST ZSTR>>
+<DEFPSEUDO     *STRL   !<LIST ZSTR>>
+<DEFPSEUDO     *EQUAL  !<LIST ATOM NUMBER>>
+<DEFPSEUDO     *PDEF   !<LIST ATOM>>
+<DEFPSEUDO     *SEQ    <LIST [REST ATOM]>>
+<DEFPSEUDO     *TABLE  !<LIST [OPT FIX]>>
+<DEFPSEUDO     *PROP   !<LIST [2 NUMBER]>>
+<DEFPSEUDO     *ENDT   <>>
+<DEFPSEUDO     *OBJECT !<LIST ATOM [5 NUMBER] ATOM>>
+<DEFPSEUDO     *GVAR   !<LIST <OR ATOM <LIST ATOM NUMBER>>>>
+<DEFPSEUDO     *FUNCT  <LIST ATOM [REST <OR ATOM <LIST ATOM NUMBER>>]>>
+<DEFPSEUDO     *INSERT !<LIST ZSTR>>
+<DEFPSEUDO     *ENDI   <>>
+<DEFPSEUDO     *END    <>>
+
+<SETG DEFGLOBAL
+      <FUNCTION (STR VAL)
+               <SETG <OR <LOOKUP .STR ,GLOBALS> <INSERT .STR ,GLOBALS>>
+                     .VAL>>>
+
+<DEFGLOBAL "STACK" #VAR 0>
+<DEFGLOBAL "FALSE" #LABEL 0>
+<DEFGLOBAL "TRUE" #LABEL 1>
+<DEFGLOBAL "NOJUMP" #LABEL 2>
+
+
+"********** Z-CODE READ TABLE DEFINITION **********"
+
+<SETG ZCHR <FUNCTION (CHR ACTION) <PUT ,ZRT <+ <ASCII .CHR> 1> .ACTION>>>
+
+<DEFINE NOP-CHR (C)
+       #DECL ((VALUE C) CHARACTER)
+       .C>
+
+<DEFINE FLUSH-COMMENT (C)
+       #DECL ((VALUE) SPLICE
+              (C) CHARACTER)
+       <REPEAT () <AND <==? <READCHR> <ASCII 13>> <RETURN>>>
+       #SPLICE ()>
+
+<DEFINE READ-ZSTR (C)
+       #DECL ((VALUE) ZSTR
+              (C) CHARACTER)
+       <STRING-ZSTR
+        <MAPF ,STRING
+              <FUNCTION ()
+                        #DECL ((VALUE) CHARACTER)
+                        <COND (<N==? <SET C <READCHR>> !\"> .C)
+                              (<==? <NEXTCHR> !\"> <READCHR>)
+                              (<MAPSTOP>)>>>>>
+
+<DEFINE QUOTE-FUNCT (C "AUX" OBJ)
+       #DECL ((VALUE) FIX
+              (C) CHARACTER
+              (OBJ) ANY)
+       <COND (<AND <TYPE? <SET OBJ <READ>> ATOM>
+                   <GASSIGNED? .OBJ>
+                   <TYPE? ,.OBJ VAR>>
+              <CHTYPE ,.OBJ FIX>)
+             (T
+              <ASSEMERR1 BAD-USE-OF-QUOTE!-ERRORS QUOTE-FUNCT .OBJ>
+              0)>>
+
+<SETG ZRT <IVECTOR 128 65>>    ;"MOST CHARACTERS ARE SYMBOL CONSTITUENTS"
+
+<ZCHR !\0 0>                   ;"NUMBERS REMAIN NUMBERS"
+<ZCHR !\1 0>
+<ZCHR !\2 0>
+<ZCHR !\3 0>
+<ZCHR !\4 0>
+<ZCHR !\5 0>
+<ZCHR !\6 0>
+<ZCHR !\7 0>
+<ZCHR !\8 0>
+<ZCHR !\9 0>
+<ZCHR !\- 0>
+<ZCHR !\, ,NOP-CHR>            ;"RETURN SPECIAL CHARS AS THEMSELVES"
+<ZCHR !\: ,NOP-CHR>
+<ZCHR !\+ ,NOP-CHR>
+<ZCHR !\/ ,NOP-CHR>
+<ZCHR !\\\ ,NOP-CHR>
+<ZCHR !\> ,NOP-CHR>
+<ZCHR !\= ,NOP-CHR>
+<ZCHR !\; ,FLUSH-COMMENT>      ;"IGNORE COMMENTS"
+<ZCHR !\' ,QUOTE-FUNCT>                ;"QUOTED SYMBOLS ARE IMMEDIATELY TRANSLATED"
+<ZCHR <ASCII 32> 0>            ;"STANDARD SEPARATORS"
+<ZCHR <ASCII 9> 0>
+<ZCHR <ASCII 13> 0>
+<ZCHR <ASCII 10> ,NOP-CHR>     ;"LINE-FEEDS ARE SIGNIFICANT"
+<ZCHR !\" ,READ-ZSTR>          ;"GET A STRING"
+<ZCHR !\. !\*>                 ;"CONVERT PERIODS (BLETCH!)"
+<ZCHR <ASCII 3> 0>             ;"PSEUDO-EOF CHARACTER"
+<ZCHR <ASCII 26> 0>            ;"DON'T DISABLE EOF"
+
+
+"********** STATEMENT READING AND PARSING STUFF **********"
+
+<DEFINE READ-STATEMENT (ZOB SCRIPT "AUX" (INCHAN ,ZIN)
+                                        (ZRT ,ZRT)
+                                        (OTHING T)
+                                        RET)
+       #DECL ((VALUE RET) <OR LIST FALSE>
+              (ZOB) <LIST [REST <OR OBLIST ATOM>]>
+              (INCHAN) <SPECIAL CHANNEL>
+              (ZRT) <SPECIAL VECTOR>
+              (OTHING) <OR ATOM CHARACTER FIX ZSTR>
+              (SCRIPT) <OR CHANNEL FALSE>)
+       <COND
+        (<EMPTY? ,STATEMENTS>
+         <SET RET
+              <MAPF ,LIST
+                    <FUNCTION ("AUX" THING)
+                              #DECL ((VALUE THING)
+                                     <OR ATOM CHARACTER FIX ZSTR>)
+                              <COND (<N==? <SET THING <READ .INCHAN
+                                                            '<MAPLEAVE <>>
+                                                            .ZOB
+                                                            .ZRT>>
+                                           <ASCII 10>>
+                                     <SET OTHING .THING>)
+                                    (<AND <TYPE? .OTHING CHARACTER>
+                                          <MEMQ .OTHING ",/\\>+=">>
+                                     <MAPRET>)
+                                    (<MAPSTOP>)>>>>)
+        (<SET RET <1 ,STATEMENTS>>
+         <SETG STATEMENTS <REST ,STATEMENTS>>
+         <AND .SCRIPT <PRINC <ASCII 9> .SCRIPT>>)>
+       <COND (<AND .SCRIPT <NOT <EMPTY? .RET>>>
+              <SET OTHING !\,>
+              <PRINC !\( .SCRIPT>
+              <MAPF <>
+                    <FUNCTION (THING)
+                              <COND (<TYPE? .THING CHARACTER>)
+                                    (<OR <TYPE? .OTHING ATOM>
+                                         <==? .OTHING !\:>>
+                                     <PRINC <ASCII 32> .SCRIPT>)>
+                              <PRINC <SET OTHING .THING> .SCRIPT>>
+                    .RET>
+              <PRINC !\) .SCRIPT>)>
+       <COND (<NOT ,DTRACE?>)
+             (,PASS1?)
+             (<G? ,ZPC ,DSBOT>
+              <SET OTHING !\,>
+              <SETG LASTSYM
+                    <MAPF ,STRING
+                          <FUNCTION (THING "AUX" (SPACE? <>))
+                                    #DECL ((VALUE) <OR STRING CHARACTER>
+                                           (SPACE?) <OR ATOM FALSE>)
+                                    <COND (<TYPE? .THING CHARACTER>)
+                                          (<OR <TYPE? .OTHING ATOM>
+                                               <==? .OTHING !\:>>
+                                           <SET SPACE? T>)>
+                                    <SET OTHING .THING>
+                                    <SET THING
+                                         <COND (<TYPE? .THING ATOM>
+                                                <SPNAME .THING>)
+                                               (<TYPE? .THING CHARACTER>
+                                                .THING)
+                                               (<TYPE? .THING ZSTR>
+                                                <MAPRET>)
+                                               (<UNPARSE .THING>)>>
+                                    <AND .SPACE? <MAPRET <ASCII 32> .THING>>
+                                    .THING>
+                          .RET>>)>
+       .RET>
+
+%%<SETG ERR '<RETURN <ASSEMERR ZAP-SYNTAX-ERROR!-ERRORS GET-STATEMENT .SL>>>
+%%<SETG ERR1
+       '<RETURN <ASSEMERR ZAP-SYNTAX-ERROR!-ERRORS GET-STATEMENT .SL .ARGL>>>
+<DEFINE GET-STATEMENT (ZOB SCRIPT "AUX" SL)
+       #DECL ((VALUE) <OR LIST FALSE>
+              (ZOB) <LIST [REST <OR OBLIST ATOM>]>
+              (SCRIPT) <OR CHANNEL FALSE>
+              (SL) <OR <LIST [REST <OR ATOM ZSTR FIX CHARACTER>]> FALSE>)
+       <AND .SCRIPT <PRINT ,ZPC .SCRIPT>>
+       <PROG
+        ((OARG !\,) (EQUALS? <>) (ADD? <>) (SKIP? <>) (ADDVAL 0))
+        #DECL ((VALUE) <OR LIST FALSE>
+               (OARG) <OR ATOM ZSTR FIX CHARACTER LIST>
+               (EQUALS? ADD? SKIP?) <OR ATOM FALSE>
+               (ADDVAL) FIX)
+        <COND (<NOT <SET SL <READ-STATEMENT .ZOB .SCRIPT>>>
+               <ASSEMERR PREMATURE-END-OF-FILE!-ERRORS GET-STATEMENT>)
+              (<EMPTY? .SL> <AGAIN>)
+              (<==? <1 .SL> *END> <>)
+              (<SETG INS <+ ,INS 1>>
+               <AND <TYPE? <1 .SL> ATOM>
+                    <NOT <EMPTY? <REST .SL>>>
+                    <==? <2 .SL> !\:>
+                    <COND (<AND <NOT <EMPTY? <REST .SL 2>>>
+                                <==? <3 .SL> !\:>>
+                           <DEFINE-LABEL <1 .SL> T>
+                           <SET SL <REST .SL 3>>)
+                          (T
+                           <DEFINE-LABEL <1 .SL>>
+                           <SET SL <REST .SL 2>>)>>
+               <AND <EMPTY? .SL> <AGAIN>>
+               <AND <TYPE? <1 .SL> ZSTR>
+                    <OR <LENGTH? .SL 1> %,ERR>
+                    <RETURN (*STR <1 .SL>)>>
+               <AND <TYPE? <1 .SL> FIX> <SET SL (*WORD !.SL)>>
+               <AND <TYPE? <1 .SL> CHARACTER> %,ERR>
+               <AND <NOT <EMPTY? <REST .SL>>>
+                    <==? <2 .SL> !\=>
+                    <OR <==? <LENGTH .SL> 3> %,ERR>
+                    <OR <TYPE? <3 .SL> ATOM FIX> %,ERR>
+                    <RETURN (*EQUAL <1 .SL> <3 .SL>)>>
+               <AND <OR <NOT <GASSIGNED? <1 .SL>>>
+                        <NOT <TYPE? ,<1 .SL> OP PSEUDO>>>
+                    <SET SL (*WORD !.SL)>>
+               (<1 .SL>
+                !<MAPR ,LIST
+                       <FUNCTION
+                        (ARGL "AUX" (ARG <1 .ARGL>))
+                        #DECL ((VALUE) ANY
+                               (ARGL) LIST
+                               (ARG) <OR ATOM ZSTR FIX CHARACTER>)
+                        <SET OARG
+                             <COND (.SKIP? <SET SKIP? <>> <MAPRET>)
+                                   (.ADD?
+                                    <SET ADD? <>>
+                                    <COND (<TYPE? .ARG FIX>
+                                           <SET ADDVAL <+ .ADDVAL .ARG>>)
+                                          (<AND <TYPE? .ARG ATOM>
+                                                <GASSIGNED? .ARG>
+                                                <TYPE? ,.ARG FIX>>
+                                           <SET ADDVAL <+ .ADDVAL ,.ARG>>)
+                                          (%,ERR1)>
+                                    <AND <NOT <EMPTY? <REST .ARGL>>>
+                                         <==? <2 .ARGL> !\+>
+                                         <SET SKIP? <SET ADD? T>>
+                                         <MAPRET>>
+                                    <COND (.EQUALS? 
+                                           <SET EQUALS? <>>
+                                           (.OARG .ADDVAL))
+                                          (<==? .OARG !\,> .ADDVAL)
+                                          ((.ADDVAL .OARG))>)
+                                   (.EQUALS?
+                                    <AND <TYPE? .ARG CHARACTER> %,ERR1>
+                                    <COND (<AND <TYPE? .ARG ATOM FIX>
+                                                <NOT <EMPTY? <REST .ARGL>>>
+                                                <==? <2 .ARGL> !\+>>
+                                           <COND (<TYPE? .ARG FIX>
+                                                  <SET ADDVAL .ARG>)
+                                                 (<AND <GASSIGNED? .ARG>
+                                                       <TYPE? ,.ARG FIX>>
+                                                  <SET ADDVAL ,.ARG>)
+                                                 (%,ERR1)>
+                                           <SET SKIP? <SET ADD? T>>
+                                           <MAPRET>)>
+                                    <SET EQUALS? <>>
+                                    (.OARG .ARG))
+                                   (<TYPE? .ARG CHARACTER>
+                                    <COND (<NOT <TYPE? .OARG CHARACTER>>)
+                                          (<AND <==? .ARGL <REST .SL>>
+                                                <N==? .ARG !\,>>)
+                                          (%,ERR1)>
+                                    <OR <MEMQ .ARG ",>/\\"> %,ERR1>
+                                    <SET OARG .ARG>
+                                    <MAPRET>)
+                                   (<==? .OARG !\,>
+                                    <OR <EMPTY? <REST .ARGL>>
+                                        <COND (<==? <2 .ARGL> !\+>
+                                               <COND (<TYPE? .ARG FIX>
+                                                      <SET ADDVAL .ARG>)
+                                                     (<AND <TYPE? .ARG ATOM>
+                                                           <GASSIGNED? .ARG>
+                                                           <TYPE? ,.ARG FIX>>
+                                                      <SET ADDVAL ,.ARG>)
+                                                     (%,ERR1)>
+                                               <SET SKIP? <SET ADD? T>>
+                                               <MAPRET>)
+                                              (<==? <2 .ARGL> !\=>
+                                               <OR <TYPE? .ARG ATOM> %,ERR1>
+                                               <SET OARG .ARG>
+                                               <SET SKIP? <SET EQUALS? T>>
+                                               <MAPRET>)>>
+                                    .ARG)
+                                   (<TYPE? .OARG CHARACTER> (.ARG .OARG))
+                                   (%,ERR1)>>>
+                       <REST .SL>>))>>>
+
+
+"********** LOWER LEVEL STUFF **********"
+
+%%<SETG ERR '<ASSEMERR ILLEGAL-SYMBOL-ASSIGNMENT!-ERRORS
+                      DEFINE-LABEL
+                      .LBL
+                      .GLOBAL?
+                      ,ZPC>>
+<DEFINE DEFINE-LABEL (LBL "OPTIONAL" (GLOBAL? <>)
+                         "AUX" (OB <COND (.GLOBAL? ,GLOBALS) (,LOCALS)>))
+       #DECL ((VALUE LBL) ATOM
+              (GLOBAL?) <OR ATOM FALSE>
+              (OB) OBLIST)
+       <COND (,PASS1?
+              <AND <GASSIGNED? .LBL> %,ERR>
+              <SETG .LBL <CHTYPE ,ZPC LABEL>>
+              <INSERT <REMOVE .LBL> .OB>)
+             (<AND <GASSIGNED? .LBL>
+                   <==? ,.LBL <CHTYPE ,ZPC LABEL>>
+                   <==? <OBLIST? .LBL> .OB>>
+              .LBL)
+             (%,ERR)>>
+
+<DEFINE ARG-TYPE (ARG)
+       #DECL ((VALUE) FIX
+              (ARG) ANY)
+       <AND <TYPE? .ARG ATOM> <SET ARG ,.ARG>>
+       <COND (<TYPE? .ARG VAR> 2)
+             (<AND <TYPE? .ARG FIX> <L? .ARG 256> <G=? .ARG 0>> 1)
+             (<TYPE? .ARG FIX LABEL PLABEL> 0)
+             (<ASSEMERR ARG-WRONG-TYPE!-ERRORS ARG-TYPE .ARG>)>>
+
+%%<SETG ERR '<ASSEMERR ARG-WRONG-TYPE!-ERRORS OPERATION .ARGL>>
+<DEFINE OPERATION (ARGL "AUX" (ZOP ,<1 .ARGL>)
+                             (AL <REST .ARGL>)
+                             NARGS
+                             (XARGS 0)
+                             (NBYTES 1)
+                             (CD <OPCODE .ZOP>)
+                             TYP
+                             TYP2
+                             NUM
+                             DEST)
+       #DECL ((VALUE XARGS NARGS NBYTES CD TYP TYP2 NUM) FIX
+              (ARGL) <LIST ATOM>
+              (ZOP) OP
+              (AL) LIST
+              (DEST) WORD)
+       <COND
+        (<SPEC? .ZOP "STRING">
+         <OR <AND <1? <LENGTH .AL>> <TYPE? <1 .AL> ZSTR>>
+             %,ERR>
+         <COND (,PASS1?
+                <SETG ZPC <+ ,ZPC 1 <* 2 </ <+ <LENGTH <1 .AL>> 2> 3>>>>)
+               (<OUTBYTE .CD>
+                <OUTSTR <1 .AL>>)>)
+        (T
+         <AND <PRED? .ZOP> <SET XARGS 1>>
+         <COND (<VAL? .ZOP>
+                <SET XARGS <+ .XARGS 1>>
+                <SET NUM <LENGTH .AL>>
+                <AND <PRED? .ZOP> <SET NUM <- .NUM 1>>>
+                <COND (<L? .NUM 0>)
+                      (<EMPTY? .AL> <SET AL '(STACK !\>)>)
+                      (<0? .NUM> <SET AL (<1 .AL> '(STACK !\>))>)
+                      (<AND <TYPE? <NTH .AL .NUM> LIST>
+                            <==? <2 <NTH .AL .NUM>> !\>>>)
+                      (<PUTREST <REST .AL <- .NUM 1>>
+                                ('(STACK !\>) !<REST .AL .NUM>)>)>)>
+         <SET NARGS <COND (<L? .CD 128> 2)
+                          (<L? .CD 176> 1)
+                          (<L? .CD 192> 0)
+                          (<- <LENGTH .AL> .XARGS>)>>
+         <AND <SPEC? .ZOP "XARGS">
+              <G? <LENGTH .AL> <+ .NARGS .XARGS>>
+              <SET NARGS <- <LENGTH .AL> .XARGS>>>
+         <OR <AND <==? <LENGTH .AL> <+ .NARGS .XARGS>>
+                  <G=? .NARGS 0>
+                  <L=? .NARGS 4>>
+             <ASSEMERR WRONG-NUMBER-OF-ARGUMENTS!-ERRORS OPERATION .ARGL>>
+         <MAPF <>
+               <FUNCTION (ARG)
+                         <AND <0? .NARGS>
+                              <L? .CD 128>
+                              <G? .NBYTES 3>
+                              <SET NBYTES <+ .NBYTES 1>>>
+                         <COND (<L? .NARGS 1>
+                                <COND (<OR <AND <0? .NARGS> <==? .XARGS 2>>
+                                           <NOT <PRED? .ZOP>>>
+                                       <OR <AND <TYPE? .ARG LIST>
+                                                <==? <2 .ARG> !\>>
+                                                <TYPE? <1 .ARG> ATOM>
+                                                <GASSIGNED? <1 .ARG>>
+                                                <TYPE? ,<1 .ARG> VAR>>
+                                           %,ERR>
+                                       <SET NBYTES <+ .NBYTES 1>>)
+                                      (<AND <TYPE? .ARG LIST>
+                                            <MEMQ <2 .ARG> "/\\">
+                                            <TYPE? <1 .ARG> ATOM>>
+                                       <SET NBYTES
+                                            <+ .NBYTES
+                                               <COND
+                                                (<NOT <GASSIGNED? <1 .ARG>>>
+                                                 <OR ,PASS1? %,ERR>
+                                                 2)
+                                                (<TYPE? ,<1 .ARG>
+                                                        LABEL
+                                                        PLABEL>
+                                                 <COND (<L? <CHTYPE ,<1 .ARG>
+                                                                    FIX>
+                                                            3>
+                                                        1)
+                                                       (2)>)
+                                                (%,ERR)>>>)
+                                      (%,ERR)>)
+                               (<TYPE? .ARG FIX>
+                                <SET NBYTES
+                                     <+ .NBYTES
+                                        <COND (<OR <G? .ARG 255> <L? .ARG 0>>
+                                               2)
+                                              (1)>>>)
+                               (<TYPE? .ARG ATOM>
+                                <SET NBYTES
+                                     <+ .NBYTES
+                                        <COND (<GASSIGNED? .ARG>
+                                               <SET ARG ,.ARG>
+                                               <COND (<TYPE? .ARG VAR> 1)
+                                                     (<AND <TYPE? .ARG FIX>
+                                                           <L? .ARG 256>
+                                                           <G=? .ARG 0>>
+                                                      1)
+                                                     (<TYPE? .ARG
+                                                             FIX
+                                                             LABEL
+                                                             PLABEL>
+                                                      2)
+                                                     (%,ERR)>)
+                                              (<NOT ,PASS1?> %,ERR)
+                                              (2)>>>)
+                               (%,ERR)>
+                         <SET NARGS <- .NARGS 1>>>
+               .AL>
+         <AND <L? .CD 128>
+              <NOT <PRED? .ZOP>>
+              <NOT <VAL? .ZOP>>
+              <G? .NBYTES 3>
+              <SET NBYTES <+ .NBYTES 1>>>
+         <AND <G=? .CD 192> <SET NBYTES <+ .NBYTES 1>>>
+         <COND
+          (,PASS1? <SETG ZPC <+ ,ZPC .NBYTES>>)
+          (<SET NARGS <- <LENGTH .AL> .XARGS>>
+           <COND
+            (<AND <0? .NARGS> <L? .CD 192>> <OUTBYTE .CD>)
+            (<AND <1? .NARGS> <L? .CD 192>>
+             <COND (<0? <SET TYP <ARG-TYPE <1 .AL>>>>
+                    <OUTBYTE .CD>
+                    <COND (<SPEC? .ZOP "BRANCH">
+                           <OUTWORD <1 .AL> <- ,ZPC>>)
+                          (<OUTWORD <1 .AL>>)>)
+                   (<1? .TYP>
+                    <OUTBYTE .CD 16>
+                    <OUTBYTE <1 .AL>>)
+                   (T
+                    <OUTBYTE .CD 32>
+                    <OUTBYTE <1 .AL>>)>)
+            (<AND <L? .CD 192> <==? .NARGS 2>>
+             <COND (<0? <* <SET TYP <ARG-TYPE <1 .AL>>>
+                           <SET TYP2 <ARG-TYPE <2 .AL>>>>>
+                    <OUTBYTE .CD 192>
+                    <OUTBYTE 12 <* .TYP 64> <* .TYP2 16>>
+                    <COND (<0? .TYP> <OUTWORD <1 .AL>>) (<OUTBYTE <1 .AL>>)>
+                    <COND (<0? .TYP2> <OUTWORD <2 .AL>>) (<OUTBYTE <2 .AL>>)>)
+                   (<OUTBYTE .CD <* <- .TYP 1> 64> <* <- .TYP2 1> 32>>
+                    <OUTBYTE <1 .AL>>
+                    <OUTBYTE <2 .AL>>)>)
+            (T
+             <COND (<L? .CD 128> <OUTBYTE .CD 192>) (<OUTBYTE .CD>)>
+             <REPEAT ((TYPS <ILIST 4 3>) (CTYPS .TYPS) (NA .NARGS) (L .AL))
+                     #DECL ((TYPS) <LIST [4 FIX]>
+                            (CTYPS) <LIST [REST FIX]>
+                            (NA) FIX
+                            (L) LIST)
+                     <COND (<0? .NA>
+                            <OUTBYTE <* <1 .TYPS> 64>
+                                     <* <2 .TYPS> 16>
+                                     <* <3 .TYPS> 4>
+                                     <4 .TYPS>>
+                            <MAPF <>
+                                  <FUNCTION (ARG TYP)
+                                            #DECL ((ARG) ANY
+                                                   (TYP) FIX)
+                                            <COND (<==? .TYP 3>)
+                                                  (<0? .TYP> <OUTWORD .ARG>)
+                                                  (<OUTBYTE .ARG>)>>
+                                  .AL
+                                  .TYPS>
+                            <RETURN>)>
+                     <PUT .CTYPS 1 <ARG-TYPE <1 .L>>>
+                     <SET NA <- .NA 1>>
+                     <SET CTYPS <REST .CTYPS>>
+                     <SET L <REST .L>>>)>
+           <SET AL <REST .AL .NARGS>>
+           <COND (<VAL? .ZOP> <OUTBYTE <1 <1 .AL>>> <SET AL <REST .AL>>)>
+           <COND (<PRED? .ZOP>
+                  <SET CD <COND (<==? <2 <1 .AL>> !\/> 128) (0)>>
+                  <COND (<L? <SET NUM <CHTYPE ,<1 <1 .AL>> FIX>> 3>
+                         <OUTBYTE .CD 64 .NUM>)
+                        (T
+                         <SET DEST <ANDB *37777* <- .NUM ,ZPC>>>
+                         <OUTBYTE .CD </ <CHTYPE .DEST FIX> 256>>
+                         <OUTBYTE <ANDB .DEST 255>>
+                         ;"replaces
+                           <OUTWORD <* .CD 256>
+                                  <ANDB *37777* <- .NUM ,ZPC>>>
+                           since predicate jumps must not be byte-swapped")>)>
+           ,ZPC)>)>>
+
+<DEFINE OUTBYTE ("TUPLE" TUP "AUX" (BYTE 0))
+       #DECL ((VALUE BYTE) FIX
+              (TUP) <TUPLE [REST <OR ATOM <PRIMTYPE WORD>>]>)
+       <MAPF <>
+             <FUNCTION (ARG)
+                       #DECL ((ARG) <OR ATOM <PRIMTYPE WORD>>)
+                       <COND (<TYPE? .ARG ATOM>
+                              <OR <==? <PRIMTYPE ,.ARG> WORD>
+                                  <ASSEMERR ARG-WRONG-TYPE!-ERRORS
+                                            OUTBYTE
+                                            .ARG>>
+                              <SET ARG ,.ARG>)>
+                       <SET BYTE <+ .BYTE <CHTYPE .ARG FIX>>>>
+             .TUP>
+       <OR <AND <G=? .BYTE 0> <L? .BYTE 256>>
+           <ASSEMERR NUMBER-OUT-OF-RANGE!-ERRORS OUTBYTE .BYTE .TUP>>
+       <COND (,SCRIPT
+              <PRINC !\  ,SCRIPT>
+              <PRIN1 <CHTYPE .BYTE FIX> ,SCRIPT>)>
+       <PUT ,ZCODE <SETG ZPC <+ ,ZPC 1>> .BYTE>
+       ,ZPC>
+
+<DEFINE OUTWORD ("TUPLE" TUP "AUX" (WRD 0) HIBYT LOBYT)
+       #DECL ((VALUE WRD HIBYT LOBYT) FIX
+              (TUP) <TUPLE [REST <OR ATOM <PRIMTYPE WORD>>]>)
+       <MAPF <>
+             <FUNCTION (ARG)
+                       #DECL ((ARG) <OR ATOM <PRIMTYPE WORD>>)
+                       <COND (<TYPE? .ARG ATOM>
+                              <OR <==? <PRIMTYPE ,.ARG> WORD>
+                                  <ASSEMERR ARG-WRONG-TYPE!-ERRORS
+                                            OUTWORD
+                                            .ARG>>
+                              <SET ARG ,.ARG>)>
+                       <SET WRD
+                            <+ .WRD
+                               <COND (<TYPE? .ARG PLABEL>
+                                      </ <CHTYPE .ARG FIX> 2>)
+                                     (<CHTYPE .ARG FIX>)>>>>
+             .TUP>
+       <COND (<OR <0? <CHTYPE <ANDB .WRD *777777600000*> FIX>>
+                  <==? #WORD -1 <ORB .WRD *77777*>>>)
+             (<ASSEMERR NUMBER-OUT-OF-RANGE!-ERRORS OUTWORD .WRD>)>
+       <COND (,SCRIPT
+              <PRINC " [" ,SCRIPT>
+              <PRIN1 <CHTYPE .WRD FIX> ,SCRIPT>
+              <PRINC !\] ,SCRIPT>)>
+       <SET HIBYT </ <CHTYPE <ANDB .WRD *177777*> FIX> 256>>
+       <SET LOBYT <CHTYPE <ANDB .WRD *377*> FIX>>
+       <PUT ,ZCODE
+            <SETG ZPC <+ ,ZPC 1>>
+            <COND (,BYTE-SWAP? .LOBYT) (.HIBYT)>>
+       <PUT ,ZCODE
+            <SETG ZPC <+ ,ZPC 1>>
+            <COND (,BYTE-SWAP? .HIBYT) (.LOBYT)>>
+       ,ZPC>
+
+<DEFINE OUTSTR (STR "AUX" (BYTNUM 3) (WRD #WORD 0))
+       #DECL ((VALUE BYTNUM) FIX
+              (STR) ZSTR
+              (WRD) WORD)
+       <MAPR <>
+             <FUNCTION (BYTS)
+                       #DECL ((BYTS) <<PRIMTYPE BYTES> 5>)
+                       <SET WRD <ORB <1 .BYTS> <* <CHTYPE .WRD FIX> 32>>>
+                       <COND (<0? <SET BYTNUM <- .BYTNUM 1>>>
+                              <COND (<EMPTY? <REST .BYTS>>
+                                     <OUTWORD .WRD *100000*>)
+                                    (<OUTWORD .WRD>)>
+                              <SET BYTNUM 3>
+                              <SET WRD #WORD 0>)>>
+             .STR>
+       <COND (<==? .BYTNUM 3> ,ZPC)
+             (<SET WRD <ORB <* <CHTYPE .WRD FIX> 32> ,PADCHR>>
+              <OR <1? .BYTNUM>
+                  <SET WRD <ORB <* <CHTYPE .WRD FIX> 32> ,PADCHR>>>
+              <OUTWORD .WRD *100000*>)>>
+
+
+"********** HIGHER LEVEL STUFF **********"
+
+<DEFINE ZAP-PASS ("AUX" (SCRIPT ,SCRIPT) (ZOB ,ZOB) (OTIME <TIME>))
+       #DECL ((SCRIPT) <OR CHANNEL FALSE>
+              (ZOB) <LIST [REST <OR OBLIST ATOM>]>
+              (OTIME) FLOAT)
+       <PRINC "ZAP pass #">
+       <PRIN1 <COND (,PASS1? 1) (2)>>
+       <SETG ASSEMERRS 0>
+       <SETG ZPC 0>
+       <SETG CUROBJ 0>
+       <SETG CURGVAR 15>
+       <SETG OZINS ()>
+       <SETG INS 0>
+       <SETG STATEMENTS
+             ((*BYTE!-GLOBALS ,ZAPID)
+              (*BYTE!-GLOBALS <COND (,BYTE-SWAP? 1) (0)>)
+              (ZORKID!-UNDEFINED)
+              (ENDLOD!-UNDEFINED)
+              (START!-UNDEFINED)
+              (VOCAB!-UNDEFINED)
+              (OBJECT!-UNDEFINED)
+              (GLOBAL!-UNDEFINED)
+              (IMPURE!-UNDEFINED)
+              !<ILIST 24 '(0)>)>
+       <REPEAT READ-LOOP (SL)
+               #DECL ((READ-LOOP) <SPECIAL ACTIVATION>
+                      (SL) <OR LIST FALSE>)
+               <OR <SET SL <GET-STATEMENT .ZOB .SCRIPT>> <RETURN>>
+               <MAPF <>
+                     <FUNCTION (ARG)
+                               #DECL ((ARG) <OR ATOM
+                                                FIX
+                                                ZSTR
+                                                <LIST ATOM
+                                                      <OR NUMBER CHARACTER>>>)
+                               <COND (<TYPE? .ARG ATOM FIX ZSTR>)
+                                     (<TYPE? <2 .ARG> ATOM>
+                                      <SET ARG <2 .ARG>>)
+                                     (<SET ARG <1 .ARG>>)>
+                               <AND <TYPE? .ARG ATOM>
+                                    <REPEAT ()
+                                            <OR <AND <GASSIGNED? .ARG>
+                                                     <TYPE? ,.ARG ATOM>>
+                                                <RETURN>>
+                                            <SET ARG ,.ARG>>>>
+                     <REST .SL>>
+               <COND (<TYPE? ,<1 .SL> OP>
+                      <COND (<NOT ,DTRACE?>)
+                            (,PASS1?
+                             <AND <0? ,DSBOT> <SETG DSBOT <- ,ZPC 1>>>)
+                            (T
+                             <DSPRINT ,LASTSYM ,DSJFN>
+                             <PUT ,DSYMBOLS <- ,ZPC ,DSBOT> ,DSPOS>
+                             <SETG DSPOS <+ ,DSPOS <LENGTH ,LASTSYM> 1>>)>
+                      <OPERATION .SL>)
+                     (<COND (<EMPTY? <1 ,<1 .SL>>> <EMPTY? <REST .SL>>)
+                            (<DECL? <REST .SL> <1 ,<1 .SL>>>)>
+                      <APPLY <2 ,<1 .SL>> .SL>)
+                     (<ASSEMERR ARG-WRONG-TYPE!-ERRORS ZAP-PASS .SL>)>>
+       <PRINC " completed in ">
+       <PRIN1 <FIX <- <TIME> .OTIME -.5>>>
+       <PRINC " seconds.">
+       <CRLF>>
+
+<DEFINE ZAP (FILE "OPTIONAL" (SCRIPT <>) (LIST1? <>)
+                 "AUX" ZIN UNDEF (OTIME <TIME>) SYMS)
+       #DECL ((FILE) STRING
+              (SCRIPT) <OR STRING CHANNEL FALSE>
+              (ZIN) <OR CHANNEL FALSE>
+              (LIST1?) <OR ATOM FALSE>
+              (UNDEF) <LIST [REST ATOM]>
+              (OTIME) FLOAT
+              (SYMS) VECTOR)
+       <AND <TYPE? .SCRIPT STRING> <SET SCRIPT <OPEN "PRINT" .SCRIPT>>>
+       <AND <TYPE? .SCRIPT CHANNEL>
+            <PUT .SCRIPT 13 <CHTYPE <MIN> FIX>>>
+       <COND (<SET ZIN <OPEN "READ" <STRING .FILE ".ZAP">>>
+              <SETG ZIN .ZIN>)
+             (<ERROR OPEN-FAILED!-ERRORS ZAP .FILE .ZIN>)>
+       <SETG PASS1? T>
+       <SETG DSBOT 0>
+       <SETG TABLE-END 0>
+       <SETG ZOB (<SETG LOCALS <MOBLIST TOPLOCALS 1>>
+                  ,GLOBALS
+                  DEFAULT
+                  <GET UNDEFINED OBLIST>)>
+       <SETG SCRIPT <AND .LIST1? .SCRIPT>>
+       <ZAP-PASS>
+       <SET UNDEF <MAPF ,LIST
+                        <FUNCTION (L)
+                                  #DECL ((L) LIST)
+                                  <MAPRET !.L>>
+                        <GET UNDEFINED OBLIST>>>
+       <COND (<AND <EMPTY? .UNDEF> <0? ,ASSEMERRS>>
+              <RESET ,ZIN>
+              <SETG PASS1? <>>
+              <COND (,DTRACE?
+                     <SETG DSYMBOLS <IBYTES 18 <- ,ZPC ,DSBOT 1>>>
+                     <SETG DSJFN <DSOPEN <STRING .FILE ".DTEXT" <ASCII 0>> T>>
+                     <DSPRINT " " ,DSJFN>
+                     <SETG DSPOS 2>)>
+              <PUT ,ZOB 1 <GET TOPLOCALS OBLIST>>
+              <SETG ZCODE <IBYTES 8 ,ZPC>>
+              <SETG SCRIPT .SCRIPT>
+              <ZAP-PASS>
+              <PRIN1 ,ZPC>
+              <PRINC " bytes used.">
+              <CRLF>
+              <PRIN1 <FIX <+ .5 </ ,INS <- <TIME> .OTIME>>>>>
+              <PRINC " instructions assembled per second.">
+              <COND (<SET ZIN <OPEN "PRINTB" <STRING .FILE ".ZIP">>>)
+                    (<ERROR OPEN-FAILED!-ERRORS ZAP .FILE .ZIN>)>
+              <GC-DUMP ,ZCODE .ZIN>
+              <CLOSE .ZIN>
+              <COND (,DTRACE?
+                     <DSCLOSE ,DSJFN>
+                     <COND (<SET ZIN <OPEN "PRINTB" <STRING .FILE
+                                                            ".DSYMBOLS">>>)
+                           (<ERROR OPEN-FAILED!-ERRORS ZAP .FILE .ZIN>)>
+                     <GC-DUMP (,DSBOT ,DSYMBOLS) .ZIN>
+                     <CLOSE .ZIN>)>
+              <SET SYMS
+                   <MAPF ,VECTOR
+                         <FUNCTION (BUCK)
+                            #DECL ((BUCK) LIST)
+                            <MAPRET !<MAPF ,VECTOR
+                                       <FUNCTION (ATM
+                                                  "AUX" (S <SPNAME .ATM>))
+                                             #DECL ((ATM) ATOM
+                                                    (S) STRING)
+                                             <COND (<AND <MEMQ !\? .S>
+                                                         <N==? 
+                                                          <NTH .S <LENGTH .S>>
+                                                          !\?>>
+                                                    <MAPRET>)
+                                                   (<==? <PRIMTYPE ,.ATM>
+                                                         WORD>
+                                                    <MAPRET <CHTYPE ,.ATM FIX>
+                                                            .S>)
+                                                   (<MAPRET>)>>
+                                   .BUCK>>>
+                         ,GLOBALS>>
+              <SORT <> .SYMS 2>
+              <SET ZIN <OPEN "PRINT" <STRING .FILE ".ZSYM">>>
+              <PRINT .SYMS .ZIN>
+              <CLOSE .ZIN>
+              <COND (<NOT <0? ,ASSEMERRS>>
+                     <PRIN1 ,ASSEMERRS>
+                     <PRINC " assembly errors">)>)
+             (<PRINC "Assembly aborted">
+              <CRLF>
+              <COND (<NOT <0? ,ASSEMERRS>>
+                     <PRIN1 ,ASSEMERRS>
+                     <PRINC " assembly errors">
+                     <CRLF>)>
+              <COND (<NOT <EMPTY? .UNDEF>>
+                     <PRINC "undefined symbols found:">
+                     <MAPF <> ,PRINT .UNDEF>)>)>
+       <CRLF>
+       <AND .SCRIPT <N==? .SCRIPT ,OUTCHAN> <CLOSE .SCRIPT>>
+       <QUIT>>
+
+
+<ENDBLOCK>
+
+<ENDPACKAGE>
\ No newline at end of file
diff --git a/zork.z/zil.mud.176 b/zork.z/zil.mud.176
new file mode 100644 (file)
index 0000000..822b707
--- /dev/null
@@ -0,0 +1,1407 @@
+
+"ZIL Interpreter/Table Generator"
+
+<SETG INITIAL <GET INITIAL OBLIST>>
+
+<DEFINE MSETG (ATM VAL) <SETG .ATM .VAL> <MANIFEST .ATM>>
+
+<SETG STR3 <ISTRING 3>>
+
+;"***************** OFFSETS INTO 'OBJECTS' ******************"
+
+<MSETG OLOC 1>
+
+<MSETG OFIRST 2>
+
+<MSETG ONEXT 3>
+
+<MSETG ODESC 4>
+
+<MSETG OBIT0-15 5>
+
+<MSETG OBIT16-31 6>
+
+<MSETG OPROP 7>
+
+;"*********************** OBJECT BIT CONSTANTS *****************"
+
+<SETG BITBYTE ,OBIT16-31>
+
+<SETG HIBIT 32>
+
+<SETG HIVAL 0>
+
+<GDECL (BITBYTE HIBIT HIVAL) FIX>
+
+<MSETG BWORD 1>
+
+<MSETG BVAL 2>
+
+<MSETG BNUM 3>
+
+;"******************** VOCABULARY WORD OFFSETS *******************"
+
+<MSETG WTYPES 1>
+
+<MSETG WVAL1 2>
+
+<MSETG WVAL2 3>
+
+<MSETG WSYM 4>
+
+;"******************* VALUES FOR THE WTYPE SLOT ******************"
+
+<SETG TOBJECT ![128 0!]>
+
+<SETG TVERB ![64 1!]>
+
+<SETG TADJ ![32 2!]>
+
+<SETG TDIR ![16 3!]>
+
+<SETG TPREP ![8 0!]>
+
+<SETG TBUZZ ![4 0!]>
+
+<GDECL (TOBJECT TVERB TADJ TDIR TPREP TBUZZ)
+       <UVECTOR FIX FIX>
+       (WTYPETBL)
+       <UVECTOR [REST ATOM]>>
+
+<SETG WTYPETBL ![OBJECT VERB ADJECTIVE DIRECTION PREPOSITION BUZZ-WORD!]>
+
+;"******************** PARTS OF SPEECH TABLES **********************"
+
+<SETG PROPS <REST <IUVECTOR 31 T> 30>>
+
+<SETG ADJS <REST <IUVECTOR 255 T> 254>>
+
+<SETG PREPS <REST <IUVECTOR 255 T> 254>>
+
+<SETG BUZZES <REST <IUVECTOR 255 T> 254>>
+
+<SETG ACTS <REST <IUVECTOR 255 T> 254>>
+
+<SETG PROPDEFS <IVECTOR 31 <>>>
+
+<GDECL (PROPS ADJS BUZZES PREPS)
+       <UVECTOR [REST ATOM]>
+       (PROPDEFS)
+       VECTOR>
+
+;"************************* OBLIST DEFINITIONS ********************"
+
+<SETG OBJECTS <MOBLIST OBJECTS 17>>
+
+<SETG ZOBJS <MOBLIST ZOBJS 17>>
+
+<SETG FLAGS <MOBLIST FLAGS 17>>
+
+<SETG VERBOBL <MOBLIST VERBOBL 17>>
+
+<SETG WORDS <MOBLIST WORDS 17>>
+
+<SETG VOCABULARY <MOBLIST VOCABULARY 53>>
+
+<GDECL (OBJECTS FLAGS WORDS VERBOBL) OBLIST>
+
+;"************************* ZILCH PSEUDO OPERATIONS ******************"
+
+<SETG ID ,TIME>
+
+<SETG ENDLOAD ,TIME>
+
+;"PROPDEF - Set property defaults"
+
+<DEFINE PROPDEF (NAME VAL)
+       #DECL ((NAME) ATOM (VAL) <OR ATOM FIX>)
+       <PUT ,PROPDEFS <POS .NAME <TOP ,PROPS>> .VAL>>
+
+;"ITABLE - Create a long empty table"
+
+<DEFINE ITABLE (LEN? LEN "OPTIONAL" (FILL 0) "AUX" L)
+       #DECL ((LEN?) ATOM (LEN FILL) FIX (L) <VECTOR [REST ZOBJECT]>)
+       <SET L <IVECTOR .LEN .FILL>>
+       <OR <==? .LEN? NONE>
+           <PUT .L 1 .LEN>>
+       <COND (<==? .LEN? WORD>
+              <PUT .L 2 <CHTYPE (.LEN) FALSE>>)>
+       <CHTYPE .L TABLE>>
+
+;"TABLE - Create arbitrary tables"
+
+<DEFINE LTABLE ("TUPLE" ELEM)
+       #DECL ((ELEM) TUPLE)
+       <TABLE <LENGTH .ELEM> !.ELEM>>
+
+<DEFINE TABLE ("TUPLE" ELEM)
+       #DECL ((ELEM) <TUPLE [REST <OR ZOBJECT <FALSE ZOBJECT>>]>)
+       <CHTYPE <MAPF ,VECTOR
+                     <FUNCTION (EL)
+                               #DECL ((EL) <OR ZOBJECT <FALSE ZOBJECT>>)
+                               <COND (<AND <TYPE? .EL ATOM>
+                                           <GASSIGNED? .EL>
+                                           <TYPE? ,.EL OBJECT FIX TABLE>>
+                                      <SET EL ,.EL>)>
+                               <MAPRET .EL <CHTYPE (.EL) FALSE>>>
+                     .ELEM>
+               TABLE>>
+
+;"DIRECTIONS - Create direction properties"
+
+<DEFINE DIRECTIONS ("TUPLE" NAMES)
+       #DECL ((NAMES) <TUPLE [REST ATOM]>)
+       <MAPF <>
+             <FUNCTION (NAME)
+                       #DECL ((NAME) ATOM)
+                       <ADD-SEQ .NAME PROPS "P?">>
+             .NAMES>
+       <PRINT-SEQ <TOP ,PROPS> "P?">
+       <GLOBAL LOW-DIRECTION <POS <NTH .NAMES <LENGTH .NAMES>> <TOP ,PROPS>>>>
+
+;" SYNTAX - Create syntax tables for the parser"
+
+<DEFINE SYNTAX ("TUPLE" ARGS
+               "AUX" ANY VERB (ACT <>) ATM (PREP 0) (POS 0) (SLOTS ,SLOTS)
+                     SLOT L (PREACT <>))
+   #DECL ((ARGS) TUPLE (ANY) ANY (VERB) ATOM (ACT ATM) <OR FALSE ATOM>
+         (POS PREP) FIX (SLOT) <UVECTOR [3 FIX]> (L) <LIST [REST VECTOR]>
+         (SLOTS) <UVECTOR [REST <UVECTOR [3 FIX]>]>)
+   <MAPR <> <FUNCTION (X) #DECL ((X) UVECTOR) <PUT .X 1 0>> <1 .SLOTS>>
+   <MAPR <> <FUNCTION (X) #DECL ((X) UVECTOR) <PUT .X 1 0>> <2 .SLOTS>>
+   <COND
+    (<EMPTY? .ARGS> <COMPERR TOO-FEW-ARGUMENTS!-ERRORS SYNTAX>)
+    (<TYPE? <SET ANY <1 .ARGS>> ATOM>
+     <SET VERB <1 .ARGS>>
+     <MAPR <>
+      <FUNCTION (TUP "AUX" (ITM <1 .TUP>)) 
+             #DECL ((ITM) ANY)
+             <COND (<==? .ITM OBJECT>
+                    <COND (<G? <SET POS <+ .POS 1>> 2>
+                           <COMPERR TOO-MANY-OBJECTS!-ERRORS SYNTAX>)>
+                    <SET SLOT <NTH .SLOTS .POS>>
+                    <PUT .SLOT 1 .PREP>
+                    <SET PREP 0>)
+                   (<==? .ITM =>
+                    <COND (<OR <LENGTH? .TUP 1> <NOT <TYPE? <2 .TUP> ATOM>>>
+                           <COMPERR BAD-SYNTAX!-ERRORS SYNTAX>)
+                          (<SET ACT <2 .TUP>>
+                           <OR <LENGTH? .TUP 2>
+                               <SET PREACT <3 .TUP>>>
+                            <MAPLEAVE>)>)
+                   (<TYPE? .ITM ATOM>
+                    <SET PREP <ADD-SEQ .ITM PREPS>>
+                    <ADD-WORD .ITM TPREP .PREP T>)
+                   (<AND <TYPE? .ITM LIST>
+                         <NOT <EMPTY? .ITM>>
+                         <TYPE? <SET ANY <1 .ITM>> ATOM>>
+                    <COND (<==? .ANY FIND>
+                           <AND <OR <LENGTH? .ITM 1>
+                                    <NOT <TYPE? <2 .ITM> ATOM>>>
+                                <COMPERR BAD-SYNTAX!-ERRORS SYNTAX>>
+                           <BITADD ,PHONYBIT <SET ATM <2 .ITM>>>
+                           <PUT .SLOT 2 <3 ,<LOOKUP <SPNAME .ATM> ,FLAGS>>>)
+                          (<SBITS .ITM .SLOT>)>)
+                   (<ERROR BAD-SYNTAX!-ERRORS SYNTAX>)>>
+      <REST .ARGS>>
+     <COND
+      (.ACT
+       <SET L
+           <COND (<SET ATM <LOOKUP <SPNAME .VERB> ,VERBOBL>> ,.ATM)
+                 (<SET ATM <INSERT <SPNAME .VERB> ,VERBOBL>> ())>>
+       <SETG .ATM
+       ([.POS
+         <1 <1 .SLOTS>>
+         <1 <2 .SLOTS>>
+         <2 <1 .SLOTS>>
+         <2 <2 .SLOTS>>
+         <3 <1 .SLOTS>>
+         <3 <2 .SLOTS>>
+         <- <GET-ACTION .ACT .PREACT> 2>]
+        !.L)>)
+      (<COMPERR NO-ACTION-SPECIFIED!-ERRORS SYNTAX>)>)
+    (<COMPERR NON-ATOMIC-VERB!-ERRORS SYNTAX .VERB>)>>
+
+;"CONSTANT - Set up arbitrary constants"
+
+<SETG CONSTANT ,SETG>
+
+;"GLOBAL - Set a global variable (at top level)"
+
+<SETG GLOBAL ,SETG>
+
+;"INSERT-FILE - Start compiling from an insert file"
+
+<DEFINE INSERT-FILE (STR "OPTIONAL" (FLOAD? <>))
+        #DECL ((STR) STRING (FLOAD?) <OR ATOM FALSE>)
+       <ZFLOAD .STR .FLOAD?>>
+
+;"BUZZ - Create a buzz-word"
+
+<DEFINE BUZZ ("TUPLE" WRDS) 
+       #DECL ((WRDS) <TUPLE [REST ATOM]>)
+       <MAPF <>
+             <FUNCTION (WRD) 
+                     #DECL ((WRD) ATOM)
+                     <ADD-WORD .WRD TBUZZ <ADD-SEQ .WRD BUZZES "B?"> T>>
+             .WRDS>>
+
+<DEFINE ROUTINE ("ARGS" L)
+       <SETG <1 .L> <CHTYPE (\ ZACT!-ZO !<REST .L>) FUNCTION>>>
+
+;"SYNONYM - Create synonyms for a given vocabulary word"
+
+<SETG SYNLIST ()>
+
+<DEFINE SYNONYM ("ARGS" FOO)
+       <SETG SYNLIST (<FORM OSYNONYM !.FOO> !,SYNLIST)>>
+
+<DEFINE OSYNONYM (WRD "TUPLE" SYNS "AUX" WRDVAL ATM) 
+       #DECL ((WRD) ATOM (SYNS) <TUPLE [REST ATOM]> (WRDVAL) VECTOR
+              (ATM) ATOM)
+       <SET ATM <GET-ATOM .WRD ,WORDS>>
+       <SET WRDVAL <COND (<GASSIGNED? .ATM>
+                          <VECTOR !,.ATM>)
+                         (<SETG .ATM [0 0 0 0]>)>>
+       <MAPF <>
+             <FUNCTION (WRD) 
+                     #DECL ((WRD) ATOM)
+                     <SETG <GET-ATOM .WRD ,WORDS> .WRDVAL>>
+             .SYNS>>
+
+;"OBJECT - Create an 'object'"
+
+<DEFINE OBJECT (NAME
+               "TUPLE" DECLS
+               "AUX" (L ()) (MEVEC <ADD-OBJ .NAME>) VEC CONT V)
+   #DECL ((NAME CONT) ATOM (DECLS) <TUPLE [REST LIST]> (L) LIST (FLAGS) FIX
+         (MEVEC VEC) <VECTOR <OR ATOM FIX> <OR ATOM FIX>> (V) VECTOR)
+   <SETG .NAME <GET-OBJ .NAME>>
+   <MAPF <>
+    <FUNCTION (DECL "AUX" (TYPE <1 .DECL>)) 
+           <COND
+            (<==? .TYPE FLAGS>
+             <MAPF <>
+                   <FUNCTION (BITNAME) <BITADD .MEVEC .BITNAME>>
+                   <REST .DECL>>)
+            (<==? .TYPE DESC> <PUT .MEVEC ,ODESC <2 .DECL>>)
+            (<==? .TYPE GLOBAL>
+             <ADD-SEQ GLOBAL PROPS "P?">
+             <SET L
+                  (GLOBAL
+                   <- <LENGTH .DECL> 1>
+                   <CHTYPE <MAPF ,VECTOR
+                                 <FUNCTION (WRD)
+                                           #DECL ((WRD) ATOM)
+                                           <ADD-OBJ .WRD>
+                                           <GET-OBJ .WRD>>
+                                 <REST .DECL>>
+                           TABLE>
+                   !.L)>)
+            (<==? .TYPE SYNONYM>
+             <ADD-SEQ SYNONYM PROPS "P?">
+             <AND <G? <LENGTH .DECL> 5>
+                  <COMPERR TOO-MANY-SYNONYMS!-ERRORS .NAME>>
+             <SET L
+                  (SYNONYM
+                   <* 2 <LENGTH <REST .DECL>>>
+                   <CHTYPE <MAPF ,VECTOR
+                                 <FUNCTION (WRD) 
+                                           #DECL ((WRD) ATOM)
+                                           <ADD-WORD .WRD TOBJECT 1 T>
+                                           <STRING "W?" <SPNAME .WRD>>>
+                                 <REST .DECL>>
+                           TABLE>
+                   !.L)>)
+            (<==? .TYPE ADJECTIVE>
+             <ADD-SEQ ADJECTIVE PROPS "P?">
+             <AND <G? <LENGTH .DECL> 9>
+                  <COMPERR TOO-MANY-ADJECTIVES!-ERRORS .NAME>>
+             <SET L
+                  (ADJECTIVE
+                   <LENGTH <REST .DECL>>
+                   <CHTYPE <MAPF ,VECTOR
+                                 <FUNCTION (WRD) 
+                                           #DECL ((WRD) ATOM)
+                                           <ADD-WORD .WRD
+                                                     TADJ
+                                                     <ADD-SEQ .WRD ADJS "A?">>
+                                           <STRING "A?" <SPNAME .WRD>>>
+                                 <REST .DECL>> TABLE>
+                   !.L)>)
+            (<==? .TYPE PSEUDO>
+             <ADD-SEQ PSEUDO PROPS "P?">
+             <SET L
+                  (PSEUDO
+                   <* <LENGTH <REST .DECL>> 2>
+                   <CHTYPE <MAPF ,VECTOR
+                                 <FUNCTION (WRD) 
+                                           #DECL ((WRD) <OR STRING ATOM>)
+                                           <COND (<TYPE? .WRD STRING>
+                                                  <ADD-WORD <PARSE .WRD>
+                                                            TOBJECT 1 T>
+                                                  <STRING "W?" .WRD>)
+                                                 (.WRD)>>
+                                 <REST .DECL>> TABLE>
+                   !.L)>)
+            (<AND <==? .TYPE IN>
+                  <N==? <2 .DECL> TO>>
+             <SET CONT <2 .DECL>>
+             <PUT .MEVEC ,OLOC .CONT>
+             <SET VEC <ADD-OBJ .CONT>>
+             <COND (<==? <OFIRST .VEC> 0> <PUT .VEC ,OFIRST .NAME>)
+                   (<SET VEC <ADD-OBJ <OFIRST .VEC>>>
+                    <PUT .MEVEC ,ONEXT <ONEXT .VEC>>
+                    <PUT .VEC ,ONEXT .NAME>)>)
+            (T
+             <ADD-SEQ .TYPE PROPS "P?">
+             <SET L (.TYPE !<ZPROP <REST .DECL> .TYPE> !.L)>)>>
+    .DECLS>
+   <SET V <VECTOR !.L>>
+   <PUT .MEVEC ,OPROP .V>
+   T>
+
+<SETG ROOM ,OBJECT>
+
+;"******************** FORMAT UTILITIES ********************"
+
+<DEFINE POS (ATM UVEC "AUX" M) 
+       #DECL ((ATM) ATOM (UVEC) <UVECTOR [REST ATOM]>
+              (M) <OR FALSE <UVECTOR [REST ATOM]>>)
+       <COND (<SET M <MEMQ .ATM .UVEC>> <- <LENGTH .UVEC> <LENGTH .M> -1>)>>
+
+<DEFINE ZPROP (LST PROP "AUX" (ITEM <1 .LST>) (LEN <LENGTH .LST>) RM OBJ/FLG
+                             TEMP) 
+   #DECL ((LST) LIST (ITEM TEMP) ANY (LEN) FIX (PROP RM OBJ/FLG) ATOM)
+   <COND
+    (<AND <==? .ITEM PER> <==? .LEN 2>>
+     <ADD-DIR .PROP>
+     [3 <CHTYPE [<2 .LST> <CHTYPE (<2 .LST>) FALSE> 0] TABLE>])
+    (<AND <=? .ITEM TO> <NOT <LENGTH? .LST 1>>>
+     <ADD-DIR .PROP>
+     <SET RM <2 .LST>>
+     <COND
+      (<LENGTH? .LST 2>
+       [1 <CHTYPE [<GET-OBJ .RM>] TABLE>])
+      (<N==? <3 .LST> IF> <COMPERR BAD-SYNTAX-IN-OBJECT-DEFINITION!-ERRORS>)
+      (<NOT <LENGTH? .LST 3>>
+       <SET OBJ/FLG <4 .LST>>
+       <COND
+       (<AND <G=? .LEN 6> <==? <5 .LST> IS> <==? <6 .LST> OPEN>>
+        <SET TEMP <COND (<AND <==? .LEN 8> <==? <7 .LST> ELSE>>
+                         <8 .LST>)>>
+        [5 <CHTYPE [<GET-OBJ .RM>
+                    <GET-OBJ .OBJ/FLG>
+                    .TEMP
+                    <CHTYPE (.TEMP) FALSE>
+                    0] TABLE>])
+       ([4
+         <CHTYPE [<GET-OBJ .RM>
+                  .OBJ/FLG
+                  !<COND (<AND <==? .LEN 6>
+                               <==? <5 .LST> ELSE>
+                               <TYPE? <6 .LST> STRING>>
+                          [<6 .LST> <CHTYPE (<6 .LST>) FALSE>])
+                         (<==? .LEN 4>
+                          [#FALSE () #FALSE (#FALSE ())])
+                         (<COMPERR BAD-SYNTAX-IN-OBJECT-DEFINITION!-ERRORS>)>]
+                 TABLE>])>)
+      (<COMPERR BAD-SYNTAX-IN-OBJECT-DEFINITION!-ERRORS>)>)
+    (<TYPE? .ITEM STRING FIX ATOM TABLE>
+     [2 <CHTYPE [.ITEM <CHTYPE (.ITEM) FALSE>] TABLE>])
+    (<ERROR UNKNOWN-PROPERTY-TYPE!-ERRORS .ITEM>)>>
+
+<DEFINE ADD-DIR (NAM)
+       #DECL ((NAM) ATOM)
+       <ADD-WORD .NAM TDIR <ADD-SEQ .NAM PROPS "P?">>>
+
+<DEFINE BITADD (VEC NAME "AUX" ATM BIT) 
+       #DECL ((VEC) VECTOR (NAME ATM) ATOM (BIT) <VECTOR FIX FIX>)
+       <SET ATM <GET-ATOM .NAME ,FLAGS>>
+       <SET BIT
+            <COND (<GASSIGNED? .ATM> ,.ATM)
+                  (<SETG HIBIT <- ,HIBIT 1>>
+                   <SETG HIVAL <COND (<0? ,HIVAL> 1) (<* ,HIVAL 2>)>>
+                   <COND (<G? ,HIVAL 35000>
+                          <COND (<==? ,BITBYTE ,OBIT16-31>
+                                 <SETG BITBYTE ,OBIT0-15>
+                                 <SETG HIVAL 1>)
+                                (<COMPERR TOO-MANY-BITS!-ERRORS>)>)>
+                   <SETG .ATM [,BITBYTE ,HIVAL ,HIBIT]>)>>
+       <PUT .VEC <BWORD .BIT> (.NAME !<NTH .VEC <BWORD .BIT>>)>>
+
+<DEFINE ADD-OBJ (NAME "AUX" ATM) 
+       #DECL ((NAME ATM) ATOM)
+       <SET ATM <GET-ATOM .NAME ,OBJECTS>>
+       <COND (<GASSIGNED? .ATM> ,.ATM) (<SETG .ATM [0 0 0 "" () () []]>)>>
+
+<DEFINE GET-ATOM (NAME OBL) 
+       #DECL ((NAME) ATOM (OBL) OBLIST)
+       <OR <LOOKUP <SPNAME .NAME> .OBL> <INSERT <SPNAME .NAME> .OBL>>>
+
+<DEFINE ADD-WORD (NAME TYPE VALUE
+                 "OPTIONAL" (SYM <>)
+                 "AUX" ATM VEC (TYPVAL ,.TYPE) TYPES)
+       #DECL ((NAME TYPE ATM) ATOM (VALUE) ANY (VEC) VECTOR
+              (TYPVAL) <UVECTOR [REST FIX]> (SYM) <OR ATOM FALSE>
+              (TYPES) <PRIMTYPE WORD>)
+       <SET ATM <GET-ATOM .NAME ,WORDS>>
+       <SET VEC <COND (<GASSIGNED? .ATM> ,.ATM) (<SETG .ATM [0 0 0 0]>)>>
+       <AND .SYM <PUT .VEC ,WSYM -1>>
+       <COND (<N==? 0 <CHTYPE <ANDB <SET TYPES <WTYPES .VEC>> <1 .TYPVAL>>
+                               FIX>>)
+             (<==? <WVAL1 .VEC> 0>
+              <PUT .VEC
+                   ,WTYPES
+                   <CHTYPE <ORB .TYPES <+ <1 .TYPVAL> <2 .TYPVAL>>> FIX>>
+              <PUT .VEC ,WVAL1 .VALUE>)
+             (<==? <WVAL2 .VEC> 0>
+              <PUT .VEC ,WTYPES <CHTYPE <ORB .TYPES <1 .TYPVAL>> FIX>>
+              <PUT .VEC ,WVAL2 .VALUE>)
+             (<COMPERR TOO-MANY-PARTS-OF-SPEECH!-ERRORS .NAME>)>>
+
+<DEFINE ADD-SEQ (NAME VECNAME
+                "OPTIONAL" (STRVAL <>)
+                "AUX" (VEC ,.VECNAME) (TVEC <TOP .VEC>) VAL)
+       #DECL ((NAME VECNAME) ATOM (VEC TVEC) <UVECTOR [REST ATOM]>
+              (STRVAL) <OR FALSE STRING> (VAL) <OR FIX FALSE>)
+       <COND (<==? .NAME \,>
+              <SET NAME COMMA>)
+             (<==? .NAME \">
+              <SET NAME QUOTE>)>
+       <COND (<SET VAL <POS .NAME .TVEC>>
+              <COND (.STRVAL <STRING .STRVAL <SPNAME .NAME>>) (.VAL)>)
+             (<PUT .VEC 1 .NAME>
+              <COND (<==? .TVEC .VEC> <COMPERR TOO-MANY!-ERRORS .VECNAME>)
+                    (<SETG .VECNAME <BACK .VEC>>)>
+              <COND (.STRVAL <STRING .STRVAL <SPNAME .NAME>>)
+                    (<SET VAL <POS .NAME .TVEC>>
+                     <SETG .NAME .VAL>
+                     .VAL)>)>>
+
+;"********************* ZILCH DATA OUTPUT ROUTINES ******************"
+
+
+<SETG SLOTS ![![0 0 0!] ![0 0 0!]!]>
+
+<SETG PHONYBIT [0 0 0 0 () ()]>
+
+<SETG PREACTION (T)>
+
+<SETG PREAL ,PREACTION>
+
+<SETG ACTION (T)>
+
+<SETG AL ,ACTION>
+
+<GDECL (ACTION AL) <LIST [REST ATOM]>
+       (PREAL PREACTION) <LIST [REST <OR FALSE ATOM>]>>
+
+<GDECL (TEMPS) <LIST [REST LOCAL]>>
+
+<DEFINE GET-ACTION (ACT PREACT)
+       #DECL ((ACT) ATOM (PREACT) <OR FALSE ATOM>)
+       <COND (<LPOS .ACT ,ACTION>)
+             (T
+              <SETG AL <REST <PUTREST ,AL (.ACT)>>>
+              <SETG PREAL <REST <PUTREST ,PREAL (.PREACT)>>>
+              <LPOS .ACT ,ACTION>)>>
+
+<DEFINE LPOS (ITM LST "AUX" M)
+       #DECL ((ITM) ATOM (LST) <LIST [REST ATOM]> (M) <OR FALSE LIST>)
+       <AND <SET M <MEMQ .ITM .LST>>
+            <- <LENGTH .LST> <LENGTH .M> -1>>>
+             
+
+<DEFINE SBITS (LST SLOT "AUX" M) 
+   #DECL ((LST) LIST (SLOT) <UVECTOR [REST FIX]>
+         (M) <OR FALSE <VECTOR [REST ATOM FIX]>>)
+   <MAPF <>
+    <FUNCTION (ANY) 
+           #DECL ((ANY) ANY)
+           <COND (<TYPE? .ANY ATOM>
+                  <COND (<SET M <MEMQ .ANY ,SFLAGS>>
+                         <PUT .SLOT 3 <+ <3 .SLOT> <2 .M>>>)
+                        (<COMPERR UNKNOWN-SYNTAX-FLAG!-ERRORS .ANY>)>)
+                 (<COMPERR BAD-SYNTAX!-ERRORS SYNTAX>)>>
+    .LST>>
+
+<MSETG SH 128>
+
+<MSETG SC 64>
+
+<MSETG SIR 32>
+
+<MSETG SOG 16>
+
+<MSETG STAKE 8>
+
+<MSETG SMANY 4>
+
+<MSETG SHAVE 2>
+
+<SETG SFLAGS
+      [HAVE
+       ,SHAVE
+       TAKE
+       ,STAKE
+       MANY
+       ,SMANY
+       HELD
+       ,SH
+       CARRIED
+       ,SC
+       IN-ROOM
+       ,SIR
+       ON-GROUND
+       ,SOG]>
+
+<GDECL (SFLAGS) <VECTOR [REST ATOM FIX]>>
+
+<DEFINE PRINT-VERBNUMS ("AUX" (N -1)) 
+       #DECL ((N) FIX)
+       <MAPF <>
+             <FUNCTION (ATM "AUX" (S <SPNAME .ATM>)) 
+                     #DECL ((ATM) ATOM (S) STRING)
+                     <COND (<AND <==? <1 .S> !\V>
+                                 <==? <2 .S> !\->>
+                            <SET S <REST .S 2>>)>
+                     <IATOM <STRING "V?" .S> <SET N <+ .N 1>>>>
+             <REST ,ACTION>>
+       <MAPF <>
+             <FUNCTION (BUCK) 
+                     #DECL ((BUCK) LIST)
+                     <MAPF <>
+                           <FUNCTION (ATM) 
+                                   #DECL ((ATM) ATOM)
+                                   <ADD-WORD .ATM
+                                             TVERB
+                                             <ADD-SEQ .ATM ACTS "ACT?">>>
+                           .BUCK>>
+             ,VERBOBL>>
+
+<DEFINE PRINT-VERBS ("AUX" FOO) 
+       #DECL ((FOO) LIST)
+       <SET FOO
+             <MAPF ,LIST
+                   <FUNCTION (X)
+                             #DECL ((X) <LIST [REST ATOM]>)
+                             <MAPRET !.X>>
+                   ,VERBOBL>>
+       <SETG VERBS
+             <MAPF ,TABLE
+                   <FUNCTION (ATM "AUX" X)
+                             #DECL ((ATM) ATOM (X) TABLE)
+                             <SET X <SYNTAB ,.ATM>>
+                             <REMOVE <GUNASSIGN .ATM>>
+                             .X>
+                   .FOO>>>
+
+<DEFINE SYNTAB (LST) 
+       #DECL ((LST) LIST)
+       <CHTYPE <VECTOR <LENGTH .LST>
+                       !<MAPF ,LIST <FUNCTION (V) <MAPRET !.V>> .LST>
+                       0>
+               TABLE>>
+
+<DEFINE PRINT-ACTIONS ()
+       <SETG ACTIONS <TABLE !<REST ,ACTION>>>
+       <SETG PREACTIONS <TABLE !<REST ,PREACTION>>>>
+
+<DEFINE PRINT-PREPS ()
+       <SETG PREPOSITIONS
+             <TABLE <LENGTH <REST ,PREPS>>
+                    !<MAPF ,LIST
+                           <FUNCTION (ATM)
+                                 <MAPRET ,<LOOKUP <STRING "W?" <SPNAME .ATM>>
+                                                  ,INITIAL>
+                                         ,<LOOKUP <STRING "PR?" <SPNAME .ATM>>
+                                                  ,INITIAL>>>
+                           <REST ,PREPS>>>>>
+       
+<DEFINE PRINT-VOCAB ("AUX" (OUTCHAN .OUTCHAN) (VOCAB ,VOCABULARY)) 
+       #DECL ((OUTCHAN) CHANNEL (VOCAB) OBLIST)
+       <EVAL ,SYNLIST>
+       <MAPF <>
+           <FUNCTION (BUCK)
+                #DECL ((BUCK) LIST)
+                <MAPF <>
+                    <FUNCTION (WRD "AUX" (VAL ,.WRD) (SPN <SPNAME .WRD>) 
+                                         W X V A) 
+                         #DECL ((WRD) ATOM (VAL) VECTOR (W) ZWORD (X) FALSE
+                                (V) TABLE (A) <OR ATOM FALSE> (SPN) STRING)
+                         <SET SPN
+                              <COND (<L=? <LENGTH .SPN> 6>
+                                     .SPN)
+                                    (<SUBSTRUC .SPN 0 6>)>>
+                         <SETG <OR <AND <SET A <LOOKUP .SPN .VOCAB>>
+                                        <PRINC "
+Already there: ">
+                                        <PRINC .A>
+                                        .A>
+                                   <INSERT .SPN .VOCAB>>
+                               <SET V
+                                    <CHTYPE <VECTOR <SET W
+                                                         <CHTYPE .SPN ZWORD>>
+                                                    <SET X
+                                                         <CHTYPE (.W) FALSE>>
+                                                    .X
+                                                    .X
+                                                    <WTYPES .VAL>
+                                                    <WX <WVAL1 .VAL>>
+                                                    <WX <WVAL2 .VAL>>>
+                                            TABLE>>>
+                         <IATOM <STRING "W?"
+                                        <COND (<=? <SPNAME .WRD> "\"">
+                                               "QUOTE")
+                                              (<=? <SPNAME .WRD> ",">
+                                               "COMMA")
+                                              (<SPNAME .WRD>)>> .V>
+                         <REMOVE <GUNASSIGN .WRD>>>
+                    .BUCK>>
+           ,WORDS>>
+
+<DEFINE WX (ITM)
+       #DECL ((ITM) <OR FIX STRING>)
+       <COND (<TYPE? .ITM STRING>
+              ,<LOOKUP .ITM <GET INITIAL OBLIST>>)
+             (.ITM)>>
+
+<DEFINE IATOM (STR VAL)
+       <SETG <OR <LOOKUP .STR ,INITIAL>
+                 <INSERT .STR ,INITIAL>>
+             .VAL>>
+
+<DEFINE PRINT-OBJECTS ("AUX" (OBJ ,OBJECTS)) 
+       #DECL ((OBJ) OBLIST)
+       <MAPF <>
+             <FUNCTION (VAL PROP)
+                       #DECL ((VAL) ANY (PROP) ATOM)
+                       <COND (<==? .PROP T>)
+                             (<PUT .PROP DEFAULT .VAL>)>>
+             ,PROPDEFS
+             <TOP ,PROPS>>
+       <MAPF <>
+             <FUNCTION (BUCK)
+                       #DECL ((BUCK) LIST)
+                       <MAPF <> ,OBJMAKE .BUCK>>
+             .OBJ>>
+
+<DEFINE PRINT-FLAGS () 
+       <MAPF <>
+             <FUNCTION (BUCK) 
+                     #DECL ((BUCK) <LIST [REST ATOM]>)
+                     <MAPF <>
+                           <FUNCTION (FLAG) 
+                                   #DECL ((FLAG) ATOM)
+                                   <IATOM <SPNAME .FLAG>
+                                          <BNUM ,.FLAG>>
+                                   <PUT <BNUM ,.FLAG>
+                                        FLAGNAME
+                                        <LOOKUP <SPNAME .FLAG> ,INITIAL>>>
+                           .BUCK>>
+             ,FLAGS>>
+
+<MSETG OBJNAME 1>
+
+<MSETG OBJBITS 2>
+
+<MSETG OBJLOC 3>
+
+<MSETG OBJNEXT 4>
+
+<MSETG OBJFIRST 5>
+
+<MSETG OBJTBL 6>
+
+<DEFINE GET-OBJ (NAME "AUX" ATM) 
+       #DECL ((NAME) ATOM (ATM) <OR FALSE ATOM>)
+       <COND (<SET ATM <LOOKUP <SPNAME .NAME> ,ZOBJS>> ,.ATM)
+             (<SETG <INSERT <SPNAME .NAME> ,ZOBJS>
+                    <CHTYPE <VECTOR .NAME () <> <> <> ,NT> OBJECT>>)>>
+
+<SETG NT ["FOO" []]>
+
+<DEFINE OBJMAKE (NAME "AUX" (VEC <ADD-OBJ .NAME>) OBJ PROPS M) 
+       #DECL ((NAME) ATOM (VEC) VECTOR (OBJ) OBJECT
+              (PROPS) <VECTOR [REST ATOM FIX TABLE]>
+              (M) <OR FALSE <VECTOR ATOM FIX TABLE [REST ANY]>>)
+       <SET OBJ <GET-OBJ .NAME>>
+       <PUT .OBJ ,OBJNAME .NAME>
+       <PUT .OBJ ,OBJBITS (!<OBIT0-15 .VEC> !<OBIT16-31 .VEC>)>
+       <AND <N==? <OLOC .VEC> 0>
+            <PUT .OBJ ,OBJLOC <GET-OBJ <OLOC .VEC>>>>
+       <AND <N==? <ONEXT .VEC> 0>
+            <PUT .OBJ ,OBJNEXT <GET-OBJ <ONEXT .VEC>>>>
+       <AND <N==? <OFIRST .VEC> 0>
+            <PUT .OBJ ,OBJFIRST <GET-OBJ <OFIRST .VEC>>>>
+       <PUT .OBJ ,OBJTBL <VECTOR <ODESC .VEC> <OPROP .VEC>>>
+       <SET PROPS <2 <OBJTBL .OBJ>>>
+       <COND (<SET M <MEMQ PSEUDO .PROPS>>
+              <PUT .M 3 <SUBS <3 .M> T>>)>
+       <COND (<SET M <MEMQ SYNONYM .PROPS>>
+              <PUT .M 3 <SUBS <3 .M> T>>)>
+       <COND (<SET M <MEMQ ADJECTIVE .PROPS>>
+              <PUT .M 3 <SUBS <3 .M>>>)>>
+              
+<DEFINE SUBS (TBL "OPTIONAL" (ZF <>))
+       #DECL ((TBL) <TABLE [REST <OR ATOM STRING>]> (ZF) <OR FALSE ATOM>)
+       <CHTYPE
+        <MAPF ,VECTOR
+             <FUNCTION (E "AUX" ATM VAL)
+                       #DECL ((E) <OR ATOM STRING> (VAL) ZOBJECT
+                              (ATM) <OR FALSE ATOM>)
+                        <COND (<TYPE? .E STRING>
+                               <SET ATM <LOOKUP .E ,INITIAL>>
+                               <COND (.ATM <SET VAL ,.ATM>)
+                                     (T
+                                      <PRINC "
+Chomping synonym: ">
+                                      <PRINC .E>
+                                      <SET VAL 0>)>)
+                              (<SET VAL .E>)>
+                        <COND (.ZF
+                               <MAPRET .VAL <CHTYPE (.VAL) FALSE>>)
+                              (.VAL)>>
+             .TBL> TABLE>>
+
+<DEFINE PRINT-SEQ (SEQTBL PREFIX "AUX" (OUTCHAN .OUTCHAN)) 
+       #DECL ((SEQTBL) <UVECTOR [REST ATOM]> (STR PREFIX) STRING
+              (OUTCHAN) CHANNEL)
+       <REPEAT ((N <LENGTH .SEQTBL>))
+               #DECL ((N) FIX)
+               <COND (<==? <NTH .SEQTBL .N> T> <RETURN>)
+                     (<IATOM <STRING .PREFIX
+                                     <SPNAME <NTH .SEQTBL .N>>>
+                             .N>)>
+               <AND <0? <SET N <- .N 1>>> <RETURN>>>>
+
+<DEFINE PRINT-TOP () 
+       <SETG PS?OBJECT 128>
+       <SETG PS?VERB 64>
+       <SETG PS?ADJECTIVE 32>
+       <SETG PS?DIRECTION 16>
+       <SETG PS?PREPOSITION 8>
+       <SETG PS?BUZZ-WORD 4>
+       <SETG P1?OBJECT 0>
+       <SETG P1?VERB 1>
+       <SETG P1?ADJECTIVE 2>
+       <SETG P1?DIRECTION 3>>
+
+<DEFINE CRUMP () 
+       <PRINT-TOP>
+       <PRINT-FLAGS>
+       <PRINT-VERBNUMS>
+       <PRINT-SEQ <TOP ,PROPS> "P?">
+       <PRINT-SEQ <TOP ,ADJS> "A?">
+       <PRINT-SEQ <TOP ,BUZZES> "B?">
+       <PRINT-SEQ <TOP ,PREPS> "PR?">
+       <PRINT-SEQ <TOP ,ACTS> "ACT?">
+       <PRINT-VERBS>
+       <PRINT-ACTIONS>
+       <GC 0 T>
+       <PRINT-VOCAB>
+       <PRINT-OBJECTS>
+       <PRINT-PREPS>
+       <GC 0 T>>
+
+;"ZIL Interpreter"
+
+;"For READST"
+
+<FLOAD "TELL.XBIN">                    
+
+<BLOCK (<ROOT>)>
+
+ZO 
+
+<ENDBLOCK>
+
+<SETG ZO <MOBLIST ZO 17>>
+
+<SETG ZOBLS (,INITIAL ,ZO <ROOT>)>
+
+<BLOCK (,ZO)>
+
+BACK
+
+GET 
+
+PUT 
+
+REMOVE 
+
+READ 
+
+RETURN
+
+AGAIN
+
+SAVE
+
+RESTORE
+
+PRINT
+
+PRINTB
+
+APPLY
+
+RANDOM
+
+<ENDBLOCK!- >
+
+<NEWTYPE ZWORD STRING>
+
+<NEWTYPE TABLE VECTOR>
+
+<NEWTYPE OBJECT
+        VECTOR
+        '<<PRIMTYPE VECTOR>
+          ATOM
+          LIST
+          <OR FALSE OBJECT>
+          <OR FALSE OBJECT>
+          <OR FALSE OBJECT>
+          VECTOR>>
+
+<SETG 2BYTES ![TABLE STRING FIX ATOM!]>
+
+<SETG 1BYTE ![OBJECT BYTE ATOM FALSE!]>
+
+<PUT ZOBJECT DECL '<OR <PRIMTYPE VECTOR> ZWORD STRING OBJECT FIX ATOM FALSE>>
+
+<DEFINE ZMODE ()
+       <OR <TYPE? ,ZMODE FUNCTION>
+           <APPLYTYPE FIX ,ZGET>>
+       <OR <==? .OBLIST ,ZOBLS>
+           <BLOCK ,ZOBLS>>
+       T>
+
+<DEFINE MMODE ()
+       <APPLYTYPE FIX ,APPLY>
+       <AND <==? .OBLIST ,ZOBLS>
+            <ENDBLOCK>>
+       T>
+
+<DEFINE OBJECT-PRINT (OBJ "AUX" C V L (OUTCHAN .OUTCHAN))
+       #DECL ((OBJ) OBJECT (C) <OR OBJECT FALSE> (V) VECTOR (L) LIST
+              (OUTCHAN) CHANNEL)
+       <PRINC "#OBJECT [">
+       <PRINC <1 <OBJTBL .OBJ>>>
+       <COND (<OBJLOC .OBJ>
+              <PRINC " in ">
+              <PRINC <OBJNAME <OBJLOC .OBJ>>>)>
+       <COND (<SET C <OBJFIRST .OBJ>>
+              <PRINC " contains ">
+              <PRINC <OBJNAME .C>>
+              <REPEAT ()
+                      <COND (<SET C <OBJNEXT .C>>
+                             <PRINC ", ">
+                             <PRINC <OBJNAME .C>>)
+                            (<RETURN>)>>)>
+       <COND (<NOT <EMPTY? <SET L <OBJBITS .OBJ>>>>
+              <PRINC " flags ">
+              <MAPF <>
+                    <FUNCTION (ATM)
+                              #DECL ((ATM) ATOM)
+                              <PRINC .ATM>
+                              <PRINC " ">>
+                    .L>)
+             (<PRINC " no flags">)>
+       <COND (<NOT <EMPTY? <SET V <2 <OBJTBL .OBJ>>>>>
+              <PRINC " properties ">
+              <REPEAT ()
+                      <COND (<EMPTY? .V> <RETURN>)
+                            (<PRINC <1 .V>>
+                             <PRINC " ">)>
+                      <SET V <REST .V 3>>>)
+             (<PRINC " no properties">)>
+       <PRINC "]">>
+
+<PRINTTYPE OBJECT ,OBJECT-PRINT>
+
+<DEFINE TABLE-PRINT (TBL "AUX" (OUTCHAN .OUTCHAN))
+       #DECL ((TBL) TABLE (OUTCHAN) CHANNEL)
+       <PRINC "#TABLE [">
+       <MAPF <>
+             <FUNCTION (X)
+                       #DECL ((X) <OR ZOBJECT <FALSE ZOBJECT>>)
+                       <COND (.X <PRIN1 .X> <PRINC " ">)
+                             (<PRINC " <?> ">)>>
+             .TBL>
+       <PRINC "]">>
+
+<PRINTTYPE TABLE ,TABLE-PRINT>
+
+<DEFINE ZGET ("TUPLE" ARGS "AUX" (LEN <LENGTH .ARGS>))
+       #DECL ((ARGS) <TUPLE FIX [REST ANY]> (LEN) FIX)
+       <COND (<==? .LEN 2>
+              <GET!-ZO <NTH .ARGS 2> <NTH .ARGS 1>>)
+             (<==? .LEN 3>
+              <PUT!-ZO <NTH .ARGS 2> <NTH .ARGS 1> <NTH .ARGS 3>>)
+             (<ERROR FIX-APPLY-ERROR!-ERRORS .ARGS>)>>
+
+<DEFINE BACK!-ZO (TBL NUM)
+       <COND (<GET .TBL PTSIZE>
+              ,PSEUDO-OBJECT)
+             (T
+              <BACK!- .TBL .NUM>)>>
+
+<DEFINE GET!-ZO (TBL ELEM "AUX" VAL)
+       #DECL ((TBL) <OR FIX <PRIMTYPE VECTOR>> (ELEM) FIX
+              (VAL) <OR ZOBJECT FALSE <FALSE ZOBJECT>>)
+       <COND (<TYPE? .TBL FIX>
+              0)
+             (<OR <SET VAL <NTH .TBL <+ <* .ELEM 2> 1>>>
+                  <EMPTY? .VAL>>
+              .VAL)
+             (<TYPE? <1 .TBL> ZWORD> 0)
+             (<ERROR PACKING-ERROR!-ERRORS GET!-ZO .TBL .ELEM <1 .VAL>>)>>
+
+<DEFINE PUT!-ZO (TBL ELEM VAL "AUX" (LOC <+ <* .ELEM 2> 1>))
+       #DECL ((TBL) <OR <PRIMTYPE VECTOR> FIX> (ELEM LOC) FIX (VAL) ZOBJECT)
+       <COND (<==? .TBL ,PSEUDO-OBJECT>
+              <COND (<TYPE? .VAL ZWORD>
+                     <PUT <OBJTBL .TBL> 1 <CHTYPE .VAL STRING>>)>
+              T)
+             (<TYPE? .TBL FIX>
+              T)
+             (<OR <NTH .TBL .LOC>
+                  <==? <NTH .TBL .LOC> <>>>
+              <PUT .TBL .LOC .VAL>
+              <PUT .TBL <+ .LOC 1> <CHTYPE (.VAL) FALSE>>)
+             (<ERROR PACKING-ERROR!-ERRORS .TBL .ELEM .VAL>)>>
+
+<DEFINE GETB (TBL ELEM "AUX" VAL)
+       #DECL ((TBL) <OR FIX <PRIMTYPE VECTOR>> (ELEM) FIX
+              (VAL) <OR ZOBJECT <FALSE ZOBJECT>>)
+       <COND (<TYPE? .TBL FIX> 0)
+             (<OR <SET VAL <NTH .TBL <+ .ELEM 1>>>
+                  <EMPTY? .VAL>>
+              .VAL)
+             (<ERROR PACKING-ERROR!-ERRORS GETB .TBL .ELEM <1 .VAL>>)>>
+
+<DEFINE PUTB (TBL ELEM VAL)
+       #DECL ((TBL) <PRIMTYPE VECTOR> (ELEM) FIX (VAL) ZOBJECT)
+       <COND (<NOT <MEMQ .VAL ,2BYTES>>
+              <PUT .TBL <+ .ELEM 1> .VAL>)
+             (<ERROR UNPACKING-ERROR!-ERRORS .TBL .ELEM .VAL>)>>
+
+<DEFINE ZERO? (ANY)
+       #DECL ((ANY) <OR ATOM FIX>)
+       <OR <==? .ANY 0> <==? .ANY T>>>
+
+<DEFINE EQUAL? (ANY A "OPTIONAL" (B #LOSE 0) (C #LOSE 0))
+       #DECL ((ANY A) ZOBJECT (B C) <OR LOSE ZOBJECT>)
+       <OR <==? .ANY .A>
+           <==? .ANY .B>
+           <==? .ANY .C>>>
+
+<SETG LESS? ,L?>
+<SETG GRTR? ,G?>
+<SETG ADD ,+>
+<SETG SUB ,->
+<SETG DIV ,/>
+<SETG MUL ,*>
+
+<DEFINE BAND (F1 F2)
+       #DECL ((F1 F2) FIX)
+       <CHTYPE <ANDB .F1 .F2> FIX>>
+
+<DEFINE BOR (F1 F2)
+       #DECL ((F1 F2) FIX)
+       <CHTYPE <ORB .F1 .F2> FIX>>
+
+<DEFINE BCOM (F1)
+       #DECL ((F1) FIX)
+       <CHTYPE <XORB .F1 -1> FIX>>
+
+<DEFINE BTST (F1 F2)
+       #DECL ((F1 F2) FIX)
+       <0? <CHTYPE <ANDB <XORB .F1 -1> .F2> FIX>>>
+
+<DEFINE INC (VAR)
+       #DECL ((VAR) ATOM)
+       <COND (<TYPE? ..VAR FIX>
+              <SET .VAR <+ ..VAR 1>>)
+             (<ERROR ILLEGAL-INCREMENT!-ERRORS .VAR>)>
+       T>
+
+<DEFINE DEC (VAR)
+       #DECL ((VAR) ATOM)
+       <COND (<TYPE? ..VAR FIX>
+              <SET .VAR <- ..VAR 1>>)
+             (<ERROR ILLEGAL-DECREMENT!-ERRORS .VAR>)>
+       T>
+
+<DEFINE IGRTR? (VAR VAL)
+       #DECL ((VAR) ATOM (VAL) FIX)
+       <INC .VAR>
+       <G? ..VAR .VAL>>
+
+<DEFINE DLESS? (VAR VAL)
+       #DECL ((VAR) ATOM (VAL) FIX)
+       <DEC .VAR>
+       <L? ..VAR .VAL>>
+
+<DEFINE IN? (OBJ1 OBJ2)
+       #DECL ((OBJ1 OBJ2) OBJECT)
+       <==? <OBJLOC .OBJ1> .OBJ2>>
+
+<DEFINE LOC (OBJ)
+       #DECL ((OBJ) OBJECT)
+       <OBJLOC .OBJ>>
+
+<DEFINE FIRST? (OBJ)
+       #DECL ((OBJ) OBJECT)
+       <OBJFIRST .OBJ>>
+
+<DEFINE NEXT? (OBJ)
+       #DECL ((OBJ) OBJECT)
+       <OBJNEXT .OBJ>>
+
+<DEFINE FSET? (OBJ FLAG)
+       #DECL ((OBJ) OBJECT (FLAG) FIX)
+       <AND <MEMQ <GET .FLAG FLAGNAME> <OBJBITS .OBJ>> T>>
+
+<DEFINE FSET (OBJ FLAG "AUX" (BITS <OBJBITS .OBJ>) NAME)
+       #DECL ((OBJ) OBJECT (FLAG) FIX (BITS) <LIST [REST ATOM]> (NAME) ATOM)
+       <COND (<MEMQ <SET NAME <GET .FLAG FLAGNAME>> .BITS>)
+             (<PUT .OBJ ,OBJBITS (.NAME !.BITS)>
+              T)>>
+
+<DEFINE FCLEAR (OBJ FLAG "AUX" (BITS <OBJBITS .OBJ>) NAME)
+       #DECL ((OBJ) OBJECT (FLAG) FIX (NAME) ATOM (BITS) <LIST [REST ATOM]>)
+       <COND (<MEMQ <SET NAME <GET .FLAG FLAGNAME>> .BITS>
+              <PUT .OBJ ,OBJBITS <SPLICE-OUT .NAME .BITS>>)>
+       T>
+
+<DEFINE PRINTD (OBJ)
+       #DECL ((OBJ) OBJECT)
+       <PRINTSTRING <1 <OBJTBL .OBJ>>>
+       T>
+
+<DEFINE PRINTN (F)
+       #DECL ((F) FIX)
+       <PRIN1 .F>
+       T>
+
+<DEFINE PRINTC (F)
+       #DECL ((F) FIX)
+       <PRINTSTRING <STRING <ASCII .F>>>
+       T>
+
+<DEFINE PRINTB!-ZO (TBL "AUX" VAL)
+       #DECL ((TBL) TABLE (VAL) <OR ZOBJECT <FALSE ZOBJECT>>)
+       <COND (<TYPE? <SET VAL <NTH .TBL 1>> ZWORD>
+              <LCP <CHTYPE .VAL STRING>>)
+             (<ERROR ILLEGAL-PRINTT!-ERRORS .VAL>)>
+       T>
+
+<DEFINE LCP (STR)
+       #DECL ((STR) STRING)
+       <MAPF <>
+             <FUNCTION (CHR "AUX" (ASC <ASCII .CHR>))
+                       #DECL ((CHR) CHARACTER (ASC) FIX)
+                       <COND (<AND <G=? .ASC <ASCII !\A>>
+                                   <L=? .ASC <ASCII !\Z>>>
+                              <PRINC <ASCII <+ .ASC 32>>>)
+                             (<PRINC .CHR>)>>
+             .STR>>
+
+<DEFINE PRINTI (STR)
+       #DECL ((STR) STRING)
+       <PRINTSTRING .STR>
+       T>
+
+<DEFINE RETURN!-ZO RET ("OPTIONAL" (VAL T))
+       #DECL ((VAL) ZOBJECT (RET) <SPECIAL ACTIVATION>)
+       <COND (<ASSIGNED? LPROG\ !-INTERRUPTS <FRAME .RET>>
+              <RETURN .VAL <LVAL LPROG\ !-INTERRUPTS <FRAME .RET>>>)
+             (<RETURN .VAL .\ ZACT!-ZO>)>>
+
+<DEFINE AGAIN!-ZO RET ()
+       #DECL ((RET) <SPECIAL ACTIVATION>)
+       <COND (<ASSIGNED? LPROG\ !-INTERRUPTS <FRAME .RET>>
+              <AGAIN <LVAL LPROG\ !-INTERRUPTS <FRAME .RET>>>)
+             (<AGAIN .\ ZACT!-ZO>)>>
+
+<DEFINE RTRUE ()
+       <RETURN T .\ ZACT!-ZO>>
+
+<DEFINE RFALSE ()
+       <RETURN <> .\ ZACT!-ZO>>
+
+<DEFINE RESTART ()
+       <GO!-INITIAL!->>
+
+<SETG ZSTACK <IVECTOR 100 0>>
+<GDECL (ZSTACK) VECTOR>
+
+<DEFINE PUSH (ZOB)
+       #DECL ((ZOB) ZOBJECT)
+       <PUT ,ZSTACK 1 .ZOB>
+       <COND (<EMPTY? ,ZSTACK>
+              <ERROR STACK-FULL!-ERRORS PUSH>)
+             (<SETG ZSTACK <REST ,ZSTACK>>)>
+       T>
+
+<DEFINE POP (ATM)
+       #DECL ((ATM) ATOM)
+       <COND (<==? <LENGTH ,ZSTACK> <LENGTH <TOP ,ZSTACK>>>
+              <ERROR STACK-EMPTY!-ERRORS POP>)
+             (T
+              <SETG ZSTACK <BACK ,ZSTACK>>
+              <SET .ATM <1 ,ZSTACK>>
+              T)>>
+
+<DEFINE RSTACK ()
+       <COND (<==? <LENGTH ,ZSTACK> <LENGTH <TOP ,ZSTACK>>>
+              <ERROR STACK-EMPTY!-ERRORS RSTACK>)
+             (T
+              <SETG ZSTACK <BACK ,ZSTACK>>
+              <RETURN <1 ,ZSTACK> .\ ZACT!-ZO>)>>
+
+<DEFINE FSTACK ()
+       <COND (<==? <LENGTH ,ZSTACK> <LENGTH <TOP ,ZSTACK>>>
+              <ERROR STACK-EMPTY!-ERRORS POP>)
+             (T
+              <SETG ZSTACK <BACK ,ZSTACK>>
+              T)>>
+
+<DEFINE JUMP ()
+       <ERROR NOT-IMPLEMENTED!-ERRORS JUMP>>
+
+<DEFINE SAVE!-ZO ()
+       <ERROR NOT-IMPLEMENTED!-ERRORS SAVE>>
+
+<DEFINE RESTORE!-ZO ()
+       <ERROR NOT-IMPLEMENTED!-ERRORS RESTORE>>
+
+<DEFINE PRINT!-ZO (STR)
+       #DECL ((STR) STRING)
+       <PRINTSTRING .STR>>
+
+<DEFINE APPLY!-ZO (FCN "TUPLE" T)
+       #DECL ((FCN) <OR FALSE FIX ATOM> (T) TUPLE)
+       <COND (<AND .FCN <N==? .FCN 0>>
+              <APPLY ,.FCN !.T>)>>
+
+<SETG CALL ,APPLY!-ZO>
+
+<DEFINE RANDOM!-ZO (NUM)
+       #DECL ((NUM) FIX)
+       <+ <MOD <RANDOM> .NUM> 1>>
+
+<DEFINE NOOP ()
+       T> 
+
+<DEFINE GETP (OBJ PNUM "AUX" M PROP)
+       #DECL ((OBJ) OBJECT (PNUM) FIX (PROP) ATOM
+              (M) <OR FALSE <VECTOR ATOM FIX TABLE [REST ANY]>>)
+       <SET PROP <NTH <TOP ,PROPS> .PNUM>>
+       <COND (<SET M <MEMQ .PROP <2 <OBJTBL .OBJ>>>>
+              <COND (<L=? <2 .M> 2>
+                     <NTH <3 .M> 1>)
+                    (<ERROR ILLEGAL-GETP!-ERRORS .OBJ .PROP <3 .M>>)>)
+             (<GET .PROP DEFAULT>)>>
+
+<DEFINE GETPT (OBJ PNUM "AUX" M PROP)
+       #DECL ((OBJ) OBJECT (PNUM) FIX (PROP) ATOM
+              (M) <OR FALSE <VECTOR ATOM FIX TABLE [REST ANY]>>)
+       <SET PROP <NTH <TOP ,PROPS> .PNUM>>
+       <COND (<SET M <MEMQ .PROP <2 <OBJTBL .OBJ>>>>
+              <PUT <3 .M> PTSIZE <2 .M>>
+              <3 .M>)
+             (<GET .PROP DEFAULT>)>>
+
+<DEFINE PTSIZE (TBL)
+       #DECL ((TBL) TABLE)
+       <COND (<GET .TBL PTSIZE>)
+             (<ERROR NOT-A-PROPERTY-TABLE!-ERRORS .TBL>)>>
+
+<DEFINE NEXTP (OBJ PNUM "AUX" PROP (PROPS <2 <OBJTBL .OBJ>>) M) 
+       #DECL ((OBJ) OBJECT (VALUE PNUM) FIX (PROP) ATOM
+              (PROPS) <VECTOR [REST ATOM FIX TABLE]>
+              (M) <OR FALSE <VECTOR ATOM FIX TABLE [REST ATOM ANY]>>)
+       <COND (<EMPTY? .PROPS> 0)
+             (T
+              <COND (<0? .PNUM> <SET PROP <1 .PROPS>>)
+                    (<SET PROP <NTH <TOP ,PROPS> .PNUM>>)>
+              <COND (<SET M <MEMQ .PROP .PROPS>>
+                     <COND (<LENGTH? .M 3> 0) (<POS <4 .M> <TOP ,PROPS>>)>)
+                    (<ERROR NOT-A-PROPERTY .PROP .OBJ NEXTP>)>)>>
+<DEFINE PUTP (OBJ PNUM VAL "AUX" M PROP)
+       #DECL ((OBJ) OBJECT (PROP) ATOM (VAL) ZOBJECT (PNUM) FIX
+              (M) <OR FALSE <VECTOR ATOM FIX TABLE [REST ANY]>>)
+       <SET PROP <NTH <TOP ,PROPS> .PNUM>>
+       <COND (<SET M <MEMQ .PROP <2 <OBJTBL .OBJ>>>>
+              <COND (<OR <AND <==? <2 .M> 1>
+                              <MEMQ <TYPE .VAL> ,1BYTE>>
+                         <AND <==? <2 .M> 2>
+                              <MEMQ <TYPE .VAL> ,2BYTES>>
+                         <AND <==? <2 .M> 1>
+                              <TYPE? .VAL FIX>
+                              <L? .VAL 256>
+                              <G=? .VAL 0>>> 
+                     <PUT <3 .M> 1 .VAL>)
+                    (<ERROR ILLEGAL-PUTP!-ERRORS .OBJ .PROP .VAL>)>)
+             (<ERROR UNDEFINED-PROPERTY!-ERRORS PUTP .PROP>)>>
+
+<DEFINE MOVE (OBJ1 OBJ2)
+       #DECL ((OBJ1 OBJ2) OBJECT)
+       <REMOVE!-ZO .OBJ1>
+       <PUT .OBJ1 ,OBJLOC .OBJ2>
+       <PUT .OBJ1 ,OBJNEXT <OBJFIRST .OBJ2>>
+       <PUT .OBJ2 ,OBJFIRST .OBJ1>
+       T>
+
+<DEFINE REMOVE!-ZO (OBJ "AUX" CNT C)
+       #DECL ((OBJ) OBJECT (CNT C) <OR FALSE OBJECT>)
+       <COND (<SET CNT <OBJLOC .OBJ>>
+              <COND (<==? <SET C <OBJFIRST .CNT>> .OBJ>
+                     <PUT .CNT ,OBJFIRST <OBJNEXT .OBJ>>)
+                    (T
+                     <REPEAT ()
+                             <COND (<==? <OBJNEXT .C> .OBJ>
+                                    <PUT .C ,OBJNEXT <OBJNEXT .OBJ>>
+                                    <RETURN>)>
+                             <SET C <OBJNEXT .C>>>)>
+              <PUT .OBJ ,OBJLOC <>>)>
+       T>
+
+<SETG ZINBUF <ISTRING 200>>
+<SETG ZRWORD <REST <ISTRING 6> 6>>
+<SETG SIBREAKS "">
+<SETG WBREAKS <STRING ".,?"
+                     <ASCII 32>
+                     <ASCII 0>
+                     <ASCII 9>
+                     <ASCII 13>
+                     <ASCII 12>
+                     <ASCII 27>
+                     ,SIBREAKS>>
+
+<GDECL (ZINBUF SIBREAKS WBREAKS ZRWORD) STRING>
+
+<SETG SCRIPT-CHANNEL <>>
+
+<DEFINE UPPERCASE (STR LEN)
+       #DECL ((STR) STRING (LEN) FIX)
+       <MAPR <>
+             <FUNCTION (S "AUX" (CHR <ASCII <1 .S>>))
+                       #DECL ((S) STRING (CHR) FIX)
+                       <COND (<L? <SET LEN <- .LEN 1>> 0>
+                              <MAPLEAVE>)>
+                       <COND (<AND <G=? .CHR <ASCII !\a>>
+                                   <L=? .CHR <ASCII !\z>>>
+                              <PUT .S 1 <ASCII <- .CHR 32>>>)>>
+             .STR>>
+
+<DEFINE READ!-ZO (BUF LEXV "AUX" (INS ,ZINBUF) (VOCAB ,VOCABULARY) LEN) 
+   #DECL ((BUF LEXV) <PRIMTYPE VECTOR> (INS) STRING (VOCAB) OBLIST (LEN) FIX)
+   <SET BUF <REST .BUF>>
+   <SET LEXV <REST .LEXV 2>>
+   <SET LEN <READST .INS "" <>>>
+   <UPPERCASE .INS .LEN>
+   <REPEAT (CHR ASC (INWORD <>) WRD (WLEN 0) (NWRDS 0) WPTR ATM)
+     #DECL ((CHR) CHARACTER (INWORD ATM) <OR ATOM FALSE> (WRD WPTR) STRING
+           (WLEN NWRDS ASC) FIX)
+     <COND (<L? <SET LEN <- .LEN 1>> 0> <SET CHR <ASCII 0>>)
+          (T <SET CHR <1 .INS>>)>
+     <SET ASC <ASCII .CHR>>
+     <PUT .BUF
+         1
+         <COND (<AND <G=? .ASC <ASCII !\A>> <L=? .ASC <ASCII !\Z>>>
+                <+ .ASC 32>)
+               (.ASC)>>
+     <SET BUF <REST .BUF>>
+     <COND (<MEMQ .CHR ,WBREAKS>
+           <COND (<AND <NOT .INWORD> <NOT <MEMQ .CHR ,SIBREAKS>>>)
+                 (T
+                  <SET WRD
+                       <SUBSTRUC .WPTR
+                                 0
+                                 <MIN 6 .WLEN>
+                                 <BACK ,ZRWORD <MIN 6 .WLEN>>>>
+                  <PROG ()
+                        <COND (.INWORD
+                               <COND (<SET ATM <LOOKUP .WRD .VOCAB>>
+                                      <PUT .LEXV 1 ,.ATM>
+                                      <PUT .LEXV 2 <CHTYPE (,.ATM) FALSE>>)
+                                     (T
+                                      <PUT .LEXV 1 <>>
+                                      <PUT .LEXV 2 <CHTYPE (<>) FALSE>>)>
+                               <PUT .LEXV 3 .WLEN>
+                               <PUT .LEXV
+                                    4
+                                    <- <LENGTH <TOP .INS>> <LENGTH .WPTR> -1>>
+                               <SET LEXV <REST .LEXV 4>>
+                               <SET NWRDS <+ .NWRDS 1>>
+                               <SET WLEN 0>
+                               <SET INWORD <>>)>
+                        <COND (<MEMQ .CHR ,SIBREAKS>
+                               <SET WRD <STRING .CHR>>
+                               <OR <==? .LEXV <REST <TOP .LEXV> 2>>
+                                   <==? <1 <BACK .LEXV 4>>
+                                        ,<LOOKUP .WRD .VOCAB>>
+                                   <AND <SET INWORD T> <AGAIN>>>)>>)>
+           <COND (<==? .CHR <ASCII 0>> <PUT <TOP .LEXV> 2 .NWRDS> <RETURN>)>)
+          (T
+           <COND (<NOT .INWORD> <SET WPTR .INS> <SET INWORD T>)>
+           <SET WLEN <+ .WLEN 1>>)>
+     <SET INS <REST .INS>>>>
+
+<DEFINE SPLICE-OUT (OBJ AL) 
+       #DECL ((AL) LIST (OBJ) ANY)
+       <COND (<==? <1 .AL> .OBJ> <REST .AL>)
+             (T
+              <REPEAT ((NL <REST .AL>) (OL .AL))
+                      #DECL ((NL) LIST (OL) <LIST ANY>)
+                      <COND (<==? <1 .NL> .OBJ>
+                             <PUTREST .OL <REST .NL>>
+                             <RETURN .AL>)
+                            (<SET OL .NL> <SET NL <REST .NL>>)>>)>>
+
+<DEFINE ZLOAD (STR)
+       #DECL ((STR) STRING)
+       <ZFLOAD .STR>
+       <CRUMP>
+       "DONE">
+
+<DEFINE ZDUMP (ATM)
+       #DECL ((ATM) ATOM)
+       <GROUP-DUMP <STRING <SPNAME .ATM> ".ZIL"> .ATM>>
+
+<DEFINE ZIL ()
+       <ZMODE>
+       <GO!-INITIAL!->>
+
+<DEFINE ZFLOAD (STR "OPTIONAL" (FLOAD? <>))
+    #DECL ((STR) STRING (FLOAD?) <OR ATOM FALSE>)
+    <PRINC "Loading ">
+    <PRINC .STR>
+    <PRINC ".ZIL">
+    <COND (.FLOAD? <PRINC " (FLOAD)">)>
+    <CRLF>
+    <BLOCK ,ZOBLS>
+    <COND (.FLOAD? <FLOAD <STRING .STR ".ZIL">>)
+         (T <GROUP-LOAD <STRING .STR ".ZIL">>)>
+    <ENDBLOCK>
+    T>
+
+<DEFINE ZILSAVE ("AUX" FOO)
+       #DECL ((FOO) ATOM)
+       <COND (<SAVE "ZIL">
+              <PRINC "Load: ">
+              <SET FOO <READ>>
+              <CRLF>
+              <ZLOAD <UNPARSE .FOO>>
+              <PRINC "Go: ">
+              <COND (<MEMQ <TYI> "TtYy">
+                     <ZIL>)>)>>
+
+<SETG COMPERR ,ERROR>
+
diff --git a/zork.z/zilch.mud.188 b/zork.z/zilch.mud.188
new file mode 100644 (file)
index 0000000..0be0b2a
--- /dev/null
@@ -0,0 +1,2708 @@
+
+"ZIL Compiler"
+
+<USE "ZSTR">
+
+<DEFINE MSETG (ATM VAL) <SETG .ATM .VAL> <MANIFEST .ATM>>
+
+<SETG STR3 <ISTRING 3>>
+
+<SETG STRCNT 0>
+
+<SETG STRS <IVECTOR 1000 "">>
+
+<SETG TBLCNT 0>
+
+<SETG TBLS <IUVECTOR 250 ()>>
+
+<GDECL (TBLCNT STRCNT)
+       FIX
+       (TBLS)
+       <UVECTOR [REST LIST]>
+       (STRS)
+       <VECTOR [REST STRING]>>
+
+;"***************** OFFSETS INTO 'OBJECTS' ******************"
+
+<MSETG OLOC 1>
+
+<MSETG OFIRST 2>
+
+<MSETG ONEXT 3>
+
+<MSETG ODESC 4>
+
+<MSETG OBIT0-15 5>
+
+<MSETG OBIT16-31 6>
+
+<MSETG OPROP 7>
+
+;"*********************** OBJECT BIT CONSTANTS *****************"
+
+<SETG BITBYTE ,OBIT16-31>
+
+<SETG HIBIT 32>
+
+<SETG HIVAL 0>
+
+<GDECL (BITBYTE HIBIT HIVAL) FIX>
+
+<MSETG BWORD 1>
+
+<MSETG BVAL 2>
+
+<MSETG BNUM 3>
+
+;"******************** VOCABULARY WORD OFFSETS *******************"
+
+<MSETG WTYPES 1>
+
+<MSETG WVAL1 2>
+
+<MSETG WVAL2 3>
+
+<MSETG WSYM 4>
+
+;"******************* VALUES FOR THE WTYPE SLOT ******************"
+
+<SETG TOBJECT ![128 0!]>
+
+<SETG TVERB ![64 1!]>
+
+<SETG TADJ ![32 2!]>
+
+<SETG TDIR ![16 3!]>
+
+<SETG TPREP ![8 0!]>
+
+<SETG TBUZZ ![4 0!]>
+
+<GDECL (TOBJECT TVERB TADJ TDIR TPREP TBUZZ)
+       <UVECTOR FIX FIX>
+       (WTYPETBL)
+       <UVECTOR [REST ATOM]>>
+
+<SETG WTYPETBL ![OBJECT VERB ADJECTIVE DIRECTION PREPOSITION BUZZ-WORD!]>
+
+;"******************** PARTS OF SPEECH TABLES **********************"
+
+<SETG PROPS <REST <IUVECTOR 31 T> 30>>
+
+<SETG ADJS <REST <IUVECTOR 255 T> 254>>
+
+<SETG PREPS <REST <IUVECTOR 255 T> 254>>
+
+<SETG ACTIONS <REST <IUVECTOR 255 T> 254>>
+
+<SETG BUZZES <REST <IUVECTOR 255 T> 254>>
+
+<SETG ACTS <REST <IUVECTOR 255 T> 254>>
+
+<SETG DIRS <REST <IUVECTOR 255 T> 254>>
+
+<SETG VERBS <REST <IUVECTOR 255 T> 254>>
+
+<SETG PROPDEFS <IVECTOR 31 0>>
+
+<GDECL (PROPS ADJS BUZZES VERBS ACTIONS PREPS)
+       <UVECTOR [REST ATOM]>
+       (PROPDEFS)
+       <VECTOR [REST <OR FIX ATOM>]>>
+
+;"******************** VARIOUS CONSTANTS AND TABLES ***************"
+
+<SETG INSERTS ()>
+
+<SETG LEVEL 0>
+
+<SETG INDENTS '["" ">" ">>" ">>>" ">>>>"]>
+
+<GDECL (INSERTS) LIST (LEVEL) FIX (INDENTS) <VECTOR [REST STRING]>>
+
+;"************************* OBLIST DEFINITIONS ********************"
+
+<SETG OBJECTS <MOBLIST OBJECTS 17>>
+
+<SETG FLAGS <MOBLIST FLAGS 17>>
+
+<SETG VERBOBL <MOBLIST VERBOBL 17>>
+
+<SETG VARS <MOBLIST VARS 17>>
+
+<SETG CONST <MOBLIST CONST 17>>
+
+<SETG UCONST <MOBLIST UCONST 17>>
+
+<SETG WORDS <MOBLIST WORDS 17>>
+
+<SETG CNV <MOBLIST CNV 17>>
+
+<SETG OPS <MOBLIST OPS 17>>
+
+<GDECL (OBJECTS FLAGS VARS CONST UCONST WORDS CNV OPS VERBOBL) OBLIST>
+
+;"************************* ZILCH PSEUDO OPERATIONS ******************"
+
+<DEFINE ID (NUM)
+       #DECL ((NUM) FIX)
+       <SETG ZORK-ID .NUM>>
+
+<DEFINE ENDLOAD ()
+       <SETG ENDLOADFLG T>
+       <PRINC "
+ENDLOD::
+" .ZCHN>>
+
+;"PROPDEF - Set property defaults"
+
+<DEFINE PROPDEF (NAME VAL)
+       #DECL ((NAME) ATOM (VAL) <OR ATOM FIX>)
+       <PUT ,PROPDEFS <ADD-SEQ <PARSE <STRING "P?" <SPNAME .NAME>>>
+                               PROPS> .VAL>>
+
+;"ITABLE - Create a long empty table"
+
+<DEFINE ITABLE (LEN? LEN "OPTIONAL" (FILL 0) "AUX" L)
+       #DECL ((LEN?) ATOM (LEN FILL) FIX (L) <LIST [REST FIX]>)
+       <SET L <ILIST .LEN .FILL>>
+       <COND (<==? .LEN? WORD>
+              <PUT .L 1 .LEN>)
+             (<==? .LEN? BYTE>
+              <PUT .L 1 <* 256 .LEN>>)>
+       <NXTTBL .L>>
+
+;"TABLE - Create arbitrary tables"
+
+<DEFINE LTABLE ("TUPLE" ELEM)
+       #DECL ((ELEM) TUPLE)
+       <TABLE <LENGTH .ELEM> !.ELEM>>
+
+<DEFINE TABLE ("TUPLE" ELEM "AUX" L)
+       #DECL ((ELEM) TUPLE (L) LIST)
+       <SET L <MAPF ,LIST ,ZEVAL .ELEM>> <NXTTBL .L>>
+
+;"DIRECTIONS - Create direction properties"
+
+<DEFINE DIRECTIONS ("TUPLE" NAMES)
+       #DECL ((NAMES) <TUPLE [REST ATOM]>)
+       <MAPF <>
+             <FUNCTION (NAME)
+                       #DECL ((NAME) ATOM)
+                       <ADD-SEQ <PARSE <STRING "P?" <SPNAME .NAME>>> PROPS>>
+             .NAMES>
+       <GLOBAL LOW-DIRECTION
+               <POS <PARSE <STRING "P?"
+                                   <SPNAME <NTH .NAMES <LENGTH .NAMES>>>>>
+                    <TOP ,PROPS>>>>
+
+;" SYNTAX - Create syntax tables for the parser"
+
+<DEFINE SYNTAX ("TUPLE" ARGS
+               "AUX" ANY VERB (ACT <>) ATM (PREP 0) (POS 0) (SLOTS ,SLOTS)
+                     SLOT L (PREACT 0))
+   #DECL ((ARGS) TUPLE (ANY) ANY (VERB) ATOM (ACT ATM) <OR FALSE ATOM>
+         (POS PREP) FIX (SLOT) <UVECTOR [3 FIX]> (L) <LIST [REST VECTOR]>
+         (SLOTS) <UVECTOR [REST <UVECTOR [3 FIX]>]>)
+   <MAPR <> <FUNCTION (X) #DECL ((X) UVECTOR) <PUT .X 1 0>> <1 .SLOTS>>
+   <MAPR <> <FUNCTION (X) #DECL ((X) UVECTOR) <PUT .X 1 0>> <2 .SLOTS>>
+   <COND
+    (<EMPTY? .ARGS> <COMPERR TOO-FEW-ARGUMENTS!-ERRORS SYNTAX>)
+    (<TYPE? <SET ANY <1 .ARGS>> ATOM>
+     <SET VERB <1 .ARGS>>
+     <MAPR <>
+      <FUNCTION (TUP "AUX" (ITM <1 .TUP>)) 
+             #DECL ((ITM) ANY)
+             <COND (<==? .ITM OBJECT>
+                    <COND (<G? <SET POS <+ .POS 1>> 2>
+                           <COMPERR TOO-MANY-OBJECTS!-ERRORS SYNTAX>)>
+                    <SET SLOT <NTH .SLOTS .POS>>
+                    <PUT .SLOT 1 .PREP>
+                    <SET PREP 0>)
+                   (<==? .ITM =>
+                    <COND (<OR <LENGTH? .TUP 1> <NOT <TYPE? <2 .TUP> ATOM>>>
+                           <COMPERR BAD-SYNTAX!-ERRORS SYNTAX>)
+                          (T
+                           <SET ACT <2 .TUP>>
+                           <OR <LENGTH? .TUP 2>
+                               <SET PREACT <3 .TUP>>>
+                           <MAPLEAVE>)>)
+                   (<TYPE? .ITM ATOM>
+                    <SET PREP <ADD-SEQ .ITM PREPS>>
+                    <ADD-WORD .ITM TPREP .PREP T>)
+                   (<AND <TYPE? .ITM LIST>
+                         <NOT <EMPTY? .ITM>>
+                         <TYPE? <SET ANY <1 .ITM>> ATOM>>
+                    <COND (<==? .ANY FIND>
+                           <AND <OR <LENGTH? .ITM 1>
+                                    <NOT <TYPE? <2 .ITM> ATOM>>>
+                                <COMPERR BAD-SYNTAX!-ERRORS SYNTAX>>
+                           <BITADD ,PHONYBIT <SET ATM <2 .ITM>>>
+                           <PUT .SLOT 2 <3 ,<LOOKUP <SPNAME .ATM> ,FLAGS>>>)
+                          (<SBITS .ITM .SLOT>)>)
+                   (<ERROR BAD-SYNTAX!-ERRORS SYNTAX>)>>
+      <REST .ARGS>>
+     <COND
+      (.ACT
+       <SET L
+           <COND (<SET ATM <LOOKUP <SPNAME .VERB> ,VERBOBL>> ,.ATM)
+                 (<SET ATM <INSERT <SPNAME .VERB> ,VERBOBL>> ())>>
+       <SETG .ATM
+       ([.POS
+         <1 <1 .SLOTS>>
+         <1 <2 .SLOTS>>
+         <2 <1 .SLOTS>>
+         <2 <2 .SLOTS>>
+         <3 <1 .SLOTS>>
+         <3 <2 .SLOTS>>
+         <- <GET-ACTION .ACT .PREACT> 2>]
+        !.L)>)
+      (<COMPERR NO-ACTION-SPECIFIED!-ERRORS SYNTAX>)>)
+    (<COMPERR NON-ATOMIC-VERB!-ERRORS SYNTAX .VERB>)>>
+
+;"CONSTANT - Set up arbitrary constants"
+
+<DEFINE CONSTANT (VAR VAL)
+       #DECL ((VAR) ATOM (VAL) ANY)
+       <SETG <OR <LOOKUP <SPNAME .VAR> ,UCONST>
+                 <INSERT <SPNAME .VAR> ,UCONST>>
+             <ZEVAL .VAL>>>
+
+;"GLOBAL - Set a global variable (at top level)"
+
+<DEFINE GLOBAL (VAR VAL) 
+       #DECL ((VAR) ATOM (VAL) ANY)
+       <REMOVE <SPNAME .VAR> ,UCONST>
+       <SETG <OR <LOOKUP <SPNAME .VAR> ,VARS> <INSERT <SPNAME .VAR> ,VARS>>
+             <ZEVAL .VAL>>>
+
+<DEFINE INSERT-CRUFTY (NAME)
+       #DECL ((NAME) STRING)
+       <PRINC "
+       .INSERT \"" .ZCHN>
+       <PRINC .NAME .ZCHN>
+       <PRINC "\"
+
+" .ZCHN>>
+
+;"INSERT-FILE - Start compiling from an insert file"
+
+<DEFINE INSERT-FILE (NAME "OPTIONAL" X) 
+       #DECL ((NAME) STRING)
+       <PRINC "
+       .INSERT \"" .ZCHN>
+       <PRINC .NAME .ZCHN>
+       <PRINC "\"
+
+" .ZCHN>
+       <SETG LEVEL <+ ,LEVEL 1>>
+       <ZILCH .NAME <COND (<==? .RECCHN ,OUTCHAN> <>) (.RECCHN)>>>
+
+;"BUZZ - Create a buzz-word"
+
+<DEFINE BUZZ ("TUPLE" WRDS) 
+       #DECL ((WRDS) <TUPLE [REST ATOM]>)
+       <MAPF <>
+             <FUNCTION (WRD) 
+                     #DECL ((WRD) ATOM)
+                     <ADD-WORD .WRD TBUZZ <ADD-SEQ .WRD BUZZES "B?"> T>>
+             .WRDS>>
+
+;"SYNONYM - Create synonyms for a given vocabulary word"
+
+<SETG SYNLIST ()>
+
+<GDECL (SYNLIST) <LIST [REST FORM]>>
+
+<DEFINE SYNONYM ("CALL" FOO)
+       <SETG SYNLIST (<PUT .FOO 1 OSYNONYM> !,SYNLIST)>>
+
+<DEFINE OSYNONYM (WRD "TUPLE" SYNS "AUX" WRDVAL ATM) 
+       #DECL ((WRD) ATOM (SYNS) <TUPLE [REST ATOM]> (WRDVAL) VECTOR
+              (ATM) <OR FALSE ATOM>)
+        <COND (<SET ATM <LOOKUP <SPNAME .WRD> ,WORDS>> <SET WRDVAL ,.ATM>)
+             (<COMPERR DOES-NOT-EXIST!-ERRORS SYNONYM .WRD>)>
+       <MAPF <>
+             <FUNCTION (WRD) 
+                     #DECL ((WRD) ATOM)
+                     <SETG <GET-ATOM .WRD ,WORDS> .WRDVAL>>
+             .SYNS>>
+
+;"OBJECT - Create an 'object'"
+
+<DEFINE OBJECT (NAME
+               "TUPLE" DECLS
+               "AUX" (L ()) (MEVEC <ADD-OBJ .NAME>) VEC CONT V)
+   #DECL ((NAME CONT) ATOM (DECLS) <TUPLE [REST LIST]> (L) LIST (FLAGS) FIX
+         (MEVEC VEC) <VECTOR <OR ATOM FIX> <OR ATOM FIX>> (V) VECTOR)
+   <REMOVE <SPNAME .NAME> ,UCONST>
+   <MAPF <>
+    <FUNCTION (DECL "AUX" (TYPE <1 .DECL>)) 
+           <COND
+            (<==? .TYPE FLAGS>
+             <MAPF <>
+                   <FUNCTION (BITNAME) <BITADD .MEVEC .BITNAME>>
+                   <REST .DECL>>)
+            (<==? .TYPE DESC> <PUT .MEVEC ,ODESC <2 .DECL>>)
+            (<==? .TYPE GLOBAL>
+             <SET L
+                  (<ADD-SEQ P?GLOBAL PROPS>
+                   ("
+       .PROP "
+                    <- <LENGTH .DECL> 1>
+                    ",P?GLOBAL"
+                    !<MAPF ,LIST
+                           <FUNCTION (WRD)
+                                   #DECL ((WRD) ATOM)
+                                   <ADD-OBJ .WRD>
+                                   <MAPRET "
+       .BYTE " <SPNAME .WRD>>>
+                           <REST .DECL>>)
+                   !.L)>)
+            (<==? .TYPE SYNONYM>
+             <AND <G? <LENGTH .DECL> 5>
+                  <COMPERR TOO-MANY-SYNONYMS!-ERRORS .NAME>>
+             <SET L
+                  (<ADD-SEQ P?SYNONYM PROPS>
+                   ("
+       .PROP "
+                    <* 2 <LENGTH <REST .DECL>>>
+                    ",P?SYNONYM"
+                    !<MAPF ,LIST
+                           <FUNCTION (WRD) 
+                                   #DECL ((WRD) ATOM)
+                                   <ADD-WORD .WRD TOBJECT "O?ANY" T>
+                                   <MAPRET "
+       W?" <SPNAME .WRD>>>
+                           <REST .DECL>>)
+                   !.L)>)
+            (<==? .TYPE ADJECTIVE>
+             <AND <G? <LENGTH .DECL> 9>
+                  <COMPERR TOO-MANY-ADJECTIVES!-ERRORS .NAME>>
+             <SET L
+                  (<ADD-SEQ P?ADJECTIVE PROPS>
+                   ("
+       .PROP "
+                    <LENGTH <REST .DECL>>
+                    ",P?ADJECTIVE"
+                    !<MAPF ,LIST
+                           <FUNCTION (WRD) 
+                                   #DECL ((WRD) ATOM)
+                                   <ADD-WORD .WRD
+                                             TADJ
+                                             <ADD-SEQ .WRD ADJS "A?">>
+                                   <MAPRET "
+       .BYTE A?" <SPNAME .WRD>>>
+                           <REST .DECL>>)
+                   !.L)>)
+            (<==? .TYPE PSEUDO>
+             <SET L
+                  (<ADD-SEQ P?PSEUDO PROPS>
+                   ("
+       .PROP "
+                    <* 2 <LENGTH <REST .DECL>>>
+                    ",P?PSEUDO"
+                    !<MAPF ,LIST
+                           <FUNCTION (WRD) 
+                                   #DECL ((WRD) <OR STRING ATOM>)
+                                   <COND (<TYPE? .WRD STRING>
+                                          <ADD-WORD <PARSE .WRD>
+                                                    TOBJECT "O?ANY" T>
+                                          <MAPRET "
+       W?" .WRD>)
+                                         (<MAPRET "
+       " .WRD>)>>
+                           <REST .DECL>>)
+                   !.L)>)
+            (<AND <==? .TYPE IN>
+                  <N==? <2 .DECL> TO>>
+             <SET CONT <2 .DECL>>
+             <PUT .MEVEC ,OLOC .CONT>
+             <SET VEC <ADD-OBJ .CONT>>
+             <COND (<==? <OFIRST .VEC> 0> <PUT .VEC ,OFIRST .NAME>)
+                   (<SET VEC <ADD-OBJ <OFIRST .VEC>>>
+                    <PUT .MEVEC ,ONEXT <ONEXT .VEC>>
+                    <PUT .VEC ,ONEXT .NAME>)>)
+            (<SET L (<ADD-SEQ <PARSE <STRING "P?" <SPNAME .TYPE>>> PROPS>
+                     <ZPROP <REST .DECL> .TYPE .NAME> !.L)>)>>
+    .DECLS>
+   <SET V <VECTOR !.L>>
+   <SORT ,L? .V 2>
+   <PUT .MEVEC ,OPROP .V>
+   T>
+
+<SETG ROOM ,OBJECT>
+
+;"******************** FORMAT UTILITIES ********************"
+
+<DEFINE POS (ATM UVEC "AUX" M) 
+       #DECL ((ATM) ATOM (UVEC) <UVECTOR [REST ATOM]>
+              (M) <OR FALSE <UVECTOR [REST ATOM]>>)
+       <COND (<SET M <MEMQ .ATM .UVEC>> <- <LENGTH .UVEC> <LENGTH .M> -1>)>>
+
+<DEFINE TBLSTR? (ITEM "AUX" (STR ,STR3)) 
+       #DECL ((ITEM) ANY (STR) STRING)
+       <AND <TYPE? .ITEM STRING>
+            <NOT <LENGTH? .ITEM 2>>
+            <SET STR <SUBSTRUC .ITEM 0 3 .STR>>
+            <MEMBER "T?" .STR>>>
+
+<DEFINE ZPROP (LST PROP NAME "AUX" (ITEM <1 .LST>) (LEN <LENGTH .LST>) RM OBJ/FLG) 
+   #DECL ((LST) LIST (ITEM) ANY (LEN) FIX (PROP RM OBJ/FLG) ATOM)
+   <COND
+    (<TBLSTR? .ITEM>
+     <LIST "
+       .PROP 2,P?" .PROP "                     ; STRING PROPERTY
+       " .ITEM>)
+    (<TYPE? .ITEM STRING>
+     <LIST "
+       .PROP 2,P?" .PROP "                     ; STRING PROPERTY
+       " <NXTSTR .ITEM>>)
+    (<TYPE? .ITEM FIX>
+     <LIST "
+       .PROP 2,P?" .PROP "                     ; INTEGER/CONSTANT PROPERTY
+
+       " .ITEM>)
+    (<AND <==? .ITEM PER> <==? .LEN 2>>
+     <ADD-DIR .PROP>
+     <LIST "
+       .PROP 3,P?" .PROP "                     ; FUNCTION EXIT
+       .WORD " <2 .LST> "
+       .BYTE 0">)
+    (<AND <=? .ITEM TO> <NOT <LENGTH? .LST 1>>>
+     <ADD-DIR .PROP>
+     <SET RM <2 .LST>>
+     <COND
+      (<LENGTH? .LST 2>
+       <LIST "
+       .PROP 1,P?" .PROP "                     ; UNCONDITIONAL EXIT
+       .BYTE " .RM>)
+      (<N==? <3 .LST> IF>
+       <COMPERR BAD-SYNTAX-IN-PROPERTY-DEFINITION!-ERRORS .NAME .PROP>)
+      (<NOT <LENGTH? .LST 3>>
+       <SET OBJ/FLG <4 .LST>>
+       <COND
+       (<AND <G=? .LEN 6> <==? <5 .LST> IS> <==? <6 .LST> OPEN>>
+        <LIST "
+       .PROP 5,P?"
+              .PROP
+              "                        ; DOOR EXIT
+       .BYTE "
+              .RM
+              "                                ; ROOM NAME
+       .BYTE "
+              .OBJ/FLG
+              "                        ; DOOR NAME"
+              <COND (<AND <==? .LEN 8> <==? <7 .LST> ELSE>>
+                     <STRING "
+       " <NXTSTR <8 .LST>>>)
+                    ("
+       .WORD 0")>
+              "
+       .BYTE 0                         ; STRING TO PRINT">)
+       (<LIST "
+       .PROP 4,P?"
+              .PROP
+              "                        ; CONDITIONAL EXIT
+       .BYTE "
+              .RM
+              "                                ; ROOM NAME
+       .BYTE "
+              .OBJ/FLG
+              "                                ; FLAG NAME"
+              <COND (<AND <==? .LEN 6>
+                          <==? <5 .LST> ELSE>
+                          <TYPE? <6 .LST> STRING>>
+                     <STRING "
+       " <NXTSTR <6 .LST>> "                   ; STRING">)
+                    (<==? .LEN 4> "
+       0                       ; NO STRING")
+                    (T
+                     <COMPERR BAD-SYNTAX-IN-PROPERTY-DEFINITION!-ERRORS
+                              .NAME
+                              .PROP>)>>)>)
+      (T
+       <COMPERR BAD-SYNTAX-IN-OBJECT-DEFINITION!-ERRORS
+               .NAME
+               .PROP>)>)
+    (<TYPE? .ITEM ATOM>
+     <LIST "
+       .PROP 2,P?" .PROP "                     ; ATOM (CONSTANT) PROPERTY
+
+       " .ITEM>)>>
+
+<DEFINE ADD-DIR (NAM)
+       #DECL ((NAM) ATOM)
+       <ADD-WORD .NAM
+                 TDIR
+                 <ADD-SEQ <PARSE <STRING "P?" <SPNAME .NAM>>> PROPS>>>
+
+<DEFINE NXTTBL (L) 
+       #DECL ((L) LIST)
+       <SETG TBLCNT <+ ,TBLCNT 1>>
+       <PUT ,TBLS 1 .L>
+       <SETG TBLS <REST ,TBLS>>
+       <AND <EMPTY? ,TBLS> <COMPERR TOO-MANY-TABLES!-ERRORS>>
+       <STRING "T?" <UNPARSE ,TBLCNT>>>
+
+<SETG STRBYTES 0>
+<GDECL (STRBYTES) FIX>
+
+<DEFINE NXTSTR (S "AUX" (CNT 1)) 
+       #DECL ((S) STRING (CNT) FIX)
+       <REPEAT ((STRS ,STRS) STR)
+               #DECL ((STRS) <VECTOR [REST STRING]> (STR) STRING)
+               <COND (<EMPTY? <SET STR <1 .STRS>>>
+                      <PUT .STRS 1 .S>
+                      <SETG STRCNT .CNT>
+                      <RETURN>)
+                     (<=? .S .STR>
+                      <RETURN>)
+                     (<EMPTY? <SET STRS <REST .STRS>>>
+                      <COMPERR TOO-MANY-TABLES!-ERRORS>)
+                     (T
+                      <SET CNT <+ .CNT 1>>)>>
+       <STRING "STR?" <UNPARSE .CNT>>>
+
+<DEFINE BITADD (VEC NAME "AUX" ATM BIT) 
+       #DECL ((VEC) VECTOR (NAME ATM) ATOM (BIT) <VECTOR FIX FIX>)
+       <SET ATM <GET-ATOM .NAME ,FLAGS>>
+       <SET BIT
+            <COND (<GASSIGNED? .ATM> ,.ATM)
+                  (<SETG HIBIT <- ,HIBIT 1>>
+                   <SETG HIVAL <COND (<0? ,HIVAL> 1) (<* ,HIVAL 2>)>>
+                   <COND (<G? ,HIVAL 35000>
+                          <COND (<==? ,BITBYTE ,OBIT16-31>
+                                 <SETG BITBYTE ,OBIT0-15>
+                                 <SETG HIVAL 1>)
+                                (<COMPERR TOO-MANY-BITS!-ERRORS>)>)>
+                   <SETG .ATM [,BITBYTE ,HIVAL ,HIBIT]>)>>
+       <PUT .VEC <BWORD .BIT> (.NAME !<NTH .VEC <BWORD .BIT>>)>>
+
+<DEFINE ADD-OBJ (NAME "AUX" ATM) 
+       #DECL ((NAME ATM) ATOM)
+       <SET ATM <GET-ATOM .NAME ,OBJECTS>>
+       <COND (<GASSIGNED? .ATM> ,.ATM) (<SETG .ATM [0 0 0 "" () () []]>)>>
+
+<DEFINE GET-ATOM (NAME OBL) 
+       #DECL ((NAME) ATOM (OBL) OBLIST)
+       <OR <LOOKUP <SPNAME .NAME> .OBL> <INSERT <SPNAME .NAME> .OBL>>>
+
+<DEFINE ADD-WORD (NAME TYPE VALUE
+                 "OPTIONAL" (SYM T)
+                 "AUX" ATM VEC (TYPVAL ,.TYPE) TYPES)
+       #DECL ((NAME TYPE ATM) ATOM (VALUE) ANY (VEC) VECTOR
+              (TYPVAL) <UVECTOR [REST FIX]> (SYM) <OR ATOM FALSE>
+              (TYPES) <PRIMTYPE WORD>)
+       <SET ATM <GET-ATOM .NAME ,WORDS>>
+       <SET VEC <COND (<GASSIGNED? .ATM> ,.ATM) (<SETG .ATM [0 0 0 0]>)>>
+       <AND .SYM <PUT .VEC ,WSYM -1>>
+       <COND (<N==? 0 <CHTYPE <ANDB <SET TYPES <WTYPES .VEC>> <1 .TYPVAL>>
+                               FIX>>)
+             (<==? <WVAL1 .VEC> 0>
+              <PUT .VEC
+                   ,WTYPES
+                   <CHTYPE <ORB .TYPES <+ <1 .TYPVAL> <2 .TYPVAL>>> FIX>>
+              <PUT .VEC ,WVAL1 .VALUE>)
+             (<==? <WVAL2 .VEC> 0>
+              <PUT .VEC ,WTYPES <CHTYPE <ORB .TYPES <1 .TYPVAL>> FIX>>
+              <PUT .VEC ,WVAL2 .VALUE>)
+             (<COMPERR TOO-MANY-PARTS-OF-SPEECH!-ERRORS .NAME>)>>
+
+<DEFINE ADD-SEQ (NAME VECNAME
+                "OPTIONAL" (STRVAL <>)
+                "AUX" (VEC ,.VECNAME) (TVEC <TOP .VEC>) VAL)
+       #DECL ((NAME VECNAME) ATOM (VEC TVEC) <UVECTOR [REST ATOM]>
+              (STRVAL) <OR FALSE STRING> (VAL) <OR FIX FALSE>)
+       <COND (<==? .NAME \,>
+              <SET NAME COMMA>)
+             (<==? .NAME \">
+              <SET NAME QUOTE>)>
+       <COND (<SET VAL <POS .NAME .TVEC>>
+              <COND (.STRVAL <STRING .STRVAL <SPNAME .NAME>>) (.VAL)>)
+             (<PUT .VEC 1 .NAME>
+              <COND (<==? .TVEC .VEC> <COMPERR TOO-MANY!-ERRORS .VECNAME>)
+                    (<SETG .VECNAME <BACK .VEC>>)>
+              <COND (.STRVAL <STRING .STRVAL <SPNAME .NAME>>)
+                    (<SET VAL <POS .NAME .TVEC>>
+                     <SETG <OR <LOOKUP <SPNAME .NAME> ,CONST>
+                               <INSERT <SPNAME .NAME> ,CONST>>
+                           .VAL>
+                     .VAL)>)>>
+
+<DEFINE ZEVAL (ITEM "AUX" ATM) 
+       #DECL ((ITEM) ANY (ATM) <OR FALSE ATOM>)
+       <COND (<AND <TYPE? .ITEM STRING> <NOT <TBLSTR? .ITEM>>> <NXTSTR .ITEM>)
+             (<==? .ITEM T> 1)
+             (<TYPE? .ITEM ATOM>
+              <CONSTANT-CHECK .ITEM>
+              <COND (<SET ATM <LOOKUP <SPNAME .ITEM> ,VARS>>
+                     ,.ATM)
+                    (.ITEM)>)
+             (<NOT .ITEM> 0)
+             (.ITEM)>>
+
+;"********************* ZILCH DATA OUTPUT ROUTINES ******************"
+
+
+<SETG SLOTS ![![0 0 0!] ![0 0 0!]!]>
+
+<SETG PHONYBIT [0 0 0 0 () ()]>
+
+<SETG ACTION (T)>
+
+<SETG AL ,ACTION>
+
+<SETG PREACTION (T)>
+
+<SETG PREAL ,PREACTION>
+
+<GDECL (ACTION AL)
+       <LIST [REST ATOM]>
+       (PREAL PREACTION)
+       <LIST [REST <OR FIX ATOM>]>>
+
+<GDECL (TEMPS) <LIST [REST LOCAL]>>
+
+<DEFINE GET-ACTION (ACT PREACT)
+       #DECL ((ACT) ATOM (PREACT) <OR FIX ATOM>)
+       <COND (<LPOS .ACT ,ACTION>)
+             (<SETG AL <REST <PUTREST ,AL (.ACT)>>>
+              <SETG PREAL <REST <PUTREST ,PREAL (.PREACT)>>>
+              <LPOS .ACT ,ACTION>)>>
+
+<DEFINE LPOS (ITM LST "AUX" M)
+       #DECL ((ITM) ATOM (LST) <LIST [REST ATOM]> (M) <OR FALSE LIST>)
+       <AND <SET M <MEMQ .ITM .LST>>
+            <- <LENGTH .LST> <LENGTH .M> -1>>>
+             
+
+<DEFINE SBITS (LST SLOT "AUX" M) 
+   #DECL ((LST) LIST (SLOT) <UVECTOR [REST FIX]>
+         (M) <OR FALSE <VECTOR [REST ATOM FIX]>>)
+   <MAPF <>
+    <FUNCTION (ANY) 
+           #DECL ((ANY) ANY)
+           <COND (<TYPE? .ANY ATOM>
+                  <COND (<SET M <MEMQ .ANY ,SFLAGS>>
+                         <PUT .SLOT 3 <+ <3 .SLOT> <2 .M>>>)
+                        (<COMPERR UNKNOWN-SYNTAX-FLAG!-ERRORS .ANY>)>)
+                 (<COMPERR BAD-SYNTAX!-ERRORS SYNTAX>)>>
+    .LST>>
+
+<MSETG SH 128>
+
+<MSETG SC 64>
+
+<MSETG SIR 32>
+
+<MSETG SOG 16>
+
+<MSETG STAKE 8>
+
+<MSETG SMANY 4>
+
+<MSETG SHAVE 2>
+
+<SETG SFLAGS
+      [HAVE
+       ,SHAVE
+       TAKE
+       ,STAKE
+       MANY
+       ,SMANY
+       HELD
+       ,SH
+       CARRIED
+       ,SC
+       IN-ROOM
+       ,SIR
+       ON-GROUND
+       ,SOG]>
+
+<GDECL (SFLAGS) <VECTOR [REST ATOM FIX]>>
+
+<DEFINE PRINT-VERBNUMS ("AUX" (OUTCHAN .OUTCHAN) (N -1))
+       #DECL ((OUTCHAN) CHANNEL (N) FIX)
+       <PRINC "
+
+; ACTION IDENTIFIERS ARE ASSIGNED HERE
+">
+       <MAPF <>
+             <FUNCTION (ATM "AUX" (S <SPNAME .ATM>))
+                       #DECL ((ATM) ATOM (S) STRING)
+                       <PRINC "
+       V?">
+                       <COND (<AND <==? <1 .S> !\V>
+                                   <==? <2 .S> !\->>
+                              <PRINC <REST .S 2>>)
+                             (<PRINC .S>)>
+                       <PRINC "=">
+                       <PRINC <SET N <+ .N 1>>>>
+             <REST ,ACTION>>
+       <MAPF <>
+             <FUNCTION (BUCK)
+                       #DECL ((BUCK) LIST)
+                       <MAPF <>
+                             <FUNCTION (ATM)
+                                       #DECL ((ATM) ATOM)
+                                       <ADD-WORD .ATM
+                                                 TVERB
+                                                 <ADD-SEQ .ATM ACTS "ACT?">>>
+                             .BUCK>>
+             ,VERBOBL>
+       <MAPF <> ,EVAL ,SYNLIST>>
+
+<DEFINE PRINT-PREPS ("AUX" (OUTCHAN .OUTCHAN) (PREPS <REST ,PREPS>))
+       #DECL ((OUTCHAN) CHANNEL (PREPS) UVECTOR)
+       <PRINC "
+
+; PREPOSITION TABLE IS DEFINED HERE
+
+PRTBL::        .TABLE
+       .WORD ">
+       <PRIN1 <LENGTH .PREPS>>
+       <MAPF <>
+             <FUNCTION (NAM)
+                       #DECL ((NAM) ATOM)
+                       <PRINC "
+       W?">
+                       <PRINC .NAM>
+                       <PRINC "
+       PR?">
+                       <PRINC .NAM>>
+             .PREPS>
+       <PRINC "
+       .ENDT
+">> 
+                   
+<DEFINE PRINT-VERBS ("AUX" (OUTCHAN .OUTCHAN)) 
+       #DECL ((OUTCHAN) CHANNEL)
+       <PRINC "
+
+; VERB TABLE IS DEFINED HERE
+
+VTBL:: .TABLE">
+       <MAPF <>
+             <FUNCTION (BUCK) 
+                     #DECL ((BUCK) LIST)
+                     <MAPF <>
+                           <FUNCTION (ATM) 
+                                   #DECL ((ATM) ATOM)
+                                   <PRINC "
+       ST?">
+                                   <PRINC .ATM>>
+                           .BUCK>>
+             ,VERBOBL>
+       <PRINC "
+       .ENDT
+
+; SYNTAX DEFINITION TABLES ARE DEFINED HERE
+">
+       <MAPF <>
+             <FUNCTION (BUCK) 
+                     #DECL ((BUCK) LIST)
+                     <MAPF <>
+                           <FUNCTION (ATM "AUX" LST) 
+                                   #DECL ((ATM) ATOM (LST) LIST)
+                                   <PRINC "
+ST?">
+                                   <PRINC .ATM>
+                                   <PRINC "::  .TABLE">
+                                   <SET LST ,.ATM>
+                                   <PRINC "
+       .BYTE ">
+                                   <PRIN1 <LENGTH .LST>>
+                                   <MAPF <> ,SYNPRINT .LST>
+                                   <PRINC "
+       .BYTE 0
+       .ENDT
+">>
+                           .BUCK>>
+             ,VERBOBL>>
+
+<DEFINE SYNPRINT (VEC "AUX" (OUTCHAN .OUTCHAN))
+       #DECL ((VEC) VECTOR (OUTCHAN) CHANNEL)
+       <MAPF <>
+             <FUNCTION (FX)
+                       #DECL ((FX) FIX)
+                       <PRINC "
+       .BYTE ">
+                       <PRIN1 .FX>>
+             .VEC>>
+
+<DEFINE PRINT-ACTIONS ("AUX" (OUTCHAN .OUTCHAN))
+       #DECL ((OUTCHAN) CHANNEL)
+       <PRINC "
+
+; THE ACTION CALLING TABLE IS DEFINED HERE
+
+ATBL:: .TABLE">
+       <MAPF <>
+             <FUNCTION (ATM)
+                       #DECL ((ATM) ATOM)
+                       <PRINC "
+       ">
+                       <PRIN1 .ATM>>
+             <REST ,ACTION>>
+       <PRINC "
+       .ENDT
+">
+       <PRINC "
+
+; THE PREACTION CALLING TABLE IS DEFINED HERE
+
+PATBL::        .TABLE">
+       <MAPF <>
+             <FUNCTION (ATM)
+                       #DECL ((ATM) ANY)
+                       <PRINC "
+       ">
+                       <PRIN1 .ATM>>
+             <REST ,PREACTION>>
+       
+       <PRINC "
+       .ENDT
+">>
+
+<DEFINE LC (STR)
+       #DECL ((VALUE STR) STRING)
+       <MAPF ,STRING
+             <FUNCTION (C)
+                       #DECL ((VALUE C) CHARACTER)
+                       <COND (<AND <G=? <ASCII .C> <ASCII !\A>>
+                                   <L=? <ASCII .C> <ASCII !\Z>>>
+                              <ASCII <+ <ASCII .C> 32>>)
+                             (.C)>>
+             .STR>>
+
+
+<DEFINE PRINT-VOCAB ("AUX" WORDS (OUTCHAN .OUTCHAN) ZSTRS) 
+   #DECL ((WORDS) <UVECTOR [REST ATOM]> (ZSTRS) <UVECTOR [REST FIX]>
+         (OUTCHAN) CHANNEL)
+   <SET WORDS <MAPF ,UVECTOR <FUNCTION (BUCK) <MAPRET !.BUCK>> ,WORDS>>
+   <SET ZSTRS
+       <MAPF ,UVECTOR
+             <FUNCTION (ATM "AUX" (NUM 0) (CNT 6)) 
+                     #DECL ((ATM) ATOM (VALUE NUM CNT) FIX)
+                     <MAPF <>
+                           <FUNCTION (COD) 
+                                   #DECL ((COD) FIX)
+                                   <SET NUM <+ <* .NUM 32> .COD>>
+                                   <COND (<0? <SET CNT <- .CNT 1>>>
+                                          <MAPLEAVE>)>>
+                           <STRING-ZSTR <LC <SPNAME .ATM>>>>
+                     <REPEAT ()
+                             <AND <0? .CNT> <RETURN>>
+                             <SET NUM <+ <* .NUM 32> ,PADCHR>>
+                             <SET CNT <- .CNT 1>>>
+                     .NUM>
+             .WORDS>>
+   <SORT <> .ZSTRS 1 0 .WORDS>
+   <PRINC "
+
+; VOCABULARY TABLE IS HERE
+
+VOCAB::        .TABLE">
+   <PRINC "
+       .BYTE 3
+       .BYTE 44
+       .BYTE 46 
+       .BYTE 34
+       .BYTE 7
+       ">
+   <PRIN1 <LENGTH .WORDS>>
+   <MAPF <>
+        <FUNCTION (WRD "AUX" (VAL ,.WRD)) 
+                #DECL ((WRD) ATOM (VAL) VECTOR)
+                <COND (<NOT <0? <WSYM .VAL>>>
+                       <CRLF>
+                       <PRINC "W?">
+                       <COND (<=? <SPNAME .WRD> ","> <PRINC "COMMA">)
+                             (<=? <SPNAME .WRD> "\""> <PRINC "QUOTE">)
+                             (<PRINC <SPNAME .WRD>>)>
+                       <PRINC "::      ">)
+                      (<PRINC "
+       ">)>
+                <PRINC ".ZWORD ">
+                <ZWORD-PRINT .WRD>
+                <PRINC "
+       .BYTE ">
+                <WTYPE-PRINT <WTYPES .VAL>>
+                <PRINC "
+       .BYTE ">
+                <PRINC <WVAL1 .VAL>>
+                <PRINC "
+       .BYTE ">
+                <PRINC <WVAL2 .VAL>>>
+        .WORDS>
+   <PRINC "
+       .ENDT
+">>
+\1a\1a\1a\1a
+
+<DEFINE ZWORD-PRINT (ATM "AUX" (SPN <SPNAME .ATM>) (CNT 7) (OUTCHAN .OUTCHAN))
+       #DECL ((ATM) ATOM (SPN) STRING (CNT) FIX (OUTCHAN) CHANNEL)
+       <PRINC !\">
+       <MAPF <>
+             <FUNCTION (CHR "AUX" (NUM <ASCII .CHR>))
+                       #DECL ((CHR) CHARACTER (NUM) FIX)
+                       <COND (<0? <SET CNT <- .CNT 1>>>
+                              <MAPLEAVE T>)>
+                       <COND (<AND <G=? .NUM <ASCII !\A>>
+                                   <L=? .NUM <ASCII !\Z>>>
+                              <PRINC <ASCII <+ .NUM 32>>>)
+                             (<==? .CHR !\">
+                              <PRINC .CHR>
+                              <PRINC .CHR>)
+                             (T
+                              <PRINC .CHR>)>>
+             .SPN>
+       <PRINC !\">>
+
+<DEFINE WTYPE-PRINT (WRD "AUX" (TYPES ,WTYPETBL) (FIRST T) (OUTCHAN .OUTCHAN)) 
+       #DECL ((WRD) FIX (TYPES) <UVECTOR [REST ATOM]>
+              (FIRST) <OR ATOM FALSE> (OUTCHAN) CHANNEL)
+       <REPEAT ((BIT #WORD *000000000200*))
+               #DECL ((BIT) WORD)
+               <COND (<NOT <==? <ANDB .WRD .BIT> #WORD *000000000000*>>
+                      <COND (.FIRST <SET FIRST <>>) (<PRINC "+">)>
+                      <PRINC "PS?">
+                      <PRIN1 <1 .TYPES>>)>
+               <SET BIT <CHTYPE </ <CHTYPE .BIT FIX> 2> WORD>>
+               <AND <EMPTY? <SET TYPES <REST .TYPES>>> <RETURN>>>
+       <COND (<==? <CHTYPE <ANDB .WRD 4> FIX> 0>
+              <PRINC "+P1?">
+              <PRIN1 <NTH ,WTYPETBL <+ <CHTYPE <ANDB .WRD 3> FIX> 1>>>)>>
+
+<DEFINE PRINT-OBJECTS ("AUX" (OBJ ,OBJECTS) (OUTCHAN .OUTCHAN)) 
+       #DECL ((OBJ) OBLIST (OUTCHAN) CHANNEL)
+       <PRINC 
+"
+
+; PROPERTY DEFAULTS AND OBJECTS ARE DEFINED HERE
+
+OBJECT::.TABLE ">
+       <PRIN1 <+ 62 <* 255 9>>>
+       <MAPF <>
+             <FUNCTION (VAL PROP)
+                       #DECL ((VAL) FIX (PROP) ATOM)
+                       <PRINC "
+       ">
+                       <PRIN1 .VAL>
+                       <PRINC "                        ;(">
+                       <PRIN1 <COND (<==? .PROP T> NONE)
+                                    (.PROP)>>
+                       <PRINC ")">>
+             ,PROPDEFS
+             <TOP ,PROPS>>
+       <MAPF <> <FUNCTION (BUCK)
+                          #DECL ((BUCK) LIST)
+                          <MAPF <> ,PRINT-OBJECT .BUCK>> .OBJ>
+       <PRINC "
+       .ENDT
+
+; OBJECT PROPERTY TABLES ARE DEFINED HERE
+">
+       <MAPF <> <FUNCTION (BUCK) <MAPF <> ,PRINT-OBJTBL .BUCK>> .OBJ>>
+
+<DEFINE PRINT-GLOBALS ("AUX" (OUTCHAN .OUTCHAN)) 
+       #DECL ((OUTCHAN) CHANNEL)
+       <PRINC 
+"
+
+; THE GLOBAL VARIABLES ARE ALL LOCATED HERE
+
+GLOBAL::.TABLE
+       .GVAR HERE=0
+       .GVAR SCORE=0
+       .GVAR MOVES=0">
+       <MAPF <>
+             <FUNCTION (STR) <REMOVE .STR ,VARS>>
+             '["HERE" "SCORE" "MOVES"]>
+       <MAPF <>
+             <FUNCTION (BUCK) 
+                     #DECL ((BUCK) <LIST [REST ATOM]>)
+                     <MAPF <>
+                           <FUNCTION (VAR) 
+                                   #DECL ((VAR) ATOM)
+                                   <PRINC "
+       .GVAR ">
+                                   <PRINC <SPNAME .VAR>>
+                                   <PRINC "=">
+                                   <PRINC ,.VAR>>
+                           .BUCK>>
+             ,VARS>
+       <PRINC "
+       .GVAR PREPOSITIONS=PRTBL
+       .GVAR ACTIONS=ATBL
+       .GVAR PREACTIONS=PATBL
+       .GVAR VERBS=VTBL
+       .ENDT
+">>
+
+<DEFINE PRINT-FLAGS ("AUX" (OUTCHAN .OUTCHAN)) 
+       #DECL ((OUTCHAN) CHANNEL)
+       <PRINC "
+
+; OBJECT FLAGS ARE DEFINED HERE
+">
+       <MAPF <>
+             <FUNCTION (BUCK) 
+                     #DECL ((BUCK) <LIST [REST ATOM]>)
+                     <MAPF <>
+                           <FUNCTION (FLAG) 
+                                   #DECL ((FLAG) ATOM)
+                                   <PRINC "
+
+       FX?">
+                                   <PRINC .FLAG>
+                                   <PRINC "=">
+                                   <PRIN1 <BVAL ,.FLAG>>
+                                   <PRINC "
+       ">
+                                   <PRINC .FLAG>
+                                   <PRINC "=">
+                                   <PRIN1 <BNUM ,.FLAG>>>
+                           .BUCK>>
+             ,FLAGS>>
+
+<DEFINE OBITPRINT (L "AUX" (OUTCHAN .OUTCHAN)) 
+       #DECL ((L) <LIST [REST ATOM]> (OUTCHAN) CHANNEL)
+       <MAPR <>
+             <FUNCTION (FLAGS) 
+                     #DECL ((FLAGS) <LIST ATOM [REST ATOM]>)
+                     <PRINC "FX?">
+                     <PRINC <1 .FLAGS>>
+                     <OR <LENGTH? .FLAGS 1> <PRINC "+">>>
+             .L>
+       <AND <EMPTY? .L> <PRIN1 0>>>
+
+<DEFINE PRINT-STRINGS ("AUX" (OUTCHAN .OUTCHAN)) 
+       #DECL ((OUTCHAN) CHANNEL)
+       <SET ZCHN .OUTCHAN>
+       <PRINC "
+
+; STRINGS ARE DEFINED HERE
+">
+       <REPEAT ((N 0))
+               #DECL ((N) FIX)
+               <COND (<G? <SET N <+ .N 1>> ,STRCNT> <RETURN>)
+                     (T
+                      <PRINC "
+       .GSTR STR?">
+                      <PRIN1 .N>
+                      <PRINC ",">
+                      <STRING-PRINT <NTH <TOP ,STRS> .N>>)>>>
+
+<DEFINE PRINT-TABLES ("AUX" (OUTCHAN .OUTCHAN)) 
+       #DECL ((OUTCHAN) CHANNEL)
+       <PRINC "
+
+; TABLES ARE DEFINED HERE
+">
+       <REPEAT ((N 0))
+               #DECL ((N) FIX)
+               <COND (<G? <SET N <+ .N 1>> ,TBLCNT> <RETURN>)
+                     (<PRINC "
+T?">
+                      <PRIN1 .N>
+                      <PRINC "::       .TABLE">
+                      <MAPF <>
+                            <FUNCTION (ITEM) <PRINC "
+       "> <PRINC .ITEM>>
+                            <NTH <TOP ,TBLS> .N>>
+                      <PRINC "
+       .ENDT
+">)>>>
+
+<DEFINE PRINT-OBJECT (NAME "AUX" (VEC <ADD-OBJ .NAME>) (COMMA ",")
+                                (OUTCHAN .OUTCHAN)) 
+       #DECL ((NAME) ATOM (VEC) VECTOR (COMMA) STRING (OUTCHAN) CHANNEL)
+       <PRINC "
+       .OBJECT ">
+       <PRINC .NAME>
+       <PRINC .COMMA>
+       <OBITPRINT <OBIT0-15 .VEC>>
+       <PRINC .COMMA>
+       <OBITPRINT <OBIT16-31 .VEC>>
+       <PRINC .COMMA>
+       <PRINC <OLOC .VEC>>
+       <PRINC .COMMA>
+       <PRINC <ONEXT .VEC>>
+       <PRINC .COMMA>
+       <PRINC <OFIRST .VEC>>
+       <PRINC ",T?">
+       <PRINC .NAME>>
+
+<DEFINE PRINT-OBJTBL (NAME "AUX" (VEC <ADD-OBJ .NAME>) (OUTCHAN .OUTCHAN)) 
+       #DECL ((NAME) ATOM (VEC) VECTOR (OUTCHAN) CHANNEL)
+       <PRINC "
+T?">
+       <PRINC .NAME>
+       <PRINC "::      .TABLE">
+       <PRINC "                        ; TABLE FOR OBJECT ">
+       <PRINC .NAME>
+       <PRINC "
+       .STRL ">
+       <PRIN1 <ODESC .VEC>>
+       <COND (<EMPTY? <OPROP .VEC>>)
+             (<REPEAT ((VV <REST <OPROP .VEC>>))
+                      <MAPF <> ,PRINC <1 .VV>>
+                      <AND <LENGTH? .VV 1> <RETURN>>
+                      <SET VV <REST .VV 2>>>)>
+       <PRINC "
+       .BYTE   0
+       .ENDT
+">>
+
+<DEFINE PRINT-UCONST ("AUX" (OUTCHAN .OUTCHAN))
+       #DECL ((OUTCHAN) CHANNEL)
+       <PRINC "
+
+; USER DEFINED CONSTANTS ARE INITIALIZED HERE
+">
+       <MAPF <>
+             <FUNCTION (BUCK)
+                       #DECL ((BUCK) LIST)
+                       <MAPF <>
+                             <FUNCTION (ATM)
+                                       #DECL ((ATM) ATOM)
+                                       <PRINC "
+       ">
+                                       <PRINC .ATM>
+                                       <PRINC "=">
+                                       <PRIN1 ,.ATM>>
+                             .BUCK>>
+             ,UCONST>>
+
+<DEFINE PRINT-SEQ (SEQTBL STR PREFIX "AUX" (OUTCHAN .OUTCHAN)) 
+       #DECL ((SEQTBL) <UVECTOR [REST ATOM]> (STR PREFIX) STRING
+              (OUTCHAN) CHANNEL)
+       <PRINC "
+
+; ">
+       <PRINC .STR>
+       <PRINC " ARE DEFINED HERE
+">
+       <REPEAT ((N <LENGTH .SEQTBL>))
+               #DECL ((N) FIX)
+               <COND (<==? <NTH .SEQTBL .N> T> <RETURN>)
+                     (<PRINC "
+       ">
+                      <PRINC .PREFIX>
+                      <PRINC <NTH .SEQTBL .N>>
+                      <PRINC "=">
+                      <PRIN1 .N>)>
+               <AND <0? <SET N <- .N 1>>> <RETURN>>>>
+
+<DEFINE PRINT-TOP ("AUX" (OUTCHAN .OUTCHAN)) 
+       #DECL ((OUTCHAN) CHANNEL)
+       <PRINC 
+"
+
+; TOP LEVEL DEFINITIONS
+
+       O?ANY=1
+       
+       PS?OBJECT=128
+       PS?VERB=64
+       PS?ADJECTIVE=32
+       PS?DIRECTION=16
+       PS?PREPOSITION=8
+       PS?BUZZ-WORD=4
+
+       P1?OBJECT=0
+       P1?VERB=1
+       P1?ADJECTIVE=2
+       P1?DIRECTION=3
+">>
+
+<DEFINE DUMP (OUTCHAN) 
+       #DECL ((OUTCHAN) <SPECIAL CHANNEL>)
+       <PRINT-TOP>
+       <PRINT-FLAGS>
+       <PRINT-VERBNUMS>
+       <PRINT-SEQ <TOP ,PROPS> "PROPERTIES" "">
+       <PRINT-SEQ <TOP ,ADJS> "ADJECTIVES" "A?">
+       <PRINT-SEQ <TOP ,BUZZES> "BUZZ WORDS" "B?">
+       <PRINT-SEQ <TOP ,PREPS> "PREPOSITIONS" "PR?">
+       <PRINT-SEQ <TOP ,DIRS> "DIRECTIONS" "D?">
+       <PRINT-SEQ <TOP ,ACTS> "ACTIONS" "ACT?">
+       <PRINT-UCONST>
+       <PRINT-OBJECTS>
+       <PRINT-GLOBALS>
+       <PRINT-TABLES>
+       <PRINC "
+
+; END OF PURENESS
+
+IMPURE::
+
+">
+       <PRINT-VERBS>
+       <PRINT-ACTIONS>
+       <PRINT-PREPS>
+       <PRINT-VOCAB>
+       <PRINC "
+       .ENDI
+">
+       <INFO "
+Vocabulary: " <OBLCNT ,WORDS>>
+       <INFO "
+Prepositions: " <- <LENGTH ,PREPS> 1>>
+       <LIST-VEC ,PREPS>
+       <INFO "
+Objects: " <OBLCNT ,OBJECTS>>
+       <LIST-OBL ,OBJECTS>
+       <INFO "
+Properties: " <- <LENGTH ,PROPS> 1>>
+       <LIST-VEC ,PROPS>
+       <INFO "
+Globals: " <OBLCNT ,VARS>>
+       <LIST-OBL ,VARS>>
+
+<DEFINE DUMPSTR (OUTCHAN)
+       #DECL ((OUTCHAN) <SPECIAL CHANNEL>)
+       <PRINT-STRINGS>
+       <PRINC "
+
+       .ENDI
+">>
+
+<DEFINE OBLCNT (OBL) #DECL ((OBL) OBLIST) <MAPF ,+ ,LENGTH .OBL>>
+
+<DEFINE LIST-VEC (UVEC)
+       #DECL ((UVEC) <UVECTOR [REST ATOM]>)
+       <MAPF <> ,LIST-ATOM <SORT <> <REST .UVEC>>>>
+
+<DEFINE LIST-OBL (OBL "AUX" UVEC)
+       #DECL ((OBL) OBLIST (UVEC) <UVECTOR [REST ATOM]>)
+       <SET UVEC
+            <MAPF ,UVECTOR
+                  <FUNCTION (BUCK)
+                            #DECL ((BUCK) <LIST [REST ATOM]>)
+                            <MAPRET !.BUCK>>
+                  .OBL>>
+       <MAPF <> ,LIST-ATOM <SORT <> .UVEC>>>
+
+<DEFINE LIST-ATOM (ATM)
+       #DECL ((ATM) ATOM)
+       <INFO "
+        " .ATM>>
+
+;"**************** ZILCH - TOP LEVEL COMPILER ROUTINE ***************"
+
+<SETG ERROR-CHECK T>
+
+<DEFINE ZILCH ZA (STR "OPTIONAL" (TTYREC <>) "AUX" C (TIM <TIME>) ZCHN) 
+       #DECL ((STR) STRING (C) <OR FALSE CHANNEL> (TIM) FLOAT
+              (ZCHN) <SPECIAL CHANNEL> (TTYREC) <OR FALSE ATOM CHANNEL>
+              (ZA) ACTIVATION)
+       <COND (<TYPE? .TTYREC CHANNEL>
+              <PRINC "Compiling ">
+              <PRINC .STR>
+              <PRINC ".ZIL">
+              <CRLF>)
+             (T
+              <SET RECCHN
+                   <COND (<NOT .TTYREC> ,OUTCHAN)
+                         (<OPEN "PRINT" .STR "RECORD">)
+                         (<COMPERR CANT-OPEN-RECORD-CHANNEL!-ERRORS>
+                          <RETURN T .ZA>)>>)>
+       <COND (<0? ,LEVEL>
+              <SETG ERRS 0>
+              <SETG CODLEN 0>
+              <INFO "
+ZIL Debugging Compiler 4.5
+--------------------------">)>
+       <COND (<AND <SET C <OPEN "READ" .STR "ZIL">>
+                   <SET ZCHN <OPEN "PRINT" .STR "ZAP">>>
+              <PUT .ZCHN 13 <CHTYPE <MIN> FIX>>
+              <INFO "
+Input file: ">
+              <INFO .STR>
+              <INFO ".ZIL">
+              <COND (<0? ,LEVEL>
+                     <ID-GEN .C>
+                     <PRINC "
+       .INSERT \"" .ZCHN>
+                     <PRINC .STR .ZCHN>
+                     <PRINC "DAT\"                     ; DATA IS IN THIS FILE
+
+" .ZCHN>)>
+              <LOAD .C>
+              <CLOSE .C>
+              <COND (<0? ,LEVEL>
+                     <PRINC "
+       .INSERT \"" .ZCHN>
+                     <PRINC .STR .ZCHN>
+                     <PRINC "STR\"
+
+       .END
+" .ZCHN>)
+                    (<PRINC "
+       .ENDI
+" .ZCHN>)>
+              <CLOSE .ZCHN>
+              <COND (<0? ,LEVEL>
+                     <CHECKUP>
+                     <COND (<AND <G? ,ERRS 0> ,ERROR-CHECK>
+                            <INFO "
+
+Fatal errors: "
+                                  ,ERRS
+                                  "
+ZILCH failed.">
+                            <COND (<AND <0? ,LEVEL>
+                                        <N==? .RECCHN ,OUTCHAN>>
+                                   <CLOSE .RECCHN>)>
+                            <>)
+                           (<SET C <OPEN "PRINT" <STRING .STR "DAT"> "ZAP">>
+                            <PUT .C 13 <CHTYPE <MIN> FIX>>
+                            <DUMP .C>
+                            <CLOSE .C>
+                            <SET C <OPEN "PRINT" <STRING .STR "STR"> "ZAP">>
+                            <PUT .C 13 <CHTYPE <MIN> FIX>>
+                            <DUMPSTR .C>
+                            <CLOSE .C>
+                            <INFO "
+Total code length: "
+                                  ,CODLEN
+                                  " bytes.
+ZILCH finished in "
+                                  <- <TIME> .TIM>
+                                  " seconds.">
+                            <CLOSE .C>
+                            <COND (<AND <0? ,LEVEL>
+                                        <N==? .RECCHN ,OUTCHAN>>
+                                   <CLOSE .RECCHN>)>
+                            ,NULL)
+                           (<COMPERR CANT-OPEN-DATA-FILE!-ERRORS>
+                            <RETURN T .ZA>)>)
+                    (<SETG LEVEL <- ,LEVEL 1>>)>)
+             (<COMPERR CANT-OPEN-INPUT-FILE!-ERRORS> <RETURN T .ZA>)>
+       ,NULL>
+
+<DEFINE ID-GEN (C "AUX" (X <MEMQ !\. <8 .C>>) Y)
+       #DECL ((C) CHANNEL (X Y) <STRING CHARACTER [REST CHARACTER]>)
+       <SET Y <MEMQ !\; .X>>
+       <SETG ZORK-VERSION 
+             <PARSE <SUBSTRUC .X 1 <- <LENGTH .X> <LENGTH .Y>>>>>> 
+
+<DEFINE CHECKUP ()
+       <COND (<GASSIGNED? ZORK-ID>
+              <CONSTANT ZORKID <+ <* ,ZORK-ID 1024> ,ZORK-VERSION>>)
+             (<COMPERR NO-GAME-ID!-ERRORS>)>
+       <COND (<NOT ,STARTFLG>
+              <COMPERR NO-STARTING-ADDRESS!-ERRORS>)>
+       <COND (<NOT ,ENDLOADFLG>
+              <COMPERR NO-ENDLOAD-ADDRESS!-ERRORS>)>
+       <MAPF <>
+             <FUNCTION (FREF "AUX" ATM OPDEF) 
+                       #DECL ((FREF) FREF (ATM) <OR FALSE ATOM> (OPDEF) OPDEF)
+                       <COND
+                        (<SET ATM <LOOKUP <SPNAME <FCALLED .FREF>> ,OPS>>
+                         <SET OPDEF ,.ATM>
+                         <COND (<OR <G? <FARGS .FREF> <OPMAX .OPDEF>>
+                                    <L? <FARGS .FREF> <OPMIN .OPDEF>>>
+                                <COMPERR WRONG-NUMBER-OF-ARGUMENTS!-ERRORS
+                                         "Caller:"
+                                         <FCALLER .FREF>
+                                         " Called Routine:"
+                                         <FCALLED .FREF>
+                                         " Arguments:"
+                                         <FARGS .FREF>>)>)
+                        (<INFO "
+ ** Warning, Undefined Routine: " <FCALLED .FREF>>)>>
+             ,FREFS>
+       <MAPF <>
+             <FUNCTION (BUCK)
+                  #DECL ((BUCK) <LIST [REST ATOM]>)
+                  <MAPF <>
+                        <FUNCTION (OP "AUX" (OPDEF ,.OP))
+                               #DECL ((OP) ATOM (OPDEF) OPDEF)
+                                <MAPF <>
+                                      <FUNCTION (ATM)
+                                           #DECL ((ATM) GLOBAL)
+                                           <OR <LOOKUP <SPNAME
+                                                        <CHTYPE .ATM ATOM>>
+                                                       ,VARS>
+                                               <UNDEF .ATM>>>
+                                        <OPEXT .OPDEF>>>
+                        .BUCK>>
+             ,OPS>>
+
+<DEFINE UNDEF (GLOBAL)
+       #DECL ((GLOBAL) GLOBAL)
+       <INFO "
+ ** WARNING Undefined Global: "
+             <CHTYPE .GLOBAL ATOM>
+             " / Initialized to zero.">
+       <GLOBAL <CHTYPE .GLOBAL ATOM> 0>>
+
+<DEFINE INFO ("TUPLE" ITMS "AUX" (CHAN .RECCHN)) 
+       #DECL ((ITMS) TUPLE (STR) STRING (NUM) FIX (CHAN) CHANNEL)
+       <MAPF <>
+             <FUNCTION (X)
+                       <PRINC .X .CHAN>>
+             .ITMS>>
+
+;" ******************** HERE LIES THE CODE COMPILER **********************"
+
+<NEWTYPE FLBL VECTOR '<<PRIMTYPE VECTOR> <LIST [REST <OR FALSE LABEL>]>
+                                        SENSE>>
+
+<NEWTYPE LOCAL ATOM>
+
+<NEWTYPE GLOBAL ATOM>
+
+<NEWTYPE LABEL ATOM>
+
+<NEWTYPE RLABEL ATOM>
+
+<NEWTYPE SENSE ATOM>
+
+<NEWTYPE JUMP ATOM>
+
+<NEWTYPE INS ATOM>
+
+<NEWTYPE CALL ATOM>
+
+<NEWTYPE RSTRING STRING>
+
+;" ******************** RANDOM VARIABLES *********************"
+
+<SETG HILBL 0>
+
+<SETG FREFS ()>
+
+<SETG LOCALS ()>
+
+<GDECL (LOCALS) <LIST [REST ATOM]> (FREFS) <LIST [REST FREF]> (HILBL) FIX>
+
+;" ********************** CONSTANTS, OPERATIONS, ETC ******************"
+
+<NEWTYPE OPDEF
+        VECTOR
+        '<<PRIMTYPE VECTOR> FIX
+                            FIX
+                            <OR ATOM FALSE>
+                            <OR ATOM FALSE>
+                            <OR ATOM FALSE>
+                            LIST>>
+
+<MSETG OPMIN 1>
+
+<MSETG OPMAX 2>
+
+<MSETG OPPRED 3>
+
+<MSETG OPVAL 4>
+
+<MSETG OPUSER 5>
+
+<MSETG OPEXT 6>
+
+<NEWTYPE FREF VECTOR '<<PRIMTYPE VECTOR> ATOM ATOM FIX>>
+
+<MSETG FCALLER 1>
+
+<MSETG FCALLED 2>
+
+<MSETG FARGS 3>
+
+<DEFINE ADD-OP (NAME MIN MAX PRED? VAL?)
+    <SETG <INSERT <SPNAME .NAME> ,OPS>
+         <CHTYPE [.MIN .MAX .PRED? .VAL? <> ()] OPDEF>>>
+
+<COND (<NOT <GASSIGNED? OPRED>>
+       <SETG OPRED ![AND OR NOT!]>
+       <MAPF <>
+            <FUNCTION (LST) <SETG <INSERT <SPNAME <1 .LST>> ,CNV> <2 .LST>>>
+            [[==? EQUAL?]
+             [=? EQUAL?]
+             [L? LESS?]
+             [G? GRTR?]
+             [APPLY CALL]
+             [SETG SET]
+             [0? ZERO?]
+             [* MUL]
+             [/ DIV]
+             [REST ADD]
+             [BACK SUB]
+             [+ ADD]
+             [- SUB]
+             [NTH GET]
+             [NTHB GETB]
+             [ANDB BAND]
+             [ORB BOR]
+             [XORB BCOM]]>
+       <SETG PREDS
+            ![#INS EQUAL?
+              #INS LESS?
+              #INS GRTR?
+              #INS DLESS?
+              #INS IGRTR?
+              #INS IN?
+              #INS FSET?
+              #INS ZERO?
+              #INS NEXT?
+              #INS FIRST?
+              #INS LOC!]>
+       <ADD-OP EQUAL? 2 4 T <>>
+       <ADD-OP LESS? 2 2 T <>>
+       <ADD-OP GRTR? 2 2 T <>>
+       <ADD-OP DLESS? 2 2 T <>>
+       <ADD-OP IGRTR? 2 2 T <>>
+       <ADD-OP IN? 2 2 T <>>
+       <ADD-OP BTST 2 2 T <>>
+       <ADD-OP BAND 2 2 <> T>
+       <ADD-OP BOR 2 2 <> T>
+       <ADD-OP BCOM 2 2 <> T>
+       <ADD-OP FSET? 2 2 T <>>
+       <ADD-OP FSET 2 2 <> <>>
+       <ADD-OP FCLEAR 2 2 <> <>>
+       <ADD-OP SET 2 2 <> <>>
+       <ADD-OP MOVE 2 2 <> <>>
+       <ADD-OP GET 2 2 <> T>
+       <ADD-OP GETB 2 2 <> T>
+       <ADD-OP GETP 2 2 <> T>
+       <ADD-OP GETPT 2 2 <> T>
+       <ADD-OP NEXTP 2 2 <> T>
+       <ADD-OP ADD 2 2 <> T>
+       <ADD-OP SUB 2 2 <> T>
+       <ADD-OP MUL 2 2 <> T>
+       <ADD-OP DIV 2 2 <> T>
+       <ADD-OP MOD 2 2 <> T>
+       <ADD-OP NOT 1 1 <> <>>
+       <ADD-OP ZERO? 1 1 T <>>
+       <ADD-OP NEXT? 1 1 T T>
+       <ADD-OP FIRST? 1 1 T T>
+       <ADD-OP LOC 1 1 <> T>
+       <ADD-OP PTSIZE 1 1 <> T>
+       <ADD-OP INC 1 1 <> <>>
+       <ADD-OP DEC 1 1 <> <>>
+       <ADD-OP PUSH 1 1 <> <>>
+       <ADD-OP POP 1 1 <> <>>
+       <ADD-OP REMOVE 1 1 <> <>>
+       <ADD-OP CALL 1 4 <> T>
+       <ADD-OP RETURN 1 1 <> <>>
+       <ADD-OP JUMP 1 1 <> <>>
+       <ADD-OP PRINT 1 1 <> <>>
+       <ADD-OP RTRUE 0 0 <> <>>
+       <ADD-OP RFALSE 0 0 <> <>>
+       <ADD-OP PRINTI 1 1 <> <>>
+       <ADD-OP PRINTR 1 1 <> <>>
+       <ADD-OP CRLF 0 0 <> <>>
+       <ADD-OP NOOP 0 0 <> <>>
+       <ADD-OP SAVE 0 0 T <>>
+       <ADD-OP RESTORE 0 0 T <>>
+       <ADD-OP RESTART 0 0 <> <>>
+       <ADD-OP QUIT 0 0 <> <>>
+       <ADD-OP RSTACK 0 0 <> <>>
+       <ADD-OP FSTACK 0 0 <> <>>
+       <ADD-OP PUT 3 3 <> <>>
+       <ADD-OP PUTB 3 3 <> <>>
+       <ADD-OP PUTP 3 3 <> <>>
+       <ADD-OP READ 2 2 <> <>>
+       <ADD-OP PRINTC 1 1 <> <>>
+       <ADD-OP PRINTN 1 1 <> <>>
+       <ADD-OP PRINTB 1 1 <> <>>
+       <ADD-OP PRINTD 1 1 <> <>>
+       <ADD-OP VALUE 1 1 <> T>
+       <ADD-OP RANDOM 1 1 <> T>
+       <ADD-OP AND 1 100 <> <>>
+       <ADD-OP OR 1 100 <> <>>
+       <ADD-OP DO 1 100 <> <>>)>
+
+<GDECL (OPRED) <UVECTOR [REST ATOM]> (PREDS) <UVECTOR [REST INS]> (CODLEN) FIX>
+
+<DEFINE DEBUG () 
+       <SET ZCHN <SET RECCHN ,OUTCHAN>>
+       <SETG CODLEN 0>
+       <SET REDEFINE T>>
+
+<DEFINE ROUTINE ZDEF ("ARGS" LST
+                     "AUX" NAME ARGL LPROG VAL ZNAM (MIN 0) (MAX 0) (OPT <>)
+                           (AUX <>) (OPS ,OPS) (EXT ()) TZL (TIM <TIME>) LEN
+                           (FORMS (T)) (F .FORMS))
+   #DECL ((LST) LIST (NAME) ATOM (ARGL) LIST (MIN MAX LEN) FIX (TIM) FLOAT
+         (TZL FORMS) LIST (LPROG) <SPECIAL RLABEL> (VAL) <OR ATOM SENSE FLBL>
+         (OPT AUX) <OR ATOM FALSE> (ZDEF) <SPECIAL ACTIVATION>
+         (ZNAM) <SPECIAL ATOM> (OPS) OBLIST (EXT) <LIST [REST GLOBAL]>)
+   <COND (<NOT <DECL? .LST '<LIST ATOM LIST [REST ANY]>>>
+         <COMPERR BAD-SYNTAX!-ERRORS DEFINE>)
+        (<SET ZNAM <SET NAME <1 .LST>>> <SET ARGL <2 .LST>>)>
+   <SET TZL <SETG TZL <SETG ZL (T)>>>
+   <SETG HILBL 0>
+   <SETG TEMPS ()>
+   <SETG LOCALS ()>
+   <EMIT "     .FUNCT  ">
+   <EMIT <CHTYPE .NAME LOCAL>>
+   <REMOVE <SPNAME .NAME> ,UCONST>
+   <INFO "
+Compiling routine: " .NAME>
+   <MAPF <>
+    <FUNCTION (ARG) 
+       #DECL ((ARG) ANY)
+       <COND
+       (<TYPE? .ARG ATOM>
+        <SETG LOCALS (.ARG !,LOCALS)>
+        <EMIT "," <CHTYPE .ARG LOCAL>>
+        <OR .AUX <SET MAX <+ .MAX 1>>>
+        <OR .OPT <SET MIN <+ .MIN 1>>>)
+       (<=? .ARG "OPTIONAL"> <SET OPT T>)
+       (<=? .ARG "AUX"> <SET OPT T> <SET AUX T>)
+       (<AND <DECL? .ARG '<LIST ATOM <OR ATOM FIX FORM>>> <OR .AUX .OPT>>
+        <SETG LOCALS (<1 .ARG> !,LOCALS)>
+        <EMIT "," <CHTYPE <1 .ARG> LOCAL>>
+        <COND
+         (<AND <TYPE? <2 .ARG> FORM>
+               <NOT <EMPTY? <2 .ARG>>>
+               <NOT <L/G? <2 .ARG>>>>
+          <SET FORMS <REST <PUTREST .FORMS (<FORM SET <1 .ARG> <2 .ARG>>)>>>)
+         (T
+          <EMIT "="
+                <COND (<==? <2 .ARG> T> 1)
+                      (<TYPE? <2 .ARG> ATOM>
+                       <CONSTANT-CHECK <2 .ARG>>
+                       <CHTYPE <2 .ARG> LOCAL>)
+                      (<TYPE? <2 .ARG> FORM>
+                       <COND (<EMPTY? <2 .ARG>> 0)
+                             (<L/G? <2 .ARG>> <CHTYPE <2 <2 .ARG>> LOCAL>)
+                             (<COMPERR BAD-ARG-SYNTAX!-ERRORS .NAME>)>)
+                      (<2 .ARG>)>>)>
+        <OR .AUX <SET MAX <+ .MAX 1>>>)
+       (<COMPERR BAD-ARG-SYNTAX!-ERRORS .NAME>)>>
+    .ARGL>
+   <COND (<TYPE? <3 .LST> DECL> <SET LST <REST .LST>>)>
+   <AND <==? .NAME GO> <SETG STARTFLG T> <EMIT "
+START::
+">>
+   <EMIT <SET LPROG #RLABEL ?FCN>>
+   <MAPF <> ,GENT <REST .F>>
+   <SET VAL
+       <MAPR <>
+             <FUNCTION (L "AUX" (ITM <1 .L>)) 
+                     #DECL ((L) LIST (ITM) ANY)
+                     <COND (<LENGTH? .L 1>
+                            <MAPLEAVE <GENT .ITM #LOCAL STACK>>)
+                           (<GENT .ITM>)>>
+             <REST .LST 2>>>
+   <COND (<==? .VAL STACK> <EMIT #INS RSTACK>)
+        (<==? .VAL ?NOVAL> <EMIT #INS RTRUE>)
+        (<TYPE? .VAL SENSE> <EMIT .VAL #JUMP TRUE #INS RFALSE>)
+        (<TYPE? .VAL ATOM> <EMIT #INS RETURN .VAL>)
+        (<ERROR .VAL>)>
+   <REPEAT ((LL .TZL) (L <REST .LL>))
+          #DECL ((LL L) LIST)
+          <COND (<TYPE? <1 .L> RLABEL LABEL INS>
+                 <MAPF <>
+                       <FUNCTION (X) 
+                               <PUTREST .LL <CONS "," .L>>
+                               <PUTREST <REST .LL> <CONS .X .L>>
+                               <SET LL <REST .LL 2>>>
+                       ,TEMPS>
+                 <RETURN>)
+                (<SET L <REST .L>> <SET LL <REST .LL>>)>>
+   <SET LST
+       <MAPF ,LIST
+             <FUNCTION (ITM) 
+                     #DECL ((ITM) ANY)
+                     <COND (<TYPE? .ITM ATOM> <MAPRET .ITM>)
+                           (<TYPE? .ITM RLABEL LABEL INS> <MAPSTOP>)
+                           (<MAPRET>)>>
+             .TZL>>
+   <MAPF <>
+        <FUNCTION (ITM) 
+                #DECL ((ITM) ANY)
+                <COND (<TYPE? .ITM GLOBAL>
+                       <COND (<MEMQ .ITM .EXT>)
+                             (<INFO "
+Global reference: " <CHTYPE .ITM ATOM>>
+                              <SET EXT (.ITM !.EXT)>)>)
+                      (<TYPE? .ITM CALL>
+                       <INFO "
+Routine called: " <CHTYPE .ITM ATOM>>)>>
+        .TZL>
+   <INFO "
+Code length: "
+        <SET LEN <+ <PEEPH .TZL .ZCHN> <LENGTH ,LOCALS>>>
+        " bytes.
+Compilation time: "
+        <- <TIME> .TIM>
+        " seconds.">
+   <SET EXT
+       <MAPF ,LIST
+             <FUNCTION (ATM) 
+                     #DECL ((ATM) GLOBAL)
+                     <COND (<LOOKUP <SPNAME <CHTYPE .ATM ATOM>> ,VARS>
+                            <MAPRET>)
+                           (.ATM)>>
+             .EXT>>
+   <COND (<AND <LOOKUP <SPNAME .NAME> .OPS>
+              <OR <NOT <ASSIGNED? REDEFINE>> <NOT .REDEFINE>>>
+         <COMPERR ALREADY-DEFINED!-ERRORS>)
+        (<SETG <OR <LOOKUP <SPNAME .NAME> .OPS> <INSERT <SPNAME .NAME> .OPS>>
+               <CHTYPE [.MIN .MAX <> T T .EXT] OPDEF>>)>
+   <SETG CODLEN <+ ,CODLEN .LEN>>
+   <CRLF .ZCHN>>
+
+<SETG STARTFLG <>>
+
+<SETG ENDLOADFLG <>>
+
+<GDECL (STARTFLG ENDLOADFLG) <OR ATOM FALSE>>
+
+<DEFINE PROGGEN (LST LPROGVAL
+                "OPTIONAL" (RPT <>) (LPROG <CHTYPE <GENLBL "PRG"> RLABEL>)
+                           (LRTN <GENLBL "REP">)
+                "AUX" VAL)
+       #DECL ((LST) LIST (RPT) <OR FALSE FIX ATOM>
+              (LPROG LRTN) <SPECIAL <PRIMTYPE ATOM>>
+              (LPROGVAL) <SPECIAL <OR LOCAL FALSE>>
+              (VAL) <OR ATOM FLBL SENSE>)
+       <AND <==? <1 .LST> ()> <SET LST <REST .LST>>>
+       <OR <==? .RPT 0> <EMIT .LPROG>>
+       <MAPR <>
+             <FUNCTION (X) <COND (<LENGTH? .X 1> <MAPLEAVE>) (<GENT <1 .X>>)>>
+             .LST>
+       <COND (<AND .LPROGVAL <NOT .RPT>>
+              <GENT <NTH .LST <LENGTH .LST>> .LPROGVAL>)
+             (<GENT <NTH .LST <LENGTH .LST>>>)>
+       <COND (.RPT
+              <EMIT #INS JUMP <CHTYPE .LPROG JUMP>>)>
+       <EMIT .LRTN>
+       <OR <AND .LPROGVAL <CHTYPE .LPROGVAL ATOM>> #SENSE TRUE>>
+
+<DEFINE CONDGEN (FRM VAL? "AUX" (CONDEND <GENLBL "CND">) VAL CVT CVF) 
+       #DECL ((FRM) LIST (CONDEND CVT CVF) LABEL (VAL) <OR FLBL SENSE ATOM>
+              (VAL?) <OR LOCAL FALSE>)
+       <COND (.VAL? <SET CVT <GENLBL "PRD">> <SET CVF <GENLBL "PRD">>)>
+       <COND (<NOT <DECL? .FRM '<LIST [REST LIST]>>>
+              <COMPERR BAD-SYNTAX!-ERRORS COND>)>
+       <MAPR <>
+             <FUNCTION (LST "AUX" (CLAUSE <1 .LST>)) 
+                     #DECL ((LST CLAUSE) LIST)
+                     <COND (.VAL?
+                            <SET VAL <IFGEN .CLAUSE .CONDEND .CVT .CVF>>)
+                           (<SET VAL <IFGEN .CLAUSE .CONDEND>>)>>
+             .FRM>
+       <COND (.VAL?
+              <EMIT #INS JUMP <CHTYPE .CVF JUMP>>
+              <EMIT .CVT #INS PUSH 1 #INS JUMP <CHTYPE .CONDEND JUMP>>
+              <EMIT .CVF #INS PUSH 0>
+              <EMIT .CONDEND>
+              <OR <==? .VAL? #LOCAL STACK>
+                  <EMIT #INS SET <CHTYPE .VAL? ATOM> "," #LOCAL STACK>>
+              <CHTYPE .VAL? ATOM>)
+             (<EMIT .CONDEND> .VAL)>>
+
+<DEFINE IFGEN (LST COND
+              "OPTIONAL" (CVT <>) CVF
+              "AUX" (THEN <GENLBL "THN">) (ELSE <GENLBL "ELS">) LBL VAL
+                    (VAL1 ?NOVAL))
+       #DECL ((LST) LIST (CVT) <OR FALSE LABEL>
+              (LBL) <LIST [REST <OR FALSE LABEL>]> (THEN ELSE COND CVF) LABEL
+              (VAL VAL1) <OR ATOM SENSE FLBL>)
+       <COND (<EMPTY? .LST> <COMPERR BAD-SYNTAX!-ERRORS COND-CLAUSE>)>
+       <COND (<LENGTH? .LST 1> <SET LST (<1 .LST> T)>)>
+       <COND (<MEMQ <1 .LST> '[T ELSE]> <SET VAL #SENSE TRUE>)
+             (<SET VAL <PREDGEN <1 .LST>>>)>
+       <COND (<TYPE? .VAL FLBL>
+              <SET LBL <1 .VAL>>
+              <SET VAL <2 .VAL>>
+              <OR <LENGTH? .LST 1>
+                  <EMIT <ZNOT .VAL> <CHTYPE .ELSE JUMP> .THEN>>
+              <MAPF <>
+                    <FUNCTION (LBL) 
+                            #DECL ((LBL) <OR FALSE LABEL>)
+                            <AND .LBL
+                                 <MEMBER "THN" <SPNAME <CHTYPE .LBL ATOM>>>
+                                 <NOT <MEMQ .LBL ,TZL>>
+                                 <EMIT .LBL>>>
+                    .LBL>)>
+       <COND (<NOT <LENGTH? .LST 1>>
+              <MAPR <>
+                    <FUNCTION (X) 
+                            <AND <LENGTH? .X 1> <MAPLEAVE>>
+                            <GENT <1 .X>>>
+                    <REST .LST>>
+              <SET VAL1
+                   <GENT <NTH .LST <LENGTH .LST>> <AND .CVT #LOCAL STACK>>>)
+             (<SET VAL1 .VAL>)>
+       <COND (<AND .CVT <TYPE? .VAL1 SENSE>> <EMIT .VAL1 <CHTYPE .CVT JUMP>>)
+             (<AND .CVT <==? .VAL1 ?NOVAL>>
+              <EMIT #INS JUMP <CHTYPE .CVT JUMP>>)
+             (T
+              <COND (.CVT
+                     <OR <==? .VAL1 STACK>
+                         <EMIT #INS PUSH <CHTYPE .VAL1 LOCAL>>>)>
+              <EMIT #INS JUMP <CHTYPE .COND JUMP>>)>
+       <AND <ASSIGNED? LBL>
+            <MAPF <>
+                  <FUNCTION (LBL) 
+                          #DECL ((LBL) <OR FALSE LABEL>)
+                          <AND .LBL
+                               <MEMBER "ELS" <SPNAME <CHTYPE .LBL ATOM>>>
+                               <NOT <MEMQ .LBL ,TZL>>
+                               <EMIT .LBL>>>
+                  .LBL>>
+       <EMIT .ELSE>
+       .VAL1>
+
+<DEFINE XNOT (FRM "AUX" (OP <1 .FRM>))
+       #DECL ((FRM) FORM (OP) ATOM)
+       <FORM <COND (<==? .OP AND> OR) (AND)>
+             !<MAPF ,LIST
+                    <FUNCTION (ITM)
+                              #DECL ((ITM) ANY)
+                              <FORM NOT .ITM>>
+                    <REST .FRM>>>>
+
+<DEFINE PREDGEN TOP (ITM
+                    "OPTIONAL" (VAL? <>)
+                    "AUX" THEN ELSE ORT (SENSE #SENSE TRUE) (LBL ()) OP
+                          (VAL <>) LL L2)
+   #DECL ((ITM) <OR ATOM <PRIMTYPE LIST>> (THEN ELSE LL ORT L2) LABEL
+         (LBL) <LIST [REST <OR FALSE LABEL>]> (OP) ATOM (SENSE) SENSE
+         (VAL) <OR FALSE ATOM SENSE FLBL> (VAL?) <OR FALSE LOCAL>)
+   <COND (<AND <TYPE? .ITM LIST FORM>
+              <NOT <LENGTH? .ITM 1>>
+              <TYPE? <1 .ITM> ATOM>
+              <GASSIGNED? <1 .ITM>>
+              <TYPE? ,<1 .ITM> MACRO>>
+         <SET ITM <EXPAND <CHTYPE .ITM FORM>>>
+         <AGAIN .TOP>)>
+   <COND
+    (<L/G? .ITM>
+     <EMIT #INS ZERO? <VARCHK .ITM>>
+     <CHTYPE [(<GENLBL "THN">) #SENSE FALSE] FLBL>)
+    (<AND <TYPE? .ITM LIST FORM> <NOT <EMPTY? .ITM>>>
+     <SET OP <1 .ITM>>
+     <COND (<==? .OP NOT>
+           <AND <LENGTH? .ITM 1> <COMPERR BAD-SYNTAX!-ERRORS NOT>>
+           <SET ITM <2 .ITM>>
+           <COND (<AND <TYPE? .ITM FORM> <MEMQ <1 .ITM> '![AND OR!]>>
+                  <SET OP <1 .ITM>>
+                  <SET ITM <XNOT .ITM>>
+                  <AGAIN .TOP>)
+                 (<SET SENSE <ZNOT .SENSE>>)>)>
+     <COND
+      (<MEMQ .OP '[AND OR]>
+       <SET THEN <GENLBL "THN">>
+       <SET ELSE <GENLBL "ELS">>
+       <AND <==? .OP OR> .VAL? <SET ORT <GENLBL "ORT">>>
+       <MAPR <>
+       <FUNCTION (L "AUX" (FOO <1 .L>) VAL SNS) 
+          #DECL ((L) LIST (FOO) ANY (VAL) <OR SENSE ATOM FLBL> (SNS) SENSE)
+          <AND <LENGTH? .L 1> <MAPLEAVE T>>
+          <SET VAL <GEN .FOO>>
+          <COND (<TYPE? .VAL FLBL> <SET LBL <1 .VAL>> <SET SNS <2 .VAL>>)
+                (<SET SNS .SENSE>)>
+          <COND (<AND <==? .OP OR> .VAL?>)
+                (<AND <TYPE? .VAL ATOM> <N==? .VAL ?NOVAL>>
+                 <EMIT #INS ZERO? <CHTYPE .VAL LOCAL>>
+                 <SET SNS <ZNOT .SNS>>)>
+          <COND
+           (<==? .OP AND> <EMIT <ZNOT .SNS> <CHTYPE .ELSE JUMP>>)
+           (<==? .OP OR>
+            <AND .VAL? <SET LL <GENLBL "ORP">>>
+            <COND (<AND .VAL? <==? .VAL ?NOVAL>>
+                   <EMIT #INS PUSH 1>
+                   <EMIT #INS JUMP <CHTYPE .THEN JUMP>>)
+                  (<AND .VAL? <TYPE? .VAL ATOM>>
+                   <SET FOO
+                        <COND (<==? .VAL STACK>
+                               <COND (<NOT <MEMQ #LOCAL ?ORTMP ,TEMPS>>
+                                      <SETG TEMPS (#LOCAL ?ORTMP !,TEMPS)>)>
+                               <EMIT #INS POP ?ORTMP>
+                               #LOCAL ?ORTMP)
+                              (<CHTYPE .VAL LOCAL>)>>
+                   <EMIT #INS ZERO? .FOO>
+                   <EMIT .SNS <CHTYPE .LL JUMP>>
+                   <EMIT #INS PUSH .FOO>
+                   <EMIT #INS JUMP <CHTYPE .THEN JUMP>>
+                   <EMIT .LL>)
+                  (<AND .VAL? <TYPE? .VAL SENSE>>
+                   <EMIT .SNS <CHTYPE .ORT JUMP>>)
+                  (<==? .VAL ?NOVAL>
+                   <EMIT #INS JUMP <CHTYPE .THEN JUMP>>
+                   <INFO "
+ ** WARNING OR clause always true " .ITM>)
+                  (<EMIT .SNS <CHTYPE .THEN JUMP>>)>)>
+          <COND (<NOT <EMPTY? .LBL>>
+                 <AND <1 .LBL> <EMIT <1 .LBL>>>
+                 <MAPF <>
+                       <FUNCTION (L) 
+                               #DECL ((L) <OR FALSE LABEL>)
+                               <AND .L <EMIT .L>>>
+                       <REST .LBL>>)>>
+       <REST .ITM>>
+       <COND (<N==? .OP OR> <SET VAL <GEN <NTH .ITM <LENGTH .ITM>> .VAL?>>)
+            (T
+             <SET VAL <GEN <NTH .ITM <LENGTH .ITM>>>>
+             <COND (.VAL?
+                    <COND (<TYPE? .VAL SENSE>
+                           <EMIT .VAL <CHTYPE .ORT JUMP>>
+                           <EMIT #INS PUSH 0>
+                           <EMIT #INS JUMP <CHTYPE .THEN JUMP>>)
+                          (<==? .VAL ?NOVAL>
+                           <EMIT #INS JUMP <CHTYPE .ORT JUMP>>)
+                          (<TYPE? .VAL ATOM>
+                           <OR <==? .VAL STACK>
+                               <EMIT #INS PUSH <CHTYPE .VAL LOCAL>>>)>)>)>
+       <COND (<TYPE? .VAL ATOM>
+             <COND (<AND .VAL? <N==? .OP OR>>
+                    <COND (<==? .VAL? <CHTYPE .VAL LOCAL>>)
+                          (<XEMIT .VAL? .VAL>)>)
+                   (<AND <==? .OP OR> .VAL?>)
+                   (<==? .VAL ?NOVAL>)
+                   (<EMIT #INS ZERO? <CHTYPE .VAL LOCAL>>
+                    <SET SENSE <ZNOT .SENSE>>)>)>
+       <COND (<TYPE? .VAL FLBL> <SET LBL <1 .VAL>> <SET SENSE <2 .VAL>>)
+            (<AND .VAL? <==? .OP AND>>
+             <EMIT #INS JUMP <CHTYPE <SET LL <GENLBL "PRD">> JUMP>>
+             <EMIT .ELSE>
+             <XEMIT .VAL? 0>
+             <EMIT .LL>)
+            (<TYPE? .VAL ATOM>)
+            (<SET SENSE .VAL>)>)
+      (T <SET VAL <GEN .ITM>>)>
+     <COND (<AND <==? .OP NOT> .VAL?>
+           <SET LL <GENLBL "PRD">>
+           <COND (<TYPE? .VAL SENSE> <EMIT .VAL <CHTYPE .LL JUMP>>)
+                 (<N==? .VAL ?NOVAL>
+                  <EMIT #INS ZERO?
+                        <CHTYPE .VAL LOCAL>
+                        #SENSE FALSE
+                        <CHTYPE .LL JUMP>>)>
+           <COND (<==? .VAL ?NOVAL> <EMIT #INS PUSH 0>)
+                 (T
+                  <EMIT #INS PUSH 1>
+                  <EMIT #INS JUMP <CHTYPE <SET L2 <GENLBL "PRD">> JUMP>>
+                  <EMIT .LL #INS PUSH 0>
+                  <EMIT .L2>)>
+           <COND (<N==? .VAL? #LOCAL STACK>
+                  <EMIT #INS SET <CHTYPE .VAL? ATOM> "," #LOCAL STACK>)>)
+          (<AND <TYPE? .VAL ATOM>
+                <N==? .VAL ?NOVAL>
+                <NOT <MEMQ .OP '![AND OR!]>>>
+           <EMIT #INS ZERO? <CHTYPE .VAL LOCAL>>
+           <SET SENSE <ZNOT .SENSE>>)>
+     <COND (<AND .VAL? <==? .OP OR>>
+           <EMIT #INS JUMP <CHTYPE .THEN JUMP>>
+           <EMIT .ORT>
+           <EMIT #INS PUSH 1>
+           <EMIT .THEN>
+           <COND (<N==? .VAL? #LOCAL STACK>
+                  <EMIT #INS POP <CHTYPE .VAL? ATOM>>)>
+           <CHTYPE .VAL? ATOM>)
+          (.VAL? <CHTYPE .VAL? ATOM>)
+          (<CHTYPE [(<COND (<==? .OP AND> .ELSE) (<==? .OP OR> .THEN)> !.LBL)
+                    .SENSE]
+                   FLBL>)>)
+    (<COMPERR BAD-SYNTAX!-ERRORS PREDICATE-CLAUSE>)>>
+
+<DEFINE VARCHK (FRM "AUX" (VAR <2 .FRM>))
+       #DECL ((FRM) <FORM ATOM ATOM> (VAR) ATOM)
+       <COND (<==? <1 .FRM> LVAL>
+              <COND (<MEMQ .VAR ,LOCALS>)
+                    (<COMPERR UNBOUND-VARIABLE!-ERRORS .FRM>)>
+              <CHTYPE .VAR LOCAL>)
+             (T
+              <COND (<MEMQ .VAR ,LOCALS>
+                     <COMPERR LOCAL-USED-IN-GLOBAL-REFERENCE!-ERRORS .FRM>)
+                    (<CHTYPE .VAR GLOBAL>)>)>>
+
+<DEFINE GENLBL (STR "AUX" (INITIAL <GET INITIAL OBLIST>)) 
+       #DECL ((STR) STRING (INITIAL) OBLIST)
+       <SET STR <STRING "?" .STR <UNPARSE <SETG HILBL <+ ,HILBL 1>>>>>
+       <CHTYPE <OR <LOOKUP .STR .INITIAL> <INSERT .STR .INITIAL>> LABEL>>
+               
+<DEFINE EMIT ("TUPLE" TUP) 
+       #DECL ((TUP) <TUPLE [REST ANY]>)
+       <MAPF <>
+             <FUNCTION (ITM) 
+                     #DECL ((ITM) ANY)
+                     <SETG ZL <REST <PUTREST ,ZL (.ITM)>>>>
+             .TUP>>
+
+<DEFINE GENT (ITM "OPTIONAL" (VAL? <>) "AUX" VAL) 
+       #DECL ((ITM) <OR 'T STRING FIX <PRIMTYPE LIST>> (VAL?) <OR FALSE
+                                                                  LOCAL>
+              (VAL) ANY)
+       <COND (<==? .ITM T> ?NOVAL)
+             (T
+              <COND (<TYPE? <SET VAL <GEN .ITM .VAL?>> FLBL>
+                     <MAPF <>
+                           <FUNCTION (LBL) <AND .LBL <EMIT .LBL>>>
+                           <1 .VAL>>
+                     <2 .VAL>)
+                    (.VAL)>)>>
+
+<DEFINE GEN (ARG
+            "OPTIONAL" (VAL <>)
+            "AUX" LEN (FIRST T) OP ATM (NXT <>) (SENSE #SENSE TRUE) OPATM
+                  OPDEF ITM L L2)
+   #DECL ((ARG) <OR <PRIMTYPE LIST> STRING FIX ATOM>
+         (ITM) <OR STRING LOCAL FIX <PRIMTYPE LIST>>
+         (FIRST VAL ATM OPATM) <OR FALSE <PRIMTYPE ATOM>> (OP) <OR ATOM FIX>
+         (OPDEF) OPDEF (NXT) ANY (SENSE) SENSE (LEN) FIX (L L2) LABEL)
+   <COND (<=? .ARG '<>> <SET ARG '<RFALSE>>)>
+   <COND
+    (<TYPE? .ARG ATOM> .ARG)
+    (<L/G? .ARG> <CHTYPE <VARCHK .ARG> ATOM>)
+    (T
+     <COND (<AND <TYPE? .ARG LIST FORM>
+                <TYPE? <1 .ARG> ATOM>
+                <GASSIGNED? <1 .ARG>>
+                <TYPE? ,<1 .ARG> MACRO>>
+           <SET ARG <EXPAND <CHTYPE .ARG FORM>>>
+           T)>
+     <SET ITM .ARG>
+     <COND (<NOT <TYPE? .ITM FIX>> <SET LEN <LENGTH .ARG>>) (<SET LEN 0>)>
+     <COND (<AND <G? .LEN 2>
+                <MEMQ <1 .ITM> '![SET SETG!]>
+                <TYPE? <3 .ITM> FORM>
+                <NOT <EMPTY? <3 .ITM>>>
+                <NOT <L/G? <3 .ITM>>>>
+           <COND (<TYPE? <2 .ITM> ATOM>
+                  <SET VAL <CHTYPE <2 .ITM> LOCAL>>
+                  <SET ITM <3 .ITM>>)
+                 (<L/G? <SET NXT <2 .ITM>>>
+                  ;<PUT .ITM 2 <2 .NXT>>
+                  <INFO "
+ ** SET/SETG of variable argument noted: " .ITM>)>)>
+     <COND
+      (<TYPE? .ITM FIX STRING LOCAL>
+       <COND (<TYPE? .ITM STRING>
+             <SET ITM <CHTYPE <PARSE <NXTSTR .ITM>> LOCAL>>)>
+       <COND (<==? .VAL #LOCAL STACK> <EMIT #INS PUSH .ITM>)
+            (.VAL <EMIT #INS SET <CHTYPE .VAL ATOM> "," .ITM>)>
+       <OR <AND .VAL <CHTYPE .VAL ATOM>> .SENSE>)
+      (<NOT <TYPE? <SET NXT <1 .ITM>> ATOM FIX>>
+       <COMPERR SYNTAX-ERROR!-ERRORS .ITM>)
+      (<==? <SET OP .NXT> COND>
+       <AND <L? .LEN 2> <COMPERR SYNTAX-ERROR!-ERRORS COND>>
+       <CONDGEN <REST .ITM> .VAL>)
+      (<==? .OP REPEAT> <PROGGEN <REST .ITM> .VAL T>)
+      (<==? .OP PROG> <PROGGEN <REST .ITM> .VAL>)
+      (<AND <==? .OP RETURN> <ASSIGNED? LRTN>>
+       <COND (.LPROGVAL
+             <COND (<==? .LEN 1> <XEMIT .LPROGVAL 1>)
+                   (<TYPE? <2 .ITM> FIX ATOM> <XEMIT .LPROGVAL <2 .ITM>>)
+                   (T <XEMIT .LPROGVAL <GEN <2 .ITM> .LPROGVAL>>)>)>
+       <EMIT #INS JUMP <CHTYPE .LRTN JUMP>>
+       .SENSE)
+      (<==? .OP AGAIN> <EMIT #INS JUMP <CHTYPE .LPROG JUMP>> ?NOVAL)
+      (<==? .OP TAG> <EMIT <CHTYPE <2 .ITM> RLABEL>> ?NOVAL)
+      (T
+       <SET ITM <OPFCN .ITM .VAL>>
+       <SET VAL <1 .ITM>>
+       <SET OP <2 .ITM>>
+       <SET ITM <REST .ITM>>
+       <SET LEN <LENGTH .ITM>>
+       <COND
+       (<==? .OP PROG>
+        <SET NXT <PROGGEN <REST .ITM> .VAL>>
+        <COND (.VAL <EMIT " >" .VAL>)>
+        <OR .VAL .NXT>)
+       (T
+        <COND
+         (<SET OPATM <LOOKUP <SPNAME .OP> ,OPS>>
+          <SET OPDEF ,.OPATM>
+          <COND (<OR <G? <- .LEN 1> <OPMAX .OPDEF>>
+                     <L? <- .LEN 1> <OPMIN .OPDEF>>>
+                 <COMPERR WRONG-NUMBER-OF-ARGUMENTS!-ERRORS .ITM>)>
+          <COND
+           (<OPUSER .OPDEF>
+            <SET OP CALL>
+            <AND <G? .LEN 4>
+                 <COMPERR MORE-THAN-THREE-ARGUMENTS-TO-ROUTINE!-ERRORS .ITM>>
+            <SET ITM (CALL !.ITM)>)>)
+         (T
+          <AND <G? .LEN 4>
+               <COMPERR MORE-THAN-THREE-ARGUMENTS-TO-ROUTINE!-ERRORS .ITM>>
+          <SET ITM (CALL !.ITM)>
+          <SETG FREFS (<CHTYPE [.ZNAM .OP <- .LEN 1>] FREF> !,FREFS)>
+          <SET OP CALL>
+          <SET OPDEF ,CALL!-OPS>)>
+        <COND
+         (<MEMQ .OP '![AND OR NOT!]> <PREDGEN .ITM .VAL>)
+         (T
+          <TMPCHK .ITM>
+          <EMIT <SETG LSTINS <CHTYPE .OP INS>>>
+          <MAPF <>
+           <FUNCTION (ARG) 
+                   #DECL ((ARG) ANY)
+                   <COND (.FIRST
+                          <SET FIRST <>>
+                          <AND <==? .OP CALL>
+                               <==? <PRIMTYPE .ARG> ATOM>
+                               <SET ARG <CHTYPE .ARG CALL>>>)
+                         (<EMIT ",">)>
+                   <COND (<TYPE? .ARG STRING> <SET ARG <CHTYPE .ARG RSTRING>>)
+                         (<NOT <TYPE? .ARG ATOM CALL FIX LOCAL GLOBAL>>
+                          <COND (<L/G? .ARG>
+                                 <SET ARG <CHTYPE <2 .ARG> LOCAL>>)
+                                (<COMPERR BAD-ARGUMENT!-ERRORS .OP .ARG>)>)
+                         (<TYPE? .ARG ATOM>
+                          <COND (<OR <LOOKUP <SPNAME .ARG> ,CONST>
+                                     <LOOKUP <SPNAME .ARG> ,UCONST>>
+                                 <SET ARG <CHTYPE .ARG LOCAL>>)>)>
+                   <EMIT .ARG>>
+           <REST .ITM>>
+          <COND (<AND .VAL <OPVAL .OPDEF>>
+                 <OR <==? .VAL #LOCAL STACK> <EMIT " >" .VAL>>)>
+          <COND (<AND <OPVAL .OPDEF> <NOT <OPPRED .OPDEF>>>
+                 <OR <AND .VAL <CHTYPE .VAL ATOM>> STACK>)
+                (<NOT <OPPRED .OPDEF>>
+                 <COND (.VAL <XEMIT .VAL 1> <CHTYPE .VAL ATOM>) (?NOVAL)>)
+                (<AND .VAL
+                      <N==? .VAL #LOCAL STACK>
+                      <OPPRED .OPDEF>
+                      <OPVAL .OPDEF>>
+                 .SENSE)
+                (.VAL
+                 <EMIT .SENSE <CHTYPE <SET L <GENLBL "PRD">> JUMP>>
+                 <EMIT #INS PUSH 0>
+                 <EMIT #INS JUMP <CHTYPE <SET L2 <GENLBL "PRD">> JUMP>>
+                 <EMIT .L #INS PUSH 1>
+                 <EMIT .L2>
+                 <COND (<==? .VAL #LOCAL STACK>)
+                       (<EMIT #INS SET <CHTYPE .VAL ATOM> "," #LOCAL STACK>)>
+                 <CHTYPE .VAL ATOM>)
+                (<==? .OP RFALSE> #SENSE FALSE)
+                (.SENSE)>)>)>)>)>>
+
+<DEFINE XEMIT (WHR WHAT)
+       #DECL ((WHR) LOCAL (WHAT) <OR ATOM FIX>)
+       <COND (<==? .WHR #LOCAL STACK>
+              <EMIT #INS PUSH
+                    .WHAT>)
+             (<EMIT #INS SET
+                    <CHTYPE .WHR ATOM>
+                    ","
+                    <COND (<TYPE? .WHAT FIX> .WHAT)
+                          (<CHTYPE .WHAT LOCAL>)>>)>>
+
+<SETG TMPS <REST '![?TMP4 ?TMP3 ?TMP2 ?TMP1 STACK!] 5>>
+
+<GDECL (TMPS) <UVECTOR [REST ATOM]>>
+
+<DEFINE TMPCHK (ITM "AUX" VARS TMPS) 
+   #DECL ((ITM) LIST (VARS) FIX (TMPS) <UVECTOR [REST ATOM]>)
+   <MAPR <>
+    <FUNCTION (X "AUX" (Y <1 .X>)) 
+           <COND (<TYPE? .Y STRING>
+                  <COND (<MEMQ <1 .ITM> '![PRINTI PRINTR!]>)
+                        (T <PUT .X 1 <CHTYPE <PARSE <NXTSTR .Y>> LOCAL>>)>)
+                 (<==? .Y T> <PUT .X 1 1>)
+                 (<==? .Y '<>> <PUT .X 1 0>)>>
+    .ITM>
+   <SET VARS
+       <MAPF ,+
+             <FUNCTION (ELEM) 
+                     #DECL ((ELEM) ANY)
+                     <COND (<OR <L/G? .ELEM> <NOT <TYPE? .ELEM FORM>>> 0)
+                           (1)>>
+             .ITM>>
+   <SET TMPS <BACK ,TMPS .VARS>>
+   <MAPR <>
+        <FUNCTION (L
+                   "AUX" (ELEM <1 .L>)
+                         (TMP <CHTYPE <OR <EMPTY? .TMPS> <1 .TMPS>> LOCAL>))
+                #DECL ((L) LIST (ELEM) ANY (TMP) LOCAL)
+                <COND (<OR <L/G? .ELEM> <NOT <TYPE? .ELEM FORM>>>)
+                      (T
+                       <PUT .L 1 <CHTYPE <GEN .ELEM .TMP> LOCAL>>
+                       <OR <==? .TMP #LOCAL STACK>
+                           <MEMQ .TMP ,TEMPS>
+                           <SETG TEMPS (.TMP !,TEMPS)>>
+                       <SET TMPS <REST .TMPS>>)>>
+        .ITM>>
+
+<DEFINE L/G? (ELEM)
+       #DECL ((ELEM) ANY)
+       <AND <TYPE? .ELEM FORM>
+            <NOT <LENGTH? .ELEM 1>>
+            <MEMQ <1 .ELEM> '![LVAL GVAL]>>>
+
+<DEFINE CONSTANT-CHECK (ATM "AUX" (SPN <SPNAME .ATM>)) 
+       #DECL ((ATM) ATOM (SPN) STRING)
+       <COND (<OR <LOOKUP .SPN ,OBJECTS>
+                  <LOOKUP .SPN ,CONST>
+                  <LOOKUP .SPN ,UCONST>
+                  <LOOKUP .SPN ,VARS>>)
+             (<INFO "
+ ** WARNING Unknown Argument: "
+                    .ATM
+                    " / Assuming CONSTANT for present.">
+              <CONSTANT .ATM 0>)>>
+
+<DEFINE OPFCN (LST VAL "AUX" (OP <1 .LST>) (LEN <LENGTH .LST>) ATM TEMP) 
+       #DECL ((LST) <PRIMTYPE LIST> (OP) <OR FIX ATOM> (ATM) <OR ATOM FALSE>
+              (VAL) <OR <PRIMTYPE ATOM> FALSE> (LEN) FIX
+              (TEMP) <LIST ANY ATOM ANY>)
+       <COND (<AND <TYPE? .OP ATOM> <SET ATM <LOOKUP <SPNAME .OP> ,CNV>>>
+              <SET OP ,.ATM>
+              <PUT .LST 1 .OP>)>
+       <COND (<TYPE? .OP FIX>
+              <COND (<==? .LEN 2> <SET LST (GET <2 .LST> .OP)>)
+                    (<==? .LEN 3> <SET LST (PUT <2 .LST> .OP <3 .LST>)>)
+                    (<COMPERR SYNTAX-ERROR!-ERRORS .LST>)>)
+             (<AND <MEMQ .OP '![GRTR? LESS?!]>
+                   <NOT <LENGTH? .LST 2>>
+                   <TYPE? <2 .LST> FORM>
+                   <NOT <L/G? <2 .LST>>>
+                   <NOT <LENGTH? <2 .LST> 2>>
+                   <MEMQ <1 <2 .LST>> '![SET SETG!]>
+                   <SET TEMP <OPFCN <3 <2 .LST>> <2 <2 .LST>>>>>
+              <COND (<==? .OP GRTR?>
+                     <COND (<==? <2 .TEMP> INC>
+                            <SET LST (IGRTR? <3 .TEMP> <3 .LST>)>)>)
+                    (<==? .OP LESS?>
+                     <COND (<==? <2 .TEMP> DEC>
+                            <SET LST (DLESS? <3 .TEMP> <3 .LST>)>)>)>)
+             (<AND <==? .OP SUB> <==? .LEN 2>>
+              <SET LST (SUB 0 <2 .LST>)>)
+             (<AND <==? .OP ADD> <==? .LEN 2>>
+              <SET LST (ADD 1 <2 .LST>)>)
+             (<AND <MEMQ .OP '![ADD SUB!]>
+                   <MEMQ 1 .LST>
+                   <AND .VAL
+                        <OR <MEMBER <FORM LVAL <CHTYPE .VAL ATOM>> .LST>
+                            <MEMBER <FORM GVAL <CHTYPE .VAL ATOM>> .LST>>>>
+              <SET VAL <>>
+              <SET LST <INC/DEC .OP .LST>>)
+             (<AND <MEMQ .OP '![IGRTR? DLESS? INC DEC!]>
+                   <NOT <LENGTH? .LST 1>>
+                   <TYPE? <2 .LST> FORM>>
+              <INFO "
+  ** WARNING Variable argument to " .OP ": " <2 .LST>>)
+             (<==? .OP 1?> <SET LST (EQUAL? <2 .LST> 1)>)
+             (<==? .OP L=?>
+              <SET LST (NOT <CHTYPE (GRTR? !<REST .LST>) FORM>)>)
+             (<==? .OP G=?>
+              <SET LST (NOT <CHTYPE (LESS? !<REST .LST>) FORM>)>)
+             (<==? .OP N==?>
+              <SET LST (NOT <CHTYPE (EQUAL? !<REST .LST>) FORM>)>)
+             (<AND <==? .OP EQUAL?> <==? .LEN 3> <==? <3 .LST> 0>>
+              <SET LST (ZERO? <2 .LST>)>)
+             (<AND <MEMQ .OP '![ADD SUB MUL DIV!]> <G? .LEN 3>>
+              <SET LST <CHTYPE <XARITH .OP <REST .LST>> LIST>>)
+             (<AND <MEMQ .OP '![FSET? FSET FCLEAR!]>
+                   <NOT <LENGTH? .LST 2>>
+                   <TYPE? <3 .LST> ATOM>>
+              <PUT .LST
+                   3
+                   <CHTYPE <PARSE <STRING "F?" <SPNAME <3 .LST>>>> LOCAL>>)
+             (<AND <MEMQ .OP '![GETP PUTP GETPT NEXTP!]>
+                   <NOT <LENGTH? .LST 2>>
+                   <TYPE? <3 .LST> ATOM>>
+              <PUT .LST
+                   3
+                   <CHTYPE <PARSE <STRING "P?" <SPNAME <3 .LST>>>> LOCAL>>)>
+       (.VAL !.LST)>
+
+<DEFINE INC/DEC (OP LST)
+       #DECL ((OP) ATOM (LST) <<OR LIST FORM> [3 ANY]>)
+       <LIST <COND (<==? .OP ADD> INC) (DEC)>
+             <2 <COND (<==? <2 .LST> 1> <3 .LST>)
+                      (<2 .LST>)>>>>
+
+<DEFINE XARITH (OP LST) 
+       #DECL ((LST) LIST (OP) ATOM)
+       <LIST PROG
+             <FORM .OP <1 .LST> <2 .LST>>
+             !<MAPF ,LIST
+                    <FUNCTION (ANY) <FORM .OP <FORM LVAL STACK> .ANY>>
+                    <REST .LST 2>>>>
+
+<DEFINE PEEPH (LST OUTCHAN "AUX" (TZL ,TZL) (OPT 0) QL) 
+   #DECL ((LST TZL) LIST (OUTCHAN) CHANNEL (OPT) FIX)
+   <REPEAT ()
+     <SET OPT 0>
+     <REPEAT ((L .LST) (LL .LST) ITM M (NXT <>))
+       #DECL ((L LL QL) LIST (ITM NXT) ANY (M) <OR FALSE LIST>)
+       <COND
+       (<EMPTY? <SET L <REST .L>>> <RETURN>)
+       (<TYPE? <SET ITM <1 .L>> JUMP>
+        <COND
+         (<SET M
+               <OR <MEMQ <CHTYPE .ITM LABEL> .L>
+                   <MEMQ <CHTYPE .ITM RLABEL> .TZL>>>
+          <AND <NOT <LENGTH? .M 1>>
+               <TYPE? <2 .M> LABEL>
+               <MAPF <>
+                     <FUNCTION (X) 
+                             #DECL ((X) ANY)
+                             <COND (<TYPE? .X LABEL>
+                                    <PUT .L 1 <CHTYPE .X JUMP>>
+                                    <SET OPT <+ .OPT 1>>)
+                                   (<MAPLEAVE>)>>
+                     <REST .M>>>
+          <COND
+           (<=? <SET NXT
+                     <1 <SET M
+                             <MAPR <>
+                                   <FUNCTION (L "AUX" (N <1 .L>)) 
+                                           #DECL ((L) LIST (N) ANY)
+                                           <COND (<TYPE? .N LABEL>)
+                                                 (<MAPLEAVE .L>)>>
+                                   .M>>>>
+                #INS JUMP>
+            <PUT .L 1 <2 .M>>
+            <SET OPT <+ .OPT 1>>)
+           (<AND <==? .NXT #INS RETURN> <NOT <TYPE? <1 .QL> SENSE>>>
+            <PUT .QL 1 .NXT>
+            <PUT .L 1 <2 .M>>)
+           (<OR <==? .NXT #INS RFALSE>
+                <AND <==? .NXT #INS RETURN> <MEMQ <2 .M> '[FALSE 0]>>>
+            <SET OPT <+ .OPT 1>>
+            <PUT .L 1 #JUMP FALSE>)
+           (<OR <==? .NXT #INS RTRUE>
+                <AND <==? .NXT #INS RETURN> <MEMQ <2 .M> '[T 1]>>>
+            <SET OPT <+ .OPT 1>>
+            <PUT .L 1 #JUMP TRUE>)>)
+         (<MEMQ .ITM '![#JUMP TRUE #JUMP FALSE!]>)
+         (<COMPERR INTERNAL-INCONSISTENCY!-ERRORS
+                   LABEL-NOT-FOUND!-ERRORS
+                   <2 .L>>)>
+        <SET LL <REST .LL>>)
+       (<AND <SET QL .L>
+             <==? .ITM #INS JUMP>
+             <SET NXT <MEMQ <CHTYPE <2 .L> LABEL> .LST>>
+             <SET NXT <NXTN .NXT INS>>
+             <==? <1 .NXT> #INS RSTACK>>
+        <PUT .L 1 #INS RSTACK>
+        <PUT .L 2 "">
+        <SET LL <REST .LL>>
+        <SET OPT <+ .OPT 1>>)
+       (<AND <TYPE? .ITM LABEL RLABEL> <NOT <MEMQ <CHTYPE .ITM JUMP> .LST>>>
+        <PUTREST .LL <REST .L>>
+        <SET OPT <+ .OPT 1>>)
+       (T <SET LL <REST .LL>>)>>
+     <REPEAT ((L <REST .LST>) (CR <>) XL ITM NXT LBL (CODLEN 0))
+       #DECL ((L) LIST (CR) <OR ATOM FALSE> (XL) <OR LIST FALSE> (ITM NXT) ANY
+             (LBL) LABEL (CODLEN) FIX)
+       <COND
+       (<EMPTY? .L> <RETURN .CODLEN>)
+       (<AND <==? <SET ITM <1 .L>> #INS JUMP>
+             <NOT <LENGTH? .L 1>>
+             <==? <2 .L> #JUMP TRUE>>
+        <PUT .L 1 #INS RTRUE>
+        <PUT .L 2 "">
+        <SET OPT <+ .OPT 1>>)
+       (<AND <==? .ITM #INS JUMP>
+             <SET NXT <2 .L>>
+             <MAPF <>
+                   <FUNCTION (X) 
+                           <COND (<AND <NOT <TYPE? .X LABEL>> <N=? .X "">>
+                                  <MAPLEAVE <>>)
+                                 (<==? .X <CHTYPE .NXT LABEL>> <MAPLEAVE T>)>>
+                   <MAPR <>
+                         <FUNCTION (X) 
+                                 <COND (<TYPE? <1 .X> LABEL> <MAPLEAVE .X>)
+                                       (<=? <1 .X> "">)
+                                       (<MAPLEAVE <>>)>>
+                         <REST .L 2>>>>
+        <PUT .L 1 "">
+        <PUT .L 2 "">)
+       (<AND <==? .ITM #INS ZERO?> <NOT <TYPE? <3 .L> SENSE>>>
+        <PUT .L 1 "">
+        <PUT .L 2 "">
+        <SET OPT <+ .OPT 1>>)
+       (<AND <==? .ITM #INS PUSH> <==? <2 .L> 0> <==? <3 .L> #INS RSTACK>>
+        <PUT .L 1 #INS RFALSE>
+        <PUT .L 2 "">
+        <PUT .L 3 "">
+        <SET OPT <+ .OPT 1>>)
+       (<AND <==? .ITM #INS PUSH> <==? <2 .L> 1> <==? <3 .L> #INS RSTACK>>
+        <PUT .L 1 #INS RTRUE>
+        <PUT .L 2 "">
+        <PUT .L 3 "">
+        <SET OPT <+ .OPT 1>>)
+       (<AND <==? .ITM #INS JUMP>
+             <NOT <LENGTH? .L 1>>
+             <==? <2 .L> #JUMP FALSE>>
+        <PUT .L 1 #INS RFALSE>
+        <PUT .L 2 "">
+        <SET OPT <+ .OPT 1>>)
+       (<AND <==? .ITM #INS RETURN>
+             <NOT <LENGTH? .L 1>>
+             <MEMQ <SET NXT <2 .L>> '[T TRUE 1]>>
+        <PUT .L 1 #INS RTRUE>
+        <PUT .L 2 "">
+        <SET OPT <+ .OPT 1>>)
+       (<AND <==? .ITM #INS ZERO?> <==? <3 .L> #INS JUMP>>
+        <PUT .L 1 "">
+        <PUT .L 2 #INS FSTACK>)
+       (<AND <==? .ITM #INS RETURN>
+             <NOT <LENGTH? .L 1>>
+             <==? .NXT #LOCAL STACK>>
+        <PUT .L 1 #INS RSTACK>
+        <PUT .L 2 "">
+        <SET OPT <+ .OPT 1>>)
+       (<AND <==? .ITM #INS JUMP>
+             <NOT <LENGTH? .L 2>>
+             <==? <SET NXT <2 .L>>
+                  <CHTYPE <1 <NXTN <REST .L 2> LABEL>> JUMP>>>
+        <MAPR <>
+              <FUNCTION (LL) 
+                      <COND (<==? <1 .LL> <CHTYPE .NXT LABEL>> <MAPLEAVE T>)
+                            (<PUT .LL 1 "">)>>
+              .L>)
+       (<AND <==? .ITM #INS RETURN>
+             <NOT <LENGTH? .L 1>>
+             <MEMQ .NXT '[FALSE 0 '<>]>>
+        <PUT .L 1 #INS RFALSE>
+        <PUT .L 2 "">
+        <SET OPT <+ .OPT 1>>)
+       (<TYPE? .ITM SENSE>
+        <COND (<AND <NOT <LENGTH? .L 3>>
+                    <MEMQ <SET NXT <2 .L>> '![#JUMP TRUE #JUMP FALSE!]>
+                    <==? <3 .L> #INS JUMP>>
+               <PUT .L 1 <ZNOT .ITM>>
+               <PUT .L
+                    2
+                    <COND (<TYPE? <4 .L> ATOM> <CHTYPE <4 .L> JUMP>)
+                          (<4 .L>)>>
+               <PUT .L 3 "">
+               <PUT .L
+                    4
+                    <COND (<==? .NXT #JUMP TRUE> #INS RTRUE) (#INS RFALSE)>>)
+              (<AND <NOT <LENGTH? .L 3>>
+                    <OR <AND <MEMQ <1 <SET NXT <NXTN <REST .L 2> INS>>>
+                                   '![#INS RTRUE #INS RFALSE!]>
+                             <SET NXT <1 .NXT>>>
+                        <AND <==? <1 .NXT> #INS RETURN>
+                             <MEMQ <2 .NXT> '[1 T]>
+                             <SET NXT #INS RTRUE>>
+                        <AND <==? <1 .NXT> #INS RETURN>
+                             <MEMQ <2 .NXT> '[0 FALSE]>
+                             <SET NXT #INS RFALSE>>
+                        <AND <==? <1 .NXT> #INS JUMP>
+                             <MEMQ <SET NXT <2 .NXT>>
+                                   '![#JUMP TRUE #JUMP FALSE!]>
+                             <SET NXT
+                                  <AND <==? .NXT #JUMP TRUE> #INS RTRUE>>>>
+                    <NOT <MEMQ <CHTYPE <2 .L> RLABEL> .TZL>>
+                    <SET LBL <CHTYPE <2 .L> LABEL>>
+                    <MAPF <>
+                          <FUNCTION (ITM) 
+                                  <COND (<TYPE? .ITM LABEL>
+                                         <AND <==? .ITM .LBL> <MAPLEAVE T>>)
+                                        (<MAPLEAVE <>>)>>
+                          <NXTN <REST .L 2> LABEL T>>>
+               <PUT .L 1 <ZNOT .ITM>>
+               <PUT .L
+                    2
+                    <COND (<==? .NXT #INS RTRUE> #JUMP TRUE) (#JUMP FALSE)>>
+               <SET NXT <NXTN <REST .L 2> INS>>
+               <COND (<MEMQ <1 .NXT> '![#INS RTRUE #INS RFALSE!]>
+                      <PUT .NXT 1 "">)
+                     (<PUT .NXT 1 ""> <PUT .NXT 2 "">)>)>)
+       (<AND <==? .ITM #INS RTRUE> <NOT <LENGTH? .L 1>> <==? <2 .L> .ITM>>
+        <PUT .L 2 "">
+        <SET OPT <+ .OPT 1>>)
+       (<AND <==? .ITM #INS PUSH> <==? <3 .L> #INS RSTACK>>
+        <PUT .L 1 #INS RETURN>
+        <PUT .L 3 "">)>
+       <SET L <REST .L>>>
+     <AND <0? .OPT> <RETURN>>>
+   <COUT .LST>>
+
+<SETG PRINTROPT 0>
+
+<DEFINE PRINTR-OPT (LST)
+       #DECL ((LST) LIST)
+       <MAPR <>
+             <FUNCTION (L)
+                  #DECL ((L) LIST)
+                  <COND (<AND <==? <1 .L> #INS PRINTI>
+                              <NOT <LENGTH? .L 4>>
+                              <==? <3 .L> #INS CRLF>
+                              <==? <4 .L> #INS RTRUE>>
+                         <PUT .L 1 #INS PRINTR>
+                         <PUT .L 3 "">
+                         <PUT .L 4 "">
+                         <SETG PRINTROPT <+ ,PRINTROPT 1>>)>>
+             .LST>>
+
+<DEFINE COUT (LST "AUX" (OUTCHAN .ZCHN) HANDLE) 
+   #DECL ((LST HANDLE) LIST (OUTCHAN) CHANNEL)
+   <PRINTR-OPT .LST>
+   <CRLF>
+   <CRLF>
+   <REPEAT ((L <REST .LST>) (CR <>) XL ITM (CODLEN 0) (LSTINS #INS NOOP)
+           (LSTLBL #LABEL ??) KLUDGE)
+     #DECL ((L) LIST (CR) <OR ATOM FALSE> (XL) <OR LIST FALSE> (ITM) ANY
+           (CODLEN) FIX (LSTINS) INS (LSTLBL KLUDGE) <OR RLABEL LABEL>)
+     <COND
+      (<EMPTY? .L>
+       <COND (<==? .ITM #JUMP FALSE>
+             <PRINC "
+       RTRUE">)
+            (<==? .ITM #JUMP TRUE>
+             <PRINC "
+       RFALSE">)>
+       <RETURN .CODLEN>)
+      (<=? <1 .L> "">)
+      (<TYPE? <SET ITM <1 .L>> SENSE>
+       <COND (<NOT <OPPRED ,<LOOKUP <SPNAME <CHTYPE .LSTINS ATOM>> ,OPS>>>
+             <INFO "
+ ** WARNING - Non-predicate jump flushed "
+                   <CHTYPE .LSTINS ATOM>>
+             <PUT .L 2 "">)
+            (<==? .ITM #SENSE TRUE> <PRINC " /">)
+            (<PRINC " \\">)>)
+      (<AND <MEMQ .ITM '[#INS FIRST? #INS NEXT?]>
+           <COND (<=? <3 .L> " >">
+                  <COND (<NOT <TYPE? <5 .L> SENSE>>
+                         <SET KLUDGE <GENLBL "KLU">>
+                         <SET HANDLE <REST .L 4>>
+                         <PUTREST <REST .L 3>
+                                  <LIST #SENSE TRUE
+                                        <CHTYPE .KLUDGE JUMP>
+                                        .KLUDGE>>
+                         <PUTREST <REST .L 6> .HANDLE>)>)
+                 (<NOT <TYPE? <3 .L> SENSE>>
+                  <SET KLUDGE <GENLBL "KLU">>
+                  <SET HANDLE <REST .L 2>>
+                  <PUTREST <REST .L>
+                           <LIST #SENSE TRUE <CHTYPE .KLUDGE JUMP> .KLUDGE>>
+                  <PUTREST <REST .L 4> .HANDLE>)>
+           <>>)
+      (<TYPE? .ITM INS>
+       <SET LSTINS .ITM>
+       <COND (<NOT .CR> <CRLF> <PRINC "        ">)>
+       <SET CR <>>
+       <PRIN1 <CHTYPE .ITM ATOM>>
+       <PRINC "        ">)
+      (<TYPE? .ITM LABEL RLABEL>
+       <COND (<==? .ITM .LSTLBL>)
+            (<OR <TYPE? .ITM RLABEL> <MEMQ <CHTYPE .ITM JUMP> ,TZL>>
+             <CRLF>
+             <SET CR T>
+             <PRIN1 <CHTYPE .ITM ATOM>>
+             <PRINC ":">
+             <PRINC "  ">)>
+       <SET LSTLBL .ITM>)
+      (<OR <TYPE? .ITM LOCAL GLOBAL>
+          <AND <TYPE? .ITM ATOM>
+               <OR <COND (<MEMQ .LSTINS '[#INS CALL #INS PUTP]>
+                          <INFO 
+"
+ ** WARNING Atomic argument to routine assumed constant - "
+                                .ITM>
+                          T)>
+                   <LOOKUP <SPNAME .ITM> ,OPS>
+                   <LOOKUP <SPNAME .ITM> ,OBJECTS>>>
+          <SPECIAL-ATOM? .ITM>>
+       <PRIN1 <CHTYPE .ITM ATOM>>)
+      (<TYPE? .ITM JUMP CALL>
+       <PRIN1 <CHTYPE .ITM ATOM>>)
+      (<TYPE? .ITM RSTRING>
+       <STRING-PRINT <CHTYPE .ITM STRING>>)
+      (<TYPE? .ITM ATOM>
+       <PRINC !\'>
+       <PRINC .ITM>)
+      (<PRINC .ITM>)>
+     <COND (<AND <TYPE? .ITM INS>
+                <MEMQ .ITM
+                      '![#INS RSTACK
+                         #INS RTRUE
+                         #INS RFALSE
+                         #INS RETURN
+                         #INS JUMP!
+                         #INS PRINTR]>>
+           <COND (<==? .ITM #INS RETURN>
+                  <COND (<==? <PRIMTYPE <2 .L>> ATOM>
+                         <PRIN1 <CHTYPE <2 .L> ATOM>>)
+                        (<PRIN1 <2 .L>>)>)
+                 (<==? .ITM #INS PRINTR>
+                  <STRING-PRINT <CHTYPE <2 .L> STRING>>
+                  <PUT .L 2 "">)
+                 (<==? .ITM #INS JUMP>
+                  <PRIN1 <CHTYPE <2 .L> ATOM>>)>
+           <SET XL
+                <MAPR <>
+                      <FUNCTION (LST) 
+                              #DECL ((LST) LIST)
+                              <COND (<TYPE? <1 .LST> LABEL> <MAPLEAVE .LST>)>>
+                      .L>>
+           <SET L <OR .XL ()>>)
+          (<SET L <REST .L>>)>>>
+
+<DEFINE STRING-PRINT (STR "AUX" (OUTCHAN .ZCHN))
+       #DECL ((STR) STRING (OUTCHAN) CHANNEL)
+       <PRINC "\"">
+        <MAPR <>
+             <FUNCTION (S "AUX" (CHR <1 .S>)) 
+                    #DECL ((S) STRING (CHR) CHARACTER)
+                    <COND (<==? .CHR !\"> <PRINC .CHR>)
+                          (<AND <==? .CHR !\.>
+                                <NOT <LENGTH? .S 3>>
+                                <==? <2 .S> !\ >
+                                <==? <3 .S> !\ >>
+                           <PUT .S 2 <ASCII 13>>)>
+                    <COND (<==? .CHR <ASCII 13>>)
+                          (<==? .CHR !\|>
+                           <CRLF>
+                           <OR <LENGTH? .S 2> <PUT .S 3 <ASCII 13>>>)
+                          (<==? .CHR <ASCII 10>> <PRINC !\ >)
+                          (T <PRINC .CHR>)>>
+             .STR>
+        <PRINC "\"">>
+
+<DEFINE SPECIAL-ATOM? (ITM "AUX" SPN)
+       #DECL ((ITM) ANY (SPN) STRING)
+       <AND <TYPE? .ITM ATOM>
+            <OR <MEMBER "PS?" <SET SPN <SPNAME .ITM>>>
+                <MEMBER "P1?" .SPN>
+                <MEMBER "W?" .SPN>>>>
+
+<DEFINE NXTN (LST TYP "OPTIONAL" (DEL <>) "AUX" VAL) 
+       #DECL ((LST) LIST (TYP) ATOM (DEL) <OR ATOM FALSE>
+              (VAL) <OR LIST FALSE>)
+       <SET VAL
+            <MAPR <>
+                  <FUNCTION (L "AUX" (ITM <1 .L>)) 
+                          #DECL ((L) LIST (ITM) ANY)
+                          <COND (<==? <TYPE .ITM> .TYP> <MAPLEAVE .L>)
+                                (<AND .DEL
+                                      <OR <N==? .L .LST>
+                                          <NOT <MEMQ <1 .L>
+                                                     '![#INS RFALSE
+                                                        #INS RTRUE
+                                                        #INS RSTACK!]>>>
+                                      <PUT .L 1 "">>)>>
+                  .LST>>
+       <OR .VAL '(T)>>
+
+<DEFINE ZNOT (ITM) 
+       #DECL ((ITM) <PRIMTYPE ATOM>)
+       <COND (<==? <CHTYPE .ITM ATOM> FALSE> #SENSE TRUE) (#SENSE FALSE)>>
+
+<SETG ERRS 0>
+
+<GDECL (ERRS) FIX>
+
+<DEFINE COMPERR ("TUPLE" T) 
+       #DECL ((T) TUPLE (VALUE) 'T)
+       <SETG ERRS <+ ,ERRS 1>>
+       <INFO "
+
+ ** Compilation error: " <1 .T>>
+       <OR <LENGTH? .T 1>
+           <INFO "
+    Relevant values: ">>
+       <MAPF <> <FUNCTION (X) <INFO .X " ">> <REST .T>>
+       <AND <ASSIGNED? ZNAM>
+            <INFO "
+Compilation of " .ZNAM " aborted.">
+            <RETURN T .ZDEF>>
+       T>\1a\1a\1a\1a\1a\1a\1a\1a\1a\0\1a\0\0\0\0\1a\1a\1a\1a\0\0\0\0\1a\1a\1a\1a\0\0\1a\1a\1a\1a\0\0\0\1a\1a\1a\1a\0\0\0\0\1a\1a\0\1a\0\0\0\1a\1a\1a\1a\1a\1a\1a\1a\1a\1a\1a\1a\0\1a\1a\1a\0\0\0\0\1a\1a\0\0\0\0\1a\1a\0\0\0\1a\1a\1a\1a\1a\1a\0\0\1a\1a\1a\1a\1a\1a\1a\1a\1a\1a\1a\1a\1a\0\0\0\1a\1a\0\0\1a\1a\0\0\1a\1a\1a\1a\0\1a\1a\1a\1a\0\0\1a\0\0\1a\1a\0\1a\1a\1a\0\0\1a\1a\0\0\1a\1a\0\0\1a\1a\1a\1a\1a\0\0\0\0\1a\1a\1a\1a\1a\0\0\0\1a\0\0\1a\1a\0\1a\1a\1a\0\1a
\ No newline at end of file
diff --git a/zork.z/zip.mud.96 b/zork.z/zip.mud.96
new file mode 100644 (file)
index 0000000..8c24833
--- /dev/null
@@ -0,0 +1,958 @@
+<PACKAGE "ZIP">
+
+<ENTRY ZIP>
+
+<USE "ZSTR" "ZOPS" "ZAC">
+
+"********** GLOBAL DEFINITIONS **********"
+
+<GDECL (OPTABLE) !<VECTOR [256 <OR OP FALSE>]>
+       (ENDLOD OBJTAB VOCTAB VOCBEG VOCWORDS VOCWLEN GLOTAB ZPC ZTOP
+       ZBOT ZLOCS ZORKID OZPC DSBOT DSJFN) FIX
+       (ZCODE) <BYTES 8>
+       (ZSTACK) <UVECTOR [REST FIX]>
+       (RBREAKS SIBREAKS INSTR DSBUF) STRING
+       (TRACE? CTRACE? DTRACE?) <OR ATOM FALSE>
+       (DSYMBOLS) <BYTES 18>>
+
+<SETG BREAKS <STRING <ASCII 10>>>
+<MANIFEST BREAKS>
+
+<SETG NOARG *400000000000*>
+<MANIFEST NOARG>
+
+<SETG INSTR <ISTRING 0>>
+
+<SETG PZVERSION 0>
+<SETG PZORKID 2>
+<SETG PENDLOD 4>
+<SETG PSTART 6>
+<SETG PVOCAB 8>
+<SETG POBJECT 10>
+<SETG PGLOBALS 12>
+<SETG PCOUNT 32>
+<SETG PCALLS 34>
+<MANIFEST PZVERSION
+         PZORKID
+         PENDLOD
+         PSTART
+         PVOCAB
+         POBJECT
+         PGLOBALS
+         PCOUNT
+         PCALLS>
+
+"********** OPERATION HANDLING FUNCTIONS **********"
+
+<DEFOPS <MOBLIST OPS> <SETG OPTABLE <IVECTOR 256 <>>>>
+
+<SETG OPDEF
+      <FUNCTION (S) 
+             <OPFUNCT ,<LOOKUP .S <GET OPS OBLIST>>
+                      ,<PARSE <STRING "OP-" .S>>>>>
+
+<DEFINE OP-EQUAL? (A1 A2 "OPTIONAL" (A3 ,NOARG) (A4 ,NOARG))
+       #DECL ((A1 A2 A3 A4) FIX)
+       <PUTPRED <OR <==? .A1 .A2> <==? .A1 .A3> <==? .A1 .A4>>>>
+<OPDEF "EQUAL?">
+
+<DEFINE OP-ZERO? (A1)
+       #DECL ((A1) FIX)
+       <PUTPRED <0? .A1>>>
+<OPDEF "ZERO?">
+
+<DEFINE OP-ADD (A1 A2)
+       #DECL ((A1 A2) FIX)
+       <PUTVAL <+ .A1 .A2>>>
+<OPDEF "ADD">
+
+<DEFINE OP-SUB (A1 A2)
+       #DECL ((A1 A2) FIX)
+       <PUTVAL <- .A1 .A2>>>
+<OPDEF "SUB">
+
+<DEFINE OP-MUL (A1 A2)
+       #DECL ((A1 A2) FIX)
+       <PUTVAL <* .A1 .A2>>>
+<OPDEF "MUL">
+
+<DEFINE OP-DIV (A1 A2)
+       #DECL ((A1 A2) FIX)
+       <PUTVAL </ .A1 .A2>>>
+<OPDEF "DIV">
+
+<DEFINE OP-MOD (A1 A2)
+       #DECL ((A1 A2) FIX)
+       <PUTVAL <MOD .A1 .A2>>>
+<OPDEF "MOD">
+
+<DEFINE OP-RANDOM (A1)
+       #DECL ((A1) FIX)
+       <PUTVAL <+ <MOD <RANDOM> .A1> 1>>>
+<OPDEF "RANDOM">
+
+<DEFINE OP-LESS? (A1 A2)
+       #DECL ((A1 A2) FIX)
+       <PUTPRED <L? .A1 .A2>>>
+<OPDEF "LESS?">
+
+<DEFINE OP-GRTR? (A1 A2)
+       #DECL ((A1 A2) FIX)
+       <PUTPRED <G? .A1 .A2>>>
+<OPDEF "GRTR?">
+
+<DEFINE OP-BTST (A1 A2)
+       #DECL ((A1 A2) FIX)
+       <PUTPRED <0? <CHTYPE <ANDB <XORB .A1 -1> .A2> FIX>>>>
+<OPDEF "BTST">
+
+<DEFINE OP-BOR (A1 A2)
+       #DECL ((A1 A2) FIX)
+       <PUTVAL <CHTYPE <ORB .A1 .A2> FIX>>>
+<OPDEF "BOR">
+
+<DEFINE OP-BCOM (A1)
+       #DECL ((A1) FIX)
+       <PUTVAL <CHTYPE <XORB .A1 -1> FIX>>>
+<OPDEF "BCOM">
+
+<DEFINE OP-BAND (A1 A2)
+       #DECL ((A1 A2) FIX)
+       <PUTVAL <CHTYPE <ANDB .A1 .A2> FIX>>>
+<OPDEF "BAND">
+
+<DEFINE OP-MOVE (A1 A2 "AUX" (L1 <OBJLOC .A1>) (L2 <OBJLOC .A2>) SIBL)
+       #DECL ((A1 A2 L1 L2 SIBL) FIX)
+       <OP-REMOVE .A1>
+       <PUTBYTE <+ .L1 4> .A2>
+       <SET SIBL <GETBYTE <+ .L2 6>>>
+       <PUTBYTE <+ .L2 6> .A1>
+       <OR <0? .SIBL> <PUTBYTE <+ .L1 5> .SIBL>>>
+<OPDEF "MOVE">
+
+<DEFINE OP-REMOVE (A1 "AUX" (L1 <OBJLOC .A1>) PARENT LP SIBL LS)
+       #DECL ((A1 L1 PARENT LP SIBL LS) FIX)
+       <COND (<NOT <0? <SET PARENT <GETBYTE <+ .L1 4>>>>>
+              <COND (<==? .A1
+                          <SET SIBL
+                               <GETBYTE <+ <SET LP <OBJLOC .PARENT>> 6>>>>
+                     <PUTBYTE <+ .LP 6> <GETBYTE <+ .L1 5>>>)
+                    (T
+                     <REPEAT
+                      ()
+                      <AND <==? .A1
+                                <SET SIBL
+                                     <GETBYTE <+ <SET LS <OBJLOC .SIBL>> 5>>>>
+                           <RETURN <PUTBYTE <+ .LS 5>
+                                            <GETBYTE <+ .L1 5>>>>>>)>
+              <PUTBYTE <+ .L1 4> 0>
+              <PUTBYTE <+ .L1 5> 0>)>>
+<OPDEF "REMOVE">
+
+<DEFINE OP-FSET? (OBJ FLG "AUX" (OBLOC <OBJLOC .OBJ>))
+       #DECL ((OBJ FLG OBLOC) FIX)
+       <COND (<L? .FLG 16> <SET OBJ <GETWORD .OBLOC>>)
+             (<SET FLG <- .FLG 16>> <SET OBJ <GETWORD <+ .OBLOC 2>>>)>
+       <PUTPRED <1? <CHTYPE <ANDB 1 <LSH .OBJ <- .FLG 15>>> FIX>>>>
+<OPDEF "FSET?">
+
+<DEFINE OP-FSET (OBJ FLG "AUX" (OBLOC <OBJLOC .OBJ>))
+       #DECL ((OBJ FLG OBLOC) FIX)
+       <COND (<L? .FLG 16> <SET OBJ <GETWORD .OBLOC>>)
+             (<SET FLG <- .FLG 16>>
+              <SET OBJ <GETWORD <SET OBLOC <+ .OBLOC 2>>>>)>
+       <PUTWORD .OBLOC <CHTYPE <ORB .OBJ <LSH 1 <- 15 .FLG>>> FIX>>>
+<OPDEF "FSET">
+
+<DEFINE OP-FCLEAR (OBJ FLG "AUX" (OBLOC <OBJLOC .OBJ>))
+       #DECL ((OBJ FLG OBLOC) FIX)
+       <COND (<L? .FLG 16> <SET OBJ <GETWORD .OBLOC>>)
+             (<SET FLG <- .FLG 16>>
+              <SET OBJ <GETWORD <SET OBLOC <+ .OBLOC 2>>>>)>
+       <PUTWORD .OBLOC
+                <CHTYPE <ANDB .OBJ <XORB <LSH 1 <- 15 .FLG>> -1>> FIX>>>
+<OPDEF "FCLEAR">
+
+<DEFINE OP-LOC (OBJ)
+       #DECL ((OBJ) FIX)
+       <PUTVAL <GETBYTE <+ <OBJLOC .OBJ> 4>>>>
+<OPDEF "LOC">
+
+<DEFINE OP-FIRST? (OBJ) 
+       #DECL ((OBJ) FIX)
+       <PUTPRED <NOT <0? <PUTVAL <GETBYTE <+ <OBJLOC .OBJ> 6>>>>>>>
+
+<OPDEF "FIRST?">
+
+<DEFINE OP-NEXT? (OBJ) 
+       #DECL ((OBJ) FIX)
+       <PUTPRED <NOT <0? <PUTVAL <GETBYTE <+ <OBJLOC .OBJ> 5>>>>>>>
+
+<OPDEF "NEXT?">
+
+<DEFINE OP-IN? (OBJ1 OBJ2)
+       #DECL ((OBJ1 OBJ2) FIX)
+       <PUTPRED <==? .OBJ2 <GETBYTE <+ <OBJLOC .OBJ1> 4>>>>>
+<OPDEF "IN?">
+
+<DEFINE OP-GETP (OBJ PN "AUX" PL)
+       #DECL ((OBJ PN PL) FIX)
+       <SET PL <GETWORD <+ <OBJLOC .OBJ> 7>>>
+       <SET PL <+ .PL <* 2 <GETBYTE .PL>> 1>>
+       <PUTVAL
+        <REPEAT (N)
+                #DECL ((VALUE N) FIX)
+                <COND (<==? <SET N <GETPROPN .PL>> .PN>
+                       <RETURN <COND (<0? <SET N <GETPROPL .PL>>>
+                                      <GETBYTE <+ .PL 1>>)
+                                     (<1? .N> <GETWORD <+ .PL 1>>)
+                                     (<ERROR PROPERTY-VALUE-TOO-LONG!-ERRORS
+                                             OP-GETP
+                                             .OBJ
+                                             .PN>)>>)
+                      (<L? .N .PN>
+                       <RETURN <GETWORD <+ ,OBJTAB <* .PN 2> -2>>>)>
+                <SET PL <NEXTPROP .PL>>>>>
+<OPDEF "GETP">
+
+<DEFINE OP-PUTP (OBJ PN VAL "AUX" PL)
+       #DECL ((OBJ PN PL VAL) FIX)
+       <SET PL <GETWORD <+ <OBJLOC .OBJ> 7>>>
+       <SET PL <+ .PL <* 2 <GETBYTE .PL>> 1>>
+       <REPEAT (N)
+               #DECL ((N) FIX)
+               <COND (<==? <SET N <GETPROPN .PL>> .PN>
+                      <COND (<0? <SET N <GETPROPL .PL>>>
+                             <PUTBYTE <+ .PL 1> .VAL>)
+                            (<1? .N> <PUTWORD <+ .PL 1> .VAL>)
+                            (<ERROR PROPERTY-VALUE-TOO-LONG!-ERRORS
+                                    OP-PUTP
+                                    .OBJ
+                                    .PN>)>
+                      <RETURN>)
+                     (<L? .N .PN>
+                      <ERROR NO-SUCH-PROPERTY!-ERRORS OP-PUTP .OBJ .PN .VAL>)>
+               <SET PL <NEXTPROP .PL>>>>
+<OPDEF "PUTP">
+
+<DEFINE OP-NEXTP (OBJ PN "AUX" PL)
+       #DECL ((OBJ PN PL) FIX)
+       <SET PL <GETWORD <+ <OBJLOC .OBJ> 7>>>
+       <SET PL <+ .PL <* 2 <GETBYTE .PL>> 1>>
+       <PUTVAL
+        <COND
+         (<0? .PN> <GETPROPN .PL>)
+         (<REPEAT (N)
+                  #DECL ((VALUE N) FIX)
+                  <COND (<==? <SET N <GETPROPN .PL>> .PN>
+                         <RETURN <GETPROPN <NEXTPROP .PL>>>)
+                        (<L? .N .PN> <RETURN 0>)>
+                  <SET PL <NEXTPROP .PL>>>)>>>
+<OPDEF "NEXTP">
+
+<DEFINE OP-GET (TBL ITM)
+       #DECL ((TBL ITM) FIX)
+       <PUTVAL <GETWORD <+ .TBL <* .ITM 2>>>>>
+<OPDEF "GET">
+
+<DEFINE OP-GETB (TBL ITM)
+       #DECL ((TBL ITM) FIX)
+       <PUTVAL <GETBYTE <+ .TBL .ITM>>>>
+<OPDEF "GETB">
+
+<DEFINE OP-PUT (TBL ITM VAL)
+       #DECL ((TBL ITM VAL) FIX)
+       <PUTWORD <+ .TBL <* .ITM 2>> .VAL>>
+<OPDEF "PUT">
+
+<DEFINE OP-PUTB (TBL ITM VAL)
+       #DECL ((TBL ITM VAL) FIX)
+       <PUTBYTE <+ .TBL .ITM> .VAL>>
+<OPDEF "PUTB">
+
+<DEFINE OP-GETPT (OBJ PN "AUX" PL)
+       #DECL ((OBJ PN PL) FIX)
+       <SET PL <GETWORD <+ <OBJLOC .OBJ> 7>>>
+       <SET PL <+ .PL <* 2 <GETBYTE .PL>> 1>>
+       <PUTVAL
+        <REPEAT (N)
+                #DECL ((VALUE N) FIX)
+                <COND (<==? <SET N <GETPROPN .PL>> .PN>
+                       <RETURN <+ .PL 1>>)
+                      (<L? .N .PN> <RETURN 0>)>
+                <SET PL <NEXTPROP .PL>>>>>
+<OPDEF "GETPT">
+
+<DEFINE OP-PTSIZE (PT)
+       #DECL ((PT) FIX)
+       <PUTVAL <+ 1 <GETPROPL <- .PT 1>>>>>
+<OPDEF "PTSIZE">
+
+<DEFINE OP-VALUE (VAR)
+       #DECL ((VAR) FIX)
+       <PUTVAL <GETVAR .VAR>>>
+<OPDEF "VALUE">
+
+<DEFINE OP-SET (A1 A2)
+       #DECL ((A1 A2) FIX)
+       <PUTVAR .A1 .A2>>
+<OPDEF "SET">
+
+<DEFINE OP-PUSH (A1)
+       #DECL ((A1) FIX)
+       <PUSHSTACK .A1>>
+<OPDEF "PUSH">
+
+<DEFINE OP-POP (A1)
+       #DECL ((A1) FIX)
+       <PUTVAR .A1 <POPSTACK>>>
+<OPDEF "POP">
+
+<DEFINE OP-INC (A1)
+       #DECL ((A1) FIX)
+       <PUTVAR .A1 <+ <GETVAR .A1> 1>>>
+<OPDEF "INC">
+
+<DEFINE OP-DEC (A1)
+       #DECL ((A1) FIX)
+       <PUTVAR .A1 <- <GETVAR .A1> 1>>>
+<OPDEF "DEC">
+
+<DEFINE OP-IGRTR? (A1 A2)
+       #DECL ((A1 A2) FIX)
+       <PUTPRED <G? <PUTVAR .A1 <+ <GETVAR .A1> 1>> .A2>>>
+<OPDEF "IGRTR?">
+
+<DEFINE OP-DLESS? (A1 A2)
+       #DECL ((A1 A2) FIX)
+       <PUTPRED <L? <PUTVAR .A1 <- <GETVAR .A1> 1>> .A2>>>
+<OPDEF "DLESS?">
+
+<DEFINE OP-READ (BUF RET
+                "AUX" STR
+                      N
+                      (LEN <GETBYTE .BUF>)
+                      (RBREAKS ,RBREAKS)
+                      (SIBREAKS ,SIBREAKS))
+       #DECL ((BUF RET N LEN) FIX
+              (STR RBREAKS SIBREAKS) STRING)
+       <SET STR <COND (<==? <LENGTH ,INSTR> .LEN> ,INSTR)
+                      (<SETG INSTR <ISTRING .LEN>>)>>
+       <SET N <READSTRING .STR ,INCHAN ,BREAKS>>
+       <READCHR ,INCHAN>
+       <COND (<==? .N .LEN>
+              <PRINC "Input line too long, flushing: ">
+              <REPEAT () <AND <==? <PRINC <READCHR>> ,EOLCHR> <RETURN>>>)>
+       <MAPR <>
+             <FUNCTION (RSTR)
+                       #DECL ((RSTR) STRING)
+                       <AND <G=? <ASCII <1 .RSTR>> <ASCII !\A>>
+                            <L=? <ASCII <1 .RSTR>> <ASCII !\Z>>
+                            <PUT .RSTR 1 <ASCII <+ <ASCII <1 .RSTR>> 32>>>>>
+             .STR>
+       <PUTBYTE
+        <+ .RET 1>
+        <REPEAT ((STR .STR)
+                 (WRD <ISTRING 6>)
+                 (N .N)
+                 (P 0)
+                 W1
+                 W2
+                 (MAXWRDS <GETBYTE .RET>)
+                 (RET <+ .RET 2>)
+                 (WRDS 0)
+                 C
+                 POS
+                 ZS
+                 ZS6)
+                #DECL ((VALUE N P W1 W2 MAXWRDS RET WRDS POS) FIX
+                       (STR WRD) STRING
+                       (C) CHARACTER
+                       (ZS) ZSTR
+                       (ZS6) !<BYTES 5 6>)
+                <AND <0? .N> <0? .P> <RETURN .WRDS>>
+                <AND <==? .P 6>
+                     <REPEAT ()
+                             <COND (<OR <0? .N> <MEMQ <1 .STR> .RBREAKS>>
+                                    <RETURN>)>
+                             <SET STR <REST .STR>>
+                             <SET N <- .N 1>>
+                             <SET P <+ .P 1>>>>
+                <COND (<COND (<0? .P>
+                              <SET POS <- .LEN <LENGTH .STR> -1>>
+                              <SET C <1 .STR>>
+                              <SET STR <REST .STR>>
+                              <SET N <- .N 1>>
+                              <COND (<MEMQ .C .SIBREAKS>
+                                     <PUT .WRD <SET P 1> .C>)
+                                    (<MEMQ .C .RBREAKS> <>)
+                                    (<PUT .WRD <SET P 1> .C> <>)>)
+                             (<0? .N>)
+                             (<MEMQ <1 .STR> .RBREAKS>)
+                             (<PUT .WRD <SET P <+ .P 1>> <1 .STR>>
+                              <SET STR <REST .STR>>
+                              <SET N <- .N 1>>
+                              <>)>
+                       <PUTBYTE <+ .RET 2> .P>
+                       <PUTBYTE <+ .RET 3> .POS>
+                       <SET ZS <STRING-ZSTR <COND (<G=? .P 6> .WRD)
+                                                  (<SUBSTRUC .WRD 0 .P>)>>>
+                       <SET ZS6
+                            <SUBSTRUC .ZS
+                                      0
+                                      <COND (<G=? <LENGTH .ZS> 6> 6)
+                                            (<LENGTH .ZS>)>
+                                      <IBYTES 5 6 ,PADCHR>>>
+                       <SET W1 <CHTYPE <ORB <LSH <1 .ZS6> 10>
+                                            <LSH <2 .ZS6> 5>
+                                            <3 .ZS6>>
+                                       FIX>>
+                       <SET W2 <CHTYPE <ORB *100000*
+                                            <LSH <4 .ZS6> 10>
+                                            <LSH <5 .ZS6> 5>
+                                            <6 .ZS6>>
+                                       FIX>>
+                       <PUTWORD
+                        .RET
+                        <REPEAT ((WL ,VOCWLEN)
+                                 (CL <* .WL
+                                        <CHTYPE <LSH 1 <FIX </ <LOG ,VOCWORDS>
+                                                               <LOG 2>>>>
+                                                FIX>>)
+                                 (VE <+ ,VOCBEG <* .WL <- ,VOCWORDS 1>>>)
+                                 (CW <- <+ ,VOCBEG .CL> .WL>)
+                                 W
+                                 UP?)
+                                #DECL ((VALUE WL CL VE CW W) FIX
+                                       (UP?) <OR ATOM FALSE>)
+                                <SET CL </ .CL 2>>
+                                <SET UP?
+                                     <COND (<G? .W1 <SET W <GETWORD .CW>>>)
+                                           (<L? .W1 .W> <>)
+                                           (<G? .W2
+                                                <SET W
+                                                     <CHTYPE
+                                                      <ANDB <GETWORD <+ .CW
+                                                                        2>>
+                                                            *177777*>
+                                                      FIX>>>)
+                                           (<L? .W2 .W> <>)
+                                           (<RETURN .CW>)>>
+                                <AND <L? .CL .WL> <RETURN 0>>
+                                <COND (.UP?
+                                       <SET CW <+ .CW .CL>>
+                                       <AND <G? .CW .VE> <SET CW .VE>>)
+                                      (<SET CW <- .CW .CL>>)>>>
+                       <SET RET <+ .RET 4>>
+                       <COND (<G? <SET WRDS <+ .WRDS 1>> .MAXWRDS>
+                              <ERROR TOO-MANY-WORDS!-ERRORS
+                                     OP-READ
+                                     <TOP .STR>>
+                              <RETURN <- .WRDS 1>>)>
+                       <SET P 0>)>>>
+       <REPEAT ()
+               <AND <0? .N> <RETURN>>
+               <PUTBYTE <SET BUF <+ .BUF 1>> <ASCII <1 .STR>>>
+               <SET STR <REST .STR>>
+               <SET N <- .N 1>>>>
+<OPDEF "READ">
+
+<DEFINE OP-CRLF ()
+       <CRLF>>
+<OPDEF "CRLF">
+
+<DEFINE OP-PRINTC (CHR)
+       #DECL ((CHR) FIX)
+       <PRINC <ASCII .CHR>>>
+<OPDEF "PRINTC">
+
+<DEFINE OP-PRINTN (NUM)
+       #DECL ((NUM) FIX)
+       <PRIN1 .NUM>>
+<OPDEF "PRINTN">
+
+<DEFINE OP-PRINT (NUM)
+       #DECL ((NUM) FIX)
+       <PRINC <ZSTR-STRING <GETSTR <* .NUM 2>>>>>
+<OPDEF "PRINT">
+
+<DEFINE OP-PRINTB (NUM)
+       #DECL ((NUM) FIX)
+       <PRINC <ZSTR-STRING <GETSTR .NUM>>>>
+<OPDEF "PRINTB">
+
+<DEFINE OP-PRINTT (TBL NUM)
+       #DECL ((TBL NUM) FIX)
+       <PRINC <ZSTR-STRING <GETSTR <+ .TBL .NUM>>>>>
+<OPDEF "PRINTT">       ;"Obsolete"
+
+<DEFINE OP-PRINTD (OBJ)
+       #DECL ((OBJ) FIX)
+       <PRINC <ZSTR-STRING <GETSTR <+ 1 <GETWORD <+ <OBJLOC .OBJ> 7>>>>>>>
+<OPDEF "PRINTD">
+
+<DEFINE OP-PRINTI ()
+       <PRINC <ZSTR-STRING <NEXTSTR>>>>
+<OPDEF "PRINTI">
+
+<DEFINE OP-PRINTR ()
+       <OP-PRINTI>
+       <OP-RTRUE>>
+<OPDEF "PRINTR">
+
+<DEFINE OP-CALL (NUM "TUPLE" TUP)
+       #DECL ((NUM) FIX
+              (TUP) <TUPLE [REST FIX]>)
+       <COND (<0? .NUM>
+              <COND (,CTRACE?
+                     <PRINC "
+               ">
+                     <PRINC <NTH ,ZINDENTS ,ZLEVEL>>
+                     <SETG ZLEVEL <- ,ZLEVEL 1>>
+                     <PRINC "Returning: ">)>
+              <PUTVAL 0>)
+             (T
+              <PUTWORD ,PCALLS <+ <GETWORD ,PCALLS> 1>>
+              <PUSHSTACK ,ZPC>
+              <PUSHSTACK ,ZLOCS>
+              <PUSHSTACK ,ZBOT>
+              <SETG ZPC <* .NUM 2>>
+              <SETG ZLOCS <+ ,ZTOP 1>>
+              <SETG ZBOT <+ ,ZTOP <SET NUM <NEXTBYTE>>>>
+              <REPEAT ()
+                      <COND (<0? .NUM> <RETURN>)
+                            (<EMPTY? .TUP> <PUSHSTACK <NEXTWORD>>)
+                            (T
+                             <PUSHSTACK <1 .TUP>>
+                             <NEXTWORD>
+                             <SET TUP <REST .TUP>>)>
+                      <SET NUM <- .NUM 1>>>
+              <OR <EMPTY? .TUP>
+                  <ERROR TOO-MANY-ARGUMENTS!-ERRORS OP-CALL .NUM .TUP>>)>>
+<OPDEF "CALL">
+
+<DEFINE OP-RETURN (VAL)
+       #DECL ((VAL) FIX)
+       <SETG ZTOP <- ,ZLOCS 1>>
+       <SETG ZBOT 0>
+       <SETG ZBOT <POPSTACK>>
+       <SETG ZLOCS <POPSTACK>>
+       <SETG ZPC <POPSTACK>>
+       <COND (,CTRACE?
+              <PRINC "
+               ">
+              <PRINC <NTH ,ZINDENTS ,ZLEVEL>>
+              <SETG ZLEVEL <- ,ZLEVEL 1>>)>
+       <COND (<OR ,TRACE? ,CTRACE?>
+              <PRINC "Returning: ">)>
+       <PUTVAL .VAL>>
+<OPDEF "RETURN">
+
+<DEFINE OP-RTRUE ()
+       <OP-RETURN 1>>
+<OPDEF "RTRUE">
+
+<DEFINE OP-RFALSE ()
+       <OP-RETURN 0>>
+<OPDEF "RFALSE">
+
+<DEFINE OP-JUMP (NUM)
+       #DECL ((NUM) FIX)
+       <SETG ZPC <+ ,ZPC .NUM -2>>>
+<OPDEF "JUMP">
+
+<DEFINE OP-RSTACK ()
+       <OP-RETURN <POPSTACK>>>
+<OPDEF "RSTACK">
+
+<DEFINE OP-FSTACK ()
+       <POPSTACK>>
+<OPDEF "FSTACK">
+
+<DEFINE OP-SAVE ("AUX" CHAN)
+       #DECL ((CHAN) <OR CHANNEL FALSE>)
+       <COND (<NOT <SET CHAN <OPEN "PRINTB" <STRING <GET-NAME> ".ZORKSAVE">>>>
+              <ERROR OPEN-FAILED!-ERRORS OP-SAVE .CHAN>)
+             (<GC-DUMP [,ZORKID
+                        <SUBSTRUC ,ZCODE 0 ,ENDLOD>
+                        ,ZPC
+                        ,ZSTACK
+                        ,ZTOP
+                        ,ZBOT
+                        ,ZLOCS]
+                       .CHAN>
+              <CLOSE .CHAN>)>>
+<OPDEF "SAVE">
+
+<DEFINE OP-RESTORE ("AUX" CHAN GAM)
+       #DECL ((CHAN) <OR CHANNEL FALSE>
+              (GAM) !<VECTOR FIX <BYTES 8> FIX <UVECTOR [REST FIX]> [3 FIX]>)
+       <COND (<NOT <SET CHAN <OPEN "READB" <STRING <GET-NAME> ".ZORKSAVE">>>>
+              <ERROR OPEN-FAILED!-ERRORS OP-RESTORE .CHAN>)
+             (T
+              <SET GAM <GC-READ .CHAN>>
+              <CLOSE .CHAN>
+              <OR <==? <1 .GAM> ,ZORKID>
+                  <ERROR WRONG-VERSION-OR-GAME!-ERRORS OP-RESTORE .GAM>>
+              <SUBSTRUC <2 .GAM> 0 ,ENDLOD ,ZCODE>
+              <SETG ZPC <3 .GAM>>
+              <SETG ZSTACK <4 .GAM>>
+              <SETG ZTOP <5 .GAM>>
+              <SETG ZBOT <6 .GAM>>
+              <SETG ZLOCS <7 .GAM>>)>>
+<OPDEF "RESTORE">
+
+<DEFINE GET-NAME ("AUX" NAM)
+       <PROG ()
+             <PRINC "
+Name: ">
+             <SET NAM <READ>>
+             <COND (<TYPE? .NAM ATOM>
+                    <SPNAME .NAM>)
+                   (T
+                    <PRINC "
+Illegal save/restore name, try again...">
+                    <AGAIN>)>>>
+
+<DEFINE OP-RESTART () <AGAIN .GAME>>
+<OPDEF "RESTART">
+
+<DEFINE OP-QUIT () <QUIT>>
+<OPDEF "QUIT">
+
+<DEFINE OP-NOOP () <TIME>>
+<OPDEF "NOOP">
+
+"********** LOW LEVEL FUNCTIONS **********"
+
+<DEFINE NEXTBYTE ("AUX" (ZPC ,ZPC))
+       #DECL ((VALUE ZPC) FIX)
+       <SETG ZPC <+ .ZPC 1>>
+       <GETBYTE .ZPC>>
+
+<DEFINE NEXTWORD ("AUX" (ZPC ,ZPC))
+       #DECL ((VALUE ZPC) FIX)
+       <SETG ZPC <+ .ZPC 2>>
+       <GETWORD .ZPC>>
+
+<DEFINE NEXTSTR ("AUX" (ZPC ,ZPC) STR)
+       #DECL ((VALUE STR) ZSTR
+              (ZPC) FIX)
+       <SET STR <GETSTR .ZPC>>
+       <SETG ZPC <+ .ZPC <* 2 </ <LENGTH .STR> 3>>>>
+       .STR>
+
+<DEFMAC POSNUM ('ZPC)
+       #DECL ((VALUE ZPC) FORM)
+       <FORM CHTYPE <FORM ANDB .ZPC *377777*> FIX>>
+
+<DEFINE GETBYTE (ZPC)
+       #DECL ((VALUE ZPC) FIX)
+       <SET ZPC <POSNUM .ZPC>>
+       <NTH ,ZCODE <+ .ZPC 1>>>
+
+<DEFINE GETWORD (ZPC "OPTIONAL" (SIGNED? T) "AUX" (ZCODE ,ZCODE) WRD)
+       #DECL ((VALUE ZPC WRD) FIX
+              (ZCODE) <BYTES 8>
+              (SIGNED?) <OR ATOM FALSE>)
+       <SET ZPC <POSNUM .ZPC>>
+       <SET WRD <+ <* 256 <NTH .ZCODE <+ .ZPC 1>>> <NTH .ZCODE <+ .ZPC 2>>>>
+       <COND (<NOT .SIGNED?>)
+             (<0? <CHTYPE <ANDB .WRD *100000*> FIX>>)
+             (<SET WRD <CHTYPE <ORB .WRD *777777600000*> FIX>>)>
+       .WRD>
+
+<FLOAD "GETSTR">       ;"until compiler bug is fixed"
+
+<DEFINE PUTBYTE (ZPC BYT)
+       #DECL ((VALUE ZPC BYT) FIX)
+       <SET ZPC <POSNUM .ZPC>>
+       <OR <0? <CHTYPE <ANDB .BYT *777777777400*> FIX>>
+           <ERROR NUMBER-OUT-OF-RANGE!-ERRORS PUTBYTE .ZPC .BYT>>
+       <AND <G=? .ZPC ,ENDLOD>
+            <ERROR ATTEMPT-TO-MODIFY-READ-ONLY-DATA!-ERRORS
+                   PUTBYTE
+                   .ZPC
+                   .BYT>>
+       <PUT ,ZCODE <+ .ZPC 1> .BYT>
+       .ZPC>
+
+<DEFINE PUTWORD (ZPC WRD)
+       #DECL ((VALUE ZPC WRD) FIX)
+       <SET ZPC <POSNUM .ZPC>>
+       <COND (<OR <0? <CHTYPE <ANDB .WRD *777777600000*> FIX>>
+                  <==? #WORD -1 <ORB .WRD *77777*>>>)
+             (<ERROR NUMBER-OUT-OF-RANGE!-ERRORS PUTWORD .ZPC .WRD>)>
+       <AND <G=? <+ .ZPC 1> ,ENDLOD>
+            <ERROR ATTEMPT-TO-MODIFY-READ-ONLY-DATA!-ERRORS
+                   PUTWORD
+                   .ZPC
+                   .WRD>>
+       <SET WRD <CHTYPE <ANDB .WRD *177777*> FIX>>
+       <PUT <PUT ,ZCODE <+ .ZPC 1> </ .WRD 256>> <+ .ZPC 2> <MOD .WRD 256>>
+       .ZPC>
+
+<DEFINE GETARG (N)
+       #DECL ((VALUE N) FIX)
+       <COND (<0? .N> <NEXTWORD>)
+             (<1? .N> <NEXTBYTE>)
+             (<GETVAR <NEXTBYTE> T>)>>
+
+<DEFINE GETVAR (VAR "OPTIONAL" (UPDSTK? <>))
+       #DECL ((VALUE VAR) FIX
+              (UPDSTK?) <OR ATOM FALSE>)
+       <COND (<0? .VAR>
+              <COND (.UPDSTK? <POPSTACK>)
+                    (<==? ,ZTOP ,ZBOT> <ERROR STACK-EMPTY!-ERRORS>)
+                    (<NTH ,ZSTACK ,ZTOP>)>)
+             (<L? .VAR 16>
+              <COND (<G? .VAR <- ,ZBOT ,ZLOCS -1>>
+                     <ERROR ATTEMPT-TO-ACCESS-UNDEFINED-LOCAL!-ERRORS
+                            GETVAR
+                            .VAR>)
+                    (<NTH ,ZSTACK <+ ,ZLOCS .VAR -1>>)>)
+             (<GETWORD <+ ,GLOTAB <* 2 <- .VAR 16>>>>)>>
+
+<DEFINE PUTVAR (VAR VAL "OPTIONAL" (UPDSTK? <>))
+       #DECL ((VALUE VAR VAL) FIX
+              (UPDSTK?) <OR ATOM FALSE>)
+       <COND (<0? .VAR>
+              <COND (.UPDSTK? <PUSHSTACK .VAL>)
+                    (<==? ,ZTOP ,ZBOT> <ERROR STACK-EMPTY!-ERRORS>)
+                    (<PUT ,ZSTACK ,ZTOP .VAL>)>)
+             (<L? .VAR 16>
+              <COND (<G? .VAR <- ,ZBOT ,ZLOCS -1>>
+                     <ERROR ATTEMPT-TO-ACCESS-UNDEFINED-LOCAL!-ERRORS
+                            PUTVAR
+                            .VAR>)
+                    (<PUT ,ZSTACK <+ ,ZLOCS .VAR -1> .VAL>)>)
+             (<PUTWORD <+ ,GLOTAB <* 2 <- .VAR 16>>> .VAL>)>
+       .VAL>
+
+<DEFINE PUTVAL (VAL "AUX" (VAR <NEXTBYTE>))
+       #DECL ((VAL LOC) FIX)
+       <COND (,TRACE?
+              <PRIN1 .VAL>
+              <PRINC ">">
+              <PRIN1 .VAR>)>
+       <PUTVAR .VAR .VAL T>>
+
+<DEFINE PUTPRED (PRED "AUX" (LOC <NEXTBYTE>) (INV? <>))
+       #DECL ((PRED INV?) <OR ATOM FALSE>
+              (LOC) FIX)
+       <AND <0? <CHTYPE <ANDB .LOC 128> FIX>>
+            <SET INV? T>>
+       <AND ,TRACE? <COND (.INV? <PRINC "\\">) (<PRINC !\/>)>>
+       <SET LOC
+            <COND (<0? <CHTYPE <ANDB .LOC 64> FIX>>
+                   <+ <* 256 <MOD .LOC 64>> <NEXTBYTE>>)
+                  (<MOD .LOC 64>)>>
+       <OR <0? <CHTYPE <ANDB .LOC *20000*> FIX>>
+           <SET LOC <CHTYPE <ORB .LOC *777777740000*> FIX>>>
+       <COND (<OR <AND .PRED <NOT .INV?>>
+                  <AND <NOT .PRED> .INV?>>
+              <COND (<0? .LOC>
+                     <AND ,TRACE? <PRINC "FALSE">>
+                     <OP-RFALSE>)
+                    (<1? .LOC>
+