aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorhistoricalsource <historicalsoftware@textfiles.com>2019-04-13 19:48:51 -0400
committerhistoricalsource <historicalsoftware@textfiles.com>2019-04-13 19:48:51 -0400
commit65673bb4345f31fc3cb8f8aba9e6822fff1f99a6 (patch)
treefa4033b0d07f213d8b83ff8e3d1528cbead3f378
downloadminizork-1982-65673bb4345f31fc3cb8f8aba9e6822fff1f99a6.tar.gz
minizork-1982-65673bb4345f31fc3cb8f8aba9e6822fff1f99a6.tar.bz2
minizork-1982-65673bb4345f31fc3cb8f8aba9e6822fff1f99a6.zip
Original Source
-rw-r--r--README.md1
-rw-r--r--actions.zil1656
-rw-r--r--chr.mud43
-rw-r--r--clock.zil51
-rw-r--r--crufty.xzap28
-rw-r--r--crufty.zil18
-rw-r--r--demons.zil164
-rw-r--r--dungeon.zil1687
-rw-r--r--fights.zil98
-rw-r--r--macros.zil90
-rw-r--r--main.zil129
-rw-r--r--melee.zil365
-rw-r--r--parser.zil749
-rw-r--r--syntax.zil467
-rw-r--r--verbs.zil1202
-rw-r--r--x.mid3839
-rw-r--r--zap.mid3800
-rw-r--r--zork.errors53
-rw-r--r--zork.xzap45
-rw-r--r--zork.zipbin0 -> 47676 bytes
20 files changed, 14485 insertions, 0 deletions
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..94dac47
--- /dev/null
+++ b/README.md
@@ -0,0 +1 @@
+# minizork-1982
diff --git a/actions.zil b/actions.zil
new file mode 100644
index 0000000..b79f560
--- /dev/null
+++ b/actions.zil
@@ -0,0 +1,1656 @@
+"MINI-ZORK"
+
+"SUBTITLE ACT1"
+
+"SUBTITLE THE WHITE HOUSE"
+
+<ROUTINE WEST-HOUSE (RARG)
+ <COND (<==? .RARG ,M-LOOK>
+ <TELL
+"You are standing in an open field west of a white house, with a boarded
+front door." CR>
+ <COND (,WON-FLAG
+ <TELL
+"A secret path leads southwest into the forest." CR>)>)>>
+
+<ROUTINE EAST-HOUSE (RARG)
+ <COND (<==? .RARG ,M-LOOK>
+ <TELL
+"You are behind the white house, where a path enters the forest to the east.
+In one corner of the house there is a small window which is ">
+ <COND (<FSET? ,KITCHEN-WINDOW ,OPENBIT>
+ <TELL "open.">)
+ (ELSE <TELL "slightly ajar.">)>
+ <CRLF>)>>
+
+<ROUTINE WINDOW-FUNCTION ()
+ <COND (<VERB? OPEN CLOSE>
+ <OPEN-CLOSE ,KITCHEN-WINDOW
+"With great effort, you open the window far enough to allow entry."
+"The window closes (more easily than it opened).">)
+ (<VERB? WALK THROUGH>
+ <COND (<==? ,HERE ,KITCHEN>
+ <PERFORM ,V?WALK ,P?EAST>)
+ (T
+ <PERFORM ,V?WALK ,P?WEST>)>
+ <RTRUE>)
+ (<VERB? LOOK-INSIDE>
+ <TELL "You can see ">
+ <COND (<==? ,HERE ,KITCHEN>
+ <TELL "a clear area leading towards a forest." CR>)
+ (T
+ <TELL "what appears to be a kitchen." CR>)>)>>
+
+<ROUTINE OPEN-CLOSE (OBJ STROPN STRCLS)
+ #DECL ((OBJ) OBJECT (STROPN STRCLS) STRING)
+ <COND (<VERB? OPEN>
+ <COND (<FSET? .OBJ ,OPENBIT>
+ <DUMMY>)
+ (ELSE
+ <TELL .STROPN CR>
+ <FSET .OBJ ,OPENBIT>)>)
+ (<VERB? CLOSE>
+ <COND (<FSET? .OBJ ,OPENBIT>
+ <TELL .STRCLS CR>
+ <FCLEAR .OBJ ,OPENBIT>
+ T)
+ (ELSE <DUMMY>)>)>>
+
+<ROUTINE KITCHEN-FCN (RARG)
+ <COND (<==? .RARG ,M-LOOK>
+ <TELL
+"You are in the kitchen of the house, where a table has been used recently
+to make food. A door leads to the west and, next to a small chimney,
+a dark staircase leads up. To the east is a small window which is ">
+ <COND (<FSET? ,KITCHEN-WINDOW ,OPENBIT>
+ <TELL "open." CR>)
+ (ELSE
+ <TELL "slightly ajar." CR>)>)>>
+
+<ROUTINE STONE-BARROW-FCN (RARG)
+ <COND (<AND <==? .RARG ,M-BEG>
+ <OR <VERB? ENTER>
+ <AND <VERB? WALK>
+ <==? ,PRSO ,P?WEST>>
+ <AND <VERB? THROUGH>
+ <==? ,PRSO ,BARROW>>>>
+ <TELL
+
+"In the Barrow|
+The great stone door shuts behind you as you enter. Ahead of you is an
+enormous cavern, dimly lit, and beyond a path leads into a dark tunnel. You
+hear a voice say: All who stand within this barrow have completed a great
+and perilous adventure which has tested your wit and courage.">
+ <V-QUIT <>>)>>
+
+<ROUTINE BARROW-FCN ()
+ <COND (<VERB? THROUGH>
+ <PERFORM ,V?WALK ,P?WEST>)>>
+
+\
+
+<GLOBAL RUG-MOVED <>>
+
+<ROUTINE LIVING-ROOM-FCN (RARG "AUX" RUG? TC)
+ #DECL ((RUG?) <OR ATOM FALSE> (TC) OBJECT)
+ <COND (<==? .RARG ,M-LOOK>
+ <COND (,MAGIC-FLAG
+ <TELL
+"You are in the living room. There is a door to the east. To the
+west is an old wooden door, which has a cyclops-sized hole in it,">)
+ (T
+ <TELL
+"You are in the living room. There is a door to the east, a rustic wooden
+door to the west, which appears to be nailed shut, ">)>
+ <TELL "a trophy case, ">
+ <SET RUG? ,RUG-MOVED>
+ <COND (<AND .RUG? <FSET? ,TRAP-DOOR ,OPENBIT>>
+ <TELL
+ "and a rug lying beside an open trap-door.">)
+ (.RUG?
+ <TELL "and a closed trap-door at your feet.">)
+ (<FSET? ,TRAP-DOOR ,OPENBIT>
+ <TELL "and an open trap-door at your feet.">)
+ (ELSE
+ <TELL
+ "and a large oriental rug in the center of the room.">)>
+ <CRLF>
+ T)
+ (<==? .RARG ,M-END>
+ <COND (<OR <VERB? TAKE>
+ <AND <VERB? PUT>
+ <==? ,PRSI ,TROPHY-CASE>>>
+ <SETG SCORE <+ ,BASE-SCORE <OTVAL-FROB>>>
+ <SCORE-UPD 0>
+ <RFALSE>)>)>>
+
+<ROUTINE OTVAL-FROB ("OPTIONAL" (O ,TROPHY-CASE) "AUX" F (SCORE 0))
+ #DECL ((VALUE) FIX)
+ <SET F <FIRST? .O>>
+ <REPEAT ()
+ <COND (<NOT .F> <RETURN .SCORE>)>
+ <SET SCORE <+ .SCORE <GETP .F ,P?TVALUE>>>
+ <COND (<FIRST? .F> <OTVAL-FROB .F>)>
+ <SET F <NEXT? .F>>>>
+
+<ROUTINE TRAP-DOOR-FCN ()
+ <COND (<AND <VERB? OPEN CLOSE>
+ <==? ,HERE ,LIVING-ROOM>>
+ <OPEN-CLOSE ,PRSO
+"The door reluctantly opens to reveal a rickety staircase
+descending into darkness."
+"The door closes.">)
+ (<==? ,HERE ,CELLAR>
+ <COND (<AND <VERB? OPEN UNLOCK>
+ <NOT <FSET? ,TRAP-DOOR ,OPENBIT>>>
+ <TELL
+"The door is latched from above." CR>)
+ (<AND <VERB? CLOSE> <NOT <FSET? ,TRAP-DOOR ,OPENBIT>>>
+ <FCLEAR ,TRAP-DOOR ,TOUCHBIT>
+ <FCLEAR ,TRAP-DOOR ,OPENBIT>
+ <TELL "The door closes and latches." CR>)
+ (<VERB? OPEN CLOSE>
+ <DUMMY>)>)>>
+
+<ROUTINE CELLAR-FCN (RARG)
+ <COND (<==? .RARG ,M-LOOK>
+ <TELL
+"You are in a dark cellar with a passages leading north and east. To the
+west is the bottom of a steep metal ramp." CR>)
+ (<==? .RARG ,M-ENTER>
+ <COND (<AND <FSET? ,TRAP-DOOR ,OPENBIT>
+ <NOT <FSET? ,TRAP-DOOR ,TOUCHBIT>>>
+ <FCLEAR ,TRAP-DOOR ,OPENBIT>
+ <FSET ,TRAP-DOOR ,TOUCHBIT>
+ <TELL
+"The trap shuts and you hear someone latching it." CR>)>)>>
+
+<ROUTINE CHIMNEY-FUNCTION ("AUX" F)
+ <COND (<NOT <SET F <FIRST? ,WINNER>>>
+ <TELL "Going up empty-handed is a bad idea." CR>
+ <RFALSE>)
+ (<AND <OR <NOT <SET F <NEXT? .F>>>
+ <NOT <NEXT? .F>>>
+ <IN? ,LAMP ,WINNER>>
+ <COND (<NOT <FSET? ,TRAP-DOOR ,OPENBIT>>
+ <FCLEAR ,TRAP-DOOR ,TOUCHBIT>)>
+ <RETURN ,KITCHEN>)
+ (T
+ <TELL "You and all of your baggage won't fit." CR>
+ <RFALSE>)>>
+
+<ROUTINE TRAP-DOOR-EXIT ()
+ <COND (,RUG-MOVED
+ <COND (<FSET? ,TRAP-DOOR ,OPENBIT>
+ <RETURN ,CELLAR>)
+ (T
+ <TELL "The trap door is closed." CR>
+ <RFALSE>)>)
+ (T
+ <TELL "You can't go that way." CR>
+ <RFALSE>)>>
+
+<ROUTINE RUG-FCN ()
+ <COND (<VERB? RAISE>
+ <COND (,RUG-MOVED
+ <TELL "The rug is too heavy." CR>)
+ (ELSE
+ <TELL
+"The rug is too heavy, but in trying to take it you notice something
+beneath it." CR>)>)
+ (<VERB? MOVE>
+ <COND (,RUG-MOVED
+ <DUMMY>)
+ (ELSE
+ <TELL
+"With effort, the rug moves to reveal the dusty cover of a closed
+trap-door." CR>
+ <FCLEAR ,TRAP-DOOR ,INVISIBLE>
+ <SETG RUG-MOVED T>)>)
+ (<VERB? TAKE>
+ <TELL
+"The rug too heavy." CR>)
+ (<AND <VERB? LOOK-UNDER>
+ <NOT ,RUG-MOVED>
+ <NOT <FSET? ,TRAP-DOOR ,OPENBIT>>>
+ <TELL "Underneath the rug is a closed trap door." CR>)>>
+
+\
+
+"SUBTITLE TROLL"
+
+<ROUTINE AXE-FUNCTION ()
+ <COND (,TROLL-FLAG <>)
+ (ELSE <WEAPON-FUNCTION ,AXE ,TROLL>)>>
+
+<ROUTINE STILETTO-FUNCTION ()
+ <WEAPON-FUNCTION ,STILETTO ,THIEF>>
+
+<ROUTINE WEAPON-FUNCTION (W V)
+ <COND (<NOT <IN? .V ,HERE>> <RFALSE>)
+ (<VERB? TAKE>
+ <COND (<IN? .W .V>
+ <TELL
+"The " D .V " snatches it out of your reach." CR>)
+ (ELSE
+ <TELL
+"The " D .W " seems white-hot. You can't hold on to it." CR>)>
+ T)>>
+
+<ROUTINE TROLL-FCN ("OPTIONAL" (MODE <>))
+ <COND (<==? .MODE ,F-DEAD>
+ <MOVE ,AXE ,HERE>
+ <FCLEAR ,AXE ,NDESCBIT>
+ <FSET ,AXE ,WEAPONBIT>
+ <SETG TROLL-FLAG T>)
+ (<==? .MODE ,F-FIRST?>
+ <COND (<PROB 33> <FSET ,TROLL ,FIGHTBIT> T)>)
+ (<NOT .MODE>
+ <COND (<OR <AND <VERB? THROW GIVE>
+ <==? ,PRSI ,TROLL>>
+ <VERB? TAKE MOVE MUNG>>
+ <AWAKEN ,TROLL>
+ <COND (<VERB? THROW GIVE>
+ <TELL
+"The troll grabs the " D ,PRSO " and eats it." CR>
+ <REMOVE ,PRSO>)
+ (<VERB? MUNG>
+ <TELL
+"The troll laughs at your puny gesture." CR>)>)
+ (<VERB? LISTEN>
+ <TELL
+"The troll growls at you." CR>)
+ (<AND ,TROLL-FLAG <VERB? HELLO>>
+ <TELL
+"The troll growls at you." CR>)>)>>
+
+\
+
+"SUBTITLE GRATING/MAZE"
+
+<GLOBAL LEAVES-GONE <>>
+<GLOBAL GRATE-REVEALED <>>
+<GLOBAL GRUNLOCK <>>
+
+<ROUTINE LEAVES-APPEAR ()
+ <COND (<AND <NOT <FSET? ,GRATE ,OPENBIT>>
+ <NOT ,GRATE-REVEALED>>
+ <TELL "A grating appears on the ground." CR>
+ <FCLEAR ,GRATE ,INVISIBLE>
+ <SETG GRATE-REVEALED T>)>
+ <>>
+
+<ROUTINE LEAF-PILE ()
+ <COND (<VERB? BURN>
+ <LEAVES-APPEAR>
+ <REMOVE ,PRSO>
+ <COND (<IN? ,PRSO ,HERE>
+ <TELL
+"The leaves burn." CR>)
+ (T
+ <JIGS-UP
+"The leaves burn, and so do you.">)>)
+
+ (<VERB? MOVE TAKE>
+ <COND (<VERB? MOVE> <TELL "Done." CR> <LEAVES-APPEAR> T)
+ (ELSE <LEAVES-APPEAR>)>)
+ (<AND <VERB? LOOK-UNDER>
+ <NOT ,GRATE-REVEALED>>
+ <TELL "Underneath the pile of leaves is a grating." CR>)>>
+
+<ROUTINE HOUSE-FUNCTION ()
+ <COND (<EQUAL? ,HERE ,KITCHEN ,LIVING-ROOM ,ATTIC>
+ <COND (<VERB? FIND>
+ <TELL "Why not find your brains?" CR>)
+ (<VERB? WALK-AROUND>
+ <GO-NEXT ,IN-HOUSE-AROUND>
+ T)>)
+ (<NOT <OR <EQUAL? ,HERE ,EAST-OF-HOUSE ,WEST-OF-HOUSE>
+ <EQUAL? ,HERE ,NORTH-OF-HOUSE ,SOUTH-OF-HOUSE>>>
+ <COND (<VERB? FIND>
+ <COND (<==? ,HERE ,CLEARING>
+ <TELL "It seems to be to the west." CR>)
+ (ELSE
+ <TELL "It was here just a minute ago...." CR>)>)
+ (ELSE <TELL "You're not at the house." CR>)>)
+ (<VERB? FIND>
+ <TELL
+"It's right in front of you. Are you blind or something?" CR>)
+ (<VERB? WALK-AROUND>
+ <GO-NEXT ,HOUSE-AROUND>
+ T)
+ (<VERB? EXAMINE>
+ <TELL
+"The house is painted white and seems to have been abandoned." CR>)
+ (<VERB? THROUGH>
+ <COND (<==? ,HERE ,EAST-OF-HOUSE>
+ <COND (<FSET? ,KITCHEN-WINDOW ,OPENBIT>
+ <GOTO ,KITCHEN>)
+ (ELSE <TELL "The window is closed." CR>)>)
+ (ELSE <TELL "I can't see how to get in from here." CR>)>)
+ (<VERB? BURN>
+ <TELL "You must be joking." CR>)>>
+
+<ROUTINE CLEARING-FCN (RARG)
+ <COND (<==? .RARG ,M-ENTER>
+ <COND (<NOT ,GRATE-REVEALED>
+ <FSET ,GRATE ,INVISIBLE>)>)
+ (<==? .RARG ,M-LOOK>
+ <TELL
+"You are in a clearing within a forest. Paths lead south, east, and west.">
+ <COND (<FSET? ,GRATE ,OPENBIT>
+ <CRLF>
+ <TELL
+"There is an open grating, descending into darkness.">)
+ (,GRATE-REVEALED
+ <CRLF>
+ <TELL
+"There is a grating securely fastened into the ground.">)>
+ <CRLF>)>>
+
+<ROUTINE MAZE-11-FCN (RARG)
+ <COND (<==? .RARG ,M-ENTER>
+ <FCLEAR ,GRATE ,INVISIBLE>)
+ (<==? .RARG ,M-LOOK>
+ <TELL
+"You are in a small room near the maze." CR>
+ <COND (<FSET? ,GRATE ,OPENBIT>
+ <TELL
+ "Above you is an open grating with sunlight pouring in.">)
+ (,GRUNLOCK
+ <TELL "Above you is a grating.">)
+ (ELSE
+ <TELL
+ "Above you is a locked grating.">)>
+ <CRLF>)>>
+
+<ROUTINE GRATE-FUNCTION ()
+ <COND (<AND <VERB? OPEN> <==? ,PRSI ,KEYS>>
+ <PERFORM ,V?UNLOCK ,GRATE ,KEYS>
+ <RTRUE>)
+ (<VERB? OPEN CLOSE>
+ <COND (,GRUNLOCK
+ <OPEN-CLOSE ,GRATE
+ <COND (<==? ,HERE ,CLEARING>
+ "The grating opens.")
+ (T
+ "The grating opens to reveal trees above you.")>
+ "The grating is closed.">
+ <COND (<FSET? ,GRATE ,OPENBIT>
+ <COND (<AND <NOT <==? ,HERE ,CLEARING>>
+ <NOT ,GRATE-REVEALED>>
+ <TELL
+"A pile of leaves falls onto your head and to the ground." CR>
+ <MOVE ,LEAVES ,HERE>)>
+ <FSET ,GRATING-ROOM ,ONBIT>)
+ (ELSE <FCLEAR ,GRATING-ROOM ,ONBIT>)>)
+ (ELSE <TELL "The grating is locked." CR>)>)>>
+
+\
+
+<ROUTINE TORCH-OBJECT ()
+ <COND (<VERB? EXAMINE>
+ <TELL "The torch is burning." CR>)
+ (<AND <VERB? LAMP-OFF> <FSET? ,PRSO ,ONBIT>>
+ <TELL
+"You almost burn your hand trying to extinguish the flame." CR>)>>
+
+\
+
+"SUBTITLE THE DOME"
+
+<ROUTINE TEMPLE-ROOM-FCN (RARG)
+ <COND (<==? .RARG ,M-LOOK>
+ <TELL
+"*****INSERT TEMPLE DESCRIPTION HERE*****." CR>
+ <COND (,DOME-FLAG
+ <TELL
+"A piece of rope descends from the railing above, ending some
+five feet above your head." CR>)>)>>
+
+<ROUTINE DOME-ROOM-FCN (RARG)
+ <COND (<==? .RARG ,M-LOOK>
+ <TELL
+"You are at a railing near the periphery of a large dome, which forms the
+ceiling of another room below." CR>
+ <COND (,DOME-FLAG
+ <TELL
+"Hanging from the railing is a rope which ends about ten feet from the floor
+below." CR>)>)>>
+
+<GLOBAL EGYPT-FLAG <>>
+
+\
+
+"SUBTITLE LAND OF THE DEAD"
+
+<ROUTINE LLD-ROOM (RARG)
+ <COND (<==? .RARG ,M-LOOK>
+ <TELL
+"You are outside a large open gateway, on which is inscribed|
+ \"Abandon every hope, all ye who enter here.\"|
+Thousands of voices, lamenting some hideous fate, can be heard." CR>
+ <COND (<NOT ,LLD-FLAG>
+ <TELL
+"The way through the gate is barred by evil spirits, who jeer at your
+attempts to pass." CR>)>)
+ (<NOT .RARG>
+ <COND
+ (<AND <NOT ,LLD-FLAG> <VERB? RING> <==? ,PRSO ,BELL>>
+ <SETG XB T>
+ <TELL
+"As the bell rings, the spirits stop their jeering and slowly turn to
+face you, displaying a long-forgotten terror." CR>
+ <SETG XC T>
+ <ENABLE <QUEUE I-XC 3>>)
+ (<AND ,XC <VERB? READ> <==? ,PRSO ,BOOK> <NOT ,LLD-FLAG>>
+ <TELL
+"The prayer reverberates through the hall. As the last word fades, a
+heart-stopping scream fills the cavern, and the spirits flee your unearthly
+power." CR>
+ <REMOVE ,GHOST>
+ <SETG LLD-FLAG T>
+ <DISABLE <INT I-XC>>)
+ (<VERB? EXORCISE>
+ <COND (<NOT ,LLD-FLAG>
+ <COND (<AND <IN? ,BELL ,WINNER>
+ <IN? ,BOOK ,WINNER>>
+ <TELL "You must perform the ceremony." CR>)
+ (ELSE
+ <TELL "You don't have the equipment." CR>)>)>)>)>>
+
+<GLOBAL XB <>>
+
+<GLOBAL XC <>>
+
+<ROUTINE I-XB ()
+ <OR ,XC
+ <AND <==? ,HERE ,ENTRANCE-TO-HADES>
+ <TELL
+"The tension of the ceremony is broken, and the spirits, resume their
+hideous jeering." CR>>>
+ <SETG XB <>>>
+
+<ROUTINE I-XC ()
+ <SETG XC <>>
+ <I-XB>>
+
+<ROUTINE GHOST-FUNCTION ()
+ <COND (<VERB? EXORCISE>
+ <TELL "Only the ceremony itself has any effect." CR>)
+ (<==? ,PRSI ,GHOST>
+ <TELL "How can you attack a spirit with material objects?" CR>
+ <>)
+ (<==? ,PRSO ,GHOST>
+ <TELL "You seem unable to affect these spirits." CR>)>>
+
+\
+
+"SUBTITLE FLOOD CONTROL DAM #3"
+
+<GLOBAL GATE-FLAG <>>
+
+<ROUTINE DAM-ROOM-FCN (RARG)
+ <COND (<==? .RARG ,M-LOOK>
+ <TELL
+"You are atop Flood Control Dam #3, which was once quite a tourist
+attraction. There are paths to the north and west, and a scramble down." CR>
+ <COND (,LOW-TIDE
+ <TELL
+"The gates are open and the water level behind the dam is low. Water
+rushes through the dam and downstream." CR>)
+ (ELSE
+ <TELL
+"The sluice gates on the dam are closed. Behind the dam is a wide
+reservoir. Water is pouring over the abandoned dam." CR>)>
+ <TELL
+"There is a control panel here. Protruding from the panel is a large
+metal bolt." CR>
+ <COND (,GATE-FLAG
+ <TELL "The panel is emitting a low-level hum." CR>)>)>>
+
+<ROUTINE BOLT-FUNCTION ()
+ <COND (<VERB? TURN>
+ <COND (<==? ,PRSI ,WRENCH>
+ <COND (,GATE-FLAG
+ <FCLEAR ,RESERVOIR-SOUTH ,TOUCHBIT>
+ <COND (,LOW-TIDE
+ <TELL
+"Nothing happens." CR>
+ T)
+ (ELSE
+ <SETG LOW-TIDE T>
+ <TELL
+"The sluice gates open and water pours through the dam." CR>
+ T)>)
+ (ELSE <TELL
+"The bolt won't turn with your best effort." CR>)>)
+ (ELSE <TELL
+"The bolt won't turn using the " D ,PRSI "." CR>)>)>>
+
+<ROUTINE DBUTTONS ()
+ <COND (<VERB? PUSH>
+ <COND (<==? ,PRSO ,RED-BUTTON>
+ <TELL "The room lights ">
+ <COND (<FSET? ,HERE ,ONBIT>
+ <FCLEAR ,HERE ,ONBIT>
+ <TELL "shut off." CR>)
+ (ELSE
+ <FSET ,HERE ,ONBIT>
+ <TELL "come on." CR>)>)
+ (<==? ,PRSO ,BROWN-BUTTON>
+ <FCLEAR ,DAM-ROOM ,TOUCHBIT>
+ <SETG GATE-FLAG <>>
+ <TELL "Click." CR>)
+ (<==? ,PRSO ,YELLOW-BUTTON>
+ <FCLEAR ,DAM-ROOM ,TOUCHBIT>
+ <SETG GATE-FLAG T>
+ <TELL "Click." CR>)>)>>
+
+<ROUTINE TOOL-CHEST-FCN ()
+ <COND (<VERB? EXAMINE>
+ <TELL "The chests are all empty." CR>)>>
+
+<ROUTINE DAM-FUNCTION ()
+ <COND (<VERB? OPEN CLOSE>
+ <TELL "Sounds reasonable, but this isn't how." CR>)
+ (<VERB? PLUG>
+ <COND (<==? ,PRSI ,HANDS>
+ <TELL
+"Are you the little Dutch boy, then?" CR>)
+ (ELSE
+ <TELL
+"With a " D ,PRSI "? Do you know how big this dam is?" CR>)>)>>
+
+<ROUTINE WITH-TELL (OBJ)
+ #DECL ((OBJ) OBJECT)
+ <TELL "With a " D .OBJ "?" CR>>
+
+<ROUTINE RESERVOIR-SOUTH-FCN (RARG)
+ <COND (<==? .RARG ,M-LOOK>
+ <COND (,LOW-TIDE
+ <TELL
+"You are in a long room south of a reservoir. However, with the water
+level lowered, there is merely a muddy stream to the north.">)
+ (ELSE
+ <TELL
+"You are in a long room on the south shore of a large lake, far
+too deep and wide for crossing.">)>
+ <CRLF>
+ <TELL
+"Rocky passages head toward the south and southwest. To the east, a
+mighty structure can be seen." CR>)>>
+
+<ROUTINE RESERVOIR-NORTH-FCN (RARG)
+ <COND (<==? .RARG ,M-LOOK>
+ <COND (,LOW-TIDE
+ <TELL
+"You are in a cavernous room north of what was formerly a lake. However,
+with the water level lowered, there is merely a muddy stream to the south.">)>
+ <CRLF>
+ <TELL
+"There is a grimy stairway leaving the room to the north." CR>)>>
+
+\
+
+"SUBTITLE WATER, WATER EVERYWHERE..."
+
+<ROUTINE BOTTLE-FUNCTION ("AUX" (E? <>))
+ <COND (<VERB? THROW>
+ <REMOVE ,PRSO>
+ <SET E? T>
+ <TELL "The bottle hits the far wall and shatters." CR>)
+ (<VERB? MUNG>
+ <SET E? T>
+ <REMOVE ,PRSO>
+ <TELL "A brilliant maneuver destroys the bottle." CR>)
+ (<VERB? SHAKE>
+ <COND (<FSET? ,PRSO ,OPENBIT> <SET E? T>)>)>
+ <COND (<AND .E? <IN? ,WATER ,PRSO>>
+ <TELL "The water spills to the floor and evaporates." CR>
+ <REMOVE ,WATER>
+ T)>>
+
+<ROUTINE WATER-FUNCTION ("AUX" AV W PI?)
+ #DECL ((AV) <OR OBJECT FALSE> (W) OBJECT (PI?) <OR ATOM FALSE>)
+ <COND (<VERB? SGIVE> <RFALSE>)
+ (<VERB? THROUGH>
+ <TELL <PICK-ONE ,SWIMYUKS>>
+ <RTRUE>)
+ (<VERB? FILL> ;"fill bottle with water =>"
+ <SET W ,PRSI> ;"put water in bottle"
+ <SETG PRSA ,V?PUT>
+ <SETG PRSI ,PRSO>
+ <SETG PRSO .W>
+ <SET PI? <>>)
+ (<OR <==? ,PRSO ,GLOBAL-WATER>
+ <==? ,PRSO ,WATER>>
+ <SET W ,PRSO>
+ <SET PI? <>>)
+ (<SET W ,PRSI>
+ <SET PI? T>)>
+ <COND (<==? .W ,GLOBAL-WATER>
+ <SET W ,WATER>
+ <COND (<VERB? TAKE PUT> <REMOVE .W>)>)>
+ <COND (.PI? <SETG PRSI .W>)
+ (T <SETG PRSO .W>)>
+ <SET AV <LOC ,WINNER>>
+ <COND (<NOT <FSET? .AV ,VEHBIT>> <SET AV <>>)>
+ <COND (<AND <VERB? TAKE PUT> <NOT .PI?>>
+ <COND (<AND .AV
+ <OR <==? .AV ,PRSI>
+ <AND <NOT ,PRSI>
+ <NOT <IN? .W .AV>>>>>
+ <TELL "There is now a puddle in the bottom of the "
+ D .AV "." CR>
+ <REMOVE ,PRSO>
+ <MOVE ,PRSO .AV>)
+ (<AND ,PRSI <NOT <==? ,PRSI ,BOTTLE>>>
+ <TELL "The water leaks out of the " D ,PRSI
+ " and evaporates immediately." CR>
+ <REMOVE .W>)
+ (<IN? ,BOTTLE ,WINNER>
+ <COND (<NOT <FSET? ,BOTTLE ,OPENBIT>>
+ <TELL "The bottle is closed." CR>)
+ (<NOT <FIRST? ,BOTTLE>>
+ <MOVE ,WATER ,BOTTLE>
+ <TELL "The bottle is now full of water." CR>)
+ (T
+ <TELL "The water slips through your fingers." CR>
+ <RTRUE>)>)
+ (<AND <IN? ,PRSO ,BOTTLE>
+ <VERB? TAKE>
+ <NOT ,PRSI>>
+ <SETG PRSO ,BOTTLE>
+ <ITAKE>
+ <SETG PRSO .W>)
+ (T
+ <TELL "The water slips through your fingers." CR>)>)
+ (.PI? <TELL "Nice try." CR>)
+ (<VERB? DROP GIVE>
+ <REMOVE ,WATER>
+ <COND (.AV
+ <TELL "There is now a puddle in the bottom of the "
+ D .AV "." CR>
+ <MOVE ,WATER .AV>)
+ (T
+ <TELL
+"The water spills to the floor and evaporates immediately." CR>
+ <REMOVE ,WATER>)>)
+ (<VERB? THROW>
+ <TELL
+"The water splashes on the walls and evaporates immediately." CR>
+ <REMOVE ,WATER>)>>
+
+\
+
+"SUBTITLE CYCLOPS"
+
+<GLOBAL CYCLOWRATH 0>
+
+<ROUTINE CYCLOPS-FCN ("AUX" COUNT)
+ #DECL ((COUNT) FIX)
+ <SET COUNT ,CYCLOWRATH>
+ <COND (,CYCLOPS-FLAG
+ <COND (<VERB? ALARM KICK ATTACK BURN MUNG KILL>
+ <TELL
+"The cyclops yawns and stares at the thing that woke him up." CR>
+ <SETG CYCLOPS-FLAG <>>
+ <FSET ,CYCLOPS ,FIGHTBIT>
+ <COND (<L? .COUNT 0>
+ <SETG CYCLOWRATH <- .COUNT>>)
+ (ELSE
+ <SETG CYCLOWRATH .COUNT>)>)>)
+ (<AND <VERB? GIVE> <==? ,PRSI ,CYCLOPS>>
+ <COND (<==? ,PRSO ,FOOD>
+ <COND (<NOT <L? .COUNT 0>>
+ <REMOVE ,FOOD>
+ <TELL
+"The cyclops says 'Mmm Mmm. I love hot peppers! But oh, could I use
+a drink--perhaps some blood.' From the gleam in his eye, it is clear whose
+blood he means." CR>
+ <SETG CYCLOWRATH <MIN -1 <- .COUNT>>>)>
+ <ENABLE <QUEUE I-CYCLOPS -1>>)
+ (<==? ,PRSO ,WATER>
+ <COND (<L? .COUNT 0>
+ <REMOVE ,WATER>
+ <FCLEAR ,CYCLOPS ,FIGHTBIT>
+ <TELL
+"The cyclops yawns and falls fast asleep (what did you put in that
+drink, anyway?)." CR>
+ <SETG CYCLOPS-FLAG T>)
+ (ELSE
+ <TELL
+"The cyclops is not thirsty and refuses your offer." CR>
+ <>)>)
+ (<==? ,PRSO ,GARLIC>
+ <TELL
+"The cyclops may be hungry, but there is a limit." CR>)
+ (ELSE
+ <TELL
+"The cyclops is not so stupid as to eat THAT!" CR>)>)
+ (<VERB? THROW ATTACK MUNG KILL>
+ <ENABLE <QUEUE I-CYCLOPS -1>>
+ <TELL
+"The cyclops shrugs and ignores your pitiful effort." CR>
+ <COND (<VERB? THROW> <MOVE ,PRSO ,HERE>)>)
+ (<VERB? TAKE>
+ <TELL
+"The cyclops doesn't take kindly to being grabbed." CR>)
+ (<VERB? TIE>
+ <TELL
+"You cannot tie the cyclops, though he is fit to be tied." CR>)
+ (<VERB? LISTEN>
+ <TELL
+"You can hear his stomach rumbling.">)>>
+
+<ROUTINE I-CYCLOPS ()
+ <COND (,CYCLOPS-FLAG <RTRUE>)
+ (<NOT <==? ,HERE ,CYCLOPS-ROOM>>
+ <DISABLE <INT I-CYCLOPS>>)
+ (ELSE
+ <COND (<G? <ABS ,CYCLOWRATH> 5>
+ <DISABLE <INT I-CYCLOPS>>
+ <JIGS-UP
+"The cyclops, tired of all of your games eats you.
+The cyclops says 'Mmm. Just like Mom used to make 'em.'">)
+ (ELSE
+ <COND (<L? ,CYCLOWRATH 0>
+ <SETG CYCLOWRATH <- ,CYCLOWRATH 1>>)
+ (T
+ <SETG CYCLOWRATH <+ ,CYCLOWRATH 1>>)>
+ <COND (<NOT ,CYCLOPS-FLAG>
+ <TELL <NTH ,CYCLOMAD <- <ABS ,CYCLOWRATH> 1>>
+ CR>)>)>)>>
+
+<ROUTINE CYCLOPS-ROOM-FCN (RARG)
+ <COND (<==? .RARG ,M-LOOK>
+ <TELL
+"This room has an exit on the north, and a staircase leading up." CR>
+ <COND (<AND ,CYCLOPS-FLAG <NOT ,MAGIC-FLAG>>
+ <TELL
+"The cyclops is sleeping blissfully at the foot of the stairs." CR>)
+ (,MAGIC-FLAG
+ <TELL
+"The east wall, previously solid, now has a cyclops-sized hole in it." CR>)
+ (<0? ,CYCLOWRATH>
+ <TELL
+"A hungry-looking cyclops blocks the staircase. From the bloodstains on the
+walls you guess that he is not very friendly, though he likes people." CR>)
+ (<G? ,CYCLOWRATH 0>
+ <TELL
+"The cyclops is standing in the corner, eyeing you closely. He looks
+very hungry, even for a cyclops." CR>)
+ (<L? ,CYCLOWRATH 0>
+ <TELL
+"The cyclops, having eaten the hot peppers, appears to be gasping.
+His enflamed tongue protrudes from his man-sized mouth." CR>)>)
+ (<==? .RARG ,M-ENTER>
+ <OR <0? ,CYCLOWRATH> <ENABLE <INT I-CYCLOPS>>>)>>
+
+<GLOBAL CYCLOMAD
+ <TABLE
+ "The cyclops seems agitated."
+ "The cyclops appears to be getting more agitated."
+ "The cyclops is looking for something."
+ "The cyclops was looking for salt and pepper. I think he is
+preparing for a snack."
+ "The cyclops is moving toward you in an unfriendly manner."
+ "You have two choices: 1. Leave 2. Become dinner.">>
+
+\
+
+"SUBTITLE A SEEDY LOOKING GENTLEMAN..."
+
+<GLOBAL THIEF-HERE <>>
+
+;"I-THIEF moved to DEMONS"
+
+\
+
+"SUBTITLE THINGS THIEF MIGHT DO"
+
+<ROUTINE THIEF-VS-ADVENTURER (HERE? "AUX" (OLD-LIT ,LIT) ROBBED?)
+ <COND (<==? ,HERE ,TREASURE-ROOM> <RTRUE>)
+ (<NOT .HERE?>
+ <COND (<PROB 30>
+ <FCLEAR ,THIEF ,INVISIBLE>
+ <TELL
+"A thief carrying a large bag is leaning against a wall. He does not
+speak, but it is clear that the bag will be taken over his dead body." CR>)>)
+ (<PROB 30>
+ <COND (<SET ROBBED?
+ <OR <ROB ,HERE ,THIEF 100>
+ <ROB ,WINNER ,THIEF>>>
+ <TELL
+"The thief just left, after robbing you blind." CR>)
+ (ELSE
+ <TELL
+"The thief, finding nothing of value, just left." CR>)>
+ <FSET ,THIEF ,INVISIBLE>
+ <RTRUE>)>
+ <RFALSE>>
+
+<ROUTINE HACK-TREASURES ("AUX" X)
+ <FSET ,THIEF ,INVISIBLE>
+ <SET X <FIRST? ,TREASURE-ROOM>>
+ <REPEAT ()
+ <COND (<NOT .X> <RETURN>)
+ (ELSE <FCLEAR .X ,INVISIBLE>)>
+ <SET X <NEXT? .X>>>>
+
+<ROUTINE DEPOSIT-BOOTY (RM "AUX" X N)
+ <SET X <FIRST? ,THIEF>>
+ <REPEAT ()
+ <COND (<NOT .X> <RETURN>)>
+ <SET N <NEXT? .X>>
+ <COND (<==? .X ,STILETTO>)
+ (<G? <GETP .X ,P?TVALUE> 0>
+ <MOVE .X .RM>)>
+ <SET X .N>>>
+
+<ROUTINE ROB-MAZE (RM "AUX" X N)
+ <SET X <FIRST? .RM>>
+ <REPEAT ()
+ <COND (<NOT .X> <RETURN>)>
+ <SET N <NEXT? .X>>
+ <COND (<AND <FSET? .X ,TAKEBIT>
+ <NOT <FSET? .X ,INVISIBLE>>
+ <PROB 40>>
+ <TELL
+"You hear, off in the distance, someone saying \"My, I wonder what
+this fine " D .X " is doing here.\"" CR>
+ <COND (<PROB 60>
+ <MOVE .X ,THIEF>
+ <FSET .X ,TOUCHBIT>
+ <FSET .X ,INVISIBLE>)>
+ <RETURN>)>
+ <SET X .N>>>
+
+\
+
+"ROBBER-FUNCTION -- more prosaic thiefly occupations"
+
+<GLOBAL THIEF-ENGROSSED <>>
+
+<ROUTINE ROBBER-FUNCTION ("OPTIONAL" (MODE <>) "AUX" (FLG <>) X N)
+ #DECL ((DEM) HACK (FLG) <OR ATOM FALSE>)
+ <COND (<NOT .MODE>
+ <COND (<AND <==? ,PRSO ,KNIFE>
+ <VERB? THROW>>
+ <TELL
+"You missed. The thief doesn't take the knife, though it would be
+a fine addition to his collection." CR>
+ <FSET ,THIEF ,FIGHTBIT>)
+ (<AND <VERB? THROW GIVE>
+ <==? ,PRSI ,THIEF>>
+ <MOVE ,PRSO ,THIEF>
+ <COND (<G? <GETP ,PRSO ,P?TVALUE> 0>
+ <SETG THIEF-ENGROSSED T>
+ <TELL
+"The thief, surprised by your generosity, accepts the "
+D ,PRSO " and stops to admire its beauty." CR>)
+ (T
+ <TELL
+"The thief places the " D ,PRSO " in his bag." CR>)>)
+ (<VERB? LISTEN>
+ <TELL
+"The thief says nothing.">)>)
+ (<==? .MODE ,F-DEAD>
+ <DEPOSIT-BOOTY ,HERE>
+ <COND (<==? ,HERE ,TREASURE-ROOM>
+ <SET X <FIRST? ,HERE>>
+ <REPEAT ()
+ <COND
+ (<NOT .X>
+ <RETURN>)
+ (<NOT <EQUAL? .X ,CHALICE ,ADVENTURER>>
+ <FCLEAR .X ,INVISIBLE>
+ <COND (<NOT .FLG>
+ <SET FLG T>
+ <TELL
+"As the thief dies, his magic wanes, and his treasures reappear." CR>)>)>
+ <SET X <NEXT? .X>>>)
+ (ELSE
+ <TELL "His booty remains." CR>)>
+ <DISABLE <INT I-THIEF>>)
+ (<==? .MODE ,F-FIRST?>
+ <COND (<AND ,THIEF-HERE <PROB 20>>
+ <FSET ,THIEF ,FIGHTBIT>
+ T)>)>>
+
+<ROUTINE MOVE-ALL (FROM TO "AUX" X N)
+ <COND (<SET X <FIRST? .FROM>>
+ <REPEAT ()
+ <COND (<NOT .X> <RETURN>)>
+ <SET N <NEXT? .X>>
+ <FCLEAR .X ,INVISIBLE>
+ <MOVE .X .TO>
+ <SET X .N>>)>>
+
+<ROUTINE CHALICE-FCN ()
+ <COND (<VERB? TAKE>
+ <COND (<AND <IN? ,PRSO ,TREASURE-ROOM>
+ <IN? ,THIEF ,TREASURE-ROOM>
+ <FSET? ,THIEF ,FIGHTBIT>
+ <NOT <FSET? ,THIEF ,INVISIBLE>>>
+ <TELL "You'd be stabbed in the back!" CR>)>)>>
+
+<ROUTINE TREASURE-ROOM-FCN (RARG "AUX" (FLG <>) TL)
+ #DECL ((FLG) <OR ATOM FALSE>)
+ <COND (<AND <==? .RARG ,M-ENTER>
+ <1? <GET <INT I-THIEF> ,C-ENABLED?>>
+ <NOT ,DEAD>>
+ <COND (<SET FLG <NOT <IN? ,THIEF ,HERE>>>
+ <TELL
+"You hear a scream of anguish as the thief rushes to defend his hideaway." CR>
+ <MOVE ,THIEF ,HERE>
+ <FSET ,THIEF ,FIGHTBIT>
+ <FCLEAR ,THIEF ,INVISIBLE>)
+ (T
+ <FSET ,THIEF ,FIGHTBIT>)>
+ <THIEF-IN-TREASURE>)>>
+
+<ROUTINE THIEF-IN-TREASURE ("AUX" F N)
+ <SET F <FIRST? ,HERE>>
+ <COND (<AND .F <NEXT? .F>>
+ <TELL
+"The thief gestures and all his treasures vanish." CR>)>
+ <REPEAT ()
+ <COND (<NOT .F> <RETURN>)
+ (<AND <NOT <==? .F ,CHALICE>>
+ <NOT <==? .F ,THIEF>>>
+ <FSET .F ,INVISIBLE>)>
+ <SET F <NEXT? .F>>>>
+
+<ROUTINE DUMMY () <TELL "Look around." CR>>
+
+<ROUTINE FRONT-DOOR-FCN ()
+ <COND (<VERB? OPEN>
+ <TELL
+ "The door cannot be opened." CR>)
+ (<VERB? BURN>
+ <TELL
+ "You cannot burn this door." CR>)
+ (<VERB? MUNG>
+ <TELL "You cannot damage this door." CR>)
+ (<VERB? LOOK-BEHIND>
+ <TELL "It won't open." CR>)>>
+
+\
+
+"SUBTITLE RANDOM FUNCTIONS"
+
+<ROUTINE BLACK-BOOK ()
+ <COND (<VERB? OPEN>
+ <TELL "The book is already open." CR>)
+ (<VERB? CLOSE>
+ <TELL "Oddly, you cannot." CR>)
+ (<VERB? BURN>
+ <TELL "Sacrelige!" CR>)>>
+
+<ROUTINE PAINTING-FCN ()
+ <COND (<VERB? MUNG>
+ <PUTP ,PRSO ,P?TVALUE 0>
+ <PUTP ,PRSO ,P?LDESC
+"There is a worthless canvas here.">
+ <TELL
+"Great! You have ruined the painting." CR>)>>
+
+\
+
+"SUBTITLE LET THERE BE LIGHT SOURCES"
+
+<GLOBAL LAMP-TABLE
+ <TABLE 100
+ "The lamp appears a bit dimmer."
+ 70
+ "The lamp is definitely dimmer now."
+ 15
+ "The lamp is nearly out."
+ 0>>
+
+<ROUTINE LANTERN ()
+ <COND (<VERB? LAMP-ON>
+ <COND (<NOT <FSET? ,LAMP ,LIGHTBIT>>
+ <TELL "A burned-out lamp won't light." CR>)
+ (ELSE
+ <ENABLE <INT I-LANTERN>>
+ <>)>)
+ (<VERB? LAMP-OFF>
+ <COND (<NOT <FSET? ,LAMP ,LIGHTBIT>>
+ <TELL "The lamp has already burned out." CR>)
+ (ELSE
+ <DISABLE <INT I-LANTERN>>
+ <>)>)
+ (<VERB? EXAMINE>
+ <COND (<NOT <FSET? ,LAMP ,LIGHTBIT>>
+ <TELL "The lamp has burned out.">)
+ (<FSET? ,LAMP ,ONBIT>
+ <TELL "The lamp is on.">)
+ (ELSE
+ <TELL "The lamp is turned off.">)>
+ <CRLF>)>>
+
+<ROUTINE MIN (N1 N2)
+ #DECL ((N1 N2) FIX)
+ <COND (<L? .N1 .N2> .N1)
+ (T .N2)>>
+
+<ROUTINE LIGHT-INT (OBJ INTNAM TBLNAM "AUX" (TBL <VALUE .TBLNAM>) TICK)
+ #DECL ((OBJ) OBJECT (TBLNAM INTNAM) ATOM (TBL) <PRIMTYPE VECTOR>
+ (TICK) FIX)
+ <ENABLE <QUEUE .INTNAM <SET TICK <GET .TBL 0>>>>
+ <COND (<0? .TICK>
+ <FCLEAR .OBJ ,LIGHTBIT>
+ <FCLEAR .OBJ ,ONBIT>)>
+ <COND (<OR <HELD? .OBJ> <IN? .OBJ ,HERE>>
+ <COND (<0? .TICK>
+ <TELL "The " D .OBJ " is out." CR>)
+ (T
+ <TELL <GET .TBL 1> CR>)>)>
+ <COND (<NOT <0? .TICK>>
+ <SETG .TBLNAM <REST .TBL 4>>)>>
+
+\
+
+"SUBTITLE ASSORTED WEAPONS"
+
+<ROUTINE SWORD-FCN ()
+ <COND (<AND <VERB? TAKE> <==? ,WINNER ,ADVENTURER>>
+ <ENABLE <QUEUE I-SWORD -1>>
+ <>)>>
+
+"SUBTITLE COAL MINE"
+
+<ROUTINE BOOM-ROOM (RARG "AUX" (DUMMY? <>) FLAME)
+ <COND (<NOT .RARG>
+ <COND (<IN? ,TORCH ,WINNER>
+ <TELL " ** BOOOOOOM **" CR>
+ <JIGS-UP
+"Oh dear. It seems that the smell coming from this room was coal
+gas. I would have thought twice about carrying the torch in here.">)>)>>
+
+<ROUTINE BATS-ROOM (RARG)
+ <COND (<==? .RARG ,M-LOOK>
+ <TELL
+"You are in a small room which has doors only to the east and south." CR>
+ <COND (<EQUAL? <LOC ,GARLIC> ,WINNER ,HERE>
+ <TELL
+"In the corner of the room on the ceiling is a large vampire bat who
+is holding his nose." CR>)>)
+ (<==? .RARG ,M-ENTER>
+ <COND (<NOT <EQUAL? <LOC ,GARLIC> ,WINNER ,HERE>>
+ <FLY-ME>)>)>>
+
+<ROUTINE BAT-FUNCTION ()
+ <COND (<VERB? TAKE ATTACK KILL MUNG>
+ <FLY-ME>)>>
+
+<ROUTINE FLY-ME ("AUX" (N 4))
+ <REPEAT ()
+ <COND (<L? <SET N <- .N 1>> 1> <RETURN>)
+ (ELSE <TELL " Fweep!" CR>)>>
+ <TELL
+"A giant vampire bat swoops down from his perch and lifts you away...." CR>
+ <GOTO <PICK-ONE ,BAT-DROPS>>
+ T>
+
+<GLOBAL BAT-DROPS
+ <LTABLE MINE-1
+ MINE-2
+ MINE-3
+ GAS-ROOM
+ SQUEEKY-ROOM
+ MINE-ENTRANCE>>
+
+<GLOBAL CAGE-TOP T>
+
+<ROUTINE DUMBWAITER ()
+ <COND (<VERB? RAISE>
+ <COND (,CAGE-TOP
+ <DUMMY>)
+ (ELSE
+ <MOVE ,RAISED-BASKET ,SHAFT-ROOM>
+ <MOVE ,LOWERED-BASKET ,LOWER-SHAFT>
+ <TELL "The basket is now at the top of the shaft." CR>
+ <SETG CAGE-TOP T>)>)
+ (<VERB? LOWER>
+ <COND (<NOT ,CAGE-TOP>
+ <DUMMY>)
+ (ELSE
+ <MOVE ,RAISED-BASKET ,LOWER-SHAFT>
+ <MOVE ,LOWERED-BASKET ,SHAFT-ROOM>
+ <TELL
+"The basket is lowered to the bottom of the shaft." CR>
+ <SETG CAGE-TOP <>>
+ <COND (<AND ,LIT <NOT <SETG LIT <LIT? ,HERE>>>>
+ <TELL "It is now pitch black." CR>)>
+ T)>)
+ (<EQUAL? ,LOWERED-BASKET ,PRSO ,PRSI>
+ <TELL "The basket is at the other end of the chain." CR>)
+ (<AND <VERB? TAKE>
+ <EQUAL? ,PRSO ,RAISED-BASKET ,LOWERED-BASKET>>
+ <TELL "The cage is securely fastened to the chain." CR>)>>
+
+<ROUTINE MACHINE-ROOM-FCN (RARG)
+ <COND (<==? .RARG ,M-LOOK>
+ <TELL
+"In one corner of this chilly room is a machine shaped somewhat like a
+clothes dryer, with a grooved switch labelled START. The switch is so
+small that your fingers can not turn it. On top of the machine is a
+large lid, which is ">
+ <COND (<FSET? ,MACHINE ,OPENBIT>
+ <TELL "open.">)
+ (ELSE <TELL "closed.">)>
+ <CRLF>)>>
+
+<ROUTINE MACHINE-FUNCTION ()
+ <COND
+ (<==? ,HERE ,MACHINE-ROOM>
+ <COND
+ (<VERB? OPEN>
+ <COND (<FSET? ,MACHINE ,OPENBIT>
+ <DUMMY>)
+ (<FIRST? ,MACHINE>
+ <TELL "The lid opens, revealing ">
+ <PRINT-CONTENTS ,MACHINE>
+ <TELL "." CR>
+ <FSET ,MACHINE ,OPENBIT>)
+ (ELSE
+ <TELL "The lid opens." CR>
+ <FSET ,MACHINE ,OPENBIT>)>)
+ (<VERB? CLOSE>
+ <COND (<FSET? ,MACHINE ,OPENBIT>
+ <TELL "The lid closes." CR>
+ <FCLEAR ,MACHINE ,OPENBIT>
+ T)
+ (ELSE <DUMMY>)>)>)>>
+
+<ROUTINE MSWITCH-FUNCTION ("AUX" O)
+ <COND (<VERB? TURN>
+ <COND (<==? ,PRSI ,SCREWDRIVER>
+ <COND (<FSET? ,MACHINE ,OPENBIT>
+ <TELL
+"The machine won't work with the lid open." CR>)
+ (ELSE <TELL
+"The machine emits a brief display of dazzling lights and bizarre noises." CR>
+ <COND (<IN? ,COAL ,MACHINE>
+ <REMOVE ,COAL>
+ <MOVE ,DIAMOND ,MACHINE>)
+ (ELSE
+ <REPEAT ()
+ <COND (<SET O <FIRST? ,MACHINE>>
+ <REMOVE .O>)
+ (ELSE <RETURN>)>>
+ <MOVE ,GUNK ,MACHINE>)>)>)
+ (ELSE
+ <TELL "It seems that a " D ,PRSO " won't do." CR>)>)>>
+
+<ROUTINE GUNK-FUNCTION ()
+ <REMOVE ,GUNK>
+ <TELL
+"The slag crumbles into dust at your touch." CR>>
+
+<ROUTINE NO-OBJS (RARG "AUX" F)
+ <COND (<==? .RARG ,M-BEG>
+ <SET F <FIRST? ,WINNER>>
+ <SETG EMPTY-HANDED T>
+ <REPEAT ()
+ <COND (<NOT .F> <RETURN>)
+ (<G? <WEIGHT .F> 4>
+ <SETG EMPTY-HANDED <>>
+ <RETURN>)>
+ <SET F <NEXT? .F>>>
+ <COND (<AND <==? ,HERE ,LOWER-SHAFT> ,LIT>
+ <SCORE-UPD ,LIGHT-SHAFT>
+ <SETG LIGHT-SHAFT 0>)>
+ <RFALSE>)>>
+
+<ROUTINE SOUTH-TEMPLE-FCN (RARG)
+ <COND (<==? .RARG ,M-BEG>
+ <SETG COFFIN-CURE <NOT <IN? ,COFFIN ,WINNER>>>
+ <RFALSE>)>>
+
+<GLOBAL LIGHT-SHAFT 13>
+
+\
+
+"SUBTITLE OLD MAN RIVER, THAT OLD MAN RIVER..."
+
+<ROUTINE WHITE-CLIFFS-FUNCTION (RARG)
+ <COND (<NOT .RARG>
+ <COND (<IN? ,INFLATED-BOAT ,WINNER>
+ <SETG DEFLATE <>>)
+ (ELSE <SETG DEFLATE T>)>)>>
+
+<ROUTINE SCEPTRE-FUNCTION ()
+ <COND (<VERB? WAVE RAISE>
+ <COND (<AND <NOT ,RAINBOW-FLAG>
+ <EQUAL? ,HERE ,ARAGAIN-FALLS ,END-OF-RAINBOW>>
+ <FCLEAR ,POT-OF-GOLD ,INVISIBLE>
+ <TELL
+"Suddenly, the rainbow appears to become solid." CR>
+ <SETG RAINBOW-FLAG T>)
+ (ELSE
+ <TELL
+"A dazzling display of color briefly emanates from the sceptre." CR>)>)>>
+
+<ROUTINE FALLS-ROOM (RARG)
+ <COND (<==? .RARG ,M-LOOK>
+ <TELL
+"You are near the top of Aragain Falls, an enormous waterfall. The only path
+here is on the north end." CR>
+ <COND (,RAINBOW-FLAG
+ <TELL
+"A solid rainbow spans the falls.">)
+ (ELSE
+ <TELL
+"A beautiful rainbow can be seen over the falls to the west.">)>
+ <CRLF>)>>
+
+<ROUTINE RAINBOW-FCN ()
+ <COND (<VERB? CROSS>
+ <COND (,RAINBOW-FLAG
+ <COND (<==? ,HERE ,ARAGAIN-FALLS>
+ <GOTO ,END-OF-RAINBOW>)
+ (<==? ,HERE ,END-OF-RAINBOW>
+ <GOTO ,ARAGAIN-FALLS>)
+ (T
+ <TELL "You'll have to say which way..." CR>)>)
+ (T
+ <TELL "I didn't know you could walk on water vapor."
+ CR>)>)>>
+
+<GLOBAL YUKS
+ <LTABLE
+ "A valiant attempt."
+ "You can't be serious."
+ ;"Not bloody likely."
+ "An interesting idea..."
+ "What a concept!">>
+
+<ROUTINE RIVER-FUNCTION ()
+ <COND (<VERB? PUT>
+ <COND (<==? ,PRSI ,RIVER>
+ <COND (<==? ,PRSO ,ME>
+ <JIGS-UP
+"You fight the current for a while, and finally drown.">)
+ (<==? ,PRSO ,INFLATED-BOAT>
+ <TELL
+"You should get in the boat then launch it." CR>)
+ (<FSET? ,PRSO ,BURNBIT>
+ <REMOVE ,PRSO>
+ <TELL
+"The " D ,PRSO " floats for a moment, then sinks." CR>)
+ (ELSE
+ <REMOVE ,PRSO>
+ <TELL
+"The " D ,PRSO " splashes into the water and is gone forever." CR>)>)>)
+ (<VERB? LEAP>
+ <TELL
+"A look before leaping reveals that the river is dangerous,with
+swift currents and sharp rocks. You therefore decide to
+forgo your ill-considered swim." CR>)>>
+
+<GLOBAL RIVER-SPEEDS
+ <LTABLE RIVER-1 4 RIVER-2 3 RIVER-3 2>>
+
+<GLOBAL RIVER-NEXT
+ <LTABLE RIVER-1 RIVER-2 RIVER-3>>
+
+<GLOBAL RIVER-LAUNCH
+ <LTABLE DAM-BASE RIVER-1
+ WHITE-CLIFFS RIVER-2
+ SANDY-BEACH RIVER-3>>
+
+<ROUTINE I-RIVER ("AUX" RM)
+ #DECL ((RM) <OR FALSE OBJECT>)
+ <COND (<NOT <EQUAL? ,HERE ,RIVER-1 ,RIVER-2 ,RIVER-3>>
+ <DISABLE <INT I-RIVER>>)
+ (<SET RM <LKP ,HERE ,RIVER-NEXT>>
+ <TELL "The flow of the river carries you downstream." CR>
+ <GOTO .RM>
+ <ENABLE <QUEUE I-RIVER <LKP ,HERE ,RIVER-SPEEDS>>>)
+ (T
+ <JIGS-UP
+"Unfortunately, a rubber raft doesn't provide much protection from the rocks
+and boulders at the bottom of many waterfalls. Including this one.">)>>
+
+<ROUTINE RBOAT-FUNCTION ("OPTIONAL" (RARG <>))
+ #DECL ((RARG) <OR FALSE FIX>)
+ <COND (<==? .RARG ,M-ENTER> <>)
+ (<==? .RARG ,M-BEG>
+ <COND (<VERB? WALK>
+ <COND (<EQUAL? ,PRSO ,P?LAND ,P?EAST ,P?WEST>
+ <RFALSE>)
+ (T
+ <TELL "You can't control the boat with words." CR>
+ <RTRUE>)>)
+ (<VERB? LAUNCH>
+ <COND (<GO-NEXT ,RIVER-LAUNCH>
+ <ENABLE <QUEUE I-RIVER <LKP ,HERE ,RIVER-SPEEDS>>>
+ <RTRUE>)
+ (T
+ <TELL "You can't launch it from here." CR>)>)>)
+ (<VERB? LAUNCH>
+ <TELL "You're not in the boat!" CR>)
+ (<VERB? INFLATE FILL>
+ <TELL "Inflating it further would probably burst it." CR>)
+ (<VERB? DEFLATE>
+ <COND (<==? <LOC ,WINNER> ,INFLATED-BOAT>
+ <TELL
+"You can't deflate the boat while you're in it." CR>)
+ (<NOT <IN? ,INFLATED-BOAT ,HERE>>
+ <TELL
+"The boat must be on the ground to be deflated." CR>)
+ (ELSE <TELL
+"The boat deflates." CR>
+ <SETG DEFLATE T>
+ <REMOVE ,INFLATED-BOAT>
+ <MOVE ,INFLATABLE-BOAT ,HERE>)>)>>
+
+<ROUTINE BREATHE ()
+ <PERFORM ,V?INFLATE ,PRSO ,LUNGS>>
+
+<ROUTINE IBOAT-FUNCTION ()
+ <COND (<VERB? INFLATE FILL>
+ <COND (<NOT <IN? ,INFLATABLE-BOAT ,HERE>>
+ <TELL
+"The boat must be on the ground to be inflated." CR>)
+ (<==? ,PRSI ,PUMP>
+ <TELL
+"The boat inflates and appears seaworthy." CR>
+ <COND (<NOT <FSET? ,BOAT-LABEL ,TOUCHBIT>>
+ <TELL
+"A tan label is lying inside the boat." CR>)>
+ <SETG DEFLATE <>>
+ <REMOVE ,INFLATABLE-BOAT>
+ <MOVE ,INFLATED-BOAT ,HERE>)
+ (<==? ,PRSI ,LUNGS>
+ <TELL
+"You don't have enough lung power to inflate it." CR>)
+ (ELSE
+ <TELL
+"With a " D ,PRSI "? Surely you jest!" CR>)>)>>
+
+<GLOBAL BEACH-DIG -1>
+
+<GDECL (BEACH-DIG) FIX>
+
+<ROUTINE GROUND-FUNCTION ()
+ <COND (<AND <VERB? PUT> <==? ,PRSI ,GROUND>>
+ <PERFORM ,V?DROP ,PRSO>)
+ (<==? ,HERE ,SANDY-CAVE>
+ <SAND-FUNCTION>)
+ (<VERB? DIG>
+ <TELL "The ground is too hard for digging here." CR>)>>
+
+<ROUTINE SAND-FUNCTION ()
+ <COND (<VERB? DIG>
+ <SETG BEACH-DIG <+ 1 ,BEACH-DIG>>
+ <COND (<G? ,BEACH-DIG 3>
+ <SETG BEACH-DIG -1>
+ <AND <IN? ,SCARAB ,HERE> <FSET ,SCARAB ,INVISIBLE>>
+ <JIGS-UP "The hole collapses, smothering you.">)
+ (<==? ,BEACH-DIG 3>
+ <COND (<FSET? ,SCARAB ,INVISIBLE>
+ <TELL
+"You can see a scarab here in the sand." CR>
+ <FCLEAR ,SCARAB ,INVISIBLE>)>)
+ (T
+ <TELL <GET ,BDIGS ,BEACH-DIG> CR>)>)>>
+
+<GLOBAL BDIGS
+ <TABLE "You seem to be digging a hole here."
+ "The hole is getting deeper, but that's about it."
+ "You are surrounded by a wall of sand on all sides.">>
+
+\
+
+"SUBTITLE LURKING GRUES"
+
+<ROUTINE GRUE-FUNCTION ()
+ <COND (<VERB? EXAMINE>
+ <TELL
+"The grue is a fearsome beast who inhabits the dark places of the
+earth. Its favorite diet is adventurers, but its huge
+appetite is tempered by its fear of light." CR>)
+ (<VERB? FIND>
+ <TELL
+"There is no grue here, but I'm sure there is at least one lurking
+in the darkness nearby. I wouldn't let my light go out if I were
+you!" CR>)
+ (<VERB? LISTEN>
+ <TELL
+"It makes no sound but is always lurking in the darkness nearby." CR>)>>
+
+\
+
+<ROUTINE CRETIN ()
+ <COND (<AND <VERB? GIVE> <==? ,PRSI ,ME>>
+ <PERFORM ,V?TAKE ,PRSO>)
+ (<AND <VERB? GIVE> <==? ,PRSO ,ME> ,PRSI <FSET? ,PRSI ,VILLAIN>>
+ <TELL "That would be suicidal." CR>)
+ (<VERB? ATTACK KILL MUNG>
+ <COND (<AND ,PRSI <FSET? ,PRSI ,WEAPONBIT>>
+ <JIGS-UP
+ "If you insist.... Poof, you're dead!">)
+ (T <TELL "Suicide is not the answer." CR>)>)
+ (<VERB? TAKE>
+ <TELL "How romantic!" CR>)
+ (<VERB? EXAMINE>
+ <TELL
+ "That's difficult unless your eyes are prehensile." CR>)>>
+
+\
+
+<ROUTINE HELD? (CAN)
+ #DECL ((CAN) OBJECT)
+ <REPEAT ()
+ <SET CAN <LOC .CAN>>
+ <COND (<NOT .CAN> <RFALSE>)
+ (<==? .CAN ,WINNER> <RTRUE>)>>>
+
+\
+
+"SUBTITLE TOITY POIPLE BOIDS A CHOIPIN' AN' A BOIPIN' ... "
+
+<ROUTINE TREE-ROOM (RARG "AUX" F)
+ <COND (<==? .RARG ,M-LOOK>
+ <TELL
+"You are about 10 feet above the ground nestled among some large
+branches. The nearest branch above you is above your reach.
+A bird's nest is tangled around a branch here." CR>)
+ (<==? .RARG ,M-BEG>
+ <COND (<VERB? DROP>
+ <COND (<NOT <IDROP>> <RTRUE>)
+ (<==? ,PRSO ,EGG>
+ <TELL
+"The egg falls to the ground and cracks open." CR>
+ <MOVE ,EGG ,PATH>
+ <OPEN-EGG>)
+ (<NOT <EQUAL? ,PRSO ,WINNER ,TOP-OF-TREE>>
+ <MOVE ,PRSO ,PATH>
+ <TELL
+"The " D ,PRSO " falls to the ground." CR>)>)>)
+ (<==? .RARG ,M-ENTER> <ENABLE <QUEUE I-FOREST-ROOM -1>>)>>
+
+<ROUTINE EGG-OBJECT ()
+ <COND (<AND <VERB? OPEN MUNG> <==? ,PRSO ,EGG>>
+ <COND (<FSET? ,PRSO ,OPENBIT>
+ <TELL "The egg is already open." CR>)
+ (T
+ <TELL
+"The egg is now open, but the clumsiness of your attempt has seriously
+compromised its esthetic appeal." CR>
+ <OPEN-EGG>)>)
+ (<VERB? CLIMB-ON>
+ <TELL
+"There is a delicate crunch from beneath you.">
+ <OPEN-EGG>)>>
+
+<ROUTINE OPEN-EGG ("AUX" L)
+ <TELL
+"Nestled inside the now broken egg is a golden clockwork canary." CR>
+ <MOVE ,BROKEN-EGG <LOC ,EGG>>
+ <MOVE ,CANARY ,BROKEN-EGG>
+ <REMOVE ,EGG>>
+
+<GLOBAL SING-SONG <>>
+
+<ROUTINE CANARY-OBJECT ()
+ <COND (<VERB? WIND>
+ <COND (<AND <NOT ,SING-SONG> <FOREST-ROOM?>>
+ <TELL
+"The canary chirps a beautiful song and as it does a lovely songbird
+arrives and perches above your head. As it opens its beak to sing,
+a brass bauble drops from its mouth, bounces off your head, and lands
+in the grass. When the song ends, the bird flies away." CR>
+ <SETG SING-SONG T>
+ <MOVE ,BAUBLE
+ <COND (<==? ,HERE ,UP-A-TREE> ,PATH)
+ (ELSE ,HERE)>>)
+ (T
+ <TELL
+"The canary chirps blithely for a short time." CR>)>)>>
+
+<ROUTINE FOREST-ROOM? ()
+ <OR <EQUAL? ,HERE ,FOREST-EDGE>
+ <EQUAL? ,HERE ,PATH ,UP-A-TREE>>>
+
+<ROUTINE I-FOREST-ROOM ()
+ <COND (<NOT <FOREST-ROOM?>>
+ <DISABLE <INT I-FOREST-ROOM>>)
+ (<PROB 15>
+ <TELL
+"You hear in the distance the chirping of a song bird." CR>)>>
+
+<ROUTINE FOREST-ROOM (RARG)
+ <COND (<==? .RARG ,M-ENTER> <ENABLE <QUEUE I-FOREST-ROOM -1>>)>>
+
+<ROUTINE FOREST-FUNCTION ()
+ <COND (<VERB? WALK-AROUND>
+ <GO-NEXT ,FOREST-AROUND>)>>
+
+<ROUTINE BIRD-OBJECT ()
+ <COND (<VERB? EXAMINE>
+ <TELL "I can't see any songbird here." CR>)
+ (<VERB? FIND>
+ <TELL "The songbird is not here." CR>)
+ (<VERB? LISTEN>
+ <TELL "You can't hear the songbird just now." CR>)
+ (<VERB? FOLLOW>
+ <TELL "You can't follow him." CR>)>>
+
+<ROUTINE WCLIF-OBJECT ()
+ <COND (<VERB? CLIMB-UP CLIMB-DOWN CLIMB-FOO>
+ <TELL "The cliff is too steep for climbing." CR>)>>
+
+<ROUTINE CLIFF-OBJECT ()
+ <COND (<==? ,PRSI ,CLIMBABLE-CLIFF>
+ <COND (<VERB? PUT>
+ <TELL
+"The " D ,PRSO " tumbles into the river and is gone." CR>
+ <REMOVE ,PRSO>)>)>>
+
+\
+
+"SUBTITLE CHUTES AND LADDERS"
+
+<ROUTINE ROPE-FUNCTION ("AUX" RLOC)
+ <COND (<NOT <==? ,HERE ,DOME-ROOM>>
+ <SETG DOME-FLAG <>>
+ <COND (<VERB? TIE>
+ <TELL "You can't tie the rope to that." CR>)>)
+ (<VERB? TIE>
+ <COND (<==? ,PRSI ,RAILING>
+ <COND (,DOME-FLAG
+ <TELL
+"The rope is already tied to it." CR>)
+ (ELSE
+ <TELL
+"The rope drops over the side of the railing." CR>
+ <SETG DOME-FLAG T>
+ <FSET ,ROPE ,NDESCBIT>
+ <SET RLOC <LOC ,ROPE>>
+ <COND (<OR <NOT .RLOC>
+ <NOT <IN? .RLOC ,ROOMS>>>
+ <MOVE ,ROPE ,HERE>)>
+ T)>)>)
+ (<VERB? UNTIE>
+ <COND (,DOME-FLAG
+ <SETG DOME-FLAG <>>
+ <FCLEAR ,ROPE ,NDESCBIT>
+ <TELL "The rope is now untied." CR>)
+ (ELSE
+ <TELL "It is not tied to anything." CR>)>)
+ (<AND <VERB? DROP>
+ <==? ,HERE ,DOME-ROOM>
+ <NOT ,DOME-FLAG>>
+ <MOVE ,ROPE ,NORTH-TEMPLE>
+ <TELL "The rope drops gently to the floor below." CR>)
+ (<VERB? TAKE>
+ <COND (,DOME-FLAG
+ <TELL "The rope is tied to the railing." CR>)>)>>
+
+<ROUTINE UNTIE-FROM ()
+ <COND (<AND <==? ,PRSO ,ROPE>
+ <AND ,DOME-FLAG <==? ,PRSI ,RAILING>>>
+ <PERFORM ,V?UNTIE ,PRSO>)
+ (ELSE <TELL "It's not attached to that!" CR>)>>
+
+<ROUTINE SLIDE-FUNCTION ()
+ <COND (<OR <VERB? THROUGH>
+ <AND <VERB? PUT> <==? ,PRSO ,ME>>>
+ <TELL "You tumble down the slide...." CR>
+ <GOTO ,CELLAR>)
+ (<VERB? PUT>
+ <COND (<FSET? ,PRSO ,TAKEBIT>
+ <TELL
+"The " D ,PRSO " falls into the slide and is gone." CR>
+ <COND (<==? ,PRSO ,WATER> <REMOVE ,PRSO>)
+ (T
+ <MOVE ,PRSO ,CELLAR>)>)
+ (ELSE <YUK>)>)>>
+
+"MORE RANDOMNESS"
+
+;"Pseudo-object routines"
+
+<ROUTINE LAKE-PSEUDO ()
+ <COND (,LOW-TIDE
+ <TELL "There's not much lake left...." CR>)
+ (<VERB? CROSS>
+ <TELL "It's too wide to cross." CR>)
+ (<VERB? THROUGH>
+ <TELL "You can't swim in this lake.">)>>
+
+<ROUTINE GATE-PSEUDO ()
+ <COND (<VERB? THROUGH>
+ <PERFORM ,V?WALK ,P?IN>
+ <RTRUE>)
+ (ELSE
+ <TELL
+"The gate is protected by an invisible force." CR>)>>
+
+<ROUTINE DOOR-PSEUDO ()
+ <COND (<VERB? OPEN CLOSE>
+ <TELL "The door won't budge." CR>)>>
+
+<ROUTINE PAINT-PSEUDO ()
+ <COND (<VERB? MUNG>
+ <TELL "Some paint chips away, revealing more paint." CR>)>>
+
+<ROUTINE GAS-PSEUDO ()
+ <COND (<VERB? BREATHE> ;"REALLY BLOW"
+ <TELL "There is too much gas to blow away." CR>)
+ (<VERB? SMELL>
+ <TELL "It smells like coal gas in here." CR>)>>
+
+<ROUTINE PATH-OBJECT ()
+ <COND (<VERB? TAKE FOLLOW>
+ <TELL "You must specify a direction to go." CR>)
+ (<VERB? FIND>
+ <TELL "I can't help you there...." CR>)>>
+
diff --git a/chr.mud b/chr.mud
new file mode 100644
index 0000000..d59b86d
--- /dev/null
+++ b/chr.mud
@@ -0,0 +1,43 @@
+<SETG LENTAB <IVECTOR 4 0>>
+<SETG TBL <IVECTOR 26 0>>
+<SETG LINE <ISTRING 100>>
+
+<DEFINE CNTLIN (C "AUX" STR L)
+ <PROG ()
+ <READSTRING ,LINE .C <STRING <ASCII 13>> '<RETURN <>>>
+ <READCHR .C>
+ <READCHR .C>
+ <SET L <REST <MEMQ !\, ,LINE>>>
+ <SET STR <PARSE .L>>
+ <MAPF <>
+ <FUNCTION (CHR "AUX" OFF)
+ <SET OFF <- <ASCII .CHR> 96>>
+ <PUT ,TBL .OFF <+ <NTH ,TBL .OFF> 1>>>
+ .STR>>>
+
+<DEFINE WRDLIN (C "AUX" STR L)
+ <PROG ()
+ <READSTRING ,LINE .C <STRING <ASCII 13>> '<RETURN <>>>
+ <READCHR .C>
+ <READCHR .C>
+ <SET L <REST <MEMQ !\, ,LINE>>>
+ <SET STR <PARSE .L>>
+ <SET LEN </ <+ 4
+ <MAPF ,+
+ <FUNCTION (CHR)
+ <COND (<MEMQ .CHR ,BAD> 2)
+ (T 1)>>
+ .STR>> 4>>
+ <PUT ,LENTAB .LEN <+ <NTH ,LENTAB .LEN> 1>>>>
+
+<DEFINE WRDFILE (NAM "AUX" C)
+ <COND (<SET C <OPEN "READ" .NAM>>
+ <REPEAT ()
+ <COND (<NOT <WRDLIN .C>> <RETURN>)>>
+ <CLOSE .C>)>>
+
+<DEFINE CNTFILE (NAM "AUX" C)
+ <COND (<SET C <OPEN "READ" .NAM>>
+ <REPEAT ()
+ <COND (<NOT <CNTLIN .C>> <RETURN>)>>
+ <CLOSE .C>)>> \ No newline at end of file
diff --git a/clock.zil b/clock.zil
new file mode 100644
index 0000000..485074f
--- /dev/null
+++ b/clock.zil
@@ -0,0 +1,51 @@
+
+<CONSTANT C-TABLELEN 180>
+
+<GLOBAL C-TABLE <ITABLE NONE 90>>
+
+<GLOBAL C-INTS 90>
+
+<CONSTANT C-INTLEN 6>
+
+<CONSTANT C-ENABLED? 0>
+
+<CONSTANT C-TICK 1>
+
+<CONSTANT C-RTN 2>
+
+<ROUTINE QUEUE (RTN TICK "AUX" CINT)
+ #DECL ((RTN) ATOM (TICK) FIX (CINT) <PRIMTYPE VECTOR>)
+ <PUT <SET CINT <INT .RTN>> ,C-TICK .TICK>
+ .CINT>
+
+<ROUTINE INT (RTN "AUX" E C INT)
+ #DECL ((RTN) ATOM (E C INT) <PRIMTYPE VECTOR>)
+ <SET E <REST ,C-TABLE ,C-TABLELEN>>
+ <SET C <REST ,C-TABLE ,C-INTS>>
+ <REPEAT ()
+ <COND (<==? .C .E>
+ <SETG C-INTS <- ,C-INTS ,C-INTLEN>>
+ <SET INT <REST ,C-TABLE ,C-INTS>>
+ <PUT .INT ,C-RTN .RTN>
+ <RETURN .INT>)
+ (<==? <GET .C ,C-RTN> .RTN> <RETURN .C>)>
+ <SET C <REST .C ,C-INTLEN>>>>
+
+<GLOBAL CLOCK-WAIT <>>
+
+<ROUTINE CLOCKER ("AUX" C E TICK (FLG <>))
+ #DECL ((C E) <PRIMTYPE VECTOR> (TICK) FIX (FLG) <OR FALSE ATOM>)
+ <COND (,CLOCK-WAIT <SETG CLOCK-WAIT <>> <RFALSE>)>
+ <SET C <REST ,C-TABLE ,C-INTS>>
+ <SET E <REST ,C-TABLE ,C-TABLELEN>>
+ <REPEAT ()
+ <COND (<==? .C .E> <RETURN .FLG>)
+ (<NOT <0? <GET .C ,C-ENABLED?>>>
+ <SET TICK <GET .C ,C-TICK>>
+ <COND (<0? .TICK>)
+ (T
+ <PUT .C ,C-TICK <- .TICK 1>>
+ <COND (<NOT <G? .TICK 1>>
+ <SET FLG T>
+ <APPLY <GET .C ,C-RTN>>)>)>)>
+ <SET C <REST .C ,C-INTLEN>>>>
diff --git a/crufty.xzap b/crufty.xzap
new file mode 100644
index 0000000..44bfcb8
--- /dev/null
+++ b/crufty.xzap
@@ -0,0 +1,28 @@
+
+ .FUNCT THIS-IT?,OBJ,TBL,SYNS,?TMP1
+ FSET? OBJ,INVISIBLE /FALSE
+ ZERO? P-NAM /?THN3
+ GETPT OBJ,P?SYNONYM >SYNS
+ PTSIZE SYNS
+ DIV STACK,2
+ SUB STACK,1
+ CALL ZMEMQ,P-NAM,SYNS,STACK
+ ZERO? STACK /FALSE
+?THN3: ZERO? P-ADJ /?ELS8
+ GETPT OBJ,P?ADJECTIVE >SYNS
+ ZERO? SYNS /FALSE
+ PTSIZE SYNS
+ SUB STACK,1
+ CALL ZMEMQB,P-ADJ,SYNS,STACK
+ ZERO? STACK /FALSE
+?ELS8: ZERO? P-GWIMBIT /TRUE
+ FSET? OBJ,P-GWIMBIT /TRUE
+ RFALSE
+
+
+ .FUNCT I-LANTERN
+ CALL LIGHT-INT,LAMP,I-LANTERN,'LAMP-TABLE
+ RSTACK
+
+
+ .ENDI
diff --git a/crufty.zil b/crufty.zil
new file mode 100644
index 0000000..8f90f34
--- /dev/null
+++ b/crufty.zil
@@ -0,0 +1,18 @@
+<ROUTINE THIS-IT? (OBJ TBL "AUX" SYNS)
+ #DECL ((OBJ) OBJECT (TBL) TABLE (SYNS) <OR FALSE TABLE>)
+ <AND <NOT <FSET? .OBJ ,INVISIBLE>>
+ <OR <NOT ,P-NAM>
+ <ZMEMQ ,P-NAM
+ <SET SYNS <GETPT .OBJ ,P?SYNONYM>>
+ <- </ <PTSIZE .SYNS> 2> 1>>>
+ <OR <NOT ,P-ADJ>
+ <AND <SET SYNS <GETPT .OBJ ,P?ADJECTIVE>>
+ <ZMEMQB ,P-ADJ .SYNS <- <PTSIZE .SYNS> 1>>>>
+ <OR <0? ,P-GWIMBIT> <FSET? .OBJ ,P-GWIMBIT>>>>
+
+<ROUTINE I-LANTERN ()
+ <LIGHT-INT ,LAMP I-LANTERN LAMP-TABLE>>
+
+
+
+
diff --git a/demons.zil b/demons.zil
new file mode 100644
index 0000000..dd4c113
--- /dev/null
+++ b/demons.zil
@@ -0,0 +1,164 @@
+"Fighting demon"
+
+<ROUTINE I-FIGHT ("AUX" (FIGHT? <>) (LEN <GET ,VILLAINS 0>)
+ CNT OO O P)
+ <COND (,DEAD <RTRUE>)>
+ <SET CNT 0>
+ <REPEAT ()
+ <SET CNT <+ .CNT 1>>
+ <COND (<==? .CNT .LEN> <RETURN>)>
+ <SET OO <GET ,VILLAINS .CNT>>
+ <COND (<IN? <SET O <GET .OO ,V-VILLAIN>> ,HERE>
+ <COND (<AND <==? .O ,THIEF> ,THIEF-ENGROSSED>
+ <SETG THIEF-ENGROSSED <>>)
+ (<L? <GETP .O ,P?STRENGTH> 0>
+ <SET P <GET .OO ,V-PROB>>
+ <COND (<AND <NOT <0? .P>> <PROB .P>>
+ <PUT .OO ,V-PROB 0>
+ <AWAKEN .O>)
+ (ELSE
+ <PUT .OO ,V-PROB <+ .P 25>>)>)
+ (<OR <FSET? .O ,FIGHTBIT>
+ <APPLY <GETP .O ,P?ACTION> ,F-FIRST?>>
+ <SET FIGHT? T>)>)
+ (ELSE
+ <COND (<FSET? .O ,FIGHTBIT>
+ <APPLY <GETP .O ,P?ACTION> ,F-BUSY?>)>
+ <COND (<==? .O ,THIEF> <SETG THIEF-ENGROSSED <>>)>
+ <FCLEAR ,WINNER ,STAGGERED>
+ <FCLEAR .O ,STAGGERED>
+ <FCLEAR .O ,FIGHTBIT>
+ <AWAKEN .O>)>>
+ <COND (<NOT .FIGHT?> <RTRUE>)>
+ <DO-FIGHT .LEN>>
+
+<ROUTINE AWAKEN (O "AUX" (S <GETP .O ,P?STRENGTH>))
+ <COND (<L? .S 0>
+ <PUTP .O ,P?STRENGTH <- 0 .S>>
+ <APPLY <GETP .O ,P?ACTION> ,F-CONSCIOUS>)>
+ T>
+
+"SWORD demon"
+
+<ROUTINE I-SWORD ("AUX" (DEM <INT I-SWORD>) (G <GETP ,SWORD ,P?TVALUE>)
+ (NG 0) P T L)
+ #DECL ((NG G) FIX)
+ <COND (<IN? ,SWORD ,ADVENTURER>
+ <COND (<INFESTED? ,HERE> <SET NG 2>)
+ (ELSE
+ <SET P 0>
+ <REPEAT ()
+ <COND (<0? <SET P <NEXTP ,HERE .P>>>
+ <RETURN>)
+ (<NOT <L? .P ,LOW-DIRECTION>>
+ <SET T <GETPT ,HERE .P>>
+ <SET L <PTSIZE .T>>
+ <COND (<EQUAL? .L ,UEXIT ,CEXIT ,DEXIT>
+ <COND (<INFESTED? <GETB .T 0>>
+ <SET NG 1>
+ <RETURN>)>)>)>>)>
+ <COND (<==? .NG .G>)
+ (<==? .NG 2>
+ <TELL "Your sword has begun to glow very brightly." CR>)
+ (<1? .NG>
+ <TELL "Your sword is glowing with a faint blue glow."
+ CR>)
+ (<0? .NG>
+ <TELL "Your sword is no longer glowing." CR>)>
+ <PUTP ,SWORD ,P?TVALUE .NG>)
+ (ELSE <PUT .DEM ,C-ENABLED? 0>)>>
+
+<ROUTINE INFESTED? (R "AUX" (F <FIRST? .R>))
+ <REPEAT ()
+ <COND (<NOT .F> <RETURN <>>)
+ (<AND <FSET? .F ,VILLAIN> <NOT <FSET? .F ,INVISIBLE>>>
+ <RTRUE>)
+ (<NOT <SET F <NEXT? .F>>> <RETURN <>>)>>>
+
+"THIEF demon"
+
+<ROUTINE I-THIEF ("AUX" (RM <LOC ,THIEF>) ROBJ HERE? (ONCE <>))
+ <PROG ()
+ <COND (<SET HERE? <NOT <FSET? ,THIEF ,INVISIBLE>>>
+ <SET RM <LOC ,THIEF>>)>
+ <COND
+ (<AND <==? .RM ,TREASURE-ROOM> <NOT <==? .RM ,HERE>>>
+ <COND (.HERE? <HACK-TREASURES> <SET HERE? <>>)>
+ <DEPOSIT-BOOTY ,TREASURE-ROOM>)
+ (<==? .RM ,HERE>
+ <THIEF-VS-ADVENTURER .HERE?>)
+ (ELSE
+ <COND (<AND <IN? ,THIEF .RM>
+ <NOT <FSET? ,THIEF ,INVISIBLE>>> ;"Leave if victim left"
+ <FSET ,THIEF ,INVISIBLE>
+ <SET HERE? <>>)>
+ <COND (<FSET? .RM ,TOUCHBIT> ;"Hack the adventurer's belongings"
+ <ROB .RM ,THIEF 75>
+ <COND (<AND <FSET? .RM ,MAZEBIT> <FSET? ,HERE ,MAZEBIT>>
+ <ROB-MAZE .RM>)
+ (ELSE <STEAL-JUNK .RM>)>)>)>
+ <COND (<AND <SET ONCE <NOT .ONCE>> <NOT .HERE?>>
+ ;"Move to next room, and hack."
+ <REPEAT ()
+ <COND (<AND .RM <SET RM <NEXT? .RM>>>)
+ (ELSE <SET RM <FIRST? ,ROOMS>>)>
+ <COND (<AND <NOT <FSET? .RM ,SACREDBIT>>
+ <FSET? .RM ,RLANDBIT>>
+ <MOVE ,THIEF .RM>
+ <FCLEAR ,THIEF ,FIGHTBIT>
+ <FSET ,THIEF ,INVISIBLE>
+ <RETURN>)>>
+ <AGAIN>)>>
+ <COND (<NOT <==? .RM ,TREASURE-ROOM>>
+ <DROP-JUNK .RM>)>>
+
+<ROUTINE DROP-JUNK (RM "AUX" X N)
+ <SET X <FIRST? ,THIEF>>
+ <REPEAT ()
+ <COND (<NOT .X> <RETURN>)>
+ <SET N <NEXT? .X>>
+ <COND (<==? .X ,STILETTO>)
+ (<AND <0? <GETP .X ,P?TVALUE>> <PROB 30 T>>
+ <FCLEAR .X ,INVISIBLE>
+ <MOVE .X .RM>
+ <COND (<==? .RM ,HERE>
+ <TELL
+"The robber, rummaging through his bag, dropped a few items he found
+valueless." CR>)>)>
+ <SET X .N>>>
+
+<ROUTINE STEAL-JUNK (RM "AUX" X N)
+ <SET X <FIRST? .RM>>
+ <REPEAT ()
+ <COND (<NOT .X> <RETURN>)>
+ <SET N <NEXT? .X>>
+ <COND (<AND <0? <GETP .X ,P?TVALUE>>
+ <FSET? .X ,TAKEBIT>
+ <NOT <FSET? .X ,SACREDBIT>>
+ <NOT <FSET? .X ,INVISIBLE>>
+ <OR <==? .X ,STILETTO>
+ <PROB 10 T>>>
+ <MOVE .X ,THIEF>
+ <FSET .X ,TOUCHBIT>
+ <FSET .X ,INVISIBLE>
+ <COND (<==? .X ,ROPE> <SETG DOME-FLAG <>>)>
+ <COND (<==? .RM ,HERE>
+ <TELL "You suddenly notice that the "
+ D .X " vanished." CR>)>
+ <RETURN>)>
+ <SET X .N>>>
+
+<ROUTINE ROB (WHAT THIEF "OPTIONAL" (PROB <>) "AUX" N X (ROBBED? <>))
+ <SET X <FIRST? .WHAT>>
+ <REPEAT ()
+ <COND (<NOT .X> <RETURN .ROBBED?>)>
+ <SET N <NEXT? .X>>
+ <COND (<AND <NOT <FSET? .X ,INVISIBLE>>
+ <NOT <FSET? .X ,SACREDBIT>>
+ <G? <GETP .X ,P?TVALUE> 0>
+ <OR <NOT .PROB> <PROB .PROB>>>
+ <MOVE .X .THIEF>
+ <FSET .X ,TOUCHBIT>
+ <COND (<==? .THIEF ,THIEF> <FSET .X ,INVISIBLE>)>
+ <SET ROBBED? T>)>
+ <SET X .N>>> \ No newline at end of file
diff --git a/dungeon.zil b/dungeon.zil
new file mode 100644
index 0000000..36de313
--- /dev/null
+++ b/dungeon.zil
@@ -0,0 +1,1687 @@
+"SUBTITLE MINI-ZORK"
+
+<DIRECTIONS NORTH EAST WEST SOUTH NE NW SE SW UP DOWN IN OUT LAND>
+
+"SUBTITLE GLOBAL OBJECTS"
+
+<GLOBAL LOAD-MAX 100>
+<GLOBAL LOAD-ALLOWED 100>
+
+<OBJECT GLOBAL-OBJECTS
+ (FLAGS RWATERBIT RMUNGBIT INVISIBLE TOUCHBIT FIGHTBIT STAGGERED)>
+
+<OBJECT LOCAL-GLOBALS (IN GLOBAL-OBJECTS) (SYNONYM MGCKJK)>
+;"Yes, this synonym for LOCAL-GLOBALS needs to exist... sigh"
+
+<OBJECT ROOMS>
+
+<OBJECT PSEUDO-OBJECT
+ (DESC "pseudo")
+ (ACTION GRANITE)>
+
+<OBJECT IT ;"was IT"
+ (IN GLOBAL-OBJECTS)
+ (SYNONYM IT THAT THIS HIM)
+ (DESC "random object")
+ (FLAGS NDESCBIT)>
+
+<OBJECT STAIRS
+ (IN LOCAL-GLOBALS)
+ (SYNONYM STAIRS STEPS STAIRCASE STAIRWAY)
+ (ADJECTIVE STONE FORBIDDING STEEP)
+ (DESC "stairs")
+ (FLAGS NDESCBIT CLIMBBIT)>
+
+<OBJECT PATHOBJ
+ (IN GLOBAL-OBJECTS)
+ (SYNONYM PASSAGE CRAWLWAY EXIT PATH)
+ (ADJECTIVE FOREST NARROW LONG WINDING)
+ (DESC "way")
+ (FLAGS NDESCBIT)
+ (ACTION PATH-OBJECT)>
+
+<OBJECT BOARDS
+ (IN LOCAL-GLOBALS)
+ (SYNONYM BOARDS BOARD)
+ (DESC "board")
+ (FLAGS NDESCBIT)>
+
+<OBJECT WALL ;"was WALL"
+ (IN GLOBAL-OBJECTS)
+ (SYNONYM WALL WALLS)
+ (DESC "wall")>
+
+<OBJECT GROUND ;"was GROUND"
+ (IN GLOBAL-OBJECTS)
+ (SYNONYM GROUND EARTH SAND DIRT)
+ (DESC "ground")
+ (ACTION GROUND-FUNCTION)>
+
+<OBJECT GRUE ;"was GRUE"
+ (IN GLOBAL-OBJECTS)
+ (SYNONYM GRUE)
+ (ADJECTIVE LURKING)
+ (DESC "lurking grue")
+ (ACTION GRUE-FUNCTION)>
+
+<OBJECT LUNGS ;"was LUNGS"
+ (IN GLOBAL-OBJECTS)
+ (SYNONYM LUNGS AIR MOUTH BREATH)
+ (DESC "air")
+ (FLAGS NDESCBIT)>
+
+<OBJECT SONGBIRD ;"was SONGBIRD"
+ (IN LOCAL-GLOBALS)
+ (SYNONYM BIRD)
+ (ADJECTIVE SONG)
+ (DESC "song bird")
+ (FLAGS NDESCBIT)
+ (ACTION BIRD-OBJECT)>
+
+<OBJECT WHITE-HOUSE ;"was WHITE-HOUSE"
+ (IN LOCAL-GLOBALS)
+ (SYNONYM HOUSE)
+ (ADJECTIVE WHITE)
+ (DESC "white house")
+ (FLAGS NDESCBIT)
+ (ACTION HOUSE-FUNCTION)>
+
+<OBJECT FOREST
+ (IN LOCAL-GLOBALS)
+ (SYNONYM FOREST TREES)
+ (DESC "forest")
+ (FLAGS NDESCBIT)
+ (ACTION FOREST-FUNCTION)>
+
+<OBJECT TREE ;"was TREE"
+ (IN LOCAL-GLOBALS)
+ (SYNONYM TREE TREES)
+ (ADJECTIVE LARGE)
+ (DESC "tree")
+ (FLAGS NDESCBIT)>
+
+<OBJECT GLOBAL-WATER ;"was GLOBAL-WATER"
+ (IN LOCAL-GLOBALS)
+ (SYNONYM WATER QUANTITY)
+ (DESC "water")
+ (FLAGS DRINKBIT)
+ (ACTION WATER-FUNCTION)>
+
+<OBJECT KITCHEN-WINDOW ;"was KITCHEN-WINDOW"
+ (IN LOCAL-GLOBALS)
+ (SYNONYM WINDOW)
+ (ADJECTIVE KITCHEN SMALL)
+ (DESC "kitchen window")
+ (FLAGS DOORBIT NDESCBIT)
+ (ACTION WINDOW-FUNCTION)>
+
+<OBJECT CHIMNEY
+ (IN LOCAL-GLOBALS)
+ (SYNONYM CHIMNEY)
+ (ADJECTIVE DARK NARROW)
+ (DESC "chimney")
+ (FLAGS CLIMBBIT NDESCBIT)>
+
+\
+
+"SUBTITLE OBJECTS"
+
+<OBJECT ADVENTURER ;"was ADVENTURER"
+ (IN WEST-OF-HOUSE)
+ (SYNONYM ADVENTURER)
+ (DESC "cretin")
+ (FLAGS VILLAIN NDESCBIT INVISIBLE SACREDBIT)
+ (STRENGTH 0)
+ (ACTION 0)>
+
+<OBJECT ME
+ (IN GLOBAL-OBJECTS)
+ (SYNONYM ME MYSELF SELF CRETIN)
+ (DESC "you")
+ (FLAGS VILLAIN)
+ (ACTION CRETIN)>
+
+<OBJECT GHOST ;"was GHOST"
+ (IN ENTRANCE-TO-HADES)
+ (SYNONYM GHOSTS SPIRITS FORCE)
+ (ADJECTIVE INVISIBLE EVIL)
+ (DESC "number of ghosts")
+ (FLAGS VICBIT NDESCBIT)
+ (ACTION GHOST-FUNCTION)>
+
+<OBJECT SKULL
+ (IN LAND-OF-LIVING-DEAD)
+ (SYNONYM SKULL TREASURE)
+ (ADJECTIVE CRYSTAL)
+ (DESC "crystal skull")
+ (FDESC
+"Lying in the corner is a beautifully carved crystal skull.")
+ (FLAGS TAKEBIT)
+ (VALUE 10)
+ (TVALUE 10)>
+
+<OBJECT LOWERED-BASKET ;"was FBASK"
+ (IN LOWER-SHAFT)
+ (SYNONYM BASKET)
+ (LDESC "From the chain is suspended a basket.")
+ (DESC "basket")
+ (FLAGS)
+ (ACTION DUMBWAITER)>
+
+<OBJECT FOOD ;"was FOOD"
+ (IN SANDWICH-BAG)
+ (SYNONYM FOOD SANDWICH LUNCH)
+ (ADJECTIVE HOT PEPPER)
+ (DESC "lunch")
+ (FLAGS TAKEBIT FOODBIT)
+ (LDESC "A hot pepper sandwich is here.")>
+
+<OBJECT RAISED-BASKET ;"was TBASK"
+ (IN SHAFT-ROOM)
+ (SYNONYM BASKET)
+ (DESC "basket")
+ (FLAGS TRANSBIT CONTBIT OPENBIT)
+ (ACTION DUMBWAITER)
+ (LDESC "At the end of the chain is a basket.")
+ (CAPACITY 50)>
+
+<OBJECT BAT ;"was BAT"
+ (IN BAT-ROOM)
+ (SYNONYM BAT VAMPIRE)
+ (ADJECTIVE VAMPIRE DERANGED)
+ (DESC "bat")
+ (FLAGS NDESCBIT TRYTAKEBIT)
+ (ACTION BAT-FUNCTION)>
+
+<OBJECT BELL ;"was BELL"
+ (IN NORTH-TEMPLE)
+ (SYNONYM BELL)
+ (ADJECTIVE BRASS)
+ (DESC "brass bell")
+ (FLAGS TAKEBIT)>
+
+<OBJECT AXE ;"was AXE"
+ (IN TROLL)
+ (SYNONYM AXE)
+ (ADJECTIVE BLOODY)
+ (DESC "bloody axe")
+ (FLAGS ;WEAPONBIT TRYTAKEBIT NDESCBIT)
+ (ACTION AXE-FUNCTION)
+ (SIZE 25)>
+
+<OBJECT BOLT ;"was BOLT"
+ (IN DAM-ROOM)
+ (SYNONYM BOLT)
+ (ADJECTIVE METAL LARGE)
+ (DESC "bolt")
+ (FLAGS NDESCBIT TURNBIT)
+ (ACTION BOLT-FUNCTION)>
+
+<OBJECT ALTAR
+ (IN SOUTH-TEMPLE)
+ (SYNONYM ALTAR)
+ (DESC "altar")
+ (FLAGS NDESCBIT SURFACEBIT CONTBIT OPENBIT)
+ (CAPACITY 50)>
+
+<OBJECT BOOK ;"was BOOK"
+ (IN ALTAR)
+ (SYNONYM BOOK)
+ (ADJECTIVE PRAYER)
+ (DESC "prayer book")
+ (FLAGS READBIT TAKEBIT CONTBIT BURNBIT TURNBIT)
+ (ACTION BLACK-BOOK)
+ (FDESC "On the altar is an open prayer book.")
+ (SIZE 10)
+ (TEXT
+"The book contains instructions for using certain noises and prayers to
+drive away evil." )>
+
+<OBJECT SCEPTRE ;"was STICK"
+ (IN COFFIN)
+ (SYNONYM SCEPTRE TREASURE)
+ (ADJECTIVE EGYPTIAN ANCIENT)
+ (DESC "sceptre")
+ (FLAGS TAKEBIT)
+ (ACTION SCEPTRE-FUNCTION)
+ (FDESC
+"An ancient Egyptian sceptre, ornamented with multi-colored jewels, is in
+the coffin.")
+ (SIZE 3)
+ (VALUE 4)
+ (TVALUE 6)>
+
+<OBJECT TIMBERS ;"was OTIMB"
+ (IN TIMBER-ROOM)
+ (SYNONYM TIMBERS PILE)
+ (ADJECTIVE WOODEN BROKEN)
+ (DESC "broken timber")
+ (FLAGS TAKEBIT)
+ (SIZE 50)>
+
+<OBJECT SLIDE ;"was SLIDE"
+ (IN LOCAL-GLOBALS)
+ (SYNONYM SLIDE)
+ (ADJECTIVE STEEP METAL TWISTING)
+ (DESC "slide")
+ (FLAGS CLIMBBIT)
+ (ACTION SLIDE-FUNCTION)>
+
+<OBJECT KITCHEN-TABLE
+ (IN KITCHEN)
+ (SYNONYM TABLE)
+ (ADJECTIVE KITCHEN)
+ (DESC "kitchen table")
+ (FLAGS NDESCBIT CONTBIT OPENBIT SURFACEBIT)
+ (CAPACITY 30)>
+
+<OBJECT SANDWICH-BAG ;"was SBAG"
+ (IN KITCHEN-TABLE)
+ (SYNONYM BAG SACK)
+ (ADJECTIVE BROWN ELONGATED SMELLY)
+ (DESC "brown sack")
+ (FLAGS TAKEBIT CONTBIT BURNBIT)
+ (FDESC
+"On the table is an elongated brown sack, smelling of hot peppers.")
+ (CAPACITY 15)
+ (SIZE 3)>
+
+<OBJECT OVERBOARD
+ (IN GLOBAL-OBJECTS)
+ (SYNONYM OVERBOARD)
+ (FLAGS NDESCBIT)>
+
+<OBJECT TOOL-CHEST ;"first obj in room"
+ (IN MAINTENANCE-ROOM)
+ (SYNONYM CHEST TOOLCHEST)
+ (ADJECTIVE TOOL)
+ (DESC "tool chest")
+ (FLAGS OPENBIT SACREDBIT)>
+
+<OBJECT BUTTON ;"was YBUTT"
+ (IN MAINTENANCE-ROOM)
+ (SYNONYM BUTTON)
+ (DESC "button")
+ (FLAGS NDESCBIT)
+ (ACTION DBUTTONS)>
+
+<OBJECT TROPHY-CASE ;"was TCASE -- first obj so L.R. desc looks right."
+ (IN LIVING-ROOM)
+ (SYNONYM CASE)
+ (ADJECTIVE TROPHY)
+ (DESC "trophy case")
+ (FLAGS TRANSBIT CONTBIT NDESCBIT)
+ (ACTION TROPHY-CASE-FCN)
+ (CAPACITY 10000)>
+
+<OBJECT RUG ;"was RUG"
+ (IN LIVING-ROOM)
+ (SYNONYM RUG CARPET)
+ (ADJECTIVE LARGE ORIENTAL)
+ (DESC "carpet")
+ (FLAGS NDESCBIT TRYTAKEBIT)
+ (ACTION RUG-FCN)>
+
+<OBJECT CHALICE ;"was CHALI"
+ (IN TREASURE-ROOM)
+ (SYNONYM CHALICE SILVER TREASURE)
+ (ADJECTIVE SILVER)
+ (DESC "silver chalice")
+ (FLAGS TAKEBIT)
+ (ACTION CHALICE-FCN)
+ (SIZE 10)
+ (VALUE 10)
+ (TVALUE 5)>
+
+<OBJECT GARLIC ;"was GARLI"
+ (IN SANDWICH-BAG)
+ (SYNONYM GARLIC CLOVE)
+ (DESC "clove of garlic")
+ (FLAGS TAKEBIT FOODBIT)>
+
+<OBJECT CYCLOPS ;"was CYCLO"
+ (IN CYCLOPS-ROOM)
+ (SYNONYM CYCLOPS)
+ (ADJECTIVE HUNGRY GIANT)
+ (DESC "cyclops")
+ (FLAGS VICBIT VILLAIN NDESCBIT)
+ (ACTION CYCLOPS-FCN)
+ (STRENGTH 10000)>
+
+<OBJECT DAM ;"was DAM"
+ (IN DAM-ROOM)
+ (SYNONYM DAM GATE GATES)
+ (DESC "dam")
+ (FLAGS NDESCBIT)
+ (ACTION DAM-FUNCTION)>
+
+<OBJECT TRAP-DOOR ;"was DOOR"
+ (IN LIVING-ROOM)
+ (SYNONYM DOOR TRAP-DOOR)
+ (ADJECTIVE TRAP)
+ (DESC "trap door")
+ (FLAGS DOORBIT NDESCBIT INVISIBLE)
+ (ACTION TRAP-DOOR-FCN)>
+
+<OBJECT BOARDED-WINDOW
+ (SYNONYM WINDOW)
+ (ADJECTIVE BOARDED)
+ (DESC "boarded window")
+ (FLAGS NDESCBIT)>
+
+<OBJECT NAILS
+ (IN WOODEN-DOOR)
+ (SYNONYM NAILS NAIL)
+ (DESC "nail")
+ (FLAGS NDESCBIT)>
+
+<OBJECT FRONT-DOOR ;"was FDOOR"
+ (IN WEST-OF-HOUSE)
+ (SYNONYM DOOR)
+ (ADJECTIVE FRONT BOARDED)
+ (DESC "door")
+ (FLAGS DOORBIT NDESCBIT)
+ (ACTION FRONT-DOOR-FCN)>
+
+<OBJECT BARROW-DOOR
+ (IN STONE-BARROW)
+ (SYNONYM DOOR)
+ (ADJECTIVE HUGE STONE)
+ (DESC "stone door")
+ (FLAGS DOORBIT NDESCBIT)>
+
+<OBJECT BARROW
+ (IN STONE-BARROW)
+ (SYNONYM BARROW TOMB)
+ (ADJECTIVE MASSIVE STONE)
+ (DESC "stone barrow")
+ (FLAGS NDESCBIT)
+ (ACTION BARROW-FCN)>
+
+\
+
+<OBJECT BOTTLE ;"was BOTTL"
+ (IN KITCHEN-TABLE)
+ (SYNONYM BOTTLE)
+ (ADJECTIVE GLASS)
+ (DESC "glass bottle")
+ (FLAGS TAKEBIT TRANSBIT CONTBIT)
+ (ACTION BOTTLE-FUNCTION)
+ (FDESC "A bottle is sitting on the table.")
+ (CAPACITY 4)>
+
+<OBJECT COFFIN ;"was COFFI"
+ (IN EGYPT-ROOM)
+ (SYNONYM COFFIN TREASURE)
+ (ADJECTIVE SOLID GOLD)
+ (DESC "gold coffin")
+ (FLAGS TAKEBIT CONTBIT SACREDBIT)
+ (LDESC
+"The solid-gold coffin used for the burial of Ramses II is here.")
+ (CAPACITY 35)
+ (SIZE 55)
+ (VALUE 10)
+ (TVALUE 15)>
+
+<OBJECT GRATE ;"was GRATE"
+ (IN LOCAL-GLOBALS)
+ (SYNONYM GRATE GRATING LOCK)
+ (DESC "grating")
+ (FLAGS DOORBIT NDESCBIT INVISIBLE)
+ (ACTION GRATE-FUNCTION)>
+
+<OBJECT PUMP ;"was PUMP"
+ (IN RESERVOIR-NORTH)
+ (SYNONYM PUMP AIR-PUMP)
+ (ADJECTIVE HAND-HELD HAND HELD)
+ (DESC "hand-held air pump")
+ (FLAGS TAKEBIT TOOLBIT)>
+
+<OBJECT DIAMOND ;"was DIAMO"
+ (SYNONYM DIAMOND TREASURE)
+ (ADJECTIVE HUGE)
+ (DESC "huge diamond")
+ (FLAGS TAKEBIT)
+ (LDESC "There is a huge diamond (perfectly cut) here.")
+ (VALUE 10)
+ (TVALUE 10)>
+
+<OBJECT JADE ;"was JADE"
+ (IN BAT-ROOM)
+ (SYNONYM FIGURINE TREASURE)
+ (ADJECTIVE JADE)
+ (DESC "jade figurine")
+ (FLAGS TAKEBIT)
+ (LDESC "There is an exquisite jade figurine here.")
+ (SIZE 10)
+ (VALUE 5)
+ (TVALUE 5)>
+
+<OBJECT KNIFE ;"was KNIFE"
+ (IN ATTIC)
+ (SYNONYM KNIFE)
+ (ADJECTIVE NASTY NASTY-LOOKING)
+ (DESC "nasty knife")
+ (FLAGS TAKEBIT WEAPONBIT)
+ (FDESC "On the ground is a nasty-looking knife.")>
+
+<OBJECT BONES ;"was BONES"
+ (IN MAZE-5)
+ (SYNONYM BONES SKELETON BODY)
+ (DESC "skeleton")
+ (FLAGS TRYTAKEBIT NDESCBIT)>
+
+<OBJECT BURNED-OUT-LANTERN ;"was BLANT"
+ (IN MAZE-5)
+ (SYNONYM LANTERN LAMP)
+ (ADJECTIVE BURNED)
+ (DESC "burned-out lantern")
+ (FLAGS TAKEBIT)
+ (FDESC "The deceased adventurer's burned-out lantern is here.")
+ (SIZE 20)>
+
+<OBJECT BAG-OF-COINS ;"was BAGCO"
+ (IN MAZE-5)
+ (SYNONYM BAG COINS TREASURE)
+ (DESC "bag of coins")
+ (FLAGS TAKEBIT)
+ (LDESC "A bag, bulging with coins, is here.")
+ (SIZE 15)
+ (VALUE 10)
+ (TVALUE 5)>
+
+<OBJECT LAMP ;"was LAMP"
+ (IN LIVING-ROOM)
+ (SYNONYM LAMP LANTERN LIGHT)
+ (ADJECTIVE BRASS)
+ (DESC "lamp")
+ (FLAGS TAKEBIT LIGHTBIT)
+ (ACTION LANTERN)
+ (FDESC "A battery-powered brass lantern is on the trophy case.")
+ (SIZE 15)>
+
+<OBJECT MACHINE ;"was MACHI"
+ (IN MACHINE-ROOM)
+ (SYNONYM MACHINE LID)
+ (DESC "machine")
+ (FLAGS CONTBIT NDESCBIT)
+ (ACTION MACHINE-FUNCTION)
+ (CAPACITY 50)>
+
+<OBJECT INFLATED-BOAT ;"was RBOAT"
+ (SYNONYM BOAT)
+ (ADJECTIVE INFLAT MAGIC PLASTIC)
+ (DESC "inflated boat")
+ (FLAGS TAKEBIT BURNBIT VEHBIT OPENBIT)
+ (ACTION RBOAT-FUNCTION)
+ (CAPACITY 100)
+ (SIZE 20)
+ (VTYPE RWATERBIT)>
+
+<OBJECT MAILBOX ;"was MAILB"
+ (IN WEST-OF-HOUSE)
+ (SYNONYM MAILBOX BOX)
+ (DESC "mailbox")
+ (FLAGS CONTBIT)
+ (CAPACITY 10)>
+
+<OBJECT PAINTING ;"was PAINT"
+ (IN STUDIO)
+ (SYNONYM PAINTING TREASURE)
+ (DESC "painting")
+ (FLAGS TAKEBIT BURNBIT)
+ (ACTION PAINTING-FCN)
+ (FDESC
+"Hanging on the far wall is a painting of unparalleled beauty.")
+ (SIZE 15)
+ (VALUE 4)
+ (TVALUE 6)>
+
+<OBJECT LEAVES ;"was LEAVE"
+ (IN GRATING-CLEARING)
+ (SYNONYM LEAVES PILE)
+ (DESC "pile of leaves")
+ (FLAGS TAKEBIT BURNBIT TRYTAKEBIT)
+ (ACTION LEAF-PILE)
+ (LDESC "On the ground is a pile of leaves.")
+ (SIZE 25)>
+
+<OBJECT INFLATABLE-BOAT ;"was IBOAT"
+ (IN DAM-BASE)
+ (SYNONYM BOAT PILE PLASTIC VALVE)
+ (ADJECTIVE PLASTIC INFLAT)
+ (DESC "pile of plastic")
+ (FLAGS TAKEBIT BURNBIT)
+ (ACTION IBOAT-FUNCTION)
+ (LDESC
+"There is a folded pile of plastic here which has a small valve attached.")
+ (SIZE 20)>
+
+<OBJECT POT-OF-GOLD ;"was POT"
+ (IN END-OF-RAINBOW)
+ (SYNONYM POT TREASURE)
+ (ADJECTIVE GOLD)
+ (DESC "pot of gold")
+ (FLAGS TAKEBIT INVISIBLE)
+ (FDESC "At the end of the rainbow is a pot of gold.")
+ (SIZE 15)
+ (VALUE 10)
+ (TVALUE 10)>
+
+<OBJECT WATER ;"was WATER"
+ (IN BOTTLE)
+ (SYNONYM WATER QUANTITY)
+ (DESC "quantity of water")
+ (FLAGS TAKEBIT DRINKBIT)
+ (ACTION WATER-FUNCTION)
+ (LDESC "There is some water here.")
+ (SIZE 4)>
+
+<OBJECT RAILING ;"was RAILI"
+ (IN DOME-ROOM)
+ (SYNONYM RAILING RAIL)
+ (ADJECTIVE WOODEN)
+ (DESC "wooden railing")
+ (FLAGS NDESCBIT)>
+
+<OBJECT DOME
+ (IN LOCAL-GLOBALS)
+ (SYNONYM DOME)
+ (DESC "dome")
+ (FLAGS NDESCBIT)>
+
+<OBJECT RAINBOW ;"was RAINB"
+ (IN LOCAL-GLOBALS)
+ (SYNONYM RAINBOW)
+ (DESC "rainbow")
+ (FLAGS NDESCBIT CLIMBBIT)
+ (ACTION RAINBOW-FCN)>
+
+<OBJECT RIVER
+ (IN LOCAL-GLOBALS)
+ (DESC "river")
+ (SYNONYM RIVER)
+ (ADJECTIVE FRIGID)
+ (ACTION RIVER-FUNCTION)
+ (FLAGS NDESCBIT)>
+
+<OBJECT ROPE ;"was ROPE"
+ (IN ATTIC)
+ (SYNONYM ROPE COIL)
+ (DESC "rope")
+ (FLAGS TAKEBIT SACREDBIT TRYTAKEBIT)
+ (ACTION ROPE-FUNCTION)
+ (FDESC "A coil of rope is lying in the corner.")
+ (SIZE 10)>
+
+<OBJECT SAND ;"was SAND"
+ (IN SANDY-CAVE)
+ (SYNONYM SAND)
+ (DESC "sand")
+ (FLAGS NDESCBIT)
+ (ACTION SAND-FUNCTION)>
+
+<OBJECT SCREWDRIVER ;"was SCREW"
+ (IN MAINTENANCE-ROOM)
+ (SYNONYM SCREWDRIVER DRIVER)
+ (ADJECTIVE SCREW)
+ (DESC "screwdriver")
+ (FLAGS TAKEBIT TOOLBIT)>
+
+<OBJECT SHOVEL ;"was SHOVE"
+ (IN SANDY-BEACH)
+ (SYNONYM SHOVEL)
+ (DESC "shovel")
+ (FLAGS TAKEBIT TOOLBIT)
+ (SIZE 15)>
+
+<OBJECT COAL ;"was COAL"
+ (IN DEAD-END-5)
+ (SYNONYM COAL PILE)
+ (ADJECTIVE SMALL)
+ (DESC "small pile of coal")
+ (FLAGS TAKEBIT BURNBIT)
+ (SIZE 20)>
+
+<OBJECT SCARAB ;"was STATU"
+ (IN SANDY-CAVE)
+ (SYNONYM SCARAB TREASURE)
+ (ADJECTIVE PRECIOUS CARVED)
+ (DESC "scarab")
+ (FLAGS TAKEBIT INVISIBLE)
+ (LDESC "There is a precious carved scarab here.")
+ (SIZE 8)
+ (VALUE 5)
+ (TVALUE 5)>
+
+<OBJECT STILETTO ;"was STILL"
+ (IN THIEF)
+ (SYNONYM STILETTO)
+ (DESC "stiletto")
+ (ACTION STILETTO-FUNCTION)
+ (FLAGS ;WEAPONBIT TAKEBIT NDESCBIT)
+ (SIZE 10)>
+
+<OBJECT MACHINE-SWITCH ;"was MSWIT"
+ (IN MACHINE-ROOM)
+ (SYNONYM SWITCH)
+ (DESC "switch")
+ (FLAGS NDESCBIT TURNBIT)
+ (ACTION MSWITCH-FUNCTION)>
+
+<OBJECT WOODEN-DOOR
+ (IN LIVING-ROOM)
+ (SYNONYM DOOR LETTERING)
+ (ADJECTIVE WOODEN GOTHIC STRANGE)
+ (DESC "wooden door")
+ (FLAGS READBIT DOORBIT NDESCBIT TRANSBIT)
+ (ACTION FRONT-DOOR-FCN)
+ (TEXT
+"The engravings translate to 'This space intentionally left blank.'")>
+
+<OBJECT SWORD ;"was SWORD"
+ (IN LIVING-ROOM)
+ (SYNONYM SWORD)
+ (ADJECTIVE ELVISH)
+ (DESC "sword")
+ (FLAGS TAKEBIT WEAPONBIT TRYTAKEBIT)
+ (ACTION SWORD-FCN)
+ (FDESC
+"Above the trophy case hangs an elvish sword of great antiquity.")
+ (SIZE 30)
+ (TVALUE 0)>
+
+<OBJECT MAP
+ (IN TROPHY-CASE)
+ (SYNONYM PARCHMENT MAP)
+ (ADJECTIVE ANCIENT)
+ (DESC "ancient map")
+ (FLAGS INVISIBLE READBIT TAKEBIT)
+ (FDESC
+"In the trophy case is an ancient parchment which appears to be a map.")
+ (SIZE 2)
+ (TEXT
+"It shows a white house in the middle of a clearing within a vast forest,
+which lies on the edge of a mighty canyon. The map indicates three paths
+leaving the clearing--to the north, east, and southwest.")>
+
+<OBJECT BOAT-LABEL ;"was LABEL"
+ (IN INFLATED-BOAT)
+ (SYNONYM LABEL)
+ (ADJECTIVE TAN)
+ (DESC "tan label")
+ (FLAGS READBIT TAKEBIT BURNBIT)
+ (SIZE 2)
+ (TEXT
+" FROBOZZ MAGIC BOAT COMPANY|
+|
+ To enter a body of water, say 'Launch'.|
+ To get to shore, say 'Land'.|
+")>
+
+<OBJECT THIEF ;"was THIEF"
+ (IN ROUND-ROOM)
+ (SYNONYM THIEF ROBBER INDIVIDUAL)
+ (ADJECTIVE SHADY SUSPICIOUS SEEDY)
+ (DESC "thief")
+ (FLAGS VICBIT VILLAIN INVISIBLE OPENBIT)
+ (ACTION ROBBER-FUNCTION)
+ (LDESC
+"There is a suspicious-looking individual, holding a bag, leaning
+against one wall. He is armed with a deadly stiletto.")
+ (STRENGTH 5)>
+
+<OBJECT TORCH ;"was TORCH"
+ (IN ALTAR)
+ (SYNONYM TORCH TREASURE)
+ (ADJECTIVE FLAMING IVORY)
+ (DESC "torch")
+ (FLAGS TAKEBIT LIGHTBIT FLAMEBIT ONBIT SACREDBIT)
+ (ACTION TORCH-OBJECT)
+ (FDESC "Sitting on the altar is a flaming torch, made of ivory.")
+ (SIZE 20)
+ (VALUE 14)
+ (TVALUE 6)>
+
+<OBJECT TROLL ;"was TROLL"
+ (IN TROLL-ROOM)
+ (SYNONYM TROLL)
+ (DESC "troll")
+ (FLAGS VICBIT VILLAIN OPENBIT)
+ (ACTION TROLL-FCN)
+ (LDESC
+"A troll, brandishing a bloody axe, blocks all the exits.")
+ (STRENGTH 2)>
+
+<OBJECT TRUNK ;"was TRUNK"
+ (IN RESERVOIR)
+ (SYNONYM TRUNK TREASURE)
+ (DESC "trunk of jewels")
+ (FLAGS TAKEBIT INVISIBLE)
+ (FDESC
+"Lying half buried in the mud is an old trunk, bulging with jewels.")
+ (SIZE 35)
+ (VALUE 15)
+ (TVALUE 5)>
+
+<OBJECT TOP-OF-TREE ;"was TTREE"
+ (IN UP-A-TREE)
+ (SYNONYM TREE)
+ (ADJECTIVE LARGE)
+ (DESC "large tree")
+ (FLAGS NDESCBIT CLIMBBIT)>
+
+<OBJECT CLIMBABLE-CLIFF ;"was CCLIF"
+ (IN LOCAL-GLOBALS)
+ (SYNONYM CLIFF)
+ (ADJECTIVE ROCKY SHEER)
+ (DESC "cliff")
+ (ACTION CLIFF-OBJECT)
+ (FLAGS NDESCBIT CLIMBBIT)>
+
+<OBJECT WHITE-CLIFF ;"was WCLIF"
+ (IN LOCAL-GLOBALS)
+ (SYNONYM CLIFF CLIFFS)
+ (ADJECTIVE WHITE)
+ (DESC "white cliffs")
+ (FLAGS NDESCBIT CLIMBBIT)
+ (ACTION WCLIF-OBJECT)>
+
+<OBJECT WRENCH ;"was WRENC"
+ (IN MAINTENANCE-ROOM)
+ (SYNONYM WRENCH)
+ (DESC "wrench")
+ (FLAGS TAKEBIT TOOLBIT)
+ (SIZE 10)>
+
+<OBJECT CONTROL-PANEL ;"was CPANL"
+ (IN DAM-ROOM)
+ (SYNONYM PANEL)
+ (ADJECTIVE CONTROL)
+ (DESC "control panel")
+ (FLAGS NDESCBIT)>
+
+\
+
+"SUBTITLE FOREST OBJECTS"
+
+<OBJECT NEST ;"was NEST"
+ (IN UP-A-TREE)
+ (SYNONYM NEST)
+ (DESC "bird's nest")
+ (FLAGS BURNBIT OPENBIT NDESCBIT)
+ (CAPACITY 20)>
+
+<OBJECT CANARY ;"was GCANA"
+ (IN EGG)
+ (SYNONYM CANARY)
+ (ADJECTIVE GOLD GOLDEN)
+ (DESC "golden canary")
+ (FLAGS TAKEBIT)
+ (ACTION CANARY-OBJECT)
+ (VALUE 6)
+ (TVALUE 4)
+ (FDESC
+"There is a golden canary nestled in the egg. Through a crystal window
+you can see intricate machinery inside. It appears to have wound down.")>
+
+<OBJECT BAUBLE ;"was BAUBL"
+ (SYNONYM BAUBLE)
+ (ADJECTIVE BRASS BEAUTIFUL)
+ (DESC "brass bauble")
+ (FLAGS TAKEBIT)
+ (VALUE 1)
+ (TVALUE 1)>
+
+<OBJECT BROKEN-EGG ;"was BEGG"
+ (SYNONYM EGG)
+ (ADJECTIVE BROKEN)
+ (DESC "broken egg")
+ (FLAGS TAKEBIT CONTBIT OPENBIT)
+ (CAPACITY 6)
+ (TVALUE 2)>
+
+<OBJECT GUNK ;"was GUNK"
+ (SYNONYM GUNK PIECE SLAG)
+ (ADJECTIVE VITREOUS)
+ (DESC "piece of vitreous slag")
+ (FLAGS TAKEBIT TRYTAKEBIT)
+ (ACTION GUNK-FUNCTION)
+ (SIZE 10)>
+
+<OBJECT EGG ;"was EGG"
+ (IN NEST)
+ (SYNONYM EGG TREASURE)
+ (ADJECTIVE ENCRUSTED JEWELED)
+ (DESC "jewel-encrusted egg")
+ (FLAGS TAKEBIT CONTBIT)
+ (ACTION EGG-OBJECT)
+ (VALUE 5)
+ (TVALUE 5)
+ (CAPACITY 6)
+ (FDESC
+"In the nest is a large egg encrusted with precious jewels and inlaid with
+gold, apparently scavenged somewhere by a childless songbird.")>
+
+\
+
+"SUBTITLE ROOMS"
+
+"SUBTITLE CONDITIONAL EXIT FLAGS"
+
+<GLOBAL CYCLOPS-FLAG <>>
+<GLOBAL DEFLATE <>>
+<GLOBAL DOME-FLAG <>>
+<GLOBAL EMPTY-HANDED <>>
+<GLOBAL LLD-FLAG <>>
+<GLOBAL LOW-TIDE <>>
+<GLOBAL MAGIC-FLAG <>>
+<GLOBAL RAINBOW-FLAG <>>
+<GLOBAL TROLL-FLAG <>>
+<GLOBAL WON-FLAG <>>
+<GLOBAL COFFIN-CURE <>>
+
+"SUBTITLE FOREST AND OUTSIDE OF HOUSE"
+
+<ROOM WEST-OF-HOUSE ;"was WHOUS"
+ (IN ROOMS)
+ (DESC "West of House")
+ (NORTH TO NORTH-OF-HOUSE)
+ (SOUTH TO SOUTH-OF-HOUSE)
+ (EAST "The door is boarded and you can't remove the boards.")
+ (SW TO STONE-BARROW IF WON-FLAG)
+ (ACTION WEST-HOUSE)
+ (FLAGS RLANDBIT ONBIT SACREDBIT)
+ (GLOBAL WHITE-HOUSE BOARDS)>
+
+<ROOM STONE-BARROW ;"was WHOUS"
+ (IN ROOMS)
+ (LDESC
+"You are east of a massive stone tomb. Through an open door you see
+darkness within.")
+ (DESC "Stone Barrow")
+ (NE TO WEST-OF-HOUSE)
+ (ACTION STONE-BARROW-FCN)
+ (FLAGS RLANDBIT ONBIT SACREDBIT)>
+
+<ROOM NORTH-OF-HOUSE ;"was NHOUS"
+ (IN ROOMS)
+ (LDESC
+"You are north of the white house. There is no door here, and all the
+windows are boarded up. To the north a narrow path enters the woods.")
+ (DESC "North of House")
+ (WEST TO WEST-OF-HOUSE)
+ (EAST TO EAST-OF-HOUSE)
+ (NORTH TO PATH)
+ (SOUTH "The windows are all boarded.")
+ (FLAGS RLANDBIT ONBIT SACREDBIT)
+ (GLOBAL BOARDED-WINDOW BOARDS WHITE-HOUSE)>
+
+<ROOM SOUTH-OF-HOUSE ;"was SHOUS"
+ (IN ROOMS)
+ (LDESC
+"You are south of the white house. There is no door here, and all the
+windows are boarded.")
+ (DESC "South of House")
+ (WEST TO WEST-OF-HOUSE)
+ (EAST TO EAST-OF-HOUSE)
+ (NORTH "The windows are all boarded.")
+ (FLAGS RLANDBIT ONBIT SACREDBIT)
+ (GLOBAL BOARDED-WINDOW BOARDS WHITE-HOUSE)>
+
+<ROOM EAST-OF-HOUSE ;"was EHOUS"
+ (IN ROOMS)
+ (DESC "Behind House")
+ (NORTH TO NORTH-OF-HOUSE)
+ (SOUTH TO SOUTH-OF-HOUSE)
+ (EAST TO CANYON-VIEW)
+ (WEST TO KITCHEN IF KITCHEN-WINDOW IS OPEN)
+ (IN TO KITCHEN IF KITCHEN-WINDOW IS OPEN)
+ (ACTION EAST-HOUSE)
+ (FLAGS RLANDBIT ONBIT SACREDBIT)
+ (GLOBAL WHITE-HOUSE KITCHEN-WINDOW)>
+
+<ROOM FOREST-EDGE
+ (IN ROOMS)
+ (LDESC "You are on a path in a dimly-lit forest. The path heads west
+into the heart of the forest, and to the southeast where the trees seem to
+thin out.")
+ (DESC "Forest Edge")
+ (UP "There is no tree here suitable for climbing.")
+ (SE TO CANYON-VIEW)
+ (WEST TO PATH)
+ (ACTION FOREST-ROOM)
+ (FLAGS RLANDBIT ONBIT SACREDBIT)
+ (GLOBAL TREE SONGBIRD WHITE-HOUSE FOREST)>
+
+<ROOM PATH ;"was FORE3"
+ (IN ROOMS)
+ (LDESC
+"This is a path winding through a dimly-lit forest. The path turns a corner
+here, heading south and east. One large tree with some low branches stands
+at the edge of the path.")
+ (DESC "Forest Path")
+ (UP TO UP-A-TREE)
+ (EAST TO FOREST-EDGE)
+ (SOUTH TO NORTH-OF-HOUSE)
+ (DOWN TO GRATING-ROOM
+ IF GRATE IS OPEN ELSE "You can't go through the closed grating.")
+ (ACTION FOREST-ROOM)
+ (FLAGS RLANDBIT ONBIT SACREDBIT)
+ (GLOBAL TREE SONGBIRD WHITE-HOUSE FOREST)>
+
+<ROOM UP-A-TREE ;"was TREE"
+ (IN ROOMS)
+ (DESC "Up a Tree")
+ (DOWN TO PATH)
+ (UP "You cannot climb any higher.")
+ (ACTION TREE-ROOM)
+ (FLAGS RLANDBIT ONBIT SACREDBIT)
+ (GLOBAL FOREST SONGBIRD WHITE-HOUSE)>
+
+\
+
+"SUBTITLE HOUSE"
+
+<ROOM KITCHEN ;"was KITCH"
+ (IN ROOMS)
+ (DESC "Kitchen")
+ (EAST TO EAST-OF-HOUSE IF KITCHEN-WINDOW IS OPEN)
+ (WEST TO LIVING-ROOM)
+ (OUT TO EAST-OF-HOUSE IF KITCHEN-WINDOW IS OPEN)
+ (UP TO ATTIC)
+ (DOWN "Only Santa Claus climbs down chimneys.")
+ (ACTION KITCHEN-FCN)
+ (FLAGS RLANDBIT ONBIT RHOUSEBIT SACREDBIT)
+ (VALUE 10)
+ (GLOBAL KITCHEN-WINDOW CHIMNEY STAIRS)>
+
+<ROOM ATTIC ;"was ATTIC"
+ (IN ROOMS)
+ (LDESC "This is the attic. The only exit is a stairway leading down.")
+ (DESC "Attic")
+ (DOWN TO KITCHEN)
+ (FLAGS RLANDBIT RHOUSEBIT SACREDBIT)
+ (GLOBAL STAIRS)>
+
+<ROOM LIVING-ROOM ;"was LROOM"
+ (IN ROOMS)
+ (DESC "Living Room")
+ (EAST TO KITCHEN)
+ (WEST TO CYCLOPS-ROOM IF MAGIC-FLAG ELSE "The door is nailed shut.")
+ (DOWN PER TRAP-DOOR-EXIT) ;"to CELLAR"
+ (ACTION LIVING-ROOM-FCN)
+ (FLAGS RLANDBIT ONBIT RHOUSEBIT SACREDBIT)
+ (GLOBAL STAIRS)>
+
+\
+
+"SUBTITLE CELLAR AND VICINITY"
+
+<ROOM CELLAR ;"was CELLA"
+ (IN ROOMS)
+ (DESC "Cellar")
+ (NORTH TO TROLL-ROOM)
+ (EAST TO STUDIO)
+ (UP TO LIVING-ROOM IF TRAP-DOOR IS OPEN)
+ (WEST
+"You try to ascend the ramp, but it is impossible, and you slide back down.")
+ (ACTION CELLAR-FCN)
+ (FLAGS RLANDBIT)
+ (VALUE 25)
+ (GLOBAL TRAP-DOOR SLIDE STAIRS)>
+
+<ROOM TROLL-ROOM ;"was MTROL"
+ (IN ROOMS)
+ (LDESC
+"This is a small room with passages to the east and south and a
+forbidding hole leading west. Bloodstains and deep scratches mar the walls.")
+ (DESC "The Troll Room")
+ (SOUTH TO CELLAR)
+ (NE TO RESERVOIR-SOUTH
+ IF TROLL-FLAG ELSE "The troll fends you off with a menacing gesture.")
+ (EAST TO ROUND-ROOM
+ IF TROLL-FLAG ELSE "The troll fends you off with a menacing gesture.")
+ (WEST TO MAZE-1
+ IF TROLL-FLAG ELSE "The troll fends you off with a menacing gesture.")
+ (FLAGS RLANDBIT)>
+
+<ROOM STUDIO ;"was STUDI"
+ (IN ROOMS)
+ (LDESC
+"This appears to have been an artist's studio. The walls and floors are
+splattered with paint. At the west end of the room is an open door. A
+narrow chimney leads up from a fireplace; although you might be able to
+get up it, it seems unlikely you could get back down.")
+ (DESC "Studio")
+ (WEST TO CELLAR)
+ (UP PER CHIMNEY-FUNCTION) ;"to KITCHEN"
+ (FLAGS RLANDBIT)
+ (GLOBAL CHIMNEY)
+ (PSEUDO "DOOR" DOOR-PSEUDO "PAINT" PAINT-PSEUDO)>
+
+\
+
+"SUBTITLE MAZE"
+
+<ROOM MAZE-1 ;"was MAZE1"
+ (IN ROOMS)
+ (LDESC "This is part of a maze of twisty little passages, all alike.")
+ (DESC "Maze")
+ (EAST TO TROLL-ROOM)
+ (NE TO MAZE-1)
+ (NW TO MAZE-2)
+ (WEST TO MAZE-3)
+ (FLAGS RLANDBIT MAZEBIT)>
+
+<ROOM MAZE-2 ;"was MAZE2"
+ (IN ROOMS)
+ (LDESC "This is part of a maze of twisty little passages, all alike.")
+ (DESC "Maze")
+ (NORTH TO MAZE-1)
+ (WEST TO MAZE-2)
+ (SE TO MAZE-3)
+ (DOWN TO MAZE-5)
+ (FLAGS RLANDBIT MAZEBIT)>
+
+<ROOM MAZE-3 ;"was MAZE3"
+ (IN ROOMS)
+ (LDESC "This is part of a maze of twisty little passages, all alike.")
+ (DESC "Maze")
+ (WEST TO MAZE-2)
+ (NORTH TO MAZE-1)
+ (EAST TO DEAD-END-1)
+ (UP TO MAZE-5)
+ (FLAGS RLANDBIT MAZEBIT)>
+
+<ROOM MAZE-4
+ (IN ROOMS)
+ (LDESC "This is part of a maze of twisty little passages, all alike.")
+ (DESC "Maze")
+ (DOWN TO MAZE-5)
+ (UP TO MAZE-6)
+ (SOUTH TO MAZE-10)
+ (WEST TO MAZE-8)
+ (SE TO MAZE-7)
+ (NW TO GRATING-ROOM)
+ (FLAGS RLANDBIT MAZEBIT)>
+
+<ROOM DEAD-END-1 ;"was DEAD1"
+ (IN ROOMS)
+ (DESC "Dead End")
+ (LDESC "You have come to a dead end in the maze.")
+ (DOWN TO MAZE-3)
+ (FLAGS RLANDBIT MAZEBIT)>
+
+<ROOM MAZE-5 ;"was MAZE5"
+ (IN ROOMS)
+ (LDESC "This is part of a maze of twisty little passages, all alike.
+A skeleton, probably the remains of a luckless adventurer, lies here.")
+ (DESC "Maze")
+ (NW TO MAZE-2)
+ (NORTH TO MAZE-3)
+ (SW TO MAZE-4)
+ (FLAGS RLANDBIT MAZEBIT)>
+
+<ROOM DEAD-END-2 ;"was DEAD2"
+ (IN ROOMS)
+ (DESC "Dead End")
+ (LDESC "You have come to a dead end in the maze.")
+ (SOUTH TO MAZE-6)
+ (FLAGS RLANDBIT MAZEBIT)>
+
+<ROOM MAZE-6 ;"was MAZE6"
+ (IN ROOMS)
+ (LDESC "This is part of a maze of twisty little passages, all alike.")
+ (DESC "Maze")
+ (UP TO MAZE-6)
+ (SE TO MAZE-4)
+ (WEST TO DEAD-END-2)
+ (DOWN TO MAZE-2)
+ (FLAGS RLANDBIT MAZEBIT)>
+
+<ROOM MAZE-7 ;"was MAZE7"
+ (IN ROOMS)
+ (LDESC "This is part of a maze of twisty little passages, all alike.")
+ (UP TO MAZE-10)
+ (WEST TO MAZE-4)
+ (DOWN TO MAZE-5)
+ (FLAGS RLANDBIT MAZEBIT)>
+
+<ROOM MAZE-8 ;"was MAZE8"
+ (IN ROOMS)
+ (LDESC "This is part of a maze of twisty little passages, all alike.")
+ (DESC "Maze")
+ (SE TO MAZE-10)
+ (EAST TO MAZE-9)
+ (UP TO MAZE-4)
+ (NORTH TO MAZE-8)
+ (FLAGS RLANDBIT MAZEBIT)>
+
+<ROOM MAZE-9 ;"was MAZE9"
+ (IN ROOMS)
+ (LDESC "This is part of a maze of twisty little passages, all alike.")
+ (DESC "Maze")
+ (NORTH TO MAZE-8)
+ (SE TO CYCLOPS-ROOM)
+ (SOUTH TO MAZE-10)
+ (FLAGS RLANDBIT MAZEBIT)>
+
+<ROOM MAZE-10 ;"was MAZ10"
+ (IN ROOMS)
+ (LDESC "This is part of a maze of twisty little passages, all alike.")
+ (DESC "Maze")
+ (NE TO MAZE-8)
+ (NW TO MAZE-7)
+ (SW TO MAZE-4)
+ (SOUTH TO MAZE-9)
+ (FLAGS RLANDBIT MAZEBIT)>
+
+<ROOM GRATING-ROOM ;"was MGRAT"
+ (IN ROOMS)
+ (DESC "Grating Room")
+ (SOUTH TO MAZE-4)
+ (UP TO PATH
+ IF GRATE IS OPEN ELSE "The grating is closed.")
+ (ACTION MAZE-11-FCN)
+ (GLOBAL GRATE)
+ (FLAGS RLANDBIT)>
+
+\
+
+"SUBTITLE CYCLOPS AND HIDEAWAY"
+
+<ROOM CYCLOPS-ROOM ;"was CYCLO"
+ (IN ROOMS)
+ (DESC "Cyclops Room")
+ (NORTH TO MAZE-9)
+ (EAST TO LIVING-ROOM
+ IF MAGIC-FLAG ELSE "The east wall is solid rock.")
+ (UP TO TREASURE-ROOM
+ IF CYCLOPS-FLAG
+ ELSE "The cyclops doesn't look like he'll let you past.")
+ (ACTION CYCLOPS-ROOM-FCN)
+ (FLAGS RLANDBIT)
+ (GLOBAL STAIRS)>
+
+<ROOM TREASURE-ROOM ;"was TREAS"
+ (IN ROOMS)
+ (LDESC
+"This room is full of discarded bags, which crumble at your touch. There
+is an exit down a staircase.")
+ (DESC "Thief's Den")
+ (DOWN TO CYCLOPS-ROOM)
+ (ACTION TREASURE-ROOM-FCN)
+ (FLAGS RLANDBIT)
+ (VALUE 25)
+ (GLOBAL STAIRS)>
+
+\
+
+"SUBTITLE RESERVOIR AREA"
+
+<ROOM RESERVOIR-SOUTH ;"was RESES"
+ (IN ROOMS)
+ (DESC "Reservoir South")
+ (SOUTH TO ROUND-ROOM)
+ (SW TO TROLL-ROOM)
+ (EAST TO DAM-ROOM)
+ (NORTH TO RESERVOIR
+ IF LOW-TIDE ELSE "You are not equipped for swimming.")
+ (ACTION RESERVOIR-SOUTH-FCN)
+ (FLAGS RLANDBIT)
+ (GLOBAL GLOBAL-WATER)
+ (PSEUDO "LAKE" LAKE-PSEUDO)>
+
+<ROOM RESERVOIR ;"was RESER"
+ (IN ROOMS)
+ (DESC "Reservoir")
+ (LDESC
+"You are on what used to be a large lake, but which is now a large
+mud pile. There are 'shores' to the north and south.")
+ (NORTH TO RESERVOIR-NORTH)
+ (SOUTH TO RESERVOIR-SOUTH)
+ (FLAGS RWATERBIT )
+ (GLOBAL GLOBAL-WATER)>
+
+<ROOM RESERVOIR-NORTH ;"was RESEN"
+ (IN ROOMS)
+ (DESC "Reservoir North")
+ (SOUTH TO RESERVOIR)
+ (UP TO DUSTY-CAVE)
+ (ACTION RESERVOIR-NORTH-FCN)
+ (FLAGS RLANDBIT)
+ (GLOBAL GLOBAL-WATER STAIRS)
+ (PSEUDO "LAKE" LAKE-PSEUDO)>
+
+<ROOM WINDY-CAVE ;"was CAVE2"
+ (IN ROOMS)
+ (LDESC
+"This is a tiny cave with an entrance on the north, and a
+forbidding staircase leading down.")
+ (DESC "Windy Cave")
+ (NORTH TO ROUND-ROOM)
+ (DOWN TO ENTRANCE-TO-HADES)
+ (FLAGS RLANDBIT)
+ (GLOBAL STAIRS)>
+
+<ROOM DUSTY-CAVE ;"was PASS4"
+ (IN ROOMS)
+ (LDESC
+"This is a small cave with exits on the east and west.")
+ (DESC "Dusty Cave")
+ (WEST TO SLIDE-ROOM)
+ (EAST TO RESERVOIR-NORTH)
+ (FLAGS RLANDBIT)>
+
+\
+
+"SUBTITLE ROUND ROOM AND VICINITY"
+
+<ROOM ROUND-ROOM ;"was CAROU"
+ (IN ROOMS)
+ (LDESC
+"This is a circular stone room with passages in all directions, although
+several have been blocked by cave-ins.")
+ (DESC "Round Room")
+ (EAST TO WHITE-CLIFFS)
+ (WEST TO TROLL-ROOM)
+ (NORTH TO RESERVOIR-SOUTH)
+ (SOUTH TO WINDY-CAVE)
+ (SE TO DOME-ROOM)
+ (FLAGS RLANDBIT)>
+
+<ROOM ENTRANCE-TO-HADES
+ (IN ROOMS)
+ (DESC "Entrance to Hades")
+ (UP TO WINDY-CAVE)
+ (IN TO LAND-OF-LIVING-DEAD
+ IF LLD-FLAG
+ ELSE "Some invisible force prevents you from passing through the gate.")
+ (SOUTH TO LAND-OF-LIVING-DEAD
+ IF LLD-FLAG
+ ELSE "Some invisible force prevents you from passing through the gate.")
+ (ACTION LLD-ROOM)
+ (FLAGS RLANDBIT ONBIT)
+ (PSEUDO "GATE" GATE-PSEUDO)>
+
+<ROOM LAND-OF-LIVING-DEAD ;"was LLD2"
+ (IN ROOMS)
+ (LDESC
+"You have entered the Land of the Living Dead. You can hear the sounds of
+thousands of lost souls weeping and moaning. A passage exits to the north.")
+ (DESC "Land of the Dead")
+ (OUT TO ENTRANCE-TO-HADES)
+ (NORTH TO ENTRANCE-TO-HADES)
+ (FLAGS RLANDBIT ONBIT)>
+
+\
+
+"SUBTITLE DOME, TEMPLE, EGYPT"
+
+<ROOM EGYPT-ROOM ;"was EGYPT"
+ (IN ROOMS)
+ (LDESC
+"This is a former Egyptian tomb. There is an ascending staircase to the west.")
+ (DESC "Egyptian Room")
+ (WEST TO NORTH-TEMPLE)
+ (UP TO NORTH-TEMPLE)
+ (FLAGS RLANDBIT)
+ (GLOBAL STAIRS)>
+
+<ROOM DOME-ROOM ;"was DOME"
+ (IN ROOMS)
+ (DESC "Dome Room")
+ (NW TO DOME-ROOM)
+ (DOWN TO TORCH-ROOM
+ IF DOME-FLAG ELSE "You cannot go down without fracturing many bones.")
+ (ACTION DOME-ROOM-FCN)
+ (FLAGS RLANDBIT)
+ (GLOBAL DOME)>
+
+<ROOM NORTH-TEMPLE ;"was TEMP1"
+ (IN ROOMS)
+ (LDESC
+"This is the north end of a large temple. Engraved on the east wall is
+a prayer in a long-forgotten language. Below the prayer is a staircase
+leading down.")
+ (DESC "Temple")
+ (DOWN TO EGYPT-ROOM)
+ (EAST TO EGYPT-ROOM)
+ (SOUTH TO SOUTH-TEMPLE)
+ (UP "You cannot reach the rope.")
+ (ACTION TORCH-ROOM-FCN)
+ (GLOBAL DOME STAIRS)
+ (FLAGS RLANDBIT ONBIT SACREDBIT)>
+
+<ROOM SOUTH-TEMPLE ;"was TEMP2"
+ (IN ROOMS)
+ (LDESC
+"You are next to the altar at the south end of the temple. In one corner
+is a small hole in the floor.")
+ (DESC "Altar")
+ (NORTH TO NORTH-TEMPLE)
+ (DOWN TO ENTRANCE-TO-HADES
+ IF COFFIN-CURE
+ ELSE "You haven't a prayer of getting the coffin down that hole.")
+ (FLAGS RLANDBIT ONBIT SACREDBIT)
+ (ACTION SOUTH-TEMPLE-FCN)>
+******ADD TORCH******
+
+\
+
+"SUBTITLE FLOOD CONTROL DAM #3"
+
+<ROOM DAM-ROOM ;"was DAM"
+ (IN ROOMS)
+ (DESC "Dam")
+ (DOWN TO DAM-BASE)
+ (NORTH TO MAINTENANCE-ROOM)
+ (WEST TO RESERVOIR-SOUTH)
+ (ACTION DAM-ROOM-FCN)
+ (FLAGS RLANDBIT ONBIT)
+ (GLOBAL GLOBAL-WATER)>
+
+<ROOM MAINTENANCE-ROOM ;"was MAINT"
+ (IN ROOMS)
+ (LDESC
+"This was maintenance room for Flood Control Dam #3. On the wall is an
+important-looking button. The west wall contains a door.")
+ (DESC "Maintenance Room")
+ (WEST TO DAM-ROOM)
+ (FLAGS RLANDBIT)>
+
+\
+
+"SUBTITLE RIVER AREA"
+
+<ROOM DAM-BASE ;"was DOCK"
+ (IN ROOMS)
+ (LDESC
+"You are at the base of the dam, on a bank of the river Frigid.")
+ (DESC "Dam Base")
+ (UP TO DAM-ROOM)
+ (FLAGS RLANDBIT ONBIT SACREDBIT)
+ (GLOBAL GLOBAL-WATER RIVER)>
+
+<ROOM RIVER-1 ;"was RIVR1"
+ (IN ROOMS)
+ (LDESC
+"You are on a quiet section of the Frigid River near the Dam. There is
+a landing on the west shore.")
+ (DESC "Frigid River")
+ (UP "The current prevents upstream travel.")
+ (WEST TO DAM-BASE)
+ (LAND TO DAM-BASE)
+ (DOWN TO RIVER-2)
+ (EAST "The White Cliffs prevent your landing here.")
+ (FLAGS RWATERBIT SACREDBIT)
+ (GLOBAL GLOBAL-WATER RIVER)>
+
+<ROOM RIVER-2 ;"was RIVR3"
+ (IN ROOMS)
+ (LDESC
+"The river descends into a valley with a narrow beach on the west shore.
+In the distance a rumbling can be heard.")
+ (DESC "Frigid River")
+ (UP "You cannot go upstream due to strong currents.")
+ (DOWN TO RIVER-3)
+ (LAND TO WHITE-CLIFFS)
+ (WEST TO WHITE-CLIFFS)
+ (FLAGS RWATERBIT SACREDBIT)
+ (GLOBAL GLOBAL-WATER RIVER)>
+
+<ROOM WHITE-CLIFFS
+ (IN ROOMS)
+ (LDESC
+"You are on a narrow beach at the base of the White Cliffs. A passage
+leads west into the Cliffs.")
+ (DESC "White Cliffs Beach")
+ (WEST TO ROUND-ROOM IF DEFLATE ELSE "The path is too tight.")
+ (ACTION WHITE-CLIFFS-FUNCTION)
+ (FLAGS RLANDBIT SACREDBIT )
+ (GLOBAL GLOBAL-WATER WHITE-CLIFF RIVER)>
+
+<ROOM RIVER-3 ;"was RIVR4"
+ (IN ROOMS)
+ (LDESC
+"The river is running faster here, and the roar of rushing water is almost
+unbearable. You can see beaches on both the east and west shores.")
+ (DESC "Frigid River")
+ (UP "You cannot go upstream due to strong currents.")
+ (LAND TO SANDY-BEACH)
+ (EAST TO SANDY-BEACH)
+ (ACTION RIVR4-ROOM)
+ (FLAGS RWATERBIT SACREDBIT)
+ (GLOBAL GLOBAL-WATER RIVER)>
+
+<ROOM SANDY-BEACH ;"was BEACH"
+ (IN ROOMS)
+ (LDESC
+"You are on a large sandy beach on the east shore of the river. A path runs
+along the river to the south, and a cave that is partially buried in sand
+lies to the northeast.")
+ (DESC "Sandy Beach")
+ (NE TO SANDY-CAVE)
+ (SOUTH TO ARAGAIN-FALLS)
+ (FLAGS RLANDBIT SACREDBIT)
+ (GLOBAL GLOBAL-WATER RIVER)>
+
+<ROOM SANDY-CAVE ;"was TCAVE"
+ (IN ROOMS)
+ (LDESC
+"This is a sand-filled cave whose exit is to the southwest.")
+ (DESC "Sandy Cave")
+ (SW TO SANDY-BEACH)
+ (FLAGS RLANDBIT)>
+
+<ROOM ARAGAIN-FALLS ;"was FALLS"
+ (IN ROOMS)
+ (DESC "Aragain Falls")
+ (WEST TO END-OF-RAINBOW IF RAINBOW-FLAG)
+ (DOWN "It's a long way...")
+ (NORTH TO SANDY-BEACH)
+ (UP TO END-OF-RAINBOW IF RAINBOW-FLAG)
+ (ACTION FALLS-ROOM)
+ (FLAGS RLANDBIT SACREDBIT)
+ (GLOBAL GLOBAL-WATER RIVER RAINBOW)>
+
+<ROOM END-OF-RAINBOW ;"was POG"
+ (IN ROOMS)
+ (LDESC
+"This is a small beach on the Frigid River below the Falls. A rainbow
+crosses over the falls to the east and a path leads to the southwest.")
+ (DESC "End of Rainbow")
+ (UP TO ARAGAIN-FALLS IF RAINBOW-FLAG)
+ (EAST TO ARAGIAN-FALLS IF RAINBOW-FLAG)
+ (SW TO CANYON-BOTTOM)
+ (FLAGS RLANDBIT ONBIT )
+ (GLOBAL GLOBAL-WATER RAINBOW RIVER)>
+
+<ROOM CANYON-BOTTOM ;"was CLBOT"
+ (IN ROOMS)
+ (LDESC
+"You are at the base of a river canyon near the flowing runoff of Aragain
+Falls. The cliff wall may be climbable, and to the northeast is a narrow
+path.")
+ (DESC "Canyon Bottom")
+ (UP TO CANYON-VIEW)
+ (NE TO END-OF-RAINBOW)
+ (FLAGS RLANDBIT ONBIT SACREDBIT)
+ (GLOBAL GLOBAL-WATER CLIMBABLE-CLIFF RIVER)>
+
+<ROOM CANYON-VIEW ;"was CLTOP"
+ (IN ROOMS)
+ (LDESC
+"You are atop the west wall of a great canyon. From here there is a superb
+view of the Frigid River as it flows out of a dark cavern, flanked
+by towering white cliffs. Below rainbow-clad Aragain Falls, the river twists
+into a passage which is impossible to enter. Paths enter the forest to
+the west and north. It is possible to climb down into the canyon from here.")
+ (DESC "Canyon View")
+ (DOWN TO CLIFF-BOTTOM)
+ (WEST TO EAST-OF-HOUSE)
+ (NORTH TO FOREST-EDGE)
+ (FLAGS RLANDBIT ONBIT SACREDBIT)
+ (GLOBAL CLIMBABLE-CLIFF RIVER)>
+
+\
+
+"SUBTITLE COAL MINE AREA"
+
+<ROOM MINE-ENTRANCE ;"was ENTRA"
+ (IN ROOMS)
+ (LDESC
+
+"You are at the entrance of a disused coal mine. Strange squeaky sounds
+come from a shaft leading into the north wall, and there is another exit
+to the south.")
+ (DESC "Mine Entrance")
+ (SOUTH TO SLIDE-ROOM)
+ (IN TO BAT-ROOM)
+ (NORTH TO BAT-ROOM)
+ (FLAGS RLANDBIT)>
+
+<ROOM BAT-ROOM ;"was BATS"
+ (IN ROOMS)
+ (DESC "Bat Room")
+ (SOUTH TO MINE-ENTRANCE)
+ (EAST TO SHAFT-ROOM)
+ (ACTION BATS-ROOM)
+ (FLAGS RLANDBIT SACREDBIT)>
+
+<ROOM SHAFT-ROOM ;"was TSHAF"
+ (IN ROOMS)
+ (LDESC
+"This is a large room with exits to the west and north. In the middle of
+the room is a small shaft descending through the floor into darkness below.
+Constructed over the top of the shaft is a metal framework to which a heavy
+iron chain is attached. A foul odor comes from the room to the north.")
+ (DESC "Shaft Room")
+ (DOWN "You'd never fit.")
+ (WEST TO BAT-ROOM)
+ (NORTH TO SMELLY-ROOM)
+ (FLAGS RLANDBIT)>
+
+<ROOM GAS-ROOM ;"was BOOM"
+ (IN ROOMS)
+ (LDESC
+"This room smells strongly of coal gas. Tunnels lead south and east.")
+ (DESC "Gas Room")
+ (SOUTH TO SHAFT-ROOM)
+ (EAST TO MINE-1)
+ (ACTION BOOM-ROOM)
+ (FLAGS RLANDBIT SACREDBIT)
+ (GLOBAL STAIRS)
+ (PSEUDO "GAS" GAS-PSEUDO "ODOR" GAS-PSEUDO)>
+
+<ROOM DEAD-END-5 ;"was DEAD7"
+ (IN ROOMS)
+ (DESC "Dead End")
+ (LDESC "You have come to a dead end in the mine.")
+ (NORTH TO TIMBER-ROOM)
+ (FLAGS RLANDBIT)>
+
+<ROOM TIMBER-ROOM ;"was TIMBE"
+ (IN ROOMS)
+ (LDESC
+"This is a long east-west passage which is cluttered with broken timbers.
+At the east end of the room, a rickety ladder leads through an opening in
+the roof. A strong draft comes from the west where the room narrows
+considerably.")
+ (DESC "Timber Room")
+ (UP TO MINE-3)
+ (WEST TO LOWER-SHAFT
+ IF EMPTY-HANDED
+ ELSE "You cannot fit through this passage with that load.")
+ (ACTION NO-OBJS)
+ (FLAGS RLANDBIT SACREDBIT)>
+
+<ROOM LOWER-SHAFT ;"was BSHAF"
+ (IN ROOMS)
+ (LDESC
+"This is a drafty room at the bottom of a long shaft. To the south is a
+passageway and to the east a very narrow crack. In the shaft can be seen
+a heavy iron chain.")
+ (DESC "Drafty Room")
+ (SOUTH TO MACHINE-ROOM)
+ (OUT TO TIMBER-ROOM
+ IF EMPTY-HANDED
+ ELSE "You cannot fit through this passage with that load.")
+ (EAST TO TIMBER-ROOM
+ IF EMPTY-HANDED
+ ELSE "You cannot fit through this passage with that load.")
+ (UP "The chain is not climbable.")
+ (ACTION NO-OBJS)
+ (FLAGS RLANDBIT SACREDBIT)>
+
+<ROOM MACHINE-ROOM ;"was MACHI"
+ (IN ROOMS)
+ (DESC "Machine Room")
+ (NORTH TO LOWER-SHAFT)
+ (ACTION MACHINE-ROOM-FCN)
+ (FLAGS RLANDBIT)>
+
+\
+
+"SUBTITLE COAL MINE"
+
+<ROOM MINE-1 ;"was MINE1"
+ (IN ROOMS)
+ (LDESC "This is a non-descript part of a coal mine.")
+ (DESC "Coal Mine")
+ (WEST TO GAS-ROOM)
+ (SOUTH TO MINE-1)
+ (NORTH TO MINE-2)
+ (FLAGS RLANDBIT)>
+
+<ROOM MINE-2 ;"was MINE2"
+ (IN ROOMS)
+ (LDESC "This is a non-descript part of a coal mine.")
+ (DESC "Coal Mine")
+ (NE TO MINE-2)
+ (NW TO MINE-1)
+ (SOUTH TO MINE-3)
+ (FLAGS RLANDBIT)>
+
+<ROOM MINE-3 ;"was MINE3"
+ (IN ROOMS)
+ (LDESC "This is a non-descript part of a coal mine. The top of a
+rickety ladder pokes through a hole in the floor.")
+ (DESC "Coal Mine")
+ (WEST TO MINE-3)
+ (DOWN TO TIMBER-ROOM)
+ (EAST TO MINE-2)
+ (FLAGS RLANDBIT)>
+
+<ROOM SLIDE-ROOM ;"was SLIDE"
+ (IN ROOMS)
+ (LDESC
+"This is a small chamber, which appears to have been part of a coal mine.
+There are openings to the north and east, and a steep metal slide twisting
+downward.")
+ (DESC "Slide Room")
+ (EAST TO DUSTY-CAVE)
+ (NORTH TO MINE-ENTRANCE)
+ (DOWN TO CELLAR)
+ (FLAGS RLANDBIT)
+ (GLOBAL SLIDE)>
+
+\
+
+;"RANDOM TABLES FOR WALK-AROUND"
+
+<GLOBAL HOUSE-AROUND
+ <LTABLE WEST-OF-HOUSE NORTH-OF-HOUSE EAST-OF-HOUSE SOUTH-OF-HOUSE
+ WEST-OF-HOUSE>>
+
+<GLOBAL FOREST-AROUND
+ <LTABLE FOREST-1 FOREST-2 PATH FOREST-1>>
+
+<GLOBAL IN-HOUSE-AROUND
+ <LTABLE LIVING-ROOM KITCHEN ATTIC KITCHEN>>
+
+<GLOBAL ABOVE-GROUND
+ <LTABLE WEST-OF-HOUSE NORTH-OF-HOUSE EAST-OF-HOUSE SOUTH-OF-HOUSE
+ FOREST-1 FOREST-2 PATH GRATING-CLEARING
+ CANYON-VIEW>> \ No newline at end of file
diff --git a/fights.zil b/fights.zil
new file mode 100644
index 0000000..fc246c2
--- /dev/null
+++ b/fights.zil
@@ -0,0 +1,98 @@
+;"SUBTITLE PURE STRUCTURE FROM MELEE"
+
+"messages for winner"
+
+<CONSTANT F-WEP 0> ;"means print weapon name"
+<CONSTANT F-DEF 1> ;"means print defender name (villain, e.g.)"
+
+<GLOBAL HERO-MELEE
+ <TABLE
+ <LTABLE
+ <LTABLE "Your " F-WEP " misses the " F-DEF " by an inch.">
+ <LTABLE "A good slash, but it misses the " F-DEF " by a mile.">
+ <LTABLE "You charge, but the " F-DEF " jumps nimbly aside.">>
+ <LTABLE
+ <LTABLE "Your " F-WEP " crashes down, knocking the " F-DEF " into dreamland.">>
+ <LTABLE
+
+ <LTABLE "The fatal blow strikes the " F-DEF " square in the heart: He dies.">>
+ <LTABLE
+ <LTABLE "The " F-DEF " is struck on the arm, blood begins to trickle down.">
+ <LTABLE "Your " F-WEP " pinks the " F-DEF " on the wrist, but it's not serious.">>
+ <LTABLE
+ <LTABLE "The " F-DEF " receives a deep gash in his side.">
+ <LTABLE "A savage blow on the thigh! The " F-DEF " is stunned but can still fight!">>
+ <LTABLE
+ <LTABLE "The " F-DEF " is confused and can't fight back.">
+ <LTABLE "The quickness of your thrust knocks the " F-DEF " back, stunned.">>
+ <LTABLE
+ <LTABLE "The " F-DEF " is disarmed by a subtle feint past his guard.">>>>
+
+\
+
+"messages for troll"
+
+<GLOBAL TROLL-MELEE
+<TABLE
+ <LTABLE
+ <LTABLE "The axe sweeps past as you jump aside.">
+ <LTABLE "The axe crashes against the rock, throwing sparks!">>
+ <LTABLE
+ <LTABLE "The flat of the troll's axe hits you delicately on the head, knocking
+you out.">>
+ <LTABLE
+ <LTABLE "The troll neatly removes your head.">>
+ <LTABLE
+ <LTABLE "The axe gets you right in the side. Ouch!">
+ <LTABLE "The flat of the troll's axe skins across your forearm.">>
+ <LTABLE
+ <LTABLE "An axe stroke makes a deep wound in your leg.">
+ <LTABLE "The troll's axe swings down, gashing your shoulder.">>
+ <LTABLE
+ <LTABLE "The troll hits you with a glancing blow, and you are momentarily
+stunned.">
+ <LTABLE "You stagger back under a hail of axe strokes.">>
+ <LTABLE
+ <LTABLE "The axe knocks your " F-WEP " out of your hand. It falls to the floor.">>
+ <LTABLE
+ <LTABLE "The troll hesitates, fingering his axe.">>
+ <LTABLE
+ <LTABLE "Conquering his fears, the troll puts you to death.">>>>
+
+\
+
+"messages for thief"
+
+<GLOBAL THIEF-MELEE
+<TABLE
+ <LTABLE
+ <LTABLE "The thief stabs nonchalantly with his stiletto and misses.">
+ <LTABLE "You dodge as the thief comes in low.">
+ <LTABLE "The thief tries to sneak past your guard, but you twist away.">>
+ <LTABLE
+ <LTABLE "The thief knocks you out.">>
+ <LTABLE
+ <LTABLE "The thief bows formally, raises his stiletto, and with a wry grin,
+ends the battle and your life.">>
+ <LTABLE
+ <LTABLE "The thief draws blood, raking his stiletto across your arm.">
+ <LTABLE "The thief slowly approaches, strikes like a snake, and leaves
+you wounded.">>
+ <LTABLE
+ <LTABLE "The thief stabs a deep cut in your upper arm.">
+ <LTABLE "The thief strikes at your wrist, and suddenly your grip is slippery
+with blood.">>
+ <LTABLE
+ <LTABLE "The thief rams the haft of his blade into your stomach, leaving
+you out of breath.">>
+ <LTABLE
+ <LTABLE "The thief neatly flips your " F-WEP " out of your hands, and it drops
+to the floor.">>
+ <LTABLE
+ <LTABLE "The thief, a man of good breeding, refrains from attacking a helpless
+opponent.">
+ <LTABLE "The thief amuses himself by searching your pockets.">>
+ <LTABLE
+ <LTABLE "The thief, who is essentially a pragmatist, dispatches you as a
+threat to his livelihood.">>>>
+
diff --git a/macros.zil b/macros.zil
new file mode 100644
index 0000000..a9014f0
--- /dev/null
+++ b/macros.zil
@@ -0,0 +1,90 @@
+<SETG C-ENABLED? 0>
+<SETG C-ENABLED 1>
+<SETG C-DISABLED 0>
+
+<DEFMAC TELL ("ARGS" A)
+ <FORM PROG ()
+ !<MAPF ,LIST
+ <FUNCTION ("AUX" E P O)
+ <COND (<EMPTY? .A> <MAPSTOP>)
+ (<SET E <NTH .A 1>>
+ <SET A <REST .A>>)>
+ <COND (<TYPE? .E ATOM>
+ <COND (<OR <=? <SET P <SPNAME .E>>
+ "CRLF">
+ <=? .P "CR">>
+ <MAPRET '<CRLF>>)
+ (<EMPTY? .A>
+ <ERROR INDICATOR-AT-END? .E>)
+ (ELSE
+ <SET O <NTH .A 1>>
+ <SET A <REST .A>>
+ <COND (<OR <=? <SET P <SPNAME .E>>
+ "DESC">
+ <=? .P "D">
+ <=? .P "OBJ">
+ <=? .P "O">>
+ <MAPRET <FORM PRINTD .O>>)
+ (<OR <=? .P "NUM">
+ <=? .P "N">>
+ <MAPRET <FORM PRINTN .O>>)
+ (<OR <=? .P "CHAR">
+ <=? .P "CHR">
+ <=? .P "C">>
+ <MAPRET <FORM PRINTC .O>>)
+ (ELSE
+ <MAPRET
+ <FORM PRINT
+ <FORM GETP .O .E>>>)>)>)
+ (<TYPE? .E STRING>
+ <MAPRET <FORM PRINTI .E>>)
+ (<TYPE? .E FORM>
+ <MAPRET <FORM PRINT .E>>)
+ (ELSE <ERROR UNKNOWN-TYPE .E>)>>>>>
+
+<DEFMAC VERB? ("TUPLE" ATMS "AUX" (O ()) (L ()))
+ <REPEAT ()
+ <COND (<EMPTY? .ATMS>
+ <RETURN!- <COND (<LENGTH? .O 1> <NTH .O 1>)
+ (ELSE <FORM OR !.O>)>>)>
+ <REPEAT ()
+ <COND (<EMPTY? .ATMS> <RETURN!->)>
+ <SET ATM <NTH .ATMS 1>>
+ <SET L
+ (<FORM GVAL <PARSE <STRING "V?" <SPNAME .ATM>>>>
+ !.L)>
+ <SET ATMS <REST .ATMS>>
+ <COND (<==? <LENGTH .L> 3> <RETURN!->)>>
+ <SET O (<FORM EQUAL? ',PRSA !.L> !.O)>
+ <SET L ()>>>
+
+<DEFMAC RFATAL ()
+ '<PROG () <PUSH 2> <RSTACK>>>
+
+<DEFMAC PROB ('BASE? "OPTIONAL" 'LOSER?)
+ <COND (<ASSIGNED? LOSER?> <FORM ZPROB .BASE?>)
+ (ELSE <FORM G? .BASE? '<RANDOM 100>>)>>
+
+<ROUTINE ZPROB
+ (BASE)
+ <COND (,LUCKY <G? .BASE <RANDOM 100>>)
+ (ELSE <G? .BASE <RANDOM 300>>)>>
+
+<ROUTINE PICK-ONE (FROB)
+ <GET .FROB <RANDOM <GET .FROB 0>>>>
+
+<DEFMAC ENABLE ('INT) <FORM PUT .INT ,C-ENABLED? 1>>
+
+<DEFMAC DISABLE ('INT) <FORM PUT .INT ,C-ENABLED? 0>>
+
+<DEFMAC FLAMING? ('OBJ)
+ <FORM AND <FORM FSET? .OBJ ',FLAMEBIT>
+ <FORM FSET? .OBJ ',ONBIT>>>
+
+<DEFMAC OPENABLE? ('OBJ)
+ <FORM OR <FORM FSET? .OBJ ',DOORBIT>
+ <FORM FSET? .OBJ ',CONTBIT>>>
+
+<DEFMAC ABS ('NUM)
+ <FORM COND (<FORM L? .NUM 0> <FORM - 0 .NUM>)
+ (T .NUM)>> \ No newline at end of file
diff --git a/main.zil b/main.zil
new file mode 100644
index 0000000..8f9d7f9
--- /dev/null
+++ b/main.zil
@@ -0,0 +1,129 @@
+<CONSTANT M-FATAL 2>
+
+<CONSTANT M-HANDLED 1>
+
+<CONSTANT M-NOT-HANDLED <>>
+
+<CONSTANT M-BEG 1>
+
+<CONSTANT M-END <>>
+
+<CONSTANT M-ENTER 2>
+
+<CONSTANT M-LOOK 3>
+
+<ROUTINE GO ()
+ <ENABLE <QUEUE I-FIGHT -1>>
+ <QUEUE I-SWORD -1>
+ <ENABLE <QUEUE I-THIEF -1>>
+ <QUEUE I-LANTERN 200>
+ <PUTP ,INFLATED-BOAT ,P?VTYPE ,RWATERBIT>
+ <PUT ,DEF1-RES 1 <REST ,DEF1 2>>
+ <PUT ,DEF1-RES 2 <REST ,DEF1 4>>
+ <PUT ,DEF2-RES 2 <REST ,DEF2B 2>>
+ <PUT ,DEF2-RES 3 <REST ,DEF2B 4>>
+ <PUT ,DEF3-RES 1 <REST ,DEF3A 2>>
+ <PUT ,DEF3-RES 3 <REST ,DEF3B 2>>
+ <SETG HERE ,WEST-OF-HOUSE>
+ <SETG P-IT-OBJECT ,MAILBOX>
+ <SETG P-IT-LOC ,HERE>
+ <COND (<NOT <FSET? ,HERE ,TOUCHBIT>> <V-VERSION> <CRLF>)>
+ <SETG LIT T>
+ <SETG WINNER ,ADVENTURER>
+ <V-LOOK>
+ <MAIN-LOOP>
+ <AGAIN>>
+
+
+<ROUTINE MAIN-LOOP ("AUX" ICNT OCNT NUM CNT OBJ TBL V PTBL OBJ1 TMP)
+ #DECL ((CNT OCNT ICNT NUM) FIX (V) <OR 'T FIX FALSE> (OBJ) <OR FALSE OBJECT>
+ (OBJ1) OBJECT (TBL) TABLE (PTBL) <OR FALSE ATOM>)
+ <REPEAT ()
+ <SET CNT 0>
+ <SET OBJ <>>
+ <SET PTBL T>
+ <COND (<SETG P-WON <PARSER>>
+ <SET ICNT <GET ,P-PRSI ,P-MATCHLEN>>
+ <SET NUM
+ <COND (<0? <SET OCNT <GET ,P-PRSO ,P-MATCHLEN>>> .OCNT)
+ (<G? .OCNT 1>
+ <SET TBL ,P-PRSO>
+ <COND (<0? .ICNT> <SET OBJ <>>)
+ (T <SET OBJ <GET ,P-PRSI 1>>)>
+ .OCNT)
+ (<G? .ICNT 1>
+ <SET PTBL <>>
+ <SET TBL ,P-PRSI>
+ <SET OBJ <GET ,P-PRSO 1>>
+ .ICNT)
+ (T 1)>>
+ <COND (<AND <NOT .OBJ> <1? .ICNT>> <SET OBJ <GET ,P-PRSI 1>>)>
+ <COND (<==? ,PRSA ,V?WALK> <SET V <PERFORM ,PRSA ,PRSO>>)
+ (<0? .NUM>
+ <COND (<0? <BAND <GETB ,P-SYNTAX ,P-SBITS> ,P-SONUMS>>
+ <SET V <PERFORM ,PRSA>>)
+ (T
+ <TELL "I don't know what object you mean.">
+ <SET V <>>)>)
+ (T
+ <REPEAT ()
+ <COND (<G? <SET CNT <+ .CNT 1>> .NUM> <RETURN>)
+ (T
+ <COND (.PTBL <SET OBJ1 <GET ,P-PRSO .CNT>>)
+ (T <SET OBJ1 <GET ,P-PRSI .CNT>>)>
+ <COND (<G? .NUM 1>
+ <PRINTD .OBJ1>
+ <TELL ": ">)>
+ <SET V
+ <PERFORM ,PRSA
+ <COND (.PTBL .OBJ1) (T .OBJ)>
+ <COND (.PTBL .OBJ) (T .OBJ1)>>>
+ <COND (<==? .V ,M-FATAL> <RETURN>)>)>>
+ <SETG P-IT-OBJECT .OBJ1>
+ <SETG P-IT-LOC ,HERE>)>
+ <SETG MOVES <+ ,MOVES 1>>
+ <COND (<==? .V ,M-FATAL> <SETG P-CONT <>>)>)
+ (T
+ <SETG P-CONT <>>)>
+ <SET V <CLOCKER>>>>
+
+<GLOBAL L-PRSA <>>
+
+<GLOBAL L-PRSO <>>
+
+<GLOBAL L-PRSI <>>
+
+<ROUTINE PERFORM (A "OPTIONAL" (O <>) (I <>) "AUX" V OA OO OI)
+ #DECL ((A) FIX (O) <OR FALSE OBJECT FIX> (I) <OR FALSE OBJECT> (V) ANY)
+ <SET OA ,PRSA>
+ <SET OO ,PRSO>
+ <SET OI ,PRSI>
+ <SETG PRSA .A>
+ <COND (<AND <EQUAL? ,IT .I .O>
+ <NOT <EQUAL? ,P-IT-LOC ,HERE>>>
+ <TELL "I don't see what you are referring to." CR>
+ <RFATAL>)>
+ <COND (<==? .O ,IT> <SET O ,P-IT-OBJECT>)>
+ <COND (<==? .I ,IT> <SET I ,P-IT-OBJECT>)>
+ <SETG PRSO .O>
+ <SETG PRSI .I>
+ <COND (<NOT <==? .A ,V?AGAIN>>
+ <SETG L-PRSA .A>
+ <SETG L-PRSO .O>
+ <SETG L-PRSI .I>)>
+ <COND (<SET V <APPLY <GETP ,WINNER ,P?ACTION>>> .V)
+ (<SET V <APPLY <GETP <LOC ,WINNER> ,P?ACTION> ,M-BEG>> .V)
+ (<SET V <APPLY <GET ,PREACTIONS .A>>> .V)
+ (<AND .I <SET V <APPLY <GETP .I ,P?ACTION>>>> .V)
+ (<AND .O
+ <NOT <==? .A ,V?WALK>>
+ <SET V <APPLY <GETP .O ,P?ACTION>>>>
+ .V)
+ (<SET V <APPLY <GET ,ACTIONS .A>>> .V)>
+ <COND (<NOT <==? .V ,M-FATAL>>
+ <SET V <APPLY <GETP ,HERE ,P?ACTION> ,M-END>>)>
+ <SETG PRSA .OA>
+ <SETG PRSO .OO>
+ <SETG PRSI .OI>
+ .V>
+
diff --git a/melee.zil b/melee.zil
new file mode 100644
index 0000000..e9ebb16
--- /dev/null
+++ b/melee.zil
@@ -0,0 +1,365 @@
+"SUBTITLE MELEE"
+
+"melee actions (object functions for villains called with these"
+
+<CONSTANT F-DEAD 2> ;"mistah kurtz, he dead."
+<CONSTANT F-FIRST? 5> ;"strike first?"
+
+\
+
+"blow results"
+
+<CONSTANT MISSED 1> ;"attacker misses"
+<CONSTANT KILLED 3> ;"defender dead"
+<CONSTANT LIGHT-WOUND 4> ;"defender lightly wounded"
+<CONSTANT SERIOUS-WOUND 5> ;"defender seriously wounded"
+<CONSTANT STAGGER 6> ;"defender staggered (miss turn)"
+<CONSTANT LOSE-WEAPON 7> ;"defender loses weapon"
+<CONSTANT HESITATE 8> ;"hesitates (miss on free swing)"
+<CONSTANT SITTING-DUCK 9> ;"sitting duck (crunch!)"
+
+"tables of melee results"
+
+<GLOBAL DEF1
+ <TABLE
+ MISSED MISSED MISSED MISSED
+ STAGGER STAGGER
+ STAGGER STAGGER
+ KILLED KILLED KILLED KILLED KILLED>>
+
+<GLOBAL DEF2A
+ <TABLE
+ MISSED MISSED MISSED MISSED MISSED
+ STAGGER STAGGER
+ LIGHT-WOUND LIGHT-WOUND
+ KILLED>>
+
+<GLOBAL DEF2B
+ <TABLE
+ MISSED MISSED MISSED
+ STAGGER STAGGER
+ LIGHT-WOUND LIGHT-WOUND LIGHT-WOUND
+ KILLED
+ KILLED KILLED KILLED>>
+
+<GLOBAL DEF3A
+ <TABLE
+ MISSED MISSED MISSED MISSED MISSED
+ STAGGER STAGGER
+ LIGHT-WOUND LIGHT-WOUND
+ SERIOUS-WOUND SERIOUS-WOUND>>
+
+<GLOBAL DEF3B
+ <TABLE
+ MISSED MISSED MISSED
+ STAGGER STAGGER
+ LIGHT-WOUND LIGHT-WOUND LIGHT-WOUND
+ SERIOUS-WOUND SERIOUS-WOUND SERIOUS-WOUND>>
+
+<GLOBAL DEF3C
+ <TABLE
+ MISSED
+ STAGGER STAGGER
+ LIGHT-WOUND LIGHT-WOUND LIGHT-WOUND LIGHT-WOUND
+ SERIOUS-WOUND SERIOUS-WOUND SERIOUS-WOUND>>
+
+<GLOBAL DEF1-RES
+ <TABLE DEF1
+ 0 ;<REST ,DEF1 2>
+ 0 ;<REST ,DEF1 4>>>
+
+<GLOBAL DEF2-RES
+ <TABLE DEF2A
+ DEF2B
+ 0; <REST ,DEF2B 2>
+ 0; <REST ,DEF2B 4>>>
+
+<GLOBAL DEF3-RES
+ <TABLE DEF3A
+ 0 ;<REST ,DEF3A 2>
+ DEF3B
+ 0 ;<REST ,DEF3B 2>
+ DEF3C>>
+
+\
+
+"useful constants"
+
+<CONSTANT STRENGTH-MAX 7>
+<CONSTANT STRENGTH-MIN 2>
+<CONSTANT CURE-WAIT 30>
+
+"each table entry is:"
+
+<CONSTANT V-VILLAIN 0> ;"villain"
+<CONSTANT V-BEST 1> ;"best weapon"
+<CONSTANT V-BEST-ADV 2> ;"advantage it confers"
+<CONSTANT V-PROB 3> ;"prob of waking if unconscious"
+<CONSTANT V-MSGS 4> ;"messages for that villain"
+
+<GLOBAL VILLAINS
+ <LTABLE <TABLE TROLL SWORD 1 0 TROLL-MELEE>
+ <TABLE THIEF KNIFE 1 0 THIEF-MELEE>>>
+
+\
+
+"I-FIGHT moved to DEMONS"
+
+<ROUTINE DO-FIGHT (LEN "AUX" CNT RES O OO (OUT <>))
+ <REPEAT ()
+ <SET CNT 0>
+ <REPEAT ()
+ <SET CNT <+ .CNT 1>>
+ <COND (<==? .CNT .LEN>
+ <SET RES T>
+ <RETURN T>)>
+ <SET OO <GET ,VILLAINS .CNT>>
+ <SET O <GET .OO ,V-VILLAIN>>
+ <COND (<NOT <FSET? .O ,FIGHTBIT>>)
+ (<NOT <SET RES
+ <VILLAIN-BLOW
+ .OO
+ .OUT>>>
+ <SET RES <>>
+ <RETURN>)
+ (<==? .RES ,UNCONSCIOUS>
+ <SET OUT <+ 1 <RANDOM 3>>>)>>
+ <COND (.RES
+ <COND (<NOT .OUT> <RETURN>)
+ (T
+ <SET OUT <- .OUT 1>>
+ <COND (<0? .OUT> <RETURN>)>)>)
+ (ELSE <RETURN>)>>>
+
+\
+
+"takes a remark, defender, and good-guy's weapon"
+
+<ROUTINE REMARK (REMARK D W "AUX" (LEN <GET .REMARK 0>) (CNT 0) STR)
+ #DECL ((A D) OBJECT (W) <OR OBJECT FALSE> (LEN CNT) FIX
+ (STR) <OR FIX STRING>)
+ <REPEAT ()
+ <COND (<G? <SET CNT <+ .CNT 1>> .LEN> <RETURN>)>
+ <SET STR <GET .REMARK .CNT>>
+ <COND (<==? .STR ,F-WEP> <PRINTD .W>)
+ (<==? .STR ,F-DEF> <PRINTD .D>)
+ (ELSE <PRINT .STR>)>>
+ <CRLF>>
+
+"Strength of the player is a basic value (S) adjusted by his P?STRENGTH
+property, which is normally 0"
+
+<ROUTINE FIGHT-STRENGTH ("OPTIONAL" (ADJUST? T) "AUX" S)
+ #DECL ((HERO) ADV (S SMAX SMIN VALUE) FIX (ADJUST?) <OR ATOM FALSE>)
+ <SET S
+ <+ ,STRENGTH-MIN
+ </ ,SCORE
+ </ ,SCORE-MAX
+ <- ,STRENGTH-MAX ,STRENGTH-MIN>>>>>
+ <COND (.ADJUST? <+ .S <GETP ,WINNER ,P?STRENGTH>>)(ELSE .S)>>
+
+<ROUTINE VILLAIN-STRENGTH (OO
+ "AUX" (VILLAIN <GET .OO ,V-VILLAIN>)
+ OD TMP)
+ #DECL ((VILLAIN) OBJECT (WV) <OR FALSE VECTOR>
+ (OD VALUE) FIX)
+ <SET OD <GETP .VILLAIN ,P?STRENGTH>>
+ <COND (<NOT <L? .OD 0>>
+ <COND (<AND <==? .VILLAIN ,THIEF> ,THIEF-ENGROSSED>
+ <COND (<G? .OD 2> <SET OD 2>)>
+ <SETG THIEF-ENGROSSED <>>)>
+ <COND (<AND ,PRSI
+ <FSET? ,PRSI ,WEAPONBIT>
+ <==? <GET .OO ,V-BEST> ,PRSI>>
+ <SET TMP <- .OD <GET .OO ,V-BEST-ADV>>>
+ <COND (<L? .TMP 1> <SET TMP 1>)>
+ <SET OD .TMP>)>)>
+ .OD>
+
+"find a weapon (if any) in possession of argument"
+
+<ROUTINE FIND-WEAPON (O "AUX" W)
+ <SET W <FIRST? .O>>
+ <COND (<NOT .W>
+ <RFALSE>)>
+ <REPEAT ()
+ <COND (<FSET? .W ,WEAPONBIT> <RETURN .W>)
+ (<NOT <SET W <NEXT? .W>>> <RETURN <>>)>>>
+
+\
+
+<ROUTINE VILLAIN-BLOW (OO OUT?
+ "AUX" (VILLAIN <GET .OO ,V-VILLAIN>)
+ (REMARKS <GET .OO ,V-MSGS>)
+ DWEAPON ATT DEF OA OD TBL RES NWEAPON)
+ <FCLEAR ,WINNER ,STAGGERED>
+ <COND (<FSET? .VILLAIN ,STAGGERED>
+ <TELL "The " D .VILLAIN
+ " slowly regains his feet." CR>
+ <FCLEAR .VILLAIN ,STAGGERED>
+ <RTRUE>)>
+ <SET OA <SET ATT <VILLAIN-STRENGTH .OO>>>
+ <COND (<NOT <G? <SET DEF <FIGHT-STRENGTH>> 0>> <RTRUE>)>
+ <SET OD <FIGHT-STRENGTH <>>>
+ <SET DWEAPON <FIND-WEAPON ,WINNER>>
+ <COND (<L? .DEF 0> <SET RES ,KILLED>)
+ (ELSE
+ <COND (<1? .DEF>
+ <COND (<G? .ATT 2> <SET ATT 3>)>
+ <SET TBL <GET ,DEF1-RES <- .ATT 1>>>)
+ (<==? .DEF 2>
+ <COND (<G? .ATT 3> <SET ATT 4>)>
+ <SET TBL <GET ,DEF2-RES <- .ATT 1>>>)
+ (<G? .DEF 2>
+ <SET ATT <- .ATT .DEF>>
+ <COND (<L? .ATT -1> <SET ATT -2>)
+ (<G? .ATT 1> <SET ATT 2>)>
+ <SET TBL <GET ,DEF3-RES <+ .ATT 2>>>)>
+ <SET RES <GET .TBL <- <RANDOM 9> 1>>>
+ <REMARK
+ <PICK-ONE <GET .REMARKS <- .RES 1>>>
+ ,WINNER
+ .DWEAPON>)>
+ <COND (<OR <==? .RES ,MISSED> <==? .RES ,HESITATE>>)
+ (<OR <==? .RES ,KILLED> <==? .RES ,SITTING-DUCK>> <SET DEF 0>)
+ (<==? .RES ,LIGHT-WOUND>
+ <SET DEF <- .DEF 1>>
+ <COND (<L? .DEF 0> <SET DEF 0>)>
+ <COND (<G? ,LOAD-ALLOWED 50>
+ <SETG LOAD-ALLOWED <- ,LOAD-ALLOWED 10>>)>)
+ (<==? .RES ,SERIOUS-WOUND>
+ <SET DEF <- .DEF 2>>
+ <COND (<L? .DEF 0> <SET DEF 0>)>
+ <COND (<G? ,LOAD-ALLOWED 50>
+ <SETG LOAD-ALLOWED <- ,LOAD-ALLOWED 20>>)>)
+ (<==? .RES ,STAGGER> <FSET ,WINNER ,STAGGERED>)>
+ <WINNER-RESULT .DEF .RES .OD>>
+
+<ROUTINE HERO-BLOW ("AUX" OO VILLAIN DWEAPON ATT DEF (CNT 0)
+ OA OD TBL RES NWEAPON (LEN <GET ,VILLAINS 0>))
+ #DECL ((VILLAIN) OBJECT (NWEAPON) <OR OBJECT FALSE>
+ (RES OA OD ATT DEF FIX) FIX (HERO?) <OR ATOM FALSE>)
+ <REPEAT ()
+ <SET CNT <+ .CNT 1>>
+ <COND (<==? .CNT .LEN> <RETURN>)>
+ <SET OO <GET ,VILLAINS .CNT>>
+ <COND (<==? <GET .OO ,V-VILLAIN> ,PRSO>
+ <RETURN>)>>
+ <FSET ,PRSO ,FIGHTBIT>
+ <COND (<FSET? ,WINNER ,STAGGERED>
+ <TELL
+"You are still recovering from that last blow, so your attack is
+ineffective." CR>
+ <FCLEAR ,WINNER ,STAGGERED>
+ <RTRUE>)>
+ <SET ATT <FIGHT-STRENGTH>>
+ <COND (<L? .ATT 1> <SET ATT 1>)>
+ <SET OA .ATT>
+ <SET VILLAIN <GET .OO ,V-VILLAIN>>
+ <COND (<0? <SET OD <SET DEF <VILLAIN-STRENGTH .OO>>>>
+ <COND (<==? ,PRSO ,WINNER>
+ <RETURN <JIGS-UP
+"Well, you really did it that time. Is suicide painless?">>)>
+ <TELL "Attacking the " D .VILLAIN " is pointless." CR>
+ <RTRUE>)>
+ <SET DWEAPON <FIND-WEAPON .VILLAIN>>
+ <COND (<1? .DEF>
+ <COND (<G? .ATT 2> <SET ATT 3>)>
+ <SET TBL <GET ,DEF1-RES <- .ATT 1>>>)
+ (<==? .DEF 2>
+ <COND (<G? .ATT 3> <SET ATT 4>)>
+ <SET TBL <GET ,DEF2-RES <- .ATT 1>>>)
+ (<G? .DEF 2>
+ <SET ATT <- .ATT .DEF>>
+ <COND (<L? .ATT -1> <SET ATT -2>)
+ (<G? .ATT 1> <SET ATT 2>)>
+ <SET TBL <GET ,DEF3-RES <+ .ATT 2>>>)>
+ <SET RES <GET .TBL <- <RANDOM 9> 1>>>
+ <COND (<==? .RES 2> <SET RES 1>)>
+ <REMARK
+ <PICK-ONE <GET ,HERO-MELEE <- .RES 1>>>
+ ,PRSO
+ ,PRSI>
+ <COND (<EQUAL? .RES ,MISSED ,HESITATE>)
+ (<EQUAL? .RES ,KILLED ,SITTING-DUCK> <SET DEF 0>)
+ (<==? .RES ,LIGHT-WOUND>
+ <SET DEF <- .DEF 1>>
+ <COND (<L? .DEF 0> <SET DEF 0>)>)
+ (<==? .RES ,SERIOUS-WOUND>
+ <SET DEF <- .DEF 2>>
+ <COND (<L? .DEF 0> <SET DEF 0>)>)
+ (<==? .RES ,STAGGER> <FSET ,PRSO ,STAGGERED>)>
+ <VILLAIN-RESULT ,PRSO .DEF .RES>>
+
+\
+
+<ROUTINE WINNER-RESULT (DEF RES OD)
+ <PUTP ,WINNER
+ ,P?STRENGTH
+ <COND (<0? .DEF> -10000)(ELSE <- .DEF .OD>)>>
+ <COND (<L? <- .DEF .OD> 0>
+ <ENABLE <QUEUE I-CURE ,CURE-WAIT>>)>
+ <COND (<NOT <G? <FIGHT-STRENGTH> 0>>
+ <PUTP ,WINNER ,P?STRENGTH <+ 1 <- <FIGHT-STRENGTH <>>>>>
+ <JIGS-UP
+"It appears that that last blow was too much for you. I'm afraid you
+are dead.">
+ <>)
+ (ELSE .RES)>>
+
+<ROUTINE VILLAIN-RESULT (VILLAIN DEF RES)
+ <PUTP .VILLAIN ,P?STRENGTH .DEF>
+ <COND (<0? .DEF>
+ <FCLEAR .VILLAIN ,FIGHTBIT>
+ <TELL
+"Almost as soon as the " D .VILLAIN " breathes his last breath, a cloud
+of sinister black fog envelops him, and when the fog lifts, his carcass
+and weapon have disappeared." CR>
+ <REMOVE .VILLAIN>
+ <APPLY <GETP .VILLAIN ,P?ACTION> ,F-DEAD>
+ .RES)
+ (ELSE .RES)>>
+
+\
+
+<ROUTINE WINNING? (V "AUX" VS PS)
+ #DECL ((V) OBJECT (VS PS) FIX)
+ <SET VS <GETP .V ,P?STRENGTH>>
+ <SET PS <- .VS <FIGHT-STRENGTH>>>
+ <COND (<G? .PS 3> <PROB 90>)
+ (<G? .PS 0> <PROB 75>)
+ (<0? .PS> <PROB 50>)
+ (<G? .VS 1> <PROB 25>)
+ (ELSE <PROB 10>)>>
+
+<ROUTINE I-CURE ("AUX" (S <GETP ,WINNER ,P?STRENGTH>))
+ #DECL ((S) FIX)
+ <COND (<G? .S 0> <SET S 0> <PUTP ,WINNER ,P?STRENGTH .S>)
+ (<L? .S 0> <SET S <+ .S 1>> <PUTP ,WINNER ,P?STRENGTH .S>)>
+ <COND (<L? .S 0>
+ <COND (<L? ,LOAD-ALLOWED ,LOAD-MAX>
+ <SETG LOAD-ALLOWED <+ ,LOAD-ALLOWED 10>>)>
+ <ENABLE <QUEUE I-CURE ,CURE-WAIT>>)
+ (ELSE
+ <SETG LOAD-ALLOWED ,LOAD-MAX>
+ <DISABLE <INT I-CURE>>)>>
+
+<ROUTINE V-DIAGNOSE ("AUX" (MS <FIGHT-STRENGTH <>>)
+ (WD <GETP ,WINNER ,P?STRENGTH>) (RS <+ .MS .WD>))
+ #DECL ((MS WD RS) FIX)
+ <COND (<0? <GET <INT I-CURE> ,C-ENABLED?>> <SET WD 0>)
+ (ELSE <SET WD <- .WD>>)>
+ <COND (<0? .WD> <TELL "You are in perfect health.">)
+ (T
+ <TELL "You have wounds which will be cured in ">
+ <PRINTN
+ <+ <* ,CURE-WAIT <- .WD 1>>
+ <GET <INT I-CURE> ,C-TICK>>>
+ <TELL " moves." CR>)>
+ <CRLF>
+ <COND (<0? .RS> <TELL "You are at death's door.">)
+ (<1? .RS> <TELL "You can be killed by one more wound.">)
+ (<==? .RS 2> <TELL "You can be killed by a serious wound.">)
+ (<==? .RS 3> <TELL "You can survive one serious wound.">)
+ (<G? .RS 3> <TELL "You are still strong.">)>
+ <CRLF>>
diff --git a/parser.zil b/parser.zil
new file mode 100644
index 0000000..5591470
--- /dev/null
+++ b/parser.zil
@@ -0,0 +1,749 @@
+"Z-parser (ZIL)"
+;"Parser global variable convention: All parser globals will
+ begin with 'P-'. Local variables are not restricted in any
+ way.
+"
+
+<SETG SIBREAKS ".,">
+
+<GLOBAL ALWAYS-LIT <>>
+
+<GLOBAL GWIM-DISABLE <>>
+
+<GLOBAL PRSA 0>
+
+<GLOBAL PRSI 0>
+
+<GLOBAL PRSO 0>
+
+<GLOBAL P-TABLE 0>
+
+<GLOBAL P-ONEOBJ 0>
+
+<GLOBAL P-SYNTAX 0>
+
+<GLOBAL P-CCSRC 0>
+
+<GLOBAL P-LEN 0>
+
+<GLOBAL P-DIR 0>
+
+<GLOBAL HERE 0>
+
+<GLOBAL WINNER 0>
+
+<GLOBAL P-LEXV <ITABLE BYTE 60>>
+;"INBUF - Input buffer for READ"
+
+<GLOBAL P-INBUF <ITABLE BYTE 60>>
+;"Parse-cont variable"
+
+<GLOBAL P-CONT <>>
+
+<GLOBAL P-IT-OBJECT <>>
+<GLOBAL P-IT-LOC <>>
+
+;"Parser variables and temporaries"
+
+<CONSTANT P-PHRLEN 3>
+
+<CONSTANT P-ORPHLEN 7>
+
+<CONSTANT P-RTLEN 3>
+;"Byte offset to # of entries in LEXV"
+
+<CONSTANT P-LEXWORDS 1>
+;"Word offset to start of LEXV entries"
+
+<CONSTANT P-LEXSTART 1>
+;"Number of words per LEXV entry"
+
+<CONSTANT P-LEXELEN 2>
+
+<CONSTANT P-WORDLEN 4>
+;"Offset to parts of speech byte"
+
+<CONSTANT P-PSOFF 4>
+;"Offset to first part of speech"
+
+<CONSTANT P-P1OFF 5>
+;"First part of speech bit mask in PSOFF byte"
+
+<CONSTANT P-P1BITS 3>
+
+<CONSTANT P-ITBLLEN 9>
+
+<GLOBAL P-ITBL <TABLE 0 0 0 0 0 0 0 0 0 0>>
+
+<GLOBAL P-VTBL <TABLE 0 0 0 0>>
+
+<GLOBAL P-NCN 0>
+
+<CONSTANT P-VERB 0>
+
+<CONSTANT P-VERBN 1>
+
+<CONSTANT P-PREP1 2>
+
+<CONSTANT P-PREP1N 3>
+
+<CONSTANT P-PREP2 4>
+
+<CONSTANT P-PREP2N 5>
+
+<CONSTANT P-NC1 6>
+
+<CONSTANT P-NC1L 7>
+
+<CONSTANT P-NC2 8>
+
+<CONSTANT P-NC2L 9>
+
+" Grovel down the input finding the verb, prepositions, and noun clauses.
+ If the input is <direction> or <walk> <direction>, fall out immediately
+ setting PRSA to ,V?WALK and PRSO to <direction>. Otherwise, perform
+ all required orphaning, syntax checking, and noun clause lookup."
+
+<ROUTINE PARSER ("AUX" (PTR ,P-LEXSTART) WORD (VAL 0) (VERB <>)
+ LEN (DIR <>) (NW 0) NUM)
+ <CLEAR-ITBL>
+ <PUT ,P-PRSO ,P-MATCHLEN 0>
+ <PUT ,P-PRSI ,P-MATCHLEN 0>
+ <PUT ,P-BUTS ,P-MATCHLEN 0>
+ <COND (,P-CONT
+ <SET PTR ,P-CONT>
+ <SETG P-CONT <>>
+ <COND (<NOT ,SUPER-BRIEF> <CRLF>)>)
+ (T
+ <COND (<NOT ,SUPER-BRIEF> <CRLF>)>
+ <TELL ">">
+ <READ ,P-INBUF ,P-LEXV>)>
+ <SETG P-LEN <GETB ,P-LEXV ,P-LEXWORDS>>
+ <COND (<0? ,P-LEN> <TELL "Beg pardon?" CR> <RFALSE>)>
+ <SET LEN ,P-LEN>
+ <SETG P-DIR <>>
+ <SETG P-NCN 0>
+ <SETG P-GETFLAGS 0>
+ <REPEAT ()
+ <COND (<L? <SETG P-LEN <- ,P-LEN 1>> 0> <RETURN>)
+ (<SET WORD <GET ,P-LEXV .PTR>>
+ <COND (<EQUAL? .WORD ,W?THEN ,W?.>
+ <OR <0? ,P-LEN>
+ <SETG P-CONT <+ .PTR ,P-LEXELEN>>>
+ <PUTB ,P-LEXV ,P-LEXWORDS ,P-LEN>
+ <RETURN>)
+ (<AND <SET VAL
+ <WT? .WORD
+ ,PS?DIRECTION
+ ,P1?DIRECTION>>
+ <OR <==? .LEN 1>
+ <AND <==? .LEN 2> <==? .VERB ,ACT?WALK>>
+ <EQUAL? <SET NW
+ <GET ,P-LEXV
+ <+ .PTR ,P-LEXELEN>>>
+ ,W?THEN
+ ,W?.>
+ <EQUAL? .NW ,W?COMMA ,W?AND>>>
+ <SET DIR .VAL>
+ <COND (<EQUAL? .NW ,W?COMMA ,W?AND>
+ <PUT ,P-LEXV
+ <+ .PTR ,P-LEXELEN>
+ ,W?THEN>)>
+ <COND (<NOT <G? .LEN 2>> <RETURN>)>)
+ (<AND <SET VAL <WT? .WORD ,PS?VERB ,P1?VERB>>
+ <NOT .VERB>>
+ <SET VERB .VAL>
+ <PUT ,P-ITBL ,P-VERB .VAL>
+ <PUT ,P-ITBL ,P-VERBN ,P-VTBL>
+ <PUT ,P-VTBL 0 .WORD>
+ <PUTB ,P-VTBL 2 <GETB ,P-LEXV
+ <SET NUM
+ <+ <* .PTR 2> 2>>>>
+ <PUTB ,P-VTBL 3 <GETB ,P-LEXV <+ .NUM 1>>>)
+ (<OR <SET VAL <WT? .WORD ,PS?PREPOSITION 0>>
+ <AND <OR <EQUAL? .WORD ,W?ALL ,W?ONE ,W?A>
+ <WT? .WORD ,PS?ADJECTIVE>
+ <WT? .WORD ,PS?OBJECT>>
+ <SET VAL 0>>>
+ <COND (<AND <G? ,P-LEN 0>
+ <==? <GET ,P-LEXV
+ <+ .PTR ,P-LEXELEN>>
+ ,W?OF>
+ <0? .VAL>
+ <NOT
+ <EQUAL? .WORD ,W?ALL ,W?ONE ,W?A>>>)
+ (<AND <NOT <0? .VAL>>
+ <OR <0? ,P-LEN>
+ <EQUAL? <GET ,P-LEXV <+ .PTR 2>>
+ ,W?THEN ,W?.>>>
+ <COND (<L? ,P-NCN 2>
+ <PUT ,P-ITBL ,P-PREP1 .VAL>
+ <PUT ,P-ITBL ,P-PREP1N .WORD>)>)
+ (<==? ,P-NCN 2>
+ <TELL "Too many noun clauses??" CR>
+ <RFALSE>)
+ (T
+ <SETG P-NCN <+ ,P-NCN 1>>
+ <OR <SET PTR <CLAUSE .PTR .VAL .WORD>>
+ <RFALSE>>
+ <AND <L? .PTR 0> <RETURN>>)>)
+ (<WT? .WORD ,PS?BUZZ-WORD>)
+ (T
+ <TELL "I can't use the word '">
+ <PRINTB .WORD>
+ <TELL "' here." CR>
+ <RFALSE>)>)
+ (T <UNKNOWN-WORD .PTR> <RFALSE>)>
+ <SET PTR <+ .PTR ,P-LEXELEN>>>
+ <COND (.DIR <SETG PRSA ,V?WALK> <SETG PRSO .DIR> <RETURN T>)>
+ <COND (<AND <SYNTAX-CHECK> <SNARF-OBJECTS> <TAKE-CHECK> <MANY-CHECK>>
+ T)>>
+;"Check whether word pointed at by PTR is the correct part of speech.
+ The second argument is the part of speech (,PS?<part of speech>). The
+ 3rd argument (,P1?<part of speech>), if given, causes the value
+ for that part of speech to be returned."
+
+<ROUTINE WT? (PTR BIT "OPTIONAL" (B1 5) "AUX" (OFFSET ,P-P1OFF) TYP)
+ <COND (<BTST <SET TYP <GETB .PTR ,P-PSOFF>> .BIT>
+ <COND (<G? .B1 4> <RTRUE>)
+ (T
+ <SET TYP <BAND .TYP ,P-P1BITS>>
+ <COND (<NOT <==? .TYP .B1>> <SET OFFSET <+ .OFFSET 1>>)>
+ <GETB .PTR .OFFSET>)>)>>
+;" Scan through a noun clause, leave a pointer to its starting location"
+
+<ROUTINE CLAUSE (PTR VAL WORD "AUX" OFF NUM (ANDFLG <>) (FIRST?? <>) NW)
+ #DECL ((PTR VAL OFF NUM) FIX (WORD NW) <OR FALSE FIX TABLE>
+ (ANDFLG FIRST??) <OR ATOM FALSE>)
+ <SET OFF <* <- ,P-NCN 1> 2>>
+ <COND (<NOT <==? .VAL 0>>
+ <PUT ,P-ITBL <SET NUM <+ ,P-PREP1 .OFF>> .VAL>
+ <PUT ,P-ITBL <+ .NUM 1> .WORD>
+ <SET PTR <+ .PTR ,P-LEXELEN>>)
+ (T <SETG P-LEN <+ ,P-LEN 1>>)>
+ <COND (<0? ,P-LEN> <SETG P-NCN <- ,P-NCN 1>> <RETURN -1>)>
+ <PUT ,P-ITBL <SET NUM <+ ,P-NC1 .OFF>> <REST ,P-LEXV <* .PTR 2>>>
+ <REPEAT ()
+ <COND (<L? <SETG P-LEN <- ,P-LEN 1>> 0>
+ <PUT ,P-ITBL <+ .NUM 1> <REST ,P-LEXV <* .PTR 2>>>
+ <RETURN -1>)>
+ <COND (<SET WORD <GET ,P-LEXV .PTR>>
+ <COND (<0? ,P-LEN> <SET NW 0>)
+ (T <SET NW <GET ,P-LEXV <+ .PTR ,P-LEXELEN>>>)>
+ <COND (<EQUAL? .WORD ,W?AND ,W?COMMA> <SET ANDFLG T>)
+ (<EQUAL? .WORD ,W?ALL ,W?ONE>
+ <COND (<==? .NW ,W?OF>
+ <SETG P-LEN <- ,P-LEN 1>>
+ <SET PTR <+ .PTR ,P-LEXELEN>>)>)
+ (<OR <EQUAL? .WORD ,W?THEN ,W?.>
+ <AND <WT? .WORD ,PS?PREPOSITION>
+ <NOT .FIRST??>>>
+ <SETG P-LEN <+ ,P-LEN 1>>
+ <PUT ,P-ITBL
+ <+ .NUM 1>
+ <REST ,P-LEXV <* .PTR 2>>>
+ <RETURN <- .PTR ,P-LEXELEN>>)
+ (<WT? .WORD ,PS?OBJECT>
+ <COND (<AND <WT? .WORD
+ ,PS?ADJECTIVE
+ ,P1?ADJECTIVE>
+ <NOT <==? .NW 0>>
+ <WT? .NW ,PS?OBJECT>>)
+ (<AND <NOT .ANDFLG>
+ <NOT <EQUAL? .NW ,W?BUT ,W?EXCEPT>>
+ <NOT <EQUAL? .NW ,W?AND ,W?COMMA>>>
+ <PUT ,P-ITBL
+ <+ .NUM 1>
+ <REST ,P-LEXV <* <+ .PTR 2> 2>>>
+ <RETURN .PTR>)
+ (T <SET ANDFLG <>>)>)
+ (<OR <WT? .WORD ,PS?ADJECTIVE>
+ <WT? .WORD ,PS?BUZZ-WORD>>)
+ (<AND .ANDFLG
+ <OR <WT? .WORD ,PS?DIRECTION>
+ <WT? .WORD ,PS?VERB>>>
+ <SET PTR <- .PTR 4>>
+ <PUT ,P-LEXV <+ .PTR 2> ,W?THEN>
+ <SETG P-LEN <+ ,P-LEN 2>>)
+ (T
+ <TELL "I can't use the word '">
+ <PRINTB .WORD>
+ <TELL "' here." CR>
+ <RFALSE>)>)
+ (T <UNKNOWN-WORD .PTR> <RFALSE>)>
+ <SET FIRST?? <>>
+ <SET PTR <+ .PTR ,P-LEXELEN>>>>
+
+;"Print undefined word in input.
+ PTR points to the unknown word in P-LEXV"
+
+<ROUTINE WORD-PRINT (CNT BUF)
+ <REPEAT ()
+ <COND (<DLESS? CNT 0> <RETURN>)
+ (ELSE
+ <PRINTC <GETB ,P-INBUF .BUF>>
+ <SET BUF <+ .BUF 1>>)>>>
+
+<ROUTINE UNKNOWN-WORD (PTR "AUX" BUF)
+ #DECL ((PTR BUF) FIX)
+ <TELL "I don't know the word '">
+ <WORD-PRINT <GETB <REST ,P-LEXV <SET BUF <* .PTR 2>>> 2>
+ <GETB <REST ,P-LEXV .BUF> 3>>
+ <TELL "'." CR>>
+
+;"Clear out the input table (prior to GROVELing through the input)"
+
+<ROUTINE CLEAR-ITBL ("AUX" (CNT -1))
+ <REPEAT ()
+ <COND (<IGRTR? CNT ,P-ITBLLEN> <RETURN>)
+ (T <PUT ,P-ITBL .CNT 0>)>>>
+
+;" Perform syntax matching operations, using P-ITBL as the source of
+ the verb and adjectives for this input. Returns false if no
+ syntax matches, and does it's own orphaning. If return is true,
+ the syntax is saved in P-SYNTAX."
+
+<GLOBAL P-SLOCBITS 0>
+
+<CONSTANT P-SYNLEN 8>
+
+<CONSTANT P-SBITS 0>
+
+<CONSTANT P-SPREP1 1>
+
+<CONSTANT P-SPREP2 2>
+
+<CONSTANT P-SFWIM1 3>
+
+<CONSTANT P-SFWIM2 4>
+
+<CONSTANT P-SLOC1 5>
+
+<CONSTANT P-SLOC2 6>
+
+<CONSTANT P-SACTION 7>
+
+<CONSTANT P-SONUMS 3>
+
+<ROUTINE SYNTAX-CHECK ("AUX" SYN LEN NUM OBJ (DRIVE1 <>) (DRIVE2 <>) PREP VERB TMP)
+ #DECL ((DRIVE1 DRIVE2) <OR FALSE <PRIMTYPE VECTOR>>
+ (SYN) <PRIMTYPE VECTOR> (LEN NUM VERB PREP) FIX
+ (OBJ) <OR FALSE OBJECT>)
+ <COND (<0? <SET VERB <GET ,P-ITBL ,P-VERB>>>
+ <TELL "You must supply a verb!" CR>
+ <RFALSE>)>
+ <SET SYN <GET ,VERBS <- 255 .VERB>>>
+ <SET LEN <GETB .SYN 0>>
+ <SET SYN <REST .SYN>>
+ <REPEAT ()
+ <SET NUM <BAND <GETB .SYN ,P-SBITS> ,P-SONUMS>>
+ <COND (<AND <NOT <L? .NUM 1>>
+ <0? ,P-NCN>
+ <OR <0? <SET PREP <GET ,P-ITBL ,P-PREP1>>>
+ <==? .PREP <GETB .SYN ,P-SPREP1>>>>
+ <SET DRIVE1 .SYN>)
+ (<==? <GETB .SYN ,P-SPREP1> <GET ,P-ITBL ,P-PREP1>>
+ <COND (<AND <==? .NUM 2> <==? ,P-NCN 1>>
+ <SET DRIVE2 .SYN>)
+ (<==? <GETB .SYN ,P-SPREP2>
+ <GET ,P-ITBL ,P-PREP2>>
+ <SYNTAX-FOUND .SYN>
+ <RTRUE>)>)>
+ <COND (<DLESS? LEN 1>
+ <COND (<OR .DRIVE1 .DRIVE2> <RETURN>)
+ (T
+ <TELL "I don't understand that sentence." CR>
+ <RFALSE>)>)
+ (T <SET SYN <REST .SYN ,P-SYNLEN>>)>>
+ <COND (<AND .DRIVE1
+ <SET OBJ
+ <GWIM <GETB .DRIVE1 ,P-SFWIM1>
+ <GETB .DRIVE1 ,P-SLOC1>
+ <GETB .DRIVE1 ,P-SPREP1>>>>
+ <PUT ,P-PRSO ,P-MATCHLEN 1>
+ <PUT ,P-PRSO 1 .OBJ>
+ <SYNTAX-FOUND .DRIVE1>)
+ (<AND .DRIVE2
+ <SET OBJ
+ <GWIM <GETB .DRIVE2 ,P-SFWIM2>
+ <GETB .DRIVE2 ,P-SLOC2>
+ <GETB .DRIVE2 ,P-SPREP2>>>>
+ <PUT ,P-PRSI ,P-MATCHLEN 1>
+ <PUT ,P-PRSI 1 .OBJ>
+ <SYNTAX-FOUND .DRIVE2>)
+ (T
+ <TELL "You must supply a noun!" CR>
+ <RFALSE>)>>
+
+<ROUTINE SYNTAX-FOUND (SYN)
+ #DECL ((SYN) <PRIMTYPE VECTOR>)
+ <SETG P-SYNTAX .SYN>
+ <SETG PRSA <GETB .SYN ,P-SACTION>>>
+
+<GLOBAL P-GWIMBIT 0>
+
+<ROUTINE GWIM (GBIT LBIT PREP "AUX" OBJ)
+ #DECL ((GBIT LBIT) FIX (OBJ) OBJECT)
+ <COND (<==? .GBIT ,RWATERBIT>
+ <RETURN ,ROOMS>)>
+ <SETG P-GWIMBIT .GBIT>
+ <SETG P-SLOCBITS .LBIT>
+ <PUT ,P-MERGE ,P-MATCHLEN 0>
+ <COND (<GET-OBJECT ,P-MERGE <>>
+ <SETG P-GWIMBIT 0>
+ <COND (<==? <GET ,P-MERGE ,P-MATCHLEN> 1>
+ <SET OBJ <GET ,P-MERGE 1>>
+ <TELL "(">
+ <COND (<NOT <0? .PREP>>
+ <PRINTB <PREP-FIND .PREP>>
+ <COND (<==? .OBJ ,HANDS>
+ <TELL " your hands)" CR>)
+ (T
+ <TELL " the ">)>)>
+ <COND (<NOT <==? .OBJ ,HANDS>>
+ <TELL D .OBJ ")" CR>)>
+ .OBJ)>)
+ (T <SETG P-GWIMBIT 0> <RFALSE>)>>
+
+<ROUTINE PREP-FIND (PREP "AUX" (CNT 0) SIZE)
+ #DECL ((PREP CNT SIZE) FIX)
+ <SET SIZE <* <GET ,PREPOSITIONS 0> 2>>
+ <REPEAT ()
+ <COND (<IGRTR? CNT .SIZE> <RFALSE>)
+ (<==? <GET ,PREPOSITIONS .CNT> .PREP>
+ <RETURN <GET ,PREPOSITIONS <- .CNT 1>>>)>>>
+
+<ROUTINE SNARF-OBJECTS ("AUX" PTR)
+ #DECL ((PTR) <OR FIX <PRIMTYPE VECTOR>>)
+ <COND (<NOT <==? <SET PTR <GET ,P-ITBL ,P-NC1>> 0>>
+ <SETG P-SLOCBITS <GETB ,P-SYNTAX ,P-SLOC1>>
+ <OR <SNARFEM .PTR <GET ,P-ITBL ,P-NC1L> ,P-PRSO> <RFALSE>>
+ <OR <0? <GET ,P-BUTS ,P-MATCHLEN>>
+ <SETG P-PRSO <BUT-MERGE ,P-PRSO>>>)>
+ <COND (<NOT <==? <SET PTR <GET ,P-ITBL ,P-NC2>> 0>>
+ <SETG P-SLOCBITS <GETB ,P-SYNTAX ,P-SLOC2>>
+ <OR <SNARFEM .PTR <GET ,P-ITBL ,P-NC2L> ,P-PRSI> <RFALSE>>
+ <COND (<NOT <0? <GET ,P-BUTS ,P-MATCHLEN>>>
+ <COND (<==? <GET ,P-PRSI ,P-MATCHLEN> 1>
+ <SETG P-PRSO <BUT-MERGE ,P-PRSO>>)
+ (T <SETG P-PRSI <BUT-MERGE ,P-PRSI>>)>)>)>
+ <RTRUE>>
+
+<ROUTINE BUT-MERGE (TBL "AUX" LEN BUTLEN (CNT 1) (MATCHES 0) OBJ NTBL)
+ #DECL ((TBL NTBL) TABLE (LEN BUTLEN MATCHES) FIX (OBJ) OBJECT)
+ <SET LEN <GET .TBL ,P-MATCHLEN>>
+ <PUT ,P-MERGE ,P-MATCHLEN 0>
+ <REPEAT ()
+ <COND (<DLESS? LEN 0> <RETURN>)
+ (<ZMEMQ <SET OBJ <GET .TBL .CNT>> ,P-BUTS>)
+ (T
+ <PUT ,P-MERGE <+ .MATCHES 1> .OBJ>
+ <SET MATCHES <+ .MATCHES 1>>)>
+ <SET CNT <+ .CNT 1>>>
+ <PUT ,P-MERGE ,P-MATCHLEN .MATCHES>
+ <SET NTBL ,P-MERGE>
+ <SETG P-MERGE .TBL>
+ .NTBL>
+
+<GLOBAL P-NAM <>>
+
+<GLOBAL P-ADJ <>>
+
+<GLOBAL P-ADJN <>>
+
+<GLOBAL P-PRSO <ITABLE NONE 20>>
+
+<GLOBAL P-PRSI <ITABLE NONE 20>>
+
+<GLOBAL P-BUTS <ITABLE NONE 50>>
+
+<GLOBAL P-MERGE <ITABLE NONE 50>>
+
+<GLOBAL P-MATCHLEN 0>
+
+<GLOBAL P-GETFLAGS 0>
+
+<CONSTANT P-ALL 1>
+
+<CONSTANT P-ONE 2>
+
+<CONSTANT P-INHIBIT 4>
+
+<ROUTINE SNARFEM (PTR EPTR TBL "AUX" (AND <>) (BUT <>) LEN WV WORD NW)
+ #DECL ((TBL) TABLE (PTR EPTR) <PRIMTYPE VECTOR> (AND) <OR ATOM FALSE>
+ (BUT) <OR FALSE TABLE> (WV) <OR FALSE FIX>)
+ <SETG P-GETFLAGS 0>
+ <PUT ,P-BUTS ,P-MATCHLEN 0>
+ <PUT .TBL ,P-MATCHLEN 0>
+ <SET WORD <GET .PTR 0>>
+ <REPEAT ()
+ <COND (<==? .PTR .EPTR> <RETURN <GET-OBJECT <OR .BUT .TBL>>>)
+ (T
+ <SET NW <GET .PTR ,P-LEXELEN>>
+ <COND (<==? .WORD ,W?ALL>
+ <SETG P-GETFLAGS ,P-ALL>
+ <COND (<==? .NW ,W?OF>
+ <SET PTR <REST .PTR ,P-WORDLEN>>)>)
+ (<EQUAL? .WORD ,W?BUT ,W?EXCEPT>
+ <OR <GET-OBJECT <OR .BUT .TBL>> <RFALSE>>
+ <SET BUT ,P-BUTS>
+ <PUT .BUT ,P-MATCHLEN 0>)
+ (<EQUAL? .WORD ,W?A ,W?ONE>
+ <COND (<NOT ,P-ADJ>
+ <SETG P-GETFLAGS ,P-ONE>
+ <COND (<==? .NW ,W?OF>
+ <SET PTR <REST .PTR ,P-WORDLEN>>)>)
+ (T
+ <SETG P-NAM ,P-ONEOBJ>
+ <OR <GET-OBJECT <OR .BUT .TBL>> <RFALSE>>
+ <AND <0? .NW> <RTRUE>>)>)
+ (<AND <EQUAL? .WORD ,W?AND ,W?COMMA>
+ <NOT <EQUAL? .NW ,W?AND ,W?COMMA>>>
+ <OR <GET-OBJECT <OR .BUT .TBL>> <RFALSE>>
+ T)
+ (<WT? .WORD ,PS?BUZZ-WORD>)
+ (<EQUAL? .WORD ,W?AND ,W?COMMA>)
+ (<==? .WORD ,W?OF>
+ <COND (<0? ,P-GETFLAGS>
+ <SETG P-GETFLAGS ,P-INHIBIT>)>)
+ (<SET WV <WT? .WORD ,PS?ADJECTIVE ,P1?ADJECTIVE>>
+ <SETG P-ADJ .WV>
+ <SETG P-ADJN .WORD>)
+ (<WT? .WORD ,PS?OBJECT ,P1?OBJECT>
+ <SETG P-NAM .WORD>
+ <SETG P-ONEOBJ .WORD>)>)>
+ <COND (<NOT <==? .PTR .EPTR>>
+ <SET PTR <REST .PTR ,P-WORDLEN>>
+ <SET WORD .NW>)>>>
+
+<CONSTANT SH 128>
+
+<CONSTANT SC 64>
+
+<CONSTANT SIR 32>
+
+<CONSTANT SOG 16>
+
+<CONSTANT STAKE 8>
+
+<CONSTANT SMANY 4>
+
+<CONSTANT SHAVE 2>
+
+<ROUTINE GET-OBJECT (TBL
+ "OPTIONAL" (VRB T)
+ "AUX" BITS LEN XBITS TLEN (GCHECK <>))
+ #DECL ((TBL) TABLE (XBITS BITS TLEN LEN) FIX (GWIM) <OR FALSE FIX>
+ (VRB GCHECK) <OR ATOM FALSE>)
+ <SET XBITS ,P-SLOCBITS>
+ <SET TLEN <GET .TBL ,P-MATCHLEN>>
+ <COND (<BTST ,P-GETFLAGS ,P-INHIBIT> <RTRUE>)>
+ <COND (<AND <NOT ,P-NAM> ,P-ADJ <WT? ,P-ADJN ,PS?OBJECT ,P1?OBJECT>>
+ <SETG P-NAM ,P-ADJN>
+ <SETG P-ADJ <>>)>
+ <COND (<AND <NOT ,P-NAM>
+ <NOT ,P-ADJ>
+ <NOT <==? ,P-GETFLAGS ,P-ALL>>
+ <0? ,P-GWIMBIT>>
+ <COND (.VRB
+ <TELL "There is a noun missing." CR>)>
+ <RFALSE>)>
+ <COND (<OR <NOT <==? ,P-GETFLAGS ,P-ALL>> <0? ,P-SLOCBITS>>
+ <SETG P-SLOCBITS -1>)>
+ <SETG P-TABLE .TBL>
+ <PROG ()
+ <COND (.GCHECK <GLOBAL-CHECK .TBL>)
+ (T
+ <COND (,LIT <DO-SL ,HERE ,SOG ,SIR>)>
+ <DO-SL ,WINNER ,SH ,SC>)>
+ <SET LEN <- <GET .TBL ,P-MATCHLEN> .TLEN>>
+ <COND (<BTST ,P-GETFLAGS ,P-ALL>)
+ (<OR <G? .LEN 1>
+ <AND <0? .LEN> <NOT <==? ,P-SLOCBITS -1>>>>
+ <COND (<==? ,P-SLOCBITS -1>
+ <SETG P-SLOCBITS .XBITS>
+ <PUT .TBL
+ ,P-MATCHLEN
+ <- <GET .TBL ,P-MATCHLEN> .LEN>>
+ <AGAIN>)
+ (T
+ <COND (.VRB
+ <TELL "Specify which ">
+ <PRINTB ,P-NAM>
+ <TELL " you mean." CR>)>
+ <SETG P-NAM <>>
+ <SETG P-ADJ <>>
+ <RFALSE>)>)
+ (<AND <0? .LEN> .GCHECK>
+ <COND (.VRB
+ <COND (,LIT
+ <TELL "I can't see any">
+ <COND (,P-ADJ <TELL " "> <PRINTB ,P-ADJN>)>
+ <COND (,P-NAM <TELL " "> <PRINTB ,P-NAM>)>
+ <TELL " here." CR>)
+ (T
+ <TELL "It's too dark to see." CR>)>)>
+ <SETG P-NAM <>>
+ <SETG P-ADJ <>>
+ <RFALSE>)
+ (<0? .LEN> <SET GCHECK T> <AGAIN>)>
+ <SETG P-ADJ <>>
+ <SETG P-NAM <>>
+ <SETG P-SLOCBITS .XBITS>
+ <RTRUE>>>
+
+<ROUTINE GLOBAL-CHECK (TBL "AUX" RMG RMGL (CNT 0) OBJ OBITS FOO)
+ #DECL ((TBL) TABLE (RMG) <OR FALSE TABLE> (RMGL CNT) FIX (OBJ) OBJECT)
+ <SET OBITS ,P-SLOCBITS>
+ <COND (<SET RMG <GETPT ,HERE ,P?GLOBAL>>
+ <SET RMGL <- <PTSIZE .RMG> 1>>
+ <REPEAT ()
+ <COND (<THIS-IT? <SET OBJ <GETB .RMG .CNT>> .TBL>
+ <OBJ-FOUND .OBJ .TBL>)>
+ <COND (<IGRTR? CNT .RMGL> <RETURN>)>>)>
+ <COND (<SET RMG <GETPT ,HERE ,P?PSEUDO>>
+ <SET RMGL <- </ <PTSIZE .RMG> 4> 1>>
+ <SET CNT 0>
+ <REPEAT ()
+ <COND (<==? ,P-NAM <GET .RMG <* .CNT 2>>>
+ <PUTP ,PSEUDO-OBJECT
+ ,P?ACTION
+ <GET .RMG <+ <* .CNT 2> 1>>>
+ <SET FOO
+ <BACK <GETPT ,PSEUDO-OBJECT ,P?ACTION> 5>>
+ <PUT .FOO 0 <GET ,P-NAM 0>>
+ <PUT .FOO 1 <GET ,P-NAM 1>>
+ <OBJ-FOUND ,PSEUDO-OBJECT .TBL>
+ <RETURN>)
+ (<IGRTR? CNT .RMGL> <RETURN>)>>)>
+ <COND (<0? <GET .TBL ,P-MATCHLEN>>
+ <SETG P-SLOCBITS -1>
+ <SETG P-TABLE .TBL>
+ <DO-SL ,GLOBAL-OBJECTS 1 1>
+ <SETG P-SLOCBITS .OBITS>)>>
+
+<ROUTINE DO-SL (OBJ BIT1 BIT2 "AUX" BITS)
+ #DECL ((OBJ) OBJECT (BIT1 BIT2 BITS) FIX)
+ <COND (<BTST ,P-SLOCBITS <+ .BIT1 .BIT2>>
+ <SEARCH-LIST .OBJ ,P-TABLE ,P-SRCALL>)
+ (T
+ <COND (<BTST ,P-SLOCBITS .BIT1>
+ <SEARCH-LIST .OBJ ,P-TABLE ,P-SRCTOP>)
+ (<BTST ,P-SLOCBITS .BIT2>
+ <SEARCH-LIST .OBJ ,P-TABLE ,P-SRCBOT>)
+ (T <RTRUE>)>)>>
+
+<CONSTANT P-SRCBOT 2>
+
+<CONSTANT P-SRCTOP 0>
+
+<CONSTANT P-SRCALL 1>
+
+<ROUTINE SEARCH-LIST (OBJ TBL LVL "AUX" FLS NOBJ)
+ #DECL ((OBJ NOBJ) <OR FALSE OBJECT> (TBL) TABLE (LVL) FIX (FLS) ANY)
+ <COND (<SET OBJ <FIRST? .OBJ>>
+ <REPEAT ()
+ <COND (<AND <NOT <==? .LVL ,P-SRCBOT>>
+ <THIS-IT? .OBJ .TBL>>
+ <OBJ-FOUND .OBJ .TBL>)>
+ <COND (<AND <OR <NOT <==? .LVL ,P-SRCTOP>>
+ <FSET? .OBJ ,SURFACEBIT>>
+ <SET NOBJ <FIRST? .OBJ>>
+ <OR <FSET? .OBJ ,OPENBIT>
+ <FSET? .OBJ ,TRANSBIT>>>
+ <SET FLS
+ <SEARCH-LIST .OBJ
+ .TBL
+ <COND (<FSET? .OBJ ,SURFACEBIT>
+ ,P-SRCALL)
+ (T ,P-SRCTOP)>>>)>
+ <COND (<SET OBJ <NEXT? .OBJ>>) (T <RETURN>)>>)>>
+
+<ROUTINE OBJ-FOUND (OBJ TBL "AUX" PTR)
+ #DECL ((OBJ) OBJECT (TBL) TABLE (PTR) FIX)
+ <SET PTR <GET .TBL ,P-MATCHLEN>>
+ <PUT .TBL <+ .PTR 1> .OBJ>
+ <PUT .TBL ,P-MATCHLEN <+ .PTR 1>>>
+
+<ROUTINE TAKE-CHECK ()
+ <AND <ITAKE-CHECK ,P-PRSO <GETB ,P-SYNTAX ,P-SLOC1>>
+ <ITAKE-CHECK ,P-PRSI <GETB ,P-SYNTAX ,P-SLOC2>>>>
+
+
+<ROUTINE ITAKE-CHECK (TBL BITS "AUX" PTR OBJ TAKEN)
+ #DECL ((TBL) TABLE (BITS PTR) FIX (OBJ) OBJECT
+ (TAKEN) <OR FALSE FIX ATOM>)
+ <COND (<AND <SET PTR <GET .TBL ,P-MATCHLEN>> <BTST .BITS ,STAKE>>
+ <REPEAT ()
+ <COND (<L? <SET PTR <- .PTR 1>> 0> <RETURN>)
+ (T
+ <SET OBJ <GET .TBL <+ .PTR 1>>>
+ <COND (<==? .OBJ ,IT> <SET OBJ ,P-IT-OBJECT>)>
+ <COND (<NOT <IN? .OBJ ,WINNER>>
+ <SETG PRSO .OBJ>
+ <COND (<FSET? .OBJ ,TRYTAKEBIT>
+ <SET TAKEN T>)
+ (<==? <ITAKE <>> T>
+ <SET TAKEN <>>)
+ (T <SET TAKEN T>)>
+ <COND (<AND .TAKEN <BTST .BITS ,SHAVE>>
+ <TELL "You don't have the ">
+ <PRINTD .OBJ>
+ <TELL "." CR>
+ <RFALSE>)
+ (<NOT .TAKEN>
+ <TELL "(Taken)" CR>)>)>)>>)
+ (T)>>
+
+<ROUTINE MANY-CHECK ("AUX" (LOSS <>) TMP)
+ #DECL ((LOSS) <OR FALSE FIX>)
+ <COND (<AND <G? <GET ,P-PRSO ,P-MATCHLEN> 1>
+ <NOT <BTST <GETB ,P-SYNTAX ,P-SLOC1> ,SMANY>>>
+ <SET LOSS 1>)
+ (<AND <G? <GET ,P-PRSI ,P-MATCHLEN> 1>
+ <NOT <BTST <GETB ,P-SYNTAX ,P-SLOC2> ,SMANY>>>
+ <SET LOSS 2>)>
+ <COND (.LOSS
+ <TELL "You can't use multiple objects with '">
+ <SET TMP <GET ,P-ITBL ,P-VERBN>>
+ <COND (,P-OFLAG
+ <PRINTB <GET .TMP 0>>)
+ (T
+ <WORD-PRINT <GETB .TMP 2> <GETB .TMP 3>>)>
+ <TELL "'." CR>
+ <RFALSE>)
+ (T)>>
+
+<ROUTINE ZMEMQ (ITM TBL "OPTIONAL" (SIZE -1) "AUX" (CNT 1))
+ <COND (<NOT .TBL> <RFALSE>)>
+ <COND (<NOT <L? .SIZE 0>> <SET CNT 0>)
+ (ELSE <SET SIZE <GET .TBL 0>>)>
+ <REPEAT ()
+ <COND (<==? .ITM <GET .TBL .CNT>> <RTRUE>)
+ (<IGRTR? CNT .SIZE> <RFALSE>)>>>
+
+<ROUTINE ZMEMQB (ITM TBL SIZE "AUX" (CNT 0))
+ #DECL ((ITM) ANY (TBL) TABLE (SIZE CNT) FIX)
+ <REPEAT ()
+ <COND (<==? .ITM <GETB .TBL .CNT>> <RTRUE>)
+ (<IGRTR? CNT .SIZE> <RFALSE>)>>>
+
+<SETG ALWAYS-LIT <>>
+
+<ROUTINE LIT? (RM "AUX" OHERE (LIT <>))
+ #DECL ((RM OHERE) OBJECT (LIT) <OR ATOM FALSE>)
+ <SETG P-GWIMBIT ,ONBIT>
+ <SET OHERE ,HERE>
+ <SETG HERE .RM>
+ <COND (<OR <FSET? .RM ,ONBIT> ,ALWAYS-LIT> <SET LIT T>)
+ (T
+ <PUT ,P-MERGE ,P-MATCHLEN 0>
+ <SETG P-TABLE ,P-MERGE>
+ <SETG P-SLOCBITS -1>
+ <COND (<==? .OHERE .RM> <DO-SL ,WINNER 1 1>)>
+ <DO-SL .RM 1 1>
+ <COND (<G? <GET ,P-TABLE ,P-MATCHLEN> 0> <SET LIT T>)>)>
+ <SETG HERE .OHERE>
+ <SETG P-GWIMBIT 0>
+ .LIT>
+ \ No newline at end of file
diff --git a/syntax.zil b/syntax.zil
new file mode 100644
index 0000000..293ab3c
--- /dev/null
+++ b/syntax.zil
@@ -0,0 +1,467 @@
+"SUBTITLE VOCABULARY"
+
+<BUZZ A THE IS AND OF THEN ALL ONE BUT EXCEPT \. \, YES NO Y>
+
+<SYNONYM WITH USING THROUGH>
+<SYNONYM IN INSIDE INTO>
+
+<SYNONYM NORTH N>
+<SYNONYM SOUTH S>
+<SYNONYM EAST E>
+<SYNONYM WEST W>
+<SYNONYM DOWN D>
+<SYNONYM UP U>
+<SYNONYM NW NORTHWEST>
+<SYNONYM NE NORTHEAST>
+<SYNONYM SW SOUTHWEST>
+<SYNONYM SE SOUTHEAST>
+
+\
+
+"ZORK game commands"
+
+<SYNTAX BRIEF = V-BRIEF>
+
+<SYNTAX SUPER = V-SUPER-BRIEF>
+<SYNONYM SUPERBRIEF>
+
+<SYNTAX DIAGNOSE = V-DIAGNOSE>
+
+<SYNTAX INVENTORY = V-INVENTORY>
+<SYNONYM INVENTORY I>
+
+<SYNTAX QUIT = V-QUIT>
+<SYNONYM QUIT Q>
+
+<SYNTAX RESTART = V-RESTART>
+
+<SYNTAX RESTORE = V-RESTORE>
+
+
+<SYNTAX SAVE = V-SAVE>
+
+<SYNTAX SCORE = V-SCORE>
+
+<SYNTAX VERSION = V-VERSION>
+
+<SYNTAX VERBOSE = V-VERBOSE>
+
+\
+
+"SUBTITLE REAL VERBS"
+
+<SYNTAX AGAIN = V-AGAIN>
+
+<SYNTAX ATTACK
+ OBJECT (FIND VILLAIN) (ON-GROUND IN-ROOM)
+ WITH
+ OBJECT (FIND WEAPONBIT) (HELD CARRIED HAVE)
+ = V-ATTACK>
+<SYNONYM ATTACK FIGHT HIT>
+
+<SYNTAX BOARD OBJECT (FIND VEHBIT) (ON-GROUND IN-ROOM)
+ = V-BOARD PRE-BOARD>
+
+<SYNTAX BURN
+ OBJECT (FIND BURNBIT) (HELD CARRIED ON-GROUND IN-ROOM)
+ WITH
+ OBJECT (FIND FLAMEBIT) (HELD CARRIED ON-GROUND IN-ROOM HAVE)
+ = V-BURN PRE-BURN>
+<SYNTAX BURN
+ DOWN
+ OBJECT (FIND BURNBIT) (HELD CARRIED ON-GROUND IN-ROOM)
+ WITH
+ OBJECT (FIND FLAMEBIT) (HELD CARRIED ON-GROUND IN-ROOM HAVE)
+ = V-BURN PRE-BURN>
+<SYNONYM BURN IGNITE>
+
+<SYNTAX CLIMB UP OBJECT (FIND CLIMBBIT) (ON-GROUND IN-ROOM) = V-CLIMB-UP>
+<SYNTAX CLIMB DOWN OBJECT (FIND CLIMBBIT) (ON-GROUND IN-ROOM) = V-CLIMB-DOWN>
+<SYNTAX CLIMB OBJECT (FIND CLIMBBIT) (ON-GROUND IN-ROOM) = V-CLIMB-FOO>
+<SYNTAX CLIMB IN OBJECT (FIND VEHBIT) (ON-GROUND IN-ROOM) = V-BOARD PRE-BOARD>
+<SYNTAX CLIMB ON OBJECT (FIND VEHBIT) (ON-GROUND IN-ROOM) = V-CLIMB-ON>
+<SYNONYM CLIMB SIT HATCH>
+
+<SYNTAX CLOSE
+ OBJECT (FIND DOORBIT) (HELD CARRIED ON-GROUND IN-ROOM)
+ = V-CLOSE>
+
+<SYNTAX COUNT OBJECT = V-COUNT>
+<SYNONYM COUNT>
+
+<SYNTAX CROSS OBJECT = V-CROSS>
+<SYNONYM CROSS FORD>
+
+<SYNTAX CUT OBJECT WITH OBJECT (FIND WEAPONBIT) (CARRIED HELD) = V-CUT>
+<SYNONYM CUT SLICE PIERCE>
+
+<SYNTAX DEFLATE OBJECT = V-DEFLATE>
+
+<SYNTAX DIG
+ OBJECT (ON-GROUND IN-ROOM)
+ WITH
+ OBJECT (FIND TOOLBIT) (HELD CARRIED HAVE) = V-DIG PRE-DIG>
+<SYNTAX DIG
+ IN
+ OBJECT (ON-GROUND IN-ROOM)
+ WITH
+ OBJECT (FIND TOOLBIT) (HELD CARRIED HAVE)
+ = V-DIG PRE-DIG>
+
+<SYNTAX DISEMBARK OBJECT (FIND VEHBIT) (ON-GROUND IN-ROOM)
+ = V-DISEMBARK>
+
+<SYNTAX DRINK
+ OBJECT (FIND DRINKBIT) (HELD CARRIED ON-GROUND IN-ROOM)
+ = V-DRINK>
+<SYNONYM DRINK>
+
+<SYNTAX DROP OBJECT (HELD MANY HAVE) = V-DROP ;*>
+<SYNTAX DROP OBJECT (HELD MANY HAVE) DOWN OBJECT = V-PUT PRE-PUT>
+<SYNTAX DROP OBJECT (HELD MANY HAVE) IN OBJECT = V-PUT PRE-PUT>
+<SYNTAX DROP OBJECT (HELD MANY HAVE) ON OBJECT = V-PUT PRE-PUT>
+<SYNONYM DROP POUR>
+
+<SYNTAX EAT
+ OBJECT (FIND FOODBIT) (HELD CARRIED ON-GROUND IN-ROOM TAKE MANY)
+ = V-EAT>
+<SYNONYM EAT TASTE>
+
+<SYNTAX ENTER = V-ENTER>
+<SYNTAX ENTER OBJECT = V-THROUGH>
+
+<SYNTAX EXAMINE OBJECT (HELD CARRIED IN-ROOM ON-GROUND MANY) = V-EXAMINE>
+<SYNTAX EXAMINE IN OBJECT (HELD CARRIED IN-ROOM ON-GROUND MANY)
+ = V-LOOK-INSIDE>
+<SYNONYM EXAMINE DESCRIBE WHAT WHATS>
+
+<SYNTAX EXORCISE OBJECT = V-EXORCISE>
+<SYNTAX EXORCISE OUT OBJECT (FIND VILLAIN) = V-EXORCISE>
+<SYNTAX EXORCISE AWAY OBJECT (FIND VILLAIN) = V-EXORCISE>
+<SYNONYM EXORCISE BANISH CAST DRIVE>
+
+<SYNTAX EXTINGUISH
+ OBJECT (FIND LIGHTBIT) (MANY HELD CARRIED ON-GROUND IN-ROOM TAKE HAVE)
+ = V-LAMP-OFF>
+<SYNONYM EXTINGUISH DOUSE>
+
+<SYNTAX FILL
+ OBJECT (FIND CONTBIT) (HELD CARRIED ON-GROUND IN-ROOM)
+ WITH
+ OBJECT
+ = V-FILL>
+<SYNTAX FILL
+ OBJECT (FIND CONTBIT) (HELD CARRIED ON-GROUND IN-ROOM)
+ = V-FILL>
+
+<SYNTAX FIND OBJECT
+ = V-FIND>
+<SYNONYM FIND WHERE SEEK SEE>
+
+<SYNTAX GIVE
+ OBJECT (MANY HELD CARRIED ON-GROUND IN-ROOM)
+ TO
+ OBJECT (FIND VICBIT) (ON-GROUND)
+ = V-GIVE ;*>
+<SYNTAX GIVE
+ OBJECT (FIND VICBIT) (ON-GROUND)
+ OBJECT (MANY)
+ = V-SGIVE>
+<SYNONYM GIVE>
+
+<SYNTAX HELLO = V-HELLO ;*>
+<SYNTAX HELLO OBJECT = V-HELLO>
+<SYNONYM HELLO HI>
+
+<SYNTAX BLOW OUT OBJECT = V-LAMP-OFF>
+<SYNTAX BLOW UP
+ OBJECT
+ WITH
+ OBJECT (FIND TOOLBIT) (ON-GROUND IN-ROOM HELD CARRIED)
+ = V-INFLATE ;*>
+<SYNTAX BLOW UP OBJECT = V-BLAST>
+<SYNTAX BLOW IN OBJECT = V-BREATHE>
+
+<SYNTAX INFLAT
+ OBJECT
+ WITH
+ OBJECT (FIND TOOLBIT) (ON-GROUND IN-ROOM HELD CARRIED)
+ = V-INFLATE>
+
+<SYNTAX JUMP = V-LEAP>
+<SYNTAX JUMP OVER OBJECT = V-LEAP>
+<SYNTAX JUMP ACROSS OBJECT = V-LEAP>
+<SYNTAX JUMP IN OBJECT = V-LEAP>
+<SYNONYM JUMP LEAP>
+
+<SYNTAX KICK OBJECT = V-KICK>
+<SYNONYM KICK BITE>
+
+<SYNTAX KILL
+ OBJECT (FIND VILLAIN) (ON-GROUND IN-ROOM)
+ WITH
+ OBJECT (FIND WEAPONBIT) (HELD CARRIED HAVE)
+ = V-KILL>
+<SYNONYM KILL STAB>
+
+<SYNTAX KNOCK AT OBJECT = V-KNOCK ;*>
+<SYNTAX KNOCK ON OBJECT = V-KNOCK>
+<SYNTAX KNOCK DOWN OBJECT (FIND VICBIT) (ON-GROUND IN-ROOM) = V-ATTACK>
+<SYNONYM KNOCK>
+
+<SYNTAX LAUNCH OBJECT (FIND VEHBIT) = V-LAUNCH>
+
+<SYNTAX LEAVE = V-LEAVE>
+<SYNTAX LEAVE OBJECT = V-DROP>
+
+<SYNTAX LIGHT
+ OBJECT (FIND LIGHTBIT)
+ (HELD CARRIED ON-GROUND IN-ROOM TAKE HAVE)
+ = V-LAMP-ON ;*>
+<SYNTAX LIGHT
+ OBJECT (FIND LIGHTBIT) (HELD CARRIED ON-GROUND IN-ROOM)
+ WITH
+ OBJECT (FIND FLAMEBIT) (HELD CARRIED TAKE HAVE)
+ = V-BURN PRE-BURN>
+
+<SYNTAX LISTEN TO OBJECT = V-LISTEN>
+<SYNTAX LISTEN FOR OBJECT = V-LISTEN>
+
+<SYNTAX LOOK = V-LOOK>
+<SYNTAX LOOK AROUND OBJECT (FIND RWATERBIT) = V-LOOK>
+<SYNTAX LOOK UP OBJECT (FIND RWATERBIT) = V-LOOK>
+<SYNTAX LOOK DOWN OBJECT (FIND RWATERBIT) = V-LOOK>
+<SYNTAX LOOK AT OBJECT (HELD CARRIED ON-GROUND IN-ROOM MANY) = V-EXAMINE>
+<SYNTAX LOOK WITH OBJECT = V-LOOK-INSIDE>
+<SYNTAX LOOK UNDER OBJECT = V-LOOK-UNDER>
+<SYNTAX LOOK BEHIND OBJECT = V-LOOK-BEHIND>
+<SYNTAX LOOK IN OBJECT (HELD CARRIED ON-GROUND IN-ROOM MANY) = V-LOOK-INSIDE>
+<SYNTAX LOOK AT OBJECT (HELD CARRIED ON-GROUND IN-ROOM MANY) WITH OBJECT = V-READ PRE-READ>
+<SYNTAX LOOK FOR OBJECT = V-FIND>
+<SYNONYM LOOK L STARE GAZE>
+
+<SYNTAX SEARCH OBJECT = V-SEARCH>
+<SYNTAX SEARCH IN OBJECT = V-SEARCH>
+<SYNTAX SEARCH FOR OBJECT = V-FIND>
+
+<SYNTAX LOWER OBJECT = V-LOWER>
+
+<SYNTAX MELT
+ OBJECT
+ WITH
+ OBJECT (FIND FLAMEBIT) (HELD CARRIED ON-GROUND IN-ROOM)
+ = V-MELT>
+<SYNONYM MELT>
+
+<SYNTAX MOVE OBJECT (ON-GROUND IN-ROOM) = V-MOVE PRE-MOVE>
+<SYNTAX ROLL UP OBJECT (ON-GROUND IN-ROOM) = V-MOVE PRE-MOVE>
+<SYNONYM MOVE>
+
+<SYNTAX PULL OBJECT (ON-GROUND IN-ROOM) = V-MOVE PRE-MOVE ; *>
+<SYNTAX PULL ON OBJECT (ON-GROUND IN-ROOM) = V-MOVE PRE-MOVE>
+<SYNONYM PULL TUG>
+
+<SYNTAX MUMBLE = V-MUMBLE>
+<SYNONYM MUMBLE SIGH>
+
+<SYNTAX DESTROY
+ OBJECT (ON-GROUND IN-ROOM HELD CARRIED)
+ WITH
+ OBJECT (HELD CARRIED TAKE)
+ = V-MUNG PRE-MUNG>
+<SYNTAX DESTROY
+ DOWN
+ OBJECT (ON-GROUND IN-ROOM HELD CARRIED)
+ WITH
+ OBJECT (HELD CARRIED TAKE)
+ = V-MUNG PRE-MUNG>
+<SYNONYM DESTROY BREAK SMASH>
+
+<SYNTAX ODYSSEUS = V-ODYSSEUS>
+<SYNONYM ODYSSEUS ULYSSES>
+
+<SYNTAX OPEN
+ OBJECT (FIND DOORBIT) (HELD CARRIED ON-GROUND IN-ROOM)
+ = V-OPEN ;*>
+<SYNTAX OPEN
+ UP
+ OBJECT (FIND DOORBIT) (HELD CARRIED ON-GROUND IN-ROOM)
+ = V-OPEN ;*>
+<SYNTAX OPEN
+ OBJECT (FIND DOORBIT) (HELD CARRIED ON-GROUND IN-ROOM)
+ WITH
+ OBJECT (FIND TOOLBIT) (ON-GROUND IN-ROOM HELD CARRIED HAVE)
+ = V-OPEN>
+
+<SYNTAX PICK UP
+ OBJECT (FIND TAKEBIT)
+ (ON-GROUND MANY)
+ = V-TAKE PRE-TAKE>
+
+<SYNTAX POKE
+ OBJECT (FIND VILLAIN) (ON-GROUND IN-ROOM)
+ WITH
+ OBJECT (FIND WEAPONBIT) (HELD CARRIED HAVE)
+ = V-MUNG PRE-MUNG>
+<SYNONYM POKE BLIND>
+
+<SYNTAX POUR OBJECT (HELD CARRIED) = V-DROP ;*>
+<SYNTAX POUR OBJECT (HELD CARRIED) IN OBJECT = V-DROP>
+<SYNTAX POUR OBJECT (HELD CARRIED) ON OBJECT = V-POUR-ON PRE-POUR-ON>
+<SYNONYM POUR SPILL>
+
+<SYNTAX PRAY = V-PRAY>
+
+<SYNTAX PUMP UP OBJECT = V-PUMP>
+<SYNTAX PUMP UP OBJECT WITH OBJECT = V-PUMP>
+
+<SYNTAX PUSH OBJECT (IN-ROOM ON-GROUND MANY) = V-PUSH>
+<SYNTAX PUSH ON OBJECT (IN-ROOM ON-GROUND MANY) = V-PUSH>
+<SYNTAX PUSH OBJECT UNDER OBJECT = V-PUT-UNDER>
+<SYNONYM PUSH PRESS>
+
+<SYNTAX PUT OBJECT (HELD MANY HAVE) IN OBJECT = V-PUT PRE-PUT ;*>
+<SYNTAX PUT OBJECT (HELD MANY HAVE) ON OBJECT = V-PUT PRE-PUT>
+<SYNTAX PUT DOWN OBJECT (HELD MANY) = V-DROP>
+<SYNTAX PUT OBJECT UNDER OBJECT = V-PUT-UNDER>
+<SYNONYM PUT PLACE>
+
+<SYNTAX RAISE OBJECT = V-RAISE ;*>
+<SYNTAX RAISE UP OBJECT = V-RAISE>
+<SYNONYM RAISE LIFT>
+
+<SYNTAX READ
+ OBJECT (FIND READBIT) (HELD CARRIED ON-GROUND IN-ROOM TAKE)
+ = V-READ PRE-READ ; *>
+
+<SYNTAX RING OBJECT (TAKE) = V-RING ;*>
+<SYNTAX RING OBJECT (TAKE) WITH OBJECT = V-RING>
+<SYNONYM RING PEAL>
+
+<SYNTAX RUB OBJECT = V-RUB>
+<SYNTAX RUB OBJECT WITH OBJECT = V-RUB>
+<SYNONYM RUB TOUCH FEEL>
+
+<SYNTAX SHAKE OBJECT = V-SHAKE>
+
+<SYNTAX SLIDE OBJECT UNDER OBJECT = V-PUT-UNDER>
+
+<SYNTAX SMELL OBJECT = V-SMELL>
+<SYNONYM SMELL SNIFF>
+
+<SYNTAX STRIKE
+ OBJECT (FIND VICBIT) (ON-GROUND IN-ROOM)
+ WITH
+ OBJECT (FIND WEAPONBIT) (HELD CARRIED ON-GROUND IN-ROOM HAVE)
+ = V-ATTACK>
+<SYNTAX STRIKE
+ OBJECT (FIND VICBIT) (ON-GROUND IN-ROOM)
+ = V-ATTACK ;*>
+<SYNTAX STRIKE OBJECT (ON-GROUND IN-ROOM HELD CARRIED) = V-LAMP-ON>
+
+<SYNTAX SWIM = V-SWIM>
+<SYNTAX SWIM IN OBJECT = V-SWIM>
+<SYNONYM SWIM>
+
+<SYNTAX SWING
+ OBJECT (FIND WEAPONBIT) (HELD CARRIED HAVE)
+ AT
+ OBJECT (FIND VILLAIN) (ON-GROUND IN-ROOM)
+ = V-SWING>
+<SYNONYM SWING THRUST>
+
+<SYNTAX TAKE
+ OBJECT (FIND TAKEBIT)
+ (ON-GROUND MANY)
+ = V-TAKE PRE-TAKE ;*>
+<SYNTAX TAKE IN OBJECT (FIND VEHBIT) (ON-GROUND IN-ROOM) = V-BOARD PRE-BOARD>
+<SYNTAX TAKE OUT OBJECT (FIND VEHBIT) (ON-GROUND IN-ROOM) = V-DISEMBARK>
+<SYNTAX TAKE ON OBJECT (FIND VEHBIT) (ON-GROUND IN-ROOM) = V-CLIMB-ON>
+<SYNTAX TAKE
+ OBJECT (FIND TAKEBIT) (CARRIED IN-ROOM MANY)
+ OUT
+ OBJECT
+ = V-TAKE PRE-TAKE>
+<SYNTAX TAKE
+ OBJECT (FIND TAKEBIT) (CARRIED IN-ROOM MANY)
+ OFF
+ OBJECT
+ = V-TAKE PRE-TAKE>
+<SYNTAX TAKE
+ OBJECT (FIND TAKEBIT) (IN-ROOM CARRIED MANY)
+ FROM
+ OBJECT
+ = V-TAKE PRE-TAKE>
+<SYNONYM TAKE GET HOLD CARRY REMOVE>
+
+<SYNTAX THROW
+ OBJECT (HELD CARRIED HAVE)
+ AT
+ OBJECT (FIND VICBIT) (ON-GROUND IN-ROOM)
+ = V-THROW ;*>
+<SYNTAX THROW
+ OBJECT (HELD CARRIED HAVE)
+ WITH
+ OBJECT (FIND VICBIT) (ON-GROUND IN-ROOM)
+ = V-THROW>
+<SYNTAX THROW OBJECT OBJECT = V-OVERBOARD>
+<SYNTAX THROW OBJECT (HELD CARRIED HAVE) IN OBJECT = V-PUT PRE-PUT>
+<SYNTAX THROW OBJECT (HELD CARRIED HAVE) ON OBJECT = V-PUT PRE-PUT>
+<SYNTAX THROW OBJECT (HELD CARRIED HAVE) OVER OBJECT = V-PUT PRE-PUT>
+<SYNONYM THROW>
+
+<SYNTAX TIE OBJECT TO OBJECT = V-TIE PRE-TIE>
+<SYNTAX TIE UP
+ OBJECT (FIND VICBIT) (ON-GROUND IN-ROOM)
+ WITH
+ OBJECT (FIND TOOLBIT) (ON-GROUND IN-ROOM HELD CARRIED HAVE)
+ = V-TIE-UP>
+<SYNONYM TIE FASTEN>
+
+<SYNTAX TURN
+ OBJECT (FIND TURNBIT) ( HELD CARRIED ON-GROUND IN-ROOM)
+ WITH
+ OBJECT (FIND TOOLBIT) (ON-GROUND IN-ROOM HELD CARRIED HAVE)
+ = V-TURN PRE-TURN ;*>
+<SYNTAX TURN ON
+ OBJECT (FIND LIGHTBIT) (HELD CARRIED ON-GROUND IN-ROOM TAKE HAVE)
+ = V-LAMP-ON>
+<SYNTAX TURN OFF
+ OBJECT (FIND LIGHTBIT) (HELD CARRIED ON-GROUND IN-ROOM TAKE HAVE)
+ = V-LAMP-OFF>
+<SYNONYM TURN SHUT>
+
+<SYNTAX UNTIE
+ OBJECT (ON-GROUND IN-ROOM HELD CARRIED)
+ = V-UNTIE PRE-UNTIE ;*>
+<SYNTAX UNTIE
+ OBJECT (ON-GROUND IN-ROOM HELD CARRIED)
+ FROM
+ OBJECT
+ = V-UNTIE PRE-UNTIE>
+<SYNONYM UNTIE>
+
+<SYNTAX WAIT = V-WAIT>
+
+<SYNTAX WAKE OBJECT (FIND VICBIT) (ON-GROUND IN-ROOM) = V-ALARM ;*>
+<SYNTAX WAKE UP OBJECT (FIND VICBIT) (ON-GROUND IN-ROOM) = V-ALARM>
+<SYNONYM WAKE>
+
+<SYNTAX WALK AWAY OBJECT = V-WALK> ;"Crock!"
+<SYNTAX WALK IN OBJECT = V-THROUGH>
+<SYNTAX WALK WITH OBJECT = V-THROUGH>
+<SYNTAX WALK AROUND OBJECT = V-WALK-AROUND>
+<SYNTAX WALK UP OBJECT (FIND CLIMBBIT) (ON-GROUND IN-ROOM) = V-CLIMB-UP>
+<SYNTAX WALK DOWN OBJECT (FIND CLIMBBIT) (ON-GROUND IN-ROOM) = V-CLIMB-DOWN>
+<SYNONYM WALK GO RUN PROCEED>
+
+<SYNTAX WAVE OBJECT (HELD CARRIED) = V-WAVE>
+<SYNONYM WAVE BRANDISH>
+
+<SYNTAX WIND OBJECT = V-WIND>
+<SYNTAX WIND UP OBJECT = V-WIND>
+
+<SYNTAX YELL = V-YELL>
+<SYNONYM YELL SCREAM SHOUT>
+
+
diff --git a/verbs.zil b/verbs.zil
new file mode 100644
index 0000000..b556bb3
--- /dev/null
+++ b/verbs.zil
@@ -0,0 +1,1202 @@
+"SUBTITLE VERB FUNCTIONS"
+
+"SUBTITLE DESCRIBE THE UNIVERSE"
+
+"SUBTITLE SETTINGS FOR VARIOUS LEVELS OF DESCRIPTION"
+
+<GLOBAL VERBOSE <>>
+<GLOBAL SUPER-BRIEF <>>
+<GDECL (VERBOSE SUPER-BRIEF) <OR ATOM FALSE>>
+
+<ROUTINE V-VERBOSE ()
+ <SETG VERBOSE T>
+ <SETG SUPER-BRIEF <>>
+ <TELL "Maximum verbosity." CR>>
+
+<ROUTINE V-BRIEF ()
+ <SETG VERBOSE <>>
+ <SETG SUPER-BRIEF <>>
+ <TELL "Brief descriptions." CR>>
+
+<ROUTINE V-SUPER-BRIEF ()
+ <SETG SUPER-BRIEF T>
+ <TELL "Super-brief descriptions." CR>>
+
+\
+
+"SUBTITLE DESCRIBERS"
+
+<ROUTINE V-LOOK ()
+ <COND (<DESCRIBE-ROOM T>
+ <DESCRIBE-OBJECTS T>)>>
+
+<ROUTINE V-FIRST-LOOK ()
+ <COND (<DESCRIBE-ROOM>
+ <COND (<NOT ,SUPER-BRIEF> <DESCRIBE-OBJECTS>)>)>>
+
+<ROUTINE V-EXAMINE ()
+ <COND (<GETP ,PRSO ,P?TEXT>
+ <TELL <GETP ,PRSO ,P?TEXT> CR>)
+ (<OR <FSET? ,PRSO ,CONTBIT>
+ <FSET? ,PRSO ,DOORBIT>>
+ <V-LOOK-INSIDE>)
+ (ELSE
+ <TELL "There's nothing unusual about it." CR>)>>
+
+<ROUTINE DESCRIBE-ROOM ("OPTIONAL" (LOOK? <>) "AUX" V? STR)
+ <SET V? <OR .LOOK? ,VERBOSE>>
+ <COND (<NOT ,LIT>
+ <TELL
+"It is pitch black. You are likely to be eaten by a grue." CR>
+ <RETURN <>>)>
+ <COND (<OR <NOT <FSET? ,HERE ,TOUCHBIT>>
+ <FSET? ,HERE ,MAZEBIT>>
+ <FSET ,HERE ,TOUCHBIT>
+ <SET V? T>)>
+ <TELL D ,HERE CR>
+ <COND (<OR .LOOK? <NOT ,SUPER-BRIEF>>
+ <COND (<FSET? <LOC ,WINNER> ,VEHBIT>
+ <TELL "(You are in the " D <LOC ,WINNER> ".)" CR>)>
+ <COND (<AND .V? <APPLY <GETP ,HERE ,P?ACTION> ,M-LOOK>>
+ <RTRUE>)
+ (<AND .V? <SET STR <GETP ,HERE ,P?LDESC>>>
+ <TELL .STR CR>)>)>
+ T>
+
+<ROUTINE DESCRIBE-OBJECTS ("OPTIONAL" (V? <>))
+ <COND (,LIT
+ <COND (<FIRST? ,HERE>
+ <PRINT-CONT ,HERE <SET V? <OR .V? ,VERBOSE>> -1>)>)
+ (ELSE
+ <TELL "I can't see in the dark." CR>)>>
+
+"DESCRIBE-OBJECT -- takes object and flag. if flag is true will print a
+long description (fdesc or ldesc), otherwise will print short."
+
+<ROUTINE DESCRIBE-OBJECT (OBJ V? LEVEL "AUX" (STR <>) AV)
+ <COND (<0? .LEVEL>
+ <COND (<OR <AND <NOT <FSET? .OBJ ,TOUCHBIT>>
+ <SET STR <GETP .OBJ ,P?FDESC>>>
+ <SET STR <GETP .OBJ ,P?LDESC>>>
+ <TELL .STR>)
+ (T <TELL "There is a " D .OBJ " here.">)>)
+ (ELSE
+ <TELL <GET ,INDENTS .LEVEL>>
+ <TELL "A " D .OBJ>)>
+ <COND (<AND <0? .LEVEL>
+ <SET AV <LOC ,WINNER>>
+ <FSET? .AV ,VEHBIT>
+ <IN? .OBJ ,HERE>>
+ <TELL " (outside the " D .AV ")">)>
+ <CRLF>
+ <COND (<AND <SEE-INSIDE? .OBJ> <FIRST? .OBJ>>
+ <PRINT-CONT .OBJ .V? .LEVEL>)>>
+
+<ROUTINE PRINT-CONT (OBJ "OPTIONAL" (V? <>) (LEVEL 0)
+ "AUX" Y 1ST? AV STR (PV? <>) (INV? <>))
+ #DECL ((OBJ) OBJECT (LEVEL) FIX)
+ <COND (<NOT <SET Y <FIRST? .OBJ>>> <RTRUE>)>
+ <COND (<AND <SET AV <LOC ,WINNER>> <FSET? .AV ,VEHBIT>>
+ T)
+ (ELSE <SET AV <>>)>
+ <SET 1ST? T>
+ <COND (<EQUAL? ,WINNER .OBJ <LOC .OBJ>>
+ <SET INV? T>)
+ (ELSE
+ <REPEAT ()
+ <COND (<NOT .Y> <RETURN <NOT .1ST?>>)
+ (<==? .Y .AV> <SET PV? T>)
+ (<==? .Y ,WINNER>)
+ (<AND <NOT <FSET? .Y ,INVISIBLE>>
+ <NOT <FSET? .Y ,TOUCHBIT>>
+ <SET STR <GETP .Y ,P?FDESC>>>
+ <COND (<NOT <FSET? .Y ,NDESCBIT>>
+ <TELL .STR CR>)>
+ <COND (<AND <SEE-INSIDE? .Y> <FIRST? .Y>>
+ <PRINT-CONT .Y .V? 0>)>)>
+ <SET Y <NEXT? .Y>>>)>
+ <SET Y <FIRST? .OBJ>>
+ <REPEAT ()
+ <COND (<NOT .Y>
+ <COND (<AND .PV? .AV <FIRST? .AV>>
+ <SET LEVEL <+ .LEVEL 1>>
+ <PRINT-CONT .AV .V? .LEVEL>)>
+ <RETURN <NOT .1ST?>>)
+ (<EQUAL? .Y .AV ,ADVENTURER>)
+ (<AND <NOT <FSET? .Y ,INVISIBLE>>
+ <OR .INV?
+ <FSET? .Y ,TOUCHBIT>
+ <NOT <GETP .Y ,P?FDESC>>>>
+ <COND (<NOT <FSET? .Y ,NDESCBIT>>
+ <COND (.1ST?
+ <FIRSTER .OBJ .LEVEL>
+ <SET LEVEL <+ 1 .LEVEL>>
+ <SET 1ST? <>>)>
+ <DESCRIBE-OBJECT .Y .V? .LEVEL>)
+ (<FIRST? .Y>
+ <SET LEVEL <+ .LEVEL 1>>
+ <PRINT-CONT .Y .V? .LEVEL>)>)>
+ <SET Y <NEXT? .Y>>>>
+
+<ROUTINE FIRSTER (OBJ LEVEL)
+ <COND (<==? .OBJ ,TROPHY-CASE>
+ <TELL "Your treasures are:" CR>)
+ (<==? .OBJ ,WINNER>
+ <TELL "You are carrying:" CR>)
+ (<NOT <IN? .OBJ ,ROOMS>>
+ <COND (<G? .LEVEL 0>
+ <TELL <GET ,INDENTS .LEVEL>>)>
+ <COND (<FSET? .OBJ ,SURFACEBIT>
+ <TELL "Sitting on the " D .OBJ
+ " is: " CR>)
+ (ELSE
+ <TELL "The " D .OBJ
+ " contains:" CR>)>)>>
+
+\
+
+"SUBTITLE SCORING"
+
+<GLOBAL MOVES 0>
+<GLOBAL SCORE 0>
+<GLOBAL BASE-SCORE 0>
+
+<ROUTINE SCORE-UPD (NUM)
+ #DECL ((NUM) FIX)
+ <SETG BASE-SCORE <+ ,BASE-SCORE .NUM>>
+ <SETG SCORE <+ ,SCORE .NUM>>
+ <COND (<AND <NOT <L? ,SCORE ,SCORE-MAX>> <NOT ,WON-FLAG>>
+ <SETG WON-FLAG T>
+ <FCLEAR ,MAP ,INVISIBLE>
+ <FCLEAR ,WEST-OF-HOUSE ,TOUCHBIT>
+ <TELL
+"An almost inaudible voice whispers in your ear, \"Look to your treasures
+for the final secret.\"" CR>)>
+ T>
+
+<ROUTINE SCORE-OBJ (OBJ "AUX" TEMP)
+ #DECL ((OBJ) OBJECT (TEMP) FIX)
+ <COND (<G? <SET TEMP <GETP .OBJ ,P?VALUE>> 0>
+ <SCORE-UPD .TEMP>
+ <PUTP .OBJ ,P?VALUE 0>)>>
+
+<GLOBAL SCORE-MAX 350>
+
+<ROUTINE V-SCORE ("OPTIONAL" (ASK? T))
+ #DECL ((ASK?) <OR ATOM FALSE>)
+ <TELL "Your score is ">
+ <TELL N ,SCORE>
+ <TELL " (total of ">
+ <TELL N ,SCORE-MAX>
+ <TELL " points), in ">
+ <TELL N ,MOVES>
+ <COND (<1? ,MOVES> <TELL " move.">) (ELSE <TELL " moves.">)>
+ <CRLF>>
+
+<ROUTINE FINISH ()
+ <V-SCORE>
+ <QUIT>>
+
+<ROUTINE V-QUIT ("OPTIONAL" (ASK? T) "AUX" SCOR)
+ #DECL ((ASK?) <OR ATOM <PRIMTYPE LIST>> (SCOR) FIX)
+ <V-SCORE>
+ <COND (<OR <AND .ASK?
+ <TELL
+"Do you wish to leave the game? (Y/N): ">
+ <YES?>>
+ <NOT .ASK?>>
+ <QUIT>)
+ (ELSE <TELL "Ok." CR>)>>
+
+<ROUTINE YES? ()
+ <PRINTI ">">
+ <READ ,P-INBUF ,P-LEXV>
+ <COND (<EQUAL? <GET ,P-LEXV 1> ,W?YES ,W?Y>
+ <RTRUE>)
+ (T
+ <RFALSE>)>>
+
+<GLOBAL COPYRIGHT-YEAR 1982>
+
+<ROUTINE V-VERSION ("AUX" (CNT 17))
+ <TELL
+"ZORK: The Great Underground Empire|
+Copyright " N ,COPYRIGHT-YEAR " by Infocom, Inc.|
+All rights reserved.|
+ZORK is a trademark of Infocom, Inc.|
+Release ">
+ <PRINTN <BAND <GET 0 1> *3777*>>
+ <CRLF>>
+
+<ROUTINE V-AGAIN ("AUX" OBJ)
+ <SET OBJ
+ <COND (<AND ,L-PRSO <NOT <LOC ,L-PRSO>>>
+ ,L-PRSO)
+ (<AND ,L-PRSI <NOT <LOC ,L-PRSI>>>
+ ,L-PRSI)>>
+ <COND (.OBJ
+ <TELL "I can't see the " D .OBJ " anymore." CR>
+ <RFATAL>)
+ (T
+ <PERFORM ,L-PRSA ,L-PRSO ,L-PRSI>)>>
+
+\
+
+"SUBTITLE DEATH AND TRANSFIGURATION"
+
+<GLOBAL DEAD <>>
+<GLOBAL DEATHS 0>
+
+<ROUTINE JIGS-UP (DESC "OPTIONAL" (PLAYER? <>))
+ #DECL ((DESC) STRING (PLAYER?) <OR ATOM FALSE>)
+ <TELL .DESC CR>
+ <PROG ()
+ <SCORE-UPD -10>
+ <TELL "
+| **** You have died ****
+|
+|">
+ <COND
+ (<NOT <L? ,DEATHS 2>>
+ <TELL
+"You clearly are a suicidal maniac. We don't allow psychotics in the
+cave, since they may harm other adventurers. Sorry." CR>
+ <FINISH>)
+ (T
+ <SETG DEATHS <+ ,DEATHS 1>>
+ <MOVE ,WINNER ,HERE>
+ <TELL
+"Now, let's take a look here...|
+Well, you probably deserve another chance. I can't quite fix you
+up completely, but you can't have everything." CR>
+ <FCLEAR ,TRAP-DOOR ,TOUCHBIT>
+ <SETG P-CONT <>>
+ <RANDOMIZE-OBJECTS>
+ <KILL-INTERRUPTS>)>>>
+
+<ROUTINE KILL-INTERRUPTS ()
+ <DISABLE <INT I-XB>>
+ <DISABLE <INT I-XC>>
+ <DISABLE <INT I-CYCLOPS>>
+ <DISABLE <INT I-LANTERN>>
+ <DISABLE <INT I-SWORD>>
+ <DISABLE <INT I-FOREST-ROOM>>
+ <RTRUE>>
+
+<ROUTINE RANDOMIZE-OBJECTS ("AUX" (R <>) F N L)
+ <COND (<IN? ,LAMP ,WINNER>
+ <MOVE ,LAMP ,LIVING-ROOM>)>
+ <COND (<IN? ,COFFIN ,WINNER>
+ <MOVE ,COFFIN ,EGYPT-ROOM>)>
+ <PUTP ,SWORD ,P?TVALUE 0>
+ <SET N <FIRST? ,WINNER>>
+ <SET L <GET ,ABOVE-GROUND 0>>
+ <REPEAT ()
+ <SET F .N>
+ <COND (<NOT .F> <RETURN>)>
+ <SET N <NEXT? .F>>
+ <COND (<G? <GETP .F ,P?TVALUE> 0>
+ <REPEAT ()
+ <COND (<NOT .R> <SET R <FIRST? ,ROOMS>>)>
+ <COND (<AND <FSET? .R ,RLANDBIT>
+ <NOT <FSET? .R ,ONBIT>>
+ <PROB 50>>
+ <MOVE .F .R>
+ <RETURN>)
+ (ELSE <SET R <NEXT? .R>>)>>)
+ (ELSE
+ <MOVE .F <GET ,ABOVE-GROUND <RANDOM .L>>>)>>>
+
+<ROUTINE V-RESTORE ()
+ <COND (<RESTORE>
+ <TELL "Ok." CR>
+ <V-FIRST-LOOK>)
+ (T
+ <TELL "Failed." CR>)>>
+
+<ROUTINE V-SAVE ()
+ <COND (<SAVE>
+ <TELL "Ok." CR>)
+ (T
+ <TELL "Failed." CR>)>>
+
+<ROUTINE V-RESTART ()
+ <V-SCORE T>
+ <TELL "Are you sure (Y/N): ">
+ <COND (<YES?>
+ <RESTART>)>>
+
+<CONSTANT REXIT 0>
+<CONSTANT UEXIT 1>
+<CONSTANT NEXIT 2>
+<CONSTANT FEXIT 3>
+<CONSTANT CEXIT 4>
+<CONSTANT DEXIT 5>
+
+<CONSTANT NEXITSTR 0>
+<CONSTANT FEXITFCN 0>
+<CONSTANT CEXITFLAG 1>
+<CONSTANT CEXITSTR 1>
+<CONSTANT DEXITOBJ 1>
+<CONSTANT DEXITSTR 1>
+
+<ROUTINE V-WALK-AROUND ()
+ <TELL "Use directions to move." CR>>
+
+<ROUTINE V-LAUNCH ()
+ <YUK>>
+
+<ROUTINE YUK () <TELL <PICK-ONE ,YUKS> CR>>
+
+<ROUTINE GO-NEXT (TBL "AUX" VAL)
+ #DECL ((TBL) TABLE (VAL) ANY)
+ <COND (<SET VAL <LKP ,HERE .TBL>>
+ <GOTO .VAL>)>>
+
+<ROUTINE LKP (ITM TBL "AUX" (CNT 0) (LEN <GET .TBL 0>))
+ #DECL ((ITM) ANY (TBL) TABLE (CNT LEN) FIX)
+ <REPEAT ()
+ <COND (<G? <SET CNT <+ .CNT 1>> .LEN>
+ <RFALSE>)
+ (<==? <GET .TBL .CNT> .ITM>
+ <COND (<==? .CNT .LEN> <RFALSE>)
+ (T
+ <RETURN <GET .TBL <+ .CNT 1>>>)>)>>>
+
+<ROUTINE V-WALK ("AUX" PT PTS STR OBJ RM)
+ #DECL ((PT) <OR FALSE TABLE> (PTS) FIX (STR) <OR STRING FALSE>
+ (OBJ) OBJECT (RM) <OR FALSE OBJECT>)
+ <COND (<SET PT <GETPT ,HERE ,PRSO>>
+ <COND (<==? <SET PTS <PTSIZE .PT>> ,UEXIT>
+ <GOTO <GETB .PT ,REXIT>>)
+ (<==? .PTS ,NEXIT>
+ <TELL <GET .PT ,NEXITSTR> CR>
+ <RFATAL>)
+ (<==? .PTS ,FEXIT>
+ <COND (<SET RM <APPLY <GET .PT ,FEXITFCN>>>
+ <GOTO .RM>)
+ (T
+ <RFATAL>)>)
+ (<==? .PTS ,CEXIT>
+ <COND (<VALUE <GETB .PT ,CEXITFLAG>>
+ <GOTO <GETB .PT ,REXIT>>)
+ (<SET STR <GET .PT ,CEXITSTR>>
+ <TELL .STR CR>
+ <RFATAL>)
+ (T
+ <TELL "You can't go that way." CR>
+ <RFATAL>)>)
+ (<==? .PTS ,DEXIT>
+ <COND (<FSET? <SET OBJ <GETB .PT ,DEXITOBJ>> ,OPENBIT>
+ <GOTO <GETB .PT ,REXIT>>)
+ (<SET STR <GET .PT ,DEXITSTR>>
+ <TELL .STR CR>
+ <RFATAL>)
+ (T
+ <TELL "The " D .OBJ " is closed." CR>
+ <RFATAL>)>)>)
+ (<AND <NOT ,LIT>
+ <PROB 75>>
+ <JIGS-UP
+"Oh, no! You have walked into the fangs of a lurking grue!">)
+ (T
+ <TELL "You can't go that way." CR>
+ <RFATAL>)>>
+
+<ROUTINE V-INVENTORY ()
+ <COND (<FIRST? ,WINNER> <PRINT-CONT ,WINNER>)
+ (T <TELL "You are empty handed." CR>)>>
+
+<GLOBAL INDENTS
+ <TABLE "" " " " " " ">>
+
+\
+
+<ROUTINE PRE-TAKE ()
+ <COND (<IN? ,PRSO ,WINNER> <TELL "You already have it." CR>)
+ (<AND <FSET? <LOC ,PRSO> ,CONTBIT>
+ <NOT <FSET? <LOC ,PRSO> ,OPENBIT>>>
+ <TELL "I can't reach that." CR>
+ <RTRUE>)
+ (,PRSI
+ <COND (<AND <==? ,PRSI ,GROUND> <IN? ,PRSO ,HERE>>
+ <SETG PRSI <>>
+ <RFALSE>)
+ (<NOT <==? ,PRSI <LOC ,PRSO>>>
+ <TELL "It's not in that!" CR>)
+ (T
+ <SETG PRSI <>>
+ <RFALSE>)>)
+ (<==? ,PRSO <LOC ,WINNER>> <TELL "You're in it!" CR>)>>
+
+<ROUTINE V-TAKE ()
+ <COND (<==? <ITAKE> T>
+ <TELL "Taken." CR>)>>
+
+<ROUTINE ITAKE ("OPTIONAL" (VB T) "AUX" CNT OBJ)
+ #DECL ((VB) <OR ATOM FALSE> (CNT) FIX (OBJ) OBJECT)
+ <COND (<NOT <FSET? ,PRSO ,TAKEBIT>>
+ <COND (.VB <YUK>)>
+ <RFALSE>)
+ (<AND <NOT <IN? <LOC ,PRSO> ,WINNER>>
+ <G? <+ <WEIGHT ,PRSO> <WEIGHT ,WINNER>> ,LOAD-ALLOWED>>
+ <COND (.VB
+ <TELL "Your load is too heavy">
+ <COND (<L? ,LOAD-ALLOWED ,LOAD-MAX>
+ <TELL
+", especially in light of your condition.">)
+ (ELSE <TELL ".">)>
+ <CRLF>)>
+ <RFATAL>)
+ (<AND <G? <SET CNT <CCOUNT ,WINNER>> 7>
+ <PROB <* .CNT 8>>>
+ <SET OBJ <FIRST? ,WINNER>>
+ <SET OBJ <NEXT? .OBJ>>
+ ;"This must go! Chomping compiler strikes again"
+ <TELL "Oh, no. The " D .OBJ
+ " slips from your arms while taking the "
+ D ,PRSO "
+and both tumble to the ground." CR>
+ <PERFORM ,V?DROP .OBJ>
+ <RFATAL>)
+ (T
+ <MOVE ,PRSO ,WINNER>
+ <FSET ,PRSO ,TOUCHBIT>
+ <SCORE-OBJ ,PRSO>
+ <RTRUE>)>>
+
+<ROUTINE PRE-PUT ()
+ <COND (<OR <IN? ,PRSO ,GLOBAL-OBJECTS>
+ <NOT <FSET? ,PRSO ,TAKEBIT>>>
+ <YUK>)>>
+
+<ROUTINE V-PUT ()
+ <COND (<OR <FSET? ,PRSI ,OPENBIT>
+ <OPENABLE? ,PRSI>
+ <FSET? ,PRSI ,VEHBIT>>)
+ (T
+ <TELL "I can't do that." CR>
+ <RTRUE>)>
+ <COND (<NOT <FSET? ,PRSI ,OPENBIT>>
+ <TELL "The " D ,PRSI " isn't open." CR>)
+ (<==? ,PRSI ,PRSO>
+ <YUK>)
+ (<IN? ,PRSO ,PRSI>
+ <TELL "It's already there!" CR>)
+ (<G? <+ <- <WEIGHT ,PRSI> <GETP ,PRSI ,P?SIZE>>
+ <WEIGHT ,PRSO>>
+ <GETP ,PRSI ,P?CAPACITY>>
+ <TELL "There's no room." CR>)
+ (<AND <NOT <HELD? ,PRSO>>
+ <FSET? ,PRSO ,TRYTAKEBIT>>
+ <TELL "You don't have the " D ,PRSO "." CR>
+ <RTRUE>)
+ (<AND <NOT <HELD? ,PRSO>>
+ <NOT <ITAKE>>>
+ <RTRUE>)
+ (T
+ <SCORE-OBJ ,PRSO>
+ <MOVE ,PRSO ,PRSI>
+ <FSET ,PRSO ,TOUCHBIT>
+ <TELL "Done." CR>)>>
+
+<ROUTINE PRE-DROP ()
+ <COND (<==? ,PRSO <LOC ,WINNER>>
+ <PERFORM ,V?DISEMBARK ,PRSO>
+ <RTRUE>)>>
+
+<ROUTINE V-GIVE ()
+ <COND (<NOT <FSET? ,PRSI ,VICBIT>>
+ <TELL "You can't give a " D ,PRSO " to a " D ,PRSI "!" CR>)
+ (<IDROP> <TELL "Given." CR>)>>
+
+<ROUTINE V-SGIVE ()
+ <PERFORM ,V?GIVE ,PRSI ,PRSO>>
+
+<ROUTINE V-DROP () <COND (<IDROP> <TELL "Dropped." CR>)>>
+
+<ROUTINE V-THROW () <COND (<IDROP> <TELL "Thrown." CR>)>>
+
+<ROUTINE V-OVERBOARD ("AUX" LOCN)
+ #DECL ((LOCN) OBJECT)
+ <COND (<==? ,PRSI ,OVERBOARD>
+ <COND (<FSET? <SET LOCN <LOC ,WINNER>> ,VEHBIT>
+ <MOVE ,PRSO <LOC .LOCN>>
+ <TELL D ,PRSO " overboard!" CR>)
+ (ELSE <YUK>)>)
+ (T <TELL "Huh?" CR>)>>
+
+<ROUTINE IDROP
+ ()
+ <COND (<AND <NOT <IN? ,PRSO ,WINNER>> <NOT <IN? <LOC ,PRSO> ,WINNER>>>
+ <TELL "You're not carrying the " D ,PRSO "." CR>
+ <RFALSE>)
+ (<AND <NOT <IN? ,PRSO ,WINNER>>
+ <NOT <FSET? <LOC ,PRSO> ,OPENBIT>>>
+ <TELL "The " D ,PRSO " is closed." CR>
+ <RFALSE>)
+ (T <MOVE ,PRSO <LOC ,WINNER>> <RTRUE>)>>
+
+\
+
+<ROUTINE V-OPEN ("AUX" F STR)
+ <COND (<NOT <FSET? ,PRSO ,CONTBIT>>
+ <TELL "How does one open a " D ,PRSO "?" CR>)
+ (<NOT <==? <GETP ,PRSO ,P?CAPACITY> 0>>
+ <COND (<FSET? ,PRSO ,OPENBIT> <TELL "It is already open." CR>)
+ (T
+ <FSET ,PRSO ,OPENBIT>
+ <COND (<OR <NOT <FIRST? ,PRSO>> <FSET? ,PRSO ,TRANSBIT>>
+ <TELL "Opened." CR>)
+ (<AND <SET F <FIRST? ,PRSO>>
+ <NOT <NEXT? .F>>
+ <SET STR <GETP .F ,P?FDESC>>>
+ <TELL "The " D ,PRSO " opens." CR>
+ <TELL .STR CR>)
+ (T
+ <TELL "Opening the " D ,PRSO " reveals ">
+ <PRINT-CONTENTS ,PRSO>
+ <TELL "." CR>)>)>)
+ (T <TELL "The " D ,PRSO " cannot be opened." CR>)>>
+
+<ROUTINE PRINT-CONTENTS (OBJ "AUX" F N (1ST? T))
+ #DECL ((OBJ) OBJECT (F N) <OR FALSE OBJECT>)
+ <COND (<SET F <FIRST? .OBJ>>
+ <REPEAT ()
+ <SET N <NEXT? .F>>
+ <COND (.1ST? <SET 1ST? <>>)
+ (ELSE
+ <TELL ", ">
+ <COND (<NOT .N> <TELL "and ">)>)>
+ <TELL "a " D .F>
+ <SET F .N>
+ <COND (<NOT .F> <RETURN>)>>)>>
+
+<ROUTINE V-CLOSE ()
+ <COND (<NOT <FSET? ,PRSO ,CONTBIT>>
+ <TELL "You can't do that!" CR>)
+ (<FSET? ,PRSO ,OPENBIT>
+ <TELL "Closed." CR>
+ <FCLEAR ,PRSO ,OPENBIT>)
+ (T <TELL "It is already." CR>)>>
+
+<ROUTINE CCOUNT (OBJ "AUX" (CNT 0) X)
+ <COND (<SET X <FIRST? .OBJ>>
+ <REPEAT ()
+ <SET CNT <+ .CNT 1>>
+ <COND (<NOT <SET X <NEXT? .X>>>
+ <RETURN>)>>)>
+ .CNT>
+
+"WEIGHT: Get sum of SIZEs of supplied object, recursing to the nth level."
+
+<ROUTINE WEIGHT
+ (OBJ "AUX" CONT (WT 0))
+ #DECL ((OBJ) OBJECT (CONT) <OR FALSE OBJECT> (WT) FIX)
+ <COND (<SET CONT <FIRST? .OBJ>>
+ <REPEAT ()
+ <SET WT <+ .WT <WEIGHT .CONT>>>
+ <COND (<NOT <SET CONT <NEXT? .CONT>>> <RETURN>)>>)>
+ <+ .WT <GETP .OBJ ,P?SIZE>>>
+
+<ROUTINE PRE-MOVE
+ ()
+ <COND (<NOT <IN? ,PRSO ,HERE>> <TELL "I don't juggle objects!" CR>)>>
+
+<ROUTINE V-MOVE ()
+ <COND (<FSET? ,PRSO ,TAKEBIT>
+ <TELL "Moving the " D ,PRSO " reveals nothing." CR>)
+ (T <TELL "You can't move the " D ,PRSO "." CR>)>>
+
+<ROUTINE V-LAMP-ON
+ ()
+ <COND (<FSET? ,PRSO ,LIGHTBIT>
+ <COND (<FSET? ,PRSO ,ONBIT> <TELL "It is already on." CR>)
+ (ELSE
+ <FSET ,PRSO ,ONBIT>
+ <TELL "The " D ,PRSO " is now on." CR>
+ <COND (<NOT ,LIT>
+ <SETG LIT <LIT? ,HERE>>
+ <V-LOOK>)>)>)
+ (T
+ <TELL "You can't turn that on." CR>)>
+ <RTRUE>>
+
+<ROUTINE V-LAMP-OFF
+ ()
+ <COND (<FSET? ,PRSO ,LIGHTBIT>
+ <COND (<NOT <FSET? ,PRSO ,ONBIT>>
+ <TELL "It is already off." CR>)
+ (ELSE
+ <FCLEAR ,PRSO ,ONBIT>
+ <COND (,LIT
+ <SETG LIT <LIT? ,HERE>>)>
+ <TELL "The " D ,PRSO " is now off." CR>
+ <COND (<NOT <SETG LIT <LIT? ,HERE>>>
+ <TELL "It is now pitch black." CR>)>)>)
+ (ELSE <TELL "You can't turn that off." CR>)>
+ <RTRUE>>
+
+<ROUTINE V-WAIT ("OPTIONAL" (NUM 3))
+ #DECL ((NUM) FIX)
+ <TELL "Time passes..." CR>
+ <REPEAT ()
+ <COND (<L? <SET NUM <- .NUM 1>> 0> <RETURN>)
+ (<CLOCKER> <RETURN>)>
+ <SETG MOVES <+ ,MOVES 1>>>
+ <SETG CLOCK-WAIT T>>
+
+<ROUTINE PRE-BOARD
+ ("AUX" AV)
+ <SET AV <LOC ,WINNER>>
+ <COND (<FSET? ,PRSO ,VEHBIT>
+ <COND (<NOT <IN? ,PRSO ,HERE>>
+ <TELL "The "
+ D
+ ,PRSO
+ " must be on the ground." CR>)
+ (<FSET? .AV ,VEHBIT>
+ <TELL "You are already in it!" CR>)
+ (T <RFALSE>)>)
+ (T <YUK>)>
+ <RFATAL>>
+
+<ROUTINE V-BOARD
+ ("AUX" AV)
+ #DECL ((AV) OBJECT)
+ <TELL "You are now in the " D ,PRSO "." CR>
+ <MOVE ,WINNER ,PRSO>
+ <APPLY <GETP ,PRSO ,P?ACTION> ,M-ENTER>
+ <RTRUE>>
+
+<ROUTINE V-DISEMBARK
+ ()
+ <COND (<NOT <==? <LOC ,WINNER> ,PRSO>>
+ <TELL "You're not in that!" CR>
+ <RFATAL>)
+ (<FSET? ,HERE ,RLANDBIT>
+ <TELL "You are on your feet again." CR>
+ <MOVE ,WINNER ,HERE>)
+ (T
+ <TELL
+"You realize that getting out would probably be fatal." CR>
+ <RFATAL>)>>
+
+<ROUTINE V-BREATHE ()
+ <PERFORM ,V?INFLATE ,PRSO ,LUNGS>>
+
+<ROUTINE GOTO (RM "OPTIONAL" (V? T)
+ "AUX" (LB <FSET? .RM ,RLANDBIT>) (WLOC <LOC ,WINNER>)
+ (AV <>) OLIT)
+ #DECL ((RM WLOC) OBJECT (LB) <OR ATOM FALSE> (AV) <OR FALSE FIX>)
+ <SET OLIT ,LIT>
+ <COND (<FSET? .WLOC ,VEHBIT>
+ <SET AV <GETP .WLOC ,P?VTYPE>>)>
+ <COND (<OR <AND <NOT .LB> <OR <NOT .AV> <NOT <FSET? .RM .AV>>>>
+ <AND <FSET? ,HERE ,RLANDBIT>
+ .LB
+ .AV
+ <NOT <==? .AV ,RLANDBIT>>
+ <NOT <FSET? .RM .AV>>>>
+ <COND (.AV <TELL "You can't go there in a " D .WLOC ".">)
+ (T <TELL "You can't go there without a vehicle.">)>
+ <CRLF>
+ <RFALSE>)
+ (<FSET? .RM ,RMUNGBIT> <TELL <GETP .RM ,P?LDESC> CR> <RFALSE>)
+ (T
+ <COND (.AV <MOVE .WLOC .RM>)
+ (T
+ <MOVE ,WINNER .RM>)>
+ <SETG HERE .RM>
+ <SETG LIT <LIT? ,HERE>>
+ <COND (<AND <NOT .OLIT> <NOT ,LIT> <PROB 75>>
+ <JIGS-UP
+"Oh, no! A lurking grue slithered into the room and devoured you!">)
+ (ELSE
+ <COND (<NOT ,LIT>
+ <TELL
+"You have moved into a dark place." CR>)>
+ <APPLY <GETP ,HERE ,P?ACTION> ,M-ENTER>
+ <SCORE-OBJ .RM>
+ <COND (.V? <V-FIRST-LOOK>)>
+ <RTRUE>)>)>>
+
+<ROUTINE PRE-POUR-ON
+ ()
+ <COND (<==? ,PRSO ,WATER> <RFALSE>)
+ (T <TELL "You can't." CR> <RTRUE>)>>
+
+<ROUTINE V-POUR-ON
+ ()
+ <REMOVE ,PRSO>
+ <COND (<FLAMING? ,PRSI>
+ <COND (<==? ,PRSI ,TORCH>
+ <TELL "The water evaporates before it gets close.">)
+ (T <TELL "The " D ,PRSI " is extinguished.">)>
+ <CRLF>
+ <RTRUE>)
+ (T
+ <TELL "The water spills over the "
+ D
+ ,PRSI
+ " and to the floor where it evaporates." CR>)>>
+
+<ROUTINE PRE-FILL
+ ("AUX" T)
+ #DECL ((T) <OR FALSE TABLE>)
+ <COND (<AND <NOT ,PRSI> <SET T <GETPT ,HERE ,P?GLOBAL>>>
+ <COND (<ZMEMQB ,GLOBAL-WATER .T <PTSIZE .T>>
+ <SETG PRSI ,GLOBAL-WATER>
+ <RFALSE>)
+ (T
+ <TELL ,NOFILL CR>
+ <RTRUE>)>)>
+ <COND (<NOT <EQUAL? ,PRSI ,WATER ,GLOBAL-WATER>>
+ <PERFORM ,V?PUT ,PRSI ,PRSO>
+ <RTRUE>)>>
+
+<GLOBAL NOFILL "There is nothing to fill it with.">
+
+<ROUTINE V-FILL ()
+ <COND (<NOT ,PRSI>
+ <COND (<GLOBAL-IN? ,GLOBAL-WATER ,HERE>
+ <PERFORM ,V?FILL ,PRSO ,GLOBAL-WATER>)
+ (T
+ <TELL ,NOFILL CR>)>)
+ (T <YUK>)>>
+
+<ROUTINE V-ODYSSEUS ()
+ <COND (<AND <==? ,HERE ,CYCLOPS-ROOM> <IN? ,CYCLOPS ,HERE>>
+ <DISABLE <INT I-CYCLOPS>>
+ <SETG CYCLOPS-FLAG T>
+ <TELL
+"The cyclops, hearing the name of his father's deadly nemesis, flees the room
+by knocking down the wall on the east of the room." CR>
+ <SETG MAGIC-FLAG T>
+ <FCLEAR ,CYCLOPS ,FIGHTBIT>
+ <REMOVE ,CYCLOPS>)
+ (T <TELL "Wasn't he a sailor?" CR>)>>
+
+<ROUTINE V-RING
+ ()
+ <COND (<==? ,PRSO ,BELL> <TELL "Ding, dong.">)
+ (ELSE <YUK>)>
+ <CRLF>>
+
+<ROUTINE V-DRINK ()
+ <V-EAT>>
+
+<ROUTINE V-EAT ("AUX" (EAT? <>) (DRINK? <>) (NOBJ <>))
+ #DECL ((NOBJ) <OR OBJECT FALSE> (EAT? DRINK?) <OR ATOM FALSE>)
+ <COND (<AND <SET EAT? <FSET? ,PRSO ,FOODBIT>> <IN? ,PRSO ,WINNER>>
+ <COND (<VERB? DRINK> <TELL "How can I drink that?">)
+ (ELSE
+ <TELL "Thank you. It really hit the spot.">
+ <REMOVE ,PRSO>)>
+ <CRLF>)
+ (<SET DRINK? <FSET? ,PRSO ,DRINKBIT>>
+ <COND (<OR <IN? ,PRSO ,GLOBAL-OBJECTS>
+ <AND <SET NOBJ <LOC ,PRSO>>
+ <IN? .NOBJ ,WINNER>
+ <FSET? .NOBJ ,OPENBIT>>>
+ <TELL
+"Thank you very much. I was rather thirsty." CR>
+ <REMOVE ,PRSO>)
+ (T <TELL "I can't get to it." CR>)>)
+ (<NOT <OR .EAT? .DRINK?>>
+ <TELL "I don't think the "
+ D
+ ,PRSO
+ " would agree with you." CR>)>>
+
+<ROUTINE V-LISTEN ()
+ <TELL "The " D ,PRSO " makes no sound." CR>>
+
+<ROUTINE V-PRAY
+ ()
+ <COND (<==? ,HERE ,SOUTH-TEMPLE>
+ <GOTO ,FOREST-1>)
+ (T
+ <TELL
+"Your prayers may be someday answered." CR>)>>
+
+<ROUTINE V-LEAP
+ ("AUX" T S)
+ #DECL ((T) <OR FALSE TABLE>)
+ <COND (,PRSO
+ <COND (<IN? ,PRSO ,HERE>
+ <COND (<FSET? ,PRSO ,VILLAIN>
+ <TELL "The "
+ D
+ ,PRSO
+ " is too big to jump over." CR>)
+ (T <YUK>)>)
+ (T <TELL "That would be a good trick." CR>)>)
+ (<SET T <GETPT ,HERE ,P?DOWN>>
+ <SET S <PTSIZE .T>>
+ <COND (<OR <==? .S 2> ;NEXIT
+ <AND <==? .S 4> ;CEXIT
+ <NOT <VALUE <GETB .T 1>>>>>
+ <TELL "It would be suicidal." CR>)
+ (ELSE <V-SKIP>)>)
+ (ELSE <V-SKIP>)>>
+
+<ROUTINE V-LEAVE () <PERFORM ,V?WALK ,P?OUT>>
+
+<GLOBAL HS 0>
+
+<ROUTINE V-HELLO
+ ()
+ <COND (,PRSO
+ <COND (<==? ,PRSO ,SAILOR>
+ <SETG HS <+ ,HS 1>>
+ <COND (<0? <MOD ,HS 15>>
+ <TELL "You seem to be repeating yourself." CR>)
+ (ELSE <TELL "Nothing happens here." CR>)>)
+ (<FSET? ,PRSO ,VILLAIN>
+ <TELL "The "
+ D
+ ,PRSO
+ " bows to you." CR>)
+ (ELSE
+ <TELL
+"I think only schizophrenics say 'Hello' to a "
+ D
+ ,PRSO
+ "." CR>)>)
+ (ELSE <TELL "Good day." CR>)>>
+
+<ROUTINE PRE-READ ()
+ <COND (<NOT ,LIT> <TELL "You can't read in the dark." CR>)>>
+
+<ROUTINE V-READ ()
+ <COND (<NOT <FSET? ,PRSO ,READBIT>>
+ <TELL "How can I read a " D ,PRSO "?" CR>)
+ (ELSE <TELL <GETP ,PRSO ,P?TEXT> CR>)>>
+
+<ROUTINE V-LOOK-UNDER () <TELL "There is nothing but dust there." CR>>
+
+<ROUTINE V-LOOK-BEHIND () <TELL "There is nothing behind the " D ,PRSO "." CR>>
+
+<ROUTINE V-LOOK-INSIDE
+ ()
+ <COND (<FSET? ,PRSO ,DOORBIT>
+ <COND (<FSET? ,PRSO ,OPENBIT>
+ <TELL "The "
+ D
+ ,PRSO
+ " is open, but I can't tell what's beyond it.">)
+ (ELSE <TELL "The " D ,PRSO " is closed.">)>
+ <CRLF>)
+ (<FSET? ,PRSO ,CONTBIT>
+ <COND (<SEE-INSIDE? ,PRSO>
+ <COND (<AND <FIRST? ,PRSO> <PRINT-CONT ,PRSO>>
+ <RTRUE>)
+ (T
+ <TELL "The " D ,PRSO " is empty." CR>)>)
+ (ELSE <TELL "The " D ,PRSO " is closed." CR>)>)
+ (ELSE <TELL "I can't look inside a " D ,PRSO "." CR>)>>
+
+<ROUTINE SEE-INSIDE? (OBJ)
+ <AND <NOT <FSET? .OBJ ,INVISIBLE>>
+ <OR <FSET? .OBJ ,TRANSBIT> <FSET? .OBJ ,OPENBIT>>>>
+<ROUTINE PRE-BURN ()
+ <COND (<FLAMING? ,PRSI> <RFALSE>)
+ (T <TELL "With a " D ,PRSI "??!?" CR>)>>
+
+<ROUTINE V-BURN
+ ()
+ <COND (<FSET? ,PRSO ,BURNBIT>
+ <COND (<IN? ,PRSO ,WINNER>
+ <REMOVE ,PRSO>
+ <TELL "The " D ,PRSO " catches fire." CR>
+ <JIGS-UP
+"Unfortunately, you were holding it at the time.">)
+ (T
+ <REMOVE ,PRSO>
+ <TELL "The " D ,PRSO " is consumed by fire." CR>)
+ (ELSE <TELL "You don't have that." CR>)>)
+ (T <TELL "You can't burn a " D ,PRSO "." CR>)>>
+
+<ROUTINE PRE-TURN
+ ()
+ <COND (<NOT <FSET? ,PRSO ,TURNBIT>> <TELL "You can't turn that!" CR>)
+ (<NOT ,PRSI>
+ <TELL "You need a tool." CR>)
+ (<NOT <FSET? ,PRSI ,TOOLBIT>>
+ <TELL "You can't turn it with a " D ,PRSI "." CR>)>>
+
+<ROUTINE V-TURN () <TELL "This has no effect." CR>>
+
+<ROUTINE V-PUMP
+ ()
+ <COND (<AND ,PRSI <NOT <==? ,PRSI ,PUMP>>>
+ <TELL "Pump it up with a " D ,PRSI "?" CR>)
+ (<IN? ,PUMP ,WINNER>
+ <PERFORM ,V?INFLATE ,PRSO ,PUMP>)
+ (T <TELL "I really don't see how." CR>)>>
+
+<ROUTINE V-INFLATE () <YUK>>
+
+<ROUTINE V-DEFLATE () <YUK>>
+
+<ROUTINE V-CUT ()
+ <COND (<FSET? ,PRSO ,VILLAIN>
+ <PERFORM ,V?KILL ,PRSO ,PRSI>)
+ (<AND <FSET? ,PRSO ,BURNBIT>
+ <FSET? ,PRSI ,WEAPONBIT>>
+ <REMOVE ,PRSO>
+ <TELL "You slice it into tiny bits which disappear!" CR>)
+ (<NOT <FSET? ,PRSI ,WEAPONBIT>>
+ <TELL "Not so sharp." CR>)
+ (T
+ <YUK>)>>
+
+<ROUTINE V-KILL ()
+ <IKILL "kill">>
+
+<ROUTINE IKILL (STR)
+ #DECL ((STR) STRING)
+ <COND (<NOT ,PRSO> <TELL "There is nothing to " .STR "." CR>)
+ (<AND <NOT <FSET? ,PRSO ,VILLAIN>>
+ <NOT <FSET? ,PRSO ,VICBIT>>>
+ <TELL "I've known weirdos, but fighting a "
+ D
+ ,PRSO
+ "?" CR>)
+ (<OR <NOT ,PRSI> <EQUAL? ,PRSI ,HANDS>>
+ <TELL "Trying to "
+ .STR
+ " a "
+ D
+ ,PRSO
+ " with your hands is suicidal." CR>)
+ (<NOT <FSET? ,PRSI ,WEAPONBIT>>
+ <TELL "Trying to "
+ .STR
+ " the "
+ D
+ ,PRSO
+ " with a "
+ D
+ ,PRSI
+ " is suicidal." CR>)
+ (ELSE <HERO-BLOW>)>>
+
+<ROUTINE V-ATTACK () <IKILL "attack">>
+
+<ROUTINE V-SWING ()
+ <COND (<NOT ,PRSI>
+ <TELL "Whoosh!" CR>)
+ (T
+ <PERFORM ,V?ATTACK ,PRSI ,PRSO>)>>
+
+<ROUTINE V-KICK () <HACK-HACK "Kicking the ">>
+
+<ROUTINE V-WAVE () <HACK-HACK "Waving the ">>
+
+<ROUTINE V-RAISE () <HACK-HACK "Playing in this way with the ">>
+
+<ROUTINE V-LOWER () <HACK-HACK "Playing in this way with the ">>
+
+<ROUTINE V-RUB () <HACK-HACK "Fiddling with the ">>
+
+<ROUTINE V-PUSH () <HACK-HACK "Pushing the ">>
+
+<ROUTINE PRE-MUNG ()
+ <COND (<NOT <FSET? ,PRSO ,VICBIT>>
+ <HACK-HACK "Trying to destroy the ">)
+ (<NOT ,PRSI>
+ <TELL "Trying to destroy the "
+ D
+ ,PRSO
+ " with your bare hands is suicidal." CR>)
+ (<NOT <FSET? ,PRSI ,WEAPONBIT>>
+ <TELL "Trying to destroy the "
+ D
+ ,PRSO
+ " with a "
+ D
+ ,PRSI
+ " is useless." CR>)>>
+
+<ROUTINE V-MUNG () <HERO-BLOW>>
+
+<ROUTINE HACK-HACK
+ (STR)
+ #DECL ((STR) STRING)
+ <TELL .STR D ,PRSO <PICK-ONE ,HO-HUM> CR>>
+
+<GLOBAL HO-HUM
+ <LTABLE
+ " doesn't work."
+ " has no effect.">>
+
+<ROUTINE WORD-TYPE
+ (OBJ WORD "AUX" SYNS)
+ #DECL ((OBJ) OBJECT (WORD SYNS) TABLE)
+ <ZMEMQ .WORD
+ <SET SYNS <GETPT .OBJ ,P?SYNONYM>>
+ <- </ <PTSIZE .SYNS> 2> 1>>>
+
+<ROUTINE V-KNOCK
+ ()
+ <COND (<WORD-TYPE ,PRSO ,W?DOOR>
+ <TELL "Nobody's home." CR>)
+ (ELSE <YUK>)>>
+
+<ROUTINE V-YELL () <TELL "Aaaarrrrgggghhhh!" CR>>
+
+<ROUTINE V-EXORCISE () <TELL "What a bizarre concept!" CR>>
+
+<ROUTINE V-SHAKE ("AUX" X)
+ <COND (<FSET? ,PRSO ,VILLAIN>
+ <YUK>)
+ (<NOT <FSET? ,PRSO ,TAKEBIT>>
+ <TELL "You don't have it." CR>)
+ (<AND <NOT <FSET? ,PRSO ,OPENBIT>>
+ <FIRST? ,PRSO>>
+ <TELL "There's something in the "
+ D
+ ,PRSO
+ "."
+ CR>)
+ (<AND <FSET? ,PRSO ,OPENBIT> <FIRST? ,PRSO>>
+ <WHY>)>>
+
+<ROUTINE PRE-DIG
+ ()
+ <COND (<NOT ,PRSI> <SETG PRSI ,HANDS>)>
+ <COND (<==? ,PRSI ,SHOVEL> <RFALSE>)
+ (<FSET? ,PRSI ,TOOLBIT>
+ <TELL "Digging with the " D ,PRSI " is slow and tedious." CR>)
+ (ELSE <YUK>)>>
+
+<ROUTINE V-DIG () <RTRUE>>
+
+<ROUTINE V-SMELL () <TELL "It smells like a " D ,PRSO "." CR>>
+
+<ROUTINE GLOBAL-IN? (OBJ1 OBJ2 "AUX" T)
+ #DECL ((OBJ1 OBJ2) OBJECT (T) <OR FALSE TABLE>)
+ <COND (<SET T <GETPT .OBJ2 ,P?GLOBAL>>
+ <ZMEMQB .OBJ1 .T <PTSIZE .T>>)>>
+
+<ROUTINE V-SWIM ()
+ <TELL "This is an adventure, not a vacation!" CR>>
+
+<ROUTINE PRE-UNTIE ()
+ <COND (<NOT <==? ,PRSO ,ROPE>>
+ <TELL "It's not tied!" CR>)>>
+
+<ROUTINE V-UNTIE () <RTRUE>>
+
+<ROUTINE PRE-TIE
+ ()
+ <COND (<NOT <==? ,PRSO ,ROPE>>
+ <TELL "How can you tie that to anything." CR>)
+ (<==? ,PRSI ,WINNER>
+ <TELL "You can't tie the rope to yourself." CR>)>>
+
+<ROUTINE V-TIE () <TELL "You can't tie the " D ,PRSO " to that." CR>>
+
+<ROUTINE V-TIE-UP
+ ()
+ <COND (<==? ,PRSI ,ROPE>
+ <COND (<FSET? ,PRSO ,VILLAIN>
+ <COND (<L? <GETP ,PRSO ,P?STRENGTH> 0>
+ <TELL
+"Your attempt to tie up the " D ,PRSO " awakens him.">
+ <AWAKEN ,PRSO>)
+ (ELSE
+ <TELL
+"The " D ,PRSO " struggles and you cannot tie him up." CR>)>)
+ (ELSE <WHY>)>)
+ (ELSE <TELL "You'd never tie it with that!" CR>)>>
+
+<ROUTINE WHY () <TELL "What on earth for?" CR>>
+
+<ROUTINE V-MELT () <TELL "It's not frozen!" CR>>
+
+<ROUTINE V-MUMBLE ()
+ <TELL "I can't hear you!" CR>>
+
+<ROUTINE V-ALARM ()
+ <COND (<FSET? ,PRSO ,VILLAIN>
+ <COND (<L? <GETP ,PRSO ,P?STRENGTH> 0>
+ <TELL "The " D ,PRSO " is rudely awakened." CR>
+ <AWAKEN ,PRSO>)
+ (T
+ <TELL "He's wide awake, or haven't you noticed..."
+ CR>)>)
+ (ELSE
+ <TELL "The " D ,PRSO " isn't sleeping." CR>)>>
+
+<ROUTINE MUNG-ROOM (RM STR)
+ #DECL ((STR) STRING)
+ <FSET .RM ,RMUNGBIT>
+ <PUTP .RM ,P?LDESC .STR>>
+
+<ROUTINE V-COMMAND ()
+ <COND (<FSET? ,PRSO ,VICBIT>
+ <TELL "The " D ,PRSO " pays no attention." CR>)
+ (ELSE
+ <TELL "You cannot talk to that!" CR>)>>
+
+<ROUTINE V-CLIMB-ON ()
+ <COND (<FSET? ,PRSO ,VEHBIT>
+ <V-CLIMB-UP ,P?UP T>)
+ (T
+ <TELL "You can't climb onto the " D ,PRSO "." CR>)>>
+
+<ROUTINE V-CLIMB-FOO () <V-CLIMB-UP ,P?UP T>>
+
+<ROUTINE V-CLIMB-UP ("OPTIONAL" (DIR ,P?UP) (OBJ <>) "AUX" X)
+ #DECL ((DIR) FIX (OBJ) <OR ATOM FALSE> (X) TABLE)
+ <COND (<GETPT ,HERE .DIR>
+ <PERFORM ,V?WALK .DIR>
+ <RTRUE>)
+ (<NOT .OBJ>
+ <TELL "You can't go that way." CR>)
+ (<AND .OBJ
+ <ZMEMQ ,W?WALL
+ <SET X <GETPT ,PRSO ,P?SYNONYM>> <PTSIZE .X>>>
+ <TELL "Climbing the walls is to no avail." CR>)
+ (ELSE <TELL "Bizarre!" CR>)>>
+
+<ROUTINE V-CLIMB-DOWN () <V-CLIMB-UP ,P?DOWN>>
+
+<ROUTINE V-WIND ()
+ <TELL "You cannot wind up a " D ,PRSO "." CR>>
+
+<ROUTINE V-COUNT ("AUX" OBJS CNT)
+ #DECL ((CNT) FIX)
+ <COND (<==? ,PRSO ,LEAVES>
+ <TELL "There are 69,105 leaves here." CR>)
+ (T
+ <WHY>)>>
+
+<ROUTINE V-PUT-UNDER ()
+ <TELL "You can't do that." CR>>
+
+<ROUTINE V-ENTER ()
+ <PERFORM ,V?WALK ,P?IN>>
+
+<ROUTINE V-THROUGH ("OPTIONAL" (OBJ <>))
+ <COND (<AND <NOT .OBJ> <FSET? ,PRSO ,VEHBIT>>
+ <PERFORM ,V?BOARD ,PRSO>)
+ (<AND <NOT .OBJ> <NOT <FSET? ,PRSO ,TAKEBIT>>>
+ <TELL "You hit your head on the "
+ D ,PRSO " in your attempt." CR>)
+ (.OBJ <TELL "You can't do that!">)
+ (<IN? ,PRSO ,WINNER>
+ <TELL "That would be quite a contortion!" CR>)
+ (ELSE <YUK>)>>
+
+<ROUTINE V-CROSS ()
+ <TELL "You can't cross that!" CR>>
+
+<ROUTINE V-SEARCH ()
+ <TELL "You find nothing unusual." CR>>
+
+<ROUTINE V-FIND ()
+ <TELL "You're the adventurer." CR>>
diff --git a/x.mid b/x.mid
new file mode 100644
index 0000000..f154527
--- /dev/null
+++ b/x.mid
@@ -0,0 +1,3839 @@
+TITLE ZAP -- Z-Language Assembler
+
+; ZAP version 3 - Expanded word table to 96 words
+; MARC/JMB - 1/7/82
+
+ .DECSAV
+
+SUBTTL ACS
+
+ O=0
+ A=1
+ B=2
+ C=3
+ D=4
+ E=5
+ F=6
+ G=7
+ H=10
+ I=11
+ J=12 ;called J only during word-frequency pass
+;acs below this point are used for special purposes
+ AB=12 ;pointer into argument table ARGBUF
+ Z=13 ;pointer into output buffer OUTBUF
+ ZPC=14 ;pc
+ FREE=15 ;free storage pointer for symbol tables
+ TP=16 ;pointer into token table TOKENS
+ P=17 ;stack
+
+;bits in symbol table words
+%UNDEF==400000 ;undefined symbol; right half will be ptr to references
+%VAR==200000 ;symbol is a variable
+%BITS==600000 ;all defined bits in symbol table
+
+;bits in reference words
+%RBYTE==400000 ;byte refs are flagged
+%RJUMP==200000 ;as are jump refs
+
+;random macros
+DEFINE MSG M
+ HRROI A,[ASCIZ /!M!/]
+TERMIN
+
+DEFINE NXTARG N
+ ADD TP,[<2*N>,,<2*N>]
+TERMIN
+
+ LOC 140
+
+SUBTTL PSEUDO-OPS AND OPCODES
+
+%PSEUD==400000 ;pseudo-op
+
+;pseudo-op definition macro
+DEFINE DISP SYM
+ 440700,,[ASCIZ /.!SYM/]
+ %PSEUD,,Z!SYM
+TERMIN
+
+%PRED==200000 ;predicate inst.
+%VAL==100000 ;value inst.
+%JUMP==40000 ;jump inst.
+%STR==20000 ;string instr.
+%XARG==10000 ;??
+
+;opcode definition macro
+DEFINE DEFOP OP,OPCODE,FLAGS
+ 440700,,[ASCIZ /OP/]
+ FLAGS,,OPCODE
+TERMIN
+SUBTTL PSEUDOS
+
+OPS:
+PSUTBL: DISP BYTE
+ DISP END
+ DISP ENDI
+ DISP ENDT
+ DISP EQUAL
+ DISP FALSE
+ DISP FSTR
+ DISP FUNCT
+ DISP GSTR
+ DISP GVAR
+ DISP INSERT
+ DISP LEN
+ DISP OBJECT
+ DISP PDEF
+ DISP PROP
+ DISP SEQ
+ DISP STR
+ DISP STRL
+ DISP TABLE
+ DISP TRUE
+ DISP WORD
+ DISP ZWORD
+OPRTBL: DEFOP ADD,20.,%VAL
+ DEFOP BAND,9.,%VAL
+ DEFOP BCOM,143.,%VAL
+ DEFOP BOR,8.,%VAL
+ DEFOP BTST,7.,%PRED
+ DEFOP CALL,224.,%VAL
+ DEFOP CRLF,187.
+ DEFOP DEC,134.
+ DEFOP DIV,23.,%VAL
+ DEFOP DLESS?,4.,%PRED
+ DEFOP EQUAL?,1.,%PRED+%XARG
+ DEFOP FCLEAR,12.
+ DEFOP FIRST?,130.,%PRED+%VAL
+ DEFOP FSET,11.
+ DEFOP FSET?,10.,%PRED
+ DEFOP FSTACK,185.
+ DEFOP GET,15.,%VAL
+ DEFOP GETB,16.,%VAL
+ DEFOP GETP,17.,%VAL
+ DEFOP GETPT,18.,%VAL
+ DEFOP GRTR?,3.,%PRED
+ DEFOP IGRTR?,5.,%PRED
+ DEFOP IN?,6.,%PRED
+ DEFOP INC,133.
+ DEFOP JUMP,140.,%JUMP
+OPJMP=.-1 ;full opcode for jump
+ DEFOP LESS?,2.,%PRED
+ DEFOP LOC,131.,%VAL
+ DEFOP MOD,24.,%VAL
+ DEFOP MOVE,14.
+ DEFOP MUL,22.,%VAL
+ DEFOP NEXT?,129.,%PRED+%VAL
+ DEFOP NEXTP,19.,%VAL
+ DEFOP NOOP,180.
+ DEFOP POP,233.
+ DEFOP PRINT,141.
+ DEFOP PRINTB,135.
+ DEFOP PRINTC,229.
+ DEFOP PRINTD,138.
+ DEFOP PRINTI,178.,%STR
+ DEFOP PRINTN,230.
+ DEFOP PRINTR,179.,%STR
+ DEFOP PTSIZE,132.,%VAL
+ DEFOP PUSH,232.
+ DEFOP PUT,225.
+ DEFOP PUTB,226.
+ DEFOP PUTP,227.
+ DEFOP QUIT,186.
+ DEFOP RANDOM,231.,%VAL
+ DEFOP READ,228.
+ DEFOP REMOVE,137.
+ DEFOP RESTART,183.
+ DEFOP RESTORE,182.,%PRED
+ DEFOP RETURN,139.
+ DEFOP RFALSE,177.
+ DEFOP RSTACK,184.
+ DEFOP RTRUE,176.
+ DEFOP SAVE,181.,%PRED
+ DEFOP SET,13.
+ DEFOP SUB,21.,%VAL
+ DEFOP USL,188.
+ DEFOP VALUE,142.,%VAL
+ DEFOP VERIFY,189.,%PRED
+ DEFOP ZERO?,128.,%PRED
+
+OPCNT==<.-OPS>/2 ;number of pseudos and operators altogether
+
+SUBTTL START UP -- READ JCL AND OPEN INPUT FILE
+
+START: RESET
+ MOVE P,[-77,,PDL]
+ SETZ A,
+ RSCAN
+ JFCL
+ JUMPE A,NOJCL ; NO JCL, FLUSH
+
+;read jcl line
+ MOVN C,A
+ MOVEI A,.PRIIN
+ MOVE B,[440700,,FILBUF]
+ SIN ; READ JCL
+
+;parse jcl line
+ MOVE B,[440700,,FILBUF]
+NAMLOP: ILDB A,B
+ CAILE A,40
+ JRST NAMLOP
+NAMDON: CAIE A,^M
+ CAIN A,^J
+ JRST NOJCL
+ MOVEM B,FILPTR ;should be file spec start
+ ILDB A,B
+ CAIL A,40
+ JRST .-2
+ MOVEI A,0
+ DPB A,B
+ MOVE B,FILPTR
+ PUSHJ P,OPEN ;open file
+ JRST BEGIN
+
+;here if no jcl, read file name from tty
+NOJCL: PUSHJ P,TOPEN
+ JRST BEGIN
+
+SUBTTL FILE NAME READING AND FILE OPENING
+
+OPEN: PUSHJ P,FOPEN
+ JRST TOPEN ;open failed, try from tty
+ POPJ P,
+
+;read file name from tty
+TOPEN: MSG [
+File: ]
+ PSOUT
+ MOVEI A,GTJFNT
+ MOVEI B,0
+ PUSHJ P,FOPEN1
+ JRST TOPEN
+ POPJ P,
+
+;open a file
+; b/ file name
+;skips if wins
+FOPEN: MOVEI A,GTJFNB
+ PUSH P,B
+ GTJFN
+ SKIPA
+ JRST FOPEN2
+ MOVEI A,GTJFNX
+ MOVE B,(P)
+ JRST FOPEN0
+
+FOPEN1: PUSH P,B
+FOPEN0: GTJFN
+ JRST NOFILE
+FOPEN2: TLZ A,-1
+ MOVEM A,IJFN ; SAVE CURRENT INPUT JFN
+ MOVE B,[070000,,240000]
+ OPENF ; HAS TO BE OPEN
+ JRST NOFIL1
+ POP P,B
+ AOS (P)
+ POPJ P,
+
+;gtjfn failed for some reason
+NOFILE: MOVE B,A
+ MSG [Open failed?]
+NOFIL4: PSOUT
+ POP P,C
+ JUMPE C,NOFIL3
+ MSG [ (]
+ PSOUT
+ MOVE A,C
+NOFIL2: PSOUT
+ MSG [)]
+ PSOUT
+NOFIL3: MSG [: ]
+ PSOUT
+
+;print error string
+ERPRNT: HRRZI A,-1
+ HRLI B,400000
+ MOVEI C,0
+ ERSTR ; PRINT ERROR
+ POPJ P, ;UNDEFINED ERROR.
+ POPJ P, ;CHOMPING DEST.
+ POPJ P, ;WON.
+ POPJ P,
+
+;openf failed for some reason
+NOFIL1: MOVE B,A
+ MSG [Can't OPENF file?]
+ JRST NOFIL4
+
+
+SUBTTL BEGIN ASSEMBLING
+
+;print filename being assembled
+BEGIN: SKIPN DOFREQ
+ JRST BEGINF
+ MSG [Counting ]
+ SKIPA
+BEGINF: MSG [Assembling ]
+ PUSHJ P,PFNAME ;tell name of file being read
+
+;find out release number since it's alway wrong in the ZAP file
+ MSG [Time Mode?: ]
+ PSOUT
+ PBIN
+ SETZ B,
+ CAIE A,"T
+ CAIN A,"Y
+ JRST [TRO B,%TIMESL
+ MSG [ <yes>]
+ JRST .+2]
+ MSG [ <no>]
+ PSOUT
+ PUSHJ P,PCRLF
+; MSG [Byte Swapped?: ]
+; PSOUT
+; PBIN
+; CAIE A,"T
+; CAIN A,"Y
+; TRO B,%BYTSWP
+; PUSHJ P,PCRLF
+ MOVEM B,FLGWRD
+ MSG [Release: ]
+ PSOUT
+ MOVEI A,.PRIIN
+ MOVEI C,10.
+ SETOM RELEAS
+ NIN
+ JRST GETFNM ;lost, use default
+ JUMPL B,GETFNM
+ MOVEM B,RELEAS ;save and use instead of supplied
+
+;get goodies so can open correct output file
+GETFNM: MOVE A,OUTPTR
+ MOVE B,IJFN
+ MOVE C,[222000,,JS%PAF] ;output dev:<dir>name.
+ JFNS
+ MOVEM A,OUTPTR ;save for outputting other exts.
+ SKIPE DOFREQ
+ JRST BEGLUP ;do frequency assembly
+
+ MOVE Z,[441000,,OUTBUF] ;byte ptr to output buffer
+ MOVEI ZPC,0 ;pc initially zero
+ PUSHJ P,SCRIPT ;open script channel if asked
+ PUSHJ P,GLBINI ;initialize global symbol table
+ PUSHJ P,LCLINI ;initialize local symbol table
+
+;here to create references to the first n words, which are special
+ MOVE A,ZAPID
+ PUSHJ P,OUTBYT
+ MOVE A,FLGWRD
+ PUSHJ P,OUTBYT
+ SKIPGE A,RELEAS ;user gave a release number?
+ JRST NORELE
+ PUSHJ P,OUTWRD
+ JRST DEFWDS
+
+NORELE: HRROI B,[ASCIZ /.WORD ZORKID
+/]
+ HRROI A,BUFFER
+ MOVEI C,0
+ SOUT
+ PUSHJ P,ASSEM
+
+;output always defined words
+DEFWDS: HRROI B,[ASCIZ /.WORD ENDLOD,START,VOCAB,OBJECT,GLOBAL,IMPURE,0,0,0,0,WORDS
+/]
+ HRROI A,BUFFER ;copy to buffer
+ MOVEI C,0
+ SOUT
+ PUSHJ P,ASSEM ;assemble it
+
+BEGWDS: MOVEI A,0
+ PUSHJ P,OUTWRD
+ CAIGE ZPC,100
+ JRST BEGWDS
+
+BEGLUP: PUSHJ P,RDLINE ;read a line, no skip if done
+ JRST DONE
+ SKIPE PDEBUG
+ PUSHJ P,PINPUT
+ PUSHJ P,ASSEM ;assemble line
+ SKIPE PDEBUG
+ CAMN Z,SAVZ
+ JRST BEGLUP
+ PUSHJ P,OPC
+ JRST BEGLUP
+
+PINPUT: PUSH P,A
+ PUSH P,B
+ PUSH P,C
+ MOVE A,PDEBUG
+ MOVEI C,0
+ HRROI B,[ASCIZ /
+ ;/]
+ SOUT
+ HRROI B,BUFFER
+ SOUT ;print it (for debugging)
+ MOVEM ZPC,SAVZPC
+ MOVEM Z,SAVZ
+ JRST POPCBA
+
+SUBTTL DONE - FINISH UP, PRINT STATS, ETC.
+
+DONE: SKIPE DOFREQ
+ JRST FILEND
+ PUSHJ P,UNDGLB ;print undefined globals
+ MSG [
+]
+ PSOUT
+ MOVEI A,.PRIOU
+ MOVE B,ZPC
+ MOVEI C,10.
+ NOUT
+ JFCL
+ MSG [ bytes.
+]
+ PSOUT
+ MOVEI A,.PRIOU
+ MOVE B,OBJTOT
+ MOVEI C,10.
+ NOUT
+ JFCL
+ MSG [ objects.
+]
+ PSOUT
+ MOVEI A,.PRIOU
+ MOVE B,GLBTOT
+ MOVEI C,10.
+ NOUT
+ JFCL
+ MSG [ globals.
+]
+ PSOUT
+ SKIPE TWOPAS ;don't bother if two pass assembly
+ JRST OUTPUT
+ MOVEI A,.PRIOU
+ MOVE B,SHRIMP
+ MOVEI C,10.
+ NOUT
+ JFCL
+ MSG [ wasted long jumps.
+]
+ PSOUT
+
+
+;here to force pc to value in A
+SETZPC: MOVE ZPC,A
+ MOVE Z,[441000,,OUTBUF]
+ EXCH A,Z
+ ADJBP Z,A
+ POPJ P,
+
+;here to output date stuff for serial number in ascii
+;a/ number
+OUTDAT: PUSH P,B
+ IDIVI A,10.
+ ADDI A,"0
+ PUSHJ P,OUTBYT
+ MOVEI A,"0(B)
+ PUSHJ P,OUTBYT
+ POP P,B
+ POPJ P,
+
+;here to output the data
+OUTPUT: MOVEM Z,SAVZ
+ MOVEM ZPC,SAVZPC
+ MOVEI A,32 ; where the length lives
+ PUSHJ P,SETZPC
+ MOVE A,SAVZPC ; get back the final top pc
+ LSH A,-1 ; make it in words
+ PUSHJ P,OUTWRD
+ MOVEI A,77 ; start at byte 100 octal
+ PUSHJ P,SETZPC
+ SETZ D, ; zero the checksum
+OUTCL: CAMN ZPC,SAVZPC ; loop until through the entire file
+ JRST OUTCHK
+ ILDB B,Z ; get the byte
+ ADD D,B ; and add it into checksum
+ AOJA ZPC,OUTCL
+OUTCHK: MOVEI A,34 ; where the checksum lives
+ PUSHJ P,SETZPC
+ MOVE A,D
+ ANDI A,177777 ; only 15 bits worth, though
+ PUSHJ P,OUTWRD
+ MOVEI A,22 ; where serial number lives
+ PUSHJ P,SETZPC
+ MOVNI B,1
+ ODCNV ; get current time/date
+ HLRZ A,B ; here's the year
+ SUBI A,1900. ; we will take only the mod 100 part
+ PUSHJ P,OUTDAT
+ HRRZ A,B ; here's the month (starting at 0)
+ ADDI A,1 ; so fix it up here
+ PUSHJ P,OUTDAT
+ HLRZ A,C ; here's the day (starting at 0)
+ ADDI A,1 ; so fix it up here
+ PUSHJ P,OUTDAT
+
+ MOVE Z,SAVZ
+ MOVE ZPC,SAVZPC
+ MOVE A,[440700,,[ASCIZ /.ZIP/]]
+ MOVE B,OUTPTR
+ ILDB 0,A
+ IDPB 0,B
+ JUMPN 0,.-2
+ MOVSI A,(GJ%SHT+GJ%FOU)
+ HRROI B,OUTFIL
+ GTJFN
+ JRST ERPRNT
+ HRRZ A,A
+ MOVE B,[440000,,OF%WR]
+ OPENF
+ JRST ERPRNT
+;blat out stupid gcdump header
+ HRRM ZPC,HEADER+5
+ MOVEI C,3(Z)
+ SUBI C,OUTBUF
+ HRLM C,FOOTER+1
+ ADDI C,2006
+ HRRM C,FOOTER+1
+ SUBI C,2006-2
+ MOVEM C,HEADER
+ MOVEM C,HEADER+1
+ MOVEM C,HEADER+2
+ MOVE B,[444400,,HEADER]
+ MOVNI C,7
+ SOUT
+;blat out data
+ MOVE B,[444400,,OUTBUF]
+ MOVEI C,1(Z)
+ SUBI C,OUTBUF
+ MOVN C,C
+ SOUT
+;blat out stupid footer
+ MOVE B,[444400,,FOOTER]
+ MOVNI C,2
+ SOUT
+;close up and go home
+ CLOSF
+ JFCL
+ SKIPE A,PDEBUG
+ CLOSF
+ HALTF
+ HALTF
+
+;print name of IJFN file, takes prefix string in A
+PFNAME: PSOUT
+ MOVEI A,.PRIOU
+ MOVE B,IJFN
+ MOVE C,[222220,,JS%PAF]
+ JFNS
+ PUSHJ P,PCRLF
+ POPJ P,
+
+SCRIPT: SKIPL PDEBUG
+ POPJ P,
+ MOVE A,[440700,,[ASCIZ /.SCRIPT/]]
+ MOVE B,OUTPTR
+ ILDB 0,A
+ IDPB 0,B
+ JUMPN 0,.-2
+ MOVSI A,(GJ%SHT+GJ%FOU)
+ HRROI B,OUTFIL
+ GTJFN
+ JRST ERPRNT
+ HRRZ A,A
+ MOVEM A,PDEBUG
+ MOVE B,[070000,,OF%WR]
+ OPENF
+ JRST ERPRNT
+ POPJ P,
+
+SUBTTL READ A LINE FROM INPUT FILE
+
+RDLINE: SKIPN A,IJFN ;no eof yet?
+ POPJ P, ; eof, return
+ PUSH P,B
+ HRROI B,BUFFER
+ MOVEI C,512.*5
+ MOVEI D,^J ;stop on crlf
+ SIN ;read a line
+ ERJMP RDEOF
+ MOVEI A,0 ;terminate with nul
+ IDPB A,B ;zero byte
+ POP P,B
+POPJ1: AOS (P)
+CPOPJ: POPJ P,
+
+RDEOF: MOVE A,IJFN
+ CLOSF ;close input file
+ JRST ERPRNT
+ SETZM IJFN ;eof found
+ POP P,B
+ JRST POPJ1
+
+;parse a line into tokens; may require reading more lines if it's a string
+GTLINE: MOVE A,[440700,,TOKEN]
+ MOVEM A,TOKPTR
+ MOVE TP,TPDL
+GTLIN1: PUSHJ P,GTOKEN ;get a token
+ PUSH TP,B ;push string
+ PUSH TP,A ;push terminator
+ JUMPN A,GTLIN1
+ PUSH TP,[0] ;end of line, push zeros
+ PUSH TP,[0] ;end of line, push zeros
+ POPJ P,
+
+;print a token
+PTOKEN: SKIPN TDEBUG
+ POPJ P,
+ EXCH A,B
+ SKIPE A
+ PSOUT ;string part
+ EXCH A,B
+ JUMPE A,PCRLF
+ PBOUT ;terminator part
+ POPJ P,
+PCRLF: MSG [
+]
+ PSOUT
+ MOVEI A,0
+ POPJ P,
+
+SUBTTL PARSE A TOKEN FROM INPUT LINE
+;returns a/ break char, b/ ptr to token
+GTOKEN: MOVE B,TOKPTR
+GTOKE1: ILDB A,C
+ JUMPE A,RTERM
+ CAIG A,40
+ JRST GTOKE1 ;skip over leading junk
+ JRST RTOK3
+RTOKEN: ILDB A,C
+RTOK3: CAIG A,40
+ JRST RTERM
+ CAIE A,": ;label
+ CAIN A,"+ ;sum
+ JRST RTERM
+ CAIE A,"= ;definition
+ CAIN A,"/ ;then jump
+ JRST RTERM
+ CAIE A,"\ ;else jump
+ CAIN A,", ;separator
+ JRST RTERM
+ CAIE A,"> ;assignment
+ CAIN A,"' ;quoting
+ JRST RTERM
+ CAIN A,"; ;start of comment
+ JRST RCOMNT ; ignore comment
+ CAIN A,"" ;start of string
+ JRST RSTRNG ;read string
+;else part of token
+RTOK1: IDPB A,B ;build token
+ JRST RTOKEN ;loop
+
+;here to read a string
+RSTRNG: CAME B,TOKPTR ;anything read yet?
+ JRST RSTR3 ; yes
+RSTR1: ILDB A,C
+ JUMPE A,[PUSHJ P,MORSTR
+ JRST RSTR1] ;need to read another line from file
+ CAIN A,"" ;end of string
+ JRST RSTRQ
+RSTR2: IDPB A,B
+ JRST RSTR1
+
+RSTR3: DPB C ;here if string bung up against other token
+ MOVEI A,40 ;fake a space
+ JRST RTERM ;and return
+
+;here to check for ""
+RSTRQ: MOVE 0,C
+ ILDB A,C
+ JUMPE A,[PUSHJ P,MORSTR
+ JRST RSTRQ]
+ CAIN A,""
+ JRST RSTR2 ;is ", ship it
+ MOVE C,0 ;restore bptr
+ MOVEI A,"" ;pretend was "
+ JRST RTERM ;not a ", return
+
+;here to snarf another line for multi-line strings
+MORSTR: PUSHJ P,RDLINE
+ JRST STRERR
+ MOVE C,[440700,,BUFFER]
+ POPJ P,
+
+STRERR: MSG [String not terminated at eof.]
+ PUSHJ P,ERROR
+ POPJ P,
+
+;here to read and ignore a comment
+RCOMNT: MOVEI A,0
+RTERM: CAMN B,TOKPTR
+ CAIN A,"" ;allow empty strings
+ SKIPA
+ JRST RNONE
+ MOVEI 0,0
+ IDPB 0,B ;asciz
+ EXCH B,TOKPTR
+ POPJ P,
+
+;here for nothing read
+RNONE: MOVEI B,0
+ POPJ P,
+
+
+SUBTTL SYMBOL LOOKUP FOR CONSTANT TABLES
+
+;takes: a/ symbol to lookup
+;retns +2 won, b/ value
+; +2 lost
+LOOKUP: MOVNI C,1 ;low bound
+ MOVEI E,OPCNT ;high bound
+LOOKLP: MOVE D,C
+ ADD D,E
+ TRZ D,1 ;make it an even number
+ MOVE B,OPS(D)
+ HRLI B,440700
+ PUSHJ P,COMPAR ; a/ token b/ table
+ JRST LOOKWN ; a=b
+ JRST LOOKLS ; a>b
+ LSH D,-1
+ MOVE C,D ; a<b
+ JRST LOOKND
+
+LOOKLS: LSH D,-1
+ MOVE E,D
+
+LOOKND: CAIGE C,-1(E)
+ JRST LOOKLP
+ POPJ P, ;lost, no skip
+
+LOOKWN: MOVE B,OPS+1(D) ;return value
+ AOS (P)
+ POPJ P,
+
+;compare two strings
+;a/ token b/ table
+;no skip: a=b
+;+1 skip: a>b
+;+2 skip: a<b
+COMPAR: PUSH P,A
+ PUSH P,B
+ PUSH P,C
+ PUSH P,D
+COMPA1: ILDB C,A
+ ILDB D,B
+ CAIN C,(D)
+ JRST COMEQU ;characters same
+ CAIL C,(D)
+ AOS -4(P) ;a>b
+ AOS -4(P) ;a<b
+COMEXI: POP P,D
+ POP P,C
+ POP P,B
+ POP P,A
+ POPJ P,
+
+COMEQU: JUMPE C,COMEXI ;if end of string, win
+ JRST COMPA1 ;else continue
+
+LOOKER: MOVE F,[-OPCNT,,OPS]
+LOOKIT: MOVE A,(F)
+ PSOUT
+ PUSHJ P,PCRLF
+ PUSHJ P,LOOKUP
+ HALTF
+ ADDI F,1
+ AOBJN F,LOOKIT
+ POPJ P,
+
+SUBTTL SOME DEBUGGING ROUTINES
+
+;used to make sure zpc and z are always in tandem
+CHKZPC: PUSH P,A
+ PUSH P,Z
+ PUSH P,ZPC
+ HRRZ A,Z
+ SUBI A,OUTBUF
+ LSH A,2
+ HLRZ Z,Z
+ CAIN Z,441000
+ ADDI A,0
+ CAIN Z,341000
+ ADDI A,1
+ CAIN Z,241000
+ ADDI A,2
+ CAIN Z,141000
+ ADDI A,3
+ CAIN Z,41000
+ ADDI A,4
+ CAME A,ZPC
+ HALTF
+ POP P,ZPC
+ POP P,Z
+ POP P,A
+ POPJ P,
+
+;here start printing goodies if pc has reached a certain value
+STOPPE: CAMGE ZPC,STOP
+ POPJ P,
+ MOVEM ZPC,SAVZPC
+ MOVEM Z,SAVZ
+ MOVEI .PRIOU
+ MOVEM PDEBUG
+ SETZM STOP
+ POPJ P,
+
+SUBTTL ASSEMBLE A LINE
+
+ASSEM: SKIPE STOP ;supposed to stop sometime?
+ PUSHJ P,STOPPER ; yes, see if now
+ SETZM NOREF ;produce references
+ SETZM WRDBYT ;initially assume assembling word
+
+;here to check that symbol pname tables haven't overflowed
+ MOVE C,LCLPTR
+ CAIL C,LCLTAB
+ HALTF
+ MOVE C,GLBPTR
+ CAIL C,GLBTAB
+ HALTF
+;read and parse input line
+ MOVE C,[440700,,BUFFER] ;set up ptr to input buffer
+ PUSHJ P,GTLINE
+ MOVE TP,TPDL
+ ADD TP,[1,,1]
+ SKIPN (TP)
+ POPJ P, ;nothing on this line
+
+;if frequency assembly, ignore all this foofaraw
+ SKIPE DOFREQ
+ JRST FREQ ;do something else instead
+
+;label?
+ MOVE A,1(TP) ;get terminator
+ CAIE A,":
+ JRST AOP
+;line starts with a label
+ SKIPN 2(TP) ;second token?
+ SKIPN 3(TP)
+ JRST LCLLBL ;empty line, more or less
+ MOVE A,3(TP) ;get terminator
+ CAIE A,":
+ JRST BDLBSY ;bad label syntax: foo:<x> for x not :
+;global label
+GLBLBL: SKIPE FZ ;time for function second pass?
+ PUSHJ P,FPASS2 ; yes
+ MOVE B,(TP) ;global label
+ MOVE C,ZPC ;label is current pc
+ PUSHJ P,DEFGLB ;define it
+ JRST BDMDGL ;multiply defined global label
+ NXTARG 2 ;move over label and colons
+ JRST AOP
+;local label
+LCLLBL: SKIPN A,FUNCT ;is there a function these days?
+ JRST GLBLBL ;else it might as well be a global
+ MOVE B,(TP) ;get token
+ MOVE C,ZPC ;label is current pc
+ PUSHJ P,DEFLCL ;define it
+ JRST BDMDLL ;multiply defined local label
+ NXTARG 1 ;move over local label
+ JRST AOP
+
+BDLABL: MSG [Multiply defined label]
+BDLAB1: MOVE B,(TP)
+ PUSHJ P,ERRMSG ;shout lossage
+ JRST AOP ;but continue
+
+BDLBSY: MSG [Label followed by :, non-colon]
+ JRST BDLAB1
+
+;here we have reached an opcode or pseudo after flushing label
+AOP: SKIPN A,(TP)
+ SKIPE 1(TP)
+ SKIPA
+ POPJ P,
+ PUSHJ P,LOOKUP ;takes symbol in A
+ JRST AEQUAL ; not any sort of op.
+ JUMPL B,APSEUDO ;pseudo
+ JRST AOPER ;regular op
+
+;here not oper or pseudo
+
+;see if it's an atom=foo
+AEQUAL: SKIPE A,1(TP)
+ CAIE A,"=
+ JRST AATOM
+ MOVE B,2(TP) ;value
+ PUSHJ P,FIXQ
+ JRST BDEQUA ;FOO=<non-fix>?
+ MOVE C,B
+ MOVE B,(TP)
+ PUSHJ P,DEFGLB
+ JRST BDEQU1 ;already defined?
+ SKIPN 4(TP)
+ SKIPE 5(TP)
+ JRST BDEQU2 ;too many args to equal?
+ POPJ P,
+
+;see if it's an atom
+AATOM: PUSHJ P,AWORD
+ JFCL
+ POPJ P,
+
+SUBTTL ASSEMBLE WORDS AND BYTES
+
+;get value of symbol
+; returns A/ terminator B/ value
+ALCL: PUSH P,C
+ MOVEI C,0 ;symbol is a zero
+ MOVE B,(TP)
+ PUSHJ P,REFLCL
+ MOVE B,SYMVAL(A)
+ JRST AGNEXT
+
+AGET: PUSH P,C
+ MOVEI C,0 ;symbol is a zero
+AGLOOP: MOVE B,(TP)
+ PUSHJ P,FIXQ
+ JRST [MOVE B,(TP)
+ PUSHJ P,REFSYM
+ SKIPGE B,SYMVAL(A)
+ MOVSI B,%UNDEF
+ JRST .+1]
+AGNEXT: ADD C,B ;accumulate value
+ NXTARG 1
+ SKIPN A,-1(TP) ;terminator?
+ JRST AGEXI1 ;no skip if last thing on line
+ CAIN A,"+
+ JRST AGLOOP
+AGEXIT: AOS -1(P)
+AGEXI1: MOVE B,C
+ POP P,C
+ POPJ P,
+
+AWORD: SETZM WRDBYT ;means working on word
+ PUSHJ P,AGET
+ SOS (P)
+ MOVE A,B
+ TLZ A,%BITS
+ PUSHJ P,OUTWRD
+ AOS (P)
+ POPJ P,
+
+ABYTE: SETOM WRDBYT ;means working on byte
+ PUSHJ P,AGET
+ SOS (P)
+ MOVE A,B
+ TLZ A,%BITS
+ PUSHJ P,OUTBYT
+ AOS (P)
+ POPJ P,
+
+
+SUBTTL OUTPUT WORDS
+
+;output a word
+; a/ word
+OUTWRD: CAILE A,177777 ;check size
+ JRST WRDBIG ; lose, too big
+OUTWR1: LSHC A,-8.
+ PUSHJ P,OUTBY1 ;output first byte
+ MOVEI A,0
+ ROTC A,8.
+ PUSHJ P,OUTBY1 ;output second byte
+ POPJ P,
+
+;add a value to an already output word (used for fixups)
+; a/ word
+ADDWRD: CAILE A,177777 ;too big?
+ JRST WRDBIG ; yes, lose
+ LSHC A,-8.
+ PUSHJ P,ADDBYT ;add first byte
+ MOVEI A,0
+ ROTC A,8.
+ PUSHJ P,ADDBYT ;add second byte
+ POPJ P,
+
+;output word reference
+; a/ word
+OUTWRF: CAILE A,177777 ;too big?
+ JRST WRDBIG ; yes, lose
+ LSHC A,-8.
+ PUSHJ P,OUTBY1
+ MOVEI A,0
+ ROTC A,8.
+ PUSHJ P,OUTBY1
+ POPJ P,
+
+;error, word is too large
+WRDBIG: MSG [Word too large]
+ PUSHJ P,ERROR
+ MOVEI A,0
+ JRST OUTWR1
+
+SUBTTL OUTPUT BYTES
+
+;output a byte
+; a/ byte
+OUTBYT: CAILE A,377 ;too big?
+ JRST BYTBIG ; too big, lose
+;enter here to just output the byte directly
+OUTBY1: IDPB A,Z ;output byte
+ ADDI ZPC,1 ;increment pc
+ HRRZ 0,(P)
+ SKIPN TABLE
+ SKIPE STRFLG'
+ POPJ P,
+ SKIPN PASS2
+ AOS CODLEN'
+ POPJ P,
+
+;output byte reference
+; a/ byte
+OUTBRF: CAILE A,377 ;too big?
+ JRST BYTBIG ; yes, lose
+ PUSHJ P,OUTBY1
+ POPJ P,
+
+;same as outbyt, but adds in new value (for fixup)
+; a/ byte
+ADDBYT: CAILE A,377
+ JRST BYTBIG
+ PUSH P,B
+ ILDB B,Z ;pick up current contents
+ ADD A,B ;add new stuff in
+ DPB A,Z ;put it back out
+ ADDI ZPC,1
+ POP P,B
+ POPJ P,
+
+;here byte was too large (>255.)
+BYTBIG: MSG [Byte too large]
+ PUSHJ P,ERROR
+ MOVEI A,0
+ JRST OUTBY1
+
+SUBTTL PRINT BYTES AND PCS (FOR DEBUGGING)
+
+OBYTE: PUSH P,A
+ PUSH P,B
+ PUSH P,C
+ MOVE B,A
+ MOVE A,PDEBUG
+ MOVEI C,8
+ HRLI C,(NO%LFL+NO%ZRO)+3
+ NOUT
+ JFCL
+ MOVEI B,"
+ BOUT
+ JRST POPCBA
+
+OPC: PUSH P,A
+ PUSH P,B
+ PUSH P,C
+ MOVE B,SAVZPC
+ MOVE A,PDEBUG
+ MOVEI C,8
+ NOUT
+ JFCL
+ HRROI B,[ASCIZ !/ !]
+ MOVEI C,0
+ SOUT
+OBYLUP: ILDB A,SAVZ
+ PUSHJ P,OBYTE
+ CAME Z,SAVZ
+ JRST OBYLUP
+ JRST POPCBA
+
+SUBTTL VARIOUS ERRORS
+
+BDMDGL: MSG [Multiply defined global label]
+ JRST BDERRO
+BDMDLL: MSG [Multiply defined local label]
+ JRST BDERRO
+BDMDLV: MSG [Multiply defined local variable]
+ JRST BDERRO
+BDEQUA: MSG [Something assigned to non-fix]
+ JRST BDERRO
+BDEQU1: MSG [Something already assigned]
+ JRST BDERRO
+BDEQU2: MSG [Too many args to equal]
+BDERRO: PUSHJ P,ERROR
+ POPJ P,
+
+
+SUBTTL IS IT A FIX?
+;given string pointer, skips if it's a number
+;returns number in B
+FIXQ: PUSH P,C
+ PUSH P,D
+ MOVE C,B
+ MOVEI B,0
+ SETZ D,
+FIXQ1: ILDB A,C
+ JUMPE A,FIXEND
+ CAIN A,"-
+ JRST [SETO D,
+ JRST FIXQ1]
+ CAIL A,"0
+ CAILE A,"9
+ JRST [POP P,D
+ POP P,C
+ POPJ P,]
+ SUBI A,"0
+ IMULI B,10.
+ ADD B,A
+ JRST FIXQ1
+
+FIXEND: CAILE B,177777
+ JRST FIXBIG
+ SKIPE D
+ MOVN B,B
+ ANDI B,177777
+FIXEN1: POP P,D
+ POP P,C
+ JRST POPJ1
+
+FIXBIG: MSG [Fix too big for a word]
+ PUSHJ P,ERROR
+ MOVE B,177777
+ JRST FIXEN1
+
+SUBTTL PSEUDO-OPS
+
+;dispatch for pseudo-ops
+APSEUD: SKIPE FZ ;time for a function second pass?
+ PUSHJ P,FPASS2 ; yes, go do it
+APSEU1: SETZM PASS2
+ HRRZ B,B
+ CAIN B,ZFUNCT ;if not .funct, skip
+ PUSHJ P,UNDLCL
+ JRST (B)
+
+SUBTTL .END .INSERT AND .ENDI
+
+;end of assembly
+ZEND: MOVE A,IJFN
+ CLOSF
+ JRST ERPRNT
+ SETZM IJFN
+ POPJ P,
+
+;insert another file
+ZINSER: SKIPE OJFN
+ JRST ZINSIN
+ MOVE A,3(TP)
+ CAIE A,""
+ JRST ZINSTR ;not a string
+ MOVE A,IJFN
+ MOVEM A,OJFN
+ MOVE B,2(TP)
+ PUSHJ P,OPEN
+ MSG [Inserting ]
+ PUSHJ P,PFNAME
+ POPJ P,
+
+ZINSIN: MSG [Already in .INSERT?]
+ PUSHJ P,ERROR
+ POPJ P,
+
+ZINSTR: MSG [Argument to .INSERT not string?]
+ PUSHJ P,ERROR
+ POPJ P,
+
+;end an insertion
+ZENDI: SKIPN B,OJFN
+ JRST ZENDLS
+ MOVE A,IJFN
+ CLOSF
+ JRST ZENDCL
+ SETZM OJFN
+ MOVEM B,IJFN
+ POPJ P,
+
+ZENDLS: MSG [.ENDI not in .INSERT?]
+ PUSHJ P,ERROR
+ POPJ P,
+
+ZENDCL: MSG [.ENDI close failed?]
+ PUSHJ P,ERROR
+ POPJ P,
+
+SUBTTL TABLES
+
+ZTABLE: MOVEM ZPC,TABLE
+ SETOM TABLEN
+ NXTARG 1
+ SKIPN B,(TP)
+ POPJ P,
+ PUSHJ P,FIXQ
+ JRST ZTNOTF
+ MOVEM B,TABLEN
+ POPJ P,
+
+ZTNOTF: MSG [Argument to .TABLE not fix]
+ PUSHJ P,ERROR
+ POPJ P,
+
+ZENDT: SKIPN TABLE
+ JRST ZETNOT
+ SKIPGE A,TABLEN
+ JRST ZENDTX
+ ADD A,TABLE
+ CAML A,ZPC
+ JRST ZENDTX
+ MSG [Table too large]
+ PUSHJ P,ERROR
+ POPJ P,
+
+ZENDTX: SETZM TABLE
+ SETZM TABLEN
+ POPJ P,
+
+ZETNOT: MSG [.ENDT not after .TABLE]
+ PUSHJ P,ERROR
+ POPJ P,
+
+ZEQUAL: SKIPN B,4(TP)
+ JRST ZEQTFA
+ PUSHJ P,FIXQ
+ JRST ZEQANF
+ MOVE C,B
+ PUSHJ P,DEFNAM
+ JRST ZEQMDG
+ POPJ P,
+
+ZEQMDG: MSG [Already defined]
+ PUSHJ P,ERROR
+ POPJ P,
+ZEQANF: MSG [Second argument to .EQUAL not fix]
+ PUSHJ P,ERROR
+ POPJ P,
+ZEQTFA: MSG [Too few arguments to .EQUAL]
+ PUSHJ P,ERROR
+ POPJ P,
+
+SUBTTL NAMED THINGS: FUNCTIONS, GLOBAL STRINGS, VARIABLES, OBJECTS
+
+;define a named thing, value in C
+DEFNAM: MOVE B,2(TP) ;pname
+ PUSHJ P,DEFGLB ;define symbol
+ JRST DEFMLT ;already defined
+ NXTARG 2 ;move over pseudo and name
+ AOS (P)
+ POPJ P,
+;complain about multiply defined thing
+DEFMLT: MSG [Multiply defined ]
+ MOVE B,(TP)
+ PUSHJ P,ERRMSG
+ POPJ P,
+
+;force a word boundary
+WRDBDY: TRNN ZPC,1
+ POPJ P,
+ PUSH P,A
+ MOVEI A,0
+ PUSHJ P,OUTBYT
+ POP P,A
+ POPJ P,
+
+SUBTTL FUNCTIONS
+
+ZFUNCT: PUSHJ P,WRDBDY ;force word boundary
+ SKIPN 2(TP)
+ JRST ZFNONE ;no name?
+ MOVE C,ZPC
+ LSH C,-1 ;functions are always on word bdy.
+ MOVEM C,FSYM ;save symbol value of last function
+ PUSHJ P,DEFNAM
+ POPJ P,
+ MOVE A,LSTSYM ;pick up last defined symbol
+ MOVEM A,FUNCT ;new function
+;print functions and locs if asked for
+ SKIPE FDEBUG
+ PUSHJ P,PFUNCT
+;here hack arguments
+ MOVEI D,0 ;current lval
+ MOVE E,Z ;save current bptr
+ IDPB D,Z ;start with zero
+ ADDI ZPC,1
+ZFLOOP: SKIPN B,(TP) ;is there one?
+ JRST ZFDONE ;nope, done
+ ADDI D,1 ;bump arg count
+ MOVE C,D ;which local?
+ TLO C,%VAR
+ PUSHJ P,DEFLCL ;define it as a local
+ JRST BDMDLV
+ SKIPE A,1(TP)
+ CAIE A,"=
+ JRST ZFNEXT
+ NXTARG 1 ;move over variable name
+ SKIPN B,(TP)
+ JRST ZFNOEQ
+ PUSHJ P,AWORD ;assemble word
+ JFCL
+ JRST ZFLOOP
+
+ZFNEXT: MOVEI A,0
+ PUSHJ P,OUTWRD ;bind it to 0
+ NXTARG 1 ;move over variable name
+ JRST ZFLOOP
+
+ZFDONE: IDPB D,E ;now fake output of argument count
+
+;save goodies for function pass two
+;can be called on its own, be careful!
+FMARK: MOVE A,IJFN
+ RFPTR
+ HALTF
+ MOVEM B,FPOS ;save file pointer
+ MOVEM Z,FZ ;save output pointer
+ MOVEM ZPC,FZPC ;save pc
+ MOVE A,SHRIMP
+ MOVEM A,OSHRIM
+ POPJ P,
+
+ZFNONE: MSG [No name given to function?]
+ PUSHJ P,ERROR
+ POPJ P,
+ZFNOEQ: MSG [Argument = not followed by value?]
+ PUSHJ P,ERROR
+ POPJ P,
+
+;here to set up second pass over functions with short jumps
+FPASS2: SKIPN TWOPASS ;skip if two pass assembly of functions
+ POPJ P, ;else return immediately
+ CAMN ZPC,FZPC
+ JRST [PUSHJ P,FMARK
+ POPJ P,]
+ SETOM PASS2
+ MOVE A,OSHRIM ;count of wasted long jumps
+ ;CAML A,SHRIMP ; what it was when function started
+ ;POPJ P, ;resume, false alarm
+ MOVEM A,SHRIMP
+ MOVE A,IJFN
+ MOVE B,FPOS
+ SFPTR
+ HALTF
+ MOVE Z,FZ
+ MOVEM Z,SAVZ ;fool debugging printer
+ MOVE ZPC,FZPC
+ SETZM FPOS ;file pointer of start of function
+ SETZM FZ ;z at start of function
+ SETZM FZPC ;zpc at start of function
+ SETZM FSHORT ;count of short jumps
+ POP P,0 ;flush call to fpass2
+ POPJ P, ;return from caller
+
+;.FSTR -- like .GSTR but adds to table of frequent strings
+ZFSTR: SKIPN A,4(TP)
+ JRST TFARG
+ PUSHJ P,WLOOK
+ SKIPA
+ JRST ZFDUP ;duplicate of frequent string? lose!
+;here to add new string to table
+ MOVE A,TABPTR
+ TLNN A,400000
+ JRST [HRLI A,440700
+ ADDI A,1
+ JRST .+1]
+ MOVE H,A
+ MOVE B,4(TP)
+ MOVEI C,0
+ SOUT ;copy string to buffer
+ IDPB C,A
+ MOVEM A,TABPTR
+;update table pointer
+ PUSH P,G
+ MOVE G,WRDTAB
+ SUB G,[2,,2]
+ MOVEM G,WRDTAB
+ POP P,G
+;make a slot for new entry
+ HRRZ A,WRDTAB
+ HRLI A,2(A)
+ BLT A,-1(G)
+;put out new entry
+ MOVEM H,-1(G) ;string
+ AOS H,FSTRS
+ MOVEM H,-2(G) ;count
+ CAIG H,96.
+ JRST ZFSTR1
+ MSG [Too many .FSTRs]
+ZFERR: PUSHJ P,ERROR
+ POPJ P,
+
+ZFDUP: MSG [Duplicate .FSTR]
+ JRST ZFERR
+
+ZFSTR1: PUSHJ P,WRDBDY
+ MOVE C,ZPC
+ LSH C,-1
+ PUSHJ P,DEFNAM
+ POPJ P,
+ SKIPN A,(TP)
+ JRST TFARG
+ PUSHJ P,MAKSTR
+ POPJ P,
+
+
+;.GSTR -- global string
+ZGSTR: PUSHJ P,WRDBDY
+ MOVE C,ZPC
+ LSH C,-1
+ PUSHJ P,DEFNAM
+ POPJ P,
+ SKIPN A,(TP)
+ JRST TFARG
+ PUSHJ P,MAKFRQ
+ POPJ P,
+
+ZGVAR: AOS GLBTOT
+ AOS C,GLBCNT
+ CAILE C,255. ;real high limit
+ JRST TMGLB
+ TLO C,%VAR
+ PUSHJ P,DEFNAM
+ POPJ P, ;multiply defined
+ PUSHJ P,AWORD
+ POPJ P,
+ POPJ P,
+
+TMGLB: MSG [Too many globals]
+ PUSHJ P,ERROR
+ POPJ P,
+
+ZOBJEC: AOS OBJTOT ;how many he tried to make
+ AOS C,OBJCNT
+ CAILE C,255.
+ JRST TMOBJ ;more than 255 objects
+ PUSHJ P,DEFNAM
+ POPJ P, ;multiply defined
+;process parts of object line
+ PUSHJ P,AWORD
+ JRST TFAOBJ
+ PUSHJ P,AWORD ;flags
+ JRST TFAOBJ
+ PUSHJ P,ABYTE
+ JRST TFAOBJ
+ PUSHJ P,ABYTE
+ JRST TFAOBJ
+ PUSHJ P,ABYTE
+ JRST TFAOBJ
+ PUSHJ P,AWORD ;property table ptr
+ JRST TFAOBJ
+ POPJ P,
+
+TFAOBJ: MSG [Too few arguments to .OBJECT]
+ PUSHJ P,ERROR
+ POPJ P,
+
+TMOBJ: MSG [Too many objects]
+ PUSHJ P,ERROR
+ POPJ P,
+
+ZLEN: POPJ P,
+
+ZPDEF: PUSHJ P,WRDBDY ;guarantee word boundary
+ POPJ P,
+
+ZPROP: SKIPN TABLE
+ JRST ZPROPL
+ NXTARG 1
+ PUSHJ P,AGET ;get property length
+ JFCL
+ TLZ B,%BITS
+ CAILE B,0
+ CAILE B,8
+ JRST ZPOFL ;property length out of range
+ MOVE C,B
+ PUSHJ P,AGET ;get property number
+ JFCL
+ TLZ B,%BITS
+ CAILE B,0
+ CAIL B,40
+ JRST ZPOFR ;property number out of range
+ SUBI C,1 ;length minus one
+ LSH C,5 ;left shifted
+ ADD C,B ;plus number
+ MOVE A,C
+ PUSHJ P,OUTBYT ;output it
+ POPJ P,
+
+ZPOFR: MSG [Property out of range]
+ SKIPA
+ZPOFL: MSG [Property length too long]
+ PUSHJ P,ERROR
+ POPJ P,
+
+ZPROPL: MSG [Property definition not during table?]
+ PUSHJ P,ERROR
+ POPJ P,
+
+ZSEQ: MOVEI D,0
+ NXTARG 1
+ZSEQL: SKIPN B,(TP)
+ POPJ P,
+ MOVE C,D
+ PUSHJ P,DEFGLB
+ JRST ZSEMDG
+ZSEQN: AOJA D,ZSEQL
+
+ZSEMDG: MSG [Multiply defined global]
+ PUSHJ P,ERROR
+ JRST ZSEQN
+
+
+SUBTTLE STRING PSEUDOS
+
+ZSTR: SKIPN A,2(TP)
+ JRST TFARG
+ PUSHJ P,MAKFRQ
+ POPJ P,
+
+ZSTRL: MOVEI A,0
+ PUSHJ P,OUTBYT
+ PUSH P,Z ;save bptr
+ PUSH P,ZPC ;save pc
+ PUSHJ P,ZSTR
+ POP P,A ;restore pc
+ POP P,B ;restore bptr
+ SUBM ZPC,A
+ TRNE A,1
+ ADDI A,1 ;round up
+ LSH A,-1 ;convert to words
+ DPB A,B ;output length of string
+ POPJ P,
+
+ZZWORD: NXTARG 1
+ SKIPN A,(TP)
+ JRST TFARG
+ PUSHJ P,MAKWRD ;make a 6-char word
+ POPJ P,
+
+TFARG: MSG [Too few arguments]
+ PUSHJ P,ERROR
+ POPJ P,
+
+
+SUBTTL SIMPLE THINGS: TRUTH, WORDS, BYTES
+
+ZTRUE: MOVEI A,1
+ PUSHJ P,OUTWRD
+ POPJ P,
+
+ZFALSE: MOVEI A,0
+ PUSHJ P,OUTWRD
+ POPJ P,
+
+ZWORD: NXTARG 1 ;flush .WORD
+ZWORD1: PUSHJ P,AWORD
+ POPJ P,
+ SKIPN (TP)
+ SKIPE 1(TP)
+ JRST ZWORD1
+ POPJ P,
+
+ZBYTE: NXTARG 1 ;flush .BYTE
+ZBYTE1: PUSHJ P,ABYTE
+ POPJ P,
+ SKIPN (TP)
+ SKIPE 1(TP)
+ JRST ZBYTE1
+ POPJ P,
+
+SUBTTL OPERAND ASSEMBLY
+
+;assembly of real opers
+AOPER: SETOM NOREF ;don't produce references, just do lookups
+ MOVEM B,OPER ;save operand (and bits!)
+ SETOM PRED ;not pred instruction
+ TLNE B,%PRED
+ SETZM PRED ; yes it is!
+ SETZM SENSE ;initialize jump sense
+ SETOM VAL ;not val instruction
+ TLNE B,%VAL
+ SETZM VAL ; yes it is!
+ MOVEI F,0 ;first count arguments
+;set up buffer for arguments
+ MOVE AB,[ARGBUF,,ARGBUF+1]
+ SETOM ARGBUF
+ BLT AB,ARGBUF+12
+ MOVEI AB,ARGBUF
+
+ MOVE B,OPER
+ TLNE B,%JUMP ;don't skip if it's a jump
+ JRST AOPERJ
+ NXTARG 1 ;move over op
+ {;now hack arguments
+AOPER1: SKIPN (TP)
+ SKIPE 1(TP)
+ SKIPA
+ JRST AOPERN ;done, no more args
+ MOVE A,1(TP) ;pick up terminator
+;here for string
+ CAIE A,""
+ JRST AOPERQ
+ MOVE A,OPER
+ TLNN A,%STR ;must be string operator
+ JRST AOPSTR ;string given to non-string operator
+ HRRZ A,A
+ PUSHJ P,OUTBYT
+ MOVE A,(TP)
+ PUSHJ P,MAKFRQ
+ SKIPN 2(TP)
+ SKIPE 3(TP)
+ JRST TMAPRI
+ POPJ P,
+
+TMAPRI: MSG [Too many arguments to PRINTI]
+ PUSHJ P,ERROR
+ POPJ P,
+
+AOPSTR: MSG [String given to non-string operator?]
+ PUSHJ P,ERROR
+ POPJ P,
+
+;here for quoted variable name
+AOPERQ: CAIE A,"' ;quoted variable?
+ JRST AOPERP
+ ADDI F,1 ;that's an argument
+ NXTARG 1
+ SKIPN (TP)
+ JRST AOPQUT ;bad variable name
+ PUSHJ P,AGET
+ JFCL
+ TLNN B,%VAR
+ JRST AOPQUT
+ TLZ B,%VAR ;quoting devariablizes variables
+ JRST AOPOUT
+
+AOPGET: PUSHJ P,AGET ;get value if any
+ JFCL
+AOPOUT: MOVEM B,(AB) ;put out theory on arg
+ MOVE B,-2(TP)
+ MOVEM B,1(AB) ;put out symbol
+ ADDI AB,2
+ JRST AOPER1
+
+;here arg is nothing special
+AOPERC: AOJA F,AOPGET
+
+AOPERJ: MOVEI G,0
+ JRST AOPERK
+
+;here for predicate jump
+AOPERP: CAIE A,"/ ;'then' predicate?
+ CAIN A,"\ ;'else' predicate?
+ SKIPA
+ JRST AOPERV
+ MOVEI G,0
+ CAIN A,"/
+ TRO G,100000
+ MOVEM G,SENSE
+AOPERK: NXTARG 1
+ SKIPN (TP)
+ JRST AOPQUT ;bad variable name
+ PUSHJ P,ALCL ;get value if any
+ JFCL
+ MOVEM B,PRED
+ MOVE B,-2(TP)
+ MOVEM B,PRED+1
+ JRST AOPER1
+
+;here for value variable
+AOPERV: CAIE A,"> ;term. for assignment
+ JRST AOPERC
+ NXTARG 1
+ SKIPN (TP)
+ JRST AOPQUT ;bad variable name
+ PUSHJ P,AGET ;get value if any
+ JFCL
+ MOVEM B,VAL
+ MOVE B,-2(TP)
+ MOVEM B,VAL+1
+ JRST AOPER1
+
+AOPQUT: MSG [Bad variable name after value or predicate]
+ PUSHJ P,ERROR
+ POPJ P,
+
+;here we know how many args, so frotz with operand value appropriately
+;f/ # of args.
+AOPERN: SKIPE ODEBUG ;print theory of operator
+ PUSHJ P,OPRNT ; if odebug is non-zero
+ SKIPE TWOPASS ;if non two pass, then can make refs
+ SKIPE PASS2 ;can't make refs in pass 1
+ SETZM NOREF ;can make refs now
+ MOVEI AB,ARGBUF
+ MOVE B,OPER ;pick up operator
+ ANDI B,377 ;flush various funny bits
+;dispatch on operand value
+ CAIL B,300 ;ext?
+ JRST OUTEXT ; yes, this one is always an ext
+ CAIL B,260 ;0op?
+ JRST OUT0OP ; yes
+ CAIL B,200 ;1op?
+ JRST OUT1OP ; yes
+;falls through
+
+;remainder are all 2op (but can be ext!)
+OUT2OP: CAIE F,2
+ JRST TMA2OP
+ MOVEI C,0
+ MOVE A,(AB)
+ JUMPL A,CNVEXT ;if undefined, must be ext.
+ TLNE A,%VAR
+ JRST CHK1VR
+ CAIL A,0
+ CAIL A,400
+ JRST CNVEXT ;if long immediate, must be ext.
+ SKIPA ;arg 1 is immediate
+CHK1VR: TRO B,100 ;arg 1 is a variable
+CHK2ND: MOVE A,2(AB)
+ JUMPL A,CNVEXT ;if undefined, must be ext.
+ TLNE A,%VAR
+ JRST CHK2VR
+ CAIL A,0
+ CAIL A,400
+ JRST CNVEXT ;if long immediate, must be ext.
+ SKIPA ;arg 2 is immediate
+CHK2VR: TRO B,40 ;arg 2 is a variable
+
+;here it's really a 2op
+ MOVE A,B
+ PUSHJ P,OUTBYT ;output operator
+ HRRZ A,(AB)
+ PUSHJ P,OUTBYT
+ HRRZ A,2(AB)
+ PUSHJ P,OUTBYT
+ JRST OUTPV ;go do value and pred
+
+;here if wrong number of arguments (might be 4 arg EQUAL?)
+TMA2OP: MOVE B,OPER
+ TLNN B,%XARG ;4 arg equal?, so convert to ext.
+ JRST TMA2O1 ;real wna, too bad
+
+;here to convert a 2op to an ext
+CNVEXT: MOVE B,OPER
+ ADDI B,300 ;convert to ext
+ MOVEM B,OPER
+ ANDI B,377
+ MOVEI AB,ARGBUF
+ JRST OUTEXT
+
+TMA2O1: MSG [Too many arguments to 2op]
+ PUSHJ P,ERROR
+ POPJ P,
+
+;here to output a 1op instruction
+OUT1OP: MOVE B,OPER
+ TLNE B,%JUMP ;special case jumps
+ JRST OUTJMP
+ CAIE F,1 ;one arg?
+ JRST TMA1OP ;no, lose!
+ MOVE A,(AB) ;pick up argument
+ TLNN A,%VAR ;variable?
+ JRST 1OPI ; no.
+ TRO B,40 ;variable arg bit
+1OPBYT: EXCH A,B
+ HRRZ A,A
+ PUSHJ P,OUTBYT ;output oper
+ HRRZ A,B
+ PUSHJ P,OUTBYT ;output variable byte
+ JRST OUTPV
+
+OUTJMP: JUMPG F,TMA1OP
+ HRRZ A,B
+ PUSHJ P,OUTBYT ;output it for now
+ MOVE B,OPER
+ JRST OUTP1
+
+1OPI: CAIL A,0
+ CAIL A,400 ;will it fit in one word?
+ JRST 1OPNO
+ TRO B,20 ;immediate bit
+ JRST 1OPBYT ;output oper and imm. byte
+
+1OPNO: EXCH A,B
+ HRRZ A,A
+ PUSHJ P,OUTBYT ;output oper.
+ JUMPL B,1OPREF
+1OPNO1: HRRZ A,B
+ PUSHJ P,OUTWRD ;output long arg.
+ JRST OUTPV
+
+;here single arg is reference to unknown
+1OPREF: MOVE B,1(AB) ;must make an appropriate fixup
+ PUSHJ P,REFSYM
+ MOVE B,(AB) ;output what we have of value
+ JRST 1OPNO1
+
+TMA1OP: MSG [Too many args to 1op instruction]
+ PUSHJ P,ERROR
+ POPJ P,
+
+;here to output extended op
+OUTEXT: CAILE F,4
+ JRST TMAEXT
+ MOVE A,B
+ PUSHJ P,OUTBYT ;operator
+ MOVEI A,0
+ PUSHJ P,OUTBYT ;ext byte (will be filled in later)
+ MOVE G,Z ;save output ptr
+ MOVEI D,0 ;ext byte under construction
+ MOVEI E,4 ;max arguments
+;here loop through args to ext instruction
+EXTLUP: MOVE A,(AB) ;get arg
+ TLNN A,%VAR ;variable?
+ JRST EXTIMM
+ TRO D,2 ;yes, turn on variable bit
+EXTBYT: HRRZ A,A
+ PUSHJ P,OUTBYT ;output variable byte
+ JRST EXTNXT
+EXTIMM: CAIL A,0 ;immediate?
+ CAIL A,400
+ JRST EXTLIM ;no, long
+ TRO D,1 ;turn on immediate bit
+ JRST EXTBYT ;output immediate byte
+EXTLIM: JUMPL A,EXTREF ;undefined?
+ HRRZ A,A ;no, output full word
+ PUSHJ P,OUTWRD
+ JRST EXTNXT
+
+EXTREF: MOVE B,1(AB)
+ PUSHJ P,REFSYM
+ HRRZ A,(AB)
+ PUSHJ P,OUTWRD
+
+EXTNXT: SOJE E,EXTEXT ;if done four args, leave
+ SUBI F,1 ;reduce count
+ ADDI AB,2 ;move to next
+ LSH D,2 ;update ext byte
+ JUMPG F,EXTLUP ;if still args, do them
+ TRO D,3 ;turn on last arg bits
+ JRST EXTNXT ;if not, loop filling ext byte with 3
+
+EXTEXT: DPB D,G ;output ext word
+ JRST OUTPV ;go output val and pred stuff
+
+TMAEXT: MSG [Too many arguments to EXT instruction]
+ PUSHJ P,ERROR
+ POPJ P,
+
+;here to output a 0op instruction
+OUT0OP: JUMPG F,TMA0OP ;better not have any args!
+ MOVE A,B ;pick up operand from B
+ PUSHJ P,OUTBYT
+
+;here to output value and predicate stuff for instructions
+OUTPV: MOVE B,OPER
+ TLNN B,%VAL
+ JRST OUTP
+ MOVE A,VAL
+ CAMN A,[-1]
+ JRST NOVAL
+ JUMPL A,OUTVRF ;reference to value
+ HRRZ A,A
+ PUSHJ P,OUTBYT
+
+OUTP: TLNN B,%PRED+%JUMP
+ POPJ P,
+;comes here from outputting jump instruction
+OUTP1: MOVE A,PRED
+ CAMN A,[-1]
+ JRST NOPRED
+ MOVE C,A
+ JUMPL A,OUTPRF ;reference to predicate
+;produce jump offset
+ TRNN A,37776 ;check for /true /false jump
+ JRST OUTPSH ;short
+ SUB A,ZPC
+ TLNE B,%JUMP
+ ANDI A,177777 ;16 bit jump inst.
+ TLNN B,%JUMP
+ ANDI A,37777 ;14 bit pred. jumps
+;determine whether short or long jump
+ CAIGE A,77 ;test if pred jump is short
+ JRST OUTPSH
+ CAMN B,OPJMP ;jump instruction can take larger "shorts"
+ CAIL A,377 ;small enough?
+ JRST OUTPLN ; no, long jump. sigh.
+
+;short jump: <polarity>+<short=1>+<offset:6bits>
+; such are always forward jumps of less than 64 bytes
+OUTPSH: CAMN B,OPJMP
+ JRST OUTSJ ;output short jump byte
+ TRO A,100 ;short jump
+ MOVE C,SENSE
+ TRNE C,100000
+ TRO A,200 ;move jump sense to second byte
+OUTPS1: ANDI A,377 ;and make it a byte
+ PUSHJ P,OUTBYT
+ POPJ P,
+
+OUTSJ: PUSH P,A
+ HRRZ A,B
+ TRO A,20 ;turn on immediate bit
+ DPB A,Z
+ POP P,A
+ JRST OUTPS1
+
+;long jump
+OUTPLN: MOVE C,SENSE
+ TRNE C,100000
+ TRO A,100000
+ PUSHJ P,OUTWRD
+ POPJ P,
+
+;here when predicate jump is a forward reference
+OUTPRF: SETOM JMPREF ;say it's a jump reference
+ SKIPE TWOPAS
+ SKIPE FZ
+ JRST OUTPRL
+ HRRZ A,A ;get value part of ref
+ SUB A,ZPC
+ SUB A,FSHORT
+ TLNE B,%JUMP
+ ANDI A,177777 ;16 bit jump inst.
+ TLNN B,%JUMP
+ ANDI A,37777 ;14 bit pred. jumps
+;determine whether short or long jump
+ TLNN B,%JUMP ;real jumps are always long
+ CAIL A,77 ;test if pred jump is short
+ JRST OUTPRL ;long jump. sigh.
+;here short jump reference
+ MOVEI A,100 ;short jump
+ MOVE C,SENSE
+ TRNE C,100000
+ TRO A,200 ;move jump sense to second byte
+ HRRM A,PRED ;save it
+;make the reference
+ SETOM WRDBYT ;say it's a byte ref
+ MOVE B,PRED+1
+ PUSHJ P,REFLCL
+ SETZM JMPREF
+ SETZM WRDBYT
+;output the byte
+ HRRZ A,PRED
+ PUSHJ P,OUTBRF
+ AOS FSHORT
+ POPJ P,
+
+OUTPRL: MOVE B,PRED+1
+ PUSHJ P,REFLCL ;all jumps are local
+ SETZM JMPREF
+ MOVE A,SENSE
+ PUSHJ P,OUTWRF ;output reference
+ POPJ P,
+
+NOPRED: MSG [Predicate instruction lacks predicate]
+ PUSHJ P,ERROR
+ POPJ P,
+
+OUTVRF: MSG [Value indefined]
+ SKIPA
+NOVAL: MSG [Value instruction lacks value]
+ PUSHJ P,ERROR
+ POPJ P,
+
+TMA0OP: MSG [Too many args to 0op instruction]
+ PUSHJ P,ERROR
+ POPJ P,
+
+OPRNT: PUSH P,A
+ PUSH P,B
+ PUSH P,C
+ PUSH P,D
+ HRROI A,BUFFER
+ PSOUT
+ MOVEI A,^M
+ PBOUT
+ MOVEI A,^J
+ PBOUT
+ MOVEI D,0
+OPLOOP: MOVE A,ARGBUF(D)
+ CAMN A,[-1]
+ JRST OPPV
+ MOVE A,ARGBUF+1(D)
+ PSOUT
+ MOVEI A,^I
+ PBOUT
+ MOVE B,ARGBUF(D)
+ PUSHJ P,NUM
+ PUSHJ P,CRLF
+ ADDI D,2
+ JRST OPLOOP
+
+CRLF: MOVEI A,^M
+ PBOUT
+ MOVEI A,^J
+ PBOUT
+ POPJ P,
+
+NUM: PUSH P,A
+ PUSH P,C
+ JUMPGE B,OPNV
+ MOVEI A,"?
+ PBOUT
+ MOVEI A,"
+ PBOUT
+ TLZ B,%UNDEF
+OPNV: TLNN B,%VAR
+ JRST OPNUM
+ MOVEI A,"#
+ PBOUT
+ TLZ B,%VAR
+OPNUM: MOVEI A,.PRIOU
+ MOVEI C,8.
+ NOUT
+ JFCL
+ POP P,C
+ POP P,A
+ POPJ P,
+
+OPPV: MOVE A,VAL
+ CAMN A,[-1]
+ JRST OPPRED
+ MOVEI A,">
+ PBOUT
+ MOVE A,VAL+1
+ PSOUT
+ MOVEI A,^I
+ PBOUT
+ MOVE B,VAL
+ PUSHJ P,NUM
+ PUSHJ P,CRLF
+OPPRED: MOVE B,PRED
+ CAMN B,[-1]
+ JRST OPPEX
+ MOVEI A,"\
+ MOVE B,SENSE
+ TRNE B,100000
+ MOVEI A,"/
+ PBOUT
+ MOVE A,PRED+1
+ PSOUT
+ MOVEI A,^I
+ PBOUT
+ MOVE B,PRED
+ PUSHJ P,NUM
+ PUSHJ P,CRLF
+OPPEX: POP P,D
+ POP P,C
+ POP P,B
+ POP P,A
+ POPJ P,
+
+
+SUBTTL SYMBOL HACKING
+
+; symbols look like:
+; SYMNAM <pname loc> ,, <next symbol>
+; SYMVAL <value>
+; SYMREF <references>
+; where
+; <value> if for a defined symbol
+; includes
+; %VAR,, if the symbol is for a variable (local or global)
+; and
+; <value> if for an undefined symbol
+; includes
+; %UNDEF,, <value if local label>
+
+; a reference chain consists of
+; <pc> ,, <next reference>
+; <output ptr>
+; where
+; <pc> includes
+; %RBYTE if the reference is a byte reference
+; %RJUMP if the reference is a jump reference
+
+;look up a symbol in a symbol list
+; a/ symbol table, b/ symbol
+; +1 a/ table loc of symbol, won
+; +2 a/ potential table loc of symbol, lost
+SLOOK: PUSH P,B
+ PUSH P,C
+ PUSH P,D
+ PUSH P,E
+;hash the symbol
+ SETZ C,
+HASH1: ILDB E,B
+ JUMPE E,HASH2
+ ROT C,3
+ XOR C,E
+ JRST HASH1
+HASH2: TLZ C,400000
+ IDIVI C,BUCKN ;number of buckets to D
+ IMULI D,BUCKL ;length of buckets
+ HRL D,D
+ ADDM A,D
+ SKIPL D
+ HALTF ;symbol table overflow
+;look for it
+ MOVE A,-3(P) ;pick up symbol being looked for
+SLKLUP: SKIPN B,SYMNAM(D) ;symbol here?
+ JRST SLKLOS ; nothing here
+ HLR B,B
+ HRLI B,440700 ;produce byte pointer
+ PUSHJ P,COMPAR ;compare
+ JRST SLKWON ;same, win
+ JFCL
+ ADDI D,SYMSIZ ;move to next symbol
+ JRST SLKLUP ;and loop
+
+SLKLOS: MOVE A,D ; rtn ptr to symbol slot in A
+ POP P,E
+ POP P,D
+ POP P,C
+ POP P,B
+ JRST POPJ1
+
+SLKWON: HLR B,SYMNAM(D) ;found it, stuff it for future use
+ HRLI B,440700
+ MOVEM B,LSTSYM
+ MOVE A,D ; return ptr
+ POP P,E
+ POP P,D
+ POP P,C
+ POP P,B ; return ptr to cell
+ POPJ P,
+
+; insert symbol in table
+; a/ where (as returned by SLOOK)
+; b/ symbol
+; c/ value
+SINSRT: PUSH P,A
+ PUSH P,B
+ PUSH P,C
+ PUSH P,D
+ HRLZM FREE,SYMNAM(A) ;symbol will be copied here
+ MOVEM C,SYMVAL(A) ;value
+;copy symbol into appropriate symbol area
+ MOVE A,FREE
+ HRLI A,440700 ;bptr to output
+ MOVE D,A ;save a copy
+ SETZM (A) ;make sure its zero
+ MOVEM A,LSTSYM ;most recent symbol defn.
+ ILDB C,B
+ IDPB C,A
+ JUMPN C,.-2
+ CAMN A,D ;not a nul symbol?
+ HALTF ; should be no nul symbols
+ HRRZI FREE,1(A) ;update free pointer
+ POP P,D
+ POP P,C
+ POP P,B
+ POP P,A
+ POPJ P,
+
+SUBTTL SYMBOL TABLE DEBUGGING
+
+;print a symbol list, takes it in A
+SPRNT: PUSH P,A
+ PUSH P,B
+ SKIPN B,A
+ JRST SPRNT2
+SPRNT1: HLRZ A,SYMNAM(B)
+ JUMPE A,SPRNT3
+ HRLI A,-1
+ PSOUT
+ MOVEI A,"?
+ SKIPGE SYMVAL(B)
+ PBOUT ;? if undefined
+ MOVEI A,",
+ PBOUT
+SPRNT3: HRRZ B,SYMNAM(B)
+ JUMPN B,SPRNT1
+SPRNT2: HRROI A,[ASCIZ /
+/]
+ PSOUT
+POPBAJ: POP P,B
+ POP P,A
+ POPJ P,
+
+;print the global symbol table
+GPRNT: PUSH P,A
+ MOVE A,GLBLST
+ PUSHJ P,SPRNT
+ POP P,A
+ POPJ P,
+
+;print the local symbol table
+LPRNT: PUSH P,A
+ MOVE A,LCLLST
+ PUSHJ P,SPRNT
+ POP P,A
+ POPJ P,
+
+SUBTTL INITIALIZE SYMBOL TABLES
+
+;initialize global symbol table
+GLBINI: PUSH P,A
+ MOVEI A,GLBBUF
+ MOVEM A,GLBPTR
+ SETZM GLBLST
+ SETZM GLBTAB
+ MOVE A,[GLBTAB,,GLBTAB+1]
+ BLT A,GLBEND
+ POP P,A
+ POPJ P,
+
+;initialize local symbol table
+LCLINI: PUSH P,A
+ PUSH P,B
+ PUSH P,C
+ MOVEI A,LCLBUF
+ MOVEM A,LCLPTR
+ SETZM LCLLST
+ SETZM LCLTAB
+ MOVE A,[LCLTAB,,LCLTAB+1]
+ BLT A,LCLEND
+;local tables start with these three symbols in them
+ MOVE B,[440700,,[ASCIZ /FALSE/]]
+ MOVEI C,0
+ PUSHJ P,DEFLCL
+ JFCL
+ MOVE B,[440700,,[ASCIZ /TRUE/]]
+ MOVEI C,1
+ PUSHJ P,DEFLCL
+ JFCL
+ MOVE B,[440700,,[ASCIZ /STACK/]]
+ MOVSI C,%VAR
+ PUSHJ P,DEFLCL
+ JFCL
+ JRST POPCBA
+
+SUBTTL PRINT UNDEFINED LOCALS
+
+;print names of undefined locals in function
+;done whenever a function is finished
+UNDLCL: SKIPN FUNCT ;skip if was assembling a function
+ POPJ P,
+ PUSH P,A
+ PUSH P,B
+ PUSH P,C
+ PUSH P,D
+ MOVE C,LCLLST
+UNDLC2: SKIPL D,SYMVAL(C) ;value slot
+ JRST UNDLC1 ;defined symbol
+ SKIPN A,FUNCT ;undefined symbol
+ JRST UNDLC3 ;don't print function name
+ PSOUT ;print function name
+ MSG [
+]
+ PSOUT
+ SETZM FUNCT ;zero it since one print is enough
+;here to print undefined symbol and pcs at which it is referenced
+UNDLC3: MSG [ ]
+ PSOUT
+ HLRO A,SYMNAM(C) ;bptr to symbol
+ PSOUT
+ MSG [ undefined: ]
+ PSOUT
+ PUSH P,C
+ MOVEI C,10.
+ HRRZ D,SYMREF(C)
+ JRST UNDLC5
+UNDLC4: MOVEI A,.PRIOU
+ HLRZ B,(D) ;pc at which referenced
+ TRZ B,%RBYTE+%RJUMP
+ NOUT ;output pc
+ JFCL
+ MSG [, ]
+ PSOUT
+UNDLC5: HRRZ D,(D) ;move to next pc
+ JUMPN D,UNDLC4 ;and leave if last
+ PUSHJ P,PCRLF
+ POP P,C
+
+UNDLC1: HRRZ C,SYMNAM(C) ;move to next symbol
+ JUMPN C,UNDLC2 ;or leave if it was last
+;produce symbol table if asked
+ SKIPN SYMFLG
+ JRST UNDLCX
+ MOVE A,LCLLST
+ PUSHJ P,SYMTAB
+ MOVE B,FCNPTR
+ SUBI A,SYMBUF
+ MOVEM A,(B)
+ MOVE A,FSYM ;last function defined
+ MOVEM A,1(B)
+ ADDI B,2
+ MOVEM B,FCNPTR
+
+;do rest of cleanup
+UNDLCX: PUSHJ P,LCLINI ;reinit local symbol table
+ JRST POPDA
+
+SUBTTL PRINT UNDEFINED GLOBALS
+
+;print undefined globals
+UNDGLB: PUSH P,A
+ PUSH P,B
+ PUSH P,C
+ PUSH P,D
+ MOVE C,GLBLST
+UNDGL2: SKIPL D,SYMVAL(C) ;value slot
+ JRST UNDGL1
+ HLRO A,SYMNAM(C) ;bptr to symbol
+ PSOUT
+ MSG [ global undefined: ]
+ PSOUT
+ PUSH P,C
+ MOVEI C,10.
+ HRRZ D,SYMREF(C)
+ JRST UNDGL5
+UNDGL4: MOVEI A,.PRIOU
+ HLRZ B,(D) ;pc at which referenced
+ TRZ B,%RBYTE+%RJUMP
+ NOUT ;output pc
+ JFCL
+ MSG [, ]
+ PSOUT
+ HRRZ D,(D) ;move to next pc
+UNDGL5: JUMPN D,UNDGL4 ;and leave if last
+ PUSHJ P,PCRLF
+ POP P,C
+UNDGL1: HRRZ C,SYMNAM(C) ;move to next symbol
+ JUMPN C,UNDGL2 ;or leave if it was last
+
+;produce symbol table if was asked
+ SKIPN SYMFLG
+ JRST POPDA
+ MOVE A,GLBLST
+ PUSHJ P,SYMTAB
+ SUBI A,SYMBUF
+ MOVEM A,SYMBUF ;ptr to global symbol table
+;sort function table and copy it into symbol area
+ MOVE A,FCNPTR
+ SETZM (A)
+ AOS FCNPTR
+ MOVEI A,FCNBUF
+ PUSHJ P,SSORT
+ HRLI A,FCNBUF
+ HRR A,SYMPTR
+ SUBI A,SYMBUF
+ HRRZM A,SYMBUF+1 ;ptr to function symbol table
+ ADDI A,SYMBUF
+ MOVE B,FCNPTR
+ SUBI B,FCNBUF
+ ADD B,SYMPTR
+ MOVEM B,SYMPTR
+ BLT A,(B)
+
+;output symbols file
+OUTSYM: MOVE A,[440700,,[ASCIZ /.SYMS/]]
+ MOVE B,OUTPTR
+ ILDB 0,A
+ IDPB 0,B
+ JUMPN 0,.-2
+ MOVSI A,(GJ%SHT+GJ%FOU)
+ HRROI B,OUTFIL
+ GTJFN
+ JRST ERPRNT
+ HRRZ A,A
+ MOVE B,[440000,,OF%WR]
+ OPENF
+ JRST ERPRNT
+ MOVE B,[444400,,SYMBUF]
+ MOVEI C,SYMBUF
+ SUB C,SYMPTR
+ SOUT
+;close up and go home
+ CLOSF
+ JFCL
+
+POPDA: POP P,D
+ JRST POPCBA
+
+SUBTTL OUTPUT SYMBOL TABLES
+
+SYMTAB: PUSH P,B
+ PUSH P,C
+ PUSH P,D
+ MOVE C,A
+ MOVE D,A
+;copy strings
+SYMCPY: HLR A,SYMNAM(C)
+ HRLI A,440700
+ HRRZ B,SYMPTR
+ SUBI B,SYMBUF
+ HRLM B,SYMNAM(C)
+ ADDI B,SYMBUF
+ HRLI B,440700
+ ILDB A
+ IDPB B
+ JUMPN .-2
+ HRRZI B,1(B)
+ MOVEM B,SYMPTR
+ HRRZ C,(C)
+ JUMPN C,SYMCPY
+ MOVE C,D
+;copy symbols themselves
+SYMCP1: HLR A,SYMNAM(C)
+ HRLI A,440700
+ MOVEM A,(B)
+ MOVE A,SYMVAL(C)
+ MOVEM A,1(B)
+ ADDI B,2
+ HRRZ C,(C)
+ JUMPN C,SYMCP1
+ SETZM (B)
+ ADDI B,1
+ EXCH B,SYMPTR
+ MOVE A,B
+ PUSHJ P,SSORT ;sort the table
+ POP P,D
+ POP P,C
+ POP P,B
+ POPJ P,
+
+;sort a symbol table by value words
+; a/ ptr to symbol table
+SSORT: PUSH P,A
+ PUSH P,B
+ PUSH P,C
+ PUSH P,D
+SSORT1: SKIPN (A)
+ JRST POPDA
+ MOVE C,A ;save destination
+ MOVE D,A ;ptr to best candidate
+SSORT0: ADDI A,2 ;ptr to first test
+ SKIPN (A) ;better be a test...
+ JRST SSORT2 ; zero, end of table
+ MOVE B,1(D)
+ CAMLE B,1(A) ;test better than best?
+ MOVE D,A ;new best
+ JRST SSORT0 ;move to next
+
+SSORT2: CAMN D,C ;must move one?
+ JRST SSORT3
+ MOVE A,(D)
+ EXCH A,(C)
+ MOVEM A,(D)
+ MOVE A,1(D)
+ EXCH A,1(C)
+ MOVEM A,1(D)
+SSORT3: MOVEI A,2(C)
+ JRST SSORT1
+
+SUBTTL GLOBAL SYMBOL REFERENCE AND DEFINITION
+
+DEFGLB: MOVE A,GLBOBL ;look it up in global symbol table
+ PUSHJ P,SLOOK
+ JRST DEFOLD ;already there
+;symbol not in global table
+INSGLB: MOVE FREE,GLBPTR
+ PUSHJ P,SINSRT ;insert it
+ MOVEM FREE,GLBPTR
+ HRR 0,GLBLST ;chain together all globals
+ HRRM 0,(A)
+ MOVEM A,GLBLST ;by consing into a list
+ SKIPN SDEBUG
+ JRST POPJ1
+;print symbol table here if debugging
+ PUSH P,A
+ MOVE A,GLBLST
+ PUSHJ P,SPRNT
+ POP P,A
+ JRST POPJ1
+
+;here to define a symbol that already has been referenced
+DEFOLD: MOVE B,A ;move ptr to symbol
+ SKIPL SYMVAL(B) ;is it undefined?
+ JRST CPOPJ ; if defined, lose
+ MOVE A,C ;save value
+ MOVEM C,SYMVAL(B) ;define it
+ MOVE C,SYMREF(B) ;pick up reference chain to C
+ PUSHJ P,FIXUP ;fix up references already accumulated
+ JRST POPJ1
+
+SUBTTL LOCAL SYMBOL REFERENCE AND DEFINITION
+
+DEFLCL: MOVE A,LCLOBL ;look it up in local symbol table
+ PUSHJ P,SLOOK
+ JRST DEFOLL ;here for forward references
+;here to add symbol to local symbol table
+INSLCL: MOVE FREE,LCLPTR
+ PUSHJ P,SINSRT
+ MOVEM FREE,LCLPTR
+ HRR 0,LCLLST
+ HRRM 0,(A)
+ MOVEM A,LCLLST
+ JRST POPJ1
+
+;here to define already referenced local symbol
+DEFOLL: SKIPN TWOPAS
+ JRST DEFOLD
+ SKIPN PASS2 ;only do fixups if pass 2
+ JRST DEFOL1 ; do usual thing in pass 1
+;do hair in pass 2
+ MOVEM C,SYMVAL(A) ;redefine local label
+;fix up for short jumps
+ MOVE C,SYMREF(A) ;get reference chain
+ MOVE A,SYMVAL(A) ;get value to be fixed up
+ PUSHJ P,FIXUP
+ JRST POPJ1
+
+;here to "define" local symbol during pass one
+DEFOL1: MOVE B,A
+ SKIPL SYMVAL(B) ;should be undefined
+ JRST CPOPJ ; if defined, lose
+ MOVE A,C ;save value
+ HRRM C,SYMVAL(B) ;pretend to define it
+ JRST POPJ1
+
+BPASS2: MSG [Label inconsistency, pass 2]
+ PUSHJ P,ERROR
+ JRST POPJ1
+
+
+SUBTTL REFERENCE AND DEFINE SYMBOLS
+
+;reference a symbol
+; takes b/ symbol
+; returns a/ ptr to cell for symbol
+REFSYM: PUSH P,B
+ PUSH P,C
+ MOVE A,LCLOBL ;look up as local first
+ PUSHJ P,SLOOK
+ JRST [SKIPL SYMVAL(A) ;skip if undefined
+ JRST POPCB ;has a value, return it
+ JRST REFLLD] ;refer to old local
+ MOVE A,GLBOBL
+ MOVE B,-1(P)
+ PUSHJ P,SLOOK
+ JRST [SKIPL SYMVAL(A)
+ JRST POPCB ;has a gval, return it
+ JRST REFGLD] ;refer to old global
+ MOVE B,-1(P)
+ PUSHJ P,REFGLB
+POPCB: POP P,C
+ POP P,B
+ POPJ P,
+
+;reference a global
+; b/ symbol
+REFGLB: PUSH P,B
+ PUSH P,C
+ MOVE A,GLBOBL
+ MOVE B,-1(P)
+ PUSHJ P,SLOOK
+ JRST REFGLD ;refer to old global
+ MOVE B,-1(P)
+ HRLZI C,%UNDEF ;undefined
+ PUSHJ P,INSGLB
+ HALTF
+REFGLD: SKIPE NOREF
+ JRST POPCB
+ MOVE FREE,GLBPTR
+ HRRZ B,SYMREF(A) ;get pc chain
+ HRRM FREE,SYMREF(A) ;and put new cell in symbol cell
+ SKIPE WRDBYT
+ TLO B,%RBYTE ;indicate byte reference
+ MOVEM B,(FREE)
+ MOVEM ZPC,1(FREE) ;pc
+ MOVEM Z,2(FREE) ;bptr
+ ADDI FREE,3
+ MOVEM FREE,GLBPTR
+ JRST POPCB
+
+;reference a local
+; b/ symbol
+REFLCL: PUSH P,B
+ PUSH P,C
+ MOVE A,LCLOBL
+ MOVE B,-1(P)
+ PUSHJ P,SLOOK
+ JRST REFLLD ;refer to old local
+ MOVE B,-1(P)
+ HRLZI C,%UNDEF ;undefined
+ PUSHJ P,INSLCL
+ HALTF
+REFLLD: SKIPE NOREF
+ JRST POPCB
+ MOVE FREE,LCLPTR ;get free storage from local area
+ HRRZ B,SYMREF(A) ;get ptr to reference chain
+ HRRM FREE,SYMREF(A) ;and update chain ptr
+ SKIPE WRDBYT
+ TLO B,%RBYTE
+ SKIPE JMPREF
+ TLO B,%RJUMP ;indicate jump reference
+ MOVEM B,(FREE) ;put it in right half of new ref
+ MOVEM ZPC,1(FREE) ;put out pc of ref
+ MOVEM Z,2(FREE) ;put of bptr of ref
+ ADDI FREE,3
+ MOVEM FREE,LCLPTR ;update free ptr
+ JRST POPCB
+
+SUBTTL FIXUPS
+
+;fixup forward references
+; a/ value
+; c/ ptr chain
+FIXUP: TRNN C,-1 ;if empty fixup chain, return immediately
+ POPJ P, ; only happens for local labels
+ PUSH P,SAVZPC
+ PUSH P,SAVZ
+ PUSH P,ZPC
+ PUSH P,Z ;fix up references
+ PUSH P,A
+FIXUPL: HRRZ A,(P) ;pick up value to output
+ MOVE Z,2(C) ;pick up reference output ptr
+ MOVEM Z,SAVZ
+ MOVE ZPC,1(C)
+ MOVEM ZPC,SAVZPC
+ MOVE B,(C)
+ TLNE B,%RJUMP ;jump ref?
+ JRST FIXUPJ ; yes
+ JUMPGE B,[PUSHJ P,ADDWRD
+ JRST FIXUPN]
+ PUSHJ P,ADDBYT
+FIXUPN: SKIPE PDEBUG
+ PUSHJ P,PFIXUP
+ HRRZ C,(C) ;move to next one
+ JUMPN C,FIXUPL
+FIXUPX: POP P,A
+ POP P,Z
+ POP P,ZPC
+ POP P,SAVZ
+ POP P,SAVZPC
+ POPJ P,
+
+;here to fix up jumps
+FIXUPJ: MOVE 1(C) ;pc of ref
+ SUB A,0 ;pc difference (true/false and pc diff cancel?)
+ TLNE B,%RBYTE ;byte ref?
+ JRST FIXSHJ ; means short jump
+ ANDI A,177777 ;and it down (two's comp.)
+ CAIGE A,77 ;skip if couldn't have been short
+ AOS SHRIMP ;keep count of short jumps
+ PUSHJ P,ADDWRD
+ MOVE A,(P) ;get value back
+ JRST FIXUPN ;and continue
+
+;here to fix up short jumps
+FIXSHJ: ADDI A,1 ;pc offset
+ ANDI A,177777 ;max size of a reference
+ CAILE A,77 ;can it be a short jump?
+ HALTF ; better be!
+ ANDI A,377 ;and it down just ofr good measure
+ PUSHJ P,ADDBYT ;output byte
+ MOVE A,(P) ;resnarf value
+ JRST FIXUPN ;and loop
+
+;when debugging, print fixups when they are done
+PFIXUP: PUSH P,A
+ PUSH P,B
+ PUSH P,C
+ MOVE A,PDEBUG
+ MOVEI B,"{
+ BOUT
+ PUSHJ P,OPC
+ MOVEI C,0
+ HRROI B,[ASCIZ /}
+/]
+ SOUT
+ JRST POPCBA
+
+SUBTTL ERROR MESSAGES
+
+ERROR: PUSH P,B
+ SETZ B,
+ PUSHJ P,ERRMSG
+ POP P,B
+ POPJ P,
+
+;takes message in A, token in B
+ERRMSG: PUSH P,A
+ PUSH P,B
+ PUSH P,C
+ MOVEI A,.PRIOU
+ MOVE B,ZPC
+ MOVEI C,8
+ NOUT
+ JFCL
+ SKIPN FUNCT
+ JRST ERRMS1
+ MSG [ (in ]
+ PSOUT
+ MOVE A,FUNCT
+ PSOUT
+ MSG [)]
+ PSOUT
+ERRMS1: MSG [ ]
+ PSOUT
+ MOVE A,-2(P)
+ PSOUT
+ MOVE B,-1(P)
+ JUMPE B,ERREND
+ MOVEI A,[ASCIZ /: /]
+ PSOUT
+ MOVE A,B
+ PSOUT
+ PUSHJ P,PCRLF
+ HRROI A,BUFFER
+ PSOUT
+ SKIPA
+ERREND: PUSHJ P,PCRLF
+ POP P,C
+ POP P,B
+ POP P,A
+ POPJ P,
+
+SUBTTL STRING ASSEMBLY
+
+;zstrings from strings
+; a/ ptr to string to translate
+MAKFRQ: SETOM FREQST
+ MOVEI H,-1
+ JRST MAKST1
+
+MAKWRD: MOVEI H,2 ;count of words allowed (six chars max)
+ SETZM FREQST ;not frequency string
+ JRST MAKST1
+
+MAKSTR: MOVEI H,-1 ;many words allowed
+ SETZM FREQST ;not frequency string
+
+MAKST1: SETOM STRFLG
+ SKIPE CDEBUG
+ PUSHJ P,CSTRNG
+ MOVEI D,0 ;char set
+ MOVEI E,3 ;"old" character set
+ MOVEM E,ZCSET ;save it away
+ZSTRW: MOVEI F,0 ;build words here
+ MOVEI G,3 ;count of chars in word
+ZSTRLP: MOVE B,A
+ ILDB C,B ;pick up next character
+ CAIN C,^J
+ JRST [MOVE A,B
+ JRST ZSTRLP] ;linefeeds ignored
+ JUMPE C,ZSTRND ;leave if zero
+ JRST ZCHAR
+
+;here to output a character
+ZOUT: SKIPE CDEBUG
+ PUSHJ P,COUT
+ LSH F,5 ;5 bits wide
+ ADD F,C ;add in new character
+ SOJG G,ZSTRLP ;loop if haven't filled a word
+ PUSHJ P,OUTSTW ;put word out
+ SOJG H,ZSTRW ;loop if haven't counted out words
+
+ZSTRND: CAIG H,2 ;building string or word?
+ JRST ZWRDND ; word
+ CAIN G,3 ; string
+ JRST ZSTRTG
+ZSTRN1: LSH F,5
+ ADDI F,5
+ SOJG G,ZSTRN1
+ PUSHJ P,OUTSTW
+ZSTRTG: LDB G,LSTRWD
+ TRO G,200
+ DPB G,LSTRWD
+ SETZM STRFLG
+ POPJ P,
+
+ZWRDND: JUMPE H,ZSTRTG
+ LSH F,5
+ ADDI F,5
+ SOJG G,ZWRDND
+ PUSHJ P,OUTSTW
+;reset counter and string
+ MOVEI G,3
+ MOVEI F,0
+ SOJG H,ZWRDND
+ JRST ZSTRTG
+
+;here to do character set changes
+ZCHAR: PUSHJ P,ZCS ;get set for character
+ SKIPE FREQST ;don't do this hair if not GSTR or PRINTI string
+ CAIG H,4 ;assembling string?
+ JRST ZCHAR1 ;no, word, ignore freq. junk
+; CAIN C,40
+; JRST ZCHARS
+; CAIG E,1
+; CAML E,ZCSET
+; JRST ZCHAR1
+; MOVE 0,ZCSET
+; CAIG 0,1
+; JRST ZCHAR1
+ZCHARS: PUSHJ P,WFREQ ;takes string in a, returns ptr in a
+ JRST ZCHAR1
+;word is in frequency table
+ LSH F,5
+ PUSH P,D
+ IDIVI C,32.
+ ADDI F,1(C) ; get the right table
+ MOVE C,D ; remainder is output next
+ POP P,D
+ SKIPE CDEBUG
+ JRST [PUSH P,C
+ MOVEI C,1
+ PUSHJ P,COUT
+ POP P,C
+ JRST .+1]
+ SOJG G,ZOUT
+ PUSHJ P,OUTSTW
+ MOVEI F,0
+ MOVEI G,3
+ JRST ZOUT
+
+ZCHAR1: MOVE A,B
+ MOVEM E,ZCSET
+ CAIN E,3
+ JRST [MOVEI C,0
+ JRST ZOUT]
+ CAMN D,E ;same as current?
+ JRST ZCC
+;next char is different set, see if next-next is the same
+ MOVE B,A ;see if next-next character is same different set
+ZNEXT: ILDB 0,B ;get next-next
+ JUMPE 0,ZCHCS ;no next-next character
+ CAIN 0,^J
+ JRST ZNEXT ;linefeeds don't count
+ PUSH P,C ;save next char
+ PUSH P,E ; and its set
+ MOVE C,0 ;get next-next
+ PUSHJ P,ZCS ;set for next-next
+;decide whether to change set temp. or perm.
+
+ JRST ZCHCST
+
+;code for permanent shifting rests in peace below
+;some day it may be resurrected (consult the ZIP document)
+
+ CAME E,(P) ;same set as next?
+ JRST ZCHCST ; go change temporarily
+ZCHCSP: POP P,E ;new permanent char set
+ POP P,C ;char
+;calculate byte for new permanent set
+ PUSH P,H
+ EXCH D,E
+ SUBM D,E
+ MOVE H,E
+ ADDI H,3
+ IDIVI H,3
+ ADDI I,3
+ POP P,H ;new perm. set in I
+
+;output set change byte
+ZOUTB: SKIPE CDEBUG
+ JRST [PUSH P,C ;save next char
+ MOVE C,I
+ PUSHJ P,COUT
+ POP P,C
+ JRST .+1]
+ LSH F,5
+ ADD F,I ;output new char set.
+ SOJG G,ZCC
+;output this word and then continue
+ PUSHJ P,OUTSTW
+ SOJE H,CPOPJ ;end for zwords
+ MOVEI F,0
+ MOVEI G,3
+ JRST ZCC
+
+;calculate byte for temporary set
+ZCHCST: POP P,E ;temporary char set
+ POP P,C
+
+;;ZCHCS: PUSH P,H
+
+ZCHCS: MOVEI I,3(E)
+ JRST ZOUTB
+
+;hairy shift code removed
+
+;; SUB E,D
+;; MOVE H,E
+;; ADDI H,3
+;; IDIVI H,3
+;; ADDI I,1
+;; POP P,H
+;; JRST ZOUTB
+
+ZCC: PUSHJ P,ZCB ;get byte
+ JRST ZOUT ;winning char
+;here for characters not in the normal set
+ZASCII: LSH F,5
+ ADDI F,6 ;add in ascii escape byte
+ SKIPE CDEBUG
+ JRST [PUSH P,C
+ MOVEI C,6
+ PUSHJ P,COUT
+ POP P,C
+ JRST .+1]
+ SOJG G,ZASCI1
+ PUSHJ P,OUTSTW
+ SOJE H,CPOPJ ;end for zwords
+ MOVEI F,0
+ MOVEI G,3
+ZASCI1: MOVE B,C
+ LSH B,-5
+ LSH F,5
+ ADD F,B
+ SKIPE CDEBUG
+ JRST [PUSH P,C
+ MOVE C,B
+ PUSHJ P,COUT
+ POP P,C
+ JRST .+1]
+ SOJG G,ZASCI2
+ PUSHJ P,OUTSTW
+ SOJE H,CPOPJ ;end for zwords
+ MOVEI F,0
+ MOVEI G,3
+ZASCI2: ANDI C,37
+ JRST ZOUT
+
+
+;lookup word in word table
+; a/ word
+; +1: not found, loc to add in (A)
+; +2: found, word is at (A)
+
+WFREQ: PUSH P,B
+ PUSH P,F
+ PUSH P,G
+ PUSH P,H
+ SKIPL G,WRDTAB
+ JRST WFREQX
+ HRRZ G,G ;initial center point
+ HRRZ F,G ;initial low point
+ MOVEI H,WRDTND ;initial high point
+;calculate test point
+WFREQ1: CAML F,H ;not hit yet?
+ JRST WFREQX
+ SUB G,F ;minus low point
+ LSH G,-1 ;divide by two
+ TRZ G,1 ;must be multiple of two (size of entries)
+ ADD G,F ;plus low
+;test
+ MOVE B,1(G) ;get test
+ PUSHJ P,SFREQ
+ JRST WFREQQ ;found it
+ SKIPA H,G ;sample before
+ MOVEI F,2(G) ;sample after
+ MOVE G,H ;high point
+ JRST WFREQ1
+
+WFREQQ: AOS -4(P)
+ MOVE C,(G) ;value
+WFREQX: POP P,H
+ POP P,G
+ POP P,F
+ POP P,B
+ POPJ P,
+
+;a/ sample
+;b/ word from table
+; +1: =
+; +2: a>b
+; +3: b>a
+
+SFREQ: PUSH P,A
+ PUSH P,C
+FREQN: ILDB C,B
+ JUMPE C,FREQQ
+ ILDB 0,A
+ CAME 0,C
+ JRST FREQD
+ JRST FREQN
+
+FREQQ: POP P,C
+ POP P,0
+ POPJ P,
+
+FREQD: CAML 0,C
+ AOS -2(P)
+ AOS -2(P)
+ POP P,C
+ POP P,A
+ POPJ P,
+
+SUBTTL OUTPUT A STRING WORD
+
+;output a string word
+;F/ string word
+OUTSTW: PUSH P,A
+ PUSH P,B
+ PUSH P,C
+ MOVE A,F
+ LSH A,-10
+ PUSHJ P,OUTBYT
+ MOVEM Z,LSTRWD ;save z so stop bit can be stuck in later
+ MOVE A,F
+ ANDI A,377
+ PUSHJ P,OUTBYT ;low byte
+ POP P,C
+ POP P,B
+ POP P,A
+ POPJ P,
+
+SUBTTL Conversion of ASCII to ZASCII
+
+;return which cs chr in C is in. returns in E
+ZCS: CAIE C,40
+ JRST ZNRM
+ MOVEI E,3 ;in all sets, return "set" 3
+ POPJ P,
+
+ZNRM: CAIL C,"a ;CS 0?
+ CAILE C,"z
+ JRST ZNRM1
+ MOVEI E,0
+ POPJ P,
+
+ZNRM1: CAIL C,"A ;CS 1?
+ CAILE C,"Z
+ JRST ZNRM2
+ MOVEI E,1
+ POPJ P,
+
+ZNRM2: MOVEI E,2 ;everything else is CS 2
+ POPJ P,
+
+;return byte for this character
+; C/ character
+;returns
+; C/ value
+;skip returns if character must be ascii escaped
+ZCB: CAIE C,"
+ JRST .+3
+ MOVEI C,0 ;space = 0
+ POPJ P,
+
+ CAIL C,"a
+ CAILE C,"z
+ JRST ZC1
+ SUBI C,"a-6 ;a-z = 6-37
+ POPJ P,
+
+ZC1: CAIL C,"A
+ CAILE C,"Z
+ JRST ZC2
+ SUBI C,"A-6 ;A-Z = 6-37
+ POPJ P,
+
+ZC2: CAIN C,^M
+ JRST [MOVEI C,7
+ POPJ P,]
+ CAIL C,"0
+ CAILE C,"9
+ JRST ZCFNY
+ SUBI C,"0-8
+ POPJ P,
+
+;in set 2 but not a number, search for it
+ZCFNY: PUSH P,A
+ MOVNI A,16.
+ CAMN C,CS2CH(A)
+ JRST ZCFND ;got it
+ AOJL A,.-2
+ AOSA -1(P) ;skip return means is not a usual character
+ZCFND: MOVE C,CS2VL(A) ;return value in C
+ POP P,A
+ POPJ P,
+
+;table of characters in set 2 and their values
+ 40 ? ". ? ", ? "! ? "?
+ "_ ? "# ? "' ? "" ? "/
+ "\ ? "- ? ": ? "( ? ")
+CS2CH:
+ 6 ? 22 ? 23 ? 24 ? 25
+ 26 ? 27 ? 30 ? 31 ? 32
+ 33 ? 34 ? 35 ? 36 ? 37
+CS2VL:
+
+SUBTTL STRING ASSEMBLY DEBUGGING
+
+;print zstring being assembled
+;only called if CDEBUG is not 0
+; a/ bptr to string
+CSTRNG: PUSH P,A
+ PUSH P,B
+ PUSH P,C
+ SKIPN A,PDEBUG ;pick up script channel
+ MOVEI A,.PRIOU ;or tty
+ MOVEI C,0
+ HRROI B,[ASCIZ /
+"/]
+ SOUT
+ MOVE B,-2(P)
+ SOUT
+ HRROI B,[ASCIZ /"
+/]
+ SOUT
+ JRST POPCBA
+
+;print character being produced for a zstring
+;only called if CDEBUG is not 0
+; b/ character
+COUT: PUSH P,A
+ PUSH P,B
+ PUSH P,C
+ MOVE B,C
+ SKIPN A,PDEBUG ;pick up script channel
+ MOVEI A,.PRIOU ;or tty if there is no script
+ MOVEI C,8 ;radix 8
+ HRLI C,(NO%ZRO+NO%LFL)+2 ;always print two column, pad with 0
+ NOUT
+ JFCL
+ MOVEI B,40 ;terminate with space
+ BOUT
+POPCBA: POP P,C
+ POP P,B
+ POP P,A
+ POPJ P,
+
+SUBTTL ROUTINE FOR PRINTING CURRENT ZFUNCTION NAME AND CURRENT PC
+
+PFUNCT: PUSH P,A
+ PUSH P,B
+ PUSH P,C
+ HRROI A,[ASCIZ / = /]
+ PSOUT
+ MOVE B,CODLEN
+ MOVEI A,.PRIOU
+ SUB B,CODSAV'
+ MOVEI C,0
+ NOUT
+ JFCL
+ MOVE B,CODLEN
+ MOVEM B,CODSAV
+ MOVEI A,^M
+ PBOUT
+ MOVEI A,^J
+ PBOUT
+ MOVE A,FUNCT
+ PSOUT
+ MOVEI A,^I
+ PBOUT
+ MOVEI A,.PRIOU
+ MOVE B,ZPC
+ MOVEI C,10.
+ NOUT
+ JFCL
+ POP P,C
+ POP P,B
+ POP P,A
+ POPJ P,
+
+SUBTTL WORD FREQUENCY PASS GOODIES GO HERE
+
+FREQ: MOVE A,1(TP)
+ CAIE A,":
+ JRST FREQ1
+ NXTARG 1
+ JRST FREQ
+FREQ1: SKIPN A,(TP)
+ SKIPE 1(TP)
+ SKIPA
+ POPJ P,
+ PUSHJ P,LOOKUP
+ POPJ P,
+ JUMPL B,FPSEUDO
+ JRST FOPER
+
+FOPER: TLNN B,%STR
+ POPJ P,
+ NXTARG 1
+ MOVE D,(TP)
+ PUSHJ P,NEWWRD
+ POPJ P,
+
+FPSEUD: HRRZ B,B
+ CAIE B,ZINSER
+ CAIN B,ZENDI
+ JRST (B)
+
+ CAIE B,ZSTRL
+ CAIN B,ZSTR
+ JRST FPSEU1
+ CAIE B,ZGSTR
+ POPJ P,
+
+FPSEU2: NXTARG 1
+FPSEU1: NXTARG 1
+ SKIPN D,(TP)
+ JRST TFARG
+ PUSHJ P,NEWWRD
+ POPJ P,
+
+;main entry to count frequency of words in a particular string
+; called with string pointer in D
+
+NEWWRD: JUMPE D,CPOPJ
+ MOVE E,[440700,,WRDBUF]
+ MOVEI J,0 ;count of bytes
+NXTWRD: ILDB A,D
+ JUMPE A,CPOPJ
+ PUSHJ P,PUNCT
+ JRST WRDSTA ;if punct. sequence
+ PUSHJ P,ALPHA
+ JRST NXTWRD
+ TRNN A,40 ;l.c. letter?
+WRDSTA: ADDI J,1 ;U.C. letter takes additional byte
+
+WRDBEG: IDPB A,E
+ ADDI J,1
+ MOVE F,D ;save this pointer
+ ILDB A,D
+ JUMPE A,WRDEOS
+ PUSHJ P,ALPHA
+ JRST WRDEND ;not alphabetic
+ JRST WRDBEG
+
+;here check for ' followed by alphabetic (turn ' into alphabetic)
+WRDQUT: PUSH P,A
+ PUSH P,D
+ ILDB A,D
+ PUSHJ P,ALPHA
+ JRST [POP P,D
+ POP P,A
+ JRST WRDEN1]
+ POP P,D
+ POP P,A
+ ADDI J,1 ;' takes two bytes
+ JRST WRDBEG
+
+WRDEOS: MOVEI D,0 ;end of input string
+ JRST WRDEN2
+WRDEND: CAIN A,"'
+ JRST WRDQUT
+WRDEN1: CAIN A,40 ;SP is included in words
+ JRST [IDPB A,E
+ ADDI J,1
+ JRST WRDEN3]
+ MOVE D,F ;recover non-spaced bptr
+WRDEN3: MOVEI A,0
+WRDEN2: IDPB A,E
+ MOVE A,[440700,,WRDBUF]
+ PUSHJ P,WLOOK
+ JRST WRDADD ;not there, go add it
+ AOS (G) ;add to its usage count
+ JRST NEWWRD
+
+WRDADD: SKIPN WDEBUG
+ JRST WRDAD1
+ MSG ["]
+ PSOUT
+ MOVE A,[440700,,WRDBUF]
+ PSOUT
+ MSG ["
+]
+ PSOUT
+
+WRDAD1: MOVE A,TABPTR
+ TLNN A,400000
+ JRST [HRLI A,440700
+ ADDI A,1
+ JRST .+1]
+ MOVE H,A
+ MOVE B,[440700,,WRDBUF]
+ MOVEI C,0
+ SOUT ;copy string to buffer
+ IDPB C,A
+ MOVEM A,TABPTR
+;update table pointer
+ PUSH P,G
+ MOVE G,WRDTAB
+ SUB G,[2,,2]
+ MOVEM G,WRDTAB
+ POP P,G
+;make a slot for new entry
+ HRRZ A,WRDTAB
+ HRLI A,2(A)
+ BLT A,-1(G)
+;put out new entry
+ MOVEM H,-1(G) ;string
+ MOVEI H,1
+ HRL H,J ;size of string in bytes
+ MOVEM H,-2(G) ;count
+ JRST NEWWRD
+
+;here when all done
+FILEND: PUSHJ P,BYTES
+ PUSHJ P,SORT
+
+;here to output the data
+ MOVE A,[440700,,[ASCIZ /FREQ.ZAP/]]
+ MOVE B,OUTPTR
+ ILDB 0,A
+ IDPB 0,B
+ JUMPN 0,.-2
+ MOVSI A,(GJ%SHT+GJ%FOU)
+ HRROI B,OUTFIL
+ GTJFN
+ JRST ERPRNT
+ HRRZ A,A
+ MOVEM A,OJFN
+ MOVE B,[070000,,OF%WR]
+ OPENF
+ JRST ERPRNT
+
+;output the goodies
+ MOVE G,WRDTAB
+ HRLI G,-<2*96.>
+ PUSHJ P,PTAB
+
+;output garbage at end
+
+ MOVE A,OJFN
+ HRROI B,[ASCIZ /
+
+;word frequency table of 96 most common words
+
+WORDS:: .TABLE
+ FSTR?1
+ FSTR?2
+ FSTR?3
+ FSTR?4
+ FSTR?5
+ FSTR?6
+ FSTR?7
+ FSTR?8
+ FSTR?9
+ FSTR?10
+ FSTR?11
+ FSTR?12
+ FSTR?13
+ FSTR?14
+ FSTR?15
+ FSTR?16
+ FSTR?17
+ FSTR?18
+ FSTR?19
+ FSTR?20
+ FSTR?21
+ FSTR?22
+ FSTR?23
+ FSTR?24
+ FSTR?25
+ FSTR?26
+ FSTR?27
+ FSTR?28
+ FSTR?29
+ FSTR?30
+ FSTR?31
+ FSTR?32
+ FSTR?33
+ FSTR?34
+ FSTR?35
+ FSTR?36
+ FSTR?37
+ FSTR?38
+ FSTR?39
+ FSTR?40
+ FSTR?41
+ FSTR?42
+ FSTR?43
+ FSTR?44
+ FSTR?45
+ FSTR?46
+ FSTR?47
+ FSTR?48
+ FSTR?49
+ FSTR?50
+ FSTR?51
+ FSTR?52
+ FSTR?53
+ FSTR?54
+ FSTR?55
+ FSTR?56
+ FSTR?57
+ FSTR?58
+ FSTR?59
+ FSTR?60
+ FSTR?61
+ FSTR?62
+ FSTR?63
+ FSTR?64
+ FSTR?65
+ FSTR?66
+ FSTR?67
+ FSTR?68
+ FSTR?69
+ FSTR?70
+ FSTR?71
+ FSTR?72
+ FSTR?73
+ FSTR?74
+ FSTR?75
+ FSTR?76
+ FSTR?77
+ FSTR?78
+ FSTR?79
+ FSTR?80
+ FSTR?81
+ FSTR?82
+ FSTR?83
+ FSTR?84
+ FSTR?85
+ FSTR?86
+ FSTR?87
+ FSTR?88
+ FSTR?89
+ FSTR?90
+ FSTR?91
+ FSTR?92
+ FSTR?93
+ FSTR?94
+ FSTR?95
+ FSTR?96
+ .ENDT
+
+ .ENDI
+/]
+ MOVEI C,0
+ SOUT
+
+ MOVE A,OJFN
+ CLOSF
+ JFCL
+
+ MSG [Best 96 words: ]
+ PSOUT
+ MOVEI A,.PRIOU
+ MOVE B,D
+ MOVEI C,10.
+ NOUT
+ JFCL
+ MSG [ zbytes saved, ]
+ PSOUT
+ MOVEI A,.PRIOU
+ MOVE B,E
+ NOUT
+ JFCL
+ MSG [ uses.
+]
+ PSOUT
+
+ HALTF
+
+;calculate bytes saved
+BYTES: MOVE A,WRDTAB
+BYTES1: HRRZ B,(A)
+ HLRZ C,(A)
+ SUBI C,2
+ IMUL B,C
+ HRLM B,(A)
+ ADD A,[2,,2]
+ JUMPL A,BYTES1
+ POPJ P,
+
+;sort word table by bytes saved
+SORT: MOVE A,WRDTAB
+;next slot of table
+SORTM: MOVE B,A
+ SETZB C,D
+ SETZ E,
+;next try for largest number
+SORTN: CAMLE C,(B)
+ JRST SORTL
+;pick up new candidate
+ MOVE C,(B)
+ MOVE D,1(B)
+ MOVE E,B
+SORTL: ADD B,[2,,2]
+ JUMPL B,SORTN
+;end of pass
+ JUMPE C,SORTO
+ EXCH C,(A)
+ MOVEM C,(E)
+ EXCH D,1(A)
+ MOVEM D,1(E)
+;move to next slot
+SORTO: MOVE C,(A)
+SORTP: ADD A,[2,,2]
+ JUMPGE A,CPOPJ
+ CAMN C,(A)
+ JRST SORTP
+ JRST SORTM
+
+NEXT31: MOVE A,WRDTAB
+ ADD A,[76,,76]
+ MOVEM A,WRDTAB
+N31LUP: HRRZ B,(A)
+ HLRZ C,(A)
+ IDIV C,B
+ SUBI C,1
+ HRLM C,(A)
+ ADD A,[1,,1]
+ AOBJN A,N31LUP
+ PUSHJ P,BYTES
+ PUSHJ P,SORT
+ POPJ P,
+
+
+PSAVED: MSG [31 words: ]
+ PSOUT
+ MOVEI A,.PRIOU
+ MOVE B,D
+ MOVEI C,10.
+ NOUT
+ JFCL
+ MSG [ zbytes saved, ]
+ PSOUT
+ MOVEI A,.PRIOU
+ MOVE B,E
+ NOUT
+ JFCL
+ MSG [ uses.
+
+]
+ PSOUT
+ POPJ P,
+
+PTABS: MOVEI A,101
+ MOVEM A,OJFN
+ MOVE G,WRDTAB
+ HRLI G,-76
+ PUSHJ P,PTAB
+ PUSHJ P,PSAVED
+ PUSHJ P,NEXT31
+ MOVE G,WRDTAB
+ HRLI G,-76
+ PUSHJ P,PTAB
+ PUSHJ P,PSAVED
+ PUSHJ P,NEXT31
+ MOVE G,WRDTAB
+ HRLI G,-76
+ PUSHJ P,PTAB
+ PUSHJ P,PSAVED
+ POPJ P,
+
+PTABLE: PUSH P,G
+ MOVE G,WRDTAB
+ PUSHJ P,PTAB
+ POP P,G
+ POPJ P,
+
+PTAB: PUSH P,A
+ PUSH P,B
+ PUSH P,C
+ SETZB D,E
+ MOVEI F,0
+PTLOOP: MOVE A,OJFN
+ HRROI B,[ASCIZ / .FSTR FSTR?/]
+ MOVEI C,0
+ SOUT
+ ADDI F,1
+ MOVE B,F
+ MOVEI C,10.
+ NOUT
+ JFCL
+ HRROI B,[ASCIZ /,"/]
+ MOVEI C,0
+ SOUT
+ MOVE B,1(G)
+ SOUT
+ HRROI B,[ASCIZ /" ;/]
+ SOUT
+ MOVE A,OJFN
+ HLRZ B,(G)
+ ADD D,B
+ MOVEI C,10.
+ NOUT
+ JFCL
+ MOVEI B,11
+ BOUT
+ HRRZ B,(G)
+ ADD E,B
+ MOVEI C,10.
+ NOUT
+ JFCL
+ MOVEI B,15
+ BOUT
+ MOVEI B,12
+ BOUT
+ ADD G,[2,,2]
+ JUMPL G,PTLOOP
+ POP P,C
+ POP P,B
+ POP P,A
+ POPJ P,
+
+;lookup word in word table
+; a/ word
+; +1: not found, loc to add in (g)
+; +2: found, word is at (g)
+
+WLOOK: SKIPL G,WRDTAB
+ POPJ P,
+ HRRZ G,G ;initial center point
+ HRRZ F,G ;initial low point
+ MOVEI H,WRDTND ;initial high point
+;calculate test point
+LOOK1: CAML F,H ;not hit yet?
+ POPJ P,
+ SUB G,F ;minus low point
+ LSH G,-1 ;divide by two
+ TRZ G,1 ;must be multiple of two (size of entries)
+ ADD G,F ;plus low
+;test
+ MOVE B,1(G) ;get test
+ PUSHJ P,SCOMP
+ JRST LOOKEQ ;found it
+ SKIPA H,G ;sample before
+ MOVEI F,2(G) ;sample after
+ MOVE G,H ;high point
+ JRST LOOK1
+
+LOOKEQ: AOS (P)
+ POPJ P,
+
+;a/ sample
+;b/ word from table
+; +1: =
+; +2: a>b
+; +3: b>a
+
+SCOMP: PUSH P,A
+ PUSH P,C
+COMPN: ILDB 0,A
+ ILDB C,B
+ CAME 0,C
+ JRST COMPD
+ JUMPE 0,COMPX
+ JRST COMPN
+COMPX: POP P,C
+ POP P,A
+ POPJ P,
+
+COMPD: CAML 0,C
+ AOS -2(P)
+ AOS -2(P)
+ JRST COMPX
+
+ALPHA: CAIL A,"A
+ CAILE A,"Z
+ SKIPA
+ JRST ALPHA1
+ CAIL A,"a
+ CAILE A,"z
+ POPJ P,
+ALPHA1: AOS (P)
+ POPJ P,
+
+PUNCT: CAIE A,",
+ CAIN A,".
+ POPJ P,
+ CAIE A,"!
+ CAIN A,"?
+ POPJ P,
+ AOS (P)
+ POPJ P,
+
+
+SUBTTL VARIABLES AND BUFFERS
+
+;debugging flags
+SDEBUG: 0 ;if non-0, print symbol table
+PDEBUG: 0 ;if non-0, print lines as they are read
+TDEBUG: 0 ;if non-0, print tokens after parsing them
+ODEBUG: 0 ;if non-0, print opers info
+CDEBUG: 0 ;if non-0, print strings in "zascii"
+FDEBUG: 0 ;if non-0, print functions as they are found
+STOP: 0 ;if non-0, location to halt at (for changing flags)
+SYMFLG: 0 ;if non-0, output symbol table
+
+;flags for word frequency pass
+DOFREQ: 0 ;if non-0, this is word frequency run, not assy.
+WDEBUG: 0 ;if non-0, print new words during frequency pass
+
+;i/o goodies
+
+;gtjfn block for normal file opening
+GTJFNB: GJ%OLD ;flags
+ .NULIO,,.NULIO ;jfns
+ 0 ;device
+ 0 ;dir
+ -1,,[ASCIZ /ZIPTEST/] ;name
+ -1,,[ASCIZ /ZAP/] ;ext
+ 0 ;prot
+ 0 ;acct
+ 0 ;jfn
+
+;gtjfn block for normal file opening
+GTJFNX: GJ%OLD ;flags
+ .NULIO,,.NULIO ;jfns
+ 0 ;device
+ 0 ;dir
+ -1,,[ASCIZ /ZIPTEST/] ;name
+ -1,,[ASCIZ /XZAP/] ;ext
+ 0 ;prot
+ 0 ;acct
+ 0 ;jfn
+
+;gtjfn block for reading file name from tty
+GTJFNT: GJ%OLD+GJ%EXT ;flags
+ .PRIIN,,.PRIOU ;jfns
+ 0 ;device
+ -1,,[ASCIZ /INFOCOM.ZORK/] ;dir
+ -1,,[ASCIZ /ZIPTEST/] ;name
+ -1,,[ASCIZ /ZAP/] ;ext
+ 0 ;prot
+ 0 ;acct
+ 0 ;jfn
+ 0 ;f2
+ 0 ;input copy
+ 0 ;
+ -1,,[ASCIZ /File/]
+ 0
+ 0
+
+;output gtjfn
+OUTPTR: 440700,,OUTFIL
+OUTFIL: BLOCK 20
+
+OJFN: 0 ;old input jfn, for when .INSERT done
+IJFN: 0 ;input jfn
+FILBUF: BLOCK 20.
+FILPTR: 0
+JOBNAM: ASCIZ /MUDDLE/
+
+PDL: BLOCK 100 ;stack
+
+ZAPID: 3 ;zap id number (assembly language version)
+
+FLGWRD: 0 ;1 if byte swapped (not implemented)
+%BYTSWP==1 ;flag word bit for byte-swapped mode
+%TIMESL==2 ;flag word bit for 'time' status line
+
+RELEAS: -1 ;release number
+
+;various assembler variables
+SAVZPC: 0 ;saved pc used mostly by debugging printers
+SAVZ: 0 ;saved output ptr ditto
+
+TABLE: 0 ;if in table, holds pc of table start
+TABLEN: 0 ;if in table, holds max length or -1 if none
+
+GLBTOT: 0 ;how many globals he made (limit is 255-20)
+GLBCNT: 17 ;current global (1-17 are really locals)
+
+OBJTOT: 0 ;how many objects he made (limit is 255)
+OBJCNT: 0 ;current object
+
+FUNCT: 0 ;non-zero during function assy.
+FSYM: 0 ;symbol value of last function
+
+LSTSYM: 0 ;last symbol defined
+
+WRDBYT: 0 ;-1 if assembling byte, 0 if word
+JMPREF: 0 ;-1 if assembling jump, 0 otherwise
+SHRIMP: 0 ;long jumps that were wasted
+OSHRIM: 0 ;saved count of wasted long jumps
+
+;goodies for instruction assembly
+
+NOREF: 0 ;-1 if not to assemble references (as instruction operands
+ ;are moved into ARGBUF)
+
+OPER: 0 ;operator is saved here
+
+ARGBUF: BLOCK 14 ;args to operators, pairs of values and strings
+
+SENSE: 0 ;sense of predicate jump
+PRED: 0 ;value of predicate byte
+ 0 ;ptr to string defining it
+VAL: 0 ;value of value byte
+ 0 ;string defining it
+
+LSTRWD: 0 ;Z at last string word output saved here for stop bit addition
+
+;junk for second pass over functions
+TWOPAS: -1 ;-1 if two pass assembly
+PASS2: 0 ;-1 if doing second pass
+FPOS: 0 ;saved file pointer
+FZ: 0 ;saved z
+FZPC: 0 ;saved zpc
+FSHORT: 0 ;count of short jumps saved
+ZCSET: 0 ;char set of last character looked at
+
+;parsing information of various sorts
+BUFFER: BLOCK 1000 ;read in buffer
+
+TOKEN: BLOCK 1000 ;buffer for parsed tokens
+TOKPTR: 0 ; ptr into same
+
+TPDL: -100.,,TOKENS-1 ;stack for pairs of token/terminator
+TOKENS: BLOCK 100. ; points to here
+
+;junk to unsuccessfully fool GC-READ (joel is a twit)
+;this stuff is modified by OUTPUT
+HEADER: 1305 ;object plus type word
+ 1305
+ 1305
+ 122 ; ??
+ 41 ; ??
+ 51,,5374 ;type,,length
+ 41000,,2006 ;bptr to start
+
+FOOTER: 40003,,0 ;bytes
+ 1303,,3311 ;length,,self
+
+;get these out of the way
+VARIAB
+CONSTA
+
+SUBTTL SYMBOL TABLES
+
+SYMPTR: SYMBUF+2 ;ptr to symbol table buffer
+FCNPTR: FCNBUF ;ptr to function table buffer
+
+SYMSIZ==3 ;size of a symbol entry
+SYMNAM==0 ;offset of name slot
+SYMVAL==1 ;offset of value slot
+SYMREF==2 ;offset of references slot
+
+BUCKN==201. ;how many buckets
+BUCKL==25.*SYMSIZ ;how long buckets are
+
+;local symbol goodies
+LCLLST: 0 ;list of local symbols
+LCLPTR: LCLBUF ;ptr to free space in local symbol buffer
+LCLBUF: BLOCK 10000 ;local symbol pnames buffer
+
+LCLOBL: -<BUCKN*BUCKL>,,LCLTAB ;ptr to local symbol hash table
+LCLTAB: BLOCK BUCKN*BUCKL ;local symbol hash table
+LCLEND: 0 ;end of same
+
+;global symbol goodies
+GLBLST: 0 ;list of global symbols
+GLBPTR: GLBBUF ;ptr to free space in global symbol buffer
+GLBBUF: BLOCK 40000 ;global symbol pname buffer starts here
+
+GLBOBL: -<BUCKN*BUCKL>,,GLBTAB ;ptr to global symbol hash table
+GLBTAB: BLOCK BUCKN*BUCKL ;global symbol hash table
+GLBEND: 0 ;end of same
+
+;word frequency hack stuff is here
+FREQST: 0 ;-1 when assembling string that can have fstrs
+FSTRS: -1 ;count of .FSTRs seen
+WRDBUF: BLOCK 10.
+
+WRDTLN==20000.
+WRDTND==700000+WRDTLN-2
+
+WRDTAB: WRDTND
+TABPTR: 440700,,.+1
+ LOC .+1000
+
+;output buffer
+
+OUTBUF==<.+77777>&-100000 ;lies at 100000*n
+
+;symbol table hacks
+
+FCNBUF==OUTBUF+200000 ;function symbol tables made here
+SYMBUF==FCNBUF+10000 ;symbol tables made mapped here
+
+ END START
diff --git a/zap.mid b/zap.mid
new file mode 100644
index 0000000..06d811f
--- /dev/null
+++ b/zap.mid
@@ -0,0 +1,3800 @@
+TITLE ZAP -- New Z-Language Assembler
+
+; ZAP version 3 - Expanded word table to 96 words
+; MARC/JMB - 1/7/82
+
+ .DECSAV
+
+SUBTTL ACS
+
+ O=0
+ A=1
+ B=2
+ C=3
+ D=4
+ E=5
+ F=6
+ G=7
+ ZCHR=7
+ H=10
+ FRMT=10
+ I=11
+ J=12 ;called J only during word-frequency pass
+;acs below this point are used for special purposes
+ AB=12 ;pointer into argument table ARGBUF
+ Z=13 ;pointer into output buffer OUTBUF
+ ZPC=14 ;pc
+ FREE=15 ;free storage pointer for symbol tables
+ TP=16 ;pointer into token table TOKENS
+ P=17 ;stack
+
+%FWDCT==512.-16.
+
+;bits in symbol table words
+%UNDEF==400000 ;undefined symbol; right half will be ptr to references
+%VAR==200000 ;symbol is a variable
+%BITS==600000 ;all defined bits in symbol table
+
+;bits in reference words
+%RBYTE==400000 ;byte refs are flagged
+%RJUMP==200000 ;as are jump refs
+
+;random macros
+DEFINE MSG M
+ HRROI A,[ASCIZ /!M!/]
+TERMIN
+
+DEFINE NXTARG N
+ ADD TP,[<2*N>,,<2*N>]
+TERMIN
+
+ LOC 140
+
+SUBTTL PSEUDO-OPS AND OPCODES
+
+%PSEUD==400000 ;pseudo-op
+
+;pseudo-op definition macro
+DEFINE DISP SYM
+ 440700,,[ASCIZ /.!SYM/]
+ %PSEUD,,Z!SYM
+TERMIN
+
+%PRED==200000 ;predicate inst.
+%VAL==100000 ;value inst.
+%JUMP==40000 ;jump inst.
+%STR==20000 ;string instr.
+%XARG==10000 ;??
+
+;opcode definition macro
+DEFINE DEFOP OP,OPCODE,FLAGS
+ 440700,,[ASCIZ /OP/]
+ FLAGS,,OPCODE
+TERMIN
+SUBTTL PSEUDOS
+
+OPS:
+PSUTBL: DISP BYTE
+ DISP END
+ DISP ENDI
+ DISP ENDT
+ DISP EQUAL
+ DISP FALSE
+ DISP FSTR
+ DISP FUNCT
+ DISP GSTR
+ DISP GVAR
+ DISP INSERT
+ DISP LEN
+ DISP OBJECT
+ DISP PDEF
+ DISP PROP
+ DISP SEQ
+ DISP STR
+ DISP STRL
+ DISP TABLE
+ DISP TRUE
+ DISP WORD
+ DISP ZWORD
+OPRTBL: DEFOP ADD,20.,%VAL
+ DEFOP BAND,9.,%VAL
+ DEFOP BCOM,143.,%VAL
+ DEFOP BOR,8.,%VAL
+ DEFOP BTST,7.,%PRED
+ DEFOP CALL,224.,%VAL
+ DEFOP CRLF,187.
+ DEFOP DEC,134.
+ DEFOP DIV,23.,%VAL
+ DEFOP DLESS?,4.,%PRED
+ DEFOP EQUAL?,1.,%PRED+%XARG
+ DEFOP FCLEAR,12.
+ DEFOP FIRST?,130.,%PRED+%VAL
+ DEFOP FSET,11.
+ DEFOP FSET?,10.,%PRED
+ DEFOP FSTACK,185.
+ DEFOP GET,15.,%VAL
+ DEFOP GETB,16.,%VAL
+ DEFOP GETP,17.,%VAL
+ DEFOP GETPT,18.,%VAL
+ DEFOP GRTR?,3.,%PRED
+ DEFOP IGRTR?,5.,%PRED
+ DEFOP IN?,6.,%PRED
+ DEFOP INC,133.
+ DEFOP JUMP,140.,%JUMP
+OPJMP=.-1 ;full opcode for jump
+ DEFOP LESS?,2.,%PRED
+ DEFOP LOC,131.,%VAL
+ DEFOP MOD,24.,%VAL
+ DEFOP MOVE,14.
+ DEFOP MUL,22.,%VAL
+ DEFOP NEXT?,129.,%PRED+%VAL
+ DEFOP NEXTP,19.,%VAL
+ DEFOP NOOP,180.
+ DEFOP POP,233.
+ DEFOP PRINT,141.
+ DEFOP PRINTB,135.
+ DEFOP PRINTC,229.
+ DEFOP PRINTD,138.
+ DEFOP PRINTI,178.,%STR
+ DEFOP PRINTN,230.
+ DEFOP PRINTR,179.,%STR
+ DEFOP PTSIZE,132.,%VAL
+ DEFOP PUSH,232.
+ DEFOP PUT,225.
+ DEFOP PUTB,226.
+ DEFOP PUTP,227.
+ DEFOP QUIT,186.
+ DEFOP RANDOM,231.,%VAL
+ DEFOP READ,228.
+ DEFOP REMOVE,137.
+ DEFOP RESTART,183.
+ DEFOP RESTORE,182.,%PRED
+ DEFOP RETURN,139.
+ DEFOP RFALSE,177.
+ DEFOP RSTACK,184.
+ DEFOP RTRUE,176.
+ DEFOP SAVE,181.,%PRED
+ DEFOP SET,13.
+ DEFOP SUB,21.,%VAL
+ DEFOP USL,188.
+ DEFOP VALUE,142.,%VAL
+ DEFOP VERIFY,189.,%PRED
+ DEFOP ZERO?,128.,%PRED
+
+OPCNT==<.-OPS>/2 ;number of pseudos and operators altogether
+
+SUBTTL START UP -- READ JCL AND OPEN INPUT FILE
+
+START: RESET
+ MOVE P,[-77,,PDL]
+ SETZ A,
+ RSCAN
+ JFCL
+ JUMPE A,NOJCL ; NO JCL, FLUSH
+
+;read jcl line
+ MOVN C,A
+ MOVEI A,.PRIIN
+ MOVE B,[440700,,FILBUF]
+ SIN ; READ JCL
+
+;parse jcl line
+ MOVE B,[440700,,FILBUF]
+NAMLOP: ILDB A,B
+ CAILE A,40
+ JRST NAMLOP
+NAMDON: CAIE A,^M
+ CAIN A,^J
+ JRST NOJCL
+ MOVEM B,FILPTR ;should be file spec start
+ ILDB A,B
+ CAIL A,40
+ JRST .-2
+ MOVEI A,0
+ DPB A,B
+ MOVE B,FILPTR
+ PUSHJ P,OPEN ;open file
+ JRST BEGIN
+
+;here if no jcl, read file name from tty
+NOJCL: PUSHJ P,TOPEN
+ JRST BEGIN
+
+SUBTTL FILE NAME READING AND FILE OPENING
+
+OPEN: PUSHJ P,FOPEN
+ JRST TOPEN ;open failed, try from tty
+ POPJ P,
+
+;read file name from tty
+TOPEN: MSG [
+File: ]
+ PSOUT
+ MOVEI A,GTJFNT
+ MOVEI B,0
+ PUSHJ P,FOPEN1
+ JRST TOPEN
+ POPJ P,
+
+;open a file
+; b/ file name
+;skips if wins
+FOPEN: MOVEI A,GTJFNB
+ PUSH P,B
+ GTJFN
+ SKIPA
+ JRST FOPEN2
+ MOVEI A,GTJFNX
+ MOVE B,(P)
+ JRST FOPEN0
+
+FOPEN1: PUSH P,B
+FOPEN0: GTJFN
+ JRST NOFILE
+FOPEN2: TLZ A,-1
+ MOVEM A,IJFN ; SAVE CURRENT INPUT JFN
+ MOVE B,[070000,,240000]
+ OPENF ; HAS TO BE OPEN
+ JRST NOFIL1
+ POP P,B
+ AOS (P)
+ POPJ P,
+
+;gtjfn failed for some reason
+NOFILE: MOVE B,A
+ MSG [Open failed?]
+NOFIL4: PSOUT
+ POP P,C
+ JUMPE C,NOFIL3
+ MSG [ (]
+ PSOUT
+ MOVE A,C
+NOFIL2: PSOUT
+ MSG [)]
+ PSOUT
+NOFIL3: MSG [: ]
+ PSOUT
+
+;print error string
+ERPRNT: HRRZI A,-1
+ HRLI B,400000
+ MOVEI C,0
+ ERSTR ; PRINT ERROR
+ POPJ P, ;UNDEFINED ERROR.
+ POPJ P, ;CHOMPING DEST.
+ POPJ P, ;WON.
+ POPJ P,
+
+;openf failed for some reason
+NOFIL1: MOVE B,A
+ MSG [Can't OPENF file?]
+ JRST NOFIL4
+
+
+SUBTTL BEGIN ASSEMBLING
+
+;print filename being assembled
+BEGIN: SKIPN DOFREQ
+ JRST BEGINF
+ MSG [Counting ]
+ SKIPA
+BEGINF: MSG [Assembling ]
+ PUSHJ P,PFNAME ;tell name of file being read
+
+;find out release number since it's alway wrong in the ZAP file
+ MSG [Time Mode?: ]
+ PSOUT
+ PBIN
+ SETZ B,
+ CAIE A,"T
+ CAIN A,"Y
+ JRST [TRO B,%TIMESL
+ MSG [ <yes>]
+ JRST .+2]
+ MSG [ <no>]
+ PSOUT
+ PUSHJ P,PCRLF
+; MSG [Byte Swapped?: ]
+; PSOUT
+; PBIN
+; CAIE A,"T
+; CAIN A,"Y
+; TRO B,%BYTSWP
+; PUSHJ P,PCRLF
+ MOVEM B,FLGWRD
+ MSG [Release: ]
+ PSOUT
+ MOVEI A,.PRIIN
+ MOVEI C,10.
+ SETOM RELEAS
+ NIN
+ JRST GETFNM ;lost, use default
+ JUMPL B,GETFNM
+ MOVEM B,RELEAS ;save and use instead of supplied
+
+;get goodies so can open correct output file
+GETFNM: MOVE A,OUTPTR
+ MOVE B,IJFN
+ MOVE C,[222000,,JS%PAF] ;output dev:<dir>name.
+ JFNS
+ MOVEM A,OUTPTR ;save for outputting other exts.
+ SKIPE DOFREQ
+ JRST BEGLUP ;do frequency assembly
+
+ MOVE Z,[441000,,OUTBUF] ;byte ptr to output buffer
+ MOVEI ZPC,0 ;pc initially zero
+ PUSHJ P,SCRIPT ;open script channel if asked
+ PUSHJ P,GLBINI ;initialize global symbol table
+ PUSHJ P,LCLINI ;initialize local symbol table
+
+;here to create references to the first n words, which are special
+ MOVE A,ZAPID
+ PUSHJ P,OUTBYT
+ MOVE A,FLGWRD
+ PUSHJ P,OUTBYT
+ SKIPGE A,RELEAS ;user gave a release number?
+ JRST NORELE
+ PUSHJ P,OUTWRD
+ JRST DEFWDS
+
+NORELE: HRROI B,[ASCIZ /.WORD ZORKID
+/]
+ HRROI A,BUFFER
+ MOVEI C,0
+ SOUT
+ PUSHJ P,ASSEM
+
+;output always defined words
+DEFWDS: HRROI B,[ASCIZ /.WORD ENDLOD,START,VOCAB,OBJECT,GLOBAL,IMPURE,0,0,0,0,WORDS
+/]
+ HRROI A,BUFFER ;copy to buffer
+ MOVEI C,0
+ SOUT
+ PUSHJ P,ASSEM ;assemble it
+
+BEGWDS: MOVEI A,0
+ PUSHJ P,OUTWRD
+ CAIGE ZPC,100
+ JRST BEGWDS
+
+BEGLUP: PUSHJ P,RDLINE ;read a line, no skip if done
+ JRST DONE
+ SKIPE PDEBUG
+ PUSHJ P,PINPUT
+ PUSHJ P,ASSEM ;assemble line
+ SKIPE PDEBUG
+ CAMN Z,SAVZ
+ JRST BEGLUP
+ PUSHJ P,OPC
+ JRST BEGLUP
+
+PINPUT: PUSH P,A
+ PUSH P,B
+ PUSH P,C
+ MOVE A,PDEBUG
+ MOVEI C,0
+ HRROI B,[ASCIZ /
+ ;/]
+ SOUT
+ HRROI B,BUFFER
+ SOUT ;print it (for debugging)
+ MOVEM ZPC,SAVZPC
+ MOVEM Z,SAVZ
+ JRST POPCBA
+
+SUBTTL DONE - FINISH UP, PRINT STATS, ETC.
+
+DONE: SKIPE DOFREQ
+ JRST FILEND
+ PUSHJ P,UNDGLB ;print undefined globals
+ MSG [
+]
+ PSOUT
+ MOVEI A,.PRIOU
+ MOVE B,ZPC
+ MOVEI C,10.
+ NOUT
+ JFCL
+ MSG [ bytes.
+]
+ PSOUT
+ MOVEI A,.PRIOU
+ MOVE B,OBJTOT
+ MOVEI C,10.
+ NOUT
+ JFCL
+ MSG [ objects.
+]
+ PSOUT
+ MOVEI A,.PRIOU
+ MOVE B,GLBTOT
+ MOVEI C,10.
+ NOUT
+ JFCL
+ MSG [ globals.
+]
+ PSOUT
+ SKIPE TWOPAS ;don't bother if two pass assembly
+ JRST OUTPUT
+ MOVEI A,.PRIOU
+ MOVE B,SHRIMP
+ MOVEI C,10.
+ NOUT
+ JFCL
+ MSG [ wasted long jumps.
+]
+ PSOUT
+
+
+;here to force pc to value in A
+SETZPC: MOVE ZPC,A
+ MOVE Z,[441000,,OUTBUF]
+ EXCH A,Z
+ ADJBP Z,A
+ POPJ P,
+
+;here to output date stuff for serial number in ascii
+;a/ number
+OUTDAT: PUSH P,B
+ IDIVI A,10.
+ ADDI A,"0
+ PUSHJ P,OUTBYT
+ MOVEI A,"0(B)
+ PUSHJ P,OUTBYT
+ POP P,B
+ POPJ P,
+
+;here to output the data
+OUTPUT: MOVEM Z,SAVZ
+ MOVEM ZPC,SAVZPC
+ MOVEI A,32 ; where the length lives
+ PUSHJ P,SETZPC
+ MOVE A,SAVZPC ; get back the final top pc
+ LSH A,-1 ; make it in words
+ PUSHJ P,OUTWRD
+ MOVEI A,77 ; start at byte 100 octal
+ PUSHJ P,SETZPC
+ SETZ D, ; zero the checksum
+OUTCL: CAMN ZPC,SAVZPC ; loop until through the entire file
+ JRST OUTCHK
+ ILDB B,Z ; get the byte
+ ADD D,B ; and add it into checksum
+ AOJA ZPC,OUTCL
+OUTCHK: MOVEI A,34 ; where the checksum lives
+ PUSHJ P,SETZPC
+ MOVE A,D
+ ANDI A,177777 ; only 15 bits worth, though
+ PUSHJ P,OUTWRD
+ MOVEI A,22 ; where serial number lives
+ PUSHJ P,SETZPC
+ MOVNI B,1
+ ODCNV ; get current time/date
+ HLRZ A,B ; here's the year
+ SUBI A,1900. ; we will take only the mod 100 part
+ PUSHJ P,OUTDAT
+ HRRZ A,B ; here's the month (starting at 0)
+ ADDI A,1 ; so fix it up here
+ PUSHJ P,OUTDAT
+ HLRZ A,C ; here's the day (starting at 0)
+ ADDI A,1 ; so fix it up here
+ PUSHJ P,OUTDAT
+
+ MOVE Z,SAVZ
+ MOVE ZPC,SAVZPC
+ MOVE A,[440700,,[ASCIZ /.ZIP/]]
+ MOVE B,OUTPTR
+ ILDB 0,A
+ IDPB 0,B
+ JUMPN 0,.-2
+ MOVSI A,(GJ%SHT+GJ%FOU)
+ HRROI B,OUTFIL
+ GTJFN
+ JRST ERPRNT
+ HRRZ A,A
+ MOVE B,[440000,,OF%WR]
+ OPENF
+ JRST ERPRNT
+;blat out stupid gcdump header
+ HRRM ZPC,HEADER+5
+ MOVEI C,3(Z)
+ SUBI C,OUTBUF
+ HRLM C,FOOTER+1
+ ADDI C,2006
+ HRRM C,FOOTER+1
+ SUBI C,2006-2
+ MOVEM C,HEADER
+ MOVEM C,HEADER+1
+ MOVEM C,HEADER+2
+ MOVE B,[444400,,HEADER]
+ MOVNI C,7
+ SOUT
+;blat out data
+ MOVE B,[444400,,OUTBUF]
+ MOVEI C,1(Z)
+ SUBI C,OUTBUF
+ MOVN C,C
+ SOUT
+;blat out stupid footer
+ MOVE B,[444400,,FOOTER]
+ MOVNI C,2
+ SOUT
+;close up and go home
+ CLOSF
+ JFCL
+ SKIPE A,PDEBUG
+ CLOSF
+ HALTF
+ HALTF
+
+;print name of IJFN file, takes prefix string in A
+PFNAME: PSOUT
+ MOVEI A,.PRIOU
+ MOVE B,IJFN
+ MOVE C,[222220,,JS%PAF]
+ JFNS
+ PUSHJ P,PCRLF
+ POPJ P,
+
+SCRIPT: SKIPL PDEBUG
+ POPJ P,
+ MOVE A,[440700,,[ASCIZ /.SCRIPT/]]
+ MOVE B,OUTPTR
+ ILDB 0,A
+ IDPB 0,B
+ JUMPN 0,.-2
+ MOVSI A,(GJ%SHT+GJ%FOU)
+ HRROI B,OUTFIL
+ GTJFN
+ JRST ERPRNT
+ HRRZ A,A
+ MOVEM A,PDEBUG
+ MOVE B,[070000,,OF%WR]
+ OPENF
+ JRST ERPRNT
+ POPJ P,
+
+SUBTTL READ A LINE FROM INPUT FILE
+
+RDLINE: SKIPN A,IJFN ;no eof yet?
+ POPJ P, ; eof, return
+ PUSH P,B
+ HRROI B,BUFFER
+ MOVEI C,512.*5
+ MOVEI D,^J ;stop on crlf
+ SIN ;read a line
+ ERJMP RDEOF
+ MOVEI A,0 ;terminate with nul
+ IDPB A,B ;zero byte
+ POP P,B
+POPJ1: AOS (P)
+CPOPJ: POPJ P,
+
+RDEOF: MOVE A,IJFN
+ CLOSF ;close input file
+ JRST ERPRNT
+ SETZM IJFN ;eof found
+ POP P,B
+ JRST POPJ1
+
+;parse a line into tokens; may require reading more lines if it's a string
+GTLINE: MOVE A,[440700,,TOKEN]
+ MOVEM A,TOKPTR
+ MOVE TP,TPDL
+GTLIN1: PUSHJ P,GTOKEN ;get a token
+ PUSH TP,B ;push string
+ PUSH TP,A ;push terminator
+ JUMPN A,GTLIN1
+ PUSH TP,[0] ;end of line, push zeros
+ PUSH TP,[0] ;end of line, push zeros
+ POPJ P,
+
+;print a token
+PTOKEN: SKIPN TDEBUG
+ POPJ P,
+ EXCH A,B
+ SKIPE A
+ PSOUT ;string part
+ EXCH A,B
+ JUMPE A,PCRLF
+ PBOUT ;terminator part
+ POPJ P,
+PCRLF: MSG [
+]
+ PSOUT
+ MOVEI A,0
+ POPJ P,
+
+SUBTTL PARSE A TOKEN FROM INPUT LINE
+;returns a/ break char, b/ ptr to token
+GTOKEN: MOVE B,TOKPTR
+GTOKE1: ILDB A,C
+ JUMPE A,RTERM
+ CAIG A,40
+ JRST GTOKE1 ;skip over leading junk
+ JRST RTOK3
+RTOKEN: ILDB A,C
+RTOK3: CAIG A,40
+ JRST RTERM
+ CAIE A,": ;label
+ CAIN A,"+ ;sum
+ JRST RTERM
+ CAIE A,"= ;definition
+ CAIN A,"/ ;then jump
+ JRST RTERM
+ CAIE A,"\ ;else jump
+ CAIN A,", ;separator
+ JRST RTERM
+ CAIE A,"> ;assignment
+ CAIN A,"' ;quoting
+ JRST RTERM
+ CAIN A,"; ;start of comment
+ JRST RCOMNT ; ignore comment
+ CAIN A,"" ;start of string
+ JRST RSTRNG ;read string
+;else part of token
+RTOK1: IDPB A,B ;build token
+ JRST RTOKEN ;loop
+
+;here to read a string
+RSTRNG: CAME B,TOKPTR ;anything read yet?
+ JRST RSTR3 ; yes
+RSTR1: ILDB A,C
+ JUMPE A,[PUSHJ P,MORSTR
+ JRST RSTR1] ;need to read another line from file
+ CAIN A,"" ;end of string
+ JRST RSTRQ
+RSTR2: IDPB A,B
+ JRST RSTR1
+
+RSTR3: DPB C ;here if string bung up against other token
+ MOVEI A,40 ;fake a space
+ JRST RTERM ;and return
+
+;here to check for ""
+RSTRQ: MOVE 0,C
+ ILDB A,C
+ JUMPE A,[PUSHJ P,MORSTR
+ JRST RSTRQ]
+ CAIN A,""
+ JRST RSTR2 ;is ", ship it
+ MOVE C,0 ;restore bptr
+ MOVEI A,"" ;pretend was "
+ JRST RTERM ;not a ", return
+
+;here to snarf another line for multi-line strings
+MORSTR: PUSHJ P,RDLINE
+ JRST STRERR
+ MOVE C,[440700,,BUFFER]
+ POPJ P,
+
+STRERR: MSG [String not terminated at eof.]
+ PUSHJ P,ERROR
+ POPJ P,
+
+;here to read and ignore a comment
+RCOMNT: MOVEI A,0
+RTERM: CAMN B,TOKPTR
+ CAIN A,"" ;allow empty strings
+ SKIPA
+ JRST RNONE
+ MOVEI 0,0
+ IDPB 0,B ;asciz
+ EXCH B,TOKPTR
+ POPJ P,
+
+;here for nothing read
+RNONE: MOVEI B,0
+ POPJ P,
+
+
+SUBTTL SYMBOL LOOKUP FOR CONSTANT TABLES
+
+;takes: a/ symbol to lookup
+;retns +2 won, b/ value
+; +2 lost
+LOOKUP: MOVNI C,1 ;low bound
+ MOVEI E,OPCNT ;high bound
+LOOKLP: MOVE D,C
+ ADD D,E
+ TRZ D,1 ;make it an even number
+ MOVE B,OPS(D)
+ HRLI B,440700
+ PUSHJ P,COMPAR ; a/ token b/ table
+ JRST LOOKWN ; a=b
+ JRST LOOKLS ; a>b
+ LSH D,-1
+ MOVE C,D ; a<b
+ JRST LOOKND
+
+LOOKLS: LSH D,-1
+ MOVE E,D
+
+LOOKND: CAIGE C,-1(E)
+ JRST LOOKLP
+ POPJ P, ;lost, no skip
+
+LOOKWN: MOVE B,OPS+1(D) ;return value
+ AOS (P)
+ POPJ P,
+
+;compare two strings
+;a/ token b/ table
+;no skip: a=b
+;+1 skip: a>b
+;+2 skip: a<b
+COMPAR: PUSH P,A
+ PUSH P,B
+ PUSH P,C
+ PUSH P,D
+COMPA1: ILDB C,A
+ ILDB D,B
+ CAIN C,(D)
+ JRST COMEQU ;characters same
+ CAIL C,(D)
+ AOS -4(P) ;a>b
+ AOS -4(P) ;a<b
+COMEXI: POP P,D
+ POP P,C
+ POP P,B
+ POP P,A
+ POPJ P,
+
+COMEQU: JUMPE C,COMEXI ;if end of string, win
+ JRST COMPA1 ;else continue
+
+LOOKER: MOVE F,[-OPCNT,,OPS]
+LOOKIT: MOVE A,(F)
+ PSOUT
+ PUSHJ P,PCRLF
+ PUSHJ P,LOOKUP
+ HALTF
+ ADDI F,1
+ AOBJN F,LOOKIT
+ POPJ P,
+
+SUBTTL SOME DEBUGGING ROUTINES
+
+;used to make sure zpc and z are always in tandem
+CHKZPC: PUSH P,A
+ PUSH P,Z
+ PUSH P,ZPC
+ HRRZ A,Z
+ SUBI A,OUTBUF
+ LSH A,2
+ HLRZ Z,Z
+ CAIN Z,441000
+ ADDI A,0
+ CAIN Z,341000
+ ADDI A,1
+ CAIN Z,241000
+ ADDI A,2
+ CAIN Z,141000
+ ADDI A,3
+ CAIN Z,41000
+ ADDI A,4
+ CAME A,ZPC
+ HALTF
+ POP P,ZPC
+ POP P,Z
+ POP P,A
+ POPJ P,
+
+;here start printing goodies if pc has reached a certain value
+STOPPE: CAMGE ZPC,STOP
+ POPJ P,
+ MOVEM ZPC,SAVZPC
+ MOVEM Z,SAVZ
+ MOVEI .PRIOU
+ MOVEM PDEBUG
+ SETZM STOP
+ POPJ P,
+
+SUBTTL ASSEMBLE A LINE
+
+ASSEM: SKIPE STOP ;supposed to stop sometime?
+ PUSHJ P,STOPPER ; yes, see if now
+ SETZM NOREF ;produce references
+ SETZM WRDBYT ;initially assume assembling word
+
+;here to check that symbol pname tables haven't overflowed
+ MOVE C,LCLPTR
+ CAIL C,LCLTAB
+ HALTF
+ MOVE C,GLBPTR
+ CAIL C,GLBTAB
+ HALTF
+;read and parse input line
+ MOVE C,[440700,,BUFFER] ;set up ptr to input buffer
+ PUSHJ P,GTLINE
+ MOVE TP,TPDL
+ ADD TP,[1,,1]
+ SKIPN (TP)
+ POPJ P, ;nothing on this line
+
+;if frequency assembly, ignore all this foofaraw
+ SKIPE DOFREQ
+ JRST FREQ ;do something else instead
+
+;label?
+ MOVE A,1(TP) ;get terminator
+ CAIE A,":
+ JRST AOP
+;line starts with a label
+ SKIPN 2(TP) ;second token?
+ SKIPN 3(TP)
+ JRST LCLLBL ;empty line, more or less
+ MOVE A,3(TP) ;get terminator
+ CAIE A,":
+ JRST BDLBSY ;bad label syntax: foo:<x> for x not :
+;global label
+GLBLBL: SKIPE FZ ;time for function second pass?
+ PUSHJ P,FPASS2 ; yes
+ MOVE B,(TP) ;global label
+ MOVE C,ZPC ;label is current pc
+ PUSHJ P,DEFGLB ;define it
+ JRST BDMDGL ;multiply defined global label
+ NXTARG 2 ;move over label and colons
+ JRST AOP
+;local label
+LCLLBL: SKIPN A,FUNCT ;is there a function these days?
+ JRST GLBLBL ;else it might as well be a global
+ MOVE B,(TP) ;get token
+ MOVE C,ZPC ;label is current pc
+ PUSHJ P,DEFLCL ;define it
+ JRST BDMDLL ;multiply defined local label
+ NXTARG 1 ;move over local label
+ JRST AOP
+
+BDLABL: MSG [Multiply defined label]
+BDLAB1: MOVE B,(TP)
+ PUSHJ P,ERRMSG ;shout lossage
+ JRST AOP ;but continue
+
+BDLBSY: MSG [Label followed by :, non-colon]
+ JRST BDLAB1
+
+;here we have reached an opcode or pseudo after flushing label
+AOP: SKIPN A,(TP)
+ SKIPE 1(TP)
+ SKIPA
+ POPJ P,
+ PUSHJ P,LOOKUP ;takes symbol in A
+ JRST AEQUAL ; not any sort of op.
+ JUMPL B,APSEUDO ;pseudo
+ JRST AOPER ;regular op
+
+;here not oper or pseudo
+
+;see if it's an atom=foo
+AEQUAL: SKIPE A,1(TP)
+ CAIE A,"=
+ JRST AATOM
+ MOVE B,2(TP) ;value
+ PUSHJ P,FIXQ
+ JRST BDEQUA ;FOO=<non-fix>?
+ MOVE C,B
+ MOVE B,(TP)
+ PUSHJ P,DEFGLB
+ JRST BDEQU1 ;already defined?
+ SKIPN 4(TP)
+ SKIPE 5(TP)
+ JRST BDEQU2 ;too many args to equal?
+ POPJ P,
+
+;see if it's an atom
+AATOM: PUSHJ P,AWORD
+ JFCL
+ POPJ P,
+
+SUBTTL ASSEMBLE WORDS AND BYTES
+
+;get value of symbol
+; returns A/ terminator B/ value
+ALCL: PUSH P,C
+ MOVEI C,0 ;symbol is a zero
+ MOVE B,(TP)
+ PUSHJ P,REFLCL
+ MOVE B,SYMVAL(A)
+ JRST AGNEXT
+
+AGET: PUSH P,C
+ MOVEI C,0 ;symbol is a zero
+AGLOOP: MOVE B,(TP)
+ PUSHJ P,FIXQ
+ JRST [MOVE B,(TP)
+ PUSHJ P,REFSYM
+ SKIPGE B,SYMVAL(A)
+ MOVSI B,%UNDEF
+ JRST .+1]
+AGNEXT: ADD C,B ;accumulate value
+ NXTARG 1
+ SKIPN A,-1(TP) ;terminator?
+ JRST AGEXI1 ;no skip if last thing on line
+ CAIN A,"+
+ JRST AGLOOP
+AGEXIT: AOS -1(P)
+AGEXI1: MOVE B,C
+ POP P,C
+ POPJ P,
+
+AWORD: SETZM WRDBYT ;means working on word
+ PUSHJ P,AGET
+ SOS (P)
+ MOVE A,B
+ TLZ A,%BITS
+ PUSHJ P,OUTWRD
+ AOS (P)
+ POPJ P,
+
+ABYTE: SETOM WRDBYT ;means working on byte
+ PUSHJ P,AGET
+ SOS (P)
+ MOVE A,B
+ TLZ A,%BITS
+ PUSHJ P,OUTBYT
+ AOS (P)
+ POPJ P,
+
+
+SUBTTL OUTPUT WORDS
+
+;output a word
+; a/ word
+OUTWRD: CAILE A,177777 ;check size
+ JRST WRDBIG ; lose, too big
+OUTWR1: LSHC A,-8.
+ PUSHJ P,OUTBY1 ;output first byte
+ MOVEI A,0
+ ROTC A,8.
+ PUSHJ P,OUTBY1 ;output second byte
+ POPJ P,
+
+;add a value to an already output word (used for fixups)
+; a/ word
+ADDWRD: CAILE A,177777 ;too big?
+ JRST WRDBIG ; yes, lose
+ LSHC A,-8.
+ PUSHJ P,ADDBYT ;add first byte
+ MOVEI A,0
+ ROTC A,8.
+ PUSHJ P,ADDBYT ;add second byte
+ POPJ P,
+
+;output word reference
+; a/ word
+OUTWRF: CAILE A,177777 ;too big?
+ JRST WRDBIG ; yes, lose
+ LSHC A,-8.
+ PUSHJ P,OUTBY1
+ MOVEI A,0
+ ROTC A,8.
+ PUSHJ P,OUTBY1
+ POPJ P,
+
+;error, word is too large
+WRDBIG: MSG [Word too large]
+ PUSHJ P,ERROR
+ MOVEI A,0
+ JRST OUTWR1
+
+SUBTTL OUTPUT BYTES
+
+;output a byte
+; a/ byte
+OUTBYT: CAILE A,377 ;too big?
+ JRST BYTBIG ; too big, lose
+;enter here to just output the byte directly
+OUTBY1: IDPB A,Z ;output byte
+ ADDI ZPC,1 ;increment pc
+ MOVE 0,(P)
+ SKIPN TABLE
+ CAIL 0,SLOOK
+ POPJ P,
+ SKIPN PASS2
+ AOS CODLEN'
+ POPJ P,
+
+;output byte reference
+; a/ byte
+OUTBRF: CAILE A,377 ;too big?
+ JRST BYTBIG ; yes, lose
+ PUSHJ P,OUTBY1
+ POPJ P,
+
+;same as outbyt, but adds in new value (for fixup)
+; a/ byte
+ADDBYT: CAILE A,377
+ JRST BYTBIG
+ PUSH P,B
+ ILDB B,Z ;pick up current contents
+ ADD A,B ;add new stuff in
+ DPB A,Z ;put it back out
+ ADDI ZPC,1
+ POP P,B
+ POPJ P,
+
+;here byte was too large (>255.)
+BYTBIG: MSG [Byte too large]
+ PUSHJ P,ERROR
+ MOVEI A,0
+ JRST OUTBY1
+
+SUBTTL PRINT BYTES AND PCS (FOR DEBUGGING)
+
+OBYTE: PUSH P,A
+ PUSH P,B
+ PUSH P,C
+ MOVE B,A
+ MOVE A,PDEBUG
+ MOVEI C,8
+ HRLI C,(NO%LFL+NO%ZRO)+3
+ NOUT
+ JFCL
+ MOVEI B,"
+ BOUT
+ JRST POPCBA
+
+OPC: PUSH P,A
+ PUSH P,B
+ PUSH P,C
+ MOVE B,SAVZPC
+ MOVE A,PDEBUG
+ MOVEI C,8
+ NOUT
+ JFCL
+ HRROI B,[ASCIZ !/ !]
+ MOVEI C,0
+ SOUT
+OBYLUP: ILDB A,SAVZ
+ PUSHJ P,OBYTE
+ CAME Z,SAVZ
+ JRST OBYLUP
+ JRST POPCBA
+
+SUBTTL VARIOUS ERRORS
+
+BDMDGL: MSG [Multiply defined global label]
+ JRST BDERRO
+BDMDLL: MSG [Multiply defined local label]
+ JRST BDERRO
+BDMDLV: MSG [Multiply defined local variable]
+ JRST BDERRO
+BDEQUA: MSG [Something assigned to non-fix]
+ JRST BDERRO
+BDEQU1: MSG [Something already assigned]
+ JRST BDERRO
+BDEQU2: MSG [Too many args to equal]
+BDERRO: PUSHJ P,ERROR
+ POPJ P,
+
+
+SUBTTL IS IT A FIX?
+;given string pointer, skips if it's a number
+;returns number in B
+FIXQ: PUSH P,C
+ PUSH P,D
+ MOVE C,B
+ MOVEI B,0
+ SETZ D,
+FIXQ1: ILDB A,C
+ JUMPE A,FIXEND
+ CAIN A,"-
+ JRST [SETO D,
+ JRST FIXQ1]
+ CAIL A,"0
+ CAILE A,"9
+ JRST [POP P,D
+ POP P,C
+ POPJ P,]
+ SUBI A,"0
+ IMULI B,10.
+ ADD B,A
+ JRST FIXQ1
+
+FIXEND: CAILE B,177777
+ JRST FIXBIG
+ SKIPE D
+ MOVN B,B
+ ANDI B,177777
+FIXEN1: POP P,D
+ POP P,C
+ JRST POPJ1
+
+FIXBIG: MSG [Fix too big for a word]
+ PUSHJ P,ERROR
+ MOVE B,177777
+ JRST FIXEN1
+
+SUBTTL PSEUDO-OPS
+
+;dispatch for pseudo-ops
+APSEUD: SKIPE FZ ;time for a function second pass?
+ PUSHJ P,FPASS2 ; yes, go do it
+APSEU1: SETZM PASS2
+ HRRZ B,B
+ CAIN B,ZFUNCT ;if not .funct, skip
+ PUSHJ P,UNDLCL
+ JRST (B)
+
+SUBTTL .END .INSERT AND .ENDI
+
+;end of assembly
+ZEND: MOVE A,IJFN
+ CLOSF
+ JRST ERPRNT
+ SETZM IJFN
+ POPJ P,
+
+;insert another file
+ZINSER: SKIPE OJFN
+ JRST ZINSIN
+ MOVE A,3(TP)
+ CAIE A,""
+ JRST ZINSTR ;not a string
+ MOVE A,IJFN
+ MOVEM A,OJFN
+ MOVE B,2(TP)
+ PUSHJ P,OPEN
+ MSG [Inserting ]
+ PUSHJ P,PFNAME
+ POPJ P,
+
+ZINSIN: MSG [Already in .INSERT?]
+ PUSHJ P,ERROR
+ POPJ P,
+
+ZINSTR: MSG [Argument to .INSERT not string?]
+ PUSHJ P,ERROR
+ POPJ P,
+
+;end an insertion
+ZENDI: SKIPN B,OJFN
+ JRST ZENDLS
+ MOVE A,IJFN
+ CLOSF
+ JRST ZENDCL
+ SETZM OJFN
+ MOVEM B,IJFN
+ POPJ P,
+
+ZENDLS: MSG [.ENDI not in .INSERT?]
+ PUSHJ P,ERROR
+ POPJ P,
+
+ZENDCL: MSG [.ENDI close failed?]
+ PUSHJ P,ERROR
+ POPJ P,
+
+SUBTTL TABLES
+
+ZTABLE: MOVEM ZPC,TABLE
+ SETOM TABLEN
+ NXTARG 1
+ SKIPN B,(TP)
+ POPJ P,
+ PUSHJ P,FIXQ
+ JRST ZTNOTF
+ MOVEM B,TABLEN
+ POPJ P,
+
+ZTNOTF: MSG [Argument to .TABLE not fix]
+ PUSHJ P,ERROR
+ POPJ P,
+
+ZENDT: SKIPN TABLE
+ JRST ZETNOT
+ SKIPGE A,TABLEN
+ JRST ZENDTX
+ ADD A,TABLE
+ CAML A,ZPC
+ JRST ZENDTX
+ MSG [Table too large]
+ PUSHJ P,ERROR
+ POPJ P,
+
+ZENDTX: SETZM TABLE
+ SETZM TABLEN
+ POPJ P,
+
+ZETNOT: MSG [.ENDT not after .TABLE]
+ PUSHJ P,ERROR
+ POPJ P,
+
+ZEQUAL: SKIPN B,4(TP)
+ JRST ZEQTFA
+ PUSHJ P,FIXQ
+ JRST ZEQANF
+ MOVE C,B
+ PUSHJ P,DEFNAM
+ JRST ZEQMDG
+ POPJ P,
+
+ZEQMDG: MSG [Already defined]
+ PUSHJ P,ERROR
+ POPJ P,
+ZEQANF: MSG [Second argument to .EQUAL not fix]
+ PUSHJ P,ERROR
+ POPJ P,
+ZEQTFA: MSG [Too few arguments to .EQUAL]
+ PUSHJ P,ERROR
+ POPJ P,
+
+SUBTTL NAMED THINGS: FUNCTIONS, GLOBAL STRINGS, VARIABLES, OBJECTS
+
+;define a named thing, value in C
+DEFNAM: MOVE B,2(TP) ;pname
+ PUSHJ P,DEFGLB ;define symbol
+ JRST DEFMLT ;already defined
+ NXTARG 2 ;move over pseudo and name
+ AOS (P)
+ POPJ P,
+;complain about multiply defined thing
+DEFMLT: MSG [Multiply defined ]
+ MOVE B,(TP)
+ PUSHJ P,ERRMSG
+ POPJ P,
+
+;force a word boundary
+WRDBDY: TRNN ZPC,1
+ POPJ P,
+ PUSH P,A
+ MOVEI A,0
+ PUSHJ P,OUTBYT
+ POP P,A
+ POPJ P,
+
+SUBTTL FUNCTIONS
+
+ZFUNCT: PUSHJ P,WRDBDY ;force word boundary
+ SKIPN 2(TP)
+ JRST ZFNONE ;no name?
+ MOVE C,ZPC
+ LSH C,-1 ;functions are always on word bdy.
+ MOVEM C,FSYM ;save symbol value of last function
+ PUSHJ P,DEFNAM
+ POPJ P,
+ MOVE A,LSTSYM ;pick up last defined symbol
+ MOVEM A,FUNCT ;new function
+;print functions and locs if asked for
+ SKIPE FDEBUG
+ PUSHJ P,PFUNCT
+;here hack arguments
+ MOVEI D,0 ;current lval
+ MOVE E,Z ;save current bptr
+ IDPB D,Z ;start with zero
+ ADDI ZPC,1
+ZFLOOP: SKIPN B,(TP) ;is there one?
+ JRST ZFDONE ;nope, done
+ ADDI D,1 ;bump arg count
+ MOVE C,D ;which local?
+ TLO C,%VAR
+ PUSHJ P,DEFLCL ;define it as a local
+ JRST BDMDLV
+ SKIPE A,1(TP)
+ CAIE A,"=
+ JRST ZFNEXT
+ NXTARG 1 ;move over variable name
+ SKIPN B,(TP)
+ JRST ZFNOEQ
+ PUSHJ P,AWORD ;assemble word
+ JFCL
+ JRST ZFLOOP
+
+ZFNEXT: MOVEI A,0
+ PUSHJ P,OUTWRD ;bind it to 0
+ NXTARG 1 ;move over variable name
+ JRST ZFLOOP
+
+ZFDONE: IDPB D,E ;now fake output of argument count
+
+;save goodies for function pass two
+;can be called on its own, be careful!
+FMARK: MOVE A,IJFN
+ RFPTR
+ HALTF
+ MOVEM B,FPOS ;save file pointer
+ MOVEM Z,FZ ;save output pointer
+ MOVEM ZPC,FZPC ;save pc
+ MOVE A,SHRIMP
+ MOVEM A,OSHRIM
+ POPJ P,
+
+ZFNONE: MSG [No name given to function?]
+ PUSHJ P,ERROR
+ POPJ P,
+ZFNOEQ: MSG [Argument = not followed by value?]
+ PUSHJ P,ERROR
+ POPJ P,
+
+;here to set up second pass over functions with short jumps
+FPASS2: SKIPN TWOPASS ;skip if two pass assembly of functions
+ POPJ P, ;else return immediately
+ CAMN ZPC,FZPC
+ JRST [PUSHJ P,FMARK
+ POPJ P,]
+ SETOM PASS2
+ MOVE A,OSHRIM ;count of wasted long jumps
+ ;CAML A,SHRIMP ; what it was when function started
+ ;POPJ P, ;resume, false alarm
+ MOVEM A,SHRIMP
+ MOVE A,IJFN
+ MOVE B,FPOS
+ SFPTR
+ HALTF
+ MOVE Z,FZ
+ MOVEM Z,SAVZ ;fool debugging printer
+ MOVE ZPC,FZPC
+ SETZM FPOS ;file pointer of start of function
+ SETZM FZ ;z at start of function
+ SETZM FZPC ;zpc at start of function
+ SETZM FSHORT ;count of short jumps
+ POP P,0 ;flush call to fpass2
+ POPJ P, ;return from caller
+
+;.FSTR -- like .GSTR but adds to table of frequent strings
+ZFSTR: SKIPN A,4(TP)
+ JRST TFARG
+ PUSHJ P,WLOOK
+ SKIPA
+ JRST ZFDUP ;duplicate of frequent string? lose!
+;here to add new string to table
+ MOVE A,TABPTR
+ TLNN A,400000
+ JRST [HRLI A,440700
+ ADDI A,1
+ JRST .+1]
+ MOVE H,A
+ MOVE B,4(TP)
+ MOVEI C,0
+ SOUT ;copy string to buffer
+ IDPB C,A
+ MOVEM A,TABPTR
+;update table pointer
+ PUSH P,G
+ MOVE G,WRDTAB
+ SUB G,[2,,2]
+ MOVEM G,WRDTAB
+ POP P,G
+;make a slot for new entry
+ HRRZ A,WRDTAB
+ HRLI A,2(A)
+ BLT A,-1(G)
+;put out new entry
+ MOVEM H,-1(G) ;string
+ AOS H,FSTRS
+ MOVEM H,-2(G) ;count
+ CAIG H,%FWDCT
+ JRST ZFSTR1
+ MSG [Too many .FSTRs]
+ZFERR: PUSHJ P,ERROR
+ POPJ P,
+
+ZFDUP: MSG [Duplicate .FSTR]
+ JRST ZFERR
+
+ZFSTR1: PUSHJ P,WRDBDY
+ MOVE C,ZPC
+ LSH C,-1
+ PUSHJ P,DEFNAM
+ POPJ P,
+ SKIPN A,(TP)
+ JRST TFARG
+ PUSHJ P,MAKFST
+ POPJ P,
+
+
+;.GSTR -- global string
+ZGSTR: PUSHJ P,WRDBDY
+ MOVE C,ZPC
+ LSH C,-1
+ PUSHJ P,DEFNAM
+ POPJ P,
+ SKIPN A,(TP)
+ JRST TFARG
+ PUSHJ P,MAKSTR
+ POPJ P,
+
+ZGVAR: AOS GLBTOT
+ AOS C,GLBCNT
+ CAILE C,255. ;real high limit
+ JRST TMGLB
+ TLO C,%VAR
+ PUSHJ P,DEFNAM
+ POPJ P, ;multiply defined
+ PUSHJ P,AWORD
+ POPJ P,
+ POPJ P,
+
+TMGLB: MSG [Too many globals]
+ PUSHJ P,ERROR
+ POPJ P,
+
+ZOBJEC: AOS OBJTOT ;how many he tried to make
+ AOS C,OBJCNT
+ CAILE C,255.
+ JRST TMOBJ ;more than 255 objects
+ PUSHJ P,DEFNAM
+ POPJ P, ;multiply defined
+;process parts of object line
+ PUSHJ P,AWORD
+ JRST TFAOBJ
+ PUSHJ P,AWORD ;flags
+ JRST TFAOBJ
+ PUSHJ P,ABYTE
+ JRST TFAOBJ
+ PUSHJ P,ABYTE
+ JRST TFAOBJ
+ PUSHJ P,ABYTE
+ JRST TFAOBJ
+ PUSHJ P,AWORD ;property table ptr
+ JRST TFAOBJ
+ POPJ P,
+
+TFAOBJ: MSG [Too few arguments to .OBJECT]
+ PUSHJ P,ERROR
+ POPJ P,
+
+TMOBJ: MSG [Too many objects]
+ PUSHJ P,ERROR
+ POPJ P,
+
+ZLEN: POPJ P,
+
+ZPDEF: PUSHJ P,WRDBDY ;guarantee word boundary
+ POPJ P,
+
+ZPROP: SKIPN TABLE
+ JRST ZPROPL
+ NXTARG 1
+ PUSHJ P,AGET ;get property length
+ JFCL
+ TLZ B,%BITS
+ CAILE B,0
+ CAILE B,8
+ JRST ZPOFL ;property length out of range
+ MOVE C,B
+ PUSHJ P,AGET ;get property number
+ JFCL
+ TLZ B,%BITS
+ CAILE B,0
+ CAIL B,40
+ JRST ZPOFR ;property number out of range
+ SUBI C,1 ;length minus one
+ LSH C,5 ;left shifted
+ ADD C,B ;plus number
+ MOVE A,C
+ PUSHJ P,OUTBYT ;output it
+ POPJ P,
+
+ZPOFR: MSG [Property out of range]
+ SKIPA
+ZPOFL: MSG [Property length too long]
+ PUSHJ P,ERROR
+ POPJ P,
+
+ZPROPL: MSG [Property definition not during table?]
+ PUSHJ P,ERROR
+ POPJ P,
+
+ZSEQ: MOVEI D,0
+ NXTARG 1
+ZSEQL: SKIPN B,(TP)
+ POPJ P,
+ MOVE C,D
+ PUSHJ P,DEFGLB
+ JRST ZSEMDG
+ZSEQN: AOJA D,ZSEQL
+
+ZSEMDG: MSG [Multiply defined global]
+ PUSHJ P,ERROR
+ JRST ZSEQN
+
+
+SUBTTLE STRING PSEUDOS
+
+ZSTR: SKIPN A,2(TP)
+ JRST TFARG
+ PUSHJ P,MAKSTR
+ POPJ P,
+
+ZSTRL: MOVEI A,0
+ PUSHJ P,OUTBYT
+ PUSH P,Z ;save bptr
+ PUSH P,ZPC ;save pc
+ PUSHJ P,ZSTR
+ POP P,A ;restore pc
+ POP P,B ;restore bptr
+ SUBM ZPC,A
+ TRNE A,1
+ ADDI A,1 ;round up
+ LSH A,-1 ;convert to words
+ DPB A,B ;output length of string
+ POPJ P,
+
+ZZWORD: NXTARG 1
+ SKIPN A,(TP)
+ JRST TFARG
+ PUSHJ P,MAKZWD
+ POPJ P,
+
+TFARG: MSG [Too few arguments]
+ PUSHJ P,ERROR
+ POPJ P,
+
+
+SUBTTL SIMPLE THINGS: TRUTH, WORDS, BYTES
+
+ZTRUE: MOVEI A,1
+ PUSHJ P,OUTWRD
+ POPJ P,
+
+ZFALSE: MOVEI A,0
+ PUSHJ P,OUTWRD
+ POPJ P,
+
+ZWORD: NXTARG 1 ;flush .WORD
+ZWORD1: PUSHJ P,AWORD
+ POPJ P,
+ SKIPN (TP)
+ SKIPE 1(TP)
+ JRST ZWORD1
+ POPJ P,
+
+ZBYTE: NXTARG 1 ;flush .BYTE
+ZBYTE1: PUSHJ P,ABYTE
+ POPJ P,
+ SKIPN (TP)
+ SKIPE 1(TP)
+ JRST ZBYTE1
+ POPJ P,
+
+SUBTTL OPERAND ASSEMBLY
+
+;assembly of real opers
+AOPER: SETOM NOREF ;don't produce references, just do lookups
+ MOVEM B,OPER ;save operand (and bits!)
+ SETOM PRED ;not pred instruction
+ TLNE B,%PRED
+ SETZM PRED ; yes it is!
+ SETZM SENSE ;initialize jump sense
+ SETOM VAL ;not val instruction
+ TLNE B,%VAL
+ SETZM VAL ; yes it is!
+ MOVEI F,0 ;first count arguments
+;set up buffer for arguments
+ MOVE AB,[ARGBUF,,ARGBUF+1]
+ SETOM ARGBUF
+ BLT AB,ARGBUF+12
+ MOVEI AB,ARGBUF
+
+ MOVE B,OPER
+ TLNE B,%JUMP ;don't skip if it's a jump
+ JRST AOPERJ
+ NXTARG 1 ;move over op
+ {;now hack arguments
+AOPER1: SKIPN (TP)
+ SKIPE 1(TP)
+ SKIPA
+ JRST AOPERN ;done, no more args
+ MOVE A,1(TP) ;pick up terminator
+;here for string
+ CAIE A,""
+ JRST AOPERQ
+ MOVE A,OPER
+ TLNN A,%STR ;must be string operator
+ JRST AOPSTR ;string given to non-string operator
+ HRRZ A,A
+ PUSHJ P,OUTBYT
+ MOVE A,(TP)
+ PUSHJ P,MAKSTR
+ SKIPN 2(TP)
+ SKIPE 3(TP)
+ JRST TMAPRI
+ POPJ P,
+
+TMAPRI: MSG [Too many arguments to PRINTI]
+ PUSHJ P,ERROR
+ POPJ P,
+
+AOPSTR: MSG [String given to non-string operator?]
+ PUSHJ P,ERROR
+ POPJ P,
+
+;here for quoted variable name
+AOPERQ: CAIE A,"' ;quoted variable?
+ JRST AOPERP
+ ADDI F,1 ;that's an argument
+ NXTARG 1
+ SKIPN (TP)
+ JRST AOPQUT ;bad variable name
+ PUSHJ P,AGET
+ JFCL
+ TLNN B,%VAR
+ JRST AOPQUT
+ TLZ B,%VAR ;quoting devariablizes variables
+ JRST AOPOUT
+
+AOPGET: PUSHJ P,AGET ;get value if any
+ JFCL
+AOPOUT: MOVEM B,(AB) ;put out theory on arg
+ MOVE B,-2(TP)
+ MOVEM B,1(AB) ;put out symbol
+ ADDI AB,2
+ JRST AOPER1
+
+;here arg is nothing special
+AOPERC: AOJA F,AOPGET
+
+AOPERJ: MOVEI G,0
+ JRST AOPERK
+
+;here for predicate jump
+AOPERP: CAIE A,"/ ;'then' predicate?
+ CAIN A,"\ ;'else' predicate?
+ SKIPA
+ JRST AOPERV
+ MOVEI G,0
+ CAIN A,"/
+ TRO G,100000
+ MOVEM G,SENSE
+AOPERK: NXTARG 1
+ SKIPN (TP)
+ JRST AOPQUT ;bad variable name
+ PUSHJ P,ALCL ;get value if any
+ JFCL
+ MOVEM B,PRED
+ MOVE B,-2(TP)
+ MOVEM B,PRED+1
+ JRST AOPER1
+
+;here for value variable
+AOPERV: CAIE A,"> ;term. for assignment
+ JRST AOPERC
+ NXTARG 1
+ SKIPN (TP)
+ JRST AOPQUT ;bad variable name
+ PUSHJ P,AGET ;get value if any
+ JFCL
+ MOVEM B,VAL
+ MOVE B,-2(TP)
+ MOVEM B,VAL+1
+ JRST AOPER1
+
+AOPQUT: MSG [Bad variable name after value or predicate]
+ PUSHJ P,ERROR
+ POPJ P,
+
+;here we know how many args, so frotz with operand value appropriately
+;f/ # of args.
+AOPERN: SKIPE ODEBUG ;print theory of operator
+ PUSHJ P,OPRNT ; if odebug is non-zero
+ SKIPE TWOPASS ;if non two pass, then can make refs
+ SKIPE PASS2 ;can't make refs in pass 1
+ SETZM NOREF ;can make refs now
+ MOVEI AB,ARGBUF
+ MOVE B,OPER ;pick up operator
+ ANDI B,377 ;flush various funny bits
+;dispatch on operand value
+ CAIL B,300 ;ext?
+ JRST OUTEXT ; yes, this one is always an ext
+ CAIL B,260 ;0op?
+ JRST OUT0OP ; yes
+ CAIL B,200 ;1op?
+ JRST OUT1OP ; yes
+;falls through
+
+;remainder are all 2op (but can be ext!)
+OUT2OP: CAIE F,2
+ JRST TMA2OP
+ MOVEI C,0
+ MOVE A,(AB)
+ JUMPL A,CNVEXT ;if undefined, must be ext.
+ TLNE A,%VAR
+ JRST CHK1VR
+ CAIL A,0
+ CAIL A,400
+ JRST CNVEXT ;if long immediate, must be ext.
+ SKIPA ;arg 1 is immediate
+CHK1VR: TRO B,100 ;arg 1 is a variable
+CHK2ND: MOVE A,2(AB)
+ JUMPL A,CNVEXT ;if undefined, must be ext.
+ TLNE A,%VAR
+ JRST CHK2VR
+ CAIL A,0
+ CAIL A,400
+ JRST CNVEXT ;if long immediate, must be ext.
+ SKIPA ;arg 2 is immediate
+CHK2VR: TRO B,40 ;arg 2 is a variable
+
+;here it's really a 2op
+ MOVE A,B
+ PUSHJ P,OUTBYT ;output operator
+ HRRZ A,(AB)
+ PUSHJ P,OUTBYT
+ HRRZ A,2(AB)
+ PUSHJ P,OUTBYT
+ JRST OUTPV ;go do value and pred
+
+;here if wrong number of arguments (might be 4 arg EQUAL?)
+TMA2OP: MOVE B,OPER
+ TLNN B,%XARG ;4 arg equal?, so convert to ext.
+ JRST TMA2O1 ;real wna, too bad
+
+;here to convert a 2op to an ext
+CNVEXT: MOVE B,OPER
+ ADDI B,300 ;convert to ext
+ MOVEM B,OPER
+ ANDI B,377
+ MOVEI AB,ARGBUF
+ JRST OUTEXT
+
+TMA2O1: MSG [Too many arguments to 2op]
+ PUSHJ P,ERROR
+ POPJ P,
+
+;here to output a 1op instruction
+OUT1OP: MOVE B,OPER
+ TLNE B,%JUMP ;special case jumps
+ JRST OUTJMP
+ CAIE F,1 ;one arg?
+ JRST TMA1OP ;no, lose!
+ MOVE A,(AB) ;pick up argument
+ TLNN A,%VAR ;variable?
+ JRST 1OPI ; no.
+ TRO B,40 ;variable arg bit
+1OPBYT: EXCH A,B
+ HRRZ A,A
+ PUSHJ P,OUTBYT ;output oper
+ HRRZ A,B
+ PUSHJ P,OUTBYT ;output variable byte
+ JRST OUTPV
+
+OUTJMP: JUMPG F,TMA1OP
+ HRRZ A,B
+ PUSHJ P,OUTBYT ;output it for now
+ MOVE B,OPER
+ JRST OUTP1
+
+1OPI: CAIL A,0
+ CAIL A,400 ;will it fit in one word?
+ JRST 1OPNO
+ TRO B,20 ;immediate bit
+ JRST 1OPBYT ;output oper and imm. byte
+
+1OPNO: EXCH A,B
+ HRRZ A,A
+ PUSHJ P,OUTBYT ;output oper.
+ JUMPL B,1OPREF
+1OPNO1: HRRZ A,B
+ PUSHJ P,OUTWRD ;output long arg.
+ JRST OUTPV
+
+;here single arg is reference to unknown
+1OPREF: MOVE B,1(AB) ;must make an appropriate fixup
+ PUSHJ P,REFSYM
+ MOVE B,(AB) ;output what we have of value
+ JRST 1OPNO1
+
+TMA1OP: MSG [Too many args to 1op instruction]
+ PUSHJ P,ERROR
+ POPJ P,
+
+;here to output extended op
+OUTEXT: CAILE F,4
+ JRST TMAEXT
+ MOVE A,B
+ PUSHJ P,OUTBYT ;operator
+ MOVEI A,0
+ PUSHJ P,OUTBYT ;ext byte (will be filled in later)
+ MOVE G,Z ;save output ptr
+ MOVEI D,0 ;ext byte under construction
+ MOVEI E,4 ;max arguments
+;here loop through args to ext instruction
+EXTLUP: MOVE A,(AB) ;get arg
+ TLNN A,%VAR ;variable?
+ JRST EXTIMM
+ TRO D,2 ;yes, turn on variable bit
+EXTBYT: HRRZ A,A
+ PUSHJ P,OUTBYT ;output variable byte
+ JRST EXTNXT
+EXTIMM: CAIL A,0 ;immediate?
+ CAIL A,400
+ JRST EXTLIM ;no, long
+ TRO D,1 ;turn on immediate bit
+ JRST EXTBYT ;output immediate byte
+EXTLIM: JUMPL A,EXTREF ;undefined?
+ HRRZ A,A ;no, output full word
+ PUSHJ P,OUTWRD
+ JRST EXTNXT
+
+EXTREF: MOVE B,1(AB)
+ PUSHJ P,REFSYM
+ HRRZ A,(AB)
+ PUSHJ P,OUTWRD
+
+EXTNXT: SOJE E,EXTEXT ;if done four args, leave
+ SUBI F,1 ;reduce count
+ ADDI AB,2 ;move to next
+ LSH D,2 ;update ext byte
+ JUMPG F,EXTLUP ;if still args, do them
+ TRO D,3 ;turn on last arg bits
+ JRST EXTNXT ;if not, loop filling ext byte with 3
+
+EXTEXT: DPB D,G ;output ext word
+ JRST OUTPV ;go output val and pred stuff
+
+TMAEXT: MSG [Too many arguments to EXT instruction]
+ PUSHJ P,ERROR
+ POPJ P,
+
+;here to output a 0op instruction
+OUT0OP: JUMPG F,TMA0OP ;better not have any args!
+ MOVE A,B ;pick up operand from B
+ PUSHJ P,OUTBYT
+
+;here to output value and predicate stuff for instructions
+OUTPV: MOVE B,OPER
+ TLNN B,%VAL
+ JRST OUTP
+ MOVE A,VAL
+ CAMN A,[-1]
+ JRST NOVAL
+ JUMPL A,OUTVRF ;reference to value
+ HRRZ A,A
+ PUSHJ P,OUTBYT
+
+OUTP: TLNN B,%PRED+%JUMP
+ POPJ P,
+;comes here from outputting jump instruction
+OUTP1: MOVE A,PRED
+ CAMN A,[-1]
+ JRST NOPRED
+ MOVE C,A
+ JUMPL A,OUTPRF ;reference to predicate
+;produce jump offset
+ TRNN A,37776 ;check for /true /false jump
+ JRST OUTPSH ;short
+ SUB A,ZPC
+ TLNE B,%JUMP
+ ANDI A,177777 ;16 bit jump inst.
+ TLNN B,%JUMP
+ ANDI A,37777 ;14 bit pred. jumps
+;determine whether short or long jump
+ CAIGE A,77 ;test if pred jump is short
+ JRST OUTPSH
+ CAMN B,OPJMP ;jump instruction can take larger "shorts"
+ CAIL A,377 ;small enough?
+ JRST OUTPLN ; no, long jump. sigh.
+
+;short jump: <polarity>+<short=1>+<offset:6bits>
+; such are always forward jumps of less than 64 bytes
+OUTPSH: CAMN B,OPJMP
+ JRST OUTSJ ;output short jump byte
+ TRO A,100 ;short jump
+ MOVE C,SENSE
+ TRNE C,100000
+ TRO A,200 ;move jump sense to second byte
+OUTPS1: ANDI A,377 ;and make it a byte
+ PUSHJ P,OUTBYT
+ POPJ P,
+
+OUTSJ: PUSH P,A
+ HRRZ A,B
+ TRO A,20 ;turn on immediate bit
+ DPB A,Z
+ POP P,A
+ JRST OUTPS1
+
+;long jump
+OUTPLN: MOVE C,SENSE
+ TRNE C,100000
+ TRO A,100000
+ PUSHJ P,OUTWRD
+ POPJ P,
+
+;here when predicate jump is a forward reference
+OUTPRF: SETOM JMPREF ;say it's a jump reference
+ SKIPE TWOPAS
+ SKIPE FZ
+ JRST OUTPRL
+ HRRZ A,A ;get value part of ref
+ SUB A,ZPC
+ SUB A,FSHORT
+ TLNE B,%JUMP
+ ANDI A,177777 ;16 bit jump inst.
+ TLNN B,%JUMP
+ ANDI A,37777 ;14 bit pred. jumps
+;determine whether short or long jump
+ TLNN B,%JUMP ;real jumps are always long
+ CAIL A,77 ;test if pred jump is short
+ JRST OUTPRL ;long jump. sigh.
+;here short jump reference
+ MOVEI A,100 ;short jump
+ MOVE C,SENSE
+ TRNE C,100000
+ TRO A,200 ;move jump sense to second byte
+ HRRM A,PRED ;save it
+;make the reference
+ SETOM WRDBYT ;say it's a byte ref
+ MOVE B,PRED+1
+ PUSHJ P,REFLCL
+ SETZM JMPREF
+ SETZM WRDBYT
+;output the byte
+ HRRZ A,PRED
+ PUSHJ P,OUTBRF
+ AOS FSHORT
+ POPJ P,
+
+OUTPRL: MOVE B,PRED+1
+ PUSHJ P,REFLCL ;all jumps are local
+ SETZM JMPREF
+ MOVE A,SENSE
+ PUSHJ P,OUTWRF ;output reference
+ POPJ P,
+
+NOPRED: MSG [Predicate instruction lacks predicate]
+ PUSHJ P,ERROR
+ POPJ P,
+
+OUTVRF: MSG [Value indefined]
+ SKIPA
+NOVAL: MSG [Value instruction lacks value]
+ PUSHJ P,ERROR
+ POPJ P,
+
+TMA0OP: MSG [Too many args to 0op instruction]
+ PUSHJ P,ERROR
+ POPJ P,
+
+OPRNT: PUSH P,A
+ PUSH P,B
+ PUSH P,C
+ PUSH P,D
+ HRROI A,BUFFER
+ PSOUT
+ MOVEI A,^M
+ PBOUT
+ MOVEI A,^J
+ PBOUT
+ MOVEI D,0
+OPLOOP: MOVE A,ARGBUF(D)
+ CAMN A,[-1]
+ JRST OPPV
+ MOVE A,ARGBUF+1(D)
+ PSOUT
+ MOVEI A,^I
+ PBOUT
+ MOVE B,ARGBUF(D)
+ PUSHJ P,NUM
+ PUSHJ P,CRLF
+ ADDI D,2
+ JRST OPLOOP
+
+CRLF: MOVEI A,^M
+ PBOUT
+ MOVEI A,^J
+ PBOUT
+ POPJ P,
+
+NUM: PUSH P,A
+ PUSH P,C
+ JUMPGE B,OPNV
+ MOVEI A,"?
+ PBOUT
+ MOVEI A,"
+ PBOUT
+ TLZ B,%UNDEF
+OPNV: TLNN B,%VAR
+ JRST OPNUM
+ MOVEI A,"#
+ PBOUT
+ TLZ B,%VAR
+OPNUM: MOVEI A,.PRIOU
+ MOVEI C,8.
+ NOUT
+ JFCL
+ POP P,C
+ POP P,A
+ POPJ P,
+
+OPPV: MOVE A,VAL
+ CAMN A,[-1]
+ JRST OPPRED
+ MOVEI A,">
+ PBOUT
+ MOVE A,VAL+1
+ PSOUT
+ MOVEI A,^I
+ PBOUT
+ MOVE B,VAL
+ PUSHJ P,NUM
+ PUSHJ P,CRLF
+OPPRED: MOVE B,PRED
+ CAMN B,[-1]
+ JRST OPPEX
+ MOVEI A,"\
+ MOVE B,SENSE
+ TRNE B,100000
+ MOVEI A,"/
+ PBOUT
+ MOVE A,PRED+1
+ PSOUT
+ MOVEI A,^I
+ PBOUT
+ MOVE B,PRED
+ PUSHJ P,NUM
+ PUSHJ P,CRLF
+OPPEX: POP P,D
+ POP P,C
+ POP P,B
+ POP P,A
+ POPJ P,
+
+
+SUBTTL SYMBOL HACKING
+
+; symbols look like:
+; SYMNAM <pname loc> ,, <next symbol>
+; SYMVAL <value>
+; SYMREF <references>
+; where
+; <value> if for a defined symbol
+; includes
+; %VAR,, if the symbol is for a variable (local or global)
+; and
+; <value> if for an undefined symbol
+; includes
+; %UNDEF,, <value if local label>
+
+; a reference chain consists of
+; <pc> ,, <next reference>
+; <output ptr>
+; where
+; <pc> includes
+; %RBYTE if the reference is a byte reference
+; %RJUMP if the reference is a jump reference
+
+;look up a symbol in a symbol list
+; a/ symbol table, b/ symbol
+; +1 a/ table loc of symbol, won
+; +2 a/ potential table loc of symbol, lost
+SLOOK: PUSH P,B
+ PUSH P,C
+ PUSH P,D
+ PUSH P,E
+;hash the symbol
+ SETZ C,
+HASH1: ILDB E,B
+ JUMPE E,HASH2
+ ROT C,3
+ XOR C,E
+ JRST HASH1
+HASH2: TLZ C,400000
+ IDIVI C,BUCKN ;number of buckets to D
+ IMULI D,BUCKL ;length of buckets
+ HRL D,D
+ ADDM A,D
+ SKIPL D
+ HALTF ;symbol table overflow
+;look for it
+ MOVE A,-3(P) ;pick up symbol being looked for
+SLKLUP: SKIPN B,SYMNAM(D) ;symbol here?
+ JRST SLKLOS ; nothing here
+ HLR B,B
+ HRLI B,440700 ;produce byte pointer
+ PUSHJ P,COMPAR ;compare
+ JRST SLKWON ;same, win
+ JFCL
+ ADDI D,SYMSIZ ;move to next symbol
+ JRST SLKLUP ;and loop
+
+SLKLOS: MOVE A,D ; rtn ptr to symbol slot in A
+ POP P,E
+ POP P,D
+ POP P,C
+ POP P,B
+ JRST POPJ1
+
+SLKWON: HLR B,SYMNAM(D) ;found it, stuff it for future use
+ HRLI B,440700
+ MOVEM B,LSTSYM
+ MOVE A,D ; return ptr
+ POP P,E
+ POP P,D
+ POP P,C
+ POP P,B ; return ptr to cell
+ POPJ P,
+
+; insert symbol in table
+; a/ where (as returned by SLOOK)
+; b/ symbol
+; c/ value
+SINSRT: PUSH P,A
+ PUSH P,B
+ PUSH P,C
+ PUSH P,D
+ HRLZM FREE,SYMNAM(A) ;symbol will be copied here
+ MOVEM C,SYMVAL(A) ;value
+;copy symbol into appropriate symbol area
+ MOVE A,FREE
+ HRLI A,440700 ;bptr to output
+ MOVE D,A ;save a copy
+ SETZM (A) ;make sure its zero
+ MOVEM A,LSTSYM ;most recent symbol defn.
+ ILDB C,B
+ IDPB C,A
+ JUMPN C,.-2
+ CAMN A,D ;not a nul symbol?
+ HALTF ; should be no nul symbols
+ HRRZI FREE,1(A) ;update free pointer
+ POP P,D
+ POP P,C
+ POP P,B
+ POP P,A
+ POPJ P,
+
+SUBTTL SYMBOL TABLE DEBUGGING
+
+;print a symbol list, takes it in A
+SPRNT: PUSH P,A
+ PUSH P,B
+ SKIPN B,A
+ JRST SPRNT2
+SPRNT1: HLRZ A,SYMNAM(B)
+ JUMPE A,SPRNT3
+ HRLI A,-1
+ PSOUT
+ MOVEI A,"?
+ SKIPGE SYMVAL(B)
+ PBOUT ;? if undefined
+ MOVEI A,",
+ PBOUT
+SPRNT3: HRRZ B,SYMNAM(B)
+ JUMPN B,SPRNT1
+SPRNT2: HRROI A,[ASCIZ /
+/]
+ PSOUT
+POPBAJ: POP P,B
+ POP P,A
+ POPJ P,
+
+;print the global symbol table
+GPRNT: PUSH P,A
+ MOVE A,GLBLST
+ PUSHJ P,SPRNT
+ POP P,A
+ POPJ P,
+
+;print the local symbol table
+LPRNT: PUSH P,A
+ MOVE A,LCLLST
+ PUSHJ P,SPRNT
+ POP P,A
+ POPJ P,
+
+SUBTTL INITIALIZE SYMBOL TABLES
+
+;initialize global symbol table
+GLBINI: PUSH P,A
+ MOVEI A,GLBBUF
+ MOVEM A,GLBPTR
+ SETZM GLBLST
+ SETZM GLBTAB
+ MOVE A,[GLBTAB,,GLBTAB+1]
+ BLT A,GLBEND
+ POP P,A
+ POPJ P,
+
+;initialize local symbol table
+LCLINI: PUSH P,A
+ PUSH P,B
+ PUSH P,C
+ MOVEI A,LCLBUF
+ MOVEM A,LCLPTR
+ SETZM LCLLST
+ SETZM LCLTAB
+ MOVE A,[LCLTAB,,LCLTAB+1]
+ BLT A,LCLEND
+;local tables start with these three symbols in them
+ MOVE B,[440700,,[ASCIZ /FALSE/]]
+ MOVEI C,0
+ PUSHJ P,DEFLCL
+ JFCL
+ MOVE B,[440700,,[ASCIZ /TRUE/]]
+ MOVEI C,1
+ PUSHJ P,DEFLCL
+ JFCL
+ MOVE B,[440700,,[ASCIZ /STACK/]]
+ MOVSI C,%VAR
+ PUSHJ P,DEFLCL
+ JFCL
+ JRST POPCBA
+
+SUBTTL PRINT UNDEFINED LOCALS
+
+;print names of undefined locals in function
+;done whenever a function is finished
+UNDLCL: SKIPN FUNCT ;skip if was assembling a function
+ POPJ P,
+ PUSH P,A
+ PUSH P,B
+ PUSH P,C
+ PUSH P,D
+ MOVE C,LCLLST
+UNDLC2: SKIPL D,SYMVAL(C) ;value slot
+ JRST UNDLC1 ;defined symbol
+ SKIPN A,FUNCT ;undefined symbol
+ JRST UNDLC3 ;don't print function name
+ PSOUT ;print function name
+ MSG [
+]
+ PSOUT
+ SETZM FUNCT ;zero it since one print is enough
+;here to print undefined symbol and pcs at which it is referenced
+UNDLC3: MSG [ ]
+ PSOUT
+ HLRO A,SYMNAM(C) ;bptr to symbol
+ PSOUT
+ MSG [ undefined: ]
+ PSOUT
+ PUSH P,C
+ MOVEI C,10.
+ HRRZ D,SYMREF(C)
+ JRST UNDLC5
+UNDLC4: MOVEI A,.PRIOU
+ HLRZ B,(D) ;pc at which referenced
+ TRZ B,%RBYTE+%RJUMP
+ NOUT ;output pc
+ JFCL
+ MSG [, ]
+ PSOUT
+UNDLC5: HRRZ D,(D) ;move to next pc
+ JUMPN D,UNDLC4 ;and leave if last
+ PUSHJ P,PCRLF
+ POP P,C
+
+UNDLC1: HRRZ C,SYMNAM(C) ;move to next symbol
+ JUMPN C,UNDLC2 ;or leave if it was last
+;produce symbol table if asked
+ SKIPN SYMFLG
+ JRST UNDLCX
+ MOVE A,LCLLST
+ PUSHJ P,SYMTAB
+ MOVE B,FCNPTR
+ SUBI A,SYMBUF
+ MOVEM A,(B)
+ MOVE A,FSYM ;last function defined
+ MOVEM A,1(B)
+ ADDI B,2
+ MOVEM B,FCNPTR
+
+;do rest of cleanup
+UNDLCX: PUSHJ P,LCLINI ;reinit local symbol table
+ JRST POPDA
+
+SUBTTL PRINT UNDEFINED GLOBALS
+
+;print undefined globals
+UNDGLB: PUSH P,A
+ PUSH P,B
+ PUSH P,C
+ PUSH P,D
+ MOVE C,GLBLST
+UNDGL2: SKIPL D,SYMVAL(C) ;value slot
+ JRST UNDGL1
+ HLRO A,SYMNAM(C) ;bptr to symbol
+ PSOUT
+ MSG [ global undefined: ]
+ PSOUT
+ PUSH P,C
+ MOVEI C,10.
+ HRRZ D,SYMREF(C)
+ JRST UNDGL5
+UNDGL4: MOVEI A,.PRIOU
+ HLRZ B,(D) ;pc at which referenced
+ TRZ B,%RBYTE+%RJUMP
+ NOUT ;output pc
+ JFCL
+ MSG [, ]
+ PSOUT
+ HRRZ D,(D) ;move to next pc
+UNDGL5: JUMPN D,UNDGL4 ;and leave if last
+ PUSHJ P,PCRLF
+ POP P,C
+UNDGL1: HRRZ C,SYMNAM(C) ;move to next symbol
+ JUMPN C,UNDGL2 ;or leave if it was last
+
+;produce symbol table if was asked
+ SKIPN SYMFLG
+ JRST POPDA
+ MOVE A,GLBLST
+ PUSHJ P,SYMTAB
+ SUBI A,SYMBUF
+ MOVEM A,SYMBUF ;ptr to global symbol table
+;sort function table and copy it into symbol area
+ MOVE A,FCNPTR
+ SETZM (A)
+ AOS FCNPTR
+ MOVEI A,FCNBUF
+ PUSHJ P,SSORT
+ HRLI A,FCNBUF
+ HRR A,SYMPTR
+ SUBI A,SYMBUF
+ HRRZM A,SYMBUF+1 ;ptr to function symbol table
+ ADDI A,SYMBUF
+ MOVE B,FCNPTR
+ SUBI B,FCNBUF
+ ADD B,SYMPTR
+ MOVEM B,SYMPTR
+ BLT A,(B)
+
+;output symbols file
+OUTSYM: MOVE A,[440700,,[ASCIZ /.SYMS/]]
+ MOVE B,OUTPTR
+ ILDB 0,A
+ IDPB 0,B
+ JUMPN 0,.-2
+ MOVSI A,(GJ%SHT+GJ%FOU)
+ HRROI B,OUTFIL
+ GTJFN
+ JRST ERPRNT
+ HRRZ A,A
+ MOVE B,[440000,,OF%WR]
+ OPENF
+ JRST ERPRNT
+ MOVE B,[444400,,SYMBUF]
+ MOVEI C,SYMBUF
+ SUB C,SYMPTR
+ SOUT
+;close up and go home
+ CLOSF
+ JFCL
+
+POPDA: POP P,D
+ JRST POPCBA
+
+SUBTTL OUTPUT SYMBOL TABLES
+
+SYMTAB: PUSH P,B
+ PUSH P,C
+ PUSH P,D
+ MOVE C,A
+ MOVE D,A
+;copy strings
+SYMCPY: HLR A,SYMNAM(C)
+ HRLI A,440700
+ HRRZ B,SYMPTR
+ SUBI B,SYMBUF
+ HRLM B,SYMNAM(C)
+ ADDI B,SYMBUF
+ HRLI B,440700
+ ILDB A
+ IDPB B
+ JUMPN .-2
+ HRRZI B,1(B)
+ MOVEM B,SYMPTR
+ HRRZ C,(C)
+ JUMPN C,SYMCPY
+ MOVE C,D
+;copy symbols themselves
+SYMCP1: HLR A,SYMNAM(C)
+ HRLI A,440700
+ MOVEM A,(B)
+ MOVE A,SYMVAL(C)
+ MOVEM A,1(B)
+ ADDI B,2
+ HRRZ C,(C)
+ JUMPN C,SYMCP1
+ SETZM (B)
+ ADDI B,1
+ EXCH B,SYMPTR
+ MOVE A,B
+ PUSHJ P,SSORT ;sort the table
+ POP P,D
+ POP P,C
+ POP P,B
+ POPJ P,
+
+;sort a symbol table by value words
+; a/ ptr to symbol table
+SSORT: PUSH P,A
+ PUSH P,B
+ PUSH P,C
+ PUSH P,D
+SSORT1: SKIPN (A)
+ JRST POPDA
+ MOVE C,A ;save destination
+ MOVE D,A ;ptr to best candidate
+SSORT0: ADDI A,2 ;ptr to first test
+ SKIPN (A) ;better be a test...
+ JRST SSORT2 ; zero, end of table
+ MOVE B,1(D)
+ CAMLE B,1(A) ;test better than best?
+ MOVE D,A ;new best
+ JRST SSORT0 ;move to next
+
+SSORT2: CAMN D,C ;must move one?
+ JRST SSORT3
+ MOVE A,(D)
+ EXCH A,(C)
+ MOVEM A,(D)
+ MOVE A,1(D)
+ EXCH A,1(C)
+ MOVEM A,1(D)
+SSORT3: MOVEI A,2(C)
+ JRST SSORT1
+
+SUBTTL GLOBAL SYMBOL REFERENCE AND DEFINITION
+
+DEFGLB: MOVE A,GLBOBL ;look it up in global symbol table
+ PUSHJ P,SLOOK
+ JRST DEFOLD ;already there
+;symbol not in global table
+INSGLB: MOVE FREE,GLBPTR
+ PUSHJ P,SINSRT ;insert it
+ MOVEM FREE,GLBPTR
+ HRR 0,GLBLST ;chain together all globals
+ HRRM 0,(A)
+ MOVEM A,GLBLST ;by consing into a list
+ SKIPN SDEBUG
+ JRST POPJ1
+;print symbol table here if debugging
+ PUSH P,A
+ MOVE A,GLBLST
+ PUSHJ P,SPRNT
+ POP P,A
+ JRST POPJ1
+
+;here to define a symbol that already has been referenced
+DEFOLD: MOVE B,A ;move ptr to symbol
+ SKIPL SYMVAL(B) ;is it undefined?
+ JRST CPOPJ ; if defined, lose
+ MOVE A,C ;save value
+ MOVEM C,SYMVAL(B) ;define it
+ MOVE C,SYMREF(B) ;pick up reference chain to C
+ PUSHJ P,FIXUP ;fix up references already accumulated
+ JRST POPJ1
+
+SUBTTL LOCAL SYMBOL REFERENCE AND DEFINITION
+
+DEFLCL: MOVE A,LCLOBL ;look it up in local symbol table
+ PUSHJ P,SLOOK
+ JRST DEFOLL ;here for forward references
+;here to add symbol to local symbol table
+INSLCL: MOVE FREE,LCLPTR
+ PUSHJ P,SINSRT
+ MOVEM FREE,LCLPTR
+ HRR 0,LCLLST
+ HRRM 0,(A)
+ MOVEM A,LCLLST
+ JRST POPJ1
+
+;here to define already referenced local symbol
+DEFOLL: SKIPN TWOPAS
+ JRST DEFOLD
+ SKIPN PASS2 ;only do fixups if pass 2
+ JRST DEFOL1 ; do usual thing in pass 1
+;do hair in pass 2
+ MOVEM C,SYMVAL(A) ;redefine local label
+;fix up for short jumps
+ MOVE C,SYMREF(A) ;get reference chain
+ MOVE A,SYMVAL(A) ;get value to be fixed up
+ PUSHJ P,FIXUP
+ JRST POPJ1
+
+;here to "define" local symbol during pass one
+DEFOL1: MOVE B,A
+ SKIPL SYMVAL(B) ;should be undefined
+ JRST CPOPJ ; if defined, lose
+ MOVE A,C ;save value
+ HRRM C,SYMVAL(B) ;pretend to define it
+ JRST POPJ1
+
+BPASS2: MSG [Label inconsistency, pass 2]
+ PUSHJ P,ERROR
+ JRST POPJ1
+
+
+SUBTTL REFERENCE AND DEFINE SYMBOLS
+
+;reference a symbol
+; takes b/ symbol
+; returns a/ ptr to cell for symbol
+REFSYM: PUSH P,B
+ PUSH P,C
+ MOVE A,LCLOBL ;look up as local first
+ PUSHJ P,SLOOK
+ JRST [SKIPL SYMVAL(A) ;skip if undefined
+ JRST POPCB ;has a value, return it
+ JRST REFLLD] ;refer to old local
+ MOVE A,GLBOBL
+ MOVE B,-1(P)
+ PUSHJ P,SLOOK
+ JRST [SKIPL SYMVAL(A)
+ JRST POPCB ;has a gval, return it
+ JRST REFGLD] ;refer to old global
+ MOVE B,-1(P)
+ PUSHJ P,REFGLB
+POPCB: POP P,C
+ POP P,B
+ POPJ P,
+
+;reference a global
+; b/ symbol
+REFGLB: PUSH P,B
+ PUSH P,C
+ MOVE A,GLBOBL
+ MOVE B,-1(P)
+ PUSHJ P,SLOOK
+ JRST REFGLD ;refer to old global
+ MOVE B,-1(P)
+ HRLZI C,%UNDEF ;undefined
+ PUSHJ P,INSGLB
+ HALTF
+REFGLD: SKIPE NOREF
+ JRST POPCB
+ MOVE FREE,GLBPTR
+ HRRZ B,SYMREF(A) ;get pc chain
+ HRRM FREE,SYMREF(A) ;and put new cell in symbol cell
+ SKIPE WRDBYT
+ TLO B,%RBYTE ;indicate byte reference
+ MOVEM B,(FREE)
+ MOVEM ZPC,1(FREE) ;pc
+ MOVEM Z,2(FREE) ;bptr
+ ADDI FREE,3
+ MOVEM FREE,GLBPTR
+ JRST POPCB
+
+;reference a local
+; b/ symbol
+REFLCL: PUSH P,B
+ PUSH P,C
+ MOVE A,LCLOBL
+ MOVE B,-1(P)
+ PUSHJ P,SLOOK
+ JRST REFLLD ;refer to old local
+ MOVE B,-1(P)
+ HRLZI C,%UNDEF ;undefined
+ PUSHJ P,INSLCL
+ HALTF
+REFLLD: SKIPE NOREF
+ JRST POPCB
+ MOVE FREE,LCLPTR ;get free storage from local area
+ HRRZ B,SYMREF(A) ;get ptr to reference chain
+ HRRM FREE,SYMREF(A) ;and update chain ptr
+ SKIPE WRDBYT
+ TLO B,%RBYTE
+ SKIPE JMPREF
+ TLO B,%RJUMP ;indicate jump reference
+ MOVEM B,(FREE) ;put it in right half of new ref
+ MOVEM ZPC,1(FREE) ;put out pc of ref
+ MOVEM Z,2(FREE) ;put of bptr of ref
+ ADDI FREE,3
+ MOVEM FREE,LCLPTR ;update free ptr
+ JRST POPCB
+
+SUBTTL FIXUPS
+
+;fixup forward references
+; a/ value
+; c/ ptr chain
+FIXUP: TRNN C,-1 ;if empty fixup chain, return immediately
+ POPJ P, ; only happens for local labels
+ PUSH P,SAVZPC
+ PUSH P,SAVZ
+ PUSH P,ZPC
+ PUSH P,Z ;fix up references
+ PUSH P,A
+FIXUPL: HRRZ A,(P) ;pick up value to output
+ MOVE Z,2(C) ;pick up reference output ptr
+ MOVEM Z,SAVZ
+ MOVE ZPC,1(C)
+ MOVEM ZPC,SAVZPC
+ MOVE B,(C)
+ TLNE B,%RJUMP ;jump ref?
+ JRST FIXUPJ ; yes
+ JUMPGE B,[PUSHJ P,ADDWRD
+ JRST FIXUPN]
+ PUSHJ P,ADDBYT
+FIXUPN: SKIPE PDEBUG
+ PUSHJ P,PFIXUP
+ HRRZ C,(C) ;move to next one
+ JUMPN C,FIXUPL
+FIXUPX: POP P,A
+ POP P,Z
+ POP P,ZPC
+ POP P,SAVZ
+ POP P,SAVZPC
+ POPJ P,
+
+;here to fix up jumps
+FIXUPJ: MOVE 1(C) ;pc of ref
+ SUB A,0 ;pc difference (true/false and pc diff cancel?)
+ TLNE B,%RBYTE ;byte ref?
+ JRST FIXSHJ ; means short jump
+ ANDI A,177777 ;and it down (two's comp.)
+ CAIGE A,77 ;skip if couldn't have been short
+ AOS SHRIMP ;keep count of short jumps
+ PUSHJ P,ADDWRD
+ MOVE A,(P) ;get value back
+ JRST FIXUPN ;and continue
+
+;here to fix up short jumps
+FIXSHJ: ADDI A,1 ;pc offset
+ ANDI A,177777 ;max size of a reference
+ CAILE A,77 ;can it be a short jump?
+ HALTF ; better be!
+ ANDI A,377 ;and it down just ofr good measure
+ PUSHJ P,ADDBYT ;output byte
+ MOVE A,(P) ;resnarf value
+ JRST FIXUPN ;and loop
+
+;when debugging, print fixups when they are done
+PFIXUP: PUSH P,A
+ PUSH P,B
+ PUSH P,C
+ MOVE A,PDEBUG
+ MOVEI B,"{
+ BOUT
+ PUSHJ P,OPC
+ MOVEI C,0
+ HRROI B,[ASCIZ /}
+/]
+ SOUT
+ JRST POPCBA
+
+SUBTTL ERROR MESSAGES
+
+ERROR: PUSH P,B
+ SETZ B,
+ PUSHJ P,ERRMSG
+ POP P,B
+ POPJ P,
+
+;takes message in A, token in B
+ERRMSG: PUSH P,A
+ PUSH P,B
+ PUSH P,C
+ MOVEI A,.PRIOU
+ MOVE B,ZPC
+ MOVEI C,8
+ NOUT
+ JFCL
+ SKIPN FUNCT
+ JRST ERRMS1
+ MSG [ (in ]
+ PSOUT
+ MOVE A,FUNCT
+ PSOUT
+ MSG [)]
+ PSOUT
+ERRMS1: MSG [ ]
+ PSOUT
+ MOVE A,-2(P)
+ PSOUT
+ MOVE B,-1(P)
+ JUMPE B,ERREND
+ MOVEI A,[ASCIZ /: /]
+ PSOUT
+ MOVE A,B
+ PSOUT
+ PUSHJ P,PCRLF
+ HRROI A,BUFFER
+ PSOUT
+ SKIPA
+ERREND: PUSHJ P,PCRLF
+ POP P,C
+ POP P,B
+ POP P,A
+ POPJ P,
+
+SUBTTL STRING ASSEMBLY
+
+;zstrings from strings
+; a/ ptr to string to translate
+
+MAKFST: SETOM MKFSTR'
+ SETOM ZWDFLG
+ JRST MAKS
+
+MAKZWD: SETOM ZWDFLG'
+ SETOM MKFSTR
+ JRST MAKS
+
+MAKSTR: SETZM ZWDFLG
+ SETZM MKFSTR
+MAKS: SKIPE ZDEBUG
+ JRST [PUSH P,A
+ MOVEI A,^M
+ PBOUT
+ MOVEI A,^J
+ PBOUT
+ MOVE A,(P)
+ PSOUT
+ MOVEI A,40
+ PBOUT
+ POP P,A
+ JRST .+1]
+ MOVEI ZCHR,0 ; initialize ZCHR byte
+ SKIPA FRMT,[%FSPC+%FCAP]; at start, default is cap + space
+MAKSTL: MOVEI FRMT,%FSPC ; except at start, default is space
+ MOVEM FRMT,FRMDFL ; set up default
+ MOVE C,A
+ ILDB B,C ; get first character
+ JUMPE B,MAKSTE ; done
+ PUSHJ P,BALPHA ; check for alphabetic
+ JRST MAKS1 ; no. goto ascii escape
+MAKST0: MOVEI FRMT,%FCAP
+ CAIG B,"Z
+ CAIGE B,"A
+ TRZ FRMT,%FCAP ; turn off capitalize bit if not upper case
+ SKIPN MKFSTR ; don't bother with freq stuff for fstrs
+ PUSHJ P,WFREQ ; lookup word in table (a is updated)
+ JRST MAKS2 ; not there, loser!
+ PUSH P,C ; save the word number
+ SKIPE INZASC
+ PUSHJ P,ENZASC
+ PUSHJ P,MAKFRM ; setup the format for the word
+ CAME FRMT,FRMDFL' ; if it's the default, don't bother
+ PUSHJ P,OUTFRM ; output the format
+ POP P,C ; restore the word number
+ SKIPE ZDEBUG
+ JRST [PUSH P,A
+ MOVEI A,"W
+ PBOUT
+ POP P,A
+ JRST .+1]
+ CAIL C,240.
+ JRST [SUBI C,240.
+ PUSH P,C
+ MOVEI C,%FNXT ; output next 256-word byte
+ PUSHJ P,OUTBYC
+ POP P,C
+ JRST .+2]
+ ADDI C,16. ; frob with word number
+ PUSHJ P,OUTBYC
+ JRST MAKSTL ; and loop
+
+MAKS1: MOVEI C,%FASC
+ SKIPN INZASC
+ PUSHJ P,OUTBYC
+MAKS1L: ILDB B,A
+ JUMPE B,MAKSTX
+ PUSHJ P,BALPHA
+ JRST MAKS1A
+MAKSEZ: SETOM INZASC'
+ PUSHJ P,BACKA
+ MOVEI FRMT,%FSPC ; except at start, default is space
+ MOVEM FRMT,FRMDFL ; set up default
+ JRST MAKST0
+
+BACKA: MOVNI B,1
+ ADJBP B,A
+ MOVE A,B
+ POPJ P,
+
+MAKS1A: PUSHJ P,MAKZBT
+ JRST MAKS1L
+
+MAKS2: MOVEI C,%FASC ; escape to ZASCII
+ SETZM MAKSAF'
+ SKIPE MKFSTR
+ JRST MAKS2L
+ SKIPN INZASC
+ PUSHJ P,OUTBYC
+MAKS2L: ILDB B,A ; get next character
+ JUMPE B,MAKSTX
+ CAIN B,"'
+ JRST MAKS2A
+ PUSHJ P,BALPHA
+ CAIA
+ JRST MAKS2A
+ SETOM MAKSAF
+ PUSHJ P,MAKZBT
+ JRST MAKS2L
+
+MAKS2A: SKIPE MAKSAF
+ JRST MAKSEZ
+ PUSHJ P,MAKZBT
+ JRST MAKS2L
+
+ENZASC: JUMPN ZCHR,ENZAS1
+ MOVEI C,0
+ PUSHJ P,OUTBYC
+ SETZM INZASC
+ POPJ P,
+
+ENZAS1: MOVEI 0,0
+ PUSHJ P,ADDZCH
+ SETZM INZASC
+ POPJ P,
+
+%FEOS==0
+%FSPC==1
+%FCOM==2
+%FCAP==4
+%FFLG==8
+
+%FESS==5
+%FNXT==4
+%FESN==3
+%FEOL==2
+%FASC==1
+
+CHR1T: "e ? "t ? "s ? "a ? "o ? "n ? "r ? "i
+ "l ? "d ? "h ? "u ? "g ? 0
+
+CHR2T: "c ? "b ? "m ? "w ? "y ? "p ? "f ? "k
+ "v ? "z ? "j ? "x ? "q ? 40 ? "! ? "?
+
+MAKZBT: MOVEI D,CHR1T
+MAKZL1: SKIPN C,(D)
+ JRST MAKZB1
+ CAME C,B
+ AOJA D,MAKZL1
+ MOVEI 0,-CHR1T+3(D)
+ PUSHJ P,ADDZCH
+ POPJ P,
+
+MAKZB1: MOVEI D,CHR2T
+MAKZL2: SKIPN C,(D)
+ JRST MAKZB2
+ CAME C,B
+ AOJA D,MAKZL2
+ MOVEI 0,1
+ PUSHJ P,ADDZCH
+ MOVEI 0,-CHR2T(D)
+ PUSHJ P,ADDZCH
+ POPJ P,
+
+MAKZB2: MOVEI 0,2
+ PUSHJ P,ADDZCH
+ PUSH P,B
+ LSH B,-4
+ MOVE 0,B
+ PUSHJ P,ADDZCH
+ POP P,B
+ ANDI B,17
+ MOVE 0,B
+ PUSHJ P,ADDZCH
+ POPJ P,
+
+ADDZCH: JUMPN ZCHR,ADDZC1
+ MOVE ZCHR,0
+ POPJ P,
+
+ADDZC1: LSH ZCHR,4
+ ADD ZCHR,0
+ MOVE C,ZCHR
+ PUSHJ P,OUTBYC
+ SKIPE ZDEBUG
+ JRST [PUSH P,A
+ PUSH P,B
+ PUSH P,C
+ MOVEI A,"(
+ PBOUT
+ MOVE B,ZCHR
+ LSH B,-4
+ MOVEI A,.PRIOU
+ MOVEI C,10.
+ NOUT
+ JFCL
+ MOVEI B,"+
+ BOUT
+ MOVE B,ZCHR
+ ANDI B,17
+ NOUT
+ JFCL
+ MOVEI B,")
+ BOUT
+ MOVEI B,40
+ BOUT
+ POP P,C
+ POP P,B
+ POP P,A
+ JRST .+1]
+ MOVEI ZCHR,0
+ POPJ P,
+
+MAKSTX: PUSHJ P,ENZASC
+MAKSTE: MOVEI C,%FEOS ; strings end with EOS
+ SKIPE ZWDFLG
+ POPJ P,
+ MOVE 0,LSTFRM
+ CAIE 0,%FFLG+%FESS
+ PUSHJ P,OUTBYC
+ POPJ P,
+
+OUTBYC: EXCH A,C ; output byte in c, saving a
+ SKIPE ZDEBUG
+ PUSHJ P,PROUTB
+ PUSHJ P,OUTBYT
+ MOVE A,C
+ SKIPN PASS2
+ AOS FSTRCT'
+ POPJ P,
+
+PROUTB: PUSH P,A
+ PUSH P,B
+ PUSH P,C
+ MOVE B,A
+ MOVEI A,.PRIOU
+ MOVEI C,10.
+ NOUT
+ JFCL
+ MOVEI A,40
+ PBOUT
+ POP P,C
+ POP P,B
+ POP P,A
+ POPJ P,
+
+OUTFRM: TRO FRMT,%FFLG ; set the format bit
+ MOVEM FRMT,LSTFRM'
+ SKIPE ZDEBUG
+ JRST [PUSH P,A
+ MOVEI A,"F
+ PBOUT
+ POP P,A
+ JRST .+1]
+ MOVE C,FRMT ; save A
+ SKIPN ZWDFLG
+ PUSHJ P,OUTBYC ; output the format byte
+ POPJ P,
+
+MAKFRM: PUSH P,A ; save text pointer
+ ILDB B,A ; get separator
+ CAIN B,".
+ JRST MAKFPR
+ CAIN B,", ; check for comma
+ JRST MAKFCM
+ CAIN B,40 ; check for space
+ JRST MAKFSP
+ CAIN B,^M
+ JRST MAKFEL
+MAKFNR: POP P,A ; restore A to get separator into string
+ POPJ P,
+
+MAKFEL: ILDB B,A ; read LF
+ MOVEI C,%FEOL
+ PUSHJ P,OUTBYC
+ MOVE FRMT,FRMDFL
+ JRST POPPO
+
+MAKFPR: MOVE C,A
+ ILDB B,C
+ JUMPE B,[MOVEI C,%FESS
+ JRST MAKFPS]
+ CAIE B,40
+ JRST MAKFNR
+ MOVEI C,%FESN
+MAKFPS: PUSHJ P,OUTBYC
+ MOVE FRMT,FRMDFL
+ MOVE A,C
+ JRST POPPO
+
+MAKFSP: TRO FRMT,%FSPC
+POPPO: POP P,0
+ POPJ P,
+
+MAKFCM: TRO FRMT,%FCOM ; set the comma next bit
+ MOVE C,A
+ ILDB B,C ; get next character
+ CAIN B,40 ; is it a space?
+ JRST [MOVE A,C
+ TRO FRMT,%FSPC
+ JRST .+1]
+ POP P,0 ; we're all set now with updated A
+ POPJ P,
+
+;lookup word in word table
+; a/ word
+; +1: not found, loc to add in (A)
+; +2: found, word is at (A)
+
+WFREQ: PUSH P,B
+ PUSH P,F
+ PUSH P,G
+ PUSH P,H
+ SKIPL G,WRDTAB
+ JRST WFREQX
+ HRRZ G,G ;initial center point
+ HRRZ F,G ;initial low point
+ MOVEI H,WRDTND ;initial high point
+;calculate test point
+WFREQ1: CAML F,H ;not hit yet?
+ JRST WFREQX
+ SUB G,F ;minus low point
+ LSH G,-1 ;divide by two
+ TRZ G,1 ;must be multiple of two (size of entries)
+ ADD G,F ;plus low
+;test
+ MOVE B,1(G) ;get test
+ PUSHJ P,SFREQ
+ JRST WFREQQ ;found it
+ SKIPA H,G ;sample before
+ MOVEI F,2(G) ;sample after
+ MOVE G,H ;high point
+ JRST WFREQ1
+
+WFREQQ: AOS -4(P)
+ MOVE C,(G) ;value
+WFREQX: POP P,H
+ POP P,G
+ POP P,F
+ POP P,B
+ POPJ P,
+
+;a/ sample
+;b/ word from table
+; +1: =
+; +2: a>b
+; +3: b>a
+
+SFREQ: PUSH P,A
+ PUSH P,C
+ SETZM SFREQ1'
+FREQN: ILDB C,B
+ JUMPE C,FREQQ
+ ILDB 0,A
+ SKIPN SFREQ1
+ JRST [CAIL 0,"A
+ CAILE 0,"Z
+ CAIA
+ ADDI 0,32.
+ JRST .+1]
+ SETOM SFREQ1
+ CAME 0,C
+ JRST FREQD
+ JRST FREQN
+
+FREQQ: MOVE C,A
+ ILDB B,C
+ CAIN B,"'
+ JRST FREQD1
+ PUSHJ P,BALPHA
+ JRST FREQQ1
+ JRST FREQD1
+FREQQ1: POP P,C
+ POP P,0
+ POPJ P,
+
+FREQD: CAML 0,C
+FREQD1: AOS -2(P)
+ AOS -2(P)
+ POP P,C
+ POP P,A
+ POPJ P,
+
+SUBTTL STRING ASSEMBLY DEBUGGING
+
+;print zstring being assembled
+;only called if CDEBUG is not 0
+; a/ bptr to string
+CSTRNG: PUSH P,A
+ PUSH P,B
+ PUSH P,C
+ SKIPN A,PDEBUG ;pick up script channel
+ MOVEI A,.PRIOU ;or tty
+ MOVEI C,0
+ HRROI B,[ASCIZ /
+"/]
+ SOUT
+ MOVE B,-2(P)
+ SOUT
+ HRROI B,[ASCIZ /"
+/]
+ SOUT
+ JRST POPCBA
+
+;print character being produced for a zstring
+;only called if CDEBUG is not 0
+; b/ character
+COUT: PUSH P,A
+ PUSH P,B
+ PUSH P,C
+ MOVE B,C
+ SKIPN A,PDEBUG ;pick up script channel
+ MOVEI A,.PRIOU ;or tty if there is no script
+ MOVEI C,8 ;radix 8
+ HRLI C,(NO%ZRO+NO%LFL)+2 ;always print two column, pad with 0
+ NOUT
+ JFCL
+ MOVEI B,40 ;terminate with space
+ BOUT
+POPCBA: POP P,C
+ POP P,B
+ POP P,A
+ POPJ P,
+
+SUBTTL ROUTINE FOR PRINTING CURRENT ZFUNCTION NAME AND CURRENT PC
+
+PFUNCT: PUSH P,A
+ PUSH P,B
+ PUSH P,C
+ HRROI A,[ASCIZ / Len = /]
+ PSOUT
+ MOVEI A,.PRIOU
+ MOVE B,ZPC
+ SUB B,ZPCLF'
+ PUSH P,B
+ MOVEM ZPC,ZPCLF
+ MOVEI C,10.
+ NOUT
+ JFCL
+ HRROI A,[ASCIZ / Str = /]
+ PSOUT
+ MOVEI A,.PRIOU
+ MOVE B,FSTRCT
+ ADDM B,FSTRTT'
+ MOVEI C,10.
+ NOUT
+ JFCL
+ HRROI A,[ASCIZ / (/]
+ PSOUT
+ POP P,B
+ MOVE A,FSTRCT
+ IMULI A,100.
+ IDIV A,B
+ MOVE B,A
+ MOVEI A,.PRIOU
+ MOVEI C,10.
+ NOUT
+ JFCL
+ HRROI A,[ASCIZ /%)/]
+ PSOUT
+ SETZM FSTRCT
+ MOVEI A,^M
+ PBOUT
+ MOVEI A,^J
+ PBOUT
+ MOVE A,FUNCT
+ PSOUT
+ MOVEI A,^I
+ PBOUT
+ MOVEI A,.PRIOU
+ MOVE B,ZPC
+ MOVEI C,10.
+ NOUT
+ JFCL
+ POP P,C
+ POP P,B
+ POP P,A
+ POPJ P,
+
+SUBTTL WORD FREQUENCY PASS GOODIES GO HERE
+
+FREQ: MOVE A,1(TP)
+ CAIE A,":
+ JRST FREQ1
+ NXTARG 1
+ JRST FREQ
+FREQ1: SKIPN A,(TP)
+ SKIPE 1(TP)
+ SKIPA
+ POPJ P,
+ PUSHJ P,LOOKUP
+ POPJ P,
+ JUMPL B,FPSEUDO
+ JRST FOPER
+
+FOPER: TLNN B,%STR
+ POPJ P,
+ NXTARG 1
+ MOVE D,(TP)
+ PUSHJ P,NEWWRD
+ POPJ P,
+
+FPSEUD: HRRZ B,B
+ SETZM FPSVFL
+ CAIE B,ZINSER
+ CAIN B,ZENDI
+ JRST (B)
+
+ CAIN B,ZZWORD
+ JRST FPSEUV
+ CAIE B,ZSTRL
+ CAIN B,ZSTR
+ JRST FPSEU1
+ CAIE B,ZGSTR
+ POPJ P,
+
+FPSEUV: SETOM FPSVFL'
+ JRST FPSEU1
+
+FPSEU2: NXTARG 1
+FPSEU1: NXTARG 1
+ SKIPN D,(TP)
+ JRST TFARG
+ PUSHJ P,NEWWRD
+ POPJ P,
+
+;main entry to count frequency of words in a particular string
+; called with string pointer in D
+
+NEWWRD: JUMPE D,CPOPJ
+ MOVE E,[440700,,WRDBUF]
+ MOVEI J,0 ;count of bytes
+NXTWRD: ILDB A,D
+ JUMPE A,CPOPJ
+ PUSHJ P,ALPHA
+ JRST NXTWRD
+ CAIG A,"Z
+ CAIGE A,"A
+ CAIA
+ ADDI A,40
+WRDLP: IDPB A,E
+ ADDI J,1
+ MOVE F,D ;save this pointer
+ ILDB A,D
+ JUMPE A,WRDEOS
+ CAIG A,"Z
+ CAIGE A,"A
+ CAIA
+ ADDI A,40
+ CAIN A,"'
+ JRST WRDLP
+ PUSHJ P,ALPHA
+ JRST WRDEND ;not alphabetic
+ JRST WRDLP
+
+WRDEOS: MOVEI D,0 ;end of input string
+ JRST WRDEN2
+WRDEND: MOVE D,F ;recover non-spaced bptr
+WRDEN3: MOVEI A,0
+WRDEN2: IDPB A,E
+ MOVE A,[440700,,WRDBUF]
+ PUSHJ P,WLOOK
+ JRST WRDADD ;not there, go add it
+ AOS (G) ;add to its usage count
+ JRST NEWWRD
+
+WRDADD: SKIPN WDEBUG
+ JRST WRDAD1
+ MSG ["]
+ PSOUT
+ MOVE A,[440700,,WRDBUF]
+ PSOUT
+ MSG ["
+]
+ PSOUT
+
+WRDAD1: MOVE A,TABPTR
+ TLNN A,400000
+ JRST [HRLI A,440700
+ ADDI A,1
+ JRST .+1]
+ MOVE H,A
+ MOVE B,[440700,,WRDBUF]
+ MOVEI C,0
+ SOUT ;copy string to buffer
+ IDPB C,A
+ MOVEM A,TABPTR
+;update table pointer
+ PUSH P,G
+ MOVE G,WRDTAB
+ SUB G,[2,,2]
+ MOVEM G,WRDTAB
+ POP P,G
+;make a slot for new entry
+ HRRZ A,WRDTAB
+ HRLI A,2(A)
+ BLT A,-1(G)
+;put out new entry
+ MOVEM H,-1(G) ;string
+ MOVEI H,1
+ HRL H,J ;size of string in bytes
+ MOVEM H,-2(G) ;count
+ JRST NEWWRD
+
+;here when all done
+FILEND:
+ PUSHJ P,BYTES
+ PUSHJ P,SORT
+
+
+;here to output the data
+ MOVE A,[440700,,[ASCIZ /FREQ.ZAP/]]
+ MOVE B,OUTPTR
+ ILDB 0,A
+ IDPB 0,B
+ JUMPN 0,.-2
+ MOVSI A,(GJ%SHT+GJ%FOU)
+ HRROI B,OUTFIL
+ GTJFN
+ JRST ERPRNT
+ HRRZ A,A
+ MOVEM A,OJFN
+ MOVE B,[070000,,OF%WR]
+ OPENF
+ JRST ERPRNT
+
+;output the goodies
+ MOVE G,WRDTAB
+ HRLI G,-<2*%FWDCT>
+ PUSHJ P,PTAB
+
+ MOVE A,OJFN
+ HRROI B,[ASCIZ /
+
+WORDS:: .TABLE/]
+ MOVEI C,0
+ SOUT
+ MOVE G,[-%FWDCT,,1]
+FWTBLL: MOVE A,OJFN
+ HRROI B,[ASCIZ /
+ FSTR?/]
+ MOVEI C,0
+ SOUT
+ HRRZ B,G
+ MOVEI C,10.
+ NOUT
+ JFCL
+ AOBJN G,FWTBLL
+ MOVE A,OJFN
+ HRROI B,[ASCIZ /
+
+ .ENDI
+/]
+ MOVEI C,0
+ SOUT
+ CLOSF
+ JFCL
+ HALTF
+
+;calculate bytes saved
+BYTES: MOVE A,WRDTAB
+ SETZM XTWRDS'
+BYTES1: HRRZ B,(A)
+ ADDM B,XTWRDS
+ HRLM B,(A)
+ ADD A,[2,,2]
+ JUMPL A,BYTES1
+ POPJ P,
+
+;sort word table by bytes saved
+SORT: MOVE A,WRDTAB
+;next slot of table
+SORTM: MOVE B,A
+ SETZB C,D
+ SETZ E,
+;next try for largest number
+SORTN: CAMLE C,(B)
+ JRST SORTL
+;pick up new candidate
+ MOVE C,(B)
+ MOVE D,1(B)
+ MOVE E,B
+SORTL: ADD B,[2,,2]
+ JUMPL B,SORTN
+;end of pass
+ JUMPE C,SORTO
+ EXCH C,(A)
+ MOVEM C,(E)
+ EXCH D,1(A)
+ MOVEM D,1(E)
+;move to next slot
+SORTO: MOVE C,(A)
+SORTP: ADD A,[2,,2]
+ JUMPGE A,CPOPJ
+ CAMN C,(A)
+ JRST SORTP
+ JRST SORTM
+
+NEXT31: MOVE A,WRDTAB
+ ADD A,[76,,76]
+ MOVEM A,WRDTAB
+N31LUP: HRRZ B,(A)
+ HLRZ C,(A)
+ IDIV C,B
+ SUBI C,1
+ HRLM C,(A)
+ ADD A,[1,,1]
+ AOBJN A,N31LUP
+ PUSHJ P,BYTES
+ PUSHJ P,SORT
+ POPJ P,
+
+
+PSAVED: MSG [31 words: ]
+ PSOUT
+ MOVEI A,.PRIOU
+ MOVE B,D
+ MOVEI C,10.
+ NOUT
+ JFCL
+ MSG [ zbytes saved, ]
+ PSOUT
+ MOVEI A,.PRIOU
+ MOVE B,E
+ NOUT
+ JFCL
+ MSG [ uses.
+
+]
+ PSOUT
+ POPJ P,
+
+PTABS: MOVEI A,101
+ MOVEM A,OJFN
+ MOVE G,WRDTAB
+ HRLI G,-76
+ PUSHJ P,PTAB
+ PUSHJ P,PSAVED
+ PUSHJ P,NEXT31
+ MOVE G,WRDTAB
+ HRLI G,-76
+ PUSHJ P,PTAB
+ PUSHJ P,PSAVED
+ PUSHJ P,NEXT31
+ MOVE G,WRDTAB
+ HRLI G,-76
+ PUSHJ P,PTAB
+ PUSHJ P,PSAVED
+ POPJ P,
+
+PTABLE: PUSH P,G
+ MOVE G,WRDTAB
+ PUSHJ P,PTAB
+ POP P,G
+ POPJ P,
+
+PTAB: PUSH P,A
+ PUSH P,B
+ PUSH P,C
+ SETZB D,E
+ MOVEI F,0
+PTLOOP: ADDI F,1
+ MOVE A,OJFN
+ HRROI B,[ASCIZ / .FSTR FSTR?/]
+ MOVEI C,0
+ SOUT
+ MOVE B,F
+ MOVEI C,10.
+ NOUT
+ JFCL
+ MOVE A,OJFN
+ HRROI B,[ASCIZ /,"/]
+ MOVEI C,0
+ SOUT
+ MOVE B,1(G)
+ SOUT
+ HRROI B,[ASCIZ /" ;/]
+ SOUT
+ MOVE A,OJFN
+ HLRZ B,(G)
+ ADD D,B
+ MOVEI C,10.
+ NOUT
+ JFCL
+ MOVEI B,15
+ BOUT
+ MOVEI B,12
+ BOUT
+ ADD G,[2,,2]
+ JUMPL G,PTLOOP
+ PUSHJ P,PT512
+ POP P,C
+ POP P,B
+ POP P,A
+ POPJ P,
+
+PT512: HRROI B,[ASCIZ /
+
+; Top 512 Words: /]
+ MOVEI C,0
+ SOUT
+ MOVE A,OJFN
+ MOVE B,D
+ MOVEI C,10.
+ NOUT
+ JFCL
+ HRROI B,[ASCIZ / uses (/]
+ MOVEI C,0
+ SOUT
+ MOVE A,OJFN
+ MOVE B,D
+ IMULI B,100.
+ IDIV B,XTWRDS
+ MOVEI C,10.
+ NOUT
+ JFCL
+ HRROI B,[ASCIZ /%)
+
+/]
+ MOVEI C,0
+ SOUT
+ POPJ P,
+
+
+
+;lookup word in word table
+; a/ word
+; +1: not found, loc to add in (g)
+; +2: found, word is at (g)
+
+WLOOK: SKIPL G,WRDTAB
+ POPJ P,
+ HRRZ G,G ;initial center point
+ HRRZ F,G ;initial low point
+ MOVEI H,WRDTND ;initial high point
+;calculate test point
+LOOK1: CAML F,H ;not hit yet?
+ POPJ P,
+ SUB G,F ;minus low point
+ LSH G,-1 ;divide by two
+ TRZ G,1 ;must be multiple of two (size of entries)
+ ADD G,F ;plus low
+;test
+ MOVE B,1(G) ;get test
+ PUSHJ P,SCOMP
+ JRST LOOKEQ ;found it
+ SKIPA H,G ;sample before
+ MOVEI F,2(G) ;sample after
+ MOVE G,H ;high point
+ JRST LOOK1
+
+LOOKEQ: AOS (P)
+ POPJ P,
+
+;a/ sample
+;b/ word from table
+; +1: =
+; +2: a>b
+; +3: b>a
+
+SCOMP: PUSH P,A
+ PUSH P,C
+COMPN: ILDB 0,A
+ ILDB C,B
+ CAME 0,C
+ JRST COMPD
+ JUMPE 0,COMPX
+ JRST COMPN
+COMPX: POP P,C
+ POP P,A
+ POPJ P,
+
+COMPD: CAML 0,C
+ AOS -2(P)
+ AOS -2(P)
+ JRST COMPX
+
+ALPHA: CAIL A,"A
+ CAILE A,"Z
+ SKIPA
+ JRST ALPHA1
+ CAIL A,"a
+ CAILE A,"z
+ POPJ P,
+ALPHA1: AOS (P)
+ POPJ P,
+
+
+BALPHA: CAIL B,"A
+ CAILE B,"Z
+ SKIPA
+ JRST BALPH1
+ CAIL B,"a
+ CAILE B,"z
+ POPJ P,
+BALPH1: AOS (P)
+ POPJ P,
+
+PUNCT: CAIE A,",
+ CAIN A,".
+ POPJ P,
+ CAIE A,"!
+ CAIN A,"?
+ POPJ P,
+ AOS (P)
+ POPJ P,
+
+
+SUBTTL VARIABLES AND BUFFERS
+
+;debugging flags
+SDEBUG: 0 ;if non-0, print symbol table
+PDEBUG: 0 ;if non-0, print lines as they are read
+TDEBUG: 0 ;if non-0, print tokens after parsing them
+ODEBUG: 0 ;if non-0, print opers info
+CDEBUG: 0 ;if non-0, print strings in "zascii"
+ZDEBUG: -1
+FDEBUG: 0 ;if non-0, print functions as they are found
+STOP: 0 ;if non-0, location to halt at (for changing flags)
+SYMFLG: 0 ;if non-0, output symbol table
+
+;flags for word frequency pass
+DOFREQ: 0 ;if non-0, this is word frequency run, not assy.
+WDEBUG: 0 ;if non-0, print new words during frequency pass
+
+;i/o goodies
+
+;gtjfn block for normal file opening
+GTJFNB: GJ%OLD ;flags
+ .NULIO,,.NULIO ;jfns
+ 0 ;device
+ 0 ;dir
+ -1,,[ASCIZ /ZIPTEST/] ;name
+ -1,,[ASCIZ /ZAP/] ;ext
+ 0 ;prot
+ 0 ;acct
+ 0 ;jfn
+
+;gtjfn block for normal file opening
+GTJFNX: GJ%OLD ;flags
+ .NULIO,,.NULIO ;jfns
+ 0 ;device
+ 0 ;dir
+ -1,,[ASCIZ /ZIPTEST/] ;name
+ -1,,[ASCIZ /XZAP/] ;ext
+ 0 ;prot
+ 0 ;acct
+ 0 ;jfn
+
+;gtjfn block for reading file name from tty
+GTJFNT: GJ%OLD+GJ%EXT ;flags
+ .PRIIN,,.PRIOU ;jfns
+ 0 ;device
+ -1,,[ASCIZ /INFOCOM.ZORK/] ;dir
+ -1,,[ASCIZ /ZIPTEST/] ;name
+ -1,,[ASCIZ /ZAP/] ;ext
+ 0 ;prot
+ 0 ;acct
+ 0 ;jfn
+ 0 ;f2
+ 0 ;input copy
+ 0 ;
+ -1,,[ASCIZ /File/]
+ 0
+ 0
+
+;output gtjfn
+OUTPTR: 440700,,OUTFIL
+OUTFIL: BLOCK 20
+
+OJFN: 0 ;old input jfn, for when .INSERT done
+IJFN: 0 ;input jfn
+FILBUF: BLOCK 20.
+FILPTR: 0
+JOBNAM: ASCIZ /MUDDLE/
+
+PDL: BLOCK 100 ;stack
+
+ZAPID: 3 ;zap id number (assembly language version)
+
+FLGWRD: 0 ;1 if byte swapped (not implemented)
+%BYTSWP==1 ;flag word bit for byte-swapped mode
+%TIMESL==2 ;flag word bit for 'time' status line
+
+RELEAS: -1 ;release number
+
+;various assembler variables
+SAVZPC: 0 ;saved pc used mostly by debugging printers
+SAVZ: 0 ;saved output ptr ditto
+
+TABLE: 0 ;if in table, holds pc of table start
+TABLEN: 0 ;if in table, holds max length or -1 if none
+
+GLBTOT: 0 ;how many globals he made (limit is 255-20)
+GLBCNT: 17 ;current global (1-17 are really locals)
+
+OBJTOT: 0 ;how many objects he made (limit is 255)
+OBJCNT: 0 ;current object
+
+FUNCT: 0 ;non-zero during function assy.
+FSYM: 0 ;symbol value of last function
+
+LSTSYM: 0 ;last symbol defined
+
+WRDBYT: 0 ;-1 if assembling byte, 0 if word
+JMPREF: 0 ;-1 if assembling jump, 0 otherwise
+SHRIMP: 0 ;long jumps that were wasted
+OSHRIM: 0 ;saved count of wasted long jumps
+
+;goodies for instruction assembly
+
+NOREF: 0 ;-1 if not to assemble references (as instruction operands
+ ;are moved into ARGBUF)
+
+OPER: 0 ;operator is saved here
+
+ARGBUF: BLOCK 14 ;args to operators, pairs of values and strings
+
+SENSE: 0 ;sense of predicate jump
+PRED: 0 ;value of predicate byte
+ 0 ;ptr to string defining it
+VAL: 0 ;value of value byte
+ 0 ;string defining it
+
+LSTRWD: 0 ;Z at last string word output saved here for stop bit addition
+
+;junk for second pass over functions
+TWOPAS: -1 ;-1 if two pass assembly
+PASS2: 0 ;-1 if doing second pass
+FPOS: 0 ;saved file pointer
+FZ: 0 ;saved z
+FZPC: 0 ;saved zpc
+FSHORT: 0 ;count of short jumps saved
+ZCSET: 0 ;char set of last character looked at
+
+;parsing information of various sorts
+BUFFER: BLOCK 1000 ;read in buffer
+
+TOKEN: BLOCK 1000 ;buffer for parsed tokens
+TOKPTR: 0 ; ptr into same
+
+TPDL: -100.,,TOKENS-1 ;stack for pairs of token/terminator
+TOKENS: BLOCK 100. ; points to here
+
+;junk to unsuccessfully fool GC-READ (joel is a twit)
+;this stuff is modified by OUTPUT
+HEADER: 1305 ;object plus type word
+ 1305
+ 1305
+ 122 ; ??
+ 41 ; ??
+ 51,,5374 ;type,,length
+ 41000,,2006 ;bptr to start
+
+FOOTER: 40003,,0 ;bytes
+ 1303,,3311 ;length,,self
+
+;get these out of the way
+VARIAB
+CONSTA
+
+SUBTTL SYMBOL TABLES
+
+SYMPTR: SYMBUF+2 ;ptr to symbol table buffer
+FCNPTR: FCNBUF ;ptr to function table buffer
+
+SYMSIZ==3 ;size of a symbol entry
+SYMNAM==0 ;offset of name slot
+SYMVAL==1 ;offset of value slot
+SYMREF==2 ;offset of references slot
+
+BUCKN==201. ;how many buckets
+BUCKL==25.*SYMSIZ ;how long buckets are
+
+;local symbol goodies
+LCLLST: 0 ;list of local symbols
+LCLPTR: LCLBUF ;ptr to free space in local symbol buffer
+LCLBUF: BLOCK 10000 ;local symbol pnames buffer
+
+LCLOBL: -<BUCKN*BUCKL>,,LCLTAB ;ptr to local symbol hash table
+LCLTAB: BLOCK BUCKN*BUCKL ;local symbol hash table
+LCLEND: 0 ;end of same
+
+;global symbol goodies
+GLBLST: 0 ;list of global symbols
+GLBPTR: GLBBUF ;ptr to free space in global symbol buffer
+GLBBUF: BLOCK 40000 ;global symbol pname buffer starts here
+
+GLBOBL: -<BUCKN*BUCKL>,,GLBTAB ;ptr to global symbol hash table
+GLBTAB: BLOCK BUCKN*BUCKL ;global symbol hash table
+GLBEND: 0 ;end of same
+
+;word frequency hack stuff is here
+FREQST: 0 ;-1 when assembling string that can have fstrs
+FSTRS: -1 ;count of .FSTRs seen
+WRDBUF: BLOCK 10.
+
+WRDTLN==20000.
+WRDTND==700000+WRDTLN-2
+
+WRDTAB: WRDTND
+TABPTR: 440700,,.+1
+ LOC .+1000
+
+;output buffer
+
+OUTBUF==<.+77777>&-100000 ;lies at 100000*n
+
+;symbol table hacks
+
+FCNBUF==OUTBUF+200000 ;function symbol tables made here
+SYMBUF==FCNBUF+10000 ;symbol tables made mapped here
+
+ END START
diff --git a/zork.errors b/zork.errors
new file mode 100644
index 0000000..c2d4e41
--- /dev/null
+++ b/zork.errors
@@ -0,0 +1,53 @@
+Assembling ZORK.XZAP.1
+
+Inserting ZORKFREQ.ZAP.8
+Inserting ZORKDAT.ZAP.2
+Inserting DUNGEON.ZAP.1
+Inserting SYNTAX.ZAP.1
+Inserting MACROS.ZAP.1
+Inserting CLOCK.ZAP.1
+Inserting MAIN.ZAP.1
+Inserting PARSER.ZAP.1
+Inserting DEMONS.ZAP.1
+Inserting CRUFTY.XZAP.1
+ CALL LIGHT-INT,CANDLES,I-CANDLES,'CANDLE-TABLE
+17360 (in I-CANDLES) Bad variable name after value or predicate
+ CALL LIGHT-INT,CANDLES,I-CANDLES,'CANDLE-TABLE
+17360 (in I-CANDLES) Bad variable name after value or predicate
+Inserting VERBS.ZAP.1
+19152 (in RANDOMIZE-OBJECTS) Multiply defined .FUNCT
+ .FUNCT KILL-INTERRUPTS
+Inserting ACTIONS.ZAP.1
+Inserting FIGHTS.ZAP.1
+Inserting MELEE.ZAP.1
+Inserting ZORKSTR.ZAP.1
+UNCONSCIOUS global undefined: 0,
+V?FOLLOW global undefined: 0, 0,
+SWIMYUKS global undefined: 0,
+V?PLUG global undefined: 0,
+YELLOW-BUTTON global undefined: 0,
+BROWN-BUTTON global undefined: 0,
+RED-BUTTON global undefined: 0,
+KEYS global undefined: 0, 0,
+CLEARING global undefined: 0, 0, 0,
+V?UNLOCK global undefined: 0, 0,
+SAILOR global undefined: 0,
+V-SKIP global undefined: 0, 0,
+CANDLE-TABLE global undefined:
+CANDLES global undefined: 0,
+F-CONSCIOUS global undefined: 0,
+F-BUSY? global undefined: 0,
+HANDS global undefined: 0, 0, 0, 0, 0,
+V-BLAST global undefined: 0,
+TORCH-ROOM-FCN global undefined: 0,
+TROPHY-CASE-FCN global undefined: 0,
+SMELLY-ROOM global undefined: 0,
+GRANITE global undefined: 0,
+CLIFF-BOTTOM global undefined: 0,
+TORCH-ROOM global undefined: 0,
+RIVR4-ROOM global undefined: 0,
+ARAGIAN-FALLS global undefined: 0,
+
+47676 bytes.
+169 objects.
+114 globals.
diff --git a/zork.xzap b/zork.xzap
new file mode 100644
index 0000000..0ca1f7d
--- /dev/null
+++ b/zork.xzap
@@ -0,0 +1,45 @@
+ .INSERT "ZORKFREQ"
+ .INSERT "ZORKDAT" ; DATA IS IN THIS FILE
+
+
+ .INSERT "DUNGEON"
+
+
+ .INSERT "SYNTAX"
+
+
+ENDLOD::
+
+ .INSERT "MACROS"
+
+
+ .INSERT "CLOCK"
+
+
+ .INSERT "MAIN"
+
+
+ .INSERT "PARSER"
+
+
+ .INSERT "DEMONS"
+
+
+ .INSERT "CRUFTY"
+
+
+ .INSERT "VERBS"
+
+
+ .INSERT "ACTIONS"
+
+
+ .INSERT "FIGHTS"
+
+
+ .INSERT "MELEE"
+
+
+ .INSERT "ZORKSTR"
+
+ .END
diff --git a/zork.zip b/zork.zip
new file mode 100644
index 0000000..7e59ba6
--- /dev/null
+++ b/zork.zip
Binary files differ