home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
cpm80
/
mac80a.mac
< prev
next >
Wrap
Text File
|
2020-01-01
|
60KB
|
2,731 lines
;MAC80 - An 8085 cross assembler for the DECsystem-10
; Copyright 1976,1977,1978,1983
; Bruce Tanner / Cerritos College
; 11110 Alondra Blvd.
; Norwalk, CA 90650
SEARCH M80UNV,MACTEN
TITLE. (M80,MAC80A,8085 Cross Assembler)
M80TTL
M80PTX
TWOSEG
RELOC 400000
EXTERN IBUF,OBUF,LBUF,SBUF,MBUF,NOFILE,FILNAM,FILEXT,PPN,OPNOBJ
EXTERN CREFSW,SYMBSW
MAC80A::MOVE T1,[PUSHJ P,UUO]
MOVEM T1,.JB41##
MOVE T1,[IOWD 20,MACSTK]
MOVEM T1,MACPDL
MOVE T1,[IOWD 20,ARGSTK]
MOVEM T1,ARGPDL
MOVEI T1,-1
MOVEM T1,INVECT
MOVE T1,[POINT 7,MACARG]
MOVEM T1,ARGPTR
MOVEI T1,1
MOVEM T1,PAGENO
SETZM LOCSYM
MOVEI T1,PAGEMX
MOVEM T1,PAGESZ
SETOM STARTA
SETZB E,LBTP
SETZ BC,
SETZM ORGXR
TDO F,[FL.LNR,,FR.PS1!FR.HEX]
RESTAR: TRNE F,FR.PS1 ;PASS1?
JRST PASS1 ;YES
OUTSTR [ASCIZ/Pass 2
/]
SETZM PC
SETZM LINENO
SETZM LOCSYM
MOVEI T1,PAGEMX
MOVEM T1,PAGESZ
PUSHJ P,GTDATE
PUSHJ P,DOHEAD ;OUTPUT THE HEADINGS
; JRST MAIN. ;JUMP TO THE MAIN LINE
MAIN.: TRZ F,FR.LOP ;CLEAR LIST OP FLAG
TRZE F,FR.END ;IF END
JRST ENDIT ;FINI
PUSHJ P,INCH ;SNEAK A LOOK FOR FF
TRNN F,FR.LIB ;IF NOT IN MACLIB
PUSHJ P,DOLINO ;PRINT LINE #
PUSHJ P,TOKEN1 ;GET TOKEN WITH 1ST CHAR IN I
JRST MAIN1
DUNTAG: TRZE F,FR.END ;DONE?
JRST ENDIT ;YES
PUSHJ P,TOKEN ;GET A TOKEN
MAIN1: PUSHJ P,IFPOP ;AN "IF" TYPE PSEUDO OP?
JRST NOTEST ;YES
TRNE F,FR.OFF ;ASSEMBLING?
JRST FLUSHX ;NO
NOTEST: JUMPN TOK,.+4 ;SKIP IF SOMETHING
CAIE I,CR ;EOL?
CAIN I,SEMICO ;COMMENT?
JRST FLUSHX ;YES
CAIN I,COLON ;TAG?
JRST DOTAG ;YES
PUSHJ P,SRCHOP ;SEARCH OPCODE
JRST [PUSHJ P,SETMAC
JRST MAIN.]
MOVE OP,OPCTAB(X) ;STORE THE OPCODE
MOVE P1,TYPLSH(X) ;GET TYPE,,SHIFT
TLNE P1,T.POP ;PSEUDO OP?
JRST [PUSHJ P,PSEUDO ;YUP
JRST MAIN.]
TLNE P1,T.1BYT ;JUST OPCODE?
JRST ONEOP ;1 BYTE INSTRUCTION
TLNE P1,T.NREG ;USES REGISTER?
JRST BYTE3 ;NO REGISTER
DOREG: PUSHJ P,TOKEN ;GET THE NEXT TOKEN
PUSHJ P,EVAL ;EVALUATE THE TOKEN
CAIL T1,10 ;LEGAL REGISTER?
WARN W.REG ;NO.
ANDI T1,7 ;MAKE LEGAL
TRNE P1,4 ;REGISTER PAIR?
LSH T1,-1 ;YES, MAKE 2 BITS WIDE
LSH T1,(P1) ;SHIFT ACCORDING TO LSH(X)
OR OP,T1 ;MERGE
TLZE P1,T.MOV ;A MOVE?
JRST [TRZ P1,-1 ;YES - CLEAR LSH
JRST DOREG] ;AND MERGE OTHER REG
TLNE P1,T.2BYT!T.3BYT ;2 OR 3 BYTE INSTR?
JRST BYTE3 ;GO ON AND DO DATA BYTES
ONEOP: PUSHJ P,OUTOP ;OUTPUT THE ONE BYTE
PUSHJ P,SPACE4
PUSHJ P,SPACE4
FLUSHX: PUSHJ P,FLUSH ;FLUSH THE REST OF THE LINE
JRST MAIN.
BYTE3: PUSHJ P,LSTPC ;OUTPUT THE OPCODE
MOVE T1,OP
PUSHJ P,LSTOP
PUSHJ P,TOKEN ;GET THE DATA BYTE(S)
JUMPN TOK,NOTMT ;NOT EMPTY
CAIE I,15 ;BREAK ON EOL?
CAIN I,SEMICO
WARN W.MT ;DEFENSIVE CODE
NOTMT: PUSHJ P,DODATA ;COMP. EFFECTIVE ADDR
MOVE T1,OP
PUSHJ P,LSTOP ;OUTPUT THE LOWER 8 BITS
LSH OP,-10 ;SHIFT DOWN
TLNE P1,T.2BYT ;JUST 1 DATA BYTE?
JRST NOP1
MOVE T1,OP
PUSHJ P,LSTOP ;OUTPUT UPPER 8 BITS
NOP1:
IFN FTREL,<
SETZ T1, ;CLEAR FOR TEST
TRZE F,FR.REL ;RELOCATABLE?
MOVEI T1,"'" ;FLAG AS
TRZE F,FR.EXT ;EXTERNAL?
MOVEI T1,"*" ;INDICATOR
SKIPE T1 ;ANYTHING THERE?
PUSHJ P,LOUCH ;YES, PRINT IT
> ;END IFN FTREL
TLNE P1,T.2BYT ;NEED SPACES?
PUSHJ P,SPACE4 ;YES
JRST FLUSHX ;LOOP
SPACE4: TRNE F,FR.HEX
POPJ P,
MOVEI T1,SPACE
REPEAT 4,<
PUSHJ P,LOUCH>
POPJ P,
;EVAL TOKEN IN TOK (AND REST OF EXPR IF ANY) RETURN VALUE IN OP
DODATA: TRZ F,FR.UND ;CLEAR STATUS
SETZM EXPLVL ;INIT EXPR LEVEL
MOVE T4,[IOWD 20,OPSTK]
PUSH T4,[DOLLAR] ;FLAG TOP OF STACK
SETZ T2, ;CLEAR FLAG
PUSH P,T2
JRST DODT12 ;JUMP IN
DODAT1: CAIE I,COMMA
CAIN I,SEMICO ;KNOWN TERMINATORS?
JRST DODAT4 ;YES
CAIE I,")" ;END OF EXPR
CAIN I,CR ;OR EOL?
JRST DODAT4 ;YES
CAIE I,"<" ;SPECIAL CASE TEST FOR <=,>=,<>
CAIN I,">"
PUSHJ P,OP2CH ;CHECK FOR 2 CHAR OPCODE
PUSH T4,I ;SAVE ON OP STACK
CAIE I,SPACE
CAIN I,TAB ;IF SPACE OR TAB
CAIA ;KEEP LOOKING FOR OP
JRST DODT10 ;HAVE OP ON STACK, GET 2ND ARG
POP T4,(T4) ;OP IS JUST SPACE OR TAB
PUSHJ P,TOKEN ;GET OP TOKEN
JUMPE TOK,DODAT1 ;OP IS BREAK, DODAT1 WILL DO IT
PUSH T4,TOK ;SAVE OP AS 6BIT TOKEN
;AT THIS POINT I MAY CONTAIN UNARY OP.
CAIE I,SPACE
CAIN I,TAB ;BETTER CONTAIN SPACE
JRST DODT10
CAIN I,MINUS ;UNARY MINUS?
JRST [PUSH P,T2
JRST DODT21] ;YES
CAIE I,"(" ;THIS IS THE ONLY NON BLANK THING ALLOWED
ERROR F.ILEX
DODT10: PUSH P,T2
CAIE I,"(" ;DON'T LET TOKEN BUST INTO EXPR
PUSHJ P,TOKEN ;GET NEXT TOKEN
DODT12: SKIPE TOK ;IF NO TOKEN
JRST DODT20
CAIN I,MINUS ;THEN THIS IS A UNARY MINUS
DODT21: MOVEI I,"@" ;SPECIAL SYMBOL FOR UNARY MINUS
DODT20: CAME TOK,[SIXBIT/NOT/] ;THE OTHER UNARY OPERATOR?
CAMN TOK,[SIXBIT/HIGH/]
JRST DODT23 ;YES
CAME TOK,[SIXBIT/LOW/]
CAMN TOK,[SIXBIT/LO/]
JRST DODT23
CAME TOK,[SIXBIT/NUL/]
CAMN TOK,[SIXBIT/NULL/]
JRST DODT23
JRST DODT22 ;NO, SKIP
DODT23: POP P,T2 ;RESTORE T2
PUSH T4,TOK ;SAVE OP
SETZB T1,TOK ;CLEAR TOK IN CASE NOT(EXPR)
SETZ TOK+1,
PUSH P,T1 ;SAVE DUMMY ARG (DUMMY NOT FOO)
JRST DODT10 ;NOW GET A TOKEN
DODT22: PUSHJ P,EVALD ;EVAL TOKEN (OR EXPR)
POP P,T2
DODT13: PUSH P,I ;SAVE I
MOVE I,(T4) ;GET LAST OP
CAIN I,DOLLAR ;NO LAST OP?
JRST DODT14 ;SKIP
PUSHJ P,DINDEX ;GET INDEX IN T3
MOVE OP,PRIOR(T3) ;GET PRIORITY OF LAST OP IN T3 (1 IS HIGEST)
MOVE I,-1(T4) ;GET OP PREVIOUS TO LAST OP
CAIN I,DOLLAR ;NOT THERE?
JRST DODT14 ;SKIP
PUSHJ P,DINDEX ;GET INDEX OF THIS ONE
CAML OP,PRIOR(T3) ;CAN WE EVAL YET?
JRST DODT15 ;YES
;NOTE: THIS IMPLIES LEFT-TO-RIGHT SCAN OF EQUAL PRI. UNARY OPS MAY NOT BE PUT TOGETHER.
DODT14: POP P,I ;DONE WITH I
PUSH P,T1 ;SAVE VALUE ON STACK
TRNN F,FR.REL!FR.EXT ;ABS?
TRO T2,1 ;FLAG ABS
TRNE F,FR.REL ;RELOC?
TRC T2,2 ;ABS & REL = REL; REL & REL = ABS
TRNE F,FR.EXT ;EXTERNAL?
ADDI T2,10
JRST DODAT1 ;KEEP GOING
DODT15: POP P,I ;DONE WITH I (DODT13)
MOVEM T1,SAVREG ;SAVE T1
POP T4,SAVREG+1 ;& LAST OPERATOR
POP P,T1
POP P,OP
MOVEM I,SAVREG+2
POP T4,I ;GET CURRENT OP
PUSHJ P,DINDEX
XCT EXPXCT(T3) ;DOIT TOIT
PUSH P,OP ;SAVE NEW VALUE BACK ON STACK
MOVE I,SAVREG+2 ;RESTORE I
PUSH T4,SAVREG+1 ;PUT BACK LAST OP
MOVE T1,SAVREG ;RESTORE LAST ARG
JRST DODT13 ;SEE IF WE CAN COMPRESS MORE
DODAT4: CAIE I,")" ;IF EOE
JRST .+4
SOSGE EXPLVL ;IF WE WERE AT TOP LEVEL..
ERROR F.PARN
JRST .+3
SKIPE EXPLVL ;THE REST BETTER BE AT TOP LEVEL
ERROR F.PARN
POP P,OP ;GET VALUE
MOVEM I,SAVREG+3 ;SAVE I
DODAT5: POP T4,I ;GET OP
CAIN I,DOLLAR ;ALL DONE?
JRST DODATX ;YES
MOVE T1,OP
POP P,OP ;GET 2ND ARG
PUSHJ P,DINDEX ;GET INDEX IN T3
XCT EXPXCT(T3) ;DO IT
JRST DODAT5 ;LOOP
DODATX: MOVE I,SAVREG+3 ;RESTORE I
ANDI OP,177777 ;JUST 16 BITS
MOVE T1,OP ;GET NUMBER
CAIN T2,10 ;ONE EXTERN?
JRST DODAT3 ;YES
CAILE T2,3 ;1 (ABS) OR 2 OR 3 (REL) ?
ERROR F.EXT ;NO POLISH FIXUPS IN THIS ASSEMBLER
DODAT3: TRZ F,FR.REL!FR.EXT ;CLEAR STATUS OF LAST TOKEN
IFN FTREL,<
TRNE T2,2 ;IF REL
TRO F,FR.REL ;FLAG
CAIN T2,10 ;IF EXTERN
TRO F,FR.EXT ;FLAG
TRNN F,FR.PS1 ;IF PASS1
SKIPN T2 ;OR NON-RELOCATABLE
POPJ P, ;RETURN
TRNE F,FR.HEX ;IF OCTAL FORMAT
TRNE F,FR.EXT ;OR EXTERN
POPJ P, ;EXIT
CAIE T2,1 ;IF FLAGED AS ABS,
TRNE F,FR.ORG ;OR NOT RELOCATING
POPJ P,
EXCH T1,RELPTR
MOVE T2,PC
MOVEM T2,RELTAB(T1) ;SAVE PC FOR NEXT LINK
AOJ T1, ;BUMP POINTER
EXCH T1,RELPTR
> ;END IFN FTREL
POPJ P, ;RETURN
OP2CH: PUSH P,T1
PUSH P,T2
MOVE T1,I ;SAVE I
MOVE T2,I
SUBI T2,40 ;SIXBIT
LSH T2,^D30 ;SHIFT TO 1ST BYTE
PUSHJ P,SNEAK ;LOOK AT THE NEXT CHARACTER
SKIPE TOK ;NON-BREAK?
JRST OLDI ;YES, NOT A 2 CHAR OPCODE
MOVE I,SNEAKI ;GET THE BREAK CHAR
SUBI I,40 ;SIXBIT
DPB I,[POINT 6,T2,11]
CAIE I,'>'
CAIN I,'=' ;GOOD 2ND CHAR?
PUSHJ P,INCH ;YES, USE IT
NEWI: SKIPA I,T2
OLDI: MOVE I,T1 ;RESTORE I
POP P,T2
POP P,T1
POPJ P,
DEFINE OPRMAC,<
E "+",<ADD OP,T1>,4
E "-",<SUB OP,T1>,4
E "@",<MOVN OP,T1>,2
E "*",<IMUL OP,T1>,3
E "/",<PUSHJ P,EXDIV>,3
E "\",<PUSHJ P,EXMOD>,3
E "&",<AND OP,T1>,6
E "!",<OR OP,T1>,5
E "_",<LSH OP,(T1)>,6
E "#",<SETCM OP,T1>,2
E 'AND ',<AND OP,T1>,6
E 'OR ',<OR OP,T1>,7
E 'MOD ',<PUSHJ P,EXMOD>,1
E 'XOR ',<XOR OP,T1>,7
E 'SHR ',<PUSHJ P,EXSHR>,3
E 'SHL ',<LSH OP,(T1)>,3
E 'NOT ',<SETCM OP,T1>,2
E 'HIGH ',<LDB OP,[POINT 8,T1,27]>,10
E 'LOW ',<LDB OP,[POINT 8,T1,35]>,10
E 'LO ',<LDB OP,[POINT 8,T1,35]>,10
E 'EQ ',<PUSHJ P,RELEQ>,5
E "=",<PUSHJ P,RELEQ>,5
E 'NE ',<PUSHJ P,RELNE>,5
E '<> ',<PUSHJ P,RELNE>,5
E 'LT ',<PUSHJ P,RELLT>,5
E "<",<PUSHJ P,RELLT>,5
E 'GT ',<PUSHJ P,RELGT>,5
E ">",<PUSHJ P,RELGT>,5
E 'GE ',<PUSHJ P,RELGE>,5
E <BYTE (6) 36,35>,<PUSHJ P,RELGE>,5
E 'LE ',<PUSHJ P,RELLE>,5
E <BYTE (6) 34,35>,<PUSHJ P,RELLE>,5
E 'NUL ',<PUSHJ P,DONULL>,1
E 'NULL ',<PUSHJ P,DONULL>,1
>
DEFINE E(CHAR,INSTR,PRI),<
CHAR>
OPRTAB: XLIST
OPRMAC
LIST
OPRTBL==.-OPRTAB
DEFINE E(CHAR,INSTR,PRI),<
INSTR>
EXPXCT: XLIST
OPRMAC
LIST
ERROR F.ILEX ;EXECUTED IF OP IS NOT IN OPRMAC
DEFINE E(CHAR,INSTR,PRI),<
EXP PRI>
PRIOR: XLIST
OPRMAC
LIST
EXDIV: PUSH P,OP+1
IDIV OP,T1
POP P,OP+1
POPJ P,
EXMOD: PUSH P,OP+1
IDIV OP,T1
MOVE OP,OP+1
POP P,OP+1
POPJ P,
EXSHR: MOVNS T1
LSH OP,(T1)
POPJ P,
RELEQ: CAME OP,T1
FALSE: TDZA OP,OP ;0 = FALSE
TRUE: SETO OP, ;-1 = TRUE
POPJ P,
RELNE: CAMN OP,T1
JRST FALSE
JRST TRUE
RELLT: CAML OP,T1
JRST FALSE
JRST TRUE
RELLE: CAMLE OP,T1
JRST FALSE
JRST TRUE
RELGT: CAMG OP,T1
JRST FALSE
JRST TRUE
RELGE: CAMGE OP,T1
JRST FALSE
JRST TRUE
;NULL = LOCAL SYMBOL GENERATED FOR MISSING ARG, WHICH IS UNDEFINED
DONULL: TLNN T1,S.UNDF ;IS THIS SYMBOL UNDEFINED?
JRST FALSE ;NO
SETZ E, ;YES, IT'S NULL; IGNORE THE 'UNDEFINED' ERROR
JRST TRUE
EVALD: CAIE I,"(" ;A WHOLE EXPR?
JRST EVAL ;NO, JUST EVAL
AOS EXPLVL ;FLAG WHICH LEVEL WE'RE IN
SETZ I, ;GET RID IF PAREN FOR TEST @ DODT10+1
PUSH T4,[DOLLAR] ;DON'T PLOW THROUGH UPPER LEVEL STUFF
PUSHJ P,DODT10 ;MUNCH ON (EXPR)
CAIE I,CR
CAIN I,SEMICO ;IF ERROR ON EOL, DODAT4 ALREADY HOLLERED
POPJ P, ;RETAIN THIS BREAK FOR ANY OTHER LEVELS
CAIE I,")" ;SHOULD END ON )
ERROR F.ILEX
JRST INCH ;GET THE BREAK CHAR
DINDEX: MOVSI T3,-OPRTBL
CAME I,OPRTAB(T3)
AOBJN T3,.-1
SKIPL T3
ERROR F.ILEX ;NOT IN TABLE
POPJ P,
TOKEN: CAIE I,CR
PUSHJ P,INCH
TOKEN1: CAIE I,SPACE ;FLUSH LEADING SPACES & TABS
CAIN I,TAB
JRST TOKEN
SETZB TOK,TOK+1
MOVE T1,[POINT 6,TOK]
CAIN I,DOLLAR ;SPECIAL TEST FOR $
POPJ P, ;LEADING DOLLAR SIGN IS ASSEMBLER PC
CAIA
TOKENL: PUSHJ P,INCH
PUSHJ P,BREAK ;BREAK CHARACTER?
POPJ P,
;REMOVE THE NEXT 2 LINES FOR $ TO BE A SIGNIFICANT LABEL CHARACTER
CAIN I,DOLLAR ;IS IT A DOLLAR?
JRST TOKENL ;YES, THEY ARE NOISE CHARACTERS
CAIL I,"A"+40 ;IF LOWER CASE
SUBI I,40 ;MAKE UPPER CASE
SUBI I,40 ;CONVERT TO SIXBIT
CAMN T1,[600,,TOK+1] ;TOK,TOK+1 FULL?
JRST TOKENW ;YES, THROW OUT READ OF TOKEN
IDPB I,T1 ;PUT IN TOK
JRST TOKENL
TOKENW: PUSHJ P,INCH ;WASTE REST OF TOKEN
PUSHJ P,BREAK
CAIA
JRST TOKENW
TRNN F,FR.SNK ;DON'T GET UPSET ABOUT OVERFLOW OF '...'
WARN W.TOK
POPJ P,
BREAK: CAIG I,"Z"
CAIGE I,"A" ;A-Z?
CAIA
JRST SCPOPJ
CAIG I,"9"
CAIGE I,"0" ;0-9?
CAIA
JRST SCPOPJ ;YES
CAIG I,"Z"+40 ;LC?
CAIGE I,"A"+40
CAIA
JRST SCPOPJ
CAIE I,"@" ;@
CAIN I,"?" ;AND ? ARE LEGAL
JRST SCPOPJ
CAIN I,DOLLAR ;$ IS NOW A LEGAL SYMBOL CHARACTER
JRST SCPOPJ
POPJ P,
FLUSHL: CAIN I,LF ;IF ALREADY FLUSHED..
JRST LCRLF ;NEW LINE
FLUSH: CAIN I,LF
POPJ P,
PUSHJ P,INCH ;GET NEXT CHARACTER
JRST FLUSH ;LOOP
;BINARY SEARCH OPNTAB
SRCHOP: SETO T1, ;RANGE START
MOVEI T2,OPTABL ;RANGE END
SRCH1: MOVE T3,T2 ;GET END
SUB T3,T1 ;GET LENGTH OF RANGE
IDIVI T3,2 ;GET 1/2 RANGE
JUMPE T3,SRCH10 ;NOT THERE
ADD T3,T1 ;GET OFFSET INTO RANGE
MOVE X,T3 ;GET IN X
CAMN TOK,OPNTAB(X) ;MATCH? (ALL TOKENS IN OPNTAB ARE LE 6 CHAR)
JRST SCPOPJ ;YES, SKIP RET
CAML TOK,OPNTAB(X)
MOVE T1,T3 ;SET NEW RANGE
CAMG TOK,OPNTAB(X)
MOVE T2,T3
JRST SRCH1 ;NO, LOOP
SRCH10: MOVEI X,OPTABL ;POINT TO NULL ENTRY
TRZE F,FR.EVL ;FROM EVAL?
POPJ P, ;YES, QUIT NOW.
DMOVE T2,TOK ;SAVE TOKEN
PUSHJ P,SNEAK ;SEE IF MACRO DEFINITION
CAMN TOK,[SIXBIT/MACRO/] ;IS IT?
JRST SRCHOK
CAME TOK,[SIXBIT/EQU/]
CAMN TOK,[SIXBIT/SET/]
JRST SRCHOK
JRST TSTMAC ;NO, SEE IF IT IS A MACRO ITSELF
SRCHOK: PUSHJ P,TOKEN ;GET NEXT TOKEN
CAME TOK,[SIXBIT/EQU/] ;NOTE: EQU & SET ARE IDENTICAL
CAMN TOK,[SIXBIT/SET/] ;GOOD GUYS?
JRST EQUAL ;YES
CAMN TOK,[SIXBIT/MACRO/]
JRST DOMAC
TSTMAC: DMOVE TOK,T2 ;PUT BACK TOKEN
PUSHJ P,SRCSYM ;CHECK FOR MACRO
JRST SRCERR ;NO MACRO
TLNE T1,S.MAC ;MACRO?
POPJ P, ;YES, SET UP MACRO
SRCERR: ERROR F.ILOP ;NO. UNKNOWN OPCODE
PUSHJ P,FLUSH ;WASTE REST
JRST SCPOPJ
PSEUDO: MOVSI X,-PTABL ;TABLE LENGTH
CAME TOK,PTAB(X) ;MATCH?
AOBJN X,.-1 ;LOOP
JRST @PDISP(X) ;DISPATCH
DEFINE PMAC,<
PX ORG
PX DS
PX DB,DC
PX DZ,DC
PX DW,DC
PX OPT,OPTION
PX PHASE
PX IFE,DOIFE
PX IFN,DOIFN
PX IF,DOIFN
PX ELSE
PX ENDIF
PX PRINTX
PX TITLE,DOTITL
PX SUBTTL,DOSUBT
PX PAGE,DOPAGE
PX MACLIB
PX REPT
PX EXITM
IFN FTREL,<
PX INT,DOINT
PX EXT,DOEXT
>
PX END,DOEND
>
DEFINE PX(NAME,ADDR),<
SIXBIT/NAME/>
PTAB: XLIST
PMAC
LIST
PTABL==.-PTAB
DEFINE PX(NAME,ADDR),<
IFB <ADDR>,<JRST NAME>
IFNB <ADDR>,<JRST ADDR>>
PDISP: XLIST
PMAC
JRST CPOPJ ;IN CASE UNDEF OPCODE
LIST
IFPOP: CAME TOK,[SIXBIT/IFE/]
CAMN TOK,[SIXBIT/IFN/]
POPJ P,
CAME TOK,[SIXBIT/ENDIF/]
CAMN TOK,[SIXBIT/END/]
POPJ P,
CAME TOK,[SIXBIT/IF/]
CAMN TOK,[SIXBIT/ELSE/]
POPJ P,
AOS (P)
POPJ P,
ORG: TRO F,FR.ORG ;FLAG NO RELOCATION
PUSHJ P,TOKEN ;GET ORG ARG
PUSHJ P,DODATA ;GET THE NUMBER
MOVEM OP,PC ;RESET PC
TRNN F,FR.PS1 ;SKIP IF PASS1
JRST FLUSH ;NOPE, DONE
MOVE T1,ORGXR ;GET INDEX
MOVEM BC,ORGBLK(T1) ;STORE BYTE COUNT
SKIPE BC ;IF BLOCK WAS VALID,
ADDI T1,2 ;BUMP ORIGIN INDEX
MOVEM OP,ORGBLK+1(T1) ;SAVE NEW START ADDRESS
MOVEM T1,ORGXR ;SAVE INDEX
SETZ BC, ;NO BYTES IN NEW BLOCK
JRST FLUSH ;FLUSH
DOEND: TRO F,FR.END ;SAY WE'RE DONE
CAIN I,CR ;JUST "END" & NO START ADDRESS?
JRST FLUSH ;YES, FLUSH LINE.
PUSHJ P,TOKEN ;GET END ADDRESS
PUSHJ P,DODATA ;GET VALUE IF ANY
MOVEM OP,STARTA
PUSHJ P,NOPC ;LIST START ADDRESS
IFN FTREL,<
MOVEI T1,"'"
TRZE F,FR.REL ;RELOC?
PUSHJ P,LOUCH ;YES
TRZN F,FR.EXT ;EXTERNAL?
JRST FLUSH ;NO, DONE
SETOM STARTA ;YES. THIS IS ILLEGAL
WARN W.EXSA
> ;END IFN FTREL
JRST FLUSH
DS: PUSHJ P,TOKEN ;GET BLOCK ARG
PUSHJ P,DODATA
PUSHJ P,LSTPC
TRO F,FR.LOP
MOVEI T1,TAB
TRNN F,FR.HEX
PUSHJ P,LOUCH
MOVE T1,PC ;SAVE OLD PC
ADDM T1,OP ;NEW PC
JRST ORG+3 ;DS MEANS NEW BLOCK
PHASE: PUSHJ P,TOKEN
PUSHJ P,DODATA
MOVEM OP,PC
TRO F,FR.ORG ;NO RELOCATION
JRST FLUSH
PRINTX: TRNE F,FR.PS1 ;IF ON PASS1
JRST FLUSH ;SKIP IT
PX1: PUSHJ P,INCH
OUTCHR I
CAIE I,LF
JRST PX1
POPJ P,
DC: MOVE T4,[POINT 10,STRING] ;SET UP OPCODE OUTPUT
MOVE T2,T4 ;AND INPUT
PUSH P,T2 ;SAVE IT
DC0: PUSHJ P,TOKEN ;GET ARG(S)
CAIE I,"'"
CAIN I,QUOTE
JRST [MOVEM I,DELIM ;SAVE QUOTE
PUSHJ P,SNEAK ;SEE IF SINGLE CHAR
TLNE TOK,7777
JRST DC4 ;NO, DO QUOTED STRING
MOVE I,SNEAKI
CAME I,DELIM ;AND MUST END ON SAME QUOTE
JRST DC4
SETZB TOK,TOK+1
JRST .+1] ;DO EXPR
PUSH P,T4 ;DODATA DESTROYS T4
PUSHJ P,DODATA
POP P,T4
MOVE T2,OP ;SAVE IT
ANDI OP,377 ;LOWER 8 BITS
IDPB OP,T4 ;SAVE OP
MOVE OP,T2 ;GET BACK ALL OF OP
AOS BYTCNT ;COUNT TOTAL BYTES IN
AOS PC ;FIX PC FOR EVAL
AOS XTRAPC ;FOR FIXUP
TLNN P1,T.DW ;WHOLE WORD?
JRST DC1 ;NO
LSH OP,-10
ANDI OP,377 ;JUST DATA BITS
TRZE F,FR.REL ;IF RELOC
TRO OP,400 ;FLAG
TRZE F,FR.EXT ;IF EXT
TRO OP,1000 ;FLAG
IDPB OP,T4
AOS BYTCNT
AOS PC
AOS XTRAPC
DC1: CAIN I,COMMA ;CONTINUE?
JRST DC0 ;YES
CAIE I,TAB ;LEADING SPACE?
CAIN I,SPACE
JRST [PUSHJ P,INCH
JRST DC1] ;YES, EAT IT
POP P,OP ;GET START BYTE POINTER
SETZ TOK, ;RESET COUNTER
SKIPN BYTCNT ;ANY BYTES IN THERE?
JRST DCX0 ;NO
SOSGE XTRAPC
JRST DC2
SOS PC
JRST .-3
DC2: SETZM XTRAPC
PUSHJ P,LSTPC ;LIST PC
MOVEI TOK,3 ;TOKEN NOT INUSE NOW
TLNE P1,T.DW ;WORDS?
MOVEI TOK,2 ;YES
DC3: ILDB T1,OP
PUSH P,T1 ;SAVE IT
PUSHJ P,LSTOP ;OUTPUT OP WITHOUT UPDATING PC
POP P,T1
SOSG BYTCNT ;ONE LESS BYTE IN STRING
JRST DCX ;ALL GONE
SOJG TOK,DC3 ;LOOP FOR 2 OR 3 BYTES
IFN FTREL,<
TRNE T1,400 ;IF RELOCATABLE
JRST [MOVEI T1,"'" ;FLAG
PUSHJ P,LOUCH
JRST .+1]
TRNE T1,1000 ;IF EXTERNAL
JRST [MOVEI T1,"*"
PUSHJ P,LOUCH
JRST .+1]
>
PUSHJ P,FLUSHL ;PRINT <TAB> LINE OF SOURCE (OR NEW LINE)
JRST DC2 ;DO ANOTHER LINE
DCX: SOJ TOK, ;COUNT BYTE PRINTED
IFN FTREL,<
MOVE T3,T1 ;GET FLAGS
SETZ T1,
TRNE T3,400 ;RELOC WORD?
MOVEI T1,"'"
TRNE T3,1000 ;EXTERN?
MOVEI T1,"*"
CAIE T1,"'"
CAIN T1,"*"
PUSHJ P,LOUCH ;OUTPUT IF ' OR *
> ;END IFN FTREL
DCX0: TLNN P1,T.DZ ;NEED A LAST ZERO?
JRST DCX2 ;NO
JUMPN TOK,DCX1 ;JUMP IF PC ALREADY PRINTED
CAIN I,LF
PUSHJ P,LCRLF
CAIN I,CR ;ON A CR?
PUSHJ P,INCH ;FLUSH LINE
PUSHJ P,LSTPC ;LIST PC
MOVEI TOK,3
TLNE P1,T.DW ;WORDS?
MOVEI TOK,2
DCX1: SETZ T1,
PUSHJ P,LSTOP ;LIST ZERO
SOJ TOK, ;COUNT DOWN
DCX2: JUMPE TOK,FLUSHL ;DONE
PUSHJ P,SPACE4 ;SPACE OUT
SOJG TOK,.-1 ;LOOP
JRST FLUSHL ;DONE
DC4: PUSHJ P,INCH ;GET LIT
CAMN I,DELIM ;END QUOTE?
JRST [PUSHJ P,INCH
JRST DC1]
IDPB I,T4 ;SAVE CHAR
AOS BYTCNT
CAIE I,CR ;EOL?
CAIN I,LF
CAIA ;YES
JRST DC4 ;NO
DC6: MOVE TOK,BYTCNT ;GET COUNT OF BYTES READY TO GO
CAIGE TOK,3 ;ENOUGH FOR A LINE?
JRST DC4 ;NO
MOVEI TOK,3 ;SET UP BYTES/LINE
PUSHJ P,LSTPC ;DO PC
POP P,OP ;GET BYTE POINTER
DC7: ILDB T1,OP ;GET BYTE
SOS BYTCNT ;COUNT DOWN
PUSH P,T1
PUSHJ P,LSTOP ;LIST IT
POP P,T1
SOJG TOK,DC7
PUSH P,OP ;SAVE IT
CAIN I,CR ;GOT HERE VIA CR?
JRST DC4 ;YES, CAUSE LINE TO BE PRINTED
JRST DC6 ;JUST BYTES FOR A WHILE
IFN FTREL,<
DOINT: SKIPA T2,[XWD S.INT,0]
DOEXT: MOVSI T2,S.EXT
PUSHJ P,TOKEN ;GET TOKEN
PUSHJ P,SRCSYM ;FIND IT (OR EMPTY LOC)
DMOVEM TOK,(S) ;NOT THERE, STUFF IT
IORM T2,2(S) ;FLAG SYMBOL
TLNE T2,S.EXT ;EXTERNAL?
HLLOS 2(S) ;YES, MAKE RH -1 (FOR END OF CHAIN)
CAIN I,COMMA ;MORE TO COME?
JRST DOEXT+1 ;YES
JRST FLUSH ;NO
>
DOMAC: DMOVE TOK,T2 ;GET MACRO NAME
DOMAC0: POP P,(P) ;CAME VIA JRST FROM SUBROUTINE
TRO F,FR.NRF ;WE WANT TO KNOW IF MACRO WAS NEVER REFERENCED
PUSHJ P,SRCSYM ;FIND IN SYMBOL TABLE
DMOVEM TOK,(S) ;SAVE IT
PUSHJ P,SYMDEF ;LINE DEFINED ON
MOVSI T1,S.MAC ;FLAG AS A MACRO REFERENCE
IORM T1,2(S) ;PUT IN SYMBOL TABLE
MOVE T2,[MACDUM,,MACDUM+1]
SETZM MACDUM
BLT T2,MACDND ;CLEAR MACRO ARG TABLE
MOVEI T1,2 ;INDICATE NOT A REPT
MOVEM T1,EOMFLG
SETZ T2, ;MACDUM INDEX
PUSH P,S
DOMAC4: PUSHJ P,TOKEN
DMOVEM TOK,MACDUM(T2) ;SAVE DUMMY ARG NAME
JUMPE TOK,DOMC4A ;SINCE NULL ENTRY MEANS END, IGNORE REST
CAIE I,COMMA ;MORE?
JRST DOMC4A ;NO, SKIP
AOJ T2,
AOJA T2,DOMAC4 ;LOOP UNTIL NO MORE ARGS
DOMC4A: POP P,S
DOMC4B: PUSHJ P,FLUSH ;WASTE REST OF THE LINE
MOVE T1,.JBFF## ;GET JOBFF
HRRM T1,2(S) ;SAVE HOME OF MACRO
MOVE T2,T1
HRLI T2,(POINT 7,0) ;POINTER TO MACRO BODY
DOMAC1: PUSHJ P,INCH
DOMAC3: HRRZI T1,1(T2) ;GET ADDRESS PART OF POINTER (+1)
PUSHJ P,MEMXPN ;SEE IF MEMORY NEEDS TO BE EXPANDED
CAIE I,SEMICO ;";"?
JRST DOM10 ;NO
LDB I,T2 ;GET LAST CHAR
CAIE I,SEMICO ;DOUBLE ;;?
JRST DOM11 ;NO
SOJ T2, ;BACKUP BTP
DOM9: ILDB I,T2
CAIN I,SEMICO
JRST DOM12 ;FOUND IT
CAIE I,TAB ;TRY TO ELIMINATE TRAILING TABS
CAIN SPACE ;OR SPACES
JRST DOM9
MOVEM T2,SAVREG ;SAVE FOR A WHILE
JRST DOM9
MEMXPN: CAMG T1,.JBREL## ;WILL T1 FIT IN CORE?
POPJ P, ;YES, EXIT
PUSH P,T1 ;SAVE T1
CORE T1,
ERROR F.NCOR
POP P,T1 ;RESTORE T1
POPJ P,
DOM12: PUSHJ P,FLUSH ;WASTE COMMENT
MOVE T2,SAVREG ;GET POINTER
MOVEI I,CR
IDPB I,T2 ;STUFF CR
SKIPA I,[LF] ;SET UP LF
DOM11: MOVEI I,SEMICO ;PUT BACK ;
DOM10: SKIPG MACLEV ;PASS THRU CONCAT INSIDE MACRO DEF
CAIE I,"'" ;CONCATENATE?
IDPB I,T2 ;STUFF IT
CAIE I,LF ;END OF LINE
JRST DOMAC6
TRZ F,FR.MCM ;FLAG END OF ANY POSSIBLE COMMENT
JRST DOMC2A ;CHECK FOR ENDM, ETC.
DOMAC6: PUSHJ P,BREAK ;IS IT WORTHWHILE TO LOOK FOR NEXT TOKEN?
JRST DOMAC2 ;YES
JRST DOMAC1 ;NO
DOMAC5: SOSL MACLEV ;IN A NESTED MACRO?
JRST DOMAC1 ;YES
SETZM MACLEV ;DON'T LEAVE IT NEG.
LDB I,T2 ;GET LAST CHAR OF MACRO
CAIN I,12 ;END WITH LF?
JRST DOMC5A ;YES, SKIP
MOVEI I,15
IDPB I,T2
MOVEI I,12 ;END MACRO TEXT WITH CRLF
IDPB I,T2
DOMC5A: MOVEI I,177
IDPB I,T2
MOVE I,EOMFLG ;177,2 IS END OF MACRO
IDPB I,T2
SETZ I,
IDPB I,T2 ;END WITH NULL
AOJ T2, ;POINT TO 1ST FREE WORD
HRRM T2,.JBFF## ;UPDATE JOBFF
MOVE T1,EOMFLG ;ARE WE FROM REPT?
CAIN T1,3
POPJ P, ;YES, GO BACK TO REPT CODE
TRNE F,FR.PS1 ;PASS1?
JRST FPASS1 ;FLUSH REST OF LINE, RETURN TO NORMAL INPUT
JRST FLUSHX ;FOR PASS2
DOMAC2: CAIN I,SEMICO
TRO F,FR.MCM ;FLAG IGNORE REST OF LINE
CAIN I,QUOTE
TRC F,FR.MQT ;TOGGLE QUOTE IN MACRO
TRNE F,FR.MCM ;IN COMMENT?
JRST DOMAC1 ;YES
DOMC2A: PUSHJ P,DOMC13 ;GET NEXT TOKEN
DOMAC7: JUMPE TOK,DOMAC1 ;NOTHING THERE
CAMN TOK,[SIXBIT/ENDM/];END OF MACRO?
JRST DOMAC5 ;YES
CAME TOK,[SIXBIT/REPT/]
CAMN TOK,[SIXBIT/MACRO/] ;NESTING A MACRO?
JRST [TRNN F,FR.MCM!FR.MQT ;IN COMMENT OR QUOTE?
AOS MACLEV ;NO, COUNT LEVEL OF NEST
JRST DOMAC1]
CAMN TOK,[SIXBIT/LOCAL/] ;LOCAL SYMBOL?
JRST DOMAC9 ;YES
MOVSI T3,-MACDML
DOMC7A: SKIPN MACDUM(T3)
JRST DOMAC1
CAMN TOK,MACDUM(T3)
CAME TOK+1,MACDUM+1(T3) ;WHAT? NO DOUBLE WORD COMPARE?
CAIA
JRST DOMAC8
AOBJN T3,.+1
AOBJN T3,DOMC7A
JUMPGE T3,DOMAC1
DOMAC8: PUSHJ P,TOKEN
PUSH P,I
MOVEI I,177
IDPB I,T2
HRRZS T3
LSH T3,-1 ;ACCOUNT FOR DOUBLE SIZE TOKENS
MOVEI I,100(T3)
IDPB I,T2
POP P,I
JRST DOMAC3
DOMAC9: SKIPG MACLEV ;IN A MACRO?
TRNE F,FR.MCM!FR.MQT ;IN COMMENT OR QUOTE?
JRST DOMAC1 ;YES, IGNORE IT
PUSHJ P,TOKEN ;EAT "LOCAL"
MOVSI T3,-MACDML
DOMC9A: SKIPN MACDUM(T3) ;FIND FIRST FREE MACDUM ENTRY
JRST DOMC9B
AOBJN T3,.+1
AOBJN T3,DOMC9A
ERROR F.TMMA ;TOO MANY MACRO ARGS (MAKE MACDUM BIGGER)
DOMC9B: PUSHJ P,TOKEN
DMOVEM TOK,MACDUM(T3) ;SAVE LOCAL SYMBOL
CAIN I,"," ;MORE LOCALS?
JRST DOMC9A ;YES
CAIN I,CR ;THROW OUT REST OF LINE
JRST DOMAC3
PUSHJ P,INCH
JRST .-3
DOMC13: HRRZ T1,INVECT ;GET INVECT POINTER
CAIG T1,BAKPTR
CAIGE T1,BAKBUF ;POINTS TO BAKBUF?? (IF SO, DON'T SNEAK)
PJRST SNEAK ;LOOK AT NEXT TOKEN
PUSH P,INVECT ;SAVE POINTER
ILDB I,INVECT
POP P,INVECT
CAIE I,177 ;END OF BAKBUF?
JRST [POP P,(P) ;WASTE RETURN ADDR
JRST DOMAC1] ;JUST PROCESS CHARACTER
MOVE T1,MACPDL
POP T1,INVECT ;RESTORE OLD POINTER
MOVEM T1,MACPDL
JRST SNEAK ;AND GET A NEW TOKEN
EQUAL: DMOVE TOK,T2 ;RESET TOKEN
TLO P1,T.EQU ;SINCE EQU IS NOT IN OPNTAB
TRO F,FR.NRF ;DEFINITION IS NOT REFERENCE
PUSHJ P,SRCSYM
DMOVEM TOK,(S) ;LOAD SYMBOL IF NOT THERE
PUSH P,S ;SAVE S
PUSHJ P,TOKEN ;GET ARG
PUSHJ P,DODATA ;GET VALUE
POP P,S ;RESTORE S
HRRM OP,2(S) ;SET SYMBOL TABLE VALUE
PUSHJ P,SYMDEF ;FLAG LINE DEFINED ON
TRNN F,FR.UND ;IS EXPR UNDEFINED?
JRST EQU1 ;NO, SKIP
MOVE T1,2(S) ;GET FLAGS
TLO T1,S.UNDF ;FLAG UNDEFINED
HLLZM T1,2(S) ;PUT BACK, CLEAR VALUE OF EQU
SETZ OP, ;A LITTLE HINT THAT ALL IS NOT OK
JRST EQU2 ;SKIP
EQU1: MOVE T1,2(S) ;GET FLAGS &C
TLZ T1,S.UNDF!S.MAC ;MAKE SURE THAT THIS SYMBOL IS NOT UNDEFINED
MOVEM T1,2(S) ;FOR CIRCULAR EQU MESS
EQU2: POP P,(P) ;CAME VIA PUSHJ,..
TRNN F,FR.LIB ;SKIP OUTPUT IF IN MACLIB
PUSHJ P,NOPC
TRNE F,FR.PS1 ;PASS1?
JRST FPASS1 ;YES
JRST FLUSHX ;NO
OPTION: PUSHJ P,TOKEN
CAMN TOK,[SIXBIT/HEX/]
TRO F,FR.HEX
CAMN TOK,[SIXBIT/OCT/]
TRZ F,FR.HEX
CAMN TOK,[SIXBIT/SMAC/]
TLO F,FL.SUP
CAMN TOK,[SIXBIT/LMAC/]
TLZ F,FL.SUP
CAIN I,COMMA
JRST OPTION
JRST FLUSH
MACLIB: PUSHJ P,TOKEN ;GET LIBRARY NAME
SKIPN T1,TOK ;FILE NAME
JRST FLUSH ;IF NO NAME, FLUSH
MOVSI T2,'LIB' ;EXT IS .LIB
SETZB T3,T4 ;IN DEFAULT PATH
LOOKUP LIB,T1 ;LOOKUP FILE
JRST [OUTSTR [ASCIZ/MACLIB file not found
/]
JRST FLUSH]
PUSHJ P,FLUSH ;THROW OUT REST OF MACLIB LINE
MOVE T1,MACPDL
PUSH T1,INVECT ;SAVE INPUT VECTOR
MOVEM T1,MACPDL
MOVEI T1,-2 ;SIGNAL MACLIB INPUT
MOVEM T1,INVECT
TRO F,FR.LIB ;FLAG IN MACLIB
POPJ P, ;RETURN
DOPAGE: PUSHJ P,TOKEN
PUSHJ P,DODATA
SKIPE OP ;IF ARG GIVEN FOR PAGE
MOVEM OP,PAGESZ ;SAVE IT AS THE NEW PAGE SIZE
HLLOS LINCTR ;FORCE A PAGE BREAK
JRST FLUSH
EXITM: HRRZ T1,INVECT ;FIRST CHECK TO SEE IF WE'RE IN A MACRO
CAIE T1,-1 ;SOURCE?
CAIN T1,-2 ;MACLIB?
JRST EXITX ;YES, ERROR
CAIG T1,BAKPTR
CAIGE T1,BAKBUF ;POINTS TO BAKBUF?
JRST EXITM1 ;NO, MUST POINT TO MACRO
PUSHJ P,EXITM1 ;YES, GET RID OF IT
JRST EXITM ;AND CHECK AGAIN TO SEE IT THIS IS A MACRO
EXITM1: PUSHJ P,FLUSH ;MAKE EVERYTHING LOOK NICE
MOVE T1,MACPDL ;GET THE INVECT STACK
POP T1,INVECT ;BAIL OUT OF THE MACRO
MOVEM T1,MACPDL
POPJ P, ;ALL DONE
EXITX: WARN W.EXM ;WARN THAT WE'RE NOT IN A MACRO
JRST FLUSH
REPT: PUSHJ P,TOKEN
PUSHJ P,DODATA ;GET THE REPT VALUE
MOVEM OP,REPCNT ;SAVE IT
MOVE T2,[MACDUM,,MACDUM+1]
SETZM MACDUM
BLT T2,MACDND ;CLEAR MACRO ARG TABLE
MOVEI T1,3 ;INDICATE REPT AND NOT MACRO
MOVEM T1,EOMFLG
MOVEI S,REPADR-2 ;FAKE UP SYMTAB POINTER
PUSHJ P,DOMC4B ;MAKE IT A MACRO IN REPBUF
SKIPN REPCNT ;IF REPT 0
POPJ P, ;FORGET IT
PUSHJ P,SETARG ;SET UP MACARG IN CASE LOCALS USED
MOVEI I,177
IDPB I,T1
MOVEI I,1
IDPB I,T1
SETZ I,
IDPB I,T1 ;END WITH NULL
PUSHJ P,FLUSH
MOVE T1,MACPDL
PUSH T1,INVECT ;SAVE INPUT VECTOR ON SPECIAL STACK
MOVE T2,REPADR ;POINT TO REPT
HRLI T2,(POINT 7,0)
MOVEM T2,INVECT
MOVEM T1,MACPDL
POPJ P,
DOIFN: PUSHJ P,TOKEN
PUSHJ P,DODATA
AOS IFLEVL ;ONE MORE IF
TRNE F,FR.OFF ;ALREADY OFF?
JRST FLUSH
SKIPE OP ;GOING OFF?
JRST FLUSH ;NO
TRNOFF: MOVE T1,IFLEVL
MOVEM T1,OFFLVL ;YES, SAVE LEVEL OF OFF
TRO F,FR.OFF ;SHUT OFF
JRST FLUSH ;RETURN
DOIFE: PUSHJ P,TOKEN
PUSHJ P,DODATA
AOS IFLEVL
TRNE F,FR.OFF
JRST FLUSH
SKIPN OP
JRST FLUSH
JRST TRNOFF ;TURN OFF
ELSE: TRNN F,FR.OFF ;ARE WE OFF?
JRST TRNOFF ;NO, TURN OFF
MOVE T1,OFFLVL ;GET OFF LEVEL
CAMN T1,IFLEVL ;TURNED OFF AT THIS LEVEL?
TRZ F,FR.OFF ;YES, TURN BACK ON
JRST FLUSH ;FLUSH & RETURN
ENDIF: TRNN F,FR.OFF ;OFF ALREADY?
JRST ENDI2 ;NO, JUST DECR. & LEAVE
MOVE T1,OFFLVL ;GET OFF LEVEL
CAMN T1,IFLEVL ;WAS TURNED OFF AT THIS LEVEL?
TRZ F,FR.OFF ;YES, TURN BACK ON
ENDI2: SOSGE IFLEVL ;COUNT DOWN IF LEVELS
WARN W.IF1 ;THERE WERE NO LEVELS!
SKIPGE IFLEVL ;IF MESSED UP,
SETZM IFLEVL ;FIX
JRST FLUSH
DOTITL: MOVE T1,[POINT 7,TITL]
MOVEI T2,^D66
PUSHJ P,INCH
CAIN I,15
JRST FLUSH
IDPB I,T1
SOJG T2,.-4
JRST FLUSH
DOSUBT: CAIA ;TRY BREAK CHARACTER FIRST
PUSHJ P,INCH ;GET DELIMITER
CAIE I,TAB
CAIN I,SPACE
JRST .-3 ;FORGET SPACES
MOVE T2,I
MOVE T3,[POINT 7,SUBTTL]
MOVEI T4,SUBTLN
SUB2: PUSHJ P,INCH
CAMN I,T2 ;END OF STRING?
JRST FLUSH ;YES
SOSLE T4
IDPB I,T3 ;STUFF
JRST SUB2
EVAL: TRZ F,FR.REL!FR.EXT ;INIT
SETZ T1, ;CLEAR OUTPUT
JUMPN TOK,DOSYM ;JUMP IF TOK NOT ZERO
CAIE I,"'" ;INTEL QUOTE
CAIN I,QUOTE
JRST DOQUOT ;LITERAL CHARACTER
CAIE I,DOLLAR
CAIN I,PERIOD
CAIA
POPJ P, ;MUST BE ZERO
MOVE T1,PC ;DOLLAR IS PC
TRO F,FR.REL ;DOLLAR IS ALSO RELOCATABLE
PUSH P,T2
TLNE P1,T.DB!T.DW!T.EQU ;FROM DB,DW OR EQU?
CAIA ;NO, SKIP OVER SOJ
SOJ T1, ;INDICATE THE PC OF THE INSTRUCTION
POP P,T2
JRST INCH ;EAT DOLLAR
DOSYM: PUSHJ P,GETNUM ;EVALUATE NUMERICALLY
POPJ P, ;RETURN WITH NUMBER IN T1
PUSHJ P,SRCSYM ;NOT NUMBER,SEARCH SYMBOL TABLE
JRST .+3 ;NOT THERE
HRRZS T1
POPJ P, ;RETURN WITH VALUE IN T1
PUSH P,T2
PUSH P,T3
PUSH P,T4
TRO F,FR.EVL ;TELL SRCHOP NOT TO FLAG ERROR
PUSHJ P,SRCHOP ;CHECK FOR OPCODE
JRST DOSYM3 ;NO OP
TRZ F,FR.EVL ;CLEAR FLAG
MOVE T2,OPCTAB(X) ;GET OPCODE
MOVE T3,TYPLSH(X) ;GET TYPE
TLNE T3,T.POP ;PSEUDO OP?
JRST DOSYM3 ;YES, DONE
TLNE T3,T.NREG ;USES REGISTER?
JRST DOSYM1 ;NO
;CONT.
DOSYM2: CAIN I,")" ;END OF EXPR?
JRST DOSYM1 ;YES
PUSH P,T2
PUSH P,T3
PUSHJ P,TOKEN
PUSHJ P,EVAL
CAILE T1,7
WARN W.REG
ANDI T1,7
POP P,T3
POP P,T2
TRNE T3,4
LSH T1,-1
LSH T1,(T3)
OR T2,T1
TLZE T3,T.MOV ;A MOVE?
JRST [TRZ T3,-1
JRST DOSYM2]
DOSYM1:
REPEAT 0,< ;DON'T GET FUSSY ABOUT OPCODES AS DATA
CAIN I,")" ;EOE?
JRST DOSYM4 ;YES
WARN W.ILO1 ;ONLY GENERATE 1 BYTE OF DATA
>; END REPEAT 0
DOSYM4: MOVE T1,T2
POP P,T4
POP P,T3
POP P,T2
POPJ P,
DOSYM3: POP P,T4
POP P,T3
POP P,T2
SKIPE (S) ;NO SYMBOL?
JRST FLUNDF ;SYMBOL ALREADY UNDEFINED
DMOVEM TOK,(S) ;SAVE SYMBOL
MOVSI T1,S.UNDF ;FLAG UNDEFINED
MOVEM T1,2(S)
FLUNDF: PUSHJ P,SRCSYM ;REFERENCE SYMBOL
JFCL ;NOT FOUND?
TRO F,FR.UND ;FLAG UNDEFINED SYMBOL
TRNN F,FR.PS1 ;SKIP IF PASS1
ERROR F.UNDF ;REALLY IS UNDEFINED
POPJ P, ;BURP UP
DOQUOT: PUSHJ P,INCH ;GET THE NEXT CHARACTER
MOVE T1,I ;JUST SAVE IT
PUSHJ P,INCH ;EAT TRAILING QUOTE
CAIE I,"'"
CAIN I,QUOTE
JRST .+4 ;OK THEN
LSH T1,10 ;SHIFT OVER
ADD T1,I ;MERGE
JRST .-6
PUSH P,T1 ;SAVE T1
PUSHJ P,TOKEN ;LOAD UP LIKE TOKEN
POP P,T1 ;RESTORE T1
POPJ P, ;RETURN
;SEARCH SYMBOL TABLE FOR ENTRY IN TOK.
;NON-SKIP RETURN: SYMBOL UNDEFINED. S CONTAINS 1ST FREE ENTRY
;SKIP RETURN: T1 CONTAINS VALUE OF SYMBOL. S POINTS TO ENTRY IN SYMTAB
;SYMTAB ENTRY: SIXBIT/NAME/
; SIXBIT/MORE NAME/
; FLAGS,,VALUE ;SEE M80UNV FOR FLAGS (S.????)
; LINE#,,LINK TO NEXT LINE# ;1B0 SET IF DEFINED ON LINE#
; 0,,LINK TO OVERFLOW ; 0 IF NO MORE ENTRIES
SRCSYM: TRZ F,FR.REL!FR.EXT
MOVSI S,-PRELEN ;GET LENGTH OF PRE DEFINED TABLE
HRRI S,PRETAB ;ADDRESS OF PERMANENT SYMBOLS
SRCS1: CAMN TOK,(S) ;MATCH?
JRST PREMAT
AOBJN S,.+1
AOBJN S,SRCS1 ;NO, LOOP
;LOOK IN REGULAR SYMBOL TABLE
PUSH P,T2 ;DON'T DESTROY T2
MOVE T2,[POINT 6,TOK];THIS ASSUMES SYMSIZ IS FAIRLY CLOSE TO 64
SETZ T1,
TLNN T2,770000 ;ONLY HASH ON 1ST WORD OF SYMBOL
JRST .+4
ILDB S,T2
ADD T1,S
JRST .-4
IDIVI T1,SYMSIZ ;GET TOKEN MODULO TABLE LENGTH
MOVE T1,T2
POP P,T2
IMULI T1,5 ;5 WORDS/ENTRY
MOVEI S,SYMTAB(T1) ;GET HASHED TABLE LOCATION
SRCL: CAMN TOK,(S)
CAME TOK+1,1(S)
CAIA
JRST SRCF
SKIPN (S) ;EMPTY?
POPJ P, ;YES, RETURN WITH S SET UP
SKIPN 4(S) ;LINK THERE?
JRST MAKLNK ;NO. MAKE NEW ENTRY & RETURN
HRRZ S,4(S) ;NEW LINK
JRST SRCL ;LOOP
PREMAT: MOVE T1,1(S) ;GET FLAGS,VALUE
JRST SCPOPJ ;SKIP RETURN
MAKLNK: MOVE T1,.JBFF## ;GET JOBFF
HRRM T1,4(S) ;MAKE NEW LINK
HRRM T1,S
ADDI T1,5 ;MAKE NEW JOBFF
PUSHJ P,MEMXPN ;EXPAND CORE IF NECESSARY
MOVEM T1,.JBFF## ;STUFF IT
POPJ P, ;DONE
SRCF: MOVE T1,2(S) ;GET FLAGS,VALUE
PUSH P,T2 ;SAVE T2
MOVE T2,T1 ;IN T2
TLNE T2,S.EXT ;EXTERNAL?
HRR T2,PC ;YES, SAVE CURRENT PC FOR NEXT SYMBOL
TRZN F,FR.NRF ;A REFERENCEABLE SYMBOL?
TLO T2,S.REF ;YES, REFERENCE SYMBOL
MOVEM T2,2(S) ;SAVE FLAGS,VALUE
TRNE F,FR.PS1 ;PASS1?
JRST SRCX ;YES, NO REF ON PASS1
TRNN F,FR.LST ;LISTING REFERENCES?
JRST SRCX ;NO USE GATHERING THEM THEN
SKIPE 3(S) ;NO REFERENCE?
JRST NXTREF ;NO
HRLZ T2,LINENO ;GET CURRENT LINENO
MOVEM T2,3(S) ;SAVE IN LH
JRST SRCX ;DONE
NXTREF: PUSH P,T1 ;SAVE T1
PUSH P,T3 ;AND T3
MOVEI T1,3(S) ;GET ADDRESS
MOVE T2,3(S) ;GET LINE,,LINK
SRCLNK: HLRZ T3,T2 ;GET LINE NUMBER IN CHAIN
ANDI T3,377777 ;JUST LINE NUMBER
CAMN T3,LINENO ;IS LINENO ALREADY IN CHAIN?
JRST SRCX0 ;YES, QUIT NOW
TRNN T2,-1 ;ANY LINK?
JRST SRCI ;NO, END OF CHAIN
HRRZ T1,T2 ;SAVE LINK
MOVE T2,(T1) ;FOLLOW LINK
JRST SRCLNK ;LOOP TO END OF CHAIN
SRCI: HRR T2,.JBFF## ;GET FIRST FREE AS LINK
MOVEM T2,(T1) ;SAVE WITH NEW LINK
HRRZ T1,T2 ;LINK ADDRESS IN T1
MOVE T2,LINENO ;GET LINE NUMBER
HRLZM T2,(T1) ;STORE IT
AOJ T1, ;NEW JOBFF
PUSHJ P,MEMXPN ;EXPAND CORE
MOVEM T1,.JBFF##
SRCX0: POP P,T3 ;RESTORE T3
POP P,T1 ;RESTORE T1
SRCX: POP P,T2
TLNE T1,S.UNDF ;UNDEFINED SYMBOL?
POPJ P, ;YES, TIME TO LEAVE
TLZE T1,S.REL ;RELOCATABLE?
TRO F,FR.REL ;YES, FLAG IT
TLZE T1,S.EXT ;EXTERNAL?
TRO F,FR.EXT ;YES
SCPOPJ: AOS (P) ;CAUSE SKIP RETURN
CPOPJ: POPJ P, ;RETURN
;SNEAK ROUTINE. WHILE FR.SNK IS ON INCH WILL COPY ALL INPUT VIA BAKPTR
;WHEN DONE, SNEAK WILL TELL INCH THAT THE PREVIOUS INPUT IS NOW A MACRO
;IN EFFECT, NO INPUT WAS DONE (EXCEPT THAT TOK CONTAINS THE NEXT TOKEN)
SNEAK: TRO F,FR.SNK ;SAY WE'RE SNEAKING AROUND
PUSH P,I
PUSH P,T1
PUSH P,T2
MOVE T2,[POINT 7,BAKBUF] ;SET UP POINTER FOR INCH
MOVEM T2,BAKPTR ;SAVE IT
PUSHJ P,TOKEN ;GET TOKEN
MOVEM I,SNEAKI ;SAVE THE BREAK CHARACTER
MOVEI T1,177
IDPB T1,BAKPTR ;STORE "END OF BAKBUF"
MOVEI T1,1
IDPB T1,BAKPTR
MOVE T1,MACPDL ;GET MACPDL
HRRZ T2,INVECT ;GET INVECT POINTER
CAIG T2,BAKPTR
CAIGE T2,BAKBUF ;POINTS TO BAKBUF?? (IF SO, DON'T SAVE)
PUSH T1,INVECT ;SAVE OLD POINTER
MOVE T2,[POINT 7,BAKBUF] ;POINT TO BACKUP BUFFER
MOVEM T2,BAKPTR ;HELP OUT THE OTHER FOLKS WHO USE BAKPTR
MOVEM T2,INVECT ;SOURCE IS NOW IN BAKBUF
MOVEM T1,MACPDL ;PUT PDL BACK IN STORAGE
TRZ F,FR.SNK ;DONE SNEAKING
POP P,T2
POP P,T1
POP P,I
POPJ P, ;DONE
GETNUM: MOVE T3,[POINT 6,TOK]
SETZ T1, ;CLEAR TOTAL
ILDB T2,T3 ;GET THE 1ST CHARACTER
CAIG T2,'9'
CAIGE T2,'0' ;NUMERIC?
JRST SCPOPJ ;NO - SHOULDN'T BE HERE
PUSH P,T4 ;SAVE T4
PUSH P,I ;AND I
GETN1: JUMPE T2,GETN2 ;END OF TOKEN
MOVE T4,T3 ;SAVE POINTER TO LAST CHAR
ILDB T2,T3 ;GET NEXT CHAR
JRST GETN1 ;LOOP
GETN2: MOVE T3,T4 ;GET BACK POINTER
LDB T4,T3 ;GET LAST CHARACTER
MOVEI I,^D10 ;ASSUME DECIMAL
CAIE T4,'O'
CAIN T4,'Q' ;OCTAL
MOVEI I,10
CAIN T4,'H' ;HEX
MOVEI I,20
CAIN T4,'B' ;BINARY
MOVEI I,2
CAIE T4,'D' ;GET RID OF THE LAST CHARACTER
CAIN T4,'H' ;IF IT IS A RADIX CHARACTER
DPB T1,T3
CAIE T4,'Q'
CAIN T4,'O'
DPB T1,T3
CAIN T4,'B'
DPB T1,T3
MOVE T3,[POINT 6,TOK]
GETNL: CAMN T3,[600,,TOK+1]
JRST GETNX
ILDB T2,T3 ;GET A CHARACTER
JUMPE T2,GETNX ;DONE. NORMAL RETURN
CAIN T2,'$' ;DUMMY DOLLAR?
JRST GETNL ;YES, IGNORE IT
IMUL T1,I ;SHIFT TOTAL BY RADIX
CAILE T2,'9' ;IF GREATER THAN DECIMAL
SUBI T2,'A'-'9'-1 ;THROW OUT OFFSET
ADDI T1,-20(T2)
JRST GETNL
GETNX: POP P,I
POP P,T4
POPJ P,
SETARG: MOVE T2,ARGPDL
PUSH T2,ARGPTR ;SAVE CURRENT MACRO'S ARGS
MOVEM T2,ARGPDL
MOVE T1,ARGPTR
ILDB T2,T1 ;SEARCH FOR END OF CURRENT MACRO'S ARGS
SKIPE T2
JRST .-2
MOVEM T1,ARGPTR ;SAVE START OF THIS MACRO'S ARGS
POPJ P,
SETMAC: PUSHJ P,SETARG
SETM00: CAIE I,TAB
CAIN I,SPACE
JRST [PUSHJ P,INCH
JRST SETM00]
CAIA
SETM0: PUSHJ P,INCH
PUSHJ P,BREAK
JRST SETM1
IDPB I,T1
JRST SETM0
SETM1: CAIE I,QUOTE
CAIN I,"'"
JRST SETM3 ;DO QUOTED STRING
CAIN I,"<" ;START EXPR?
JRST SETM4 ;YES
STM1.5: PUSH P,I
MOVEI I,177
IDPB I,T1
MOVEI I,1
IDPB I,T1
POP P,I
CAIN I,"," ;ANOTHER ARG?
JRST SETM0 ;YES
SETM2: SETZ I,
IDPB I,T1 ;END WITH NULL
PUSHJ P,FLUSH
MOVE T1,MACPDL
PUSH T1,INVECT ;SAVE INPUT VECTOR ON SPECIAL STACK
MOVE T2,2(S) ;GET POINTER TO MACRO
HRLI T2,(POINT 7,0)
MOVEM T2,INVECT
MOVEM T1,MACPDL
POPJ P,
SETM3: MOVEM I,DELIM
IDPB I,T1
PUSHJ P,INCH
CAIE I,CR
CAIN I,LF
JRST SETM1
CAME I,DELIM
JRST SETM3
IDPB I,T1
JRST STM1.5
SETM4: PUSHJ P,INCH
TRNE F,FR.END ;END IS ONLY ABNORMAL EXIT
JRST STM1.5
CAIN I,">"
JRST [PUSHJ P,INCH
JRST STM1.5]
IDPB I,T1
JRST SETM4
INCH: PUSH P,T1 ;SAVE T1
INCH1: MOVE T1,INVECT ;GET VECTOR
CAIN T1,-1 ;DEFAULT TO SOURCE?
JRST INCHS ;YES
CAIN T1,-2 ;DEFAULT TO LIBRARY?
JRST INCHL ;YES
INCHM0: ILDB I,INVECT ;GET CHARACTER FROM MACRO BODY
SKIPN I ;IS THERE A MACRO ARG?
PUSHJ P,DOLSYM ;NEEDS LOCAL SYMBOL HERE
CAIN I,177
JRST INCHM3
TRNE F,FR.LIB ;IN MACLIB?
JRST TPOPJ ;YES, FINISHED
HRRZ T1,INVECT ;GET INVECT POINTER
CAIG T1,BAKPTR
CAIGE T1,BAKBUF ;IN MACRO?
TLNN F,FL.SUP ;YES, IS FL.SUP ON?
JRST INCHX ;NO
IDPB I,BAKPTR ;YES, SAVE CHAR HERE
TPOPJ: POP P,T1
POPJ P, ;SUPPRESS ALL THIS FOOLISHNESS
INCHM3: ILDB I,INVECT ;GET CODE
CAIE I,1
CAIN I,2 ;END OF MACRO?
JRST INCHM1 ;YES
CAIN I,3 ;END OF REPT?
JRST INCHM5 ;YES
MOVE T1,MACPDL
PUSH T1,INVECT ;SAVE OLD INVECT
MOVEM T1,MACPDL
MOVE T1,ARGPTR ;INPUT IS FROM MACRO ARGS
MOVEM T1,INVECT
MOVE T1,I ;PUT ARG POSITION IN T1
ANDI T1,77
JUMPN T1,INCHM4 ;SKIP SPECIAL TEST IF NOT 1ST ARG
PUSH P,INVECT ;SAVE INPUT VECTOR
ILDB T1,INVECT
CAIN T1,177 ;LOOKING FOR 1ST ARG AND NONE THERE?
PUSHJ P,DOLSYM ;MAKE A LOCAL SYMBOL FOR THE NULL ARG
POP P,INVECT ;RESTORE VECTOR
JRST INCHM0 ;GO DOIT
INCHM2: JUMPE T1,INCHM0 ;INVECT NOW POINTS TO RIGHT SPOT
INCHM4: ILDB I,INVECT
SKIPN I ;END OF ARGS?
PUSHJ P,DOLSYM ;NEEDS LOCAL SYMBOL HERE
CAIE I,177 ;END OF ARG?
JRST INCHM4 ;NO, LOOP
ILDB I,INVECT ;GET ^A
SOJA T1,INCHM2 ;SEE IF WE'RE AT THE RIGHT SPOT
INCHM1: MOVE T1,MACPDL
POP T1,INVECT ;RESTORE OLD POINTER
MOVEM T1,MACPDL
CAIE I,2 ;END OF MACRO?
CAIN I,3
JRST [MOVE T1,ARGPDL ;RESTORE MACRO ARG CONTEXT
POP T1,ARGPTR
MOVEM T1,ARGPDL
JRST INCH1]
JRST INCH1
DOLSYM: PUSH P,INVECT ;SAVE THE INPUT VECTOR
MOVEI I,"?" ;START THE SYMBOL WITH "??"
DPB I,INVECT
IDPB I,INVECT
PUSH P,T1 ;SAVE T1
PUSH P,T2
MOVE T1,LOCSYM ;GET THE VALUE OF THE LOCAL SYMBOL
PUSHJ P,DOSNUM ;PUT THE NUMBER IN INVECT
AOS LOCSYM ;MAKE NEW SYMBOL VALUE
MOVEI I,177
IDPB I,INVECT
MOVEI I,1 ;CAP OFF SYMBOL
IDPB I,INVECT
SETZ I,
IDPB I,INVECT
POP P,T2
POP P,T1
POP P,INVECT
LDB I,INVECT ;GET FIRST BYTE IN I
POPJ P,
DOSNUM: IDIVI T1,^D10 ;OUTPUT T1 AS DECIMAL NUMBER
JUMPE T1,.+4
PUSH P,T2
PUSHJ P,DOSNUM
POP P,T2
ADDI T2,60
IDPB T2,INVECT
POPJ P,
INCHM5: SOSG REPCNT ;KNOCK DOWN REPT COUNT
JRST INCHM1
MOVE T2,ARGPTR ;POINT TO ARGS
MOVEI T1,177 ;START NEW REPT WITH A CLEAN START
IDPB T1,T2
MOVEI T1,1
IDPB T1,T2
SETZ T1,
IDPB T1,T2
MOVE T2,REPADR ;POINT TO REPT
HRLI T2,(POINT 7,0)
MOVEM T2,INVECT
JRST INCHM0 ;DOIT OVER AGAIN
INCHL: POP P,T1
INCHL1: SOSGE MBUF+2
JRST INCHL2
ILDB I,MBUF+1
JUMPE I,INCHL1
TRNE F,FR.SNK ;IF SNEAKING,
IDPB I,BAKPTR ;SAVE CHARACTER
POPJ P, ;JUST RETURN WITHOUT LISTING
INCHL2: IN LIB,
JRST INCHL1
CLOSE LIB,
TRZ F,FR.LIB ;FLAG END OF MACLIB
PUSH P,T1
MOVE T1,MACPDL
POP T1,INVECT ;RESTORE ORIGINAL INVECT BEFORE MACLIB
POP P,T1
JRST INCH ;AND GET ANOTHER CHARACTER
INCHS: SOSGE IBUF+2
JRST .+3
ILDB I,IBUF+1
JRST INCHX
IN SRC,
JRST INCHS
ENDIT: TRZN F,FR.PS1 ;PASS1?
JRST WRAPUP ;NO
TRZ F,FR.END ;TURN OFF END FROM PASS1 (SHOULD ALREADY BE OFF BUT ...)
SETZ E, ;FORGET ALL PASS1 ERRORS
TRZE F,FR.OFF ;ARE WE ASSEMBLING?
WARN W.IF2 ;NO
SETZM IFLEVL
SETZM OFFLVL
MOVE T1,ORGXR ;GET INDEX
MOVEM BC,ORGBLK(T1) ;STORE COUNT
SETZ T1, ;YES
PUSHJ P,OPNOBJ ;OPEN OBJECT DEVICE
SETZM ORGXR ;RESET FOR OUTPUT
MOVE T2,[POINT 7,TITL]
PUSHJ P,NOALT3
MOVE T2,[POINT 7,SUBTTL]
PUSHJ P,NOALT3
NOALT1: PUSHJ P,HEXHED ;DO HEDDER
MOVE T1,FILNAM##
MOVE T2,FILEXT##
SETZ T3,
MOVE T4,PPN##
LOOKUP SRC,T1
JRST NOFILE##
JRST RESTAR
NOALT3: ILDB T1,T2
JUMPN T1,[PUSHJ P,HEXOX
JRST NOALT3]
BCRLF: MOVEI T1,15
PUSHJ P,HEXOX
MOVEI T1,12
JRST HEXOX
HEXHED: PUSHJ P,BCRLF
IFN FTREL,<
MOVE T1,RELPTR ;GET SIZE OF RELTAB
CAIGE T1,^D15 ;ENOUGH TO DO A LINE?
JRST HEXH2 ;NO
MOVEI T2,^D15 ;YES, DO 15
PUSHJ P,TYPE04 ;DO RELOCATABLE TYPE
HEXH2:> ;END IFN FTREL
MOVE T4,ORGXR ;GET INDEX
MOVE T1,ORGBLK(T4) ;GET BYTE COUNT LEFT IN BLOCK
SUBI T1,^D30 ;SUBTRACT WHAT WE'RE GOING TO USE
JUMPLE T1,.+4 ;<= 30
MOVEM T1,ORGBLK(T4) ;SAVE REST
MOVEI T1,^D30 ;30 BYTES
JRST .+3
MOVE T1,ORGBLK(T4) ;GET WHAT'S LEFT
SETZM ORGBLK(T4) ;FLAG BLOCK EMPTY
MOVEM T1,CHECK
MOVE BC,T1 ;SAVE BYTES TO OUTPUT
JUMPE BC,EOFBYT ;JUMP IF TIME TO DO EOF STUFF
MOVEI T1,":" ;DO TYPE00 HEADER
PUSHJ P,HEXOX
MOVE T1,BC ;GET BYTE COUNT
PUSHJ P,HEXBYT ;OUTPUT BYTE COUNT
MOVE T1,ORGBLK+1(T4) ;GET START ADDRESS OF BLOCK
LSH T1,-10 ;GET HIGH BYTE
ADDM T1,CHECK
PUSHJ P,HEXBYT ;OUTPUT HIGH ADDRESS
MOVE T1,ORGBLK+1(T4)
ADDM T1,CHECK
PUSHJ P,HEXBYT ;OUTPUT LOW BYTE
MOVE T1,ORGBLK+1(T4)
ADD T1,BC ;LAST S.A. + BYTE COUNT
MOVEM T1,ORGBLK+1(T4) ;= NEW S.A.
SETZ T1, ;DATA (TYPE 00)
SKIPN BC ;IF DATA, SKIP
MOVEI T1,1 ;IF EOF, (TYPE 01)
JRST HEXBYT ;OUTPUT RECORD TYPE
IFN FTREL,<
TYPE04: TRNE F,FR.ORG ;RELOCATING?
POPJ P, ;NO
MOVEI T1,DOLLAR ;FLAG NON-INTEL RECORD
PUSHJ P,HEXOX
MOVE T1,T2 ;GET WORD COUNT
IMULI T1,2 ;MAKE BYTE COUNT
MOVEM T1,CHECK ;CHECKSUM
PUSHJ P,HEXBYT ;OUTPUT
SETZ T1, ;NO START ADDRESS
PUSHJ P,HEXBYT
PUSHJ P,HEXBYT
MOVEI T1,4 ;TYPE 04 (RELOCATABLE)
ADDM T1,CHECK
PUSHJ P,HEXBYT
SETZ T3, ;ZERO XR
T04.1: MOVE T1,RELTAB(T3) ;GET ADDRESS
LSH T1,-10
ADDM T1,CHECK
PUSHJ P,HEXBYT
MOVE T1,RELTAB(T3) ;GET LO ADDRESS
ANDI T1,377
ADDM T1,CHECK
PUSHJ P,HEXBYT
AOJ T3,
SOJG T2,T04.1 ;LOOP
MOVE T1,CHECK
ANDI T1,377
MOVNS T1
PUSHJ P,HEXBYT ;OUTPUT CHECKSUM
PUSHJ P,BCRLF ;CRLF
;SHUFFLE CONTENTS OF RELTAB BACK TO BOTTOM
SETZ T2,
SKIPN T1,RELTAB(T3)
JRST T04.2
MOVEM T1,RELTAB(T2)
AOJ T2,
AOJA T3,.-4
T04.2: MOVEM T2,RELPTR ;RESET POINTER
MOVSI T3,RELTAB(T2)
HRRI T3,RELTAB+1(T2)
SETZM RELTAB(T2)
BLT T3,RELEND
POPJ P,
> ;END IFN FTREL
EOFBYT:
IFN FTREL,<
TRNN F,FR.ORG ;RELOCATING?
SKIPN RELPTR ;RELTAB EMPTY?
JRST DOSYMT ;DO SYMBOL TYPE
MOVE T2,RELPTR ;GET COUNT
CAIL T2,^D15
MOVEI T2,^D15 ;MAX 15 AT A TIME
PUSHJ P,TYPE04 ;DO A LINE OF TYPE 04
JRST EOFBYT ;LOOP
DOSYMT: MOVEI S,SYMTAB ;XR
EOFL: CAIL S,SYMEND ;END ON SYMTAB?
JRST TYPE01 ;YES
SKIPN (S) ;EMPTY?
JRST EOFX ;YES, SKIP
PUSH P,S ;SAVE POINTER
MOVE T3,2(S)
TLNE T3,S.INT!S.EXT ;GOOD STUFF?
PUSHJ P,TYPE02 ;YES
SKIPE S,4(S)
JRST .-4
POP P,S
EOFX: ADDI S,5
JRST EOFL ;LOOP
TYPE02: MOVEI T1,DOLLAR ;TYPE 2 OR 3 LEADER
PUSHJ P,HEXOX
SETZM CHECK
PUSH P,T3
DMOVE T2,(S) ;GET NAME
MOVE T4,[POINT 6,T2]
T02.1: ILDB T1,T4 ;GET BYTE
ADDI T1,40 ;TO ASCII
ADDM T1,CHECK
PUSHJ P,HEXOX
CAME T4,[600,,T3] ;ALL 12?
JRST T02.1 ;NO
POP P,T3
TLNE T3,S.INT ;INTERNAL
MOVEI T1,2 ;IS TYPE 02
TLNE T3,S.EXT ;EXTERNAL
MOVEI T1,3 ;IS TYPE 03
PUSHJ P,HEXBYT ;OUTPUT SYMBOL TYPE
ADDM T1,CHECK
HRRZ T1,T3 ;GET VALUE
LSH T1,-10 ;GET HIGH PART
ADDM T1,CHECK
PUSHJ P,HEXBYT
HRRZ T1,T3
ANDI T1,377
ADDM T1,CHECK
PUSHJ P,HEXBYT
MOVE T1,CHECK
ANDI T1,377
MOVNS T1
PUSHJ P,HEXBYT
PUSHJ P,BCRLF
POPJ P,
> ;END IFN FTREL
TYPE01: MOVEI T1,":" ;OUTPUT HEADER
PUSHJ P,HEXOX
SETZ T1, ;LENGTH 0
PUSHJ P,HEXBYT
MOVE T1,STARTA ;GET START ADDRESS
LSH T1,-10
PUSHJ P,HEXBYT
MOVE T1,STARTA
ANDI T1,377
PUSHJ P,HEXBYT
MOVEI T1,1 ;TYPE 01
PUSHJ P,HEXBYT
JRST BCRLF ;CRLF
INCHX: POP P,T1
JUMPE I,INCH ;CAST OFF NULLS
TRNE F,FR.SNK ;IF SNEAKING,
JRST [IDPB I,BAKPTR ;SAVE CHARACTER
POPJ P,] ;DON'T PRINT TWICE
TRNE F,FR.PS1
JRST PAS1IX ;SKIP ALL PROCESSING OF CHARACTER IF PASS1
SKIPN LBTP
MOVE LBTP,[POINT 7,LINBLK]
CAIE I,FF ;DON'T GO PUTTING FF IN LINBLK!
IDPB I,LBTP
CAIE I,LF ;IF LF,
CAIN I,FF ;OR FF,
CAIA ;SKIP INTO EOL ROUTINE
POPJ P, ;ELSE WE'RE DONE
PUSH P,T1
PUSH P,T2
CAIN I,FF
JRST DOFFX ;IF FF, SKIP SOME STUFF
MOVEI T1,TAB
TRNE F,FR.LOP ;IF CODE GENERATED
JRST INCHX1 ;JUST ONE TAB
PUSHJ P,DOLINO ;PRINT LINE # AS A LAST RESORT
TRNE F,FR.HEX
JRST INCHX0
PUSHJ P,LOUCH
PUSHJ P,LOUCH
INCHX0: PUSHJ P,LOUCH
INCHX1: PUSHJ P,LOUCH
TRZ F,FR.LIN ;CLEAR LINE # PRINTED FLAG FOR NEXT LINE
MOVE LBTP,[POINT 7,LINBLK]
ILDB T1,LBTP
JUMPE T1,CHKERR
PUSHJ P,LOUCH
SKIPE E
OUTCHR T1
JRST .-5
CHKERR: JUMPE E,NOERR
HLRZ T1,E
OUTCHR T1
PUSHJ P,LOUCH
MOVE T2,ERRTAB-1(E)
MOVE LBTP,[POINT 7,(T2)]
ILDB T1,LBTP
JUMPE T1,.+4
PUSHJ P,LOUCH
OUTCHR T1
JRST .-4
PUSHJ P,LCRLF
OUTSTR CRLF
SETZ E,
NOERR: SETZM LINBLK
MOVE T1,[LINBLK,,LINBLK+1]
BLT T1,LINEND
SETZ LBTP,
MOVE T1,LINCTR
CAMG T1,PAGESZ ;ON NEW PAGE?
JRST NOFF ;NO
JRST DOFF ;YES, WRITE HEADER
DOFFX: AOS PAGENO
SETZM SUBPAG ;REAL PAGES HAVE NO SUB PAGE MARK
DOFF: PUSHJ P,DOHDFF ;GO DO THE HEADING
NOFF: POP P,T2
POP P,T1
PAS1IX: CAIN I,FF ;IF FF,
JRST INCH ;EAT IT
POPJ P,
LOUCH: TRNE F,FR.LST ;IF NOT LISTING
TRNE F,FR.PS1 ;OR ON PASS 1
POPJ P, ;FORGET IT
SOSGE LBUF+2
JRST LOUCH1
IDPB T1,LBUF+1
CAIN T1,LF
AOS LINCTR
CAIN T1,LF ;LF DOESN'T CHANGE BOL
POPJ P,
TRZ F,FR.BOL ;ASSUME REGULAR CHAR
CAIN T1,CR ;IF CR
TRO F,FR.BOL ;FLAG BOL
POPJ P,
LOUCH1: OUTPUT LST,
JRST LOUCH
OUTOP: PUSHJ P,LSTPC
MOVE T1,OP
PUSHJ P,LSTOP
POPJ P, ;RETURN
NOPC: MOVEI T1,TAB
PUSHJ P,LOUCH
TRNN F,FR.HEX
PUSHJ P,LOUCH
MOVE T1,OP
SKIPGE T1 ;IF NEGATIVE
SETZ T1, ;MAKE ZERO
MOVEI T3,6
TRO F,FR.LOP
PUSHJ P,LSTNUM
TRNE F,FR.HEX
POPJ P,
MOVEI T1,TAB
JRST LOUCH
HEXOX: SOSL OBUF+2
JRST [IDPB T1,OBUF+1
POPJ P,]
OUTPUT OBJ,
JRST HEXOX
HEXOUT: ADDM T1,CHECK
PUSHJ P,HEXBYT
SOJG BC,CPOPJ
PUSH P,T1
PUSH P,T2
PUSH P,T3
PUSH P,T4
MOVE T1,CHECK
ANDI T1,377
MOVNS T1
PUSHJ P,HEXBYT
MOVE T4,ORGXR ;GET INDEX
SKIPN ORGBLK(T4) ;STILL GOOD BYTE COUNT?
ADDI T4,2 ;NEXT BLOCK
MOVEM T4,ORGXR ;SAVE INDEX
PUSHJ P,HEXHED ;DO HEADER
POP P,T4
POP P,T3
POP P,T2
POP P,T1
POPJ P,
HEXBYT: PUSH P,T1
LSH T1,-4
PUSHJ P,NYBBLE ;OUTPUT HIGH NYBBLE
POP P,T1
PUSH P,T1
PUSHJ P,NYBBLE
POP P,T1
POPJ P,
NYBBLE: ANDI T1,17
CAILE T1,^D9
JRST .+3
ADDI T1,60
JRST HEXOX
ADDI T1,"A"-^D10
JRST HEXOX
WRAPUP:
IFN FTCREF,<
PUSHJ P,PRTSYM ;PRINT SYMBOL TABLE
>
RELEAS SYM,
RELEAS LST,
RELEAS OBJ,
IFN FTSTAT,<
TLNE F,FL.LNR ;LIST NON-REF SYMBOLS?
PUSHJ P,REFLOP ;YES
>
AND F,[XWD FL.CCL,0];CLEAR ALL FLAGS BUT FL.CCL
JRST START##
IFN FTSTAT,<
;PRINT ALL DEFINED BUT NOT REFERENCED SYMBOLS
REFLOP: MOVEI S,SYMTAB
RLOOP4: CAIN S,SYMEND ;END OF TABLE?
POPJ P, ;DONE
SKIPN (S) ;IF EMPTY
JRST RLOOP5 ;GET NEXT
PUSH P,S ;SAVE IT
PUSHJ P,RLINK ;RUN OUT THIS BRANCH
POP P,S ;DONE
RLOOP5: ADDI S,5 ;GET NEXT
JRST RLOOP4 ;LOOP
RLINK: MOVE T2,2(S)
TLNN T2,S.REF!S.MAC ;IS SYMBOL REFERENCED OR A MACRO?
JRST RLOOP0 ;NO
RLOOP: SKIPN S,4(S) ;IS THERE A LINK?
POPJ P, ;NO
JRST RLINK
RLOOP0: SKIPN (S)
JRST RLOOP
TRON F,FL.HED
OUTSTR [ASCIZ/Unreferenced labels:
/]
MOVE T4,[POINT 6,(S)]
RLOOP1: ILDB T2,T4
JUMPE T2,RLOOP2
ADDI T2,40
OUTCHR T2
CAME T4,[600+S,,1]
JRST RLOOP1
RLOOP2: OUTSTR [ASCIZ/
/]
JRST RLOOP
> ;END IFN FTSTAT
IFN FTCREF,<
PRTSYM: SKIPN CREFSW ;CREF?
SKIPE SYMBSW ;OR SYMBOL FILE?
CAIA ;YES, SKIP
POPJ P, ;DON'T BE SILLY THEN
SETZB BC,E ;CLEAR COUNTER
SETOM PAGENO ;FLAG SYMBOL TABLE PAGE
MOVEI T1,1 ;SYMBOL TABLE ALWAYS STARTS WITH SUBPAGE
MOVEM T1,SUBPAG ;NUMBER 1
SKIPE CREFSW ;CREF?
PUSHJ P,DOHDFX ;PRINT NEW HEADER
PRTS: HRLOI T1,377777 ;+INFINITY
SETZ P1,
MOVEI S,SYMTAB
PRT0: SKIPN (S) ;EMPTY?
AOJA P1,PRT1 ;YES
PUSH P,S ;SAVE S
PUSHJ P,PRT10 ;CHECK OUT THIS BRANCH
POP P,S
PRT1: ADDI S,5 ;NEXT LINK
CAIE S,SYMEND ;ALL DONE?
JRST PRT0 ;NO, LOOP
SKIPE T1 ;QUIT IF WE GOT TO BLANK SYMBOLS
CAMN T1,[377777,,-1] ;NO SYMBOLS SMALLER THAN +INFINITY?
JRST PRTX ;DONE
AOJ BC, ;COUNT IT
MOVE S,T2
SKIPN CREFSW ;IF NOT CREF
JRST PRT1B ;DON'T PRINT STUFF
DMOVE T2,(S) ;GET SMALLEST SYMBOL
PUSHJ P,PUTSIX ;FOR LISTING
MOVEI T1,TAB
PUSHJ P,LOUCH
MOVE T1,2(S) ;GET FLAGS,VALUE
TLNE T1,S.UNDF ;UNDEFINED?
JRST [MOVEI T2,[ASCIZ/Undf/]
PUSHJ P,PUTSTR
JRST PRT4]
TLNE T1,S.MAC
JRST [MOVEI T2,[ASCIZ/Macro/]
PUSHJ P,PUTSTR
JRST PRT4]
HRRZ T1,2(S) ;JUST VALUE
MOVEI T3,6
PUSHJ P,LSTNUM ;PRINT IT
PRT1B: SKIPN SYMBSW ;DOING SYMBOL FILE?
JRST PRT4 ;NO
MOVE T1,SYMTYP ;GET 10 OR 20
JUMPE T1,PRT1A ;NEITHER, START OF FILE
ADD T1,SYMCNT
ANDI T1,7770 ;CUT TO TAB STOP
MOVEM T1,SYMCNT
CAIL T1,MAXSYM ;GOT TO END OF LINE?
JRST [PUSHJ P,SCRLF
SETZM SYMCNT
JRST PRT1A]
MOVEI T1,TAB ;END WITH A TAB
PUSHJ P,SOUCH
MOVEI T1,TAB
MOVE T2,SYMTYP ;GET TYPE
CAIN T2,20 ;NEED 2 TABS?
PUSHJ P,SOUCH ;YES
PRT1A: HRRZ T1,2(S) ;GET FLAGS,VALUE
PUSHJ P,SYMNUM
MOVEI T1,SPACE
PUSHJ P,SOUCH
MOVEI T1,5 ;COUNT 4 DIGITS AND A SPACE
ADDM T1,SYMCNT
DMOVE T2,(S) ;GET SMALLEST SYMBOL
PUSHJ P,PUTSSX ;FOR SYMBOL FILE
MOVEI T1,10 ;ACCOUNT FOR TAB
MOVE T2,(S) ;CHECK FOR SHORT SYMBOLS
TLNN T2,77 ;1 OR 2 CHAR SYMBOL?
MOVEI T1,20 ;YES
MOVE T2,1(S) ;CHECK FOR LONG SYMBOLS
TRNE T2,77 ;12 CHAR SYMBOL?
MOVEI T1,20 ;YES
MOVEM T1,SYMTYP ;SAVE 'TYPE' 10 (NORMAL) OR 20 (SHORT OR LONG)
IFN FTREL,<
SETZ T1,
MOVE T2,2(S) ;GET FLAGS
TLNE T2,S.REL
MOVEI T1,"'" ;FLAG RELOC
TLNE T2,S.EXT!S.INT
MOVEI T1,"*"
SKIPE T1
PUSHJ P,LOUCH
> ;END IFN FTREL
PRT4: SKIPN CREFSW ;IF NOT CREF
JRST PRT9A ;JUST FLAG SYMBOL AND LOOP
MOVE T2,3(S) ;GET LINE,,LINK
PRT3: MOVEI T4,^D13 ;MAX ENTRIES/LINE
PRT2: PUSH P,T2
MOVEI T1,TAB
PUSHJ P,LOUCH
HLRZS T2
TRZ T2,(1B0) ;CLEAR FLAG
MOVEI T1,SPACE
CAIG T2,^D999
PUSHJ P,LOUCH
CAIG T2,^D99
PUSHJ P,LOUCH
CAIG T2,^D9
PUSHJ P,LOUCH
MOVE T1,T2
PUSHJ P,PUTDEC
POP P,T2
TLNN T2,(1B0) ;FLAG?
JRST .+3 ;NO
MOVEI T1,"#"
PUSHJ P,LOUCH
HRRZS T2 ;GET LINK
JUMPE T2,PRT9 ;DONE WITH CHAIN
MOVE T2,(T2) ;GET LINE,,LINK
SOJG T4,PRT2 ;LOOP FOR LINE
PUSHJ P,LCRLF ;END THE LINE
MOVE T1,LINCTR
CAMLE T1,PAGESZ ;IF ON NEW PAGE,
PUSHJ P,DOHDFF ;DO HEADER
MOVEI T1,TAB
PUSHJ P,LOUCH
PUSHJ P,LOUCH
JRST PRT3
PRT9: PUSHJ P,LCRLF
MOVE T1,LINCTR
CAMLE T1,PAGESZ ;IF ON NEW PAGE,
PUSHJ P,DOHDFF ;DO HEADER
PRT9A: MOVE T3,2(S) ;GET FLAGS
TLO T3,S.PRT ;FLAG SYMBOL PRINTED
MOVEM T3,2(S)
JRST PRTS
PRTX:
SKIPE SYMBSW ;IF SYMBOLS
PUSHJ P,SCRLF ;DO CRLF
SKIPN CREFSW ;IF NOT CREF
POPJ P, ;EXIT
IFN FTSTAT,<
PUSHJ P,LCRLF ;NEW LINE
MOVE T1,BC ;GET COUNT OF SYMBOLS USED
PUSHJ P,PUTDEC
MOVEI T2,[ASCIZ/ symbols used
/]
PUSHJ P,PUTSTR
MOVE T1,P1
PUSHJ P,PUTDEC
MOVEI T2,[ASCIZ/ empty slots in SYMTAB
/]
PUSHJ P,PUTSTR
CAIG E,1
POPJ P,
MOVE T1,E
PUSHJ P,PUTDEC
MOVEI T2,[ASCIZ/ links in longest symbol search/]
PUSHJ P,PUTSTR
> ;END IFN FTSTAT
JRST LCRLF ;CRLF
PRT10: SETZ T4, ;COUNT OF LINKS IN THIS BRANCH
MOVE T3,2(S) ;GET FLAGS
TLNE T3,S.PRT ;WAS ALREADY USED?
JRST PRT11 ;YES
CAMG T1,(S) ;GET SYMBOL THAT IS SMALLER
JRST PRT11 ;(YES, WE ARE ONLY SORTING ON THE FIRST 6 CHARACTERS)
MOVE T2,S ;SAVE INDEX OF LEAST ALPHABETICAL SYMBOL
MOVE T1,(S) ;NEW MATCH SYMBOL
PRT11: AOJ T4,
SKIPE S,4(S) ;GET NEXT LINK
JRST PRT10+1 ;GO ON
CAMLE T4,E ;GT MAX?
MOVE E,T4 ;NEW MAX
POPJ P, ;NO LINK
> ;END IFN FTCREF
LSTNUM: TRNE F,FR.HEX ;HEX OUTPUT?
JRST LSTHEX ;YES
IDIVI T1,10 ;NO
SOJLE T3,.+4
PUSH P,T2
PUSHJ P,LSTNUM
POP P,T2
MOVEI T1,60(T2)
LSTN1: PUSHJ P,LOUCH
POPJ P,
LSTHEX: IMULI T3,2 ;MULT BY 2/3
PUSH P,T4
IDIVI T3,3
POP P,T4
LSTH1: IDIVI T1,20
SOJLE T3,LSTH2
PUSH P,T2
PUSHJ P,LSTH1
POP P,T2
LSTH2: CAILE T2,11
JRST LSTH3
MOVEI T1,60(T2)
JRST LSTN1
LSTH3: MOVEI T1,"A"-^D10(T2)
JRST LSTN1
SYMNUM: MOVEI T3,4
SYMH1: IDIVI T1,20
SOJLE T3,SYMH2
PUSH P,T2
PUSHJ P,SYMH1
POP P,T2
SYMH2: CAILE T2,11
JRST SYMH3
MOVEI T1,60(T2)
CAIA
SYMH3: MOVEI T1,"A"-^D10(T2)
SOUCH: SOSGE SBUF+2
JRST SOUCH1
IDPB T1,SBUF+1
POPJ P,
SOUCH1: OUTPUT SYM,
JRST SOUCH
SCRLF: MOVEI T1,CR
PUSHJ P,SOUCH
MOVEI T1,LF
JRST SOUCH
;LSTPC LIST THE PC AND A TAB
LSTPC: TRNE F,FR.PS1 ;PASS1?
POPJ P, ;YES
PUSHJ P,DOLINO ;IN CASE AT DC?
TRZ F,FR.LIN ;LISTING PC CLEARS FR.LIN
MOVEI T3,6
MOVE T1,PC
PUSHJ P,LSTNUM
TRNE F,FR.HEX ;HEX?
JRST LSTPC1 ;YES
MOVEI T1,"="
PUSHJ P,LOUCH
MOVEI T3,3 ;3 FIGURES
MOVE T1,PC ;GET PC
LSH T1,-10
PUSHJ P,LSTNUM ;OUTPUT THE PC
MOVEI T1,"/"
PUSHJ P,LOUCH
MOVE T1,PC
ANDI T1,377
MOVEI T3,3
PUSHJ P,LSTNUM
LSTPC1:
IFN FTREL,<
TRNE F,FR.ORG ;RELOCATING?
JRST LSTPC2 ;NO
MOVEI T1,"'"
PUSHJ P,LOUCH
> ;END IFN FTREL
LSTPC2: MOVEI T1,TAB
PUSHJ P,LOUCH ;OUTPUT ANOTHER TAB
POPJ P,
LCRLF: TRNE F,FR.PS1
POPJ P,
MOVEI T1,CR
PUSHJ P,LOUCH
MOVEI T1,LF
JRST LOUCH
;LSTOP ENTER THE BYTE IN T1 IN THE OBJ FILE
; PRINT THE BYTE [AND A SPACE IF OCT]
LSTOP: TRNE F,FR.PS1
JRST LSTOP1
TRO F,FR.LOP
MOVEI T3,3
PUSH P,T2
ANDI T1,377
PUSHJ P,HEXOUT
PUSHJ P,LSTNUM ;OUTPUT BYTE
MOVEI T1,SPACE
TRNN F,FR.HEX
PUSHJ P,LOUCH
POP P,T2
LSTOP1: AOS PC
TRNE F,FR.PS1
AOJ BC,
POPJ P,
DOTAG: TRO F,FR.NRF ;DEFINITION IS NOT REFERENCE
PUSHJ P,EVAL
PUSHJ P,SYMDEF ;FLAG DEFINITION
HRRZS T1 ;CLEAR FLAGS
CAME T1,PC
ERROR F.MULT
JRST DUNTAG
SYMDEF: TRNE F,FR.PS1 ;PASS1?
POPJ P, ;YES
TRNN F,FR.LST ;LISTING?
POPJ P, ;NO
CAIGE S,SYMTAB ;POINTS TO SYMTAB?
POPJ P, ;NO. PROB POINTS TO PRETAB
PUSH P,T1
PUSH P,T2
MOVE T1,3(S) ;GET LINE,,LINK
MOVEI T2,3(S) ;GET 1ST POINTER
DEFS0: TRNN T1,-1 ;END OF CHAIN?
JRST DEFS1 ;YES
MOVE T2,T1
MOVE T1,(T2) ;LINK
JRST DEFS0 ;LOOP
DEFS1: TLO T1,(1B0) ;FLAG DEFINITION
MOVEM T1,(T2) ;PUT BACK
POP P,T2
POP P,T1
POPJ P,
DOHDFF: SKIPN PAGESZ ;IF PAGE = 0
POPJ P, ;DON'T DO ANY HEADERS
DOHDFX: MOVEI T1,FF
PUSHJ P,LOUCH ;FORCE NEW PAGE
DOHEAD: PUSH P,T1 ;SAVE ACS
PUSH P,T2
PUSH P,T3
MOVEI T1,1
MOVEM T1,LINCTR ;SET LINE COUNT TO 1
MOVE T2,[POINT 7,TITL]
MOVEI T3,^D66
ILDB T1,T2
JUMPE T1,.+3
PUSHJ P,LOUCH
SOJG T3,.-3
MOVEI T1,11 ;LOAD A <TAB>
SKIPE TITL ;NOT IF NO TITLE
PUSHJ P,LOUCH ;OUTPUT IT
MOVEI T2,HEAD0
PUSHJ P,PUTSTR
MOVEI T2,M80VER
PUSHJ P,PUTOCT
MOVEI T1,M80MIN
JUMPE T1,.+3
MOVEI T1,"@"(T1)
PUSHJ P,LOUCH
MOVEI T1,"("
PUSHJ P,LOUCH
MOVEI T2,M80EDT
PUSHJ P,PUTOCT
MOVEI T2,[ASCIZ/) /]
PUSHJ P,PUTSTR
SKIPL PAGENO
MOVEI T2,HEAD1
SKIPG PAGENO
MOVEI T2,HEAD3
PUSHJ P,PUTSTR
MOVEI T2,DATE ;SO WHAT IF WE STARTED AT 11:59 DEC 31
PUSHJ P,PUTSTR ;WE STILL USE THE DATE OF THE START OF THE RUN
MOVEI T2,HEAD2
PUSHJ P,PUTSTR
SKIPL T1,PAGENO
PUSHJ P,PUTDEC
SKIPL PAGENO
JRST .+3
MOVEI T1,"S" ;INDICATE SYMBOL TABLE PAGE
PUSHJ P,LOUCH
SKIPN SUBPAG
JRST NOSUB
MOVEI T1,"-"
PUSHJ P,LOUCH
MOVE T1,SUBPAG
PUSHJ P,PUTDEC
NOSUB: AOS SUBPAG ;BUMP SUBPAGE COUNTER HERE
PUSHJ P,LCRLF
MOVE T2,[POINT 6,FILNAM] ;LOAD THE SOURCE FILE NAME
DOH1: ILDB T1,T2
JUMPE T1,.+5
ADDI T1,40
PUSHJ P,LOUCH
TLNE T2,770K
JRST DOH1
MOVEI T1,"." ;LOAD A "."
PUSHJ P,LOUCH ;AND OUTPUT IT
HLLZ T2,FILEXT ;LOAD THE SOURCE FILE EXT.
SETZ T3,
PUSHJ P,PUTSIX ;PRINT IT
PUSHJ P,LCRLF
PUSHJ P,LCRLF
POP P,T3
POP P,T2
POP P,T1
POPJ P,
PUTSTR: HRLI T2,(POINT 7,0) ;MAKE A BTP
ILDB T1,T2 ;LOAD THE BYTE
JUMPE T1,CPOPJ ;IF LAST BYTE, RETURN
PUSHJ P,LOUCH ;OUTPUT IT
JRST .-3 ;AND LOOP
PUTOCT: MOVE T3,[POINT 3,T2] ;LOAD THE BTP
ILDB T1,T3 ;LOAD THE BYTE
JUMPE T1,.-1 ;IGNORE LEADING ZEROS
CAIA
ILDB T1,T3
ADDI T1,60 ;MAKE IT ASCII
PUSHJ P,LOUCH ;OUTPUT IT
TLNE T3,770K ;LAST BYTE?
JRST .-4 ;NO, THEN LOOP
POPJ P, ;YES, RETURN
PUTDEC: IDIVI T1,^D10 ;DIVIDE BY RADIX
JUMPE T1,.+4 ;IF NULL, DO RETURN LOOP
PUSH P,T2 ;SAVE T2
PUSHJ P,PUTDEC ;RECURSIVE CALL
POP P,T2 ;RESTORE T2
MOVEI T1,60(T2) ;MAKE ASCII
JRST LOUCH ;OUTPUT AND LOOP RETURN
CRLF: ASCIZ/
/
HEAD0: ASCIZ \MAC80 \
HEAD1: ASCIZ \8085 Cross Assembler \
HEAD2: ASCIZ \ Page \
HEAD3: ASCIZ \Symbol Table \
GTDATE: MOVE T3,[POINT 7,DATE]
PUSH P,I ;SAVE I
MOVE T1,[60,,11] ;LOAD THE DAY
GETTAB T1, ;NOW
JRST IPOPJ ;PA1050 DIES ON THIS GETTAB
PUSHJ P,GETDEC ;MAKE DECIMAL ASCII
MOVEI T1,"-"
IDPB T1,T3 ;DEPOSIT A HYPHEN
MOVE I,[57,,11] ;LOAD THE MONTH
GETTAB I,
JFCL
MOVE T2,[POINT 7,MONTAB-1(I)] ;SET BTP
ILDB T1,T2 ;LOAD THE BYTE
JUMPE T1,.+3
IDPB T1,T3 ;DEPOSIT THE BYTE
JRST .-3 ;AND LOOP
MOVEI T1,"-"
IDPB T1,T3 ;DEPOSIT ANOTHER BYTE
MOVE T1,[56,,11] ;LOAD THE YEAR
GETTAB T1,
JFCL
SUBI T1,^D1900 ;LAST TWO ONLY
PUSHJ P,GETDEC ;DEPOSIT IT
MOVEI T1,SPACE ;LOAD AND OUTPUT A SPACE
IDPB T1,T3
IDPB T1,T3 ;2 SPACES
MOVE T1,[61,,11] ;LOAD THE HOUR
GETTAB T1,
JFCL
PUSHJ P,GETDEC ;AND DEPOSIT IT
MOVEI T1,":" ;LOAD AND OUTPUT A COLON
IDPB T1,T3
MOVE T1,[62,,11] ;LOAD MINUTES
GETTAB T1,
JFCL
CAIL T1,^D10 ;TWO DIGITS?
JRST .+5 ;YES, THEN DO IT
PUSH P,T1 ;SAVE T1
MOVEI T1,"0" ;LOAD AND OUTPUT A ZERO
IDPB T1,T3
POP P,T1 ;RESTORE T1
PUSHJ P,GETDEC ;AND OUTPUT IT
IPOPJ: POP P,I ;RESTORE I
POPJ P, ;RETURN
GETDEC: IDIVI T1,^D10 ;DIVIDE BY RADIX
JUMPE T1,.+4 ;IF DONE, JUMP OUT OF LOOP
PUSH P,T2 ;SAVE T2
PUSHJ P,GETDEC ;AND LOOP
POP P,T2 ;RESTORE T2
MOVEI T1,60(T2) ;MAKE ASCII
IDPB T1,T3 ;DEPOSIT IT
POPJ P, ;LOOP RETURN
PUTSIX: MOVE T4,[POINT 6,T2]
ILDB T1,T4
ADDI T1,40
PUSHJ P,LOUCH
CAME T4,[600,,T3]
JRST .-4
POPJ P,
PUTSSX: MOVE T4,[POINT 6,T2]
ILDB T1,T4
JUMPE T1,CPOPJ
ADDI T1,40
PUSHJ P,SOUCH
AOS SYMCNT
CAME T4,[600,,T3]
JRST PUTSSX+1
POPJ P,
DOLINO: TROE F,FR.LIN ;ALREADY PRINTED?
POPJ P, ;YES, DONE
PUSH P,T1
PUSH P,T2
TRNN F,FR.BOL ;AT START OF LINE?
PUSHJ P,LCRLF ;FIXUP BUG IN DC LOGIC (HORRORS)
MOVE T1,LINCTR ;GET LINE COUNT
CAMLE T1,PAGESZ ;TEST IN CASE IN DC? CODE
PUSHJ P,DOHDFF ;IF EXPANSION OF DB OVERFLOWS PAGE
AOS T1,LINENO ;GET LINE #
MOVEI T2,SPACE
EXCH T1,T2
CAIG T2,^D999
PUSHJ P,LOUCH
CAIG T2,^D99
PUSHJ P,LOUCH
CAIG T2,^D9
PUSHJ P,LOUCH
EXCH T1,T2
PUSHJ P,PUTDEC ;PRINT IT
MOVE T2,MACPDL
PUSH T2,INVECT
DOLIN2: HRRZ T1,(T2) ;IS THIS A SOURCE LINE?
CAIN T1,-1 ;..
JRST DOLIN1 ;YES, SKIP
CAIG T1,BAKPTR
CAIGE T1,BAKBUF ;CAME FROM BAKBUF?
JRST [MOVEI T1,"M" ;NO, FLAG AS A MACRO EXPANSION LINE
PUSHJ P,LOUCH
JRST DOLIN1]
SOJA T2,DOLIN2
DOLIN1: MOVEI T1,TAB
PUSHJ P,LOUCH ;& A TAB
POP P,T2
POP P,T1
POPJ P,
MONTAB: ASCIZ /Jan/
ASCIZ /Feb/
ASCIZ /Mar/
ASCIZ /Apr/
ASCIZ /May/
ASCIZ /Jun/
ASCIZ /Jul/
ASCIZ /Aug/
ASCIZ /Sep/
ASCIZ /Oct/
ASCIZ /Nov/
ASCIZ /Dec/
;ADD NEW MONTHS HERE
PASS1: TRZE F,FR.END ;DONE?
JRST ENDIT ;YES
PUSHJ P,TOKEN
PUSHJ P,IFPOP ;IF OR FRIENDS?
JRST NOP1T ;YES
TRNE F,FR.OFF
JRST FPASS1
NOP1T: JUMPN TOK,.+4
CAIE I,CR
CAIN I,SEMICO ;END OF LINE?
JRST FPASS1 ;YES, DONE
CAIN I,COLON ;BEFORE A COLON?
JRST LOASYM ;YES, ITS A LABEL
PUSHJ P,SRCHOP ;GET INDEX TO OPCODE
JRST [PUSHJ P,SETMAC;SETUP MACRO
JRST PASS1]
MOVE P1,TYPLSH(X)
TLNE P1,T.POP ;PSEUDO OP?
JRST [PUSHJ P,PSEUDO ;DOIT
JRST PASS1] ;LOOP BACK
AOS PC ;ONE BYTE
AOJ BC,
TLNN P1,T.2BYT!T.3BYT
JRST .+3
AOS PC ;TWO BYTES
AOJ BC,
TLNN P1,T.3BYTE
JRST .+3
AOS PC ;THREE BYTES
AOJ BC,
FPASS1: PUSHJ P,FLUSH
JRST PASS1
LOASYM: PUSHJ P,SRCSYM
DMOVEM TOK,(S)
HRR T1,PC ;FLAGS,PC
TRNN F,FR.ORG ;IF RELOCATING,
TLO T1,S.REL ;FLAG AS RELOCATABLE
TLZ T1,S.UNDF ;CLEAR UNDEFINED FLAG
CAIL S,SYMTAB ;SKIP IF ILLEGAL
MOVEM T1,2(S)
JRST PASS1
UUO: LDB E,[POINT 9,.JBUUO##,8]
JRST @UUOTAB-1(E)
UUOTAB: EUUO
WUUO
WUUO: MOVSI E,"%"
JRST EUUO+1
EUUO: MOVSI E,"?"
HRR E,.JBUUO
POPJ P,
DEFINE X(A,B,C,D),<
SIXBIT /A/
>
OPNTAB: XLIST
OPTYPE
LIST
OPTABL==.-OPNTAB
DEFINE X(A,B,C,D),<
EXP B
>
OPCTAB: XLIST
OPTYPE
LIST
DEFINE X(A,B,C,D),<
XWD C,D
>
TYPLSH: XLIST
OPTYPE
T.POP,,0 ;SO THAT UNDEF OPCODES DON'T BUMP PC
LIST
DEFINE W(A,B),<
[ASCIZ \B\]>
ERRTAB: XLIST
EFLAGS
LIT
LIST
RELOC 0
PRETAB: SIXBIT /A/
EXP 7
SIXBIT /B/
EXP 0
SIXBIT /C/
EXP 1
SIXBIT /D/
EXP 2
SIXBIT /E/
EXP 3
SIXBIT /H/
EXP 4
SIXBIT /L/
EXP 5
SIXBIT /M/
EXP 6
SIXBIT /SP/
EXP 6
SIXBIT /PSW/
EXP 6
PRELEN==.-PRETAB
SYMTAB::BLOCK 5*SYMSIZ
SYMEND==.
LINBLK: BLOCK ^D40 ;HOLDS MAX OF 200 CHARACTER LINE
LINEND==.-1
STRING: BLOCK 200 ;ROOM FOR 384 BYTES - 2 FULL PAGES OF GENERATED OUTPUT
MACDUM: BLOCK ^D40 ;HOLDS 20 DUMMY MACRO ARGS
MACDML==.-MACDUM
MACDND==.-1
MACARG: BLOCK ^D100 ;500 CHARACTERS OF MACRO ARGS
MACAND==.-1
ARGPTR: 0 ;POINTER TO MACARG
ARGSTK: BLOCK 20 ;POINTER TO ARGS OF NESTED MACROS
ARGPDL: 0 ;POINTER TO ARGSTK
REPCNT: 0 ;COUNT OF CURRENT REPT
REPADR: 0 ;ADDRESS OF REPT STRING
EOMFLG: 0 ;FLAG TO TELL THE DIFF BETWEED MACRO AND REPT
PC: 0
BYTCNT: 0
XTRAPC: 0
ORGXR: 0 ;INDEX INTO ORGBLK
ORGBLK: BLOCK 100 ;BYTE COUNT OF BLOCK
;START ADDRESS OF BLOCK
MACSTK: BLOCK 20 ;INVECT GETS PUSHED ON THIS WHEN A MACRO IS CALLED
MACPDL: 0 ;POINTER TO MACSTK
MACLEV: 0 ;LEVEL OF NESTING IN MACRO
LOCSYM: 0 ;VALUE OF LOCAL SYMBOL
OPSTK: BLOCK 20 ;PDL FOR POLISH STACK (ENOUGH?)
INVECT: 0 ;POINTS TO THE MACRO FROM WHICH INCH WILL GET ITS SOURCE
BAKBUF: BLOCK ^D100 ;HOLDS NEXT 100 WORDS IN BUFFER WHILE DOING SNEAK
BAKPTR: 0 ;POINTER TO BAKBUF
SNEAKI: 0 ;CONTENTS OF REG I WHEN DONE SNEAKING TOKEN
SAVREG: BLOCK 5 ;MISC. STORAGE WHEN STACK IS BUSY
IFLEVL: 0 ;LEVEL OF CURRENT NESTED IF
EXPLVL: 0 ;LEVEL OF CURRENT PAREN IN EXPRESSION
OFFLVL: 0 ;IFLEVL THAT ASSEMBLY WAS TURNED OFF
CHECK: 0 ;CHECKSUM
STARTA: 0 ;START ADDRESS
TITL: BLOCK 20 ;TITLE BUFFER
SUBTTL: BLOCK 40
SUBTLN==<.-SUBTTL>*5
IFN FTREL,<
RELPTR: 0
RELTAB: BLOCK ^D50 ;50 RELOC ADDRESSES (DUMPED WHEN GT 15)
RELEND==.-1
>
LINENO: 0
LINCTR: 0
DELIM: 0 ;USED TO TELL " FROM ' IN DC & SETMAC CODE
PAGENO: 0
SUBPAG: 0
SYMCNT: 0 ;NUMBER OF CHARACTERS PER LINE IN SYMBOL FILE
SYMTYP: 0 ;'TYPE' OF LAST SYMBOL IN SYMBOL FILE
PAGESZ: 0 ;SIZE OF PAGE - SET BY 'PAGE'
DATE: 0
0
0
ENDHGH::0
END
