historicalsource
/
minizork-1982
mirror of https://github.com/historicalsource/minizork-1982
1
0
Fork 0
Code Issues Releases Wiki Activity
minizork-1982/zap.mid

3801 lines
66 KiB
Plaintext
Raw Permalink Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

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