3840 lines
67 KiB
Plaintext
3840 lines
67 KiB
Plaintext
TITLE ZAP -- Z-Language Assembler
|
||
|
||
; ZAP version 3 - Expanded word table to 96 words
|
||
; MARC/JMB - 1/7/82
|
||
|
||
.DECSAV
|
||
|
||
SUBTTL ACS
|
||
|
||
O=0
|
||
A=1
|
||
B=2
|
||
C=3
|
||
D=4
|
||
E=5
|
||
F=6
|
||
G=7
|
||
H=10
|
||
I=11
|
||
J=12 ;called J only during word-frequency pass
|
||
;acs below this point are used for special purposes
|
||
AB=12 ;pointer into argument table ARGBUF
|
||
Z=13 ;pointer into output buffer OUTBUF
|
||
ZPC=14 ;pc
|
||
FREE=15 ;free storage pointer for symbol tables
|
||
TP=16 ;pointer into token table TOKENS
|
||
P=17 ;stack
|
||
|
||
;bits in symbol table words
|
||
%UNDEF==400000 ;undefined symbol; right half will be ptr to references
|
||
%VAR==200000 ;symbol is a variable
|
||
%BITS==600000 ;all defined bits in symbol table
|
||
|
||
;bits in reference words
|
||
%RBYTE==400000 ;byte refs are flagged
|
||
%RJUMP==200000 ;as are jump refs
|
||
|
||
;random macros
|
||
DEFINE MSG M
|
||
HRROI A,[ASCIZ /!M!/]
|
||
TERMIN
|
||
|
||
DEFINE NXTARG N
|
||
ADD TP,[<2*N>,,<2*N>]
|
||
TERMIN
|
||
|
||
LOC 140
|
||
|
||
SUBTTL PSEUDO-OPS AND OPCODES
|
||
|
||
%PSEUD==400000 ;pseudo-op
|
||
|
||
;pseudo-op definition macro
|
||
DEFINE DISP SYM
|
||
440700,,[ASCIZ /.!SYM/]
|
||
%PSEUD,,Z!SYM
|
||
TERMIN
|
||
|
||
%PRED==200000 ;predicate inst.
|
||
%VAL==100000 ;value inst.
|
||
%JUMP==40000 ;jump inst.
|
||
%STR==20000 ;string instr.
|
||
%XARG==10000 ;??
|
||
|
||
;opcode definition macro
|
||
DEFINE DEFOP OP,OPCODE,FLAGS
|
||
440700,,[ASCIZ /OP/]
|
||
FLAGS,,OPCODE
|
||
TERMIN
|
||
SUBTTL PSEUDOS
|
||
|
||
OPS:
|
||
PSUTBL: DISP BYTE
|
||
DISP END
|
||
DISP ENDI
|
||
DISP ENDT
|
||
DISP EQUAL
|
||
DISP FALSE
|
||
DISP FSTR
|
||
DISP FUNCT
|
||
DISP GSTR
|
||
DISP GVAR
|
||
DISP INSERT
|
||
DISP LEN
|
||
DISP OBJECT
|
||
DISP PDEF
|
||
DISP PROP
|
||
DISP SEQ
|
||
DISP STR
|
||
DISP STRL
|
||
DISP TABLE
|
||
DISP TRUE
|
||
DISP WORD
|
||
DISP ZWORD
|
||
OPRTBL: DEFOP ADD,20.,%VAL
|
||
DEFOP BAND,9.,%VAL
|
||
DEFOP BCOM,143.,%VAL
|
||
DEFOP BOR,8.,%VAL
|
||
DEFOP BTST,7.,%PRED
|
||
DEFOP CALL,224.,%VAL
|
||
DEFOP CRLF,187.
|
||
DEFOP DEC,134.
|
||
DEFOP DIV,23.,%VAL
|
||
DEFOP DLESS?,4.,%PRED
|
||
DEFOP EQUAL?,1.,%PRED+%XARG
|
||
DEFOP FCLEAR,12.
|
||
DEFOP FIRST?,130.,%PRED+%VAL
|
||
DEFOP FSET,11.
|
||
DEFOP FSET?,10.,%PRED
|
||
DEFOP FSTACK,185.
|
||
DEFOP GET,15.,%VAL
|
||
DEFOP GETB,16.,%VAL
|
||
DEFOP GETP,17.,%VAL
|
||
DEFOP GETPT,18.,%VAL
|
||
DEFOP GRTR?,3.,%PRED
|
||
DEFOP IGRTR?,5.,%PRED
|
||
DEFOP IN?,6.,%PRED
|
||
DEFOP INC,133.
|
||
DEFOP JUMP,140.,%JUMP
|
||
OPJMP=.-1 ;full opcode for jump
|
||
DEFOP LESS?,2.,%PRED
|
||
DEFOP LOC,131.,%VAL
|
||
DEFOP MOD,24.,%VAL
|
||
DEFOP MOVE,14.
|
||
DEFOP MUL,22.,%VAL
|
||
DEFOP NEXT?,129.,%PRED+%VAL
|
||
DEFOP NEXTP,19.,%VAL
|
||
DEFOP NOOP,180.
|
||
DEFOP POP,233.
|
||
DEFOP PRINT,141.
|
||
DEFOP PRINTB,135.
|
||
DEFOP PRINTC,229.
|
||
DEFOP PRINTD,138.
|
||
DEFOP PRINTI,178.,%STR
|
||
DEFOP PRINTN,230.
|
||
DEFOP PRINTR,179.,%STR
|
||
DEFOP PTSIZE,132.,%VAL
|
||
DEFOP PUSH,232.
|
||
DEFOP PUT,225.
|
||
DEFOP PUTB,226.
|
||
DEFOP PUTP,227.
|
||
DEFOP QUIT,186.
|
||
DEFOP RANDOM,231.,%VAL
|
||
DEFOP READ,228.
|
||
DEFOP REMOVE,137.
|
||
DEFOP RESTART,183.
|
||
DEFOP RESTORE,182.,%PRED
|
||
DEFOP RETURN,139.
|
||
DEFOP RFALSE,177.
|
||
DEFOP RSTACK,184.
|
||
DEFOP RTRUE,176.
|
||
DEFOP SAVE,181.,%PRED
|
||
DEFOP SET,13.
|
||
DEFOP SUB,21.,%VAL
|
||
DEFOP USL,188.
|
||
DEFOP VALUE,142.,%VAL
|
||
DEFOP VERIFY,189.,%PRED
|
||
DEFOP ZERO?,128.,%PRED
|
||
|
||
OPCNT==<.-OPS>/2 ;number of pseudos and operators altogether
|
||
|
||
SUBTTL START UP -- READ JCL AND OPEN INPUT FILE
|
||
|
||
START: RESET
|
||
MOVE P,[-77,,PDL]
|
||
SETZ A,
|
||
RSCAN
|
||
JFCL
|
||
JUMPE A,NOJCL ; NO JCL, FLUSH
|
||
|
||
;read jcl line
|
||
MOVN C,A
|
||
MOVEI A,.PRIIN
|
||
MOVE B,[440700,,FILBUF]
|
||
SIN ; READ JCL
|
||
|
||
;parse jcl line
|
||
MOVE B,[440700,,FILBUF]
|
||
NAMLOP: ILDB A,B
|
||
CAILE A,40
|
||
JRST NAMLOP
|
||
NAMDON: CAIE A,^M
|
||
CAIN A,^J
|
||
JRST NOJCL
|
||
MOVEM B,FILPTR ;should be file spec start
|
||
ILDB A,B
|
||
CAIL A,40
|
||
JRST .-2
|
||
MOVEI A,0
|
||
DPB A,B
|
||
MOVE B,FILPTR
|
||
PUSHJ P,OPEN ;open file
|
||
JRST BEGIN
|
||
|
||
;here if no jcl, read file name from tty
|
||
NOJCL: PUSHJ P,TOPEN
|
||
JRST BEGIN
|
||
|
||
SUBTTL FILE NAME READING AND FILE OPENING
|
||
|
||
OPEN: PUSHJ P,FOPEN
|
||
JRST TOPEN ;open failed, try from tty
|
||
POPJ P,
|
||
|
||
;read file name from tty
|
||
TOPEN: MSG [
|
||
File: ]
|
||
PSOUT
|
||
MOVEI A,GTJFNT
|
||
MOVEI B,0
|
||
PUSHJ P,FOPEN1
|
||
JRST TOPEN
|
||
POPJ P,
|
||
|
||
;open a file
|
||
; b/ file name
|
||
;skips if wins
|
||
FOPEN: MOVEI A,GTJFNB
|
||
PUSH P,B
|
||
GTJFN
|
||
SKIPA
|
||
JRST FOPEN2
|
||
MOVEI A,GTJFNX
|
||
MOVE B,(P)
|
||
JRST FOPEN0
|
||
|
||
FOPEN1: PUSH P,B
|
||
FOPEN0: GTJFN
|
||
JRST NOFILE
|
||
FOPEN2: TLZ A,-1
|
||
MOVEM A,IJFN ; SAVE CURRENT INPUT JFN
|
||
MOVE B,[070000,,240000]
|
||
OPENF ; HAS TO BE OPEN
|
||
JRST NOFIL1
|
||
POP P,B
|
||
AOS (P)
|
||
POPJ P,
|
||
|
||
;gtjfn failed for some reason
|
||
NOFILE: MOVE B,A
|
||
MSG [Open failed?]
|
||
NOFIL4: PSOUT
|
||
POP P,C
|
||
JUMPE C,NOFIL3
|
||
MSG [ (]
|
||
PSOUT
|
||
MOVE A,C
|
||
NOFIL2: PSOUT
|
||
MSG [)]
|
||
PSOUT
|
||
NOFIL3: MSG [: ]
|
||
PSOUT
|
||
|
||
;print error string
|
||
ERPRNT: HRRZI A,-1
|
||
HRLI B,400000
|
||
MOVEI C,0
|
||
ERSTR ; PRINT ERROR
|
||
POPJ P, ;UNDEFINED ERROR.
|
||
POPJ P, ;CHOMPING DEST.
|
||
POPJ P, ;WON.
|
||
POPJ P,
|
||
|
||
;openf failed for some reason
|
||
NOFIL1: MOVE B,A
|
||
MSG [Can't OPENF file?]
|
||
JRST NOFIL4
|
||
|
||
|
||
SUBTTL BEGIN ASSEMBLING
|
||
|
||
;print filename being assembled
|
||
BEGIN: SKIPN DOFREQ
|
||
JRST BEGINF
|
||
MSG [Counting ]
|
||
SKIPA
|
||
BEGINF: MSG [Assembling ]
|
||
PUSHJ P,PFNAME ;tell name of file being read
|
||
|
||
;find out release number since it's alway wrong in the ZAP file
|
||
MSG [Time Mode?: ]
|
||
PSOUT
|
||
PBIN
|
||
SETZ B,
|
||
CAIE A,"T
|
||
CAIN A,"Y
|
||
JRST [TRO B,%TIMESL
|
||
MSG [ <yes>]
|
||
JRST .+2]
|
||
MSG [ <no>]
|
||
PSOUT
|
||
PUSHJ P,PCRLF
|
||
; MSG [Byte Swapped?: ]
|
||
; PSOUT
|
||
; PBIN
|
||
; CAIE A,"T
|
||
; CAIN A,"Y
|
||
; TRO B,%BYTSWP
|
||
; PUSHJ P,PCRLF
|
||
MOVEM B,FLGWRD
|
||
MSG [Release: ]
|
||
PSOUT
|
||
MOVEI A,.PRIIN
|
||
MOVEI C,10.
|
||
SETOM RELEAS
|
||
NIN
|
||
JRST GETFNM ;lost, use default
|
||
JUMPL B,GETFNM
|
||
MOVEM B,RELEAS ;save and use instead of supplied
|
||
|
||
;get goodies so can open correct output file
|
||
GETFNM: MOVE A,OUTPTR
|
||
MOVE B,IJFN
|
||
MOVE C,[222000,,JS%PAF] ;output dev:<dir>name.
|
||
JFNS
|
||
MOVEM A,OUTPTR ;save for outputting other exts.
|
||
SKIPE DOFREQ
|
||
JRST BEGLUP ;do frequency assembly
|
||
|
||
MOVE Z,[441000,,OUTBUF] ;byte ptr to output buffer
|
||
MOVEI ZPC,0 ;pc initially zero
|
||
PUSHJ P,SCRIPT ;open script channel if asked
|
||
PUSHJ P,GLBINI ;initialize global symbol table
|
||
PUSHJ P,LCLINI ;initialize local symbol table
|
||
|
||
;here to create references to the first n words, which are special
|
||
MOVE A,ZAPID
|
||
PUSHJ P,OUTBYT
|
||
MOVE A,FLGWRD
|
||
PUSHJ P,OUTBYT
|
||
SKIPGE A,RELEAS ;user gave a release number?
|
||
JRST NORELE
|
||
PUSHJ P,OUTWRD
|
||
JRST DEFWDS
|
||
|
||
NORELE: HRROI B,[ASCIZ /.WORD ZORKID
|
||
/]
|
||
HRROI A,BUFFER
|
||
MOVEI C,0
|
||
SOUT
|
||
PUSHJ P,ASSEM
|
||
|
||
;output always defined words
|
||
DEFWDS: HRROI B,[ASCIZ /.WORD ENDLOD,START,VOCAB,OBJECT,GLOBAL,IMPURE,0,0,0,0,WORDS
|
||
/]
|
||
HRROI A,BUFFER ;copy to buffer
|
||
MOVEI C,0
|
||
SOUT
|
||
PUSHJ P,ASSEM ;assemble it
|
||
|
||
BEGWDS: MOVEI A,0
|
||
PUSHJ P,OUTWRD
|
||
CAIGE ZPC,100
|
||
JRST BEGWDS
|
||
|
||
BEGLUP: PUSHJ P,RDLINE ;read a line, no skip if done
|
||
JRST DONE
|
||
SKIPE PDEBUG
|
||
PUSHJ P,PINPUT
|
||
PUSHJ P,ASSEM ;assemble line
|
||
SKIPE PDEBUG
|
||
CAMN Z,SAVZ
|
||
JRST BEGLUP
|
||
PUSHJ P,OPC
|
||
JRST BEGLUP
|
||
|
||
PINPUT: PUSH P,A
|
||
PUSH P,B
|
||
PUSH P,C
|
||
MOVE A,PDEBUG
|
||
MOVEI C,0
|
||
HRROI B,[ASCIZ /
|
||
;/]
|
||
SOUT
|
||
HRROI B,BUFFER
|
||
SOUT ;print it (for debugging)
|
||
MOVEM ZPC,SAVZPC
|
||
MOVEM Z,SAVZ
|
||
JRST POPCBA
|
||
|
||
SUBTTL DONE - FINISH UP, PRINT STATS, ETC.
|
||
|
||
DONE: SKIPE DOFREQ
|
||
JRST FILEND
|
||
PUSHJ P,UNDGLB ;print undefined globals
|
||
MSG [
|
||
]
|
||
PSOUT
|
||
MOVEI A,.PRIOU
|
||
MOVE B,ZPC
|
||
MOVEI C,10.
|
||
NOUT
|
||
JFCL
|
||
MSG [ bytes.
|
||
]
|
||
PSOUT
|
||
MOVEI A,.PRIOU
|
||
MOVE B,OBJTOT
|
||
MOVEI C,10.
|
||
NOUT
|
||
JFCL
|
||
MSG [ objects.
|
||
]
|
||
PSOUT
|
||
MOVEI A,.PRIOU
|
||
MOVE B,GLBTOT
|
||
MOVEI C,10.
|
||
NOUT
|
||
JFCL
|
||
MSG [ globals.
|
||
]
|
||
PSOUT
|
||
SKIPE TWOPAS ;don't bother if two pass assembly
|
||
JRST OUTPUT
|
||
MOVEI A,.PRIOU
|
||
MOVE B,SHRIMP
|
||
MOVEI C,10.
|
||
NOUT
|
||
JFCL
|
||
MSG [ wasted long jumps.
|
||
]
|
||
PSOUT
|
||
|
||
|
||
;here to force pc to value in A
|
||
SETZPC: MOVE ZPC,A
|
||
MOVE Z,[441000,,OUTBUF]
|
||
EXCH A,Z
|
||
ADJBP Z,A
|
||
POPJ P,
|
||
|
||
;here to output date stuff for serial number in ascii
|
||
;a/ number
|
||
OUTDAT: PUSH P,B
|
||
IDIVI A,10.
|
||
ADDI A,"0
|
||
PUSHJ P,OUTBYT
|
||
MOVEI A,"0(B)
|
||
PUSHJ P,OUTBYT
|
||
POP P,B
|
||
POPJ P,
|
||
|
||
;here to output the data
|
||
OUTPUT: MOVEM Z,SAVZ
|
||
MOVEM ZPC,SAVZPC
|
||
MOVEI A,32 ; where the length lives
|
||
PUSHJ P,SETZPC
|
||
MOVE A,SAVZPC ; get back the final top pc
|
||
LSH A,-1 ; make it in words
|
||
PUSHJ P,OUTWRD
|
||
MOVEI A,77 ; start at byte 100 octal
|
||
PUSHJ P,SETZPC
|
||
SETZ D, ; zero the checksum
|
||
OUTCL: CAMN ZPC,SAVZPC ; loop until through the entire file
|
||
JRST OUTCHK
|
||
ILDB B,Z ; get the byte
|
||
ADD D,B ; and add it into checksum
|
||
AOJA ZPC,OUTCL
|
||
OUTCHK: MOVEI A,34 ; where the checksum lives
|
||
PUSHJ P,SETZPC
|
||
MOVE A,D
|
||
ANDI A,177777 ; only 15 bits worth, though
|
||
PUSHJ P,OUTWRD
|
||
MOVEI A,22 ; where serial number lives
|
||
PUSHJ P,SETZPC
|
||
MOVNI B,1
|
||
ODCNV ; get current time/date
|
||
HLRZ A,B ; here's the year
|
||
SUBI A,1900. ; we will take only the mod 100 part
|
||
PUSHJ P,OUTDAT
|
||
HRRZ A,B ; here's the month (starting at 0)
|
||
ADDI A,1 ; so fix it up here
|
||
PUSHJ P,OUTDAT
|
||
HLRZ A,C ; here's the day (starting at 0)
|
||
ADDI A,1 ; so fix it up here
|
||
PUSHJ P,OUTDAT
|
||
|
||
MOVE Z,SAVZ
|
||
MOVE ZPC,SAVZPC
|
||
MOVE A,[440700,,[ASCIZ /.ZIP/]]
|
||
MOVE B,OUTPTR
|
||
ILDB 0,A
|
||
IDPB 0,B
|
||
JUMPN 0,.-2
|
||
MOVSI A,(GJ%SHT+GJ%FOU)
|
||
HRROI B,OUTFIL
|
||
GTJFN
|
||
JRST ERPRNT
|
||
HRRZ A,A
|
||
MOVE B,[440000,,OF%WR]
|
||
OPENF
|
||
JRST ERPRNT
|
||
;blat out stupid gcdump header
|
||
HRRM ZPC,HEADER+5
|
||
MOVEI C,3(Z)
|
||
SUBI C,OUTBUF
|
||
HRLM C,FOOTER+1
|
||
ADDI C,2006
|
||
HRRM C,FOOTER+1
|
||
SUBI C,2006-2
|
||
MOVEM C,HEADER
|
||
MOVEM C,HEADER+1
|
||
MOVEM C,HEADER+2
|
||
MOVE B,[444400,,HEADER]
|
||
MOVNI C,7
|
||
SOUT
|
||
;blat out data
|
||
MOVE B,[444400,,OUTBUF]
|
||
MOVEI C,1(Z)
|
||
SUBI C,OUTBUF
|
||
MOVN C,C
|
||
SOUT
|
||
;blat out stupid footer
|
||
MOVE B,[444400,,FOOTER]
|
||
MOVNI C,2
|
||
SOUT
|
||
;close up and go home
|
||
CLOSF
|
||
JFCL
|
||
SKIPE A,PDEBUG
|
||
CLOSF
|
||
HALTF
|
||
HALTF
|
||
|
||
;print name of IJFN file, takes prefix string in A
|
||
PFNAME: PSOUT
|
||
MOVEI A,.PRIOU
|
||
MOVE B,IJFN
|
||
MOVE C,[222220,,JS%PAF]
|
||
JFNS
|
||
PUSHJ P,PCRLF
|
||
POPJ P,
|
||
|
||
SCRIPT: SKIPL PDEBUG
|
||
POPJ P,
|
||
MOVE A,[440700,,[ASCIZ /.SCRIPT/]]
|
||
MOVE B,OUTPTR
|
||
ILDB 0,A
|
||
IDPB 0,B
|
||
JUMPN 0,.-2
|
||
MOVSI A,(GJ%SHT+GJ%FOU)
|
||
HRROI B,OUTFIL
|
||
GTJFN
|
||
JRST ERPRNT
|
||
HRRZ A,A
|
||
MOVEM A,PDEBUG
|
||
MOVE B,[070000,,OF%WR]
|
||
OPENF
|
||
JRST ERPRNT
|
||
POPJ P,
|
||
|
||
SUBTTL READ A LINE FROM INPUT FILE
|
||
|
||
RDLINE: SKIPN A,IJFN ;no eof yet?
|
||
POPJ P, ; eof, return
|
||
PUSH P,B
|
||
HRROI B,BUFFER
|
||
MOVEI C,512.*5
|
||
MOVEI D,^J ;stop on crlf
|
||
SIN ;read a line
|
||
ERJMP RDEOF
|
||
MOVEI A,0 ;terminate with nul
|
||
IDPB A,B ;zero byte
|
||
POP P,B
|
||
POPJ1: AOS (P)
|
||
CPOPJ: POPJ P,
|
||
|
||
RDEOF: MOVE A,IJFN
|
||
CLOSF ;close input file
|
||
JRST ERPRNT
|
||
SETZM IJFN ;eof found
|
||
POP P,B
|
||
JRST POPJ1
|
||
|
||
;parse a line into tokens; may require reading more lines if it's a string
|
||
GTLINE: MOVE A,[440700,,TOKEN]
|
||
MOVEM A,TOKPTR
|
||
MOVE TP,TPDL
|
||
GTLIN1: PUSHJ P,GTOKEN ;get a token
|
||
PUSH TP,B ;push string
|
||
PUSH TP,A ;push terminator
|
||
JUMPN A,GTLIN1
|
||
PUSH TP,[0] ;end of line, push zeros
|
||
PUSH TP,[0] ;end of line, push zeros
|
||
POPJ P,
|
||
|
||
;print a token
|
||
PTOKEN: SKIPN TDEBUG
|
||
POPJ P,
|
||
EXCH A,B
|
||
SKIPE A
|
||
PSOUT ;string part
|
||
EXCH A,B
|
||
JUMPE A,PCRLF
|
||
PBOUT ;terminator part
|
||
POPJ P,
|
||
PCRLF: MSG [
|
||
]
|
||
PSOUT
|
||
MOVEI A,0
|
||
POPJ P,
|
||
|
||
SUBTTL PARSE A TOKEN FROM INPUT LINE
|
||
;returns a/ break char, b/ ptr to token
|
||
GTOKEN: MOVE B,TOKPTR
|
||
GTOKE1: ILDB A,C
|
||
JUMPE A,RTERM
|
||
CAIG A,40
|
||
JRST GTOKE1 ;skip over leading junk
|
||
JRST RTOK3
|
||
RTOKEN: ILDB A,C
|
||
RTOK3: CAIG A,40
|
||
JRST RTERM
|
||
CAIE A,": ;label
|
||
CAIN A,"+ ;sum
|
||
JRST RTERM
|
||
CAIE A,"= ;definition
|
||
CAIN A,"/ ;then jump
|
||
JRST RTERM
|
||
CAIE A,"\ ;else jump
|
||
CAIN A,", ;separator
|
||
JRST RTERM
|
||
CAIE A,"> ;assignment
|
||
CAIN A,"' ;quoting
|
||
JRST RTERM
|
||
CAIN A,"; ;start of comment
|
||
JRST RCOMNT ; ignore comment
|
||
CAIN A,"" ;start of string
|
||
JRST RSTRNG ;read string
|
||
;else part of token
|
||
RTOK1: IDPB A,B ;build token
|
||
JRST RTOKEN ;loop
|
||
|
||
;here to read a string
|
||
RSTRNG: CAME B,TOKPTR ;anything read yet?
|
||
JRST RSTR3 ; yes
|
||
RSTR1: ILDB A,C
|
||
JUMPE A,[PUSHJ P,MORSTR
|
||
JRST RSTR1] ;need to read another line from file
|
||
CAIN A,"" ;end of string
|
||
JRST RSTRQ
|
||
RSTR2: IDPB A,B
|
||
JRST RSTR1
|
||
|
||
RSTR3: DPB C ;here if string bung up against other token
|
||
MOVEI A,40 ;fake a space
|
||
JRST RTERM ;and return
|
||
|
||
;here to check for ""
|
||
RSTRQ: MOVE 0,C
|
||
ILDB A,C
|
||
JUMPE A,[PUSHJ P,MORSTR
|
||
JRST RSTRQ]
|
||
CAIN A,""
|
||
JRST RSTR2 ;is ", ship it
|
||
MOVE C,0 ;restore bptr
|
||
MOVEI A,"" ;pretend was "
|
||
JRST RTERM ;not a ", return
|
||
|
||
;here to snarf another line for multi-line strings
|
||
MORSTR: PUSHJ P,RDLINE
|
||
JRST STRERR
|
||
MOVE C,[440700,,BUFFER]
|
||
POPJ P,
|
||
|
||
STRERR: MSG [String not terminated at eof.]
|
||
PUSHJ P,ERROR
|
||
POPJ P,
|
||
|
||
;here to read and ignore a comment
|
||
RCOMNT: MOVEI A,0
|
||
RTERM: CAMN B,TOKPTR
|
||
CAIN A,"" ;allow empty strings
|
||
SKIPA
|
||
JRST RNONE
|
||
MOVEI 0,0
|
||
IDPB 0,B ;asciz
|
||
EXCH B,TOKPTR
|
||
POPJ P,
|
||
|
||
;here for nothing read
|
||
RNONE: MOVEI B,0
|
||
POPJ P,
|
||
|
||
|
||
SUBTTL SYMBOL LOOKUP FOR CONSTANT TABLES
|
||
|
||
;takes: a/ symbol to lookup
|
||
;retns +2 won, b/ value
|
||
; +2 lost
|
||
LOOKUP: MOVNI C,1 ;low bound
|
||
MOVEI E,OPCNT ;high bound
|
||
LOOKLP: MOVE D,C
|
||
ADD D,E
|
||
TRZ D,1 ;make it an even number
|
||
MOVE B,OPS(D)
|
||
HRLI B,440700
|
||
PUSHJ P,COMPAR ; a/ token b/ table
|
||
JRST LOOKWN ; a=b
|
||
JRST LOOKLS ; a>b
|
||
LSH D,-1
|
||
MOVE C,D ; a<b
|
||
JRST LOOKND
|
||
|
||
LOOKLS: LSH D,-1
|
||
MOVE E,D
|
||
|
||
LOOKND: CAIGE C,-1(E)
|
||
JRST LOOKLP
|
||
POPJ P, ;lost, no skip
|
||
|
||
LOOKWN: MOVE B,OPS+1(D) ;return value
|
||
AOS (P)
|
||
POPJ P,
|
||
|
||
;compare two strings
|
||
;a/ token b/ table
|
||
;no skip: a=b
|
||
;+1 skip: a>b
|
||
;+2 skip: a<b
|
||
COMPAR: PUSH P,A
|
||
PUSH P,B
|
||
PUSH P,C
|
||
PUSH P,D
|
||
COMPA1: ILDB C,A
|
||
ILDB D,B
|
||
CAIN C,(D)
|
||
JRST COMEQU ;characters same
|
||
CAIL C,(D)
|
||
AOS -4(P) ;a>b
|
||
AOS -4(P) ;a<b
|
||
COMEXI: POP P,D
|
||
POP P,C
|
||
POP P,B
|
||
POP P,A
|
||
POPJ P,
|
||
|
||
COMEQU: JUMPE C,COMEXI ;if end of string, win
|
||
JRST COMPA1 ;else continue
|
||
|
||
LOOKER: MOVE F,[-OPCNT,,OPS]
|
||
LOOKIT: MOVE A,(F)
|
||
PSOUT
|
||
PUSHJ P,PCRLF
|
||
PUSHJ P,LOOKUP
|
||
HALTF
|
||
ADDI F,1
|
||
AOBJN F,LOOKIT
|
||
POPJ P,
|
||
|
||
SUBTTL SOME DEBUGGING ROUTINES
|
||
|
||
;used to make sure zpc and z are always in tandem
|
||
CHKZPC: PUSH P,A
|
||
PUSH P,Z
|
||
PUSH P,ZPC
|
||
HRRZ A,Z
|
||
SUBI A,OUTBUF
|
||
LSH A,2
|
||
HLRZ Z,Z
|
||
CAIN Z,441000
|
||
ADDI A,0
|
||
CAIN Z,341000
|
||
ADDI A,1
|
||
CAIN Z,241000
|
||
ADDI A,2
|
||
CAIN Z,141000
|
||
ADDI A,3
|
||
CAIN Z,41000
|
||
ADDI A,4
|
||
CAME A,ZPC
|
||
HALTF
|
||
POP P,ZPC
|
||
POP P,Z
|
||
POP P,A
|
||
POPJ P,
|
||
|
||
;here start printing goodies if pc has reached a certain value
|
||
STOPPE: CAMGE ZPC,STOP
|
||
POPJ P,
|
||
MOVEM ZPC,SAVZPC
|
||
MOVEM Z,SAVZ
|
||
MOVEI .PRIOU
|
||
MOVEM PDEBUG
|
||
SETZM STOP
|
||
POPJ P,
|
||
|
||
SUBTTL ASSEMBLE A LINE
|
||
|
||
ASSEM: SKIPE STOP ;supposed to stop sometime?
|
||
PUSHJ P,STOPPER ; yes, see if now
|
||
SETZM NOREF ;produce references
|
||
SETZM WRDBYT ;initially assume assembling word
|
||
|
||
;here to check that symbol pname tables haven't overflowed
|
||
MOVE C,LCLPTR
|
||
CAIL C,LCLTAB
|
||
HALTF
|
||
MOVE C,GLBPTR
|
||
CAIL C,GLBTAB
|
||
HALTF
|
||
;read and parse input line
|
||
MOVE C,[440700,,BUFFER] ;set up ptr to input buffer
|
||
PUSHJ P,GTLINE
|
||
MOVE TP,TPDL
|
||
ADD TP,[1,,1]
|
||
SKIPN (TP)
|
||
POPJ P, ;nothing on this line
|
||
|
||
;if frequency assembly, ignore all this foofaraw
|
||
SKIPE DOFREQ
|
||
JRST FREQ ;do something else instead
|
||
|
||
;label?
|
||
MOVE A,1(TP) ;get terminator
|
||
CAIE A,":
|
||
JRST AOP
|
||
;line starts with a label
|
||
SKIPN 2(TP) ;second token?
|
||
SKIPN 3(TP)
|
||
JRST LCLLBL ;empty line, more or less
|
||
MOVE A,3(TP) ;get terminator
|
||
CAIE A,":
|
||
JRST BDLBSY ;bad label syntax: foo:<x> for x not :
|
||
;global label
|
||
GLBLBL: SKIPE FZ ;time for function second pass?
|
||
PUSHJ P,FPASS2 ; yes
|
||
MOVE B,(TP) ;global label
|
||
MOVE C,ZPC ;label is current pc
|
||
PUSHJ P,DEFGLB ;define it
|
||
JRST BDMDGL ;multiply defined global label
|
||
NXTARG 2 ;move over label and colons
|
||
JRST AOP
|
||
;local label
|
||
LCLLBL: SKIPN A,FUNCT ;is there a function these days?
|
||
JRST GLBLBL ;else it might as well be a global
|
||
MOVE B,(TP) ;get token
|
||
MOVE C,ZPC ;label is current pc
|
||
PUSHJ P,DEFLCL ;define it
|
||
JRST BDMDLL ;multiply defined local label
|
||
NXTARG 1 ;move over local label
|
||
JRST AOP
|
||
|
||
BDLABL: MSG [Multiply defined label]
|
||
BDLAB1: MOVE B,(TP)
|
||
PUSHJ P,ERRMSG ;shout lossage
|
||
JRST AOP ;but continue
|
||
|
||
BDLBSY: MSG [Label followed by :, non-colon]
|
||
JRST BDLAB1
|
||
|
||
;here we have reached an opcode or pseudo after flushing label
|
||
AOP: SKIPN A,(TP)
|
||
SKIPE 1(TP)
|
||
SKIPA
|
||
POPJ P,
|
||
PUSHJ P,LOOKUP ;takes symbol in A
|
||
JRST AEQUAL ; not any sort of op.
|
||
JUMPL B,APSEUDO ;pseudo
|
||
JRST AOPER ;regular op
|
||
|
||
;here not oper or pseudo
|
||
|
||
;see if it's an atom=foo
|
||
AEQUAL: SKIPE A,1(TP)
|
||
CAIE A,"=
|
||
JRST AATOM
|
||
MOVE B,2(TP) ;value
|
||
PUSHJ P,FIXQ
|
||
JRST BDEQUA ;FOO=<non-fix>?
|
||
MOVE C,B
|
||
MOVE B,(TP)
|
||
PUSHJ P,DEFGLB
|
||
JRST BDEQU1 ;already defined?
|
||
SKIPN 4(TP)
|
||
SKIPE 5(TP)
|
||
JRST BDEQU2 ;too many args to equal?
|
||
POPJ P,
|
||
|
||
;see if it's an atom
|
||
AATOM: PUSHJ P,AWORD
|
||
JFCL
|
||
POPJ P,
|
||
|
||
SUBTTL ASSEMBLE WORDS AND BYTES
|
||
|
||
;get value of symbol
|
||
; returns A/ terminator B/ value
|
||
ALCL: PUSH P,C
|
||
MOVEI C,0 ;symbol is a zero
|
||
MOVE B,(TP)
|
||
PUSHJ P,REFLCL
|
||
MOVE B,SYMVAL(A)
|
||
JRST AGNEXT
|
||
|
||
AGET: PUSH P,C
|
||
MOVEI C,0 ;symbol is a zero
|
||
AGLOOP: MOVE B,(TP)
|
||
PUSHJ P,FIXQ
|
||
JRST [MOVE B,(TP)
|
||
PUSHJ P,REFSYM
|
||
SKIPGE B,SYMVAL(A)
|
||
MOVSI B,%UNDEF
|
||
JRST .+1]
|
||
AGNEXT: ADD C,B ;accumulate value
|
||
NXTARG 1
|
||
SKIPN A,-1(TP) ;terminator?
|
||
JRST AGEXI1 ;no skip if last thing on line
|
||
CAIN A,"+
|
||
JRST AGLOOP
|
||
AGEXIT: AOS -1(P)
|
||
AGEXI1: MOVE B,C
|
||
POP P,C
|
||
POPJ P,
|
||
|
||
AWORD: SETZM WRDBYT ;means working on word
|
||
PUSHJ P,AGET
|
||
SOS (P)
|
||
MOVE A,B
|
||
TLZ A,%BITS
|
||
PUSHJ P,OUTWRD
|
||
AOS (P)
|
||
POPJ P,
|
||
|
||
ABYTE: SETOM WRDBYT ;means working on byte
|
||
PUSHJ P,AGET
|
||
SOS (P)
|
||
MOVE A,B
|
||
TLZ A,%BITS
|
||
PUSHJ P,OUTBYT
|
||
AOS (P)
|
||
POPJ P,
|
||
|
||
|
||
SUBTTL OUTPUT WORDS
|
||
|
||
;output a word
|
||
; a/ word
|
||
OUTWRD: CAILE A,177777 ;check size
|
||
JRST WRDBIG ; lose, too big
|
||
OUTWR1: LSHC A,-8.
|
||
PUSHJ P,OUTBY1 ;output first byte
|
||
MOVEI A,0
|
||
ROTC A,8.
|
||
PUSHJ P,OUTBY1 ;output second byte
|
||
POPJ P,
|
||
|
||
;add a value to an already output word (used for fixups)
|
||
; a/ word
|
||
ADDWRD: CAILE A,177777 ;too big?
|
||
JRST WRDBIG ; yes, lose
|
||
LSHC A,-8.
|
||
PUSHJ P,ADDBYT ;add first byte
|
||
MOVEI A,0
|
||
ROTC A,8.
|
||
PUSHJ P,ADDBYT ;add second byte
|
||
POPJ P,
|
||
|
||
;output word reference
|
||
; a/ word
|
||
OUTWRF: CAILE A,177777 ;too big?
|
||
JRST WRDBIG ; yes, lose
|
||
LSHC A,-8.
|
||
PUSHJ P,OUTBY1
|
||
MOVEI A,0
|
||
ROTC A,8.
|
||
PUSHJ P,OUTBY1
|
||
POPJ P,
|
||
|
||
;error, word is too large
|
||
WRDBIG: MSG [Word too large]
|
||
PUSHJ P,ERROR
|
||
MOVEI A,0
|
||
JRST OUTWR1
|
||
|
||
SUBTTL OUTPUT BYTES
|
||
|
||
;output a byte
|
||
; a/ byte
|
||
OUTBYT: CAILE A,377 ;too big?
|
||
JRST BYTBIG ; too big, lose
|
||
;enter here to just output the byte directly
|
||
OUTBY1: IDPB A,Z ;output byte
|
||
ADDI ZPC,1 ;increment pc
|
||
HRRZ 0,(P)
|
||
SKIPN TABLE
|
||
SKIPE STRFLG'
|
||
POPJ P,
|
||
SKIPN PASS2
|
||
AOS CODLEN'
|
||
POPJ P,
|
||
|
||
;output byte reference
|
||
; a/ byte
|
||
OUTBRF: CAILE A,377 ;too big?
|
||
JRST BYTBIG ; yes, lose
|
||
PUSHJ P,OUTBY1
|
||
POPJ P,
|
||
|
||
;same as outbyt, but adds in new value (for fixup)
|
||
; a/ byte
|
||
ADDBYT: CAILE A,377
|
||
JRST BYTBIG
|
||
PUSH P,B
|
||
ILDB B,Z ;pick up current contents
|
||
ADD A,B ;add new stuff in
|
||
DPB A,Z ;put it back out
|
||
ADDI ZPC,1
|
||
POP P,B
|
||
POPJ P,
|
||
|
||
;here byte was too large (>255.)
|
||
BYTBIG: MSG [Byte too large]
|
||
PUSHJ P,ERROR
|
||
MOVEI A,0
|
||
JRST OUTBY1
|
||
|
||
SUBTTL PRINT BYTES AND PCS (FOR DEBUGGING)
|
||
|
||
OBYTE: PUSH P,A
|
||
PUSH P,B
|
||
PUSH P,C
|
||
MOVE B,A
|
||
MOVE A,PDEBUG
|
||
MOVEI C,8
|
||
HRLI C,(NO%LFL+NO%ZRO)+3
|
||
NOUT
|
||
JFCL
|
||
MOVEI B,"
|
||
BOUT
|
||
JRST POPCBA
|
||
|
||
OPC: PUSH P,A
|
||
PUSH P,B
|
||
PUSH P,C
|
||
MOVE B,SAVZPC
|
||
MOVE A,PDEBUG
|
||
MOVEI C,8
|
||
NOUT
|
||
JFCL
|
||
HRROI B,[ASCIZ !/ !]
|
||
MOVEI C,0
|
||
SOUT
|
||
OBYLUP: ILDB A,SAVZ
|
||
PUSHJ P,OBYTE
|
||
CAME Z,SAVZ
|
||
JRST OBYLUP
|
||
JRST POPCBA
|
||
|
||
SUBTTL VARIOUS ERRORS
|
||
|
||
BDMDGL: MSG [Multiply defined global label]
|
||
JRST BDERRO
|
||
BDMDLL: MSG [Multiply defined local label]
|
||
JRST BDERRO
|
||
BDMDLV: MSG [Multiply defined local variable]
|
||
JRST BDERRO
|
||
BDEQUA: MSG [Something assigned to non-fix]
|
||
JRST BDERRO
|
||
BDEQU1: MSG [Something already assigned]
|
||
JRST BDERRO
|
||
BDEQU2: MSG [Too many args to equal]
|
||
BDERRO: PUSHJ P,ERROR
|
||
POPJ P,
|
||
|
||
|
||
SUBTTL IS IT A FIX?
|
||
;given string pointer, skips if it's a number
|
||
;returns number in B
|
||
FIXQ: PUSH P,C
|
||
PUSH P,D
|
||
MOVE C,B
|
||
MOVEI B,0
|
||
SETZ D,
|
||
FIXQ1: ILDB A,C
|
||
JUMPE A,FIXEND
|
||
CAIN A,"-
|
||
JRST [SETO D,
|
||
JRST FIXQ1]
|
||
CAIL A,"0
|
||
CAILE A,"9
|
||
JRST [POP P,D
|
||
POP P,C
|
||
POPJ P,]
|
||
SUBI A,"0
|
||
IMULI B,10.
|
||
ADD B,A
|
||
JRST FIXQ1
|
||
|
||
FIXEND: CAILE B,177777
|
||
JRST FIXBIG
|
||
SKIPE D
|
||
MOVN B,B
|
||
ANDI B,177777
|
||
FIXEN1: POP P,D
|
||
POP P,C
|
||
JRST POPJ1
|
||
|
||
FIXBIG: MSG [Fix too big for a word]
|
||
PUSHJ P,ERROR
|
||
MOVE B,177777
|
||
JRST FIXEN1
|
||
|
||
SUBTTL PSEUDO-OPS
|
||
|
||
;dispatch for pseudo-ops
|
||
APSEUD: SKIPE FZ ;time for a function second pass?
|
||
PUSHJ P,FPASS2 ; yes, go do it
|
||
APSEU1: SETZM PASS2
|
||
HRRZ B,B
|
||
CAIN B,ZFUNCT ;if not .funct, skip
|
||
PUSHJ P,UNDLCL
|
||
JRST (B)
|
||
|
||
SUBTTL .END .INSERT AND .ENDI
|
||
|
||
;end of assembly
|
||
ZEND: MOVE A,IJFN
|
||
CLOSF
|
||
JRST ERPRNT
|
||
SETZM IJFN
|
||
POPJ P,
|
||
|
||
;insert another file
|
||
ZINSER: SKIPE OJFN
|
||
JRST ZINSIN
|
||
MOVE A,3(TP)
|
||
CAIE A,""
|
||
JRST ZINSTR ;not a string
|
||
MOVE A,IJFN
|
||
MOVEM A,OJFN
|
||
MOVE B,2(TP)
|
||
PUSHJ P,OPEN
|
||
MSG [Inserting ]
|
||
PUSHJ P,PFNAME
|
||
POPJ P,
|
||
|
||
ZINSIN: MSG [Already in .INSERT?]
|
||
PUSHJ P,ERROR
|
||
POPJ P,
|
||
|
||
ZINSTR: MSG [Argument to .INSERT not string?]
|
||
PUSHJ P,ERROR
|
||
POPJ P,
|
||
|
||
;end an insertion
|
||
ZENDI: SKIPN B,OJFN
|
||
JRST ZENDLS
|
||
MOVE A,IJFN
|
||
CLOSF
|
||
JRST ZENDCL
|
||
SETZM OJFN
|
||
MOVEM B,IJFN
|
||
POPJ P,
|
||
|
||
ZENDLS: MSG [.ENDI not in .INSERT?]
|
||
PUSHJ P,ERROR
|
||
POPJ P,
|
||
|
||
ZENDCL: MSG [.ENDI close failed?]
|
||
PUSHJ P,ERROR
|
||
POPJ P,
|
||
|
||
SUBTTL TABLES
|
||
|
||
ZTABLE: MOVEM ZPC,TABLE
|
||
SETOM TABLEN
|
||
NXTARG 1
|
||
SKIPN B,(TP)
|
||
POPJ P,
|
||
PUSHJ P,FIXQ
|
||
JRST ZTNOTF
|
||
MOVEM B,TABLEN
|
||
POPJ P,
|
||
|
||
ZTNOTF: MSG [Argument to .TABLE not fix]
|
||
PUSHJ P,ERROR
|
||
POPJ P,
|
||
|
||
ZENDT: SKIPN TABLE
|
||
JRST ZETNOT
|
||
SKIPGE A,TABLEN
|
||
JRST ZENDTX
|
||
ADD A,TABLE
|
||
CAML A,ZPC
|
||
JRST ZENDTX
|
||
MSG [Table too large]
|
||
PUSHJ P,ERROR
|
||
POPJ P,
|
||
|
||
ZENDTX: SETZM TABLE
|
||
SETZM TABLEN
|
||
POPJ P,
|
||
|
||
ZETNOT: MSG [.ENDT not after .TABLE]
|
||
PUSHJ P,ERROR
|
||
POPJ P,
|
||
|
||
ZEQUAL: SKIPN B,4(TP)
|
||
JRST ZEQTFA
|
||
PUSHJ P,FIXQ
|
||
JRST ZEQANF
|
||
MOVE C,B
|
||
PUSHJ P,DEFNAM
|
||
JRST ZEQMDG
|
||
POPJ P,
|
||
|
||
ZEQMDG: MSG [Already defined]
|
||
PUSHJ P,ERROR
|
||
POPJ P,
|
||
ZEQANF: MSG [Second argument to .EQUAL not fix]
|
||
PUSHJ P,ERROR
|
||
POPJ P,
|
||
ZEQTFA: MSG [Too few arguments to .EQUAL]
|
||
PUSHJ P,ERROR
|
||
POPJ P,
|
||
|
||
SUBTTL NAMED THINGS: FUNCTIONS, GLOBAL STRINGS, VARIABLES, OBJECTS
|
||
|
||
;define a named thing, value in C
|
||
DEFNAM: MOVE B,2(TP) ;pname
|
||
PUSHJ P,DEFGLB ;define symbol
|
||
JRST DEFMLT ;already defined
|
||
NXTARG 2 ;move over pseudo and name
|
||
AOS (P)
|
||
POPJ P,
|
||
;complain about multiply defined thing
|
||
DEFMLT: MSG [Multiply defined ]
|
||
MOVE B,(TP)
|
||
PUSHJ P,ERRMSG
|
||
POPJ P,
|
||
|
||
;force a word boundary
|
||
WRDBDY: TRNN ZPC,1
|
||
POPJ P,
|
||
PUSH P,A
|
||
MOVEI A,0
|
||
PUSHJ P,OUTBYT
|
||
POP P,A
|
||
POPJ P,
|
||
|
||
SUBTTL FUNCTIONS
|
||
|
||
ZFUNCT: PUSHJ P,WRDBDY ;force word boundary
|
||
SKIPN 2(TP)
|
||
JRST ZFNONE ;no name?
|
||
MOVE C,ZPC
|
||
LSH C,-1 ;functions are always on word bdy.
|
||
MOVEM C,FSYM ;save symbol value of last function
|
||
PUSHJ P,DEFNAM
|
||
POPJ P,
|
||
MOVE A,LSTSYM ;pick up last defined symbol
|
||
MOVEM A,FUNCT ;new function
|
||
;print functions and locs if asked for
|
||
SKIPE FDEBUG
|
||
PUSHJ P,PFUNCT
|
||
;here hack arguments
|
||
MOVEI D,0 ;current lval
|
||
MOVE E,Z ;save current bptr
|
||
IDPB D,Z ;start with zero
|
||
ADDI ZPC,1
|
||
ZFLOOP: SKIPN B,(TP) ;is there one?
|
||
JRST ZFDONE ;nope, done
|
||
ADDI D,1 ;bump arg count
|
||
MOVE C,D ;which local?
|
||
TLO C,%VAR
|
||
PUSHJ P,DEFLCL ;define it as a local
|
||
JRST BDMDLV
|
||
SKIPE A,1(TP)
|
||
CAIE A,"=
|
||
JRST ZFNEXT
|
||
NXTARG 1 ;move over variable name
|
||
SKIPN B,(TP)
|
||
JRST ZFNOEQ
|
||
PUSHJ P,AWORD ;assemble word
|
||
JFCL
|
||
JRST ZFLOOP
|
||
|
||
ZFNEXT: MOVEI A,0
|
||
PUSHJ P,OUTWRD ;bind it to 0
|
||
NXTARG 1 ;move over variable name
|
||
JRST ZFLOOP
|
||
|
||
ZFDONE: IDPB D,E ;now fake output of argument count
|
||
|
||
;save goodies for function pass two
|
||
;can be called on its own, be careful!
|
||
FMARK: MOVE A,IJFN
|
||
RFPTR
|
||
HALTF
|
||
MOVEM B,FPOS ;save file pointer
|
||
MOVEM Z,FZ ;save output pointer
|
||
MOVEM ZPC,FZPC ;save pc
|
||
MOVE A,SHRIMP
|
||
MOVEM A,OSHRIM
|
||
POPJ P,
|
||
|
||
ZFNONE: MSG [No name given to function?]
|
||
PUSHJ P,ERROR
|
||
POPJ P,
|
||
ZFNOEQ: MSG [Argument = not followed by value?]
|
||
PUSHJ P,ERROR
|
||
POPJ P,
|
||
|
||
;here to set up second pass over functions with short jumps
|
||
FPASS2: SKIPN TWOPASS ;skip if two pass assembly of functions
|
||
POPJ P, ;else return immediately
|
||
CAMN ZPC,FZPC
|
||
JRST [PUSHJ P,FMARK
|
||
POPJ P,]
|
||
SETOM PASS2
|
||
MOVE A,OSHRIM ;count of wasted long jumps
|
||
;CAML A,SHRIMP ; what it was when function started
|
||
;POPJ P, ;resume, false alarm
|
||
MOVEM A,SHRIMP
|
||
MOVE A,IJFN
|
||
MOVE B,FPOS
|
||
SFPTR
|
||
HALTF
|
||
MOVE Z,FZ
|
||
MOVEM Z,SAVZ ;fool debugging printer
|
||
MOVE ZPC,FZPC
|
||
SETZM FPOS ;file pointer of start of function
|
||
SETZM FZ ;z at start of function
|
||
SETZM FZPC ;zpc at start of function
|
||
SETZM FSHORT ;count of short jumps
|
||
POP P,0 ;flush call to fpass2
|
||
POPJ P, ;return from caller
|
||
|
||
;.FSTR -- like .GSTR but adds to table of frequent strings
|
||
ZFSTR: SKIPN A,4(TP)
|
||
JRST TFARG
|
||
PUSHJ P,WLOOK
|
||
SKIPA
|
||
JRST ZFDUP ;duplicate of frequent string? lose!
|
||
;here to add new string to table
|
||
MOVE A,TABPTR
|
||
TLNN A,400000
|
||
JRST [HRLI A,440700
|
||
ADDI A,1
|
||
JRST .+1]
|
||
MOVE H,A
|
||
MOVE B,4(TP)
|
||
MOVEI C,0
|
||
SOUT ;copy string to buffer
|
||
IDPB C,A
|
||
MOVEM A,TABPTR
|
||
;update table pointer
|
||
PUSH P,G
|
||
MOVE G,WRDTAB
|
||
SUB G,[2,,2]
|
||
MOVEM G,WRDTAB
|
||
POP P,G
|
||
;make a slot for new entry
|
||
HRRZ A,WRDTAB
|
||
HRLI A,2(A)
|
||
BLT A,-1(G)
|
||
;put out new entry
|
||
MOVEM H,-1(G) ;string
|
||
AOS H,FSTRS
|
||
MOVEM H,-2(G) ;count
|
||
CAIG H,96.
|
||
JRST ZFSTR1
|
||
MSG [Too many .FSTRs]
|
||
ZFERR: PUSHJ P,ERROR
|
||
POPJ P,
|
||
|
||
ZFDUP: MSG [Duplicate .FSTR]
|
||
JRST ZFERR
|
||
|
||
ZFSTR1: PUSHJ P,WRDBDY
|
||
MOVE C,ZPC
|
||
LSH C,-1
|
||
PUSHJ P,DEFNAM
|
||
POPJ P,
|
||
SKIPN A,(TP)
|
||
JRST TFARG
|
||
PUSHJ P,MAKSTR
|
||
POPJ P,
|
||
|
||
|
||
;.GSTR -- global string
|
||
ZGSTR: PUSHJ P,WRDBDY
|
||
MOVE C,ZPC
|
||
LSH C,-1
|
||
PUSHJ P,DEFNAM
|
||
POPJ P,
|
||
SKIPN A,(TP)
|
||
JRST TFARG
|
||
PUSHJ P,MAKFRQ
|
||
POPJ P,
|
||
|
||
ZGVAR: AOS GLBTOT
|
||
AOS C,GLBCNT
|
||
CAILE C,255. ;real high limit
|
||
JRST TMGLB
|
||
TLO C,%VAR
|
||
PUSHJ P,DEFNAM
|
||
POPJ P, ;multiply defined
|
||
PUSHJ P,AWORD
|
||
POPJ P,
|
||
POPJ P,
|
||
|
||
TMGLB: MSG [Too many globals]
|
||
PUSHJ P,ERROR
|
||
POPJ P,
|
||
|
||
ZOBJEC: AOS OBJTOT ;how many he tried to make
|
||
AOS C,OBJCNT
|
||
CAILE C,255.
|
||
JRST TMOBJ ;more than 255 objects
|
||
PUSHJ P,DEFNAM
|
||
POPJ P, ;multiply defined
|
||
;process parts of object line
|
||
PUSHJ P,AWORD
|
||
JRST TFAOBJ
|
||
PUSHJ P,AWORD ;flags
|
||
JRST TFAOBJ
|
||
PUSHJ P,ABYTE
|
||
JRST TFAOBJ
|
||
PUSHJ P,ABYTE
|
||
JRST TFAOBJ
|
||
PUSHJ P,ABYTE
|
||
JRST TFAOBJ
|
||
PUSHJ P,AWORD ;property table ptr
|
||
JRST TFAOBJ
|
||
POPJ P,
|
||
|
||
TFAOBJ: MSG [Too few arguments to .OBJECT]
|
||
PUSHJ P,ERROR
|
||
POPJ P,
|
||
|
||
TMOBJ: MSG [Too many objects]
|
||
PUSHJ P,ERROR
|
||
POPJ P,
|
||
|
||
ZLEN: POPJ P,
|
||
|
||
ZPDEF: PUSHJ P,WRDBDY ;guarantee word boundary
|
||
POPJ P,
|
||
|
||
ZPROP: SKIPN TABLE
|
||
JRST ZPROPL
|
||
NXTARG 1
|
||
PUSHJ P,AGET ;get property length
|
||
JFCL
|
||
TLZ B,%BITS
|
||
CAILE B,0
|
||
CAILE B,8
|
||
JRST ZPOFL ;property length out of range
|
||
MOVE C,B
|
||
PUSHJ P,AGET ;get property number
|
||
JFCL
|
||
TLZ B,%BITS
|
||
CAILE B,0
|
||
CAIL B,40
|
||
JRST ZPOFR ;property number out of range
|
||
SUBI C,1 ;length minus one
|
||
LSH C,5 ;left shifted
|
||
ADD C,B ;plus number
|
||
MOVE A,C
|
||
PUSHJ P,OUTBYT ;output it
|
||
POPJ P,
|
||
|
||
ZPOFR: MSG [Property out of range]
|
||
SKIPA
|
||
ZPOFL: MSG [Property length too long]
|
||
PUSHJ P,ERROR
|
||
POPJ P,
|
||
|
||
ZPROPL: MSG [Property definition not during table?]
|
||
PUSHJ P,ERROR
|
||
POPJ P,
|
||
|
||
ZSEQ: MOVEI D,0
|
||
NXTARG 1
|
||
ZSEQL: SKIPN B,(TP)
|
||
POPJ P,
|
||
MOVE C,D
|
||
PUSHJ P,DEFGLB
|
||
JRST ZSEMDG
|
||
ZSEQN: AOJA D,ZSEQL
|
||
|
||
ZSEMDG: MSG [Multiply defined global]
|
||
PUSHJ P,ERROR
|
||
JRST ZSEQN
|
||
|
||
|
||
SUBTTLE STRING PSEUDOS
|
||
|
||
ZSTR: SKIPN A,2(TP)
|
||
JRST TFARG
|
||
PUSHJ P,MAKFRQ
|
||
POPJ P,
|
||
|
||
ZSTRL: MOVEI A,0
|
||
PUSHJ P,OUTBYT
|
||
PUSH P,Z ;save bptr
|
||
PUSH P,ZPC ;save pc
|
||
PUSHJ P,ZSTR
|
||
POP P,A ;restore pc
|
||
POP P,B ;restore bptr
|
||
SUBM ZPC,A
|
||
TRNE A,1
|
||
ADDI A,1 ;round up
|
||
LSH A,-1 ;convert to words
|
||
DPB A,B ;output length of string
|
||
POPJ P,
|
||
|
||
ZZWORD: NXTARG 1
|
||
SKIPN A,(TP)
|
||
JRST TFARG
|
||
PUSHJ P,MAKWRD ;make a 6-char word
|
||
POPJ P,
|
||
|
||
TFARG: MSG [Too few arguments]
|
||
PUSHJ P,ERROR
|
||
POPJ P,
|
||
|
||
|
||
SUBTTL SIMPLE THINGS: TRUTH, WORDS, BYTES
|
||
|
||
ZTRUE: MOVEI A,1
|
||
PUSHJ P,OUTWRD
|
||
POPJ P,
|
||
|
||
ZFALSE: MOVEI A,0
|
||
PUSHJ P,OUTWRD
|
||
POPJ P,
|
||
|
||
ZWORD: NXTARG 1 ;flush .WORD
|
||
ZWORD1: PUSHJ P,AWORD
|
||
POPJ P,
|
||
SKIPN (TP)
|
||
SKIPE 1(TP)
|
||
JRST ZWORD1
|
||
POPJ P,
|
||
|
||
ZBYTE: NXTARG 1 ;flush .BYTE
|
||
ZBYTE1: PUSHJ P,ABYTE
|
||
POPJ P,
|
||
SKIPN (TP)
|
||
SKIPE 1(TP)
|
||
JRST ZBYTE1
|
||
POPJ P,
|
||
|
||
SUBTTL OPERAND ASSEMBLY
|
||
|
||
;assembly of real opers
|
||
AOPER: SETOM NOREF ;don't produce references, just do lookups
|
||
MOVEM B,OPER ;save operand (and bits!)
|
||
SETOM PRED ;not pred instruction
|
||
TLNE B,%PRED
|
||
SETZM PRED ; yes it is!
|
||
SETZM SENSE ;initialize jump sense
|
||
SETOM VAL ;not val instruction
|
||
TLNE B,%VAL
|
||
SETZM VAL ; yes it is!
|
||
MOVEI F,0 ;first count arguments
|
||
;set up buffer for arguments
|
||
MOVE AB,[ARGBUF,,ARGBUF+1]
|
||
SETOM ARGBUF
|
||
BLT AB,ARGBUF+12
|
||
MOVEI AB,ARGBUF
|
||
|
||
MOVE B,OPER
|
||
TLNE B,%JUMP ;don't skip if it's a jump
|
||
JRST AOPERJ
|
||
NXTARG 1 ;move over op
|
||
|
||
{;now hack arguments
|
||
AOPER1: SKIPN (TP)
|
||
SKIPE 1(TP)
|
||
SKIPA
|
||
JRST AOPERN ;done, no more args
|
||
MOVE A,1(TP) ;pick up terminator
|
||
;here for string
|
||
CAIE A,""
|
||
JRST AOPERQ
|
||
MOVE A,OPER
|
||
TLNN A,%STR ;must be string operator
|
||
JRST AOPSTR ;string given to non-string operator
|
||
HRRZ A,A
|
||
PUSHJ P,OUTBYT
|
||
MOVE A,(TP)
|
||
PUSHJ P,MAKFRQ
|
||
SKIPN 2(TP)
|
||
SKIPE 3(TP)
|
||
JRST TMAPRI
|
||
POPJ P,
|
||
|
||
TMAPRI: MSG [Too many arguments to PRINTI]
|
||
PUSHJ P,ERROR
|
||
POPJ P,
|
||
|
||
AOPSTR: MSG [String given to non-string operator?]
|
||
PUSHJ P,ERROR
|
||
POPJ P,
|
||
|
||
;here for quoted variable name
|
||
AOPERQ: CAIE A,"' ;quoted variable?
|
||
JRST AOPERP
|
||
ADDI F,1 ;that's an argument
|
||
NXTARG 1
|
||
SKIPN (TP)
|
||
JRST AOPQUT ;bad variable name
|
||
PUSHJ P,AGET
|
||
JFCL
|
||
TLNN B,%VAR
|
||
JRST AOPQUT
|
||
TLZ B,%VAR ;quoting devariablizes variables
|
||
JRST AOPOUT
|
||
|
||
AOPGET: PUSHJ P,AGET ;get value if any
|
||
JFCL
|
||
AOPOUT: MOVEM B,(AB) ;put out theory on arg
|
||
MOVE B,-2(TP)
|
||
MOVEM B,1(AB) ;put out symbol
|
||
ADDI AB,2
|
||
JRST AOPER1
|
||
|
||
;here arg is nothing special
|
||
AOPERC: AOJA F,AOPGET
|
||
|
||
AOPERJ: MOVEI G,0
|
||
JRST AOPERK
|
||
|
||
;here for predicate jump
|
||
AOPERP: CAIE A,"/ ;'then' predicate?
|
||
CAIN A,"\ ;'else' predicate?
|
||
SKIPA
|
||
JRST AOPERV
|
||
MOVEI G,0
|
||
CAIN A,"/
|
||
TRO G,100000
|
||
MOVEM G,SENSE
|
||
AOPERK: NXTARG 1
|
||
SKIPN (TP)
|
||
JRST AOPQUT ;bad variable name
|
||
PUSHJ P,ALCL ;get value if any
|
||
JFCL
|
||
MOVEM B,PRED
|
||
MOVE B,-2(TP)
|
||
MOVEM B,PRED+1
|
||
JRST AOPER1
|
||
|
||
;here for value variable
|
||
AOPERV: CAIE A,"> ;term. for assignment
|
||
JRST AOPERC
|
||
NXTARG 1
|
||
SKIPN (TP)
|
||
JRST AOPQUT ;bad variable name
|
||
PUSHJ P,AGET ;get value if any
|
||
JFCL
|
||
MOVEM B,VAL
|
||
MOVE B,-2(TP)
|
||
MOVEM B,VAL+1
|
||
JRST AOPER1
|
||
|
||
AOPQUT: MSG [Bad variable name after value or predicate]
|
||
PUSHJ P,ERROR
|
||
POPJ P,
|
||
|
||
;here we know how many args, so frotz with operand value appropriately
|
||
;f/ # of args.
|
||
AOPERN: SKIPE ODEBUG ;print theory of operator
|
||
PUSHJ P,OPRNT ; if odebug is non-zero
|
||
SKIPE TWOPASS ;if non two pass, then can make refs
|
||
SKIPE PASS2 ;can't make refs in pass 1
|
||
SETZM NOREF ;can make refs now
|
||
MOVEI AB,ARGBUF
|
||
MOVE B,OPER ;pick up operator
|
||
ANDI B,377 ;flush various funny bits
|
||
;dispatch on operand value
|
||
CAIL B,300 ;ext?
|
||
JRST OUTEXT ; yes, this one is always an ext
|
||
CAIL B,260 ;0op?
|
||
JRST OUT0OP ; yes
|
||
CAIL B,200 ;1op?
|
||
JRST OUT1OP ; yes
|
||
;falls through
|
||
|
||
;remainder are all 2op (but can be ext!)
|
||
OUT2OP: CAIE F,2
|
||
JRST TMA2OP
|
||
MOVEI C,0
|
||
MOVE A,(AB)
|
||
JUMPL A,CNVEXT ;if undefined, must be ext.
|
||
TLNE A,%VAR
|
||
JRST CHK1VR
|
||
CAIL A,0
|
||
CAIL A,400
|
||
JRST CNVEXT ;if long immediate, must be ext.
|
||
SKIPA ;arg 1 is immediate
|
||
CHK1VR: TRO B,100 ;arg 1 is a variable
|
||
CHK2ND: MOVE A,2(AB)
|
||
JUMPL A,CNVEXT ;if undefined, must be ext.
|
||
TLNE A,%VAR
|
||
JRST CHK2VR
|
||
CAIL A,0
|
||
CAIL A,400
|
||
JRST CNVEXT ;if long immediate, must be ext.
|
||
SKIPA ;arg 2 is immediate
|
||
CHK2VR: TRO B,40 ;arg 2 is a variable
|
||
|
||
;here it's really a 2op
|
||
MOVE A,B
|
||
PUSHJ P,OUTBYT ;output operator
|
||
HRRZ A,(AB)
|
||
PUSHJ P,OUTBYT
|
||
HRRZ A,2(AB)
|
||
PUSHJ P,OUTBYT
|
||
JRST OUTPV ;go do value and pred
|
||
|
||
;here if wrong number of arguments (might be 4 arg EQUAL?)
|
||
TMA2OP: MOVE B,OPER
|
||
TLNN B,%XARG ;4 arg equal?, so convert to ext.
|
||
JRST TMA2O1 ;real wna, too bad
|
||
|
||
;here to convert a 2op to an ext
|
||
CNVEXT: MOVE B,OPER
|
||
ADDI B,300 ;convert to ext
|
||
MOVEM B,OPER
|
||
ANDI B,377
|
||
MOVEI AB,ARGBUF
|
||
JRST OUTEXT
|
||
|
||
TMA2O1: MSG [Too many arguments to 2op]
|
||
PUSHJ P,ERROR
|
||
POPJ P,
|
||
|
||
;here to output a 1op instruction
|
||
OUT1OP: MOVE B,OPER
|
||
TLNE B,%JUMP ;special case jumps
|
||
JRST OUTJMP
|
||
CAIE F,1 ;one arg?
|
||
JRST TMA1OP ;no, lose!
|
||
MOVE A,(AB) ;pick up argument
|
||
TLNN A,%VAR ;variable?
|
||
JRST 1OPI ; no.
|
||
TRO B,40 ;variable arg bit
|
||
1OPBYT: EXCH A,B
|
||
HRRZ A,A
|
||
PUSHJ P,OUTBYT ;output oper
|
||
HRRZ A,B
|
||
PUSHJ P,OUTBYT ;output variable byte
|
||
JRST OUTPV
|
||
|
||
OUTJMP: JUMPG F,TMA1OP
|
||
HRRZ A,B
|
||
PUSHJ P,OUTBYT ;output it for now
|
||
MOVE B,OPER
|
||
JRST OUTP1
|
||
|
||
1OPI: CAIL A,0
|
||
CAIL A,400 ;will it fit in one word?
|
||
JRST 1OPNO
|
||
TRO B,20 ;immediate bit
|
||
JRST 1OPBYT ;output oper and imm. byte
|
||
|
||
1OPNO: EXCH A,B
|
||
HRRZ A,A
|
||
PUSHJ P,OUTBYT ;output oper.
|
||
JUMPL B,1OPREF
|
||
1OPNO1: HRRZ A,B
|
||
PUSHJ P,OUTWRD ;output long arg.
|
||
JRST OUTPV
|
||
|
||
;here single arg is reference to unknown
|
||
1OPREF: MOVE B,1(AB) ;must make an appropriate fixup
|
||
PUSHJ P,REFSYM
|
||
MOVE B,(AB) ;output what we have of value
|
||
JRST 1OPNO1
|
||
|
||
TMA1OP: MSG [Too many args to 1op instruction]
|
||
PUSHJ P,ERROR
|
||
POPJ P,
|
||
|
||
;here to output extended op
|
||
OUTEXT: CAILE F,4
|
||
JRST TMAEXT
|
||
MOVE A,B
|
||
PUSHJ P,OUTBYT ;operator
|
||
MOVEI A,0
|
||
PUSHJ P,OUTBYT ;ext byte (will be filled in later)
|
||
MOVE G,Z ;save output ptr
|
||
MOVEI D,0 ;ext byte under construction
|
||
MOVEI E,4 ;max arguments
|
||
;here loop through args to ext instruction
|
||
EXTLUP: MOVE A,(AB) ;get arg
|
||
TLNN A,%VAR ;variable?
|
||
JRST EXTIMM
|
||
TRO D,2 ;yes, turn on variable bit
|
||
EXTBYT: HRRZ A,A
|
||
PUSHJ P,OUTBYT ;output variable byte
|
||
JRST EXTNXT
|
||
EXTIMM: CAIL A,0 ;immediate?
|
||
CAIL A,400
|
||
JRST EXTLIM ;no, long
|
||
TRO D,1 ;turn on immediate bit
|
||
JRST EXTBYT ;output immediate byte
|
||
EXTLIM: JUMPL A,EXTREF ;undefined?
|
||
HRRZ A,A ;no, output full word
|
||
PUSHJ P,OUTWRD
|
||
JRST EXTNXT
|
||
|
||
EXTREF: MOVE B,1(AB)
|
||
PUSHJ P,REFSYM
|
||
HRRZ A,(AB)
|
||
PUSHJ P,OUTWRD
|
||
|
||
EXTNXT: SOJE E,EXTEXT ;if done four args, leave
|
||
SUBI F,1 ;reduce count
|
||
ADDI AB,2 ;move to next
|
||
LSH D,2 ;update ext byte
|
||
JUMPG F,EXTLUP ;if still args, do them
|
||
TRO D,3 ;turn on last arg bits
|
||
JRST EXTNXT ;if not, loop filling ext byte with 3
|
||
|
||
EXTEXT: DPB D,G ;output ext word
|
||
JRST OUTPV ;go output val and pred stuff
|
||
|
||
TMAEXT: MSG [Too many arguments to EXT instruction]
|
||
PUSHJ P,ERROR
|
||
POPJ P,
|
||
|
||
;here to output a 0op instruction
|
||
OUT0OP: JUMPG F,TMA0OP ;better not have any args!
|
||
MOVE A,B ;pick up operand from B
|
||
PUSHJ P,OUTBYT
|
||
|
||
;here to output value and predicate stuff for instructions
|
||
OUTPV: MOVE B,OPER
|
||
TLNN B,%VAL
|
||
JRST OUTP
|
||
MOVE A,VAL
|
||
CAMN A,[-1]
|
||
JRST NOVAL
|
||
JUMPL A,OUTVRF ;reference to value
|
||
HRRZ A,A
|
||
PUSHJ P,OUTBYT
|
||
|
||
OUTP: TLNN B,%PRED+%JUMP
|
||
POPJ P,
|
||
;comes here from outputting jump instruction
|
||
OUTP1: MOVE A,PRED
|
||
CAMN A,[-1]
|
||
JRST NOPRED
|
||
MOVE C,A
|
||
JUMPL A,OUTPRF ;reference to predicate
|
||
;produce jump offset
|
||
TRNN A,37776 ;check for /true /false jump
|
||
JRST OUTPSH ;short
|
||
SUB A,ZPC
|
||
TLNE B,%JUMP
|
||
ANDI A,177777 ;16 bit jump inst.
|
||
TLNN B,%JUMP
|
||
ANDI A,37777 ;14 bit pred. jumps
|
||
;determine whether short or long jump
|
||
CAIGE A,77 ;test if pred jump is short
|
||
JRST OUTPSH
|
||
CAMN B,OPJMP ;jump instruction can take larger "shorts"
|
||
CAIL A,377 ;small enough?
|
||
JRST OUTPLN ; no, long jump. sigh.
|
||
|
||
;short jump: <polarity>+<short=1>+<offset:6bits>
|
||
; such are always forward jumps of less than 64 bytes
|
||
OUTPSH: CAMN B,OPJMP
|
||
JRST OUTSJ ;output short jump byte
|
||
TRO A,100 ;short jump
|
||
MOVE C,SENSE
|
||
TRNE C,100000
|
||
TRO A,200 ;move jump sense to second byte
|
||
OUTPS1: ANDI A,377 ;and make it a byte
|
||
PUSHJ P,OUTBYT
|
||
POPJ P,
|
||
|
||
OUTSJ: PUSH P,A
|
||
HRRZ A,B
|
||
TRO A,20 ;turn on immediate bit
|
||
DPB A,Z
|
||
POP P,A
|
||
JRST OUTPS1
|
||
|
||
;long jump
|
||
OUTPLN: MOVE C,SENSE
|
||
TRNE C,100000
|
||
TRO A,100000
|
||
PUSHJ P,OUTWRD
|
||
POPJ P,
|
||
|
||
;here when predicate jump is a forward reference
|
||
OUTPRF: SETOM JMPREF ;say it's a jump reference
|
||
SKIPE TWOPAS
|
||
SKIPE FZ
|
||
JRST OUTPRL
|
||
HRRZ A,A ;get value part of ref
|
||
SUB A,ZPC
|
||
SUB A,FSHORT
|
||
TLNE B,%JUMP
|
||
ANDI A,177777 ;16 bit jump inst.
|
||
TLNN B,%JUMP
|
||
ANDI A,37777 ;14 bit pred. jumps
|
||
;determine whether short or long jump
|
||
TLNN B,%JUMP ;real jumps are always long
|
||
CAIL A,77 ;test if pred jump is short
|
||
JRST OUTPRL ;long jump. sigh.
|
||
;here short jump reference
|
||
MOVEI A,100 ;short jump
|
||
MOVE C,SENSE
|
||
TRNE C,100000
|
||
TRO A,200 ;move jump sense to second byte
|
||
HRRM A,PRED ;save it
|
||
;make the reference
|
||
SETOM WRDBYT ;say it's a byte ref
|
||
MOVE B,PRED+1
|
||
PUSHJ P,REFLCL
|
||
SETZM JMPREF
|
||
SETZM WRDBYT
|
||
;output the byte
|
||
HRRZ A,PRED
|
||
PUSHJ P,OUTBRF
|
||
AOS FSHORT
|
||
POPJ P,
|
||
|
||
OUTPRL: MOVE B,PRED+1
|
||
PUSHJ P,REFLCL ;all jumps are local
|
||
SETZM JMPREF
|
||
MOVE A,SENSE
|
||
PUSHJ P,OUTWRF ;output reference
|
||
POPJ P,
|
||
|
||
NOPRED: MSG [Predicate instruction lacks predicate]
|
||
PUSHJ P,ERROR
|
||
POPJ P,
|
||
|
||
OUTVRF: MSG [Value indefined]
|
||
SKIPA
|
||
NOVAL: MSG [Value instruction lacks value]
|
||
PUSHJ P,ERROR
|
||
POPJ P,
|
||
|
||
TMA0OP: MSG [Too many args to 0op instruction]
|
||
PUSHJ P,ERROR
|
||
POPJ P,
|
||
|
||
OPRNT: PUSH P,A
|
||
PUSH P,B
|
||
PUSH P,C
|
||
PUSH P,D
|
||
HRROI A,BUFFER
|
||
PSOUT
|
||
MOVEI A,^M
|
||
PBOUT
|
||
MOVEI A,^J
|
||
PBOUT
|
||
MOVEI D,0
|
||
OPLOOP: MOVE A,ARGBUF(D)
|
||
CAMN A,[-1]
|
||
JRST OPPV
|
||
MOVE A,ARGBUF+1(D)
|
||
PSOUT
|
||
MOVEI A,^I
|
||
PBOUT
|
||
MOVE B,ARGBUF(D)
|
||
PUSHJ P,NUM
|
||
PUSHJ P,CRLF
|
||
ADDI D,2
|
||
JRST OPLOOP
|
||
|
||
CRLF: MOVEI A,^M
|
||
PBOUT
|
||
MOVEI A,^J
|
||
PBOUT
|
||
POPJ P,
|
||
|
||
NUM: PUSH P,A
|
||
PUSH P,C
|
||
JUMPGE B,OPNV
|
||
MOVEI A,"?
|
||
PBOUT
|
||
MOVEI A,"
|
||
PBOUT
|
||
TLZ B,%UNDEF
|
||
OPNV: TLNN B,%VAR
|
||
JRST OPNUM
|
||
MOVEI A,"#
|
||
PBOUT
|
||
TLZ B,%VAR
|
||
OPNUM: MOVEI A,.PRIOU
|
||
MOVEI C,8.
|
||
NOUT
|
||
JFCL
|
||
POP P,C
|
||
POP P,A
|
||
POPJ P,
|
||
|
||
OPPV: MOVE A,VAL
|
||
CAMN A,[-1]
|
||
JRST OPPRED
|
||
MOVEI A,">
|
||
PBOUT
|
||
MOVE A,VAL+1
|
||
PSOUT
|
||
MOVEI A,^I
|
||
PBOUT
|
||
MOVE B,VAL
|
||
PUSHJ P,NUM
|
||
PUSHJ P,CRLF
|
||
OPPRED: MOVE B,PRED
|
||
CAMN B,[-1]
|
||
JRST OPPEX
|
||
MOVEI A,"\
|
||
MOVE B,SENSE
|
||
TRNE B,100000
|
||
MOVEI A,"/
|
||
PBOUT
|
||
MOVE A,PRED+1
|
||
PSOUT
|
||
MOVEI A,^I
|
||
PBOUT
|
||
MOVE B,PRED
|
||
PUSHJ P,NUM
|
||
PUSHJ P,CRLF
|
||
OPPEX: POP P,D
|
||
POP P,C
|
||
POP P,B
|
||
POP P,A
|
||
POPJ P,
|
||
|
||
|
||
SUBTTL SYMBOL HACKING
|
||
|
||
; symbols look like:
|
||
; SYMNAM <pname loc> ,, <next symbol>
|
||
; SYMVAL <value>
|
||
; SYMREF <references>
|
||
; where
|
||
; <value> if for a defined symbol
|
||
; includes
|
||
; %VAR,, if the symbol is for a variable (local or global)
|
||
; and
|
||
; <value> if for an undefined symbol
|
||
; includes
|
||
; %UNDEF,, <value if local label>
|
||
|
||
; a reference chain consists of
|
||
; <pc> ,, <next reference>
|
||
; <output ptr>
|
||
; where
|
||
; <pc> includes
|
||
; %RBYTE if the reference is a byte reference
|
||
; %RJUMP if the reference is a jump reference
|
||
|
||
;look up a symbol in a symbol list
|
||
; a/ symbol table, b/ symbol
|
||
; +1 a/ table loc of symbol, won
|
||
; +2 a/ potential table loc of symbol, lost
|
||
SLOOK: PUSH P,B
|
||
PUSH P,C
|
||
PUSH P,D
|
||
PUSH P,E
|
||
;hash the symbol
|
||
SETZ C,
|
||
HASH1: ILDB E,B
|
||
JUMPE E,HASH2
|
||
ROT C,3
|
||
XOR C,E
|
||
JRST HASH1
|
||
HASH2: TLZ C,400000
|
||
IDIVI C,BUCKN ;number of buckets to D
|
||
IMULI D,BUCKL ;length of buckets
|
||
HRL D,D
|
||
ADDM A,D
|
||
SKIPL D
|
||
HALTF ;symbol table overflow
|
||
;look for it
|
||
MOVE A,-3(P) ;pick up symbol being looked for
|
||
SLKLUP: SKIPN B,SYMNAM(D) ;symbol here?
|
||
JRST SLKLOS ; nothing here
|
||
HLR B,B
|
||
HRLI B,440700 ;produce byte pointer
|
||
PUSHJ P,COMPAR ;compare
|
||
JRST SLKWON ;same, win
|
||
JFCL
|
||
ADDI D,SYMSIZ ;move to next symbol
|
||
JRST SLKLUP ;and loop
|
||
|
||
SLKLOS: MOVE A,D ; rtn ptr to symbol slot in A
|
||
POP P,E
|
||
POP P,D
|
||
POP P,C
|
||
POP P,B
|
||
JRST POPJ1
|
||
|
||
SLKWON: HLR B,SYMNAM(D) ;found it, stuff it for future use
|
||
HRLI B,440700
|
||
MOVEM B,LSTSYM
|
||
MOVE A,D ; return ptr
|
||
POP P,E
|
||
POP P,D
|
||
POP P,C
|
||
POP P,B ; return ptr to cell
|
||
POPJ P,
|
||
|
||
; insert symbol in table
|
||
; a/ where (as returned by SLOOK)
|
||
; b/ symbol
|
||
; c/ value
|
||
SINSRT: PUSH P,A
|
||
PUSH P,B
|
||
PUSH P,C
|
||
PUSH P,D
|
||
HRLZM FREE,SYMNAM(A) ;symbol will be copied here
|
||
MOVEM C,SYMVAL(A) ;value
|
||
;copy symbol into appropriate symbol area
|
||
MOVE A,FREE
|
||
HRLI A,440700 ;bptr to output
|
||
MOVE D,A ;save a copy
|
||
SETZM (A) ;make sure its zero
|
||
MOVEM A,LSTSYM ;most recent symbol defn.
|
||
ILDB C,B
|
||
IDPB C,A
|
||
JUMPN C,.-2
|
||
CAMN A,D ;not a nul symbol?
|
||
HALTF ; should be no nul symbols
|
||
HRRZI FREE,1(A) ;update free pointer
|
||
POP P,D
|
||
POP P,C
|
||
POP P,B
|
||
POP P,A
|
||
POPJ P,
|
||
|
||
SUBTTL SYMBOL TABLE DEBUGGING
|
||
|
||
;print a symbol list, takes it in A
|
||
SPRNT: PUSH P,A
|
||
PUSH P,B
|
||
SKIPN B,A
|
||
JRST SPRNT2
|
||
SPRNT1: HLRZ A,SYMNAM(B)
|
||
JUMPE A,SPRNT3
|
||
HRLI A,-1
|
||
PSOUT
|
||
MOVEI A,"?
|
||
SKIPGE SYMVAL(B)
|
||
PBOUT ;? if undefined
|
||
MOVEI A,",
|
||
PBOUT
|
||
SPRNT3: HRRZ B,SYMNAM(B)
|
||
JUMPN B,SPRNT1
|
||
SPRNT2: HRROI A,[ASCIZ /
|
||
/]
|
||
PSOUT
|
||
POPBAJ: POP P,B
|
||
POP P,A
|
||
POPJ P,
|
||
|
||
;print the global symbol table
|
||
GPRNT: PUSH P,A
|
||
MOVE A,GLBLST
|
||
PUSHJ P,SPRNT
|
||
POP P,A
|
||
POPJ P,
|
||
|
||
;print the local symbol table
|
||
LPRNT: PUSH P,A
|
||
MOVE A,LCLLST
|
||
PUSHJ P,SPRNT
|
||
POP P,A
|
||
POPJ P,
|
||
|
||
SUBTTL INITIALIZE SYMBOL TABLES
|
||
|
||
;initialize global symbol table
|
||
GLBINI: PUSH P,A
|
||
MOVEI A,GLBBUF
|
||
MOVEM A,GLBPTR
|
||
SETZM GLBLST
|
||
SETZM GLBTAB
|
||
MOVE A,[GLBTAB,,GLBTAB+1]
|
||
BLT A,GLBEND
|
||
POP P,A
|
||
POPJ P,
|
||
|
||
;initialize local symbol table
|
||
LCLINI: PUSH P,A
|
||
PUSH P,B
|
||
PUSH P,C
|
||
MOVEI A,LCLBUF
|
||
MOVEM A,LCLPTR
|
||
SETZM LCLLST
|
||
SETZM LCLTAB
|
||
MOVE A,[LCLTAB,,LCLTAB+1]
|
||
BLT A,LCLEND
|
||
;local tables start with these three symbols in them
|
||
MOVE B,[440700,,[ASCIZ /FALSE/]]
|
||
MOVEI C,0
|
||
PUSHJ P,DEFLCL
|
||
JFCL
|
||
MOVE B,[440700,,[ASCIZ /TRUE/]]
|
||
MOVEI C,1
|
||
PUSHJ P,DEFLCL
|
||
JFCL
|
||
MOVE B,[440700,,[ASCIZ /STACK/]]
|
||
MOVSI C,%VAR
|
||
PUSHJ P,DEFLCL
|
||
JFCL
|
||
JRST POPCBA
|
||
|
||
SUBTTL PRINT UNDEFINED LOCALS
|
||
|
||
;print names of undefined locals in function
|
||
;done whenever a function is finished
|
||
UNDLCL: SKIPN FUNCT ;skip if was assembling a function
|
||
POPJ P,
|
||
PUSH P,A
|
||
PUSH P,B
|
||
PUSH P,C
|
||
PUSH P,D
|
||
MOVE C,LCLLST
|
||
UNDLC2: SKIPL D,SYMVAL(C) ;value slot
|
||
JRST UNDLC1 ;defined symbol
|
||
SKIPN A,FUNCT ;undefined symbol
|
||
JRST UNDLC3 ;don't print function name
|
||
PSOUT ;print function name
|
||
MSG [
|
||
]
|
||
PSOUT
|
||
SETZM FUNCT ;zero it since one print is enough
|
||
;here to print undefined symbol and pcs at which it is referenced
|
||
UNDLC3: MSG [ ]
|
||
PSOUT
|
||
HLRO A,SYMNAM(C) ;bptr to symbol
|
||
PSOUT
|
||
MSG [ undefined: ]
|
||
PSOUT
|
||
PUSH P,C
|
||
MOVEI C,10.
|
||
HRRZ D,SYMREF(C)
|
||
JRST UNDLC5
|
||
UNDLC4: MOVEI A,.PRIOU
|
||
HLRZ B,(D) ;pc at which referenced
|
||
TRZ B,%RBYTE+%RJUMP
|
||
NOUT ;output pc
|
||
JFCL
|
||
MSG [, ]
|
||
PSOUT
|
||
UNDLC5: HRRZ D,(D) ;move to next pc
|
||
JUMPN D,UNDLC4 ;and leave if last
|
||
PUSHJ P,PCRLF
|
||
POP P,C
|
||
|
||
UNDLC1: HRRZ C,SYMNAM(C) ;move to next symbol
|
||
JUMPN C,UNDLC2 ;or leave if it was last
|
||
;produce symbol table if asked
|
||
SKIPN SYMFLG
|
||
JRST UNDLCX
|
||
MOVE A,LCLLST
|
||
PUSHJ P,SYMTAB
|
||
MOVE B,FCNPTR
|
||
SUBI A,SYMBUF
|
||
MOVEM A,(B)
|
||
MOVE A,FSYM ;last function defined
|
||
MOVEM A,1(B)
|
||
ADDI B,2
|
||
MOVEM B,FCNPTR
|
||
|
||
;do rest of cleanup
|
||
UNDLCX: PUSHJ P,LCLINI ;reinit local symbol table
|
||
JRST POPDA
|
||
|
||
SUBTTL PRINT UNDEFINED GLOBALS
|
||
|
||
;print undefined globals
|
||
UNDGLB: PUSH P,A
|
||
PUSH P,B
|
||
PUSH P,C
|
||
PUSH P,D
|
||
MOVE C,GLBLST
|
||
UNDGL2: SKIPL D,SYMVAL(C) ;value slot
|
||
JRST UNDGL1
|
||
HLRO A,SYMNAM(C) ;bptr to symbol
|
||
PSOUT
|
||
MSG [ global undefined: ]
|
||
PSOUT
|
||
PUSH P,C
|
||
MOVEI C,10.
|
||
HRRZ D,SYMREF(C)
|
||
JRST UNDGL5
|
||
UNDGL4: MOVEI A,.PRIOU
|
||
HLRZ B,(D) ;pc at which referenced
|
||
TRZ B,%RBYTE+%RJUMP
|
||
NOUT ;output pc
|
||
JFCL
|
||
MSG [, ]
|
||
PSOUT
|
||
HRRZ D,(D) ;move to next pc
|
||
UNDGL5: JUMPN D,UNDGL4 ;and leave if last
|
||
PUSHJ P,PCRLF
|
||
POP P,C
|
||
UNDGL1: HRRZ C,SYMNAM(C) ;move to next symbol
|
||
JUMPN C,UNDGL2 ;or leave if it was last
|
||
|
||
;produce symbol table if was asked
|
||
SKIPN SYMFLG
|
||
JRST POPDA
|
||
MOVE A,GLBLST
|
||
PUSHJ P,SYMTAB
|
||
SUBI A,SYMBUF
|
||
MOVEM A,SYMBUF ;ptr to global symbol table
|
||
;sort function table and copy it into symbol area
|
||
MOVE A,FCNPTR
|
||
SETZM (A)
|
||
AOS FCNPTR
|
||
MOVEI A,FCNBUF
|
||
PUSHJ P,SSORT
|
||
HRLI A,FCNBUF
|
||
HRR A,SYMPTR
|
||
SUBI A,SYMBUF
|
||
HRRZM A,SYMBUF+1 ;ptr to function symbol table
|
||
ADDI A,SYMBUF
|
||
MOVE B,FCNPTR
|
||
SUBI B,FCNBUF
|
||
ADD B,SYMPTR
|
||
MOVEM B,SYMPTR
|
||
BLT A,(B)
|
||
|
||
;output symbols file
|
||
OUTSYM: MOVE A,[440700,,[ASCIZ /.SYMS/]]
|
||
MOVE B,OUTPTR
|
||
ILDB 0,A
|
||
IDPB 0,B
|
||
JUMPN 0,.-2
|
||
MOVSI A,(GJ%SHT+GJ%FOU)
|
||
HRROI B,OUTFIL
|
||
GTJFN
|
||
JRST ERPRNT
|
||
HRRZ A,A
|
||
MOVE B,[440000,,OF%WR]
|
||
OPENF
|
||
JRST ERPRNT
|
||
MOVE B,[444400,,SYMBUF]
|
||
MOVEI C,SYMBUF
|
||
SUB C,SYMPTR
|
||
SOUT
|
||
;close up and go home
|
||
CLOSF
|
||
JFCL
|
||
|
||
POPDA: POP P,D
|
||
JRST POPCBA
|
||
|
||
SUBTTL OUTPUT SYMBOL TABLES
|
||
|
||
SYMTAB: PUSH P,B
|
||
PUSH P,C
|
||
PUSH P,D
|
||
MOVE C,A
|
||
MOVE D,A
|
||
;copy strings
|
||
SYMCPY: HLR A,SYMNAM(C)
|
||
HRLI A,440700
|
||
HRRZ B,SYMPTR
|
||
SUBI B,SYMBUF
|
||
HRLM B,SYMNAM(C)
|
||
ADDI B,SYMBUF
|
||
HRLI B,440700
|
||
ILDB A
|
||
IDPB B
|
||
JUMPN .-2
|
||
HRRZI B,1(B)
|
||
MOVEM B,SYMPTR
|
||
HRRZ C,(C)
|
||
JUMPN C,SYMCPY
|
||
MOVE C,D
|
||
;copy symbols themselves
|
||
SYMCP1: HLR A,SYMNAM(C)
|
||
HRLI A,440700
|
||
MOVEM A,(B)
|
||
MOVE A,SYMVAL(C)
|
||
MOVEM A,1(B)
|
||
ADDI B,2
|
||
HRRZ C,(C)
|
||
JUMPN C,SYMCP1
|
||
SETZM (B)
|
||
ADDI B,1
|
||
EXCH B,SYMPTR
|
||
MOVE A,B
|
||
PUSHJ P,SSORT ;sort the table
|
||
POP P,D
|
||
POP P,C
|
||
POP P,B
|
||
POPJ P,
|
||
|
||
;sort a symbol table by value words
|
||
; a/ ptr to symbol table
|
||
SSORT: PUSH P,A
|
||
PUSH P,B
|
||
PUSH P,C
|
||
PUSH P,D
|
||
SSORT1: SKIPN (A)
|
||
JRST POPDA
|
||
MOVE C,A ;save destination
|
||
MOVE D,A ;ptr to best candidate
|
||
SSORT0: ADDI A,2 ;ptr to first test
|
||
SKIPN (A) ;better be a test...
|
||
JRST SSORT2 ; zero, end of table
|
||
MOVE B,1(D)
|
||
CAMLE B,1(A) ;test better than best?
|
||
MOVE D,A ;new best
|
||
JRST SSORT0 ;move to next
|
||
|
||
SSORT2: CAMN D,C ;must move one?
|
||
JRST SSORT3
|
||
MOVE A,(D)
|
||
EXCH A,(C)
|
||
MOVEM A,(D)
|
||
MOVE A,1(D)
|
||
EXCH A,1(C)
|
||
MOVEM A,1(D)
|
||
SSORT3: MOVEI A,2(C)
|
||
JRST SSORT1
|
||
|
||
SUBTTL GLOBAL SYMBOL REFERENCE AND DEFINITION
|
||
|
||
DEFGLB: MOVE A,GLBOBL ;look it up in global symbol table
|
||
PUSHJ P,SLOOK
|
||
JRST DEFOLD ;already there
|
||
;symbol not in global table
|
||
INSGLB: MOVE FREE,GLBPTR
|
||
PUSHJ P,SINSRT ;insert it
|
||
MOVEM FREE,GLBPTR
|
||
HRR 0,GLBLST ;chain together all globals
|
||
HRRM 0,(A)
|
||
MOVEM A,GLBLST ;by consing into a list
|
||
SKIPN SDEBUG
|
||
JRST POPJ1
|
||
;print symbol table here if debugging
|
||
PUSH P,A
|
||
MOVE A,GLBLST
|
||
PUSHJ P,SPRNT
|
||
POP P,A
|
||
JRST POPJ1
|
||
|
||
;here to define a symbol that already has been referenced
|
||
DEFOLD: MOVE B,A ;move ptr to symbol
|
||
SKIPL SYMVAL(B) ;is it undefined?
|
||
JRST CPOPJ ; if defined, lose
|
||
MOVE A,C ;save value
|
||
MOVEM C,SYMVAL(B) ;define it
|
||
MOVE C,SYMREF(B) ;pick up reference chain to C
|
||
PUSHJ P,FIXUP ;fix up references already accumulated
|
||
JRST POPJ1
|
||
|
||
SUBTTL LOCAL SYMBOL REFERENCE AND DEFINITION
|
||
|
||
DEFLCL: MOVE A,LCLOBL ;look it up in local symbol table
|
||
PUSHJ P,SLOOK
|
||
JRST DEFOLL ;here for forward references
|
||
;here to add symbol to local symbol table
|
||
INSLCL: MOVE FREE,LCLPTR
|
||
PUSHJ P,SINSRT
|
||
MOVEM FREE,LCLPTR
|
||
HRR 0,LCLLST
|
||
HRRM 0,(A)
|
||
MOVEM A,LCLLST
|
||
JRST POPJ1
|
||
|
||
;here to define already referenced local symbol
|
||
DEFOLL: SKIPN TWOPAS
|
||
JRST DEFOLD
|
||
SKIPN PASS2 ;only do fixups if pass 2
|
||
JRST DEFOL1 ; do usual thing in pass 1
|
||
;do hair in pass 2
|
||
MOVEM C,SYMVAL(A) ;redefine local label
|
||
;fix up for short jumps
|
||
MOVE C,SYMREF(A) ;get reference chain
|
||
MOVE A,SYMVAL(A) ;get value to be fixed up
|
||
PUSHJ P,FIXUP
|
||
JRST POPJ1
|
||
|
||
;here to "define" local symbol during pass one
|
||
DEFOL1: MOVE B,A
|
||
SKIPL SYMVAL(B) ;should be undefined
|
||
JRST CPOPJ ; if defined, lose
|
||
MOVE A,C ;save value
|
||
HRRM C,SYMVAL(B) ;pretend to define it
|
||
JRST POPJ1
|
||
|
||
BPASS2: MSG [Label inconsistency, pass 2]
|
||
PUSHJ P,ERROR
|
||
JRST POPJ1
|
||
|
||
|
||
SUBTTL REFERENCE AND DEFINE SYMBOLS
|
||
|
||
;reference a symbol
|
||
; takes b/ symbol
|
||
; returns a/ ptr to cell for symbol
|
||
REFSYM: PUSH P,B
|
||
PUSH P,C
|
||
MOVE A,LCLOBL ;look up as local first
|
||
PUSHJ P,SLOOK
|
||
JRST [SKIPL SYMVAL(A) ;skip if undefined
|
||
JRST POPCB ;has a value, return it
|
||
JRST REFLLD] ;refer to old local
|
||
MOVE A,GLBOBL
|
||
MOVE B,-1(P)
|
||
PUSHJ P,SLOOK
|
||
JRST [SKIPL SYMVAL(A)
|
||
JRST POPCB ;has a gval, return it
|
||
JRST REFGLD] ;refer to old global
|
||
MOVE B,-1(P)
|
||
PUSHJ P,REFGLB
|
||
POPCB: POP P,C
|
||
POP P,B
|
||
POPJ P,
|
||
|
||
;reference a global
|
||
; b/ symbol
|
||
REFGLB: PUSH P,B
|
||
PUSH P,C
|
||
MOVE A,GLBOBL
|
||
MOVE B,-1(P)
|
||
PUSHJ P,SLOOK
|
||
JRST REFGLD ;refer to old global
|
||
MOVE B,-1(P)
|
||
HRLZI C,%UNDEF ;undefined
|
||
PUSHJ P,INSGLB
|
||
HALTF
|
||
REFGLD: SKIPE NOREF
|
||
JRST POPCB
|
||
MOVE FREE,GLBPTR
|
||
HRRZ B,SYMREF(A) ;get pc chain
|
||
HRRM FREE,SYMREF(A) ;and put new cell in symbol cell
|
||
SKIPE WRDBYT
|
||
TLO B,%RBYTE ;indicate byte reference
|
||
MOVEM B,(FREE)
|
||
MOVEM ZPC,1(FREE) ;pc
|
||
MOVEM Z,2(FREE) ;bptr
|
||
ADDI FREE,3
|
||
MOVEM FREE,GLBPTR
|
||
JRST POPCB
|
||
|
||
;reference a local
|
||
; b/ symbol
|
||
REFLCL: PUSH P,B
|
||
PUSH P,C
|
||
MOVE A,LCLOBL
|
||
MOVE B,-1(P)
|
||
PUSHJ P,SLOOK
|
||
JRST REFLLD ;refer to old local
|
||
MOVE B,-1(P)
|
||
HRLZI C,%UNDEF ;undefined
|
||
PUSHJ P,INSLCL
|
||
HALTF
|
||
REFLLD: SKIPE NOREF
|
||
JRST POPCB
|
||
MOVE FREE,LCLPTR ;get free storage from local area
|
||
HRRZ B,SYMREF(A) ;get ptr to reference chain
|
||
HRRM FREE,SYMREF(A) ;and update chain ptr
|
||
SKIPE WRDBYT
|
||
TLO B,%RBYTE
|
||
SKIPE JMPREF
|
||
TLO B,%RJUMP ;indicate jump reference
|
||
MOVEM B,(FREE) ;put it in right half of new ref
|
||
MOVEM ZPC,1(FREE) ;put out pc of ref
|
||
MOVEM Z,2(FREE) ;put of bptr of ref
|
||
ADDI FREE,3
|
||
MOVEM FREE,LCLPTR ;update free ptr
|
||
JRST POPCB
|
||
|
||
SUBTTL FIXUPS
|
||
|
||
;fixup forward references
|
||
; a/ value
|
||
; c/ ptr chain
|
||
FIXUP: TRNN C,-1 ;if empty fixup chain, return immediately
|
||
POPJ P, ; only happens for local labels
|
||
PUSH P,SAVZPC
|
||
PUSH P,SAVZ
|
||
PUSH P,ZPC
|
||
PUSH P,Z ;fix up references
|
||
PUSH P,A
|
||
FIXUPL: HRRZ A,(P) ;pick up value to output
|
||
MOVE Z,2(C) ;pick up reference output ptr
|
||
MOVEM Z,SAVZ
|
||
MOVE ZPC,1(C)
|
||
MOVEM ZPC,SAVZPC
|
||
MOVE B,(C)
|
||
TLNE B,%RJUMP ;jump ref?
|
||
JRST FIXUPJ ; yes
|
||
JUMPGE B,[PUSHJ P,ADDWRD
|
||
JRST FIXUPN]
|
||
PUSHJ P,ADDBYT
|
||
FIXUPN: SKIPE PDEBUG
|
||
PUSHJ P,PFIXUP
|
||
HRRZ C,(C) ;move to next one
|
||
JUMPN C,FIXUPL
|
||
FIXUPX: POP P,A
|
||
POP P,Z
|
||
POP P,ZPC
|
||
POP P,SAVZ
|
||
POP P,SAVZPC
|
||
POPJ P,
|
||
|
||
;here to fix up jumps
|
||
FIXUPJ: MOVE 1(C) ;pc of ref
|
||
SUB A,0 ;pc difference (true/false and pc diff cancel?)
|
||
TLNE B,%RBYTE ;byte ref?
|
||
JRST FIXSHJ ; means short jump
|
||
ANDI A,177777 ;and it down (two's comp.)
|
||
CAIGE A,77 ;skip if couldn't have been short
|
||
AOS SHRIMP ;keep count of short jumps
|
||
PUSHJ P,ADDWRD
|
||
MOVE A,(P) ;get value back
|
||
JRST FIXUPN ;and continue
|
||
|
||
;here to fix up short jumps
|
||
FIXSHJ: ADDI A,1 ;pc offset
|
||
ANDI A,177777 ;max size of a reference
|
||
CAILE A,77 ;can it be a short jump?
|
||
HALTF ; better be!
|
||
ANDI A,377 ;and it down just ofr good measure
|
||
PUSHJ P,ADDBYT ;output byte
|
||
MOVE A,(P) ;resnarf value
|
||
JRST FIXUPN ;and loop
|
||
|
||
;when debugging, print fixups when they are done
|
||
PFIXUP: PUSH P,A
|
||
PUSH P,B
|
||
PUSH P,C
|
||
MOVE A,PDEBUG
|
||
MOVEI B,"{
|
||
BOUT
|
||
PUSHJ P,OPC
|
||
MOVEI C,0
|
||
HRROI B,[ASCIZ /}
|
||
/]
|
||
SOUT
|
||
JRST POPCBA
|
||
|
||
SUBTTL ERROR MESSAGES
|
||
|
||
ERROR: PUSH P,B
|
||
SETZ B,
|
||
PUSHJ P,ERRMSG
|
||
POP P,B
|
||
POPJ P,
|
||
|
||
;takes message in A, token in B
|
||
ERRMSG: PUSH P,A
|
||
PUSH P,B
|
||
PUSH P,C
|
||
MOVEI A,.PRIOU
|
||
MOVE B,ZPC
|
||
MOVEI C,8
|
||
NOUT
|
||
JFCL
|
||
SKIPN FUNCT
|
||
JRST ERRMS1
|
||
MSG [ (in ]
|
||
PSOUT
|
||
MOVE A,FUNCT
|
||
PSOUT
|
||
MSG [)]
|
||
PSOUT
|
||
ERRMS1: MSG [ ]
|
||
PSOUT
|
||
MOVE A,-2(P)
|
||
PSOUT
|
||
MOVE B,-1(P)
|
||
JUMPE B,ERREND
|
||
MOVEI A,[ASCIZ /: /]
|
||
PSOUT
|
||
MOVE A,B
|
||
PSOUT
|
||
PUSHJ P,PCRLF
|
||
HRROI A,BUFFER
|
||
PSOUT
|
||
SKIPA
|
||
ERREND: PUSHJ P,PCRLF
|
||
POP P,C
|
||
POP P,B
|
||
POP P,A
|
||
POPJ P,
|
||
|
||
SUBTTL STRING ASSEMBLY
|
||
|
||
;zstrings from strings
|
||
; a/ ptr to string to translate
|
||
MAKFRQ: SETOM FREQST
|
||
MOVEI H,-1
|
||
JRST MAKST1
|
||
|
||
MAKWRD: MOVEI H,2 ;count of words allowed (six chars max)
|
||
SETZM FREQST ;not frequency string
|
||
JRST MAKST1
|
||
|
||
MAKSTR: MOVEI H,-1 ;many words allowed
|
||
SETZM FREQST ;not frequency string
|
||
|
||
MAKST1: SETOM STRFLG
|
||
SKIPE CDEBUG
|
||
PUSHJ P,CSTRNG
|
||
MOVEI D,0 ;char set
|
||
MOVEI E,3 ;"old" character set
|
||
MOVEM E,ZCSET ;save it away
|
||
ZSTRW: MOVEI F,0 ;build words here
|
||
MOVEI G,3 ;count of chars in word
|
||
ZSTRLP: MOVE B,A
|
||
ILDB C,B ;pick up next character
|
||
CAIN C,^J
|
||
JRST [MOVE A,B
|
||
JRST ZSTRLP] ;linefeeds ignored
|
||
JUMPE C,ZSTRND ;leave if zero
|
||
JRST ZCHAR
|
||
|
||
;here to output a character
|
||
ZOUT: SKIPE CDEBUG
|
||
PUSHJ P,COUT
|
||
LSH F,5 ;5 bits wide
|
||
ADD F,C ;add in new character
|
||
SOJG G,ZSTRLP ;loop if haven't filled a word
|
||
PUSHJ P,OUTSTW ;put word out
|
||
SOJG H,ZSTRW ;loop if haven't counted out words
|
||
|
||
ZSTRND: CAIG H,2 ;building string or word?
|
||
JRST ZWRDND ; word
|
||
CAIN G,3 ; string
|
||
JRST ZSTRTG
|
||
ZSTRN1: LSH F,5
|
||
ADDI F,5
|
||
SOJG G,ZSTRN1
|
||
PUSHJ P,OUTSTW
|
||
ZSTRTG: LDB G,LSTRWD
|
||
TRO G,200
|
||
DPB G,LSTRWD
|
||
SETZM STRFLG
|
||
POPJ P,
|
||
|
||
ZWRDND: JUMPE H,ZSTRTG
|
||
LSH F,5
|
||
ADDI F,5
|
||
SOJG G,ZWRDND
|
||
PUSHJ P,OUTSTW
|
||
;reset counter and string
|
||
MOVEI G,3
|
||
MOVEI F,0
|
||
SOJG H,ZWRDND
|
||
JRST ZSTRTG
|
||
|
||
;here to do character set changes
|
||
ZCHAR: PUSHJ P,ZCS ;get set for character
|
||
SKIPE FREQST ;don't do this hair if not GSTR or PRINTI string
|
||
CAIG H,4 ;assembling string?
|
||
JRST ZCHAR1 ;no, word, ignore freq. junk
|
||
; CAIN C,40
|
||
; JRST ZCHARS
|
||
; CAIG E,1
|
||
; CAML E,ZCSET
|
||
; JRST ZCHAR1
|
||
; MOVE 0,ZCSET
|
||
; CAIG 0,1
|
||
; JRST ZCHAR1
|
||
ZCHARS: PUSHJ P,WFREQ ;takes string in a, returns ptr in a
|
||
JRST ZCHAR1
|
||
;word is in frequency table
|
||
LSH F,5
|
||
PUSH P,D
|
||
IDIVI C,32.
|
||
ADDI F,1(C) ; get the right table
|
||
MOVE C,D ; remainder is output next
|
||
POP P,D
|
||
SKIPE CDEBUG
|
||
JRST [PUSH P,C
|
||
MOVEI C,1
|
||
PUSHJ P,COUT
|
||
POP P,C
|
||
JRST .+1]
|
||
SOJG G,ZOUT
|
||
PUSHJ P,OUTSTW
|
||
MOVEI F,0
|
||
MOVEI G,3
|
||
JRST ZOUT
|
||
|
||
ZCHAR1: MOVE A,B
|
||
MOVEM E,ZCSET
|
||
CAIN E,3
|
||
JRST [MOVEI C,0
|
||
JRST ZOUT]
|
||
CAMN D,E ;same as current?
|
||
JRST ZCC
|
||
;next char is different set, see if next-next is the same
|
||
MOVE B,A ;see if next-next character is same different set
|
||
ZNEXT: ILDB 0,B ;get next-next
|
||
JUMPE 0,ZCHCS ;no next-next character
|
||
CAIN 0,^J
|
||
JRST ZNEXT ;linefeeds don't count
|
||
PUSH P,C ;save next char
|
||
PUSH P,E ; and its set
|
||
MOVE C,0 ;get next-next
|
||
PUSHJ P,ZCS ;set for next-next
|
||
;decide whether to change set temp. or perm.
|
||
|
||
JRST ZCHCST
|
||
|
||
;code for permanent shifting rests in peace below
|
||
;some day it may be resurrected (consult the ZIP document)
|
||
|
||
CAME E,(P) ;same set as next?
|
||
JRST ZCHCST ; go change temporarily
|
||
ZCHCSP: POP P,E ;new permanent char set
|
||
POP P,C ;char
|
||
;calculate byte for new permanent set
|
||
PUSH P,H
|
||
EXCH D,E
|
||
SUBM D,E
|
||
MOVE H,E
|
||
ADDI H,3
|
||
IDIVI H,3
|
||
ADDI I,3
|
||
POP P,H ;new perm. set in I
|
||
|
||
;output set change byte
|
||
ZOUTB: SKIPE CDEBUG
|
||
JRST [PUSH P,C ;save next char
|
||
MOVE C,I
|
||
PUSHJ P,COUT
|
||
POP P,C
|
||
JRST .+1]
|
||
LSH F,5
|
||
ADD F,I ;output new char set.
|
||
SOJG G,ZCC
|
||
;output this word and then continue
|
||
PUSHJ P,OUTSTW
|
||
SOJE H,CPOPJ ;end for zwords
|
||
MOVEI F,0
|
||
MOVEI G,3
|
||
JRST ZCC
|
||
|
||
;calculate byte for temporary set
|
||
ZCHCST: POP P,E ;temporary char set
|
||
POP P,C
|
||
|
||
;;ZCHCS: PUSH P,H
|
||
|
||
ZCHCS: MOVEI I,3(E)
|
||
JRST ZOUTB
|
||
|
||
;hairy shift code removed
|
||
|
||
;; SUB E,D
|
||
;; MOVE H,E
|
||
;; ADDI H,3
|
||
;; IDIVI H,3
|
||
;; ADDI I,1
|
||
;; POP P,H
|
||
;; JRST ZOUTB
|
||
|
||
ZCC: PUSHJ P,ZCB ;get byte
|
||
JRST ZOUT ;winning char
|
||
;here for characters not in the normal set
|
||
ZASCII: LSH F,5
|
||
ADDI F,6 ;add in ascii escape byte
|
||
SKIPE CDEBUG
|
||
JRST [PUSH P,C
|
||
MOVEI C,6
|
||
PUSHJ P,COUT
|
||
POP P,C
|
||
JRST .+1]
|
||
SOJG G,ZASCI1
|
||
PUSHJ P,OUTSTW
|
||
SOJE H,CPOPJ ;end for zwords
|
||
MOVEI F,0
|
||
MOVEI G,3
|
||
ZASCI1: MOVE B,C
|
||
LSH B,-5
|
||
LSH F,5
|
||
ADD F,B
|
||
SKIPE CDEBUG
|
||
JRST [PUSH P,C
|
||
MOVE C,B
|
||
PUSHJ P,COUT
|
||
POP P,C
|
||
JRST .+1]
|
||
SOJG G,ZASCI2
|
||
PUSHJ P,OUTSTW
|
||
SOJE H,CPOPJ ;end for zwords
|
||
MOVEI F,0
|
||
MOVEI G,3
|
||
ZASCI2: ANDI C,37
|
||
JRST ZOUT
|
||
|
||
|
||
;lookup word in word table
|
||
; a/ word
|
||
; +1: not found, loc to add in (A)
|
||
; +2: found, word is at (A)
|
||
|
||
WFREQ: PUSH P,B
|
||
PUSH P,F
|
||
PUSH P,G
|
||
PUSH P,H
|
||
SKIPL G,WRDTAB
|
||
JRST WFREQX
|
||
HRRZ G,G ;initial center point
|
||
HRRZ F,G ;initial low point
|
||
MOVEI H,WRDTND ;initial high point
|
||
;calculate test point
|
||
WFREQ1: CAML F,H ;not hit yet?
|
||
JRST WFREQX
|
||
SUB G,F ;minus low point
|
||
LSH G,-1 ;divide by two
|
||
TRZ G,1 ;must be multiple of two (size of entries)
|
||
ADD G,F ;plus low
|
||
;test
|
||
MOVE B,1(G) ;get test
|
||
PUSHJ P,SFREQ
|
||
JRST WFREQQ ;found it
|
||
SKIPA H,G ;sample before
|
||
MOVEI F,2(G) ;sample after
|
||
MOVE G,H ;high point
|
||
JRST WFREQ1
|
||
|
||
WFREQQ: AOS -4(P)
|
||
MOVE C,(G) ;value
|
||
WFREQX: POP P,H
|
||
POP P,G
|
||
POP P,F
|
||
POP P,B
|
||
POPJ P,
|
||
|
||
;a/ sample
|
||
;b/ word from table
|
||
; +1: =
|
||
; +2: a>b
|
||
; +3: b>a
|
||
|
||
SFREQ: PUSH P,A
|
||
PUSH P,C
|
||
FREQN: ILDB C,B
|
||
JUMPE C,FREQQ
|
||
ILDB 0,A
|
||
CAME 0,C
|
||
JRST FREQD
|
||
JRST FREQN
|
||
|
||
FREQQ: POP P,C
|
||
POP P,0
|
||
POPJ P,
|
||
|
||
FREQD: CAML 0,C
|
||
AOS -2(P)
|
||
AOS -2(P)
|
||
POP P,C
|
||
POP P,A
|
||
POPJ P,
|
||
|
||
SUBTTL OUTPUT A STRING WORD
|
||
|
||
;output a string word
|
||
;F/ string word
|
||
OUTSTW: PUSH P,A
|
||
PUSH P,B
|
||
PUSH P,C
|
||
MOVE A,F
|
||
LSH A,-10
|
||
PUSHJ P,OUTBYT
|
||
MOVEM Z,LSTRWD ;save z so stop bit can be stuck in later
|
||
MOVE A,F
|
||
ANDI A,377
|
||
PUSHJ P,OUTBYT ;low byte
|
||
POP P,C
|
||
POP P,B
|
||
POP P,A
|
||
POPJ P,
|
||
|
||
SUBTTL Conversion of ASCII to ZASCII
|
||
|
||
;return which cs chr in C is in. returns in E
|
||
ZCS: CAIE C,40
|
||
JRST ZNRM
|
||
MOVEI E,3 ;in all sets, return "set" 3
|
||
POPJ P,
|
||
|
||
ZNRM: CAIL C,"a ;CS 0?
|
||
CAILE C,"z
|
||
JRST ZNRM1
|
||
MOVEI E,0
|
||
POPJ P,
|
||
|
||
ZNRM1: CAIL C,"A ;CS 1?
|
||
CAILE C,"Z
|
||
JRST ZNRM2
|
||
MOVEI E,1
|
||
POPJ P,
|
||
|
||
ZNRM2: MOVEI E,2 ;everything else is CS 2
|
||
POPJ P,
|
||
|
||
;return byte for this character
|
||
; C/ character
|
||
;returns
|
||
; C/ value
|
||
;skip returns if character must be ascii escaped
|
||
ZCB: CAIE C,"
|
||
JRST .+3
|
||
MOVEI C,0 ;space = 0
|
||
POPJ P,
|
||
|
||
CAIL C,"a
|
||
CAILE C,"z
|
||
JRST ZC1
|
||
SUBI C,"a-6 ;a-z = 6-37
|
||
POPJ P,
|
||
|
||
ZC1: CAIL C,"A
|
||
CAILE C,"Z
|
||
JRST ZC2
|
||
SUBI C,"A-6 ;A-Z = 6-37
|
||
POPJ P,
|
||
|
||
ZC2: CAIN C,^M
|
||
JRST [MOVEI C,7
|
||
POPJ P,]
|
||
CAIL C,"0
|
||
CAILE C,"9
|
||
JRST ZCFNY
|
||
SUBI C,"0-8
|
||
POPJ P,
|
||
|
||
;in set 2 but not a number, search for it
|
||
ZCFNY: PUSH P,A
|
||
MOVNI A,16.
|
||
CAMN C,CS2CH(A)
|
||
JRST ZCFND ;got it
|
||
AOJL A,.-2
|
||
AOSA -1(P) ;skip return means is not a usual character
|
||
ZCFND: MOVE C,CS2VL(A) ;return value in C
|
||
POP P,A
|
||
POPJ P,
|
||
|
||
;table of characters in set 2 and their values
|
||
40 ? ". ? ", ? "! ? "?
|
||
"_ ? "# ? "' ? "" ? "/
|
||
"\ ? "- ? ": ? "( ? ")
|
||
CS2CH:
|
||
6 ? 22 ? 23 ? 24 ? 25
|
||
26 ? 27 ? 30 ? 31 ? 32
|
||
33 ? 34 ? 35 ? 36 ? 37
|
||
CS2VL:
|
||
|
||
SUBTTL STRING ASSEMBLY DEBUGGING
|
||
|
||
;print zstring being assembled
|
||
;only called if CDEBUG is not 0
|
||
; a/ bptr to string
|
||
CSTRNG: PUSH P,A
|
||
PUSH P,B
|
||
PUSH P,C
|
||
SKIPN A,PDEBUG ;pick up script channel
|
||
MOVEI A,.PRIOU ;or tty
|
||
MOVEI C,0
|
||
HRROI B,[ASCIZ /
|
||
"/]
|
||
SOUT
|
||
MOVE B,-2(P)
|
||
SOUT
|
||
HRROI B,[ASCIZ /"
|
||
/]
|
||
SOUT
|
||
JRST POPCBA
|
||
|
||
;print character being produced for a zstring
|
||
;only called if CDEBUG is not 0
|
||
; b/ character
|
||
COUT: PUSH P,A
|
||
PUSH P,B
|
||
PUSH P,C
|
||
MOVE B,C
|
||
SKIPN A,PDEBUG ;pick up script channel
|
||
MOVEI A,.PRIOU ;or tty if there is no script
|
||
MOVEI C,8 ;radix 8
|
||
HRLI C,(NO%ZRO+NO%LFL)+2 ;always print two column, pad with 0
|
||
NOUT
|
||
JFCL
|
||
MOVEI B,40 ;terminate with space
|
||
BOUT
|
||
POPCBA: POP P,C
|
||
POP P,B
|
||
POP P,A
|
||
POPJ P,
|
||
|
||
SUBTTL ROUTINE FOR PRINTING CURRENT ZFUNCTION NAME AND CURRENT PC
|
||
|
||
PFUNCT: PUSH P,A
|
||
PUSH P,B
|
||
PUSH P,C
|
||
HRROI A,[ASCIZ / = /]
|
||
PSOUT
|
||
MOVE B,CODLEN
|
||
MOVEI A,.PRIOU
|
||
SUB B,CODSAV'
|
||
MOVEI C,0
|
||
NOUT
|
||
JFCL
|
||
MOVE B,CODLEN
|
||
MOVEM B,CODSAV
|
||
MOVEI A,^M
|
||
PBOUT
|
||
MOVEI A,^J
|
||
PBOUT
|
||
MOVE A,FUNCT
|
||
PSOUT
|
||
MOVEI A,^I
|
||
PBOUT
|
||
MOVEI A,.PRIOU
|
||
MOVE B,ZPC
|
||
MOVEI C,10.
|
||
NOUT
|
||
JFCL
|
||
POP P,C
|
||
POP P,B
|
||
POP P,A
|
||
POPJ P,
|
||
|
||
SUBTTL WORD FREQUENCY PASS GOODIES GO HERE
|
||
|
||
FREQ: MOVE A,1(TP)
|
||
CAIE A,":
|
||
JRST FREQ1
|
||
NXTARG 1
|
||
JRST FREQ
|
||
FREQ1: SKIPN A,(TP)
|
||
SKIPE 1(TP)
|
||
SKIPA
|
||
POPJ P,
|
||
PUSHJ P,LOOKUP
|
||
POPJ P,
|
||
JUMPL B,FPSEUDO
|
||
JRST FOPER
|
||
|
||
FOPER: TLNN B,%STR
|
||
POPJ P,
|
||
NXTARG 1
|
||
MOVE D,(TP)
|
||
PUSHJ P,NEWWRD
|
||
POPJ P,
|
||
|
||
FPSEUD: HRRZ B,B
|
||
CAIE B,ZINSER
|
||
CAIN B,ZENDI
|
||
JRST (B)
|
||
|
||
CAIE B,ZSTRL
|
||
CAIN B,ZSTR
|
||
JRST FPSEU1
|
||
CAIE B,ZGSTR
|
||
POPJ P,
|
||
|
||
FPSEU2: NXTARG 1
|
||
FPSEU1: NXTARG 1
|
||
SKIPN D,(TP)
|
||
JRST TFARG
|
||
PUSHJ P,NEWWRD
|
||
POPJ P,
|
||
|
||
;main entry to count frequency of words in a particular string
|
||
; called with string pointer in D
|
||
|
||
NEWWRD: JUMPE D,CPOPJ
|
||
MOVE E,[440700,,WRDBUF]
|
||
MOVEI J,0 ;count of bytes
|
||
NXTWRD: ILDB A,D
|
||
JUMPE A,CPOPJ
|
||
PUSHJ P,PUNCT
|
||
JRST WRDSTA ;if punct. sequence
|
||
PUSHJ P,ALPHA
|
||
JRST NXTWRD
|
||
TRNN A,40 ;l.c. letter?
|
||
WRDSTA: ADDI J,1 ;U.C. letter takes additional byte
|
||
|
||
WRDBEG: IDPB A,E
|
||
ADDI J,1
|
||
MOVE F,D ;save this pointer
|
||
ILDB A,D
|
||
JUMPE A,WRDEOS
|
||
PUSHJ P,ALPHA
|
||
JRST WRDEND ;not alphabetic
|
||
JRST WRDBEG
|
||
|
||
;here check for ' followed by alphabetic (turn ' into alphabetic)
|
||
WRDQUT: PUSH P,A
|
||
PUSH P,D
|
||
ILDB A,D
|
||
PUSHJ P,ALPHA
|
||
JRST [POP P,D
|
||
POP P,A
|
||
JRST WRDEN1]
|
||
POP P,D
|
||
POP P,A
|
||
ADDI J,1 ;' takes two bytes
|
||
JRST WRDBEG
|
||
|
||
WRDEOS: MOVEI D,0 ;end of input string
|
||
JRST WRDEN2
|
||
WRDEND: CAIN A,"'
|
||
JRST WRDQUT
|
||
WRDEN1: CAIN A,40 ;SP is included in words
|
||
JRST [IDPB A,E
|
||
ADDI J,1
|
||
JRST WRDEN3]
|
||
MOVE D,F ;recover non-spaced bptr
|
||
WRDEN3: MOVEI A,0
|
||
WRDEN2: IDPB A,E
|
||
MOVE A,[440700,,WRDBUF]
|
||
PUSHJ P,WLOOK
|
||
JRST WRDADD ;not there, go add it
|
||
AOS (G) ;add to its usage count
|
||
JRST NEWWRD
|
||
|
||
WRDADD: SKIPN WDEBUG
|
||
JRST WRDAD1
|
||
MSG ["]
|
||
PSOUT
|
||
MOVE A,[440700,,WRDBUF]
|
||
PSOUT
|
||
MSG ["
|
||
]
|
||
PSOUT
|
||
|
||
WRDAD1: MOVE A,TABPTR
|
||
TLNN A,400000
|
||
JRST [HRLI A,440700
|
||
ADDI A,1
|
||
JRST .+1]
|
||
MOVE H,A
|
||
MOVE B,[440700,,WRDBUF]
|
||
MOVEI C,0
|
||
SOUT ;copy string to buffer
|
||
IDPB C,A
|
||
MOVEM A,TABPTR
|
||
;update table pointer
|
||
PUSH P,G
|
||
MOVE G,WRDTAB
|
||
SUB G,[2,,2]
|
||
MOVEM G,WRDTAB
|
||
POP P,G
|
||
;make a slot for new entry
|
||
HRRZ A,WRDTAB
|
||
HRLI A,2(A)
|
||
BLT A,-1(G)
|
||
;put out new entry
|
||
MOVEM H,-1(G) ;string
|
||
MOVEI H,1
|
||
HRL H,J ;size of string in bytes
|
||
MOVEM H,-2(G) ;count
|
||
JRST NEWWRD
|
||
|
||
;here when all done
|
||
FILEND: PUSHJ P,BYTES
|
||
PUSHJ P,SORT
|
||
|
||
;here to output the data
|
||
MOVE A,[440700,,[ASCIZ /FREQ.ZAP/]]
|
||
MOVE B,OUTPTR
|
||
ILDB 0,A
|
||
IDPB 0,B
|
||
JUMPN 0,.-2
|
||
MOVSI A,(GJ%SHT+GJ%FOU)
|
||
HRROI B,OUTFIL
|
||
GTJFN
|
||
JRST ERPRNT
|
||
HRRZ A,A
|
||
MOVEM A,OJFN
|
||
MOVE B,[070000,,OF%WR]
|
||
OPENF
|
||
JRST ERPRNT
|
||
|
||
;output the goodies
|
||
MOVE G,WRDTAB
|
||
HRLI G,-<2*96.>
|
||
PUSHJ P,PTAB
|
||
|
||
;output garbage at end
|
||
|
||
MOVE A,OJFN
|
||
HRROI B,[ASCIZ /
|
||
|
||
;word frequency table of 96 most common words
|
||
|
||
WORDS:: .TABLE
|
||
FSTR?1
|
||
FSTR?2
|
||
FSTR?3
|
||
FSTR?4
|
||
FSTR?5
|
||
FSTR?6
|
||
FSTR?7
|
||
FSTR?8
|
||
FSTR?9
|
||
FSTR?10
|
||
FSTR?11
|
||
FSTR?12
|
||
FSTR?13
|
||
FSTR?14
|
||
FSTR?15
|
||
FSTR?16
|
||
FSTR?17
|
||
FSTR?18
|
||
FSTR?19
|
||
FSTR?20
|
||
FSTR?21
|
||
FSTR?22
|
||
FSTR?23
|
||
FSTR?24
|
||
FSTR?25
|
||
FSTR?26
|
||
FSTR?27
|
||
FSTR?28
|
||
FSTR?29
|
||
FSTR?30
|
||
FSTR?31
|
||
FSTR?32
|
||
FSTR?33
|
||
FSTR?34
|
||
FSTR?35
|
||
FSTR?36
|
||
FSTR?37
|
||
FSTR?38
|
||
FSTR?39
|
||
FSTR?40
|
||
FSTR?41
|
||
FSTR?42
|
||
FSTR?43
|
||
FSTR?44
|
||
FSTR?45
|
||
FSTR?46
|
||
FSTR?47
|
||
FSTR?48
|
||
FSTR?49
|
||
FSTR?50
|
||
FSTR?51
|
||
FSTR?52
|
||
FSTR?53
|
||
FSTR?54
|
||
FSTR?55
|
||
FSTR?56
|
||
FSTR?57
|
||
FSTR?58
|
||
FSTR?59
|
||
FSTR?60
|
||
FSTR?61
|
||
FSTR?62
|
||
FSTR?63
|
||
FSTR?64
|
||
FSTR?65
|
||
FSTR?66
|
||
FSTR?67
|
||
FSTR?68
|
||
FSTR?69
|
||
FSTR?70
|
||
FSTR?71
|
||
FSTR?72
|
||
FSTR?73
|
||
FSTR?74
|
||
FSTR?75
|
||
FSTR?76
|
||
FSTR?77
|
||
FSTR?78
|
||
FSTR?79
|
||
FSTR?80
|
||
FSTR?81
|
||
FSTR?82
|
||
FSTR?83
|
||
FSTR?84
|
||
FSTR?85
|
||
FSTR?86
|
||
FSTR?87
|
||
FSTR?88
|
||
FSTR?89
|
||
FSTR?90
|
||
FSTR?91
|
||
FSTR?92
|
||
FSTR?93
|
||
FSTR?94
|
||
FSTR?95
|
||
FSTR?96
|
||
.ENDT
|
||
|
||
.ENDI
|
||
/]
|
||
MOVEI C,0
|
||
SOUT
|
||
|
||
MOVE A,OJFN
|
||
CLOSF
|
||
JFCL
|
||
|
||
MSG [Best 96 words: ]
|
||
PSOUT
|
||
MOVEI A,.PRIOU
|
||
MOVE B,D
|
||
MOVEI C,10.
|
||
NOUT
|
||
JFCL
|
||
MSG [ zbytes saved, ]
|
||
PSOUT
|
||
MOVEI A,.PRIOU
|
||
MOVE B,E
|
||
NOUT
|
||
JFCL
|
||
MSG [ uses.
|
||
]
|
||
PSOUT
|
||
|
||
HALTF
|
||
|
||
;calculate bytes saved
|
||
BYTES: MOVE A,WRDTAB
|
||
BYTES1: HRRZ B,(A)
|
||
HLRZ C,(A)
|
||
SUBI C,2
|
||
IMUL B,C
|
||
HRLM B,(A)
|
||
ADD A,[2,,2]
|
||
JUMPL A,BYTES1
|
||
POPJ P,
|
||
|
||
;sort word table by bytes saved
|
||
SORT: MOVE A,WRDTAB
|
||
;next slot of table
|
||
SORTM: MOVE B,A
|
||
SETZB C,D
|
||
SETZ E,
|
||
;next try for largest number
|
||
SORTN: CAMLE C,(B)
|
||
JRST SORTL
|
||
;pick up new candidate
|
||
MOVE C,(B)
|
||
MOVE D,1(B)
|
||
MOVE E,B
|
||
SORTL: ADD B,[2,,2]
|
||
JUMPL B,SORTN
|
||
;end of pass
|
||
JUMPE C,SORTO
|
||
EXCH C,(A)
|
||
MOVEM C,(E)
|
||
EXCH D,1(A)
|
||
MOVEM D,1(E)
|
||
;move to next slot
|
||
SORTO: MOVE C,(A)
|
||
SORTP: ADD A,[2,,2]
|
||
JUMPGE A,CPOPJ
|
||
CAMN C,(A)
|
||
JRST SORTP
|
||
JRST SORTM
|
||
|
||
NEXT31: MOVE A,WRDTAB
|
||
ADD A,[76,,76]
|
||
MOVEM A,WRDTAB
|
||
N31LUP: HRRZ B,(A)
|
||
HLRZ C,(A)
|
||
IDIV C,B
|
||
SUBI C,1
|
||
HRLM C,(A)
|
||
ADD A,[1,,1]
|
||
AOBJN A,N31LUP
|
||
PUSHJ P,BYTES
|
||
PUSHJ P,SORT
|
||
POPJ P,
|
||
|
||
|
||
PSAVED: MSG [31 words: ]
|
||
PSOUT
|
||
MOVEI A,.PRIOU
|
||
MOVE B,D
|
||
MOVEI C,10.
|
||
NOUT
|
||
JFCL
|
||
MSG [ zbytes saved, ]
|
||
PSOUT
|
||
MOVEI A,.PRIOU
|
||
MOVE B,E
|
||
NOUT
|
||
JFCL
|
||
MSG [ uses.
|
||
|
||
]
|
||
PSOUT
|
||
POPJ P,
|
||
|
||
PTABS: MOVEI A,101
|
||
MOVEM A,OJFN
|
||
MOVE G,WRDTAB
|
||
HRLI G,-76
|
||
PUSHJ P,PTAB
|
||
PUSHJ P,PSAVED
|
||
PUSHJ P,NEXT31
|
||
MOVE G,WRDTAB
|
||
HRLI G,-76
|
||
PUSHJ P,PTAB
|
||
PUSHJ P,PSAVED
|
||
PUSHJ P,NEXT31
|
||
MOVE G,WRDTAB
|
||
HRLI G,-76
|
||
PUSHJ P,PTAB
|
||
PUSHJ P,PSAVED
|
||
POPJ P,
|
||
|
||
PTABLE: PUSH P,G
|
||
MOVE G,WRDTAB
|
||
PUSHJ P,PTAB
|
||
POP P,G
|
||
POPJ P,
|
||
|
||
PTAB: PUSH P,A
|
||
PUSH P,B
|
||
PUSH P,C
|
||
SETZB D,E
|
||
MOVEI F,0
|
||
PTLOOP: MOVE A,OJFN
|
||
HRROI B,[ASCIZ / .FSTR FSTR?/]
|
||
MOVEI C,0
|
||
SOUT
|
||
ADDI F,1
|
||
MOVE B,F
|
||
MOVEI C,10.
|
||
NOUT
|
||
JFCL
|
||
HRROI B,[ASCIZ /,"/]
|
||
MOVEI C,0
|
||
SOUT
|
||
MOVE B,1(G)
|
||
SOUT
|
||
HRROI B,[ASCIZ /" ;/]
|
||
SOUT
|
||
MOVE A,OJFN
|
||
HLRZ B,(G)
|
||
ADD D,B
|
||
MOVEI C,10.
|
||
NOUT
|
||
JFCL
|
||
MOVEI B,11
|
||
BOUT
|
||
HRRZ B,(G)
|
||
ADD E,B
|
||
MOVEI C,10.
|
||
NOUT
|
||
JFCL
|
||
MOVEI B,15
|
||
BOUT
|
||
MOVEI B,12
|
||
BOUT
|
||
ADD G,[2,,2]
|
||
JUMPL G,PTLOOP
|
||
POP P,C
|
||
POP P,B
|
||
POP P,A
|
||
POPJ P,
|
||
|
||
;lookup word in word table
|
||
; a/ word
|
||
; +1: not found, loc to add in (g)
|
||
; +2: found, word is at (g)
|
||
|
||
WLOOK: SKIPL G,WRDTAB
|
||
POPJ P,
|
||
HRRZ G,G ;initial center point
|
||
HRRZ F,G ;initial low point
|
||
MOVEI H,WRDTND ;initial high point
|
||
;calculate test point
|
||
LOOK1: CAML F,H ;not hit yet?
|
||
POPJ P,
|
||
SUB G,F ;minus low point
|
||
LSH G,-1 ;divide by two
|
||
TRZ G,1 ;must be multiple of two (size of entries)
|
||
ADD G,F ;plus low
|
||
;test
|
||
MOVE B,1(G) ;get test
|
||
PUSHJ P,SCOMP
|
||
JRST LOOKEQ ;found it
|
||
SKIPA H,G ;sample before
|
||
MOVEI F,2(G) ;sample after
|
||
MOVE G,H ;high point
|
||
JRST LOOK1
|
||
|
||
LOOKEQ: AOS (P)
|
||
POPJ P,
|
||
|
||
;a/ sample
|
||
;b/ word from table
|
||
; +1: =
|
||
; +2: a>b
|
||
; +3: b>a
|
||
|
||
SCOMP: PUSH P,A
|
||
PUSH P,C
|
||
COMPN: ILDB 0,A
|
||
ILDB C,B
|
||
CAME 0,C
|
||
JRST COMPD
|
||
JUMPE 0,COMPX
|
||
JRST COMPN
|
||
COMPX: POP P,C
|
||
POP P,A
|
||
POPJ P,
|
||
|
||
COMPD: CAML 0,C
|
||
AOS -2(P)
|
||
AOS -2(P)
|
||
JRST COMPX
|
||
|
||
ALPHA: CAIL A,"A
|
||
CAILE A,"Z
|
||
SKIPA
|
||
JRST ALPHA1
|
||
CAIL A,"a
|
||
CAILE A,"z
|
||
POPJ P,
|
||
ALPHA1: AOS (P)
|
||
POPJ P,
|
||
|
||
PUNCT: CAIE A,",
|
||
CAIN A,".
|
||
POPJ P,
|
||
CAIE A,"!
|
||
CAIN A,"?
|
||
POPJ P,
|
||
AOS (P)
|
||
POPJ P,
|
||
|
||
|
||
SUBTTL VARIABLES AND BUFFERS
|
||
|
||
;debugging flags
|
||
SDEBUG: 0 ;if non-0, print symbol table
|
||
PDEBUG: 0 ;if non-0, print lines as they are read
|
||
TDEBUG: 0 ;if non-0, print tokens after parsing them
|
||
ODEBUG: 0 ;if non-0, print opers info
|
||
CDEBUG: 0 ;if non-0, print strings in "zascii"
|
||
FDEBUG: 0 ;if non-0, print functions as they are found
|
||
STOP: 0 ;if non-0, location to halt at (for changing flags)
|
||
SYMFLG: 0 ;if non-0, output symbol table
|
||
|
||
;flags for word frequency pass
|
||
DOFREQ: 0 ;if non-0, this is word frequency run, not assy.
|
||
WDEBUG: 0 ;if non-0, print new words during frequency pass
|
||
|
||
;i/o goodies
|
||
|
||
;gtjfn block for normal file opening
|
||
GTJFNB: GJ%OLD ;flags
|
||
.NULIO,,.NULIO ;jfns
|
||
0 ;device
|
||
0 ;dir
|
||
-1,,[ASCIZ /ZIPTEST/] ;name
|
||
-1,,[ASCIZ /ZAP/] ;ext
|
||
0 ;prot
|
||
0 ;acct
|
||
0 ;jfn
|
||
|
||
;gtjfn block for normal file opening
|
||
GTJFNX: GJ%OLD ;flags
|
||
.NULIO,,.NULIO ;jfns
|
||
0 ;device
|
||
0 ;dir
|
||
-1,,[ASCIZ /ZIPTEST/] ;name
|
||
-1,,[ASCIZ /XZAP/] ;ext
|
||
0 ;prot
|
||
0 ;acct
|
||
0 ;jfn
|
||
|
||
;gtjfn block for reading file name from tty
|
||
GTJFNT: GJ%OLD+GJ%EXT ;flags
|
||
.PRIIN,,.PRIOU ;jfns
|
||
0 ;device
|
||
-1,,[ASCIZ /INFOCOM.ZORK/] ;dir
|
||
-1,,[ASCIZ /ZIPTEST/] ;name
|
||
-1,,[ASCIZ /ZAP/] ;ext
|
||
0 ;prot
|
||
0 ;acct
|
||
0 ;jfn
|
||
0 ;f2
|
||
0 ;input copy
|
||
0 ;
|
||
-1,,[ASCIZ /File/]
|
||
0
|
||
0
|
||
|
||
;output gtjfn
|
||
OUTPTR: 440700,,OUTFIL
|
||
OUTFIL: BLOCK 20
|
||
|
||
OJFN: 0 ;old input jfn, for when .INSERT done
|
||
IJFN: 0 ;input jfn
|
||
FILBUF: BLOCK 20.
|
||
FILPTR: 0
|
||
JOBNAM: ASCIZ /MUDDLE/
|
||
|
||
PDL: BLOCK 100 ;stack
|
||
|
||
ZAPID: 3 ;zap id number (assembly language version)
|
||
|
||
FLGWRD: 0 ;1 if byte swapped (not implemented)
|
||
%BYTSWP==1 ;flag word bit for byte-swapped mode
|
||
%TIMESL==2 ;flag word bit for 'time' status line
|
||
|
||
RELEAS: -1 ;release number
|
||
|
||
;various assembler variables
|
||
SAVZPC: 0 ;saved pc used mostly by debugging printers
|
||
SAVZ: 0 ;saved output ptr ditto
|
||
|
||
TABLE: 0 ;if in table, holds pc of table start
|
||
TABLEN: 0 ;if in table, holds max length or -1 if none
|
||
|
||
GLBTOT: 0 ;how many globals he made (limit is 255-20)
|
||
GLBCNT: 17 ;current global (1-17 are really locals)
|
||
|
||
OBJTOT: 0 ;how many objects he made (limit is 255)
|
||
OBJCNT: 0 ;current object
|
||
|
||
FUNCT: 0 ;non-zero during function assy.
|
||
FSYM: 0 ;symbol value of last function
|
||
|
||
LSTSYM: 0 ;last symbol defined
|
||
|
||
WRDBYT: 0 ;-1 if assembling byte, 0 if word
|
||
JMPREF: 0 ;-1 if assembling jump, 0 otherwise
|
||
SHRIMP: 0 ;long jumps that were wasted
|
||
OSHRIM: 0 ;saved count of wasted long jumps
|
||
|
||
;goodies for instruction assembly
|
||
|
||
NOREF: 0 ;-1 if not to assemble references (as instruction operands
|
||
;are moved into ARGBUF)
|
||
|
||
OPER: 0 ;operator is saved here
|
||
|
||
ARGBUF: BLOCK 14 ;args to operators, pairs of values and strings
|
||
|
||
SENSE: 0 ;sense of predicate jump
|
||
PRED: 0 ;value of predicate byte
|
||
0 ;ptr to string defining it
|
||
VAL: 0 ;value of value byte
|
||
0 ;string defining it
|
||
|
||
LSTRWD: 0 ;Z at last string word output saved here for stop bit addition
|
||
|
||
;junk for second pass over functions
|
||
TWOPAS: -1 ;-1 if two pass assembly
|
||
PASS2: 0 ;-1 if doing second pass
|
||
FPOS: 0 ;saved file pointer
|
||
FZ: 0 ;saved z
|
||
FZPC: 0 ;saved zpc
|
||
FSHORT: 0 ;count of short jumps saved
|
||
ZCSET: 0 ;char set of last character looked at
|
||
|
||
;parsing information of various sorts
|
||
BUFFER: BLOCK 1000 ;read in buffer
|
||
|
||
TOKEN: BLOCK 1000 ;buffer for parsed tokens
|
||
TOKPTR: 0 ; ptr into same
|
||
|
||
TPDL: -100.,,TOKENS-1 ;stack for pairs of token/terminator
|
||
TOKENS: BLOCK 100. ; points to here
|
||
|
||
;junk to unsuccessfully fool GC-READ (joel is a twit)
|
||
;this stuff is modified by OUTPUT
|
||
HEADER: 1305 ;object plus type word
|
||
1305
|
||
1305
|
||
122 ; ??
|
||
41 ; ??
|
||
51,,5374 ;type,,length
|
||
41000,,2006 ;bptr to start
|
||
|
||
FOOTER: 40003,,0 ;bytes
|
||
1303,,3311 ;length,,self
|
||
|
||
;get these out of the way
|
||
VARIAB
|
||
CONSTA
|
||
|
||
SUBTTL SYMBOL TABLES
|
||
|
||
SYMPTR: SYMBUF+2 ;ptr to symbol table buffer
|
||
FCNPTR: FCNBUF ;ptr to function table buffer
|
||
|
||
SYMSIZ==3 ;size of a symbol entry
|
||
SYMNAM==0 ;offset of name slot
|
||
SYMVAL==1 ;offset of value slot
|
||
SYMREF==2 ;offset of references slot
|
||
|
||
BUCKN==201. ;how many buckets
|
||
BUCKL==25.*SYMSIZ ;how long buckets are
|
||
|
||
;local symbol goodies
|
||
LCLLST: 0 ;list of local symbols
|
||
LCLPTR: LCLBUF ;ptr to free space in local symbol buffer
|
||
LCLBUF: BLOCK 10000 ;local symbol pnames buffer
|
||
|
||
LCLOBL: -<BUCKN*BUCKL>,,LCLTAB ;ptr to local symbol hash table
|
||
LCLTAB: BLOCK BUCKN*BUCKL ;local symbol hash table
|
||
LCLEND: 0 ;end of same
|
||
|
||
;global symbol goodies
|
||
GLBLST: 0 ;list of global symbols
|
||
GLBPTR: GLBBUF ;ptr to free space in global symbol buffer
|
||
GLBBUF: BLOCK 40000 ;global symbol pname buffer starts here
|
||
|
||
GLBOBL: -<BUCKN*BUCKL>,,GLBTAB ;ptr to global symbol hash table
|
||
GLBTAB: BLOCK BUCKN*BUCKL ;global symbol hash table
|
||
GLBEND: 0 ;end of same
|
||
|
||
;word frequency hack stuff is here
|
||
FREQST: 0 ;-1 when assembling string that can have fstrs
|
||
FSTRS: -1 ;count of .FSTRs seen
|
||
WRDBUF: BLOCK 10.
|
||
|
||
WRDTLN==20000.
|
||
WRDTND==700000+WRDTLN-2
|
||
|
||
WRDTAB: WRDTND
|
||
TABPTR: 440700,,.+1
|
||
LOC .+1000
|
||
|
||
;output buffer
|
||
|
||
OUTBUF==<.+77777>&-100000 ;lies at 100000*n
|
||
|
||
;symbol table hacks
|
||
|
||
FCNBUF==OUTBUF+200000 ;function symbol tables made here
|
||
SYMBUF==FCNBUF+10000 ;symbol tables made mapped here
|
||
|
||
END START
|