commit 65673bb4345f31fc3cb8f8aba9e6822fff1f99a6 Author: historicalsource Date: Sat Apr 13 19:48:51 2019 -0400 Original Source 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" + + + + )>)>> + + + + + ) + (ELSE )> + )>> + + + ) + ( + + ) + (T + )> + ) + ( + + + ) + (T + )>)>> + + + + ) + (ELSE + + )>) + ( + + + + T) + (ELSE )>)>> + + + + + ) + (ELSE + )>)>> + + + + + <==? ,PRSO ,P?WEST>> + + <==? ,PRSO ,BARROW>>>> + + >)>> + + + )>> + +\ + +> + + (TC) OBJECT) + + ) + (T + )> + + + > + ) + (.RUG? + ) + ( + ) + (ELSE + )> + + T) + (<==? .RARG ,M-END> + + + <==? ,PRSI ,TROPHY-CASE>>> + >> + + )>)>> + +> + )> + >> + )> + >>> + + + <==? ,HERE ,LIVING-ROOM>> + ) + (<==? ,HERE ,CELLAR> + + >> + ) + ( >> + + + ) + ( + )>)>> + + + ) + (<==? .RARG ,M-ENTER> + + >> + + + )>)>> + +>> + + ) + (>> + >> + > + > + )> + ) + (T + + )>> + + + ) + (T + + )>) + (T + + )>> + + + ) + (ELSE + )>) + ( + ) + (ELSE + + + )>) + ( + ) + ( + + >> + )>> + +\ + +"SUBTITLE TROLL" + +) + (ELSE )>> + +> + +> ) + ( + + ) + (ELSE + )> + T)>> + +)) + + + + + ) + (<==? .MODE ,F-FIRST?> + T)>) + ( + + <==? ,PRSI ,TROLL>> + > + + + + ) + ( + )>) + ( + ) + (> + )>)>> + +\ + +"SUBTITLE GRATING/MAZE" + +> +> +> + +> + > + + + )> + <>> + + + + + + ) + (T + )>) + + ( + T) + (ELSE )>) + ( + > + )>> + + + + ) + ( + + T)>) + ( + >> + + + ) + (ELSE + )>) + (ELSE )>) + ( + ) + ( + + T) + ( + ) + ( + + + ) + (ELSE )>) + (ELSE )>) + ( + )>> + + + + )>) + (<==? .RARG ,M-LOOK> + + + + ) + (,GRATE-REVEALED + + )> + )>> + + + ) + (<==? .RARG ,M-LOOK> + + + ) + (,GRUNLOCK + ) + (ELSE + )> + )>> + + <==? ,PRSI ,KEYS>> + + ) + ( + + "The grating opens.") + (T + "The grating opens to reveal trees above you.")> + "The grating is closed."> + + > + > + + )> + ) + (ELSE )>) + (ELSE )>)>> + +\ + + + ) + ( > + )>> + +\ + +"SUBTITLE THE DOME" + + + + )>)>> + + + + )>)>> + +> + +\ + +"SUBTITLE LAND OF THE DEAD" + + + + + )>) + ( + <==? ,PRSO ,BELL>> + + + + >) + ( <==? ,PRSO ,BOOK> > + + + + >) + ( + + + > + ) + (ELSE + )>)>)>)>> + +> + +> + + + >> + >> + +> + > + + + ) + (<==? ,PRSI ,GHOST> + + <>) + (<==? ,PRSO ,GHOST> + )>> + +\ + +"SUBTITLE FLOOD CONTROL DAM #3" + +> + + + + ) + (ELSE + )> + + )>)>> + + + + + + T) + (ELSE + + + T)>) + (ELSE )>) + (ELSE )>)>> + + + + + + + ) + (ELSE + + )>) + (<==? ,PRSO ,BROWN-BUTTON> + + > + ) + (<==? ,PRSO ,YELLOW-BUTTON> + + + )>)>> + + + )>> + + + ) + ( + + ) + (ELSE + )>)>> + +> + + + ) + (ELSE + )> + + )>> + + + )> + + )>> + +\ + +"SUBTITLE WATER, WATER EVERYWHERE..." + +)) + + + + ) + ( + + + ) + ( + )>)> + > + + + T)>> + + (W) OBJECT (PI?) ) + ) + ( + > + ) + ( ;"fill bottle with water =>" + ;"put water in bottle" + + + + >) + ( + <==? ,PRSO ,WATER>> + + >) + ( + )> + + + )>)> + ) + (T )> + > + > >)> + > + + + >>>> + + + ) + (>> + + ) + ( + > + ) + (> + + ) + (T + + )>) + ( + + > + + + ) + (T + )>) + (.PI? ) + ( + + + ) + (T + + )>) + ( + + )>> + +\ + +"SUBTITLE CYCLOPS" + + + + + + + > + + + >) + (ELSE + )>)>) + ( <==? ,PRSI ,CYCLOPS>> + + > + + + >>)> + >) + (<==? ,PRSO ,WATER> + + + + + ) + (ELSE + + <>)>) + (<==? ,PRSO ,GARLIC> + ) + (ELSE + )>) + ( + > + + )>) + ( + ) + ( + ) + ( + )>> + +) + (> + >) + (ELSE + 5> + > + ) + (ELSE + + >) + (T + >)> + + 1>> + CR>)>)>)>> + + + + > + ) + (,MAGIC-FLAG + ) + (<0? ,CYCLOWRATH> + ) + ( + ) + ( + )>) + (<==? .RARG ,M-ENTER> + >>)>> + +> + +\ + +"SUBTITLE A SEEDY LOOKING GENTLEMAN..." + +> + +;"I-THIEF moved to DEMONS" + +\ + +"SUBTITLE THINGS THIEF MIGHT DO" + + ) + ( + + + )>) + ( + + >> + ) + (ELSE + )> + + )> + > + + + > + ) + (ELSE )> + >>> + +> + )> + > + ) + ( 0> + )> + >> + +> + )> + > + + > + > + + + + + )> + )> + >> + +\ + +"ROBBER-FUNCTION -- more prosaic thiefly occupations" + +> + +) "AUX" (FLG <>) X N) + #DECL ((DEM) HACK (FLG) ) + + + > + + ) + ( + <==? ,PRSI ,THIEF>> + + 0> + + ) + (T + )>) + ( + )>) + (<==? .MODE ,F-DEAD> + + + > + + ) + (> + + + + )>)> + >>) + (ELSE + )> + >) + (<==? .MODE ,F-FIRST?> + > + + T)>)>> + +> + )> + > + + + >)>> + + + + + + >> + )>)>> + +) TL) + #DECL ((FLG) ) + + <1? ,C-ENABLED?>> + > + >> + + + + ) + (T + )> + )>> + +> + > + )> + ) + (> + >> + )> + >>> + +> + + + ) + ( + ) + ( + ) + ( + )>> + +\ + +"SUBTITLE RANDOM FUNCTIONS" + + + ) + ( + ) + ( + )>> + + + + + )>> + +\ + +"SUBTITLE LET THERE BE LIGHT SOURCES" + +> + + + > + ) + (ELSE + > + <>)>) + ( + > + ) + (ELSE + > + <>)>) + ( + > + ) + ( + ) + (ELSE + )> + )>> + + .N1) + (T .N2)>> + +) TICK) + #DECL ((OBJ) OBJECT (TBLNAM INTNAM) ATOM (TBL) + (TICK) FIX) + >>> + + + )> + > + + ) + (T + CR>)>)> + > + >)>> + +\ + +"SUBTITLE ASSORTED WEAPONS" + + <==? ,WINNER ,ADVENTURER>> + > + <>)>> + +"SUBTITLE COAL MINE" + +) FLAME) + + + + )>)>> + + + + ,WINNER ,HERE> + )>) + (<==? .RARG ,M-ENTER> + ,WINNER ,HERE>> + )>)>> + + + )>> + +> 1> ) + (ELSE )>> + + > + T> + +> + + + + + ) + (ELSE + + + + )>) + ( + + ) + (ELSE + + + + > + >>> + )> + T)>) + ( + ) + ( + > + )>> + + + + + ) + (ELSE )> + )>> + + + + + ) + ( + + + + ) + (ELSE + + )>) + ( + + + + T) + (ELSE )>)>)>> + + + + + ) + (ELSE + + + ) + (ELSE + > + ) + (ELSE )>> + )>)>) + (ELSE + )>)>> + + + > + + + > + + ) + ( 4> + > + )> + >> + ,LIT> + + )> + )>> + + + >> + )>> + + + +\ + +"SUBTITLE OLD MAN RIVER, THAT OLD MAN RIVER..." + + + + >) + (ELSE )>)>> + + + + > + + + ) + (ELSE + )>)>> + + + + ) + (ELSE + )> + )>> + + + + ) + (<==? ,HERE ,END-OF-RAINBOW> + ) + (T + )>) + (T + )>)>> + +> + + + + + ) + (<==? ,PRSO ,INFLATED-BOAT> + ) + ( + + ) + (ELSE + + )>)>) + ( + )>> + +> + +> + +> + +) + > + >) + (> + + + >>) + (T + )>> + +)) + #DECL ((RARG) ) + <>) + (<==? .RARG ,M-BEG> + + + ) + (T + + )>) + ( + + >> + ) + (T + )>)>) + ( + ) + ( + ) + ( + ,INFLATED-BOAT> + ) + (> + ) + (ELSE + + + )>)>> + +> + + + > + ) + (<==? ,PRSI ,PUMP> + + > + )> + > + + ) + (<==? ,PRSI ,LUNGS> + ) + (ELSE + )>)>> + + + + + + <==? ,PRSI ,GROUND>> + ) + (<==? ,HERE ,SANDY-CAVE> + ) + ( + )>> + + + > + + + > + ) + (<==? ,BEACH-DIG 3> + + + )>) + (T + CR>)>)>> + +> + +\ + +"SUBTITLE LURKING GRUES" + + + ) + ( + ) + ( + )>> + +\ + + <==? ,PRSI ,ME>> + ) + ( <==? ,PRSO ,ME> ,PRSI > + ) + ( + > + ) + (T )>) + ( + ) + ( + )>> + +\ + +> + ) + (<==? .CAN ,WINNER> )>>> + +\ + +"SUBTITLE TOITY POIPLE BOIDS A CHOIPIN' AN' A BOIPIN' ... " + + + ) + (<==? .RARG ,M-BEG> + + > ) + (<==? ,PRSO ,EGG> + + + ) + (> + + )>)>) + (<==? .RARG ,M-ENTER> >)>> + + <==? ,PRSO ,EGG>> + + ) + (T + + )>) + ( + + )>> + + + > + + > + +> + + + > + + + ,PATH) + (ELSE ,HERE)>>) + (T + )>)>> + + + >> + +> + >) + ( + )>> + + >)>> + + + )>> + + + ) + ( + ) + ( + ) + ( + )>> + + + )>> + + + + + )>)>> + +\ + +"SUBTITLE CHUTES AND LADDERS" + +> + > + + )>) + ( + + ) + (ELSE + + + + > + + >> + )> + T)>)>) + ( + > + + ) + (ELSE + )>) + ( + <==? ,HERE ,DOME-ROOM> + > + + ) + ( + )>)>> + + + >> + ) + (ELSE )>> + + + <==? ,PRSO ,ME>>> + + ) + ( + + + ) + (T + )>) + (ELSE )>)>> + +"MORE RANDOMNESS" + +;"Pseudo-object routines" + +) + ( + ) + ( + )>> + + + + ) + (ELSE + )>> + + + )>> + + + )>> + + ;"REALLY BLOW" + ) + ( + )>> + + + ) + ( + )>> + diff --git a/chr.mud b/chr.mud new file mode 100644 index 0000000..d59b86d --- /dev/null +++ b/chr.mud @@ -0,0 +1,43 @@ +> +> +> + +> '>> + + + >> + > + + 96>> + 1>>> + .STR>>> + +> '>> + + + >> + > + 2) + (T 1)>> + .STR>> 4>> + 1>>>> + +> + > )>> + )>> + +> + > )>> + )>> \ 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 @@ + + + +> + + + + + + + + + + + +) + > ,C-TICK .TICK> + .CINT> + +) + > + > + + > + > + + ) + (<==? .RTN> )> + >>> + +> + +)) + #DECL ((C E) (TICK) FIX (FLG) ) + > )> + > + > + ) + (>> + > + ) + (T + > + > + + >)>)>)> + >>> 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 @@ +) + > + + > + <- 2> 1>>> + + > + 1>>>> + >>> + +> + + + + 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" + +) (LEN ) + CNT OO O P) + )> + + > + )> + > + > ,HERE> + ,THIEF-ENGROSSED> + >) + ( 0> + > + > > + + ) + (ELSE + >)>) + ( + ,F-FIRST?>> + )>) + (ELSE + + ,F-BUSY?>)> + >)> + + + + )>> + )> + > + +)) + + > + ,F-CONSCIOUS>)> + T> + +"SWORD demon" + +) (G ) + (NG 0) P T L) + #DECL ((NG G) FIX) + + ) + (ELSE + + >> + ) + (> + > + > + + > + + )>)>)>>)> + ) + (<==? .NG 2> + ) + (<1? .NG> + ) + (<0? .NG> + )> + ) + (ELSE )>> + +)) + >) + ( >> + ) + (>> >)>>> + +"THIEF demon" + +) ROBJ HERE? (ONCE <>)) + >> + >)> + >> + >)> + ) + (<==? .RM ,HERE> + ) + (ELSE + + >> ;"Leave if victim left" + + >)> + ;"Hack the adventurer's belongings" + + > + ) + (ELSE )>)>)> + > > + ;"Move to next room, and hack." + >>) + (ELSE >)> + > + > + + + + )>> + )>> + > + )>> + +> + )> + > + ) + (> > + + + + )>)> + >> + +> + )> + > + > + + > + > + + >> + + + + >)> + + )> + )> + >> + +) "AUX" N X (ROBBED? <>)) + > + )> + > + > + > + 0> + >> + + + )> + )> + >> \ 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" + + + +"SUBTITLE GLOBAL OBJECTS" + + + + + + + +;"Yes, this synonym for LOCAL-GLOBALS needs to exist... sigh" + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +\ + +"SUBTITLE OBJECTS" + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +\ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +\ + +"SUBTITLE FOREST OBJECTS" + + + + + + + + + + + + + +\ + +"SUBTITLE ROOMS" + +"SUBTITLE CONDITIONAL EXIT FLAGS" + +> +> +> +> +> +> +> +> +> +> +> + +"SUBTITLE FOREST AND OUTSIDE OF HOUSE" + + + + + + + + + + + + + + + + + +\ + +"SUBTITLE HOUSE" + + + + + + + +\ + +"SUBTITLE CELLAR AND VICINITY" + + + + + + + +\ + +"SUBTITLE MAZE" + + + + + + + + + + + + + + + + + + + + + + + + + + + +\ + +"SUBTITLE CYCLOPS AND HIDEAWAY" + + + + + +\ + +"SUBTITLE RESERVOIR AREA" + + + + + + + + + + + +\ + +"SUBTITLE ROUND ROOM AND VICINITY" + + + + + + + +\ + +"SUBTITLE DOME, TEMPLE, EGYPT" + + + + + + + + +******ADD TORCH****** + +\ + +"SUBTITLE FLOOD CONTROL DAM #3" + + + + + +\ + +"SUBTITLE RIVER AREA" + + + + + + + + + + + + + + + + + + + + + + + +\ + +"SUBTITLE COAL MINE AREA" + + + + + + + + + + + + + + + + + +\ + +"SUBTITLE COAL MINE" + + + + + + + + + +\ + +;"RANDOM TABLES FOR WALK-AROUND" + +> + +> + +> + +> \ 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" + + ;"means print weapon name" + ;"means print defender name (villain, e.g.)" + + + + > + > + > + + > + + > + + > + >>> + +\ + +"messages for troll" + + + > + > + > + + > + + > + + > + > + > + >>> + +\ + +"messages for thief" + + + + > + > + > + + > + + > + > + > + + > + >>> + diff --git a/macros.zil b/macros.zil new file mode 100644 index 0000000..a9014f0 --- /dev/null +++ b/macros.zil @@ -0,0 +1,90 @@ + + + + + ) + (> + >)> + + > + "CRLF"> + <=? .P "CR">> + >) + ( + ) + (ELSE + > + > + > + "DESC"> + <=? .P "D"> + <=? .P "OBJ"> + <=? .P "O">> + >) + ( + <=? .P "N">> + >) + ( + <=? .P "CHR"> + <=? .P "C">> + >) + (ELSE + >>)>)>) + ( + >) + ( + >) + (ELSE )>>>>> + + + ) + (ELSE
)>>)> + )> + > + >>> + !.L)> + > + 3> )>> + !.O)> + >> + + >> + + ) + (ELSE >)>> + +>) + (ELSE >)>> + +>>> + +> + +> + + + >> + + + >> + + ) + (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 @@ + + + + +> + + + +> + + + + + +> + + > + + + > + > + > + > + > + > + + + + > )> + + + + + > + + + (OBJ) + (OBJ1) OBJECT (TBL) TABLE (PTBL) ) + + > + + > + > + >> .OCNT) + ( + + >) + (T >)> + .OCNT) + ( + > + + > + .ICNT) + (T 1)>> + <1? .ICNT>> >)> + >) + (<0? .NUM> + ,P-SONUMS>> + >) + (T + + >)>) + (T + > .NUM> ) + (T + >) + (T >)> + + + )> + + >> + )>)>> + + )> + > + >)>) + (T + >)> + >>> + +> + +> + +> + +) (I <>) "AUX" V OA OO OI) + #DECL ((A) FIX (O) (I) (V) ANY) + + + + + + >> + + )> + )> + )> + + + > + + + )> + >> .V) + ( ,P?ACTION> ,M-BEG>> .V) + (>> .V) + (>>> .V) + (> + >>> + .V) + (>> .V)> + > + ,M-END>>)> + + + + .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" + + ;"mistah kurtz, he dead." + ;"strike first?" + +\ + +"blow results" + + ;"attacker misses" + ;"defender dead" + ;"defender lightly wounded" + ;"defender seriously wounded" + ;"defender staggered (miss turn)" + ;"defender loses weapon" + ;"hesitates (miss on free swing)" + ;"sitting duck (crunch!)" + +"tables of melee results" + +> + +> + +> + +> + +> + +> + + + 0 ;>> + + + 0; >> + + + DEF3B + 0 ; + DEF3C>> + +\ + +"useful constants" + + + + + +"each table entry is:" + + ;"villain" + ;"best weapon" + ;"advantage it confers" + ;"prob of waking if unconscious" + ;"messages for that villain" + + + >> + +\ + +"I-FIGHT moved to DEMONS" + +)) + + > + + + )> + > + > + >) + (>> + > + ) + (<==? .RES ,UNCONSCIOUS> + >>)>> + ) + (T + > + )>)>) + (ELSE )>>> + +\ + +"takes a remark, defender, and good-guy's weapon" + +) (CNT 0) STR) + #DECL ((A D) OBJECT (W) (LEN CNT) FIX + (STR) ) + > .LEN> )> + > + ) + (<==? .STR ,F-DEF> ) + (ELSE )>> + > + +"Strength of the player is a basic value (S) adjusted by his P?STRENGTH +property, which is normally 0" + +) + >>>> + >)(ELSE .S)>> + +) + OD TMP) + #DECL ((VILLAIN) OBJECT (WV) + (OD VALUE) FIX) + > + > + ,THIEF-ENGROSSED> + )> + >)> + + <==? ,PRSI>> + >> + )> + )>)> + .OD> + +"find a weapon (if any) in possession of argument" + +> + + )> + ) + (>> >)>>> + +\ + +) + (REMARKS ) + DWEAPON ATT DEF OA OD TBL RES NWEAPON) + + + + + )> + >> + > 0>> )> + >> + > + ) + (ELSE + + )> + >>) + (<==? .DEF 2> + )> + >>) + ( + > + ) + ( )> + >>)> + 1>>> + >> + ,WINNER + .DWEAPON>)> + <==? .RES ,HESITATE>>) + ( <==? .RES ,SITTING-DUCK>> ) + (<==? .RES ,LIGHT-WOUND> + > + )> + + >)>) + (<==? .RES ,SERIOUS-WOUND> + > + )> + + >)>) + (<==? .RES ,STAGGER> )> + > + +)) + #DECL ((VILLAIN) OBJECT (NWEAPON) + (RES OA OD ATT DEF FIX) FIX (HERO?) ) + > + )> + > + ,PRSO> + )>> + + + + + )> + > + )> + + > + >>> + + >)> + + )> + > + + )> + >>) + (<==? .DEF 2> + )> + >>) + ( + > + ) + ( )> + >>)> + 1>>> + )> + >> + ,PRSO + ,PRSI> + ) + ( ) + (<==? .RES ,LIGHT-WOUND> + > + )>) + (<==? .RES ,SERIOUS-WOUND> + > + )>) + (<==? .RES ,STAGGER> )> + > + +\ + + -10000)(ELSE <- .DEF .OD>)>> + 0> + >)> + 0>> + >>>> + + <>) + (ELSE .RES)>> + + + + + + + ,F-DEAD> + .RES) + (ELSE .RES)>> + +\ + +> + >> + ) + ( ) + (<0? .PS> ) + ( ) + (ELSE )>> + +)) + #DECL ((S) FIX) + ) + ( > )> + + + >)> + >) + (ELSE + + >)>> + +>) + (WD ) (RS <+ .MS .WD>)) + #DECL ((MS WD RS) FIX) + ,C-ENABLED?>> ) + (ELSE >)> + ) + (T + + > + ,C-TICK>>> + )> + + ) + (<1? .RS> ) + (<==? .RS 2> ) + (<==? .RS 3> ) + ( )> + > 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. +" + + + +> + +> + + + + + + + + + + + + + + + + + + + + + + + +> +;"INBUF - Input buffer for READ" + +> +;"Parse-cont variable" + +> + +> +> + +;"Parser variables and temporaries" + + + + + + +;"Byte offset to # of entries in LEXV" + + +;"Word offset to start of LEXV entries" + + +;"Number of words per LEXV entry" + + + + +;"Offset to parts of speech byte" + + +;"Offset to first part of speech" + + +;"First part of speech bit mask in PSOFF byte" + + + + + +> + +> + + + + + + + + + + + + + + + + + + + + + + + +" Grovel down the input finding the verb, prepositions, and noun clauses. + If the input is or , fall out immediately + setting PRSA to ,V?WALK and PRSO to . Otherwise, perform + all required orphaning, syntax checking, and noun clause lookup." + +) + LEN (DIR <>) (NW 0) NUM) + + + + + + > + )>) + (T + )> + "> + )> + > + )> + + > + + + > 0> ) + (> + + + >> + + ) + (> + + <==? .VERB ,ACT?WALK>> + >> + ,W?THEN + ,W?.> + >> + + + + ,W?THEN>)> + > )>) + (> + > + + + + + 2>>>> + >>) + (> + + + > + >> + + <==? > + ,W?OF> + <0? .VAL> + >>) + (> + + > + ,W?THEN ,W?.>>> + + + )>) + (<==? ,P-NCN 2> + + ) + (T + > + > + > + >)>) + () + (T + + + + )>) + (T )> + >> + )> + > + T)>> +;"Check whether word pointed at by PTR is the correct part of speech. + The second argument is the part of speech (,PS?). The + 3rd argument (,P1?), if given, causes the value + for that part of speech to be returned." + +> .BIT> + ) + (T + > + > >)> + )>)>> +;" Scan through a noun clause, leave a pointer to its starting location" + +) (FIRST?? <>) NW) + #DECL ((PTR VAL OFF NUM) FIX (WORD NW) + (ANDFLG FIRST??) ) + 2>> + > + > .VAL> + .WORD> + >) + (T >)> + > )> + > >> + > 0> + >> + )> + > + ) + (T >>)> + ) + ( + + > + >)>) + ( + + >> + > + + >> + >) + ( + + > + >) + ( + > + >> + + 2>>> + ) + (T >)>) + ( + >) + ( + >> + > + ,W?THEN> + >) + (T + + + + )>) + (T )> + > + >>> + +;"Print undefined word in input. + PTR points to the unknown word in P-LEXV" + + ) + (ELSE + > + >)>>> + + + >> 2> + 3>> + > + +;"Clear out the input table (prior to GROVELing through the input)" + + ) + (T )>>> + +;" 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." + + + + + + + + + + + + + + + + + + + + + + + +) (DRIVE2 <>) PREP VERB TMP) + #DECL ((DRIVE1 DRIVE2) > + (SYN) (LEN NUM VERB PREP) FIX + (OBJ) ) + >> + + )> + >> + > + > + ,P-SONUMS>> + > + <0? ,P-NCN> + >> + <==? .PREP >>> + ) + (<==? > + <==? ,P-NCN 1>> + ) + (<==? + > + + )>)> + + ) + (T + + )>) + (T >)>> + + + >>> + + + ) + ( + + >>> + + + ) + (T + + )>> + +) + + >> + + + + + )> + + + + > + + 1> + > + + > + > + + ) + (T + )>)> + > + )> + .OBJ)>) + (T )>> + + 2>> + ) + (<==? .PREP> + >>)>>> + +>) + > 0>> + > + ,P-PRSO> > + > + >>)> + > 0>> + > + ,P-PRSI> > + >> + 1> + >) + (T >)>)>)> + > + +> + + ) + (> ,P-BUTS>) + (T + .OBJ> + >)> + >> + + + + .NTBL> + +> + +> + +> + +> + +> + +> + +> + + + + + + + + + + + +) (BUT <>) LEN WV WORD NW) + #DECL ((TBL) TABLE (PTR EPTR) (AND) + (BUT) (WV) ) + + + + > + >>) + (T + > + + + + >)>) + ( + > > + + ) + ( + + + + >)>) + (T + + > > + >)>) + ( + >> + > > + T) + () + () + (<==? .WORD ,W?OF> + + )>) + (> + + ) + ( + + )>)> + > + > + )>>> + + + + + + + + + + + + + + + +)) + #DECL ((TBL) TABLE (XBITS BITS TLEN LEN) FIX (GWIM) + (VRB GCHECK) ) + + > + )> + ,P-ADJ > + + >)> + + + > + <0? ,P-GWIMBIT>> + )> + )> + > <0? ,P-SLOCBITS>> + )> + + ) + (T + )> + )> + .TLEN>> + ) + ( + >>> + + + .LEN>> + ) + (T + + + )> + > + > + )>) + ( .GCHECK> + + )> + )> + ) + (T + )>)> + > + > + ) + (<0? .LEN> )> + > + > + + >> + + (RMGL CNT) FIX (OBJ) OBJECT) + + > + 1>> + > .TBL> + )> + )>>)> + > + 4> 1>> + + >> + 1>>> + 5>> + > + > + + ) + ( )>>)> + > + + + + )>> + +> + ) + (T + + ) + ( + ) + (T )>)>> + + + + + + + + (TBL) TABLE (LVL) FIX (FLS) ANY) + > + > + > + )> + > + > + > + + >> + + ,P-SRCALL) + (T ,P-SRCTOP)>>>)> + >) (T )>>)>> + +> + .OBJ> + >> + +> + >>> + + +) + > > + > 0> ) + (T + >> + )> + > + + + ) + (<==? > T> + >) + (T )> + > + + + + ) + ( + )>)>)>>) + (T)>> + +) TMP) + #DECL ((LOSS) ) + 1> + ,SMANY>>> + ) + ( 1> + ,SMANY>>> + )> + + > + >) + (T + >)> + + ) + (T)>> + + )> + > ) + (ELSE >)> + > ) + ( )>>> + +> ) + ( )>>> + +> + +)) + #DECL ((RM OHERE) OBJECT (LIT) ) + + + + ,ALWAYS-LIT> ) + (T + + + + )> + + 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" + + + + + + + + + + + + + + + + + +\ + +"ZORK game commands" + + + + + + + + + + + + + + + + + + + + + + + + + + + +\ + +"SUBTITLE REAL VERBS" + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + ;"Crock!" + + + + + + + + + + + + + + + + + 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" + +> +> +> + + + > + > + +> + > + > + + + > + +\ + +"SUBTITLE DESCRIBERS" + + + )>> + + + )>)>> + + + CR>) + ( + > + ) + (ELSE + )>> + +) "AUX" V? STR) + > + + + >)> + > + > + + )> + + > + ,VEHBIT> + ".)" CR>)> + ,M-LOOK>> + ) + (>> + )>)> + T> + +)) + + > -1>)>) + (ELSE + )>> + +"DESCRIBE-OBJECT -- takes object and flag. if flag is true will print a +long description (fdesc or ldesc), otherwise will print short." + +) AV) + + > + >> + >> + ) + (T )>) + (ELSE + > + )> + + > + + > + )> + + > + )>> + +) (LEVEL 0) + "AUX" Y 1ST? AV STR (PV? <>) (INV? <>)) + #DECL ((OBJ) OBJECT (LEVEL) FIX) + >> )> + > > + T) + (ELSE >)> + + > + ) + (ELSE + >) + (<==? .Y .AV> ) + (<==? .Y ,WINNER>) + (> + > + >> + > + )> + > + )>)> + >>)> + > + + > + > + )> + >) + () + (> + + >>> + > + + > + >)> + ) + ( + > + )>)> + >>> + + + ) + (<==? .OBJ ,WINNER> + ) + (> + + >)> + + ) + (ELSE + )>)>> + +\ + +"SUBTITLE SCORING" + + + + + +> + > + > > + + + + )> + T> + +> 0> + + )>> + + + +) + + + + + + + ) (ELSE )> + > + + + > + +> (SCOR) FIX) + + + > + > + ) + (ELSE )>> + +"> + + ,W?YES ,W?Y> + ) + (T + )>> + + + + + *3777*>> + > + +>> + ,L-PRSO) + (>> + ,L-PRSI)>> + + ) + (T + )>> + +\ + +"SUBTITLE DEATH AND TRANSFIGURATION" + +> + + +)) + #DECL ((DESC) STRING (PLAYER?) ) + + + + > + + ) + (T + > + + + + > + + )>>> + +> + > + > + > + > + > + > + +) F N L) + + )> + + )> + + > + > + + )> + > + 0> + >)> + + > + > + + ) + (ELSE >)>>) + (ELSE + >>)>>> + + + + ) + (T + )>> + + + ) + (T + )>> + + + + + )>> + + + + + + + + + + + + + + + +> + +> + + CR>> + +> + )>> + +)) + #DECL ((ITM) ANY (TBL) TABLE (CNT LEN) FIX) + > .LEN> + ) + (<==? .ITM> + ) + (T + >>)>)>>> + + (PTS) FIX (STR) + (OBJ) OBJECT (RM) ) + > + > ,UEXIT> + >) + (<==? .PTS ,NEXIT> + CR> + ) + (<==? .PTS ,FEXIT> + >> + ) + (T + )>) + (<==? .PTS ,CEXIT> + > + >) + (> + + ) + (T + + )>) + (<==? .PTS ,DEXIT> + > ,OPENBIT> + >) + (> + + ) + (T + + )>)>) + ( + > + ) + (T + + )>> + + ) + (T )>> + +> + +\ + + ) + ( ,CONTBIT> + ,OPENBIT>>> + + ) + (,PRSI + > + > + ) + (>> + ) + (T + > + )>) + (<==? ,PRSO > )>> + + T> + )>> + + (CNT) FIX (OBJ) OBJECT) + > + )> + ) + ( ,WINNER>> + > ,LOAD-ALLOWED>> + + + ) + (ELSE )> + )> + ) + (> 7> + >> + > + > + ;"This must go! Chomping compiler strikes again" + + + ) + (T + + + + )>> + + + >> + )>> + + + + >) + (T + + )> + > + ) + (<==? ,PRSI ,PRSO> + ) + ( + ) + ( > + > + > + ) + (> + > + + ) + (> + >> + ) + (T + + + + )>> + +> + + )>> + +> + ) + ( )>> + +> + + )>> + + )>> + + + > ,VEHBIT> + > + ) + (ELSE )>) + (T )>> + +> ,WINNER>>> + + ) + (> + ,OPENBIT>>> + + ) + (T > )>> + +\ + +> + ) + ( 0>> + ) + (T + + > > + ) + (> + > + >> + + ) + (T + + + )>)>) + (T )>> + +) + > + > + >) + (ELSE + + )>)> + + + )>>)>> + +> + ) + ( + + ) + (T )>> + +> + > + >> + )>>)> + .CNT> + +"WEIGHT: Get sum of SIZEs of supplied object, recursing to the nth level." + + (WT) FIX) + > + >> + >> )>>)> + <+ .WT >> + +> )>> + + + ) + (T )>> + + + ) + (ELSE + + + + > + )>)>) + (T + )> + > + + + > + ) + (ELSE + + >)> + + >> + )>)>) + (ELSE )> + > + + + > 0> ) + ( )> + >> + > + +> + + > + ) + ( + ) + (T )>) + (T )> + > + + + + ,M-ENTER> + > + + ,PRSO>> + + ) + ( + + ) + (T + + )>> + +> + +) (WLOC ) + (AV <>) OLIT) + #DECL ((RM WLOC) OBJECT (LB) (AV) ) + + + >)> + >>> + + .LB + .AV + > + >>> + ) + (T )> + + ) + ( CR> ) + (T + ) + (T + )> + + > + > + ) + (ELSE + + )> + ,M-ENTER> + + )> + )>)>> + + ) + (T )>> + + + + + ) + (T )> + + ) + (T + )>> + +) + >> + > + + ) + (T + + )>)> + > + + )>> + + + + + + ) + (T + )>) + (T )>> + + > + > + + + + + ) + (T )>> + + ) + (ELSE )> + > + +> + +) (DRINK? <>) (NOBJ <>)) + #DECL ((NOBJ) (EAT? DRINK?) ) + > > + ) + (ELSE + + )> + ) + (> + + > + + >> + + ) + (T )>) + (> + )>> + +> + + + ) + (T + )>> + +) + + + ) + (T )>) + (T )>) + (> + > + ;NEXIT + ;CEXIT + >>>> + ) + (ELSE )>) + (ELSE )>> + +> + + + + + > + > + ) + (ELSE )>) + ( + ) + (ELSE + )>) + (ELSE )>> + + )>> + +> + ) + (ELSE CR>)>> + +> + +> + + + + ) + (ELSE )> + ) + ( + + > + ) + (T + )>) + (ELSE )>) + (ELSE )>> + +> + >>> + ) + (T )>> + + + + + + ) + (T + + ) + (ELSE )>) + (T )>> + +> ) + ( + ) + (> + )>> + +> + +>> + ) + ( + ) + (T )>> + +> + +> + + + ) + ( + > + + ) + (> + ) + (T + )>> + +> + + ) + (> + >> + ) + ( > + ) + (> + ) + (ELSE )>> + +> + + + ) + (T + )>> + +> + +> + +> + +> + +> + +> + +> + ) + ( + ) + (> + )>> + +> + + CR>> + +> + +> + <- 2> 1>>> + + + ) + (ELSE )>> + +> + +> + + + ) + (> + ) + (> + > + ) + ( > + )>> + + )> + ) + ( + ) + (ELSE )>> + +> + +> + +) + > + >)>> + +> + +> + )>> + +> + +> + ) + (<==? ,PRSI ,WINNER> + )>> + +> + + + + 0> + + ) + (ELSE + )>) + (ELSE )>) + (ELSE )>> + +> + +> + +> + + + 0> + + ) + (T + )>) + (ELSE + )>> + + + > + + + ) + (ELSE + )>> + + + ) + (T + )>> + +> + +) "AUX" X) + #DECL ((DIR) FIX (OBJ) (X) TABLE) + + + ) + ( + ) + (> >> + ) + (ELSE )>> + +> + +> + + + ) + (T + )>> + +> + +> + +)) + > + ) + ( >> + ) + (.OBJ ) + ( + ) + (ELSE )>> + +> + +> + +> 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 [ ] + JRST .+2] + MSG [ ] + 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: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 ; ab +;+2 skip: ab + AOS -4(P) ;a 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=? + 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: ++ +; 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 ,, +; SYMVAL +; SYMREF +; where +; if for a defined symbol +; includes +; %VAR,, if the symbol is for a variable (local or global) +; and +; if for an undefined symbol +; includes +; %UNDEF,, + +; a reference chain consists of +; ,, +; +; where +; 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: -,,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: -,,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 [ ] + JRST .+2] + MSG [ ] + 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: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 ; ab +;+2 skip: ab + AOS -4(P) ;a 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=? + 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: ++ +; 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 ,, +; SYMVAL +; SYMREF +; where +; if for a defined symbol +; includes +; %VAR,, if the symbol is for a variable (local or global) +; and +; if for an undefined symbol +; includes +; %UNDEF,, + +; a reference chain consists of +; ,, +; +; where +; 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: -,,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: -,,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 Binary files /dev/null and b/zork.zip differ