.enabl lc .title PAL-X ;+ ; ; ** PAL-X ** ; ; PDP-8/e cross-assembler for the LSI-11/2. ; ; By John M. B. Wilson. ; ; 23-Jan-85 JMBW Started. ; 25-Sep-91 JMBW Fix date bug (broke in 1987!). ; ;- .mcall .close,.csigen,.csispc,.date,.dstatus .mcall .exit,.print,.settop,.sreset ; .macro .sym text,val .word nochng ;not redefinable .rad50 /text/ ;symbol name .word val ;value .word .+2 ;link to next entry .endm ; .macro .err ptr jsr pc,error .word ptr ;ptr to error message .endm ; argmax= 16. ;max # of args for macros ; symbol table entry flag bits: strval= 100000 ;if set, value field points to a string macro= 2 ;if set, symbol defines a macro nochng= 1 ;if set, value may not be changed ; macro argument flag bits: deflt= 200 ;arg has a default value strng= 100 ;arg is a delimited string (') dstrn= 40 ;same as above, keep delimiters (") numbr= 20 ;arg should be eval'd to an octal number (#) ; commnt= '/ ;character to set off comments curloc= <^R. > ;that's a dot and two spaces (=current locn ctr) locsym= <^R .> ;that's two spaces and a dot (local label symtab entries) ; palx: clrb by.me ;in case we were restarted with START .print #header ;print name, version, O.S. movb #40,by.me ;re-use header for listing ; start: mov #1000,sp ;clear stack (after fatal errors) .settop #devhnd ;for a quick exit on ^C .csigen #devhnd,#defext,#0,#cmdbuf+2 ;get command string, open files tst (sp)+ ;drop option count beq 10$ ;no options, tubular .print #illopt ;print message br start ;give him/her another shot (clear stack first) 10$: mov r0,freptr ;set free list ptr (r0 pts at first free addr) mov @#54,r0 ;get address of RMON mov 266(r0),r0 ;get address of USR from RMON tst -(r0) ;pt at last free word .settop ;ask for all core below USR mov r0,r2 ;save ptr to max sub #12,r0 ;back up cmp freptr,r0 ;did we get enough for even one block? blos 20$ ;yes .print #nocore ;no, life's tough bisb #20,@#53 ;set user error byte to UNCONDITIONALLY FATAL .exit ;die 20$: mov freptr,r0 ;get starting address mov r0,r1 ;copy ptr 30$: add #12,r1 ;pt at next sym cmp r1,r2 ;is there space for this block? bhi 40$ ;no, exit loop mov r1,10(r0) ;yes, link to last block mov r1,r0 ;copy ptr br 30$ ;loop 40$: clr -2(r0) ;zero at end of last elemnt mov r0,hicore ;save ptr here clrb asked ;we haven't asked for more core yet .csispc #expbuf,#defext,#cmdbuf+2 ;parse it again & get device names tst (sp)+ ;clear stack clr r5 ;count of open files mov expbuf,r0 ;is there a .BIN file? beq 50$ ;no inc r5 ;yes, inc count .dstat expbuf+80.,expbuf ;see if block or sequential mov expbuf+80.,r0 ;get flags - bit 15=block device bis #77777,r0 ;make absolutely sure some bits are set mov r0,-(sp) ;save mov r5,-(sp) mov #outbuf,binptr ;init blk ptr clr outblk ;blk 0 jsr pc,ldrtrl ;punch leader code mov #177777,org ;init to impossible value mov (sp)+,r5 ;restore mov (sp)+,r0 50$: mov r0,binflg ;set binflg if channel 0 is open mov expbuf+12,r0 ;is there a .LST file? beq 60$ ;no inc r5 ;yes, inc count .dstat expbuf+80.,expbuf+12 ;look up device type mov expbuf+80.,r0 ;get flags bis #77777,r0 ;set all but high bit 60$: mov r0,lstflg ;set lstflg if chan 1 is open bis expbuf+24,r5 ;set flag if channel 2 in use mov #expbuf+36,r4 ;point at buffer mov #10,r3 ;8 possible input files 70$: bis (r4),r5 ;make non-zero if device specified add #10,r4 ;skip to next entry sob r3,70$ ;loop until all files checked tst r5 ;was anything open? beq start ;no, re-prompt .date ;get date tst r0 ;valid date? beq 100$ ;no, skip mov r0,-(sp) ;save mov #5,r1 ;# bits to shift 80$: asr r0 ;right a bit sob r1,80$ ;repeat 5 times mov r0,-(sp) ;save month bic #1740,r0 ;clear it mov r0,r2 ;copy to r2 mov #10.,r0 ;divide by 10 jsr pc,$div ;(convert to decimal) mov #date,r5 ;pt at date buffer add #'0,r2 ;cvt high dig to dec movb r2,(r5)+ ;put in buffer add #'0,r1 ;cvt low dig movb r1,(r5)+ ;put in buf mov (sp)+,r0 ;get month back mov #5,r1 ;# cols to shift 90$: asr r0 ;right a col sob r1,90$ ;repeat 5 times mov r0,r1 ;copy asl r1 ;*2 add r1,r0 ;=month*3 add #months-3,r0 ;point at table movb #'-,(r5)+ ;add a hyphen movb (r0)+,(r5)+ ;move 3 chars (month name) movb (r0)+,(r5)+ movb (r0)+,(r5)+ movb #'-,(r5)+ ;add another hyphen mov (sp)+,r2 ;get year bic #37740,r2 ;clear all except year (not 37760!) add #72.,r2 ;convert from RT-11 format cmp r2,#100. ;past 2000 yet? blo 100$ ;(as if there'll be any PDP-8's left!) sub #100.,r2 ;yes, convert ; the RT-11 V04 keyboard monitor won't even let you type in years which ; aren't between 1972 and 1999! 100$: mov #10.,r0 ;divide by 10 jsr pc,$div ;to convert to dec add #'0,r2 ;cvt to dec movb r2,(r5)+ ;put in buf add #'0,r1 ;cvt to dec movb r1,(r5)+ ;put in buf 110$: mov #last,endtab ;init ptr to end of table clr last+10 ;mark end of table clr errcnt ;no errors yet clrb p1erf ;we have not said "PASS 1" clr pagnum ;no list pages yet clrb linpag ;but start one on the first line clrb pagflg ;nothing on it yet mov #ttl+7,r4 ;pt at title buffer clrb -(r4) ;mark end of string mov #50,r0 ;radix-50 mov expbuf+42,r2 ;get name of first input file jsr pc,r50asc ;cvt to ascii mov expbuf+40,r2 ;(set default TITLE) jsr pc,r50asc mov r4,ttlptr ;use the user's title (#TTL) mov #lstbuf,lstptr ;init block ptr clr lstblk ;start with block 0 clr chksum ;nothing generated yet movb #2,pasnum ;on first pass pass: mov #^RACL,lstlab ;set symbol for locals (="ACL") clr lstlab+2 ;low word of name movb #3,rarea ;read from channel 3 clrb endflg ;not "$" statement clr line ;no lines read mov #200,ppc ;start at 0200 newfil: mov #-1,inblk ;input block #0 mov #1000,inptr ;start with a read (buffer empty) doline: ; do a line clr errque ;clear ptr mov #linbuf,r5 ;pt at line buffer mov inptr,r4 ;pt at next char 10$: cmp r4,#1000 ;off end of block? blo 40$ ;no inc inblk ;move to next block mov #rarea,r0 ;point at area emt 375 ;.readw bcc 30$ ;hoopy, continue dec r0 ;hard error? bne 20$ ;no, skip .print #hrderr ;yes, print message jmp start ;and try again 20$: ; channel not open, or end of file incb rarea ;move to next chan (CSI) cmpb rarea,#10. ;past last chan? blos newfil ;no, go start reading from it cmpb pasnum,#1 ;yes, pass 2? bne 25$ ;no .print #dollar ;yes, error (no $ statement) jsr pc,lstlin ;send to list file inc errcnt ;count the error 25$: jmp endpas ;end of pass 30$: clr r4 ;pt at begn of block 40$: movb inbuf(r4),r0 ;get a char inc r4 ;inc ptr tst r0 ;nul? beq 10$ ;yes, loop cmp r0,#12 ;line feed? beq 50$ ;yes, end of line cmp r0,#14 ;form feed? beq 50$ ;yes, end of line movb r0,(r5)+ ;no, add new char cmp r5,#linbuf+133. ;off end of buffer? blo 10$ ;no, loop .err linlng ;yes, line too long mov #12,r0 ;fake a line feed 50$: movb r0,endlin ;save delimiter mov r4,inptr ;save ptr cmpb -(r5),#15 ;was there a cr? beq 60$ ;yes inc r5 ;no, move back 60$: clrb (r5) ;mark end of line mov #linbuf,r5 ;point at begn of line clrb adrval ;no valid addr for listing clrb datval ;no data either jsr pc,skip ;skip movb (r5),r0 ;get char beq 70$ ;eol, ignore cmpb r0,#commnt ;comment? bne 80$ ;no, process statement 70$: jmp list ;send line to list file 80$: cmpb r0,#'$ ;end? bne 90$ ;no incb endflg ;end of pass br list1 ;list this line, exit 90$: mov r5,-(sp) ;save ptr jsr pc,rad50 ;snarf a term dec r5 ;back up mov r5,errcol ;save r5 inc r5 ;correct jsr pc,skip ;skip to next char cmpb (r5),#'= ;definition? bne .+6 ;no jmp defn ;yes, handle it cmpb (r5),#', ;label? bne .+6 ;no jmp label ;yes, deal with it mov (sp),r5 ;restore ptr br stmnt1 ;skip (saves a memory cycle) stmnt: jsr pc,skip ;skip to next field mov r5,-(sp) ;save ptr stmnt1: jsr pc,rad50 ;get first field (check if PO) jsr pc,skip ;skip to next term mov nambuf,r0 ;get first word of name mov nambuf+2,r1 ;get second word of name mov #potab,r2 ;addr of table mov #numpo,r3 ;counter 10$: cmp r0,(r2)+ ;first words match? bne 20$ ;no cmp r1,(r2)+ ;yes, how about second? bne 30$ ;no tst (sp)+ ;yes, get rid of saved ptr jsr pc,@(r2)+ ;call routine br list ;do next line 20$: tst (r2)+ ;skip second word of name 30$: tst (r2)+ ;skip addr sob r3,10$ ;loop until all checked mov (sp)+,r5 ;it's not a pseudo-op movb (r5),r0 ;get byte beq list ;blank line, just list cmp r0,#commnt ;comment? beq list ;yes, null line mov ppc,dot ;set value for "." jsr pc,eval ;evaluate line jsr pc,outwrd ;send word out list: ; print error messages, if any, and send listing out if pass 2 jsr pc,skip ;skip to end of line (or comment) movb (r5)+,r0 ;get offending char beq list1 ;end of line, good cmp r0,#commnt ;comment? beq list1 ;yes, end of line, gnarly dec r5 ;no, back up ptr (for ^) .err illchr ;error list1: inc line ;move to next line tst errque ;any errors queued? bne 10$ ;yes, format line to be printed on terminal cmpb pasnum,#1 ;pass 2? bne 80$ ;no, forget it (save time) 10$: tstb adrval ;is there a valid address in LSTADR? beq 20$ ;no, fill with blanks mov lstadr,r0 ;get address mov #addr+4,r1 ;pt at dest jsr pc,cvtoct ;cvt to octal br 30$ ;skip 20$: mov #addr,r0 ;pt at address jsr pc,blank ;blank it out 30$: tstb datval ;valid data in LSTDAT? beq 40$ ;no, fill with blanks mov lstdat,r0 ;get data mov #data+4,r1 ;pt at dest jsr pc,cvtoct ;cvt to octal br 50$ ;skip 40$: mov #data,r0 ;pt at data jsr pc,blank ;blank it out 50$: mov #linnum+5,r5 ;pt at buffer mov #5,r4 ;char ctr mov line,r2 ;get line number mov #10.,r0 ;convert to base 10. 60$: jsr pc,$div ;divide by 10. add #'0,r1 ;convert digit to decimal movb r1,-(r5) ;put in buffer sob r4,60$ ;loop until done 70$: cmpb pasnum,#1 ;pass 2? bne 80$ ;no mov #linnum,r0 ;yes, send the line jsr pc,lstlin ;to the .LST file 80$: tst errque ;any new errors since last line? beq 200$ ;no cmpb pasnum,#2 ;on pass 1? bne 85$ ;no, the line's already in the .LST file tstb p1erf ;have we said "PASS 1" yet? bne 82$ ;yes .print #pass1 ;print on terminal jsr pc,lstlin ;and in list file comb p1erf ;set flag 82$: mov #linnum,r0 ;pt at line jsr pc,lstlin ;send to .LST file 85$: .print #linnum ;print the line mov errque,r1 ;pt at first error msg block 90$: mov r1,-(sp) ;save ptr mov (r1)+,r0 ;point at string jsr pc,110$ ;format and print it mov (r1)+,r0 ;get message beq 100$ ;zero, last message jsr pc,110$ ;format and print mov (r1),r1 ;follow link mov (sp)+,r0 ;pt at block jsr pc,retblk ;link the block into the free list tst r1 ;anything left? bne 90$ ;yes, deal with it br 200$ ;no, fine 100$: mov (sp)+,r0 ;pt at blk jsr pc,retblk ;return it to free core br 200$ ;we're done 110$: ; print error message .print ;print on terminal jsr pc,lstlin ;and in .LST file ; find column # of error mov (r1)+,r5 ;get old value for r5 mov #linbuf,r4 ;pt at begn of line clr r3 ;at column 0 120$: cmp r4,r5 ;up to old ptr? beq 140$ ;yes, tab out and add "^" cmpb (r4)+,#11 ;tab? beq 130$ ;yes inc r3 ;no, move over a column br 120$ ;loop 130$: add #10,r3 ;move over to next tab field bic #7,r3 ;back to last tab stop br 120$ ;loop 140$: ; now tab out to error column mov #linbuf,r5 ;pt at line buffer 160$: cmp r3,#10 ;got at least 8 columns in there? blo 170$ ;no movb #11,(r5)+ ;yes, send a tab sub #10,r3 ;subtract 8 from col cnt br 160$ ;try again 170$: tst r3 ;anything left to do? beq 190$ ;no 180$: movb #40,(r5)+ ;yes, send a space sob r3,180$ ;space out to correct column 190$: movb #'^,(r5)+ ;add a ^ clrb (r5) ;mark end with 0 .print #linbuf ;print the string br lstlin ;send to list file and return 200$: tstb endflg ;was this a $? bne endpas ;yes, end of pass jmp doline ;do next line ; cvtoct: ; convert r0 to octal, put at (r1-4) mov #4,r2 ;loop 4 times 10$: mov r0,r3 ;copy r0 bic #177770,r3 ;clear high 13 bits add #'0,r3 ;cvt to decimal movb r3,-(r1) ;put in buffer ror r0 ;rotate right ror r0 ;3 bits ror r0 sob r2,10$ ;loop 4 times rts pc ; blank: ; put 4 blanks at (r0) mov #4,r1 ;loop ctr 10$: movb #40,(r0)+ ;put a blank sob r1,10$ ;loop 4 times rts pc ; lstlin: ; send string at (r0) to list file, preceded by header, if necessary mov r0,-(sp) ;save ptr tstb pagflg ;anything on the page yet? bne 10$ ;yes, skip mov #header,r0 ;point at header jsr pc,lstout ;send it to the list file inc pagnum ;start a new page mov pagnum,r2 ;get page # jsr pc,cvtdec ;convert to decimal jsr pc,lstout ;send to output file mov #crlf,r0 ;pt at crlf jsr pc,lstout ;send it mov ttlptr,r0 ;get current title jsr pc,lstout ;send to output file mov #crlf,r0 ;point at crlf jsr pc,lstout ;send to output file movb #3,linpag ;get line number incb pagflg ;set flag (page not empty) 10$: mov (sp)+,r0 ;restore ptr jsr pc,lstout ;send string to list file tstb -(r0) ;did it end with <200>? bmi 20$ ;yes, not on a new line incb linpag ;move to next line cmpb endlin,#14 ;form feed? beq newpag ;yes, end of page cmpb linpag,#57. ;at end of page anyway? beq newpag ;yes, send a form feed 20$: rts pc newpag: clrb linpag ;yes, start a fresh one next time clrb pagflg ;now on a clean page mov #formfd,r0 ;send a form feed ;jmp lstout ;to the .LST file, and return ; lstout: ; send .asciz string at (r0) to list file, if any tst lstflg ;is there a list file? beq 110$ ;no, never mind mov lstptr,r3 ;pt into buffer 10$: movb (r0)+,r2 ;copy a byte beq 20$ ;end of string, do crlf cmpb r2,#200 ;<200>? beq 30$ ;yes, end of string, no crlf jsr pc,100$ ;send to output file br 10$ ;loop 20$: mov #15,r2 ;send a cr jsr pc,100$ mov #12,r2 ;and an lf jsr pc,100$ 30$: mov r3,lstptr ;set new lstptr rts pc 100$: ; put r2 in block buffer at (r3) movb r2,(r3)+ ;put char in buffer cmp r3,#lstbuf+1000 ;filled a block? beq 120$ ;yes, send it out 110$: rts pc ;no, return 120$: mov r0,r4 ;save r0 mov #larea,r0 ;pt at area emt 375 ;.WRITW bcs lsterr ;error, print message and die inc lstblk ;move to next block mov r4,r0 ;restore r0 mov #lstbuf,r3 ;pt at begn of blk buf rts pc lsterr: .print #outerr ;error writing output file jmp start ;start over ; endpas: ; end of pass decb pasnum ;pass 2 done yet? beq 20$ ;yes tstb p1erf ;did we say "PASS 1" earlier? beq 10$ ;no, never mind clrb p1erf ;yes, clear flag .print #pass2 ;tell the user the listing's from pass 2 jsr pc,lstlin ;send to list file 10$: jmp pass ;do next pass 20$: ; dump symbol table to list file tst lstflg ;is there a list file? beq 30$ ;no, don't waste time sorting clr r3 ;count of non-local symbols clr r2 ;ptr to last sym mov #last,r1 ;last non-local sym checked in scan mov last+10,r0 ;pt at head of user table bne 40$ ;not empty, skip 30$: jmp 250$ ;nothing there, don't print anything 40$: cmp 2(r0),#locsym ;local symbol? beq 50$ ;yes, zap it bit #macro,(r0) ;macro? beq 60$ ;no, skip 50$: mov 10(r0),r0 ;follow link bne 40$ ;not end of list, try again br 70$ ;end, exit loop 60$: inc r3 ;bump sym count rol (r0) ;get high bit of flag word adc r2 ;set low bit of addr if undefined mov r2,(r0) ;set back ptr mov r0,10(r1) ;link from last entry ; in case we skipped some locals mov r0,r2 ;set new back ptr mov r0,r1 ;point at this block mov 10(r0),r0 ;follow link bne 40$ ;loop if not end of list 70$: clr 10(r1) ;mark end of list 80$: tst r3 ;anything worth dumping? beq 250$ ;no, don't do anything mov last+10,r5 ;yes, get a ptr to it dec r3 ;only one symbol? beq 170$ ;yes, don't sort ; now do an insertion-sort to sort the table into ascending radix-50 order mov #177776,r3 ;useful constant mov r5,r0 ;get ptr to head of table 90$: mov 10(r0),r1 ;get link to next entry beq 170$ ;end of list, done cmp 2(r0),2(r1) ;check first 3 chars bhi 100$ ;out of order, swap this el back blo 160$ ;in order, loop cmp 4(r0),4(r1) ;equal, check last 3 chars blo 160$ ;in order, loop ; swap the elements at (r0) and (r1) 100$: mov r0,-(sp) ;save ptrs mov r1,-(sp) 110$: mov (r0),r4 ;get back ptr bic #1,r4 ;clear low bit beq 120$ ;this is the begn of the list mov r1,10(r4) ;link to second block 120$: bic r3,(r1) ;clear all but bottom bit bis r4,(r1) ;OR in back ptr addr mov 10(r1),r2 ;get addr of next block beq 130$ ;this is the end of the list bic r3,(r2) ;clear all but low bit bis r0,(r2) ;set new back ptr 130$: mov r2,10(r0) ;set new next ptr mov r0,10(r1) ;link 2nd to 1st block bic r3,(r0) ;clear all but low bit bis r1,(r0) ;set new back ptr mov r4,r0 ;move back an element beq 140$ ;begn of list cmp 2(r0),2(r1) ;are these two in order? blo 150$ ;yes, reenter main loop bhi 110$ ;no, swap (r1) back another element cmp 4(r0),4(r1) ;dunno, check low word bhi 110$ ;out of order, swap br 150$ ;skip 140$: mov r1,r5 ;update head ptr 150$: mov (sp)+,r1 ;restore ptrs mov (sp)+,r0 160$: mov r1,r0 ;move to next pair br 90$ ;loop 170$: ; finished sorting, now dump the ST tstb pagflg ;anything on current page? beq 180$ ;no, skip jsr pc,newpag ;yes, start a new page 180$: mov #symdmp,ttlptr ;set new title for symbol table ; r5 is pointing at the head of the symbol table clr -(sp) ;column 0 190$: mov #symlst+6,r4 ;pt at name buffer mov #50,r0 ;radix 50 mov 4(r5),r2 ;get low word of name jsr pc,r50asc ;convert to ascii mov 2(r5),r2 ;get high word of name jsr pc,r50asc ;convert to ascii mov #symlst+13,r1 ;pt at value field ror (r5) ;is the value valid? bcc 210$ ;yes mov #4,r2 ;loop ctr 200$: movb #'?,-(r1) ;put a ? in the buffer sob r2,200$ ;do 4 of them br 220$ ;continue 210$: mov 6(r5),r0 ;get value jsr pc,cvtoct ;convert to octal 220$: mov r4,r0 ;pt at string jsr pc,lstlin ;send to list file inc (sp) ;inc column bic #4,(sp) ;done 4 col's yet? bne 230$ ;no mov #crlf,r0 ;yes, pt at cr/lf br 240$ ;skip 230$: mov #tab,r0 ;pt at tab 240$: jsr pc,lstlin ;send to list file mov 10(r5),r5 ;follow link bne 190$ ;loop tst (sp)+ ;clear stack beq 250$ ;already sent one cr/lf mov #crlf,r0 ;send a cr/lf jsr pc,lstlin ;to the list file 250$: mov #crlf,r0 ;send (another) cr/lf jsr pc,lstlin ;to the list file tst errcnt ;any errors? bne 260$ ;yes, count them .print #noerrs ;no errors, say so jsr pc,lstlin ;send to list file br 280$ ;skip 260$: .print #totlof ;"TOTAL OF " jsr pc,lstlin ;in list file, too mov #linbuf+6,r5 ;pt at buffer mov errcnt,r2 ;get # of errors jsr pc,cvtdec ;convert to decimal .print ;print string on terminal jsr pc,lstlin ;and in list file .print #errtxt ;print " ERROR" jsr pc,lstlin ;also in list file mov #s,r0 ;point at "S_" dec errcnt ;1 error? bne 270$ ;no inc r0 ;yes, don't print "S" 270$: .print ;print ["S" and] cr/lf jsr pc,lstlin ;in list file as well 280$: mov #cmdbuf,r0 ;pt at original command line jsr pc,lstlin ;send to list file tstb pagflg ;finished the page? beq 290$ ;yes, skip jsr pc,newpag ;no, send a form feed 290$: mov lstptr,r1 ;get lstbuf ptr sub #lstbuf,r1 ;subtract base beq 300$ ;buffer empty, skip clrb lstbuf(r1) ;clear a byte (in case # of bytes is odd) inc r1 ;inc ptr (in case BC is odd) asr r1 ;convert byte cnt to word cnt (chop low bit) mov r1,lstblk+4 ;set new word count ; don't send a bunch of unnecessary nuls to the .LST device (LP:, etc.) mov #larea,r0 ;pt at area emt 375 ;.WRITW the buffer bcc .+6 ;no error, hoopy jmp lsterr ;error, gack mov #400,lstblk+4 ;in case we changed it 300$: tst binflg ;is there a .BIN file? beq 310$ ;no, don't worry about it mov chksum,r0 ;yes, get checksum jsr pc,outwrd ;send to .BIN file as data ; this will also force an origin command if a ".=" statement ; was used to specify a starting address for SS BIN jsr pc,ldrtrl ;punch trailer code mov binptr,r1 ;get outbuf ptr sub #outbuf,r1 ;subtract base beq 310$ ;buffer was empty, NOP asr r1 ;convert to word count mov r1,outblk+4 ;set new WC (already on word boundary) mov #warea,r0 ;pt at area emt 375 ;.WRITW the buffer bcc .+6 ;no error, hoopy jmp bingck ;error, gack mov #400,outblk+4 ;in case we changed it 310$: .close #0 ;close chan 0, .close #1 ;chan 1, .close #2 ;and chan 2 .sreset ;close input files, dismiss handlers jmp start ;start over ; r50asc: ; convert 3-char radix-50 string in r2 to ascii, put at -3(r4) jsr pc,10$ ;do a char jsr pc,10$ ;do a char ;;; br 10$ ;do a char, return 10$: jsr pc,$div ;divide by 50 tst r1 ;' '? bne 20$ ;no rts pc ;yes, don't do anything 20$: cmp r1,#32 ;alpha? bhi 40$ ;no add #100,r1 ;yes, convert to ascii 30$: movb r1,-(r4) ;poke char rts pc 40$: add #22,r1 ;digit or '.' - convert to ascii br 30$ ;poke and return ; cvtdec: ; cvt r2 to decimal, return ptr in r0 mov r5,-(sp) ;save r5 mov #numbuf,r5 ;pt at buffer mov #10.,r0 ;cvt to decimal 10$: jsr pc,$div ;divide by 10. add #'0,r1 ;convert digit to decimal movb r1,-(r5) ;put in buffer tst r2 ;anything left? bne 10$ ;yes, loop mov r5,r0 ;copy ptr mov (sp)+,r5 ;restore r5 rts pc ; outwrd: ; send word in r0 to output file tstb datval ;is data valid? bne 10$ ;yes, so is addr mov r0,lstdat ;set data incb datval ;data is now valid mov ppc,lstadr ;set addr incb adrval ;addr is now valid 10$: tst binflg ;is there a .BIN file open? beq 30$ ;no, NOP cmpb pasnum,#2 ;pass 1? beq 30$ ;yes, not pass 2 or checksum, NOP bic #170000,r0 ;chop to 12 bits mov binptr,r3 ;point into block buffer mov r0,-(sp) ;save r0 cmp org,ppc ;do we need to do an origin? beq 20$ ;no mov ppc,r2 ;get addr bis #10000,r2 ;OR in an origin command jsr pc,sndhi ;send high byte to .BIN file mov ppc,r2 ;get addr (again) bic #7700,r2 ;clear high byte jsr pc,sndwrd ;send to .BIN file 20$: mov (sp),r2 ;get data word back sub r2,chksum ;update checksum jsr pc,sndhi ;send high byte of data mov (sp)+,r2 ;get low byte bic #7700,r2 ;clear high byte jsr pc,sndwrd ;send to .BIN file mov r3,binptr ;update ptr 30$: inc ppc ;inc ppc bic #170000,ppc ;make sure we stay in 12 bits mov ppc,org ;set origin flag rts pc ; sndhi: ; send high (PDP-8) byte of r2 to .BIN file bic #77,r2 ;clear low byte asl r2 ;shift left asl r2 ;twice swab r2 ;throw into low byte ; fall through... sndwrd: ; put r2 in .BIN block buffer at (r3) movb r2,(r3)+ ;put char in buffer cmp r3,#outbuf+1000 ;filled a block? beq 10$ ;yes, send it out rts pc ;no, return 10$: mov r0,r4 ;save r0 mov #warea,r0 ;pt at area emt 375 ;.WRITW bcs bingck ;error, print message and die inc outblk ;move to next block mov r4,r0 ;restore r0 mov #outbuf,r3 ;pt at begn of blk buf rts pc bingck: .print #binerr ;error writing binary file jmp start ;start over ; ldrtrl: ; punch leader/trailer code ; (64. bytes of 200) mov binptr,r3 ;point into buffer mov #200,r2 ;value to punch mov #100,r5 ;punch 64. of them 10$: jsr pc,sndwrd ;do one sob r5,10$ ;loop until done mov r3,binptr ;update ptr rts pc ; error: ; queue error message at @(sp) incb errflg ;set flag tstb p1err ;p1err set? bne 10$ ;yes, gack no matter what cmpb pasnum,#2 ;pass 1? beq 70$ ;yes, no error 10$: mov r0,-(sp) ;save r0 mov errque,r0 ;is there a block yet? bne 30$ ;yes, go follow chain jsr pc,getblk ;no, get a block mov r0,errque ;pt at it 20$: mov @2(sp),(r0)+ ;put in the message ptr mov r5,(r0)+ ;current ptr clr (r0)+ ;mark end of list br 60$ ;return 30$: tst 4(r0) ;is there a free space in this block? bne 40$ ;no, move to next block mov @2(sp),4(r0) ;poke the msg ptr into the blk mov r5,6(r0) ;current text ptr clr 10(r0) ;mark end of list br 60$ ;return 40$: tst 10(r0) ;is there another block? beq 50$ ;no mov 10(r0),r0 ;yes, follow link to it br 30$ ;see if there's free space in it 50$: mov r1,-(sp) ;save r1 mov r0,r1 ;copy ptr jsr pc,getblk ;get a new block mov r0,10(r1) ;link it in mov (sp)+,r1 ;restore r1 br 20$ ;poke in addresses, return 60$: inc errcnt ;inc errcnt mov (sp)+,r0 ;restore r0 70$: add #2,(sp) ;skip over pointer rts pc ; defn: ; handle "=" statements (variable definition) tst (sp)+ ;clear ptr from stack inc r5 ;skip over = sign clrb notdef ;so we can count the undef'd symbs mov r5,-(sp) ;save ptr clrb errflg ;count the errors mov ppc,dot ;set value for "." cmp nambuf,#curloc ;curr locn ctr? bne 10$ ;no decb p1err ;gack even on pass 1 br 20$ ;don't change defcal 10$: decb defcal ;tell LOOKUP who's calling 20$: mov nambuf,-(sp) ;save name mov nambuf+2,-(sp) jsr pc,eval ;try to evaluate the expression mov (sp)+,nambuf+2 ;restore name mov (sp)+,nambuf cmp nambuf,#curloc ;".="? bne 30$ ;no clrb p1err ;clear flag 30$: clrb defcal ;we're not calling anymore tstb errflg ;any errors? (UNDSYM is an error if ".=") beq 40$ ;no, good tst (sp)+ ;yes, forget it (message on pass 2) jmp list ;do next line 40$: tstb notdef ;any undefined symbols? beq 110$ ;no, save value jsr pc,maksym ;create a symbol entry bcc 60$ ;not previously defined, good bit #nochng,(r0) ;redefinable? beq 50$ ;yes mov r5,r4 ;save r5 mov errcol,r5 ;correct column for err .err muldef ;illegal redefinition mov r4,r5 ;restore r5 tst (sp)+ ;clear stack jmp list ;do next line 50$: jsr pc,unlink ;unlink the expression 60$: mov #strval,(r0) ;flags=variable, not evaluated mov (sp)+,r4 ;get old ptr mov r5,r3 ;get new ptr sub r4,r3 ;find number of chars mov r0,r1 ;save ptr jsr pc,getblk ;get a block mov r0,6(r1) ;link it to the symtab entry mov ppc,(r0)+ ;value of "." in first word mov #6,r2 ;loop counter 70$: movb (r4)+,(r0)+ ;copy a char dec r3 ;finished string? beq 80$ ;yes dec r2 ;filled block? bne 70$ ;no, loop mov r0,r1 ;yes, save ptr to block jsr pc,getblk ;get another block mov r0,(r1) ;link into chain mov #10,r2 ;8 bytes per block br 70$ ;loop 80$: dec r2 ;end of block? beq 100$ ;yes, just clear the link field 90$: clrb (r0)+ ;add a nul dec r2 ;cnt=cnt-1 add r2,r0 ;skip to link field 100$: clr (r0) ;mark end of list br 150$ ;make sure we're at the end of a line 110$: ; expression was evaluated successfully tst (sp)+ ;clear stack mov r0,lstdat ;listed in data field of listing incb datval ;set flag to print this cmp nambuf,#curloc ;curr loc ctr? bne 120$ ;no bic #170000,r0 ;force 12-bit addr mov r0,ppc ;set ppc ; origin will be sent to .BIN file before next data word br 150$ ;do next line 120$: mov r0,r4 ;save value jsr pc,maksym ;create symtab entry bcc 140$ ;not previously defined, good bit #1,(r0) ;is it redefinable? beq 130$ ;yes, good mov r5,r4 ;save r5 mov errcol,r5 ;get column of symb name (for ^) .err muldef ;multiple definition mov r4,r5 ;restore r5 jmp list ;end of line 130$: jsr pc,unlink ;unlink stored expression, if any 140$: clr (r0) ;flags=variable, evaluated mov r4,6(r0) ;value 150$: jsr pc,scan ;scan SYMTAB for newly definable exprs jmp list ;end of line ; label: ; handle "," tst (sp)+ ;clear stack inc r5 ;skip over "," cmp nambuf,#curloc ;is symbol ". "? bne 10$ ;no, good mov r5,r4 ;save r5 mov errcol,r5 ;pt at name (for ^) .err illnam ;illegal symbol name mov r4,r5 ;restore r5 br 30$ ;do rest of line 10$: jsr pc,maksym ;create symtab entry bcc 20$ ;new entry, good bit #nochng,(r0) ;redefinable? beq 40$ ;yes, so it wasn't made on last pass cmp 6(r0),ppc ;no, same value as last time? bne 40$ ;no, error ; don't need to call UNLINK because it couldn't have ; been defined with an expression (only label or permanent symtab) 20$: mov #1,(r0) ;yes, last defn was probably on pass 1 mov ppc,6(r0) ;if not, big diff cmp nambuf,#locsym ;local symbol? beq 25$ ;yes, skip mov nambuf,lstlab ;set LSTLAB to start new local symbol block mov nambuf+2,lstlab+2 ;low word 25$: jsr pc,scan ;scan SYMTAB for definable expressions 30$: mov ppc,lstadr ;set addr for listing incb adrval ;addr is valid jmp stmnt ;go do the statement (if any) 40$: mov r5,r4 ;save r5 mov errcol,r5 ;pt at symb name (for ^) .err muldef ;illegal redefinition mov r4,r5 ;restore br 30$ ;finish the line ; unlink: ; if there is a stored expression in the symtab entry at (r0), ; unlink it and return it to the free list. ; destroys r1, r2. tst (r0) ;is there a stored expression? bpl 20$ ;no, fine ; deleting this means that the expression never got defined, ; but we'll complain about that on pass 2 mov r0,r2 ;save ptr mov 6(r0),r0 ;get ptr to list 10$: mov 10(r0),r1 ;get link to next jsr pc,retblk ;return this block to free list mov r1,r0 ;any more? bne 10$ ;yes mov r2,r0 ;restore ptr 20$: rts pc ; maksym: ; create symbol table entry, return ptr to it in r0 ; if symbol already existed, C is set, else C is clear decb defcal ;no errors, please clrb notdef ;init ctr jsr pc,lookup ;look it up clrb defcal ;clear flag tstb notdef ;was it defined? bne 10$ ;no, create it mov r1,r0 ;yes, get ptr sec ;could be an error rts pc 10$: mov endtab,r1 ;pt at last symbol in table jsr pc,getblk ;get a block mov r0,endtab ;pt at new last symbol mov r0,10(r1) ;link into list clr 10(r0) ;mark new end of list mov nambuf,2(r0) ;copy name into list element mov nambuf+2,4(r0) ;low word of name clc ;no error rts pc ; scan: ; search SYMTAB for any stored expressions which may ; now be definable. called after each symbol definition. mov r5,-(sp) ;save line ptr decb defcal ;don't print any messages 10$: clr -(sp) ;success flag mov #symtab,r0 ;point at head of symbol table 20$: tst (r0) ;is there a stored expression here? bpl 70$ ;no, follow link mov 6(r0),r1 ;yes, pt at head of list mov (r1)+,dot ;set value for "." mov #expbuf,r5 ;pt at buffer mov #6,r2 ;remaining chars in this element 30$: movb (r1)+,(r5)+ ;move a char beq 50$ ;end of string, try to evaluate it sob r2,30$ ;loop until end of block mov (r1)+,r1 ;follow link beq 40$ ;zero, end of string mov #10,r2 ;8 chars per block br 30$ ;loop 40$: clrb (r5)+ ;put a nul at the end 50$: mov #expbuf,r5 ;pt at expr clrb notdef ;count undefined symbols mov r0,-(sp) ;save ptr jsr pc,eval ;try to evaluate the expression tstb notdef ;did we win? bne 60$ ;no, try next symbol mov r0,-(sp) ;yes, save value mov 2(sp),r0 ;get ptr to block jsr pc,unlink ;get rid of the expression mov (sp)+,6(r0) ;set value clr (r0) ;flags=variable, evaluated mov r5,2(sp) ;set win flag (r5 is non-zero) 60$: mov (sp)+,r0 ;get ptr to block 70$: mov 10(r0),r0 ;follow link bne 20$ ;loop if not end of list tst (sp)+ ;did we define anything? bne 10$ ;yes, make another pass clrb defcal ;you can print error msgs, now mov (sp)+,r5 ;restore ptr rts pc ; getblk: ; return ptr to a block in r0 mov freptr,r0 ;get a block beq 10$ ;out of blocks, barf mov 10(r0),freptr ;follow link rts pc 10$: tstb asked ;have we already asked for more core? beq 20$ ;no, do it .print #fultab ;yes, symbol table full jmp start ;start over 20$: mov r1,-(sp) ;save r1 mov r2,-(sp) ;and r2 .settop #-2 ;ask for everything mov hicore,r1 ;get current high addr mov r0,r2 ;save new high addr br 40$ ;jump into loop 30$: add #12,r1 ;add length of blk cmp r1,r2 ;can we fit in another blk? bhi 50$ ;no, exit loop jsr pc,retblk ;yes, link it in 40$: mov r1,r0 ;advance ptr to next candidate br 30$ ;loop 50$: incb asked ;now we've asked mov (sp)+,r2 ;restore regs mov (sp)+,r1 br getblk ;try again ; retblk: ; return block at (r0) to free list mov freptr,10(r0) ;put link mov r0,freptr ;pt at new block rts pc ; .rem $ The code for the pseudo-ops follows. These are the pseudo-ops: ASCII /text/ assembles ASCII constant, one char per word ASCIZ /text/ same as ASCII, but includes a zero at the end DEFINE name [args] define a macro MASCII /text/ same as ASCII, but negates the values of the chars PAGE [] advances to next PDP-8 memory page, or if is specified, starts at page SIXBIT /text/ assembles sixbit constant with a zero at the end, 2 chars per word (sixbit code=-40) TEXT /text/ same as SIXBIT, but uses trimmed ASCII (text code=&77) $ ; ascii: ; assemble ASCII constant clrb delim ;not in string yet 10$: jsr pc,gtext ;get a char bcs 20$ ;end of string, return jsr pc,outwrd ;send out the word br 10$ ;loop 20$: rts pc ; asciz: ; assemble ASCII constant, zero at end jsr pc,ascii ;use ASCII clr r0 ;add a zero jmp outwrd ;and return ; define: ; create a macro jsr pc,maksym ;create a symbol entry bcc 20$ ;not previously defined, good bit #1,(r0) ;redefinable? beq 10$ ;yes mov r5,r4 ;save r5 mov errcol,r5 ;correct column for err .err muldef ;illegal redefinition mov r4,r5 ;restore r5 tst (sp)+ ;clear stack jmp list ;do next line 10$: jsr pc,unlink ;unlink the expression 20$: mov #strval!macro,(r0) ;flags=macro, val field pnts to string mov r0,r1 ;save ptr jsr pc,getblk ;get a block mov r0,6(r1) ;link it to the symtab entry ;+ ; ; Get args; figure out flags [and default value] and store ; with name in block (wrap to new one if nessa). ; When we reach unknown char, gag if not comment or eol. ; Poke number of arguments to begn of first block. ; Now, set depth count to 1. Read lines, checking all ; isolated rad50 strings for args. Parse off labels, ; see if DEFINE or TERMIN; inc or dec depth accordingly. ; If depth is now zero, we're done. Otherwise continue. ; ;- bpt ;;;; this code is not done yet .rem _ mov r0,-(sp) ;save ptr to # args clrb (r0)+ ;init to 0 mov #7,r1 ;7 bytes still free in this block mov #dumarg,r4 ;point at dummy arg list defarg: jsr pc,skip ;skip to begn of next arg movb (r5),r2 ;get next char beq ... ;end of line cmp r2,#commnt ;comment? beq ... ;yes, end of line clr r3 ;init flags cmpb r2,'' ;apostrophe? bne 10$ ;no movb #strng,r3 ;yes, delimited string br 40$ ;skip 10$: cmpb r2,'" ;quotation mark? bne 20$ ;no movb #dstrn,r3 ;yes, delimited string, keep delimiters br 40$ ;skip 20$: cmpb r2,'# ;number sign? bne 40$ ;no movb #numbr,r3 ;yes, evaluate to octal constant 30$: inc r5 ;skip over the flag char jsr pc,skip ;skip to begn of name 40$: mov r0,-(sp) ;save mov r1,-(sp) jsr pc,rad50 ;get string mov (sp)+,r1 ;restore mov (sp)+,r0 mov nambuf,(r4)+ ;put name in buffer mov nambuf+2,(r4)+ incb @(sp) ;bump arg count jsr pc,skip ;skip cmpb (r5),'= ;default value? bne 50$ ;nupe bisb #deflt,r3 ;OR in default flag 50$: mov r3,r2 ;copy flags jsr pc,chblk ;put in block bitb #deflt,r3 ;was there a default? bne ... ;no inc r5 ;skip over the '=' mov r0,-(sp) ;save regs mov r1,-(sp) jsr pc,macarg ;get the default argument jsr pc,zchblk ;mark end ;;;;; _ ;;; end of .REM ; chblk: ; put char in r2 into block at posn (r0) (length in r1) dec r1 ;dec cnt bcs 20$ ;it was zero, link a new block 10$: movb r2,(r0)+ ;copy a char rts pc 20$: mov r0,r1 ;save ptr to block jsr pc,getblk ;get another block mov r0,(r1) ;link into chain mov #7,r1 ;8 bytes per block (we're using one) br 10$ ;save the char ; zchblk: ; put a zero in the character block at (r0) (length in r1) tst r1 ;at end of block? beq 10$ ;yes, zero out link field clrb (r0) ;mark end add r1,r0 ;skip to link field 10$: clr (r0) ;nuke link field (for UNLINK) rts pc ; mascii: ; assemble ASCII constant, negating each char clrb delim ;not in string yet 10$: jsr pc,gtext ;get a char bcs 20$ ;end of string, return neg r0 ;negate jsr pc,outwrd ;send out the word br 10$ ;loop 20$: rts pc ; page: ; handle PAGE p.o. movb (r5),r0 ;get char beq 30$ ;end of line cmp r0,#commnt ;comment? beq 30$ ;yes, end of line mov ppc,dot ;set value of "." clrb notdef ;so we can keep track decb p1err ;print errors even on pass 1 mov r5,errcol ;set errcol jsr pc,eval ;must be an expression clrb p1err ;clear flag tstb notdef ;any undefined symbols? bne 30$ ;yes, pretend there was no expr bit #177740,r0 ;valid page #? beq 10$ ;yes mov r5,r4 ;save r5 mov errcol,r5 ;pt at begn of expr (for ^) .err illpag ;no such page mov r4,r5 ;restore r5 br 30$ ;pretend there was no page given 10$: mov #7,r1 ;# of times to shift page # left 20$: asl r0 ;shift it sob r1,20$ ;loop until done mov r0,ppc ;set new ppc br 40$ ;go set up for listing 30$: add #200,ppc ;skip to next page bic #10177,ppc ;back up to begn of page bne 40$ ;non-zero, good .err pagovf ;wrapped around to zero 40$: ;;;;; send origin to .BIN file mov ppc,lstdat ;put in data field of listing incb datval ;set data-valid flag rts pc ; sixbit: ; SIXBIT /text/ clrb delim ;not inside delimiters 10$: jsr pc,60$ ;get a char bcs 40$ ;end of line, send the nul mov #6,r1 ;# of bits to shift 20$: asl r0 ;over a bit sob r1,20$ ;left 6 bits mov r0,-(sp) ;save the char jsr pc,60$ ;get next char bcs 30$ ;end of line, send nul add (sp)+,r0 ;add in the other char jsr pc,outwrd ;send out a word br 10$ ;loop 30$: mov (sp)+,r0 ;get the char (low byte is 0 already) br 50$ ;send it out 40$: clr r0 ;send out a zero word 50$: jmp outwrd ;send the word, return 60$: jsr pc,uctext ;get a char bcs 80$ ;end of string, return sub #40,r0 ;convert to sixbit bit #7700,r0 ;valid char? beq 70$ ;yes dec r5 ;no, back up ptr (for ^) .err illchr ;illegal char inc r5 ;correct bic #7700,r0 ;clear high byte 70$: clc ;not end of string 80$: rts pc ; text: ; TEXT /text/ clrb delim ;not inside delimiters 10$: jsr pc,60$ ;get a char bcs 40$ ;end of line, send the nul mov #6,r1 ;# of bits to shift 20$: asl r0 ;over a bit sob r1,20$ ;left 6 bits mov r0,-(sp) ;save the char jsr pc,60$ ;get next char bcs 30$ ;end of line, send nul add (sp)+,r0 ;add in the other char jsr pc,outwrd ;send out a word br 10$ ;loop 30$: mov (sp)+,r0 ;get the char (low byte is 0 already) br 50$ ;send it out 40$: clr r0 ;send out a zero word 50$: jmp outwrd ;send the word, return 60$: jsr pc,uctext ;get a char bcs 80$ ;end of string, return mov r0,r1 ;copy sub #40,r1 ;convert to sixbit bit #7700,r1 ;valid sixbit? beq 70$ ;yes, then it's valid chopped ASCII too dec r5 ;no, back up ptr (for ^) .err illchr ;illegal char inc r5 ;correct clr r0 ;return a 0 70$: bic #7700,r0 ;chop off high bit clc ;not end of string 80$: rts pc ; uctext: ; call gtext and convert char to upper case jsr pc,gtext ;get a char bcs 20$ ;end of string, return cmp r0,#'a ;lower case? blo 10$ ;no cmp r0,#'z ;sure? bhi 10$ ;no, it's not sub #40,r0 ;yes, it was, make it upper case 10$: clc ;not end of string 20$: rts pc ; gtext: ; get a char from a text constant tstb delim ;in a string? beq 40$ ;no, see if < 10$: movb (r5)+,r0 ;yes, get next char beq 80$ ;end of line, error cmpb r0,delim ;does this close the string? beq 30$ ;yes, get next arg 20$: clc ;no, everything's hoopy rts pc ;return the char 30$: clrb delim ;no longer in string 40$: cmpb (r5),#'< ;expression? beq 70$ ;yes, evaluate it movb (r5),r0 ;get char beq 90$ ;end of line, return cmp r0,#40 ;blank? beq 50$ ;yes cmp r0,#11 ;tab? bne 60$ ;no 50$: jsr pc,skip ;skip to next field ; imbedded blanks really shouldn't be allowed, but... movb (r5),r0 ;get char beq 90$ ;end of line cmp r0,#commnt ;comment? beq 90$ ;yes, end of line 60$: movb (r5)+,delim ;no, this is a new string br 10$ ;get next char from it 70$: inc r5 ;skip the < mov r1,-(sp) ;save r1 and r2 mov r2,-(sp) mov ppc,dot ;set value of "." jsr pc,eval ;get expression mov (sp)+,r2 ;restore r2 and r1 mov (sp)+,r1 cmpb (r5)+,#'> ;matching >? beq 20$ ;yes, good dec r5 ;back up 80$: .err illchr ;illegal character 90$: sec ;end of line rts pc ; title: ; handle TITLE pseudo-op jsr pc,skip ;skip to begn of title mov #ttl,r4 ;pt at title buffer mov r4,ttlptr ;set ptr ; (it would have been something else only if the ; first input filename was less than 6 chars long) 10$: movb (r5)+,r0 ;get a char beq 30$ ;end of string, return cmp r0,#11 ;tab? beq 20$ ;yes, ok cmp r0,#37 ;other ctrl char? blos 30$ ;yes, illegal cmp r0,#177 ;rubout? beq 30$ ;yes, illegal 20$: movb r0,(r4)+ ;copy the char br 10$ ;loop until all copied ; this will never overrun the TITLE buffer because ; the line at (r5) has already been checked for length 30$: dec r5 ;back up to show the char to LIST clrb (r4) ;mark end of buffer rts pc ; skip: ;skip to next non-blank, non-tab char cmpb (r5),#40 ;space? beq 10$ ;yes cmpb (r5),#11 ;tab? bne 20$ ;no 10$: inc r5 ;inc ptr br skip ;loop 20$: rts pc ; eval: ;evaluate expression at (r5) jsr pc,skip ;skip to non-blank jsr pc,eval1 ;evaluate a sub-expression mov r0,-(sp) ;save cmp r0,#5777 ;MRI? bhi 10$ ;no, never mind jsr pc,skip ;yes, skip to next field mov r5,-(sp) ;save r5 jsr pc,rad50 ;try to read a field cmp nambuf,#^RI ;i, two blanks? bne 7$ ;no cmpb (r5),#40 ;followed by a space or ctrl char? bhi 7$ ;no tst (sp)+ ;yes, drop old ptr bis #400,(sp) ;set indirect bit br 10$ ;do next field 7$: mov (sp)+,r5 ;restore ptr 10$: jsr pc,skip ;skip to next field movb (r5),r0 ;get curr char cmp r0,#'. ;see if valid char in expression beq 40$ ;yep cmp r0,#'+ beq 40$ cmp r0,#'- beq 40$ cmp r0,#'< beq 40$ mov r5,-(sp) ;save ptr jsr pc,rad50 ;see if rad50 mov (sp)+,r5 ;get back old ptr tst nambuf ;did anything happen? bne 40$ ;yes, there's another field mov (sp)+,r0 ;no, get value rts pc 40$: jsr pc,eval1 ;get next expression mov (sp),r1 ;get current accumulator cmp r1,#6000 ;MRI? bhis 80$ ;no mov r0,r1 ;yes, copy new field bic #177,r1 ;clear low 7 bits bne 50$ ;not page zero, skip bit (sp),#200 ;is on-page bit set? beq 70$ ;no, skip dec r5 ;back up ptr (for ^) .err pagcon ;page bit conflict inc r5 ;correct br 70$ ;OR it in anyway 50$: mov ppc,r2 ;get ppc bic #177,r2 ;clear low 7 bits cmp r1,r2 ;in same page? beq 60$ ;yes, good dec r5 ;no, back up ptr (for ^) .err offpag ;error inc r5 ;correct 60$: bic #7600,r0 ;clear high five bits bis #200,r0 ;set on-page bit 70$: bis r0,(sp) ;OR into current AC br 10$ ;loop 80$: cmp r1,#7000 ;IOT? blo 70$ ;yes, just OR it in ; it must be an operate instruction mov (sp),r1 ;get into r1 cmp r1,#7200 ;CLA? beq 70$ ;yes, don't bother to check group cmp r0,#7200 ;CLA? beq 70$ ;same (all groups include CLA) bit #400,r1 ;group 1? bne 110$ ;no, group 2 or 3 (including EAE) ; group 1 bit #400,r0 ;is this from some other group? beq 100$ ;no, good 90$: dec r5 ;back up ptr (for ^) .err oprgrp ;opr group conflict inc r5 ;correct 100$: bit #16,r1 ;do we already have a rotate? beq 70$ ;no, anything is OK bit #16,r0 ;yes, make sure no conflicting bits beq 70$ ;no conflict, good dec r5 ;back up ptr (for ^) .err rotcon ;rotate conflict inc r5 ;correct 110$: bit #1,r1 ;group 2? bne 120$ ;no, must be group 3 ; group 2 bit #400,r0 ;both group 2? beq 90$ ;no, group 1, error bit #1,r0 ;group 2? bne 90$ ;no, error bit #170,r1 ;do we already have a skip? beq 70$ ;no, anything is OK bit #170,r0 ;yes, are we adding another? beq 70$ ;no, don't worry about it bic #7767,r1 ;clear all but skip group bit mov r1,-(sp) ;save mov r0,r1 ;copy r0 bic #7767,r1 ;get AND/OR group bit cmp r1,(sp)+ ;bits match? beq 70$ ;yes, good dec r5 ;back up ptr (for ^) .err skpcon ;skip conflict inc r5 ;fix it 120$: ; group 3 (including EAE) bit #400,r0 ;both group 2? beq 90$ ;no, group 1, error bit #1,r0 ;group 2? beq 90$ ;no, error br 70$ ;yes, go OR in the new instr ; ; I don't know what the deal is with the NMI instruction; ; can there be other group 3 opr's but no EAE stuff, or does ; the NMI have to be completely alone? ; eval1: ;evaluate up to next unrecognized char (including blank) jsr pc,primry ;get a primary mov r0,-(sp) ;save value evloop: movb (r5),r0 ;get operator mov #optab,r1 ;pt at operator table mov #6,r2 ;# of operators 10$: cmp r0,(r1)+ ;is this it? beq 20$ ;yes tst (r1)+ ;no, skip addr sob r2,10$ ;loop until checked all 6 mov (sp)+,r0 ;end of expr, get total rts pc 20$: inc r5 ;skip over operator mov (r1)+,-(sp) ;save addr jsr pc,primry ;get next primary jmp @(sp)+ ;go handle operator ; plus: ; + add r0,(sp) ;add the two #'s br evloop ;jump into loop ; minus: ; - sub r0,(sp) ;subtract br evloop ;jump into loop ; times: ; * clr r1 ;AC mov (sp),r2 ;get multiplicand mov #20,r3 ;bit counter 10$: ror r2 ;get a bit into C bcc 20$ ;clear, don't add add r0,r1 ;set, add 20$: asl r0 ;shift left sob r3,10$ ;loop 16 times mov r1,(sp) ;yes, get product br evloop ;jump back into loop ; divby: ; % mov (sp),r2 ;get dividend jsr pc,$div ;do the divide mov r2,(sp) ;save result br evloop ;back to the loop ; $div: ;r2=r2/r0, r1=r2 mod r0 clr r1 ;AC mov #20,r3 ;bit counter 10$: asl r2 ;get a bit rol r1 ;into AC cmp r1,r0 ;would the rem. survive a subtract? blo 20$ ;no sub r0,r1 ;yes, subtract divisor from it 20$: adc r2 ;rotate new bit into r2 sob r3,10$ ;loop 16 times com r2 ;correct (C always flipped) rts pc ; and: ; & com r0 ;flip all the bits bic r0,(sp) ;AND into AC br evloop ;return to loop ; or: ; ! bis r0,(sp) ;OR into AC br evloop ;return to loop ; primry: ; evaluate a primary, return value in r0 clr -(sp) ;sign='+' cmpb (r5),#'+ ;plus? beq 10$ ;yes cmpb (r5),#'- ;minus? bne 20$ ;no com (sp) ;yes, set flag 10$: inc r5 ;skip sign char 20$: cmpb (r5),#'" ;double quote? bne 40$ ;no inc r5 ;yes, skip movb (r5)+,r0 ;get char bne 120$ ;not eol, hoopy, return 30$: dec r5 ;un-skip char .err illchr ;gone off eol, err br 120$ ;return 40$: cmpb (r5),#'< ;subexpr? bne 50$ ;no inc r5 ;yes, skip jsr pc,eval ;evaluate subexpr cmpb (r5)+,#'> ;closing broket? bne 30$ ;no, error br 120$ ;yes, return 50$: cmpb (r5),#'0 ;digit? blo 100$ ;no cmpb (r5),#'9 ;digit? bhi 100$ ;no mov r5,-(sp) ;yes, save ptr jsr pc,deciml ;try converting to decimal first cmpb (r5),#'. ;was it in fact decimal? bne 60$ ;no inc r5 ;yes, skip over decimal point tst (sp)+ ;clear stack br 120$ ;return 60$: mov (sp)+,r5 ;restore ptr clr r0 ;clear AC 70$: movb (r5)+,r1 ;get a char sub #'0,r1 ;convert to binary, see if digit blo 90$ ;not digit, end of number cmp r1,#9. ;decimal digit? bhi 90$ ;no, end of number cmp r1,#7 ;octal digit? blos 80$ ;yes dec r5 ;no, back up ptr (for ^) .err illoct ;bitch inc r5 ;restore 80$: asl r0 ;r0=r0*8 asl r0 asl r0 add r1,r0 ;add in new digit br 70$ ;loop 90$: dec r5 ;back up br 120$ ;return 100$: jsr pc,rad50 ;convert to radix 50 tst nambuf ;was there anything there? bne 110$ ;yes, continue .err illchr ;no, error clr r0 ;return 0 br 120$ ;exit 110$: jsr pc,lookup ;look up the symbol 120$: tst (sp)+ ;was sign negative? bpl 130$ ;no neg r0 ;yes, negate 130$: rts pc ; deciml: ; convert decimal string at (r5) to binary, return in r0 ; destroys r0,r1 clr r0 ;clear accumulator 10$: movb (r5),r1 ;get char sub #'0,r1 ;digit? blo 20$ ;no cmp r1,#9. ;digit? bhi 20$ ;no ; should check for overflow during the multiply here mov r0,-(sp) ;save r0 asl r0 ;*2 asl r0 ;*2 add (sp)+,r0 ;+r0 asl r0 ;*2 =r0*10. add r1,r0 ;add in new digit inc r5 ;inc ptr br 10$ ;loop 20$: rts pc ; rad50: ; convert symbol name at (r5) to radix-50 in NAMBUF ; actually, don't use full radix-50, just numbers, letters, and . ; first check to see if this is a local symbol ; destroys r0,r1 cmpb (r5),#'. ;does it start with a period? bne notloc ;no, don't even bother mov r5,-(sp) ;save r5 (in case it's not a local sym) inc r5 ;skip over the . mov r5,-(sp) ;save again jsr pc,deciml ;convert # to binary cmp r5,(sp)+ ;any change? beq 20$ ;no, no digits, can't be local cmp r1,#'.-'0 ;is this a radix-50 char? beq 20$ ;yes, never mind cmp r1,#'A-'0 ;eh? blo 10$ ;no, skip cmp r1,#'Z-'0 ;one more test... blos 20$ ;alphabetic, never mind 10$: mov #locsym,nambuf ;mark as a local label (leading space) mov r0,nambuf+2 ;value of number tst (sp)+ ;clear stack rts pc 20$: mov (sp)+,r5 ;no dice, restore r5 notloc: jsr pc,20$ ;do first 3 chars mov r0,nambuf ;save jsr pc,20$ ;do second 3 chars mov r0,nambuf+2 ;save 10$: clr r0 ;clear accumulator jsr pc,eatchr ;see if there's another char tst r0 ;any change? bne 10$ ;yes, try again ; this allows for symbols more than 6 chars long (ignores extra chars) rts pc 20$: clr r0 ;accumulator jsr pc,30$ ;do first char jsr pc,30$ ;do second char ;;; jsr pc,30$ ;do third char ;;; rts pc ;;; (fall through) 30$: mov r0,r1 ;copy r0 (prepare to multiply) asl r0 ;r0=r0*2 asl r0 ;*2 add r1,r0 ;+r0 (=r0*5) asl r0 ;r0=r0*8. asl r0 asl r0 ;altogether, r0=r0*50 eatchr: movb (r5),r1 ;get current char cmp r1,#'a ;lower case? blo 10$ ;no sub #40,r1 ;yes, convert ; it doesn't matter if r1 is really {|}~, because ; these convert to [\]^_, which are also invalid. 10$: cmp r1,#'. ;period? bne 20$ ;no add #34,r0 ;yes, add in code for period br 40$ ;return 20$: cmp r1,#'0 ;digit? blo 50$ ;no, not valid rad50 char cmp r1,#'9 ;digit? bhi 30$ ;no, skip sub #22,r1 ;convert to rad50 add r1,r0 ;add to total br 40$ ;return 30$: cmp r1,#'A ;letter? blo 50$ ;no, invalid cmp r1,#'Z ;letter? bhi 50$ ;no, invalid sub #100,r1 ;convert to rad50 add r1,r0 ;add to total 40$: inc r5 ;skip the char 50$: rts pc ; lookup: ; look up symbol in NAMBUF on symbol table, return value in r0 ; destroys r1 cmp nambuf,#curloc ;current loc ptr? bne 10$ ;no mov dot,r0 ;get value br 50$ ;return 10$: mov #symtab,r1 ;pt at symbol table cmp nambuf,#locsym ;local symbol? beq 80$ ;yes, special case 30$: cmp nambuf,2(r1) ;do the first 3 chars match? bne 70$ ;no cmp nambuf+2,4(r1) ;yes, how about the second 3? bne 70$ ;no 40$: tst (r1) ;defined? bmi 60$ ;no mov 6(r1),r0 ;yes, get value 50$: rts pc 60$: tstb defcal ;called by DEFN? bne 65$ ;yes, no error message dec r5 ;no, pt at last char of symbol .err undsym ;error inc r5 ;correct 65$: incb notdef ;remember that it wasn't defined clr r0 ;return 0 rts pc 70$: mov 10(r1),r1 ;end of the list? bne 30$ ;no, loop br 60$ ;no such symbol, error 80$: cmp lstlab,2(r1) ;do first 3 chars of last symbol match? bne 100$ ;no cmp lstlab+2,4(r1) ;yes, how about the second 3? bne 100$ ;no 90$: mov 10(r1),r1 ;skip to next symbol beq 60$ ;end of list, error cmp 2(r1),#locsym ;is it a local symb? bne 60$ ;no, undefined, error cmp 4(r1),nambuf+2 ;is this the symbol? beq 40$ ;yes, return its value br 90$ ;no, loop 100$: mov 10(r1),r1 ;move to next symbol - it must be defined br 80$ ;or it wouldn't be in LSTLAB ; ppc: .word ;pseudo program counter dot: .word ;value used by EVAL for "." (usually =PPC ;but not while evaluating a stored expression) org: .word ;current loc ctr as sent to .BIN file chksum: .word ;2's complement of sum of all data words in .BIN file nambuf: .blkw 2 ;buffer for radix-50 symbol name lstlab: .blkw 2 ;last non-local label defined errcnt: .word ;number of error messages printed errcol: .word ;buffer for r5 in case of error (^ column) freptr: .word ;ptr to begn of free list (symbol table) endtab: .word ;ptr to last symbol in symbol table binflg: .word ;if non-zero, .BIN file is open lstflg: .word ;if non-zero, .LST file is open ;bit 15 on both of above is 1 if block device, ;0 if sequential device lstadr: .word ;word to put in addr field of listing lstdat: .word ;word to put in data field of listing ttlptr: .word ;ptr to TITLE string (.asciz) errque: .word ;ptr to linked list of error ptrs ;this way the idiot can have thousands of ;errors on each line without crashing PALX line: .word ;current line number (for listing) pagnum: .word ;current page number (for listing) hicore: .word ;ptr to first word after symbol table, ;used when we ask for more core (swap USR) ; defext: .rad50 /PAL/ ;input extension .rad50 /BIN/ ;first output file .rad50 /LST/ ;second output file .rad50 /SYM/ ;there shouldn't be a third file ; rarea: .byte 3,10 ;.readw, channel 3 (to start with, anyway) inblk: .word ;block number .word inbuf ;buffer .word 400 ;word count (one block) .word 0 inptr: .word ;ptr to current offset into input block ; warea: .byte 0,11 ;.writw, channel 0 (.BIN file) outblk: .word ;block number .word outbuf ;buffer .word 400 ;word count (one block) .word 0 binptr: .word ;ptr to current offset into output block ; larea: .byte 1,11 ;.writw, channel 1 (.LST file) lstblk: .word ;block number .word lstbuf ;buffer .word 400 ;word count (one block) .word 0 lstptr: .word ;ptr to current offset into output block ; optab: ;binary operators and vectors .word '+,plus ;add .word '-,minus ;subtract .word '*,times ;multiply .if ne commnt-'/ .word '/,divby ;divide .iff .word '%,divby ;divide ('/' is used for comments) .endc .word '&,and ;logical AND .word '!,or ;logical OR ; potab: ; table of pseudo-op names and addresses .rad50 /.ASCII/ .word ascii .rad50 /.ASCIZ/ .word asciz .rad50 /.DEFIN/ .word define .rad50 /.MASCI/ .word mascii .rad50 /.PAGE / .word page .rad50 /.SIXBI/ .word sixbit .rad50 /.TEXT / .word text .rad50 /.TITLE/ .word title numpo= <.-potab>/6 ;# of pseudo-ops in table ; ; random error messages: nocore: .asciz /?PALX-U-Unable to allocate memory for symbol table/ fultab: .asciz /?PALX-F-Symbol table full/ hrderr: .asciz /?PALX-F-Hard error on input file/ outerr: .asciz /?PALX-F-Error writing to list file/ binerr: .asciz /?PALX-F-Error writing to binary file/ illopt: .asciz /?PALX-F-Illegal switch/ ; assembly error messages: illchr: .ascii /ILLEGAL CHARACTER /<200> illpag: .ascii /ILLEGAL PAGE NUMBER /<200> muldef: .ascii /ILLEGAL REDEFINITION /<200> illnam: .ascii /ILLEGAL SYMBOL NAME /<200> linlng: .ascii /LINE TOO LONG /<200> dollar: .asciz /NO $ STATEMENT/ illoct: .ascii /NOT OCTAL DIGIT /<200> offpag: .ascii /OFF-PAGE REFERENCE /<200> oprgrp: .ascii /OPERATE GROUP MISMATCH /<200> pagovf: .ascii /OUT OF PAGES /<200> pagcon: .ascii /PAGE CONFLICT /<200> pass1: .asciz /PASS 1/ pass2: .asciz /PASS 2/ rotcon: .ascii /ROTATE CONFLICT /<200> skpcon: .ascii /SKIP CONFLICT /<200> undsym: .ascii /UNDEFINED SYMBOL /<200> ; noerrs: .asciz /NO ERRORS/ totlof: .ascii /TOTAL OF /<200> errtxt: .ascii / ERROR/<200> s: .asciz /S/ ; .blkb 5 ;buffer for numbers numbuf: .byte 200 ;mark end of string ; header: .ascii /PAL-X V01, RT-11 V04/ by.me: .ascii / by John Wilson/<11> ; the first space in BY.ME is zeroed for the program ID, and then ; restored to <40> for use in page headers (.LST file) date: .ascii / /<11>/Page /<200> ttl: .blkb 133.-5 ;TITLE - <132. cols-len("TITLE")+len(nul)> symdmp: .asciz /Symbol Table/ ;replaces title during symbol table dump cmdbuf: .byte 15,12 ;cr/lf .blkb 81. ;buffer for command line (print at end of listing) crlf: .byte 0 tab: .byte 11,200 ;tab formfd: .byte 14,200 ;form feed months: .ascii /JanFebMarAprMayJunJulAugSepOctNovDec/ ;for listing ;;;ttlflg: .byte ;if non-zero, title has been set ;;;;; used only if a second TITLE statement is to be considered an error linnum: .ascii /LLLLL/<9.>/ / ;line number addr: .ascii /AAAA/<9.> ;address data: .ascii /DDDD/<9.> ;data linbuf: .blkb 133. ;current input line, 132. chars+nul .even ;EXPBUF must be on a word boundary ;because .CSISPC uses it for OUTSPC, dumarg= . ;and DEFINE uses it for .rad50 dummy ;argument names. expbuf: .blkb 131. ;buffer for saved exprs, 130. chars+nul ;(must be >= argmax*4) endlin: .byte ;char used to end current input line (ff/lf) linpag: .byte ;current line on the page pagflg: .byte ;if zero, we are at the beginning of a new page symlst: .ascii /SYMNAM/<11>/####/<200> ;buffer for symbol table dump delim: .byte ;current delimiter in a text pseudo-op pasnum: .byte ;2=pass 1, 1=pass 2 notdef: .byte ;incremented for each undefined symbol ;found during an expression evaluation defcal: .byte 0 ;if not zero, DEFN is calling (used by LOOKUP) p1err: .byte 0 ;if <>0, print error message even if pass 1 p1erf: .byte ;if <>0, "PASS 1" has been displayed adrval: .byte ;if non-zero, print LSTADR in listing datval: .byte ;if non-zero, print LSTDAT in listing endflg: .byte ;if non-zero, go to ENDPAS after LIST errflg: .byte ;inc'ed each time ERROR is called asked: .byte ;if non-zero, .SETTOP #-2 has been done .even ; inbuf: .blkw 400 ;block buffer for input (.PAL) outbuf: .blkw 400 ;block buffer for output (.BIN) lstbuf: .blkw 400 ;block buffer for list file (.LST) .rem $ Symbol table entry format: *-------------* 0 | flag word | see below |-------------| 2 | S Y M | (RAD50) (" ." if local label) |-------------| 4 | N A M | (= label number if local label) |-------------| 6 | value/ptr | value of the symbol |-------------| 10 | ptr to next | link to next entry *-------------* Flag word bits: 15 - 0=val is value, 1=val is ptr to string (expression) 1 - 1=macro, 0=normal symbol 0 - 1=label (not redefinable), 0=variable (redefinable) If bit 15 is 1, word 6 points to a list of text blocks: *-------------* 0 | char | char | |------+------| 2 | char | char | if a char=0, it marks |------+------| 4 | char | char | the end of the expression. |------+------| 6 | char | char | |-------------| 10 | ptr to next | if ptr=0, this is the last block (implies 0 char) *-------------* In expressions, the first two chars of the first block in the chain contain the value of "." which should be used in the expression. In macros, the character block is laid out as follows: .byte n ;number of arguments .rept n ;for each arg... .byte flags ;described at top of program .iif ne flags&deflt, .asciz /default value/ ;default value .endr .asciz /body of macro/ ;see below Within the body of the macro, dummy arguments are represented by argument numbers (first arg is number 0, second is 1, etc.) with their high bits set. $ symtab: ; symbol table ; MRI's (memory-reference instructions): .sym ,0000 .sym ,1000 .sym ,2000 .sym ,3000 .sym ,4000 .sym ,5000 ; IOT's (I/O traps): .sym ,6000 ; interrupt system IOTs: .sym ,6000 ;skip if interrupts enabled, IOF .sym ,6001 ;turn on interrupt system .sym ,6002 ;turn off interrupt system .sym ,6003 ;skip on interrupt request .sym ,6004 ;get flags .sym ,6005 ;restore flags, ION .sym ,6006 ;skip on greater-than .sym ,6007 ;clear all flags (reset external devices) ; KM-8/e timeshare and memory extension IOTs: .sym ,6201 ;set data field to N (62N1) .sym ,6202 ;set instruction field to N (62N2) .sym ,6203 ;set both fields to N (62N3) [CIF CDF] .sym ,6204 ;clear user interrupt (timeshare) .sym ,6214 ;read data field .sym ,6224 ;read instruction field .sym ,6234 ;read interrupt buffer .sym ,6244 ;restore memory field .sym ,6254 ;skip on user interrupt (timeshare) .sym ,6264 ;clear user flag (timeshare) .sym ,6274 ;set user flag (timeshare) ; KL-8/e Teletype control IOTs: .sym ,6030 ;clear keyboard flag .sym ,6031 ;skip on keyboard flag .sym ,6032 ;clear keyboard flag & AC, set LSR run flag .sym ,6034 ;read keyboard buffer, static (IOR w/AC) .sym ,6035 ;set int enable from AC11 (1=enabled) .sym ,6036 ;read keyboard buffer, dynamic (KCC KRS) .sym ,6040 ;set printer flag .sym ,6041 ;skip on printer flag .sym ,6042 ;clear printer flag .sym ,6044 ;transmit AC to printer .sym ,6045 ;skip on printer or keyboard (!) flag and ION .sym ,6046 ;load teleprinter sequence (TCF TPC) ; operate instructions: .sym ,7000 ; group 1 opr: .sym ,7000 .sym ,7001 .sym ,7002 .sym ,7004 .sym ,7006 .sym ,7010 .sym ,7012 .sym ,7020 .sym ,7040 .sym ,7041 ;CMA IAC .sym ,7100 .sym ,7120 ;CLL CML .sym ,7200 .sym ,7204 ;CLA RAL .sym ,7240 ;CLA CMA ; group 2 opr: .sym ,7402 .sym ,7404 .sym ,7410 .sym ,7420 .sym ,7430 .sym ,7440 .sym ,7450 .sym ,7500 .sym ,7510 .sym ,7604 ; group 3 opr: .sym ,7421 ;MQ=AC, AC=0 .sym ,7501 ;MQ=MQ!AC .sym ,7621 ;AC=0, MQ=0 .sym ,7521 ;swap AC and MQ last: .sym ,7701 ;AC=MQ ; devhnd= . ;device handlers load here ; symbol table follows last device handler ; .end palx ;