From 4b5da0c599ea728332089c2cbb4368d49d9b3cf7 Mon Sep 17 00:00:00 2001 From: Lars Brinkhoff Date: Tue, 16 Apr 2019 12:15:32 +0200 Subject: [PATCH] ZAP - ZIL assembler program. ZAP MID is New version, X MID presumably older. --- Makefile | 2 +- src/zil/x.mid | 3839 +++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 3840 insertions(+), 1 deletion(-) create mode 100644 src/zil/x.mid diff --git a/Makefile b/Makefile index 2534823c..93305f9f 100644 --- a/Makefile +++ b/Makefile @@ -28,7 +28,7 @@ SRC = syseng sysen1 sysen2 sysen3 sysnet kshack dragon channa \ fonts zork 11logo kmp info aplogo bkph bbn pdp11 chsncp sca music1 \ moon teach ken lmio1 llogo a2deh chsgtv clib sys3 lmio turnip \ mits_s rab stan_k bs cstacy kp dcp2 -pics- victor imlac rjl mb bh \ - lars drnil + lars drnil zil DOC = info _info_ sysdoc sysnet syshst kshack _teco_ emacs emacs1 c kcc \ chprog sail draw wl pc tj6 share _glpr_ _xgpr_ inquir mudman system \ xfont maxout ucode moon acount alan channa fonts games graphs humor \ diff --git a/src/zil/x.mid b/src/zil/x.mid new file mode 100644 index 00000000..f154527e --- /dev/null +++ b/src/zil/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