diff --git a/build/misc.tcl b/build/misc.tcl index b0c70541..59b25e9a 100644 --- a/build/misc.tcl +++ b/build/misc.tcl @@ -258,6 +258,10 @@ expect ":KILL" respond "*" ":midas sys1;ts cross_syseng;cross\r" expect ":KILL" +# MACN80 +respond "*" ":midas sys3;ts macn80_gz;macn80\r" +expect ":KILL" + # dired respond "*" ":midas sys;ts dired_sysen2;dired\r" expect ":KILL" diff --git a/doc/programs.md b/doc/programs.md index d010a2b1..9f137bbe 100644 --- a/doc/programs.md +++ b/doc/programs.md @@ -117,6 +117,7 @@ - LSPEED, set tty line parameters. - LSRPRT, print information about user groups. - LUSER, request help from registered list of logged-in users. +- MACN80, Z80 cross assembler. - MACSYMA, symboling manipulation system. - MAXTUL, tools for managing Macsyma. - MAGDMP, standalone program loader/dumper for magtape. diff --git a/src/gz/macn80.mid b/src/gz/macn80.mid new file mode 100755 index 00000000..f9635c5f --- /dev/null +++ b/src/gz/macn80.mid @@ -0,0 +1,8598 @@ + SUBTTL ACCUMULATOR ASSIGNMENTS + + R0= 0 ; ACCUMULATION OF SIXBIT SYMBOL, SCRATCH + R1= 1 ; SYMBOL VALUE AND FLAGS SET BY SRCH. SCRATCH + R2= 2 ; SCRATCH + R3= 3 ; UNIVERSAL SCRATCH + R4= 4 ; UNIVERSAL SCRATCH +1 + R5= 5 ; LOCATION COUNTER + R6= 6 ; SCRATCH + R7= 7 ; SYMBOL TABLE SEARCH INDEX + R10= 10 ; EXPRESSION OR TERM VALUE, SCRATCH + R11= 11 ; SCRATCH + R12= 12 ; MACRO STORAGE BYTE POINTER + R13= 13 ; LINE BUFFER BYTE POINTER + R14= 14 ; CURRENT CHARACTER (ASCII) + R15= 15 ; LH - ASSEMBLER FLAGS, RH - ERROR FLAGS + R16= 16 ; EXEC FLAGS + + +; ALTERNATE SYMBOLIC AC ASSIGNMENTS ---- + +RLOC== 5 ; LOCATION COUNTER +RBPTR== 13 ; INPUT BYTE POINTER +RBYTE== 14 ; INPUT BYTE +RMODE== 15 ; MODE FLAG REGISTER (LEFT HALF) +RERR== 15 ; ERROR FLAG REGISTER (RIGHT HALF) +P== 17 ; STACK PTR FOR SUBROUTINE LINKAGE + +call= +return= + +CPOPJ1: AOS (P) +CPOPJ: POPJ P, + +tyoch==1 +lstch==2 +binch==3 +srcch==4 +tmpch==5 +tyich==6 + +define syscal op,args + .call [setz ? sixbit /op/ ? args ((setz))] +termin + +define pbout + .iot tyoch,R1 +termin +define psout + call psout. +termin + + PDPLEN== 256. ; PUSH-DOWN POINTER LENGTH + +PDPSTK: block pdplen +JCLBUF: block 50 + ^C_35 + +srcmax==20 +srctab: block 4*srcmax + + +TRUE== 1 + +DEFINE GENM40 A,B,C,D,E,F ;GEN MOD 40 + $!A*50*50+$!B*50+$!C,,$!D*50*50+$!E*50+$!F +TERMIN + +RADTBL: + +; Assignment of symbols for the mod 40 values of special +; characters isn't perfect, since Intel's special characters +; can't be used in PDP-10 labels: + +; $$ = mod 40 value corresponding to "?" +; $. = mod 40 value corresponding to "@" + + <$==0>,, SPACE-40 + 0,, "A-40 + 0,, "B-40 + 0,, "C-40 + 0,, "D-40 + 0,, "E-40 + 0,, "F-40 + 0,, "G-40 + + 0,, "H-40 + 0,, "I-40 + 0,, "J-40 + 0,, "K-40 + 0,, "L-40 + 35,, "M-40 + 0,, "N-40 + 0,, "O-40 + + <$0==36>,, "P-40 + <$1==37>,, "Q-40 + <$2==40>,, "R-40 + <$3==41>,, "S-40 + <$4==42>,, "T-40 + <$5==43>,, "U-40 + <$6==44>,, "V-40 + <$7==45>,, "W-40 + + <$8==46>,, "X-40 + <$9==47>,, "Y-40 + 0,, "Z-40 + 0,, "?-40 + 0,, "@-40 + 0,, ".-40 + 0,, "0-40 + <$$==33>,, "1-40 + + <$.==34>,, "2-40 + <$A==1>,, "3-40 + <$B==2>,, "4-40 + <$C==3>,, "5-40 + <$D==4>,, "6-40 + <$E==5>,, "7-40 + <$F==6>,, "8-40 + <$G==7>,, "9-40 + + <$H==10>,, 0 + <$I==11>,, 0 + <$J==12>,, 0 + <$K==13>,, 0 + <$L==14>,, 0 + <$M==15>,, 0 + <$N==16>,, 0 + <$O==17>,, 0 + + <$P==20>,, 0 + <$Q==21>,, 0 + <$R==22>,, 0 + <$S==23>,, 0 + <$T==24>,, 0 + <$U==25>,, 0 + <$V==26>,, 0 + <$W==27>,, 0 + + <$X==30>,, 0 + <$Y==31>,, 0 + <$Z==32>,, 0 + 0,, 0 + 0,, 0 + 0,, 0 + 0,, 0 + 0,, 0 + +; CONVERTS 6 SIXBIT CHARACTERS IN R0 TO 6 RAD50 CHARACTERS +; IN R0 AS 3 CHARCTERS IN A 16 BIT WORD IN EACH HALFWORD. +SIXM40: ;SIXBIT TO MOD40 + PUSH P,R1 + PUSH P,R2 + PUSH P,R3 ;STACK REGISTERS + SETZ R1, + MOVSI R3,(440600,,r0) +SIXM41: ILDB R2,R3 ;GET A CHARACTER + HLRZ R2,RADTBL(R2) ;MAP + IMULI R1,50 + ADD R1,R2 + TLNE R3,770000 ;FINISHED? + JRST SIXM41 ; NO + IDIVI R1,50*50*50 ;YES, SPLIT INTO HALVES + HRLZ R0,R1 ;HIGH ORDER + HRR R0,R2 ; AND LOW ORDER + POP P,R3 ;RESTORE REGISTERS + POP P,R2 + POP P,R1 + RETURN + +; INVERSE OF SIXM40 + +M40SIX: ;MOD40 TO SIXBIT + PUSH P,R1 + PUSH P,R2 + LDB R1,[222000,,R0] + IMULI R1,50*50*50 ;MERGE + HRRZS R0 + ADD R0,R1 + SETZ R2, ;ACCUMULATOR +M40SI1: IDIVI R0,50 + HRRZ R1,RADTBL(R1) ;MAP + LSHC R1,-6 ;MOVE INTO COLLECTOR + JUMPN R0,M40SI1 ;TEST FOR END + MOVE R0,R2 + POP P,R2 + POP P,R1 + RETURN + + ; R16 - LH + + LSTBIT== 000001 ; 1- SUPRESS LISTING OUTPUT + BINBIT== 000002 ; 1- SUPRESS BINARY OUTPUT + CSWBIT== 000004 ; 1- SUPRESS CROSS REFERENCE + IRPBIT== 000010 ; 1- GENERATING .IRP CALL BLOCK + ; * THAT MEANS PARSE ONLY 1 ARG. + FOLBIT== 000020 ; 1- OVERRIDE INPUT FOLDING + MODBIT== 000040 ; 1- USER MODE AC'S SET + GEQBIT== 000100 ; 1- GLOBAL EQUATE (==) BEING PROCESSED + TTYBIT== 000200 ; 1- LISTING IS ON TTY + ERRBIT== 000400 ; 1- ERROR MESSAGES ENABLED + SBTBIT== 001000 ; 1- SUBTITLE AVAILABLE + NLISLN== 002000 ; 1- SUPPRESS LIST OF CURRENT LINE + LBLBIT== 004000 ; 1- STATEMENT IS LABELED (MAY BE + ; USED TO FORCE PRINTING LOC) + PF1BIT== 010000 ; 1- PRINT PF1 AS IS, INSTEAD OF + ; A WORD FROM CODBUF + MEXBIT== 020000 ; 1- MACRO EXPANSION IN PROGRESS + BEXBIT== 040000 ; 1- BINARY EXTENSION LINE BEING LISTED +;;;; LOHBIT== 100000 ; 1- No longer used + IIFBIT== 200000 ; 1- .IIF (NOT .IF!) IN PROGRESS + REQBIT== 400000 ; 1- .REQUIRE in progress + ; R16 - RH, Bits used by the assembler + + SETBIT== 010000 ; 1- SET (not EQU) being assembled + FFBIT== 020000 ; 1- FORM-FEED SEEN + ASCBIT== 100000 ; 1- This line contains a .ASCIZ or .ASCII and + ; binary output is to be suppressed + HDRBIT== 200000 ; 1- TIME FOR NEW LISTING PAGE + SEQBIT== 400000 ; 1- SEQUENCE NUMBER SEEN + + ; R15 - LH + + CDRFLG== 000001 ; 1- CARD READER INPUT (73-80 IGNORED) + LCFLG== 000002 ; 1- LOWER CASE INPUT + LSBFLG== 000004 ; 1- LOCAL SYMBOL BLOCK ENABLED + PNCFLG== 000010 ; 1- BINARY OUTPUT ENABLED + ENDFLG== 000020 ; 1- END OF SOURCE ENCOUNTERED + REGFLG== 000040 ; 1- REGISTERS DEFINED BY ASSEMBLER + AMAFLG== 000100 ; 1- ABS MODE ADDRESSING + CONFLG== 000200 ; 1- CONCATENATION CHARACTER SEEN + HFKFLG== 000400 ; 1- Half-killed symbol mode enabled + FPTFLG== 001000 ; 1- FLOATING POINT TRUNCATION MODE + GBLFLG== 002000 ; 1- TREAT UNDEFINED SYMBOLS AS GLOBAL + HOVFLG== 004000 ; 1- CAUSES SYMBOL BEGINNING WITH A-F + ; TO BE INTERPRETED AS A HEX + ; CONSTANT, IF RADIX=16 + ABSFLG== 010000 ; 1- ABSOLUTE OBJECT + ISDFLG== 020000 ; 1- INTERNAL SYMBOL DICTIONARY REQ'D + FLTFLG== 040000 ; 1- ERROR ENCOUNTERED IN FLOATING ROUTINE + Z80FLG== 200000 ; 1- Assemble CP & JP for Z80 (not 8080) + P1F== 400000 ; 1- PASS 1 IN PROGRESS + +; ** ALL BITS CORRESPONDING TO .ENABL/.DSABL OPTIONS: + +ENAMA1== ABSFLG+AMAFLG+CDRFLG+FPTFLG+GBLFLG+HOVFLG +ENAMA2== LCFLG+LSBFLG+PNCFLG+REGFLG+ISDFLG+HFKFLG+Z80FLG + +ENMASK== ENAMA1+ENAMA2 + +ENDEF== LCFLG+PNCFLG+ABSFLG ; ***** DEFAULT ENABL MODES ***** + + + ; R15 - RH + + ERRA== 400000 ; 1- OPERAND ERROR. + ERRB== 200000 ; 1- BOUNDARY ERROR. + ERRD== 100000 ; 1- DOUBLY-DEFINED SYSMBOL REFERENCED. + ERRE== 040000 ; 1- END DIRECTIVE NOT FOUND. + ERRI== 020000 ; 1- ILLEGAL CHARACTER DETECTED. + ERRL== 010000 ; 1- LINE BUFFER OVERFLOW (EXTRA CHARCTERS IGNORED). + ERRM== 004000 ; 1- MULTIPLE DEFINITION OF A LABEL. + ERRO== 002000 ; 1- OPCODE ERROR. + ERRP== 001000 ; 1- PHASE ERROR. + ERRQ== 000400 ; 1- QUESTIONABLE SYNTAX + ERRR== 000200 ; 1- REGISTER TYPE ERROR. + ERRT== 000100 ; 1- TRUNCATION ERROR. + ERRU== 000040 ; 1- UNDEFINED SYMBOL. + ERRN== 000020 ; 1- INVALID NUMERIC DIGIT(S) + ERRZ== 000010 ; 1- MARGINAL INSTRUCTION + + ERRP1== 000001 + +; -------- LISTING CONTROL FLAGS ----------- + +; THESE FLAGS ARE USED IN THE FOLLOWING WORDS: +; LIWORD LH - VALUE OF OVERRIDES FROM COMMAND STRING +; RH - MASK SHOWING WHICH MODE BITS ARE OVERRIDDEN + +; LSTCTL LH - VALUE OF LISTING MODES SET BY SOURCE DIRECTIVES +; RH - EFFECTIVE MODES, DETERMINED BY ALL 3 1/2 WORDS ABOVE + +LBEX== 000001 ; BINARY EXTENSIONS +LBIN== 000002 ; BINARY CODE +LCOM== 000004 ; COMMENTS +LCND== 000010 ; UNSATISFIED CONDITIONS +LLD== 000020 ; LISTING DIRECTIVES WITHOUT ARGUMENTS +LLOC== 000040 ; LOCATION COUNTER +LMC== 000100 ; MACRO CALLS +LMD== 000200 ; MACRO DEFINITIONS +LME== 000400 ; MACRO EXPANSIONS +LMEB== 001000 ; MACRO EXPANSION BINARY CODE +LSEQ== 002000 ; SOURCE SEQUENCE NUMBERS +LSON== 004000 ; SOURCE ORIENTED NUMBERING +LSRC== 010000 ; SOURCE CODE +LSYM== 020000 ; SYMBOL TABLE +LTOC== 040000 ; TABLE OF CONTENTS +LTTM== 100000 ; TELETYPE MODE +LASC== 200000 ; ASCII and ASCIZ output control + +LDEF= 777777-LLD-LTTM-LSON ; ***** DEFAULT LIST MODES ***** + + +DEFSYM== 400000 ;DEFINED SYMBOL +LBLSYM== 200000 ;LABEL +SETSYM== 100000 ; SET symbol +GLBSYM== 040000 ;GLOBAL +MDFSYM== 020000 ;MULTIPLY-DEFINED FLAG +HFKSYM== 010000 ; Half killed symbol +MD2SYM== 004000 ; Macro defined on pass 2. + +TITLE.: SIXBIT /MACN80/ +ASMVER: SIXBIT /V2.02 / ; ---- VERSIONS SHOULD CHANGE ON 1ST EDIT + +tsint: loc 42 + -tsintl,,tsint + loc tsint + p + 0 ? 1_tyich ? 0 ? 0 ? status +tsintl=.-tsint + +; Status interrupt routine... + +STATUS: + PUSH P,R1 + PUSH P,R2 + PUSH P,R3 ; Save a few registers + movei R1,tyich + .ityic R1, + jrst stat1 + caie R1,^T + jrst stat1 + syscal ttyfls,[%clbit,,1 ? %climm,,tyich] + jfcl + HRROI R1,[ ASCIZ /A Pass / ] + call PSOUT. ; Print which pass its on + MOVEI R1,"2 ; Assume pass 2 + TLNE R15,P1F ; Is it? + MOVEI R1,"1 ; No - set to pass 1 + .iot tyoch,R1 + HRROI R1,[ ASCIZ / - File: / ] + call PSOUT. + HRROI R1,SFILNM + call PSOUT. + HRROI R1,[ ASCIZ / Line: / ] + call PSOUT. ; Print line number now + MOVE R1,SEQ ; Get line number + call inout ; Print it + JFCL + .iot tyoch,[^M] + .iot tyoch,[^J] +stat1: POP P,R3 ; Restore registers + POP P,R2 + POP P,R1 + syscal dismis,[p] + .Lose %LsSys + +inout: push p,R2 + idivi R1,10. + skipe R1 + call inout + addi R2,"0 + .iot tyoch,R2 + pop p,R2 + return + + +CODLOC: BLOCK 1 ; Address of 1st data byte in CODBUF +CODPNT: BLOCK 1 ; Pointer to last byte in CODBUF +CODBUF: BLOCK 100. ; Binary output buffer + +ILOC: BLOCK 1 ; PC at start of instruction +IPNT: BLOCK 1 ; CODPNT at start of instruction + +SYMBEG: BLOCK 1 ;POINTER TO START OF SYMBOL FOR RESCAN PURPOSES +STRSYM: BLOCK 1 ; Unprocessed symbol at start of line, + ; delimited by space or tab + + +OPCODE: BLOCK 1 ;STORAGE FOR OP CODE +INSLEN: BLOCK 1 ; Instruction length - 1 + +LOCRDX: BLOCK 1 ;LOCAL RADIX + +STMNJT: ;STATEMENT JUMP TABLE. Indexed by type in OPTAB + OFFSET -. + JRST STMNT2 ;BASIC SYMBOL +MAOP:: JRST CALLM ;MACRO +OCOP:: JRST PROPC ;OP CODE +DIOP:: JRST 0(R1) ;PSEUDO-OP + OFFSET 0 + +OPFORT: ; Op format table for reg parsing + JFCL ; Type 0: No register operands + CALL OPFOR1 ; Type 1 + CALL OPFOR2 ; Type 2 + CALL OPFOR3 ; etc. + CALL OPFOR4 + CALL OPFOR5 + CALL OPFOR6 + CALL OPFOR7 + JRST Z80PRS ; Type 8: Z80 op code + ; (identified by parsing operands) + JRST Z80JP ; Type 9: Z80 jump/call/return family + +EXPRJT: ;EXPRESSION JUMP TABLE + OFFSET -. + JRST CPOPJ1 ;NOT AN OP NOR TERM; EXIT +EXTE:: JRST EXPR3 ; Possible logical operator +EXPL:: MOVEI R2,EXPRPL ; + +EXMI:: MOVEI R2,EXPRMI ; - +EXOR:: MOVEI R2,EXPROR ; ! +EXAN:: MOVEI R2,EXPRAN ; & +EXMU:: MOVEI R2,EXPRMU ; * +EXDV:: MOVEI R2,EXPRDV ; / +EXSH:: MOVEI R2,EXPRSH ; _ (LOGICAL SHIFT) + OFFSET 0 + +TERMJT: ;TERM JUMP TABLE, indexed from C5PNTR in CHJTBL + OFFSET -. + RETURN ;NULL RETURN +TEIG:: JRST TERPL ; IGNORE (+) +TE2C:: CALL TERM2C ; - (2'S COMPLEMENT) +TEEX:: CALL TERMEX ; ( (EXPRESSION FOLLOWS) +TESQ:: CALL TERMSQ ; ' +TEDL:: CALL TERMDL ; $ +TENM:: CALL TERMNM ; 0-9 +TEHX:: CALL TERMNM ; A-F (IF HEX ENABLED) + OFFSET 0 + + ILLCHR== 1 ;ILLEGAL CHARACTER SUBSTITUTE + ELLCHR== 2 ;END OF LOGICAL LINE CHARACTER + +CHARTB: ;CHARACTER JUMP TABLE + OFFSET -. + MOVEI R14,ILLCHR ;ILLEGAL CHARACTER +QJNU:: JRST CHAR ;NULL, TRY AGAIN +QJCR:: JFCL ;END OF STATEMENT +QJVT:: MOVEI R14,LF ;VERTICAL TAB +QJSP:: JFCL ;BLANK +QJPC:: JFCL ;PRINTING CHARACTER +QJLC:: JRST CHFOLD ; LOWER CASE, MAYBE FOLD + OFFSET 0 + + + SUBTTL RESERVED REGISTER SYMBOLS FOR Z80 PARSING +RSTAB: + GENM40 B ; Single standard regs: + 1,,0 ; B,C,D,E,H,L,A + GENM40 C + 1,,1 + GENM40 D + 1,,2 + GENM40 E + 1,,3 + GENM40 H + 1,,4 + GENM40 L + 1,,5 + GENM40 M + 1,,6 + GENM40 A + 1,,7 + GENM40 B,C ; Standard register pairs: + 2,,0 ; BC, DE, HL, SP, AF + GENM40 D,E + 2,,1 + GENM40 H,L + 2,,2 + GENM40 S,P + 2,,3 + GENM40 A,F + 2,,4 + GENM40 I ; Special Z80 registers: + 3,,0 ; I, IX, IY, R + GENM40 I,X + 3,,1 + GENM40 I,Y + 3,,2 + GENM40 R + 3,,3 + + GENM40 P,S,W ; 8080 alias for AF + 2,,4 +RSSIZE== <.-RSTAB>/2 + +RITAB: ; Register indirect evaluations + GENM40 H,L ; (HL): Type 4, value 0 + 4,,0 + GENM40 D,E + 4,,1 + GENM40 B,C + 4,,2 + GENM40 S,P + 4,,3 + GENM40 I,X + 4,,4 + GENM40 I,Y + 4,,5 + GENM40 C + 4,,6 +RISIZE== <.-RITAB>/2 + +BINRDX== 1 ;BIT DEFINITIONS FOR GLBRDX CONTROL WORD +QUARDX== 2 +OCTRDX== 4 +DECRDX== 10 +HEXRDX== 20 +HEXENB== 40 ;ENABLES HEX CONSTANTS TO START WITH A-F, + ; SO CONSEQUENTLY SYMBOLS CAN'T + +RADCHR: ; Radix selector codes + "H ; H -- Hexadecimal + "D ; D -- Decimal + "O ; O -- Octal + "Q ; Q -- Octal (not quaternary!) + "B ; B -- Binary + +RADTAB: ; Matching radix codes + HEXRDX + DECRDX + OCTRDX + OCTRDX + BINRDX + +C1PNTR: 400400,,CHJTBL(R14) +C2PNTR: 340400,,CHJTBL(R14) +C3PNTR: 300400,,CHJTBL(R14) +C4PNTR: 240400,,CHJTBL(R14) +C5PNTR: 200400,,CHJTBL(R14) ;Index into TERMJT +C6PNTR: 140400,,CHJTBL(R14) ;Index into SCHTAB +C7PNTR: 100400,,CHJTBL(R14) +C8PNTR: 040400,,CHJTBL(R14) +C9PNTR: 000400,,CHJTBL(R14) + +CHJTBL: ;CHARACTER JUMP TABLE + OFFSET -. + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCLE ? QJNU ? 0 ? .BYTE ; NULL + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCIL ? QJPC ? 0 ? .BYTE ; ^A + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCEL ? QJPC ? 0 ? .BYTE ; ^B + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCLE ? QJNU ? 0 ? .BYTE ; ^C + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; ^D + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; ^E + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; ^F + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; ^G + + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; ^H +TAB:: .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCSE ? QJSP ? .TAB ? .BYTE ; TAB +LF:: .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCLE ? QJCR ? 0 ? .BYTE ; LF + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJVT ? 0 ? .BYTE ; +FF:: .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCLE ? QJCR ? 0 ? .BYTE ; FF +CRR:: .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCLE ? QJCR ? 0 ? .BYTE ; CR + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; ^N + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; ^O + + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; ^P + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; ^Q + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; ^R + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; ^S + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; ^T + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; ^U + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; ^V + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; ^W + + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; ^X + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; ^Y + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; ^Z + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; ESC + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; ^\ + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; ^] + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; ^^ + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJCR ? 0 ? .BYTE ; EOL + +SPACE: .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCSE ? QJSP ? .TAB ? .BYTE ; SPACE + .BYTE 4 ? 0 ? 0 ? 0 ? EXOR ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; ! + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; " + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; # + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? TEDL ? 0 ? QJPC ? .DOL ? .BYTE ; $ + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; % + .BYTE 4 ? 0 ? 0 ? 0 ? EXAN ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; & + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? TESQ ? 0 ? QJPC ? 0 ? .BYTE ; ' + + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? TEEX ? 0 ? QJPC ? 0 ? .BYTE ; ( + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; ) + .BYTE 4 ? 0 ? 0 ? 0 ? EXMU ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; * + .BYTE 4 ? 0 ? 0 ? 0 ? EXPL ? TEIG ? 0 ? QJPC ? 0 ? .BYTE ; + + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCSE ? QJPC ? 0 ? .BYTE ; ? + .BYTE 4 ? 0 ? 0 ? 0 ? EXMI ? TE2C ? 0 ? QJPC ? 0 ? .BYTE ; - + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? .ALP ? .BYTE ; . + .BYTE 4 ? 0 ? 0 ? 0 ? EXDV ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; / + + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? TENM ? 0 ? QJPC ? .NUM ? .BYTE ; 0 + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? TENM ? 0 ? QJPC ? .NUM ? .BYTE ; 1 + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? TENM ? 0 ? QJPC ? .NUM ? .BYTE ; 2 + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? TENM ? 0 ? QJPC ? .NUM ? .BYTE ; 3 + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? TENM ? 0 ? QJPC ? .NUM ? .BYTE ; 4 + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? TENM ? 0 ? QJPC ? .NUM ? .BYTE ; 5 + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? TENM ? 0 ? QJPC ? .NUM ? .BYTE ; 6 + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? TENM ? 0 ? QJPC ? .NUM ? .BYTE ; 7 + + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? TENM ? 0 ? QJPC ? .NUM ? .BYTE ; 8 + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? TENM ? 0 ? QJPC ? .NUM ? .BYTE ; 9 + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; : + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCSE ? QJPC ? 0 ? .BYTE ; ; + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; < + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; = + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; > + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? .ALP ? .BYTE ; ? + + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? .ALP ? .BYTE ; @ + .BYTE 4 ? 0 ? 0 ? 0 ? EXTE ? TEHX ? 0 ? QJPC ? .HEX ? .BYTE ; A + .BYTE 4 ? 0 ? 0 ? 0 ? EXTE ? TEHX ? 0 ? QJPC ? .HEX ? .BYTE ; B + .BYTE 4 ? 0 ? 0 ? 0 ? EXTE ? TEHX ? 0 ? QJPC ? .HEX ? .BYTE ; C + .BYTE 4 ? 0 ? 0 ? 0 ? EXTE ? TEHX ? 0 ? QJPC ? .HEX ? .BYTE ; D + .BYTE 4 ? 0 ? 0 ? 0 ? EXTE ? TEHX ? 0 ? QJPC ? .HEX ? .BYTE ; E + .BYTE 4 ? 0 ? 0 ? 0 ? EXTE ? TEHX ? 0 ? QJPC ? .HEX ? .BYTE ; F + .BYTE 4 ? 0 ? 0 ? 0 ? EXTE ? 0 ? 0 ? QJPC ? .ALP ? .BYTE ; G + + .BYTE 4 ? 0 ? 0 ? 0 ? EXTE ? 0 ? 0 ? QJPC ? .ALP ? .BYTE ; H + .BYTE 4 ? 0 ? 0 ? 0 ? EXTE ? 0 ? 0 ? QJPC ? .ALP ? .BYTE ; I + .BYTE 4 ? 0 ? 0 ? 0 ? EXTE ? 0 ? 0 ? QJPC ? .ALP ? .BYTE ; J + .BYTE 4 ? 0 ? 0 ? 0 ? EXTE ? 0 ? 0 ? QJPC ? .ALP ? .BYTE ; K + .BYTE 4 ? 0 ? 0 ? 0 ? EXTE ? 0 ? 0 ? QJPC ? .ALP ? .BYTE ; L + .BYTE 4 ? 0 ? 0 ? 0 ? EXTE ? 0 ? 0 ? QJPC ? .ALP ? .BYTE ; M + .BYTE 4 ? 0 ? 0 ? 0 ? EXTE ? 0 ? 0 ? QJPC ? .ALP ? .BYTE ; N + .BYTE 4 ? 0 ? 0 ? 0 ? EXTE ? 0 ? 0 ? QJPC ? .ALP ? .BYTE ; O + + .BYTE 4 ? 0 ? 0 ? 0 ? EXTE ? 0 ? 0 ? QJPC ? .ALP ? .BYTE ; P + .BYTE 4 ? 0 ? 0 ? 0 ? EXTE ? 0 ? 0 ? QJPC ? .ALP ? .BYTE ; Q + .BYTE 4 ? 0 ? 0 ? 0 ? EXTE ? 0 ? 0 ? QJPC ? .ALP ? .BYTE ; R + .BYTE 4 ? 0 ? 0 ? 0 ? EXTE ? 0 ? 0 ? QJPC ? .ALP ? .BYTE ; S + .BYTE 4 ? 0 ? 0 ? 0 ? EXTE ? 0 ? 0 ? QJPC ? .ALP ? .BYTE ; T + .BYTE 4 ? 0 ? 0 ? 0 ? EXTE ? 0 ? 0 ? QJPC ? .ALP ? .BYTE ; U + .BYTE 4 ? 0 ? 0 ? 0 ? EXTE ? 0 ? 0 ? QJPC ? .ALP ? .BYTE ; V + .BYTE 4 ? 0 ? 0 ? 0 ? EXTE ? 0 ? 0 ? QJPC ? .ALP ? .BYTE ; W + + .BYTE 4 ? 0 ? 0 ? 0 ? EXTE ? 0 ? 0 ? QJPC ? .ALP ? .BYTE ; X + .BYTE 4 ? 0 ? 0 ? 0 ? EXTE ? 0 ? 0 ? QJPC ? .ALP ? .BYTE ; Y + .BYTE 4 ? 0 ? 0 ? 0 ? EXTE ? 0 ? 0 ? QJPC ? .ALP ? .BYTE ; Z + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; [ + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; \ + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; ] + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; ^ + .BYTE 4 ? 0 ? 0 ? 0 ? EXSH ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; _ + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; ` + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCLC ? QJLC ? 0 ? .BYTE ; a + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCLC ? QJLC ? 0 ? .BYTE ; b + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCLC ? QJLC ? 0 ? .BYTE ; c + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCLC ? QJLC ? 0 ? .BYTE ; d + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCLC ? QJLC ? 0 ? .BYTE ; e + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCLC ? QJLC ? 0 ? .BYTE ; f + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCLC ? QJLC ? 0 ? .BYTE ; g + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCLC ? QJLC ? 0 ? .BYTE ; h + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCLC ? QJLC ? 0 ? .BYTE ; i + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCLC ? QJLC ? 0 ? .BYTE ; j + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCLC ? QJLC ? 0 ? .BYTE ; k + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCLC ? QJLC ? 0 ? .BYTE ; l + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCLC ? QJLC ? 0 ? .BYTE ; m + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCLC ? QJLC ? 0 ? .BYTE ; n + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCLC ? QJLC ? 0 ? .BYTE ; o + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCLC ? QJLC ? 0 ? .BYTE ; p + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCLC ? QJLC ? 0 ? .BYTE ; q + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCLC ? QJLC ? 0 ? .BYTE ; r + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCLC ? QJLC ? 0 ? .BYTE ; s + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCLC ? QJLC ? 0 ? .BYTE ; t + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCLC ? QJLC ? 0 ? .BYTE ; u + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCLC ? QJLC ? 0 ? .BYTE ; v + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCLC ? QJLC ? 0 ? .BYTE ; w + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCLC ? QJLC ? 0 ? .BYTE ; x + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCLC ? QJLC ? 0 ? .BYTE ; y + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? SCLC ? QJLC ? 0 ? .BYTE ; z + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; { + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; | +ALTMOD: .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; } + .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJPC ? 0 ? .BYTE ; ~ +RUBOUT: .BYTE 4 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? QJNU ? 0 ? .BYTE ; + OFFSET 0 + + +GETSYT: ;GETSYM TABLE + OFFSET -. + JRST GETSY2 ;NON-ALPHA/NUMERIC +.TAB: JRST GETSY2 ;BLANK +.DOL: JRST GETSY2 ;Dollar sign +.ALP: JFCL ;ALPHA, O.K. +.NUM: JUMPE R0,GETLSY ; NUMERIC => LOCAL SYM IF 1ST BYTE +.HEX: JUMPE R0,GETSY3 ;A-F O.K. IF NOT FIRST + OFFSET 0 + +SCHTAB: ;GETCHR table, indexed by C6PNTR from CHJTBL + OFFSET -. + JFCL ; IGNORE RANDOM CHARACTERS. +SCIL:: JRST SETCHI ; ILLCHR - ISSUE I FLAG & SKIP BYTE. +SCEL:: JRST GETEOL ; ELLCHR - SKIP TO END OF LINE. +SCLC:: JRST FOLTST ; LOWER CASE - FOLD UNLESS OVERRIDDEN +SCLE:: JFCL ; LINE END (CR, LF, FF, NUL) - IGNORE +SCSE:: JFCL ; SEPARATOR (, ;, BLANK, TAB) - IGNORE + OFFSET 0 + +GETLTS: ;Local symbol parse table + JRST GETLNS ; NON ALPHA-NUMERIC + JRST GETLNS ; BLANK OR TAB + JRST GETLDO ; Dollar sign + JRST GETLNS ; ALPHABETIC + JFCL ; NUMERIC + JRST GETLNS ; A-F + +; Z80 jump conditions: +ZJCTAB: GENM40 N,Z ; NZ -- Nonzero + GENM40 Z ; Z -- Zero + GENM40 N,C ; NC -- No carry + GENM40 C ; C -- Carry + GENM40 P,O ; PO -- Parity odd + GENM40 P,E ; PE -- Parity even + GENM40 P ; P -- Plus + GENM40 M ; M -- Minus + +DEFINE ARG A,B,C,VALUE ; ARG TABLE GENERATOR + VALUE,,$!A*50*50+$!B*50+$!C +TERMIN + +LISTBL: -,,.+1 ; -<# args>,<1st arg addr> + ARG B,E,X,LBEX ; TABLE OF .LIST & .NLIST OPERANDS + ARG B,I,N,LBIN + ARG C,O,M,LCOM + ARG C,N,D,LCND + ARG L,D,,LLD + ARG L,O,C,LLOC + ARG M,C,,LMC + ARG M,D,,LMD + ARG M,E,,LME + ARG M,E,B,LMEB + ARG S,E,Q,LSEQ + ARG S,O,N,LSON + ARG S,R,C,LSRC + ARG S,Y,M,LSYM + ARG T,O,C,LTOC + ARG T,T,M,LTTM + ARG A,S,C,LASC +LISTBX=. + +ENATBL: -,,.+1 ; .ENABL/.DSABL ARGUMENTS + ARG A,B,S,ABSFLG + ARG A,M,A,AMAFLG + ARG C,D,R,CDRFLG + ARG F,P,T,FPTFLG + ARG G,B,L,GBLFLG + ARG .,5,K,HFKFLG + ARG H,O,V,HOVFLG + ARG I,S,D,ISDFLG + ARG L,C,,LCFLG + ARG L,S,B,LSBFLG + ARG P,N,C,PNCFLG + ARG R,E,G,REGFLG + ARG Z,8,0,Z80FLG +ENAEND=. + +M40NOT: GENM40 N,O,T +M40AND: GENM40 A,N,D +M40OR: GENM40 O,R +M40XOR: GENM40 X,O,R +M40MOD: GENM40 M,O,D +M40SHL: GENM40 S,H,L +M40SHR: GENM40 S,H,R + + +PSIXTP==cpopj +RFN"A==R1 ;terminator char, current char in RSIXTP +RFN"B==R2 ;Filename block, preserved +RFN"E==R3 ;flags +RFN"C==R13 ;preserved +RFN"D==R14 ;bp +fblk: block 4 ;A filename block + +$$RFN==1 +$$SWITCH==1 +$$PFN==1 +.insrt syseng;rfn +jclflg: block 1 +rsixtp: skipn jclflg + return ;jclflg=0, no terminators + caie r1,"/ + cain r1,", + jrst cpopj1 + caie r1,"= + cain r1,"_ + skipg jclflg ;jclflg=-1, only comma & switch + return + jrst cpopj1 ;jclflg=1, comma & switch & _= + + SUBTTL ASSEMBLER PROPER +RUNTIM: BLOCK 1 ;RUN TIME +datstr: block 5 ;HH:MM:SS MM/DD/YY + +datout: move r5,[440600,,r2] + ildb r6,r5 ? addi r6,40 ? idpb r6,r4 + ildb r6,r5 ? addi r6,40 ? idpb r6,r4 + idpb r3,r4 + ildb r6,r5 ? addi r6,40 ? idpb r6,r4 + ildb r6,r5 ? addi r6,40 ? idpb r6,r4 + idpb r3,r4 + ildb r6,r5 ? addi r6,40 ? idpb r6,r4 + ildb r6,r5 ? addi r6,40 ? idpb r6,r4 + return + +SEXTS: sixbit/>/ ;We search this *backward* + sixbit/M8/ + sixbit/M80/ + sixbit/Z8/ +sextsb: sixbit/Z80/ + +SWITCH: cain r1,"L ;/L means make a listing + jrst [tlz r16,lstbit + return] + cain r1,"S ;/S means syntax only (no binary) + jrst [tlo r16,binbit + return] + move r10,r1 + hrroi r1,[asciz\AIllegal switch:/\] ? psout + move r1,r10 + pbout + hrroi r1,[asciz/./] + jrst errout + + +MACN80: + MOVE P,[-PDPLEN,,PDPSTK-1] ; INIT STACK POINTER. + syscal open,[%clbit,,.uao\%tjdis ? %climm,,tyoch ? [sixbit/TTY/]] + .Lose %LsFil + syscal open,[%clbit,,.uai ? %climm,,tyich ? [sixbit/TTY/]] + .Lose %LsFil + MOVE R1,[-RQSTKL,,REQSTK-1] ; Get .REQUIRE stack pointer + MOVEM R1,REQSP ; and reset it + CALL SRCHI ; INITIALIZE SYMBOL TABLE. + MOVSI R16,BINBIT\LSTBIT\CSWBIT ; INIT FLAGS IN R16 LH. + SETZB R15,R5 ; Clear byte count and flag register + .break 12,[..rjcl,,Jclbuf] ;Get JCL + skipn Jclbuf + jrst NoJCL + ldb R1,[350700,,Jclbuf] + cain R1,"? + jrst Help + tlz R16,BINBIT ;Assume wants binary + move r14,[440700,,jclbuf] + movei r1,2 ;JCLFLG positive to accept backarrow + movem r1,jclflg +jcl: movei r2,srctab +jcl0: call rfn"rfn + movsi r4,'DSK ;If SNAME is given, device always + tlne r3,1_rfn"snm ;defaults back to DSK + tlne r3,1_rfn"dev + skipa + movem r4,0(r2) + tlnn r3,1_rfn"fn2 ;Do not default type (except by ^Y) + setzm 2(r2) + caie r1,"_ + cain r1,"= + jrst [move r1,[srctab,,binblk] ;Move filename to BINBLK + blt r1,binblk+3 + sos r1,jclflg + setom jclflg + jumpg r1,jcl ;Had just binfile=. Go on... + tlz r16,lstbit ;Else had a listing file + move r1,[srctab+4,,lstblk] + blt r1,lstblk+3 + move r1,[lstblk,,srctab] ;Make it the default for 1st src + blt r1,srctab+3 + jrst jcl] + move r3,r2 + hrl r3,r3 + addi r3,4 + movei r2,(r3) ;Advance pointer + caie r1,", + jrst jclend ;All done + sosn jclflg + setom jclflg + blt r3,3(r2) ;Default next file from this one + caige r2,srctab+4*srcmax + jrst jcl0 + hrroi r1,[asciz/AToo many source files/] +Errout: psout + .logout 1, + +jclend: setzm jclflg + caie r1,^M + cain r1,^C + jrst FINI + hrroi r1,[asciz/AIllegal character in JCL/] + jrst errout + +FINI: movsi r1,'DSK ;Default source files + skipn srctab+0 + movem r1,srctab+0 + skipn srctab+3 + .suset [.rhsname,,srctab+3] + movei r3,srctab +fini1: skipn 1(r3) + jrst [hrroi r1,[asciz/ANo file name?/] ? jrst errout] + move r4,[sextsb-sexts,,sextsb] + skipe 2(r3) + tloa r4,-1 ;Already have type +fini2: pop r4,2(r3) + syscal open,[%clbit,,.uai ? %climm,,tmpch + 0(r3) ? 1(r3) ? 2(r3) ? 3(r3)] + jrst [jumpge r4,fini2 + move r2,r3 ? move r14,[440700,,sfilnm] ? call rfn"pfn + setz r1, + idpb r1,r14 + hrroi r1,[asciz/AFile /] ? psout + hrroi r1,sfilnm ? psout + hrroi r1,[asciz/ not found./] ? jrst errout] + .close tmpch, + movei r3,4(r3) ;Next file + cail r3,(r2) + jrst fini3 + move r1,-4(r3) + skipn 0(r3) + movem r1,0(r3) + move r1,-1(r3) + skipn 3(r3) + movem r1,3(r3) + jrst fini1 +fini3: setzm (r2) ;Mark end of source files + move r1,srctab+0 ;Default listing file + skipn lstblk+0 + movem r1,lstblk+0 + move r1,srctab+3 + skipn lstblk+3 + movem r1,lstblk+3 + move r1,srctab+1 + skipn lstblk+1 + movem r1,lstblk+1 + movsi r1,'LST + skipn lstblk+2 + movem r1,lstblk+2 + MOVE R1,[440700,,LSTBUF] ; Get original output line pointer + MOVEM R1,LINPTR ; Set it + MOVEI R1,LSTBFL ;full count [ECL2] + MOVEM R1,LSTBFC ; set count [ECL2] +;; GJINF ; Get job info (controlling terminal #) +;; MOVE R1,LSTJFN ; Now get listing JFN +;; DVCHR ; Get device characteristics +;; HLRZ R2,R1 ; Get device designator +;; ANDI R2,777 ; Mask off device bits to get type # +;; CAIE R2,12 ; Terminal? +;; JRST .+3 ; No - skip this +;; CAIN R4,(R1) ; Units numbers match? +;; TLO R16,TTYBIT ; Yes - set TTY bit + call lptini + + move r1,lstblk+0 ;Default binary file + skipn binblk+0 + movem r1,binblk + move r1,lstblk+3 + skipn binblk+3 + movem r1,binblk+3 + move r1,lstblk+1 + skipn binblk+1 + movem r1,binblk+1 + movsi r1,'BIN + skipn binblk+2 + movem r1,binblk+2 + TLO R15,P1F ; Set for pass 1 + MOVEi R1,SRCTAB ; Get back first JFN + movem r1,srcipt ;Save position in source list + CALL SFINIT ; Init it and open it + .suset [-2,,[.soption,,[optint,,] ;Enable ^T interrupts + .smsk2,,[1_tyich]]] + syscal ttyset,[%climm,,tyich ? [212020,,202020] ? [202020,,202020]] + .Lose %LsSys + TLNE R16,LSTBIT ; Have a listing file to open? + JRST ALLWEL ; No - skip OPENF + syscal open,[%clbit,,.uao ? %climm,,lstch + lstblk+0 ? lstblk+1 ? lstblk+2 ? lstblk+3] + .Lose %LsFil +ALLWEL: + .rdtime R1, ; GET TIME AT START OF ASSEMBLY. + MOVEM R1,RUNTIM ; SAVE FOR STATISTICS OUTPUT. + .rdatim R1, ;Sixbit time and date + move r4,[440700,,datstr] + rot r2,12. ;Put month first + movei R3,"/ + call datout + move r2,r1 + movei r3,40 + idpb r3,r4 + movei r3,": + call datout + setz r3, + idpb r3,r4 + + CALL ACEXCH ;SAVE EXEC AC'S +ASSEMB: ;ASSEMBLER PROPER + TLO R15,P1F ;SET FOR PASS 1 + MOVE R3,[GENM40 .,M,A,I,N,. + ] + MOVEM R3,PRGTTL ;INIT TITLE + CALL INIPAS ;INITIALIZE PASS ONE + CALL LINE ;GO DO PASS ONE. + CALL SETBIN ;SET BINARY (OBJ OR BIN) + TLZ R15,P1F ;RESET TO PASS 2 + TRO R16,HDRBIT ; FORCE PAGE SKIP AFTER TOC. + ;;RESET INPUT COMMAND STRING + CALL ACEXCH ; Get EXEC's ACs +;; TRZ R16,ENDBIT\FFBIT ; Clear a couple of bits + trz r16,ffbit + MOVEi R1,SRCTAB ; Get first file JFN + movem r1,srcipt + setzm srcjfn + CALL SFINIT ; Init the first file + CALL ACEXCH + + CALL INIPAS + trze r16,errbit ;Somehow this seems to get turned on + .value + CALL LINE ;CALL THE ASSEMBLER (PASS TWO) + + MOVE R0,LSTCTL ; Load listing control flags. + TLNE R16,LSTBIT ;LISTING? + TRNE R0,LSYM ; SYM TAB BIT SET? + CALL SYMTB ; YES - LIST SYMBOL TABLE. + + CALL LSTCR ;SKIP ONE LINE + CALL ACEXCH ;SWAP AC'S +START2: PUSH P,R16 + TRO R16,HDRBIT ; PRINT STATISTICS ON NEW PAGE. + CALL LSTCR ; (THIS ALSO KEEPS TTY CLEAN). + TLO R16,ERRBIT ; SHOW STATS ON GRUBBY TTY TOO. + SETZM LSTCNT ; Insure that summaries will list. + CALL LSTCR ;SKIP A LINE + MOVEI R2,"? ;ASSUME ERROR + SKIPE R11,ERRCNT ;TEST ERRORS, LOAD R11 + CALL LSTOUT + MOVEI R10,[ASCIZ / Errors detected: %/] + CALL LSTMCR + CALL LSTCR + MOVE R10,[440700,,[ASCIZ / */]] + CALL LSTASC + MOVEi R10,jclbuf + CALL LSTASC ;PRINT OUT COMMAND STRING + POP P,R0 + .rdtime R1, + SUB R1,RUNTIM ; Now get difference + MOVE R11,R1 ; Load it into right register + IDIVi R11,30. ; Convert to seconds + MOVEI R10,[ASCIZ / Run-time: % seconds/] + CALL LSTMCR + CALL LSTCR +;; JRST EXIT ; CLOSE OUT +;;EXIT: + .close lstch, + tlnn r16,binbit + call bincls + move r2,srcipt + addi r2,4 + hrroi r1,[asciz/AToo many source files./] + skipe (r2) ; Test if any more files + psout + .logout 1, + +INIPAS: + CALL CODRES ; Reset binary output info. + SETZM CURSUM ; Initial codes segment checksum = 0 + MOVEI R0,DECRDX ;SET DEFAULT GLOBAL RADIX TO DECIMAL + MOVEM R0,GLBRDX + MOVEI R0,10. + MOVEM R0,RADVAL + SETZM LSTCNT ; Reset .list/.nlist level. + HRLZI R0,LDEF ; SET DEFAULT LISTING MODES. + MOVEM R0,LSTCTL + CALL SETLF + + HRLZI R0,ENDEF ; SET DEFAULT .ENABL MODES. + LDB R1,[360600,,srctab+2] ; Check 1st byte of 1st src extension. + CAIN R1,'Z ; Is it "Z"? + TLO R0,Z80FLG ; Yes - Default to Z80 mode. + + TLNE RMODE,P1F ; IS THIS START OF PASS 2? + JRST INEN ; NO -- JUST SET DEFAULTS. + TLNE RMODE,ABSFLG ; YES - COPY ABS/REL MODE FLAG + TLO R0,ABSFLG ; AS PASS 1 LEFT IT. +INEN: MOVEM R0,ENACTL ; STORE ENABL FLAGS. + CALL SETEN ; MERGE WITH SWITCH OVERRIDES. + + TLNE R15,ABSFLG ;ABSOLUTE? + TDZA R5,R5 ; YES, SET PC TO ZERO +;; MOVSI R5,(1B) ; NO, SET TO RELOCATABLE + movsi r5,(1_<35.-suboff>) + MOVEI R0,64. ; INITIAL VALUE FOR NEXT + MOVEM R0,NEXGS ; MACRO-GENERATED LOCAL = 64. + SETZM PAGNUM ; Initialize page number + SETZM SEQ ; SET LINE SEQ # = 0. + SETZM LSBLOC ; LOCAL SYMBOL BLOCK # = 0. + SETZM REPLVL + SETZM REQCNT ; Init require index + SETZB R12,CONLVL ; CLEAR MACRO BLOCK PTR & COND LVL. + HRRM R12,LSTCNT ; CLEAR RH OF LIST LEVEL. + JRST ENDLI ;EXIT THROUGH END OF LINE ROUTINE + +NoJcl: +Help: hrroi r1,[asciz\A:macn80 [[binary file][,list file] =] [srcfile,...] +(where at least one file must be specified). Also recognizes flags: +/L - make a listing file (default when a list file is specified). +/S - do not make a binary file +Filenames default from each other all around. Default binary type is BIN. +Default listing type is LST. Default source type is Z80, but it searches for +other stuff (Z8, M80, M8 and finally >) if there is no Z80.\] + psout + .logout 1, + + STMNT: ;STATEMENT PROCESSOR +;On startup, RLOC (R5) has PC, CONPNT has code buffer pointer + MOVEM RLOC,ILOC ; Record PC @ start of line + MOVE R0,CODPNT ; and CODPNT for use + MOVEM R0,IPNT ; in listing generated code. + SETZM STRSYM ;Presume no symbol at start of line. +STMNT0: CALL GETSYM ;TRY FOR SYMBOL + RETURN ; No symbol: Must be blank line or comment. + CAIN R14,": ;LABEL? + JRST LABEL ; YES + CAIN R14,"= ;ASSIGNMENT? + JRST ASGMT ; YES + CALL MSRCH ;TEST FOR MACRO + CAIA + JRST STMNT1 ;YES + CALL OSRCH ;NO, TRY OP TABLE + JRST STMNT2 ; Not op: Presume label for EQU, etc. + JRST STMNT3 ; Op: Bypass reference recording. + +STMNT1: TLNE RMODE,P1F ; Which pass is this? + JRST STM1A ; Pass 1: Must be macro call. + TLNN R1,MD2SYM ; Pass 2: Defined on this pass? + JRST STMNT2 ; No -- Must be macro definition + ; Yes - Macro call. +STM1A: PUSH P,R1 + TLNE R0,MACBIT ;SPECIAL TEST FOR OPDEFS + MOVSI R1,MAOP ; SET TO MACRO + CALL CRFREF ;CREF IT + POP P,R1 ;RETRIEVE VALUE/TYPE + LDB R2,TYPPNT ;RESTORE TYPE +STMNT3: XCT STMNJT(R2) ;EXECUTE TABLE + +; Found symbol at start of line not followed by ":" or "=", +; and not a macro name or op code. + +; 1. If such a symbol has already been encountered flag +; questionable syntax; the previous symbol will be ignored. +; 2. Save the symbol (in mod40 format) in STRSYM, for later +; processing by EQU or SET directives. +; 3. If the symbol is delimited by any character other than +; blank or tab flag questionable syntax. +; 4. Return to STMNT0 to process next symbol, hopefully an op code. + +STMNT2: SKIPE STRSYM ; Starting symbol already defined? + TRO RERR,ERRQ ; Yes - Note questionable syntax. + MOVEM R0,STRSYM ; Save symbol for later reference. + + MOVE R1,SYMDEL + CAIE R1,SPACE ; Is symbol's delimiter + CAIN R1,TAB ; blank or tab? + JRST STMNT0 ; Yes - Try to parse op code. + TRO RERR,ERRQ ; No -- Mark crummy syntax first. + JRST STMNT0 + +SYMPNT: BLOCK 1 ; Pointer to symbol mnemonic, rad50 fmt +VALPNT: BLOCK 1 ; Pointer to symbol value & attributes +CR1PNT: BLOCK 1 ; Pointer to symbol's 1st cross ref word +CR2PNT: BLOCK 1 ; Pointer to symbol's 2nd cross ref word + +LABEL: ;LABEL PROCESSOR + TLO R16,LBLBIT ; FORCE PC TO LIST IN + TLNN R0,200000 ; IS THIS A LOCAL SYMBOL? + CALL LOCRES ; NO - RESET LOCAL SYMBOL BLOCK + + CALL SSRCH ;SEARCH THE SYMBOL TABLE + JRST LABEL1 ; NOT THERE +LABEL1: TLNN R1,DEFSYM ;PREVIOUSLY DEFINED? + TDO R1,R5 ; NO, SET TO CURRENT PC + MOVE R3,R1 + TDC R3,R5 ;COMPARE WITH PC + TDNN R3,[PCMASK] ;EQUAL ON MEANINGFUL BITS? + JRST LABEL3 ; YES + TLNN R15,P1F ;NO, PASS 1? + TLNE R1,MDFSYM ;NO, MULTIPLY DEFINED ALREADY? + TLOA R1,MDFSYM ; YES, FLAG SYMBOL + TRO R15,ERRP ;NO, PHASE ERROR + CAIA +LABEL3: TLO R1,LBLSYM\DEFSYM ;OK, FLAG AS LABEL + CALL GETNB ; SKIP ":". + CAIE RBYTE,": ; IS NEXT BYTE ANOTHER ":"? + JRST LABEL4 ; NO -- DONE WITH LABEL. + TLO R1,GLBSYM ; YES - FLAG LABEL AS GLOBAL, + CALL GETNB ; SKIP THE SECOND ":". + +LABEL4: CALL INSRT ; Set name & value in symbol table. + TLNN R1,MDFSYM ; Is label multiply defined? + JRST LABEL5 ; No -- Set normal definition entry. + SETZ R0, ; Yes - Don't change cross-ref def. + TROA RERR,ERRM ; & flag multiple definition. + +LABEL5: MOVE R0,SEQ ; Set line number of definition + HRLM R0,@CR1PNT ; in cross ref info. + + TLNN R15,P1F ; Which pass is this? + JRST STMNT ; Pass 2 - Process rest of line. + ; Pass 1 - Check for unresolved + ; forward JRPs. + SKIPG FJLIST ; Is forward JRP list empty? + JRST STMNT ; Yes - Process rest of line. + ; No -- . . . + + + + +; Check for action required to resolve forward JRPs. +; This label could be one addressed by a preceding JRP. + +; First, purge the forward JRP list of entries whose +; instruction end addresses are more than 127 bytes +; ahead of the current location. This commits these +; JRPs to remain as JP's, rather than being translated +; to JR's. + +FJ1P: HRRZ R1,RLOC ; Set r1 to offset of 1st JRP's + SUB R1,FJLIST+2 ; instruction end address from . + TRNN R1,777400 ; Is offset > 127? + JRST FJCHEK ; No -- Check for JRP resolution. + ; Yes - . . . + +; Purge first entry from forward JRP list. + + SOSE R1,FJLIST ; Decrement entry count. + JRST FJ1PD ; > 0: Shuffle list entries. + SETZM CONSYM ; = 0: Clear CONSYM & quit. + JRST STMNT + +FJ1PD: LSH R1,1 ; Convert entry count to index. + MOVE R2,[FJLIST+3,,FJLIST+1] ; Shuffle entire list forward + BLT R2,FJLIST(R1) ; over (deleted) first entry. + + + +; Clean up CONSYM list to delete entries which would only +; be useful for the FJLIST entry just deleted. These entries +; represent labels with addresses less than the instruction +; end address in the new first entry in FJLIST. + +PCS1: SKIPN CONSYM ; Is CONSYM already empty? + JRST FJ1P ; Yes - Check next FJLIST entry. + ; No -- Check 1st CONSYM entry. + HLRZ R0,CONSYM+1 ; Get address of 1st symbol in list. + CAML R0,FJLIST+2 ; Is it below next JRP end address? + JRST FJ1P ; No -- Quit CONSYM cleanup. + ; Yes - . . . + +; Delete first entry in CONSYM list. + + SOS R1,CONSYM ; Decrement list's entry count. + MOVE R2,[CONSYM+2,,CONSYM+1] ; Set up for block transfer. + BLT R2,CONSYM+1(R1) ; Copy entry n+1 over entry n for all + ; entries in list. + JRST PCS1 ; Check new 1st entry in CONSYM. + + + + + +; Check to see if this label definition allows taking +; some appropriate action to resolve conditional address +; assignments for a forward JRP. This processing uses +; the following logic: + +; Case 1: New label matches first entry in FJLIST . . . + +; 1. If label's offset from JRP is less than 128 bytes, +; then decrement the conditional addresses of all +; labels between the JRP and the current address. +; 2. Delete the first FJLIST entry (describing the +; resolved JRP). +; 3. CONSYM cleanup: +; a. If FJLIST is now empty, clear CONSYM and quit; +; b. Else: +; 1. Delete CONSYM entries whose addresses are less +; than the instruction end address in the new +; first entry in FJLIST. +; 2. Repeat resolution processing from the beginning +; (case identification). + + +; Case 2: New label matches entry in FJLIST other than 1st entry . . . + +; 1. If label's offset from JRP is less than 128 bytes, +; then decrement the conditional addresses of all +; labels between the JRP and the current address. +; 2. Delete the FJLIST entry for the resolved JRP. +; 3. Repeat resolution processing from the beginning +; (case identification). + + +; Case 3: New label doesn't match any entry in FJLIST . . . + +; Append an entry to CONSYM for the new label and quit. + + +; In this description "quit" means assemble the rest of the line. +; Resolution processing iterates until it quits in one of two ways: +; - In case 1, the last forward JRP was resolved. +; - In case 3, at least one unresolved forward JRP remains +; but the label being defined is not the destination +; of any forward JRP. + + + + + +; Search FJLIST for JRP's to the label defined on this line +; and identify which of the three cases of resolution processing +; this is. + +FJCHEK: MOVE R0,@SYMPNT ; Get the label in mod40 format. + + CAMN R0,FJLIST+1 ; Does 1st FJLIST entry match label? + JRST FJC1 ; Yes - Case 1. + ; No -- Scan FJLIST. + MOVE R1,FJLIST ; R1 = # of entries to scan. + MOVEI R2,FJLIST+1 ; R2 = address of 1st entry. + +FJCSCN: CAMN R0,0(R2) ; Is JRP operand this label? + JRST FJC2 ; Yes - Case 2. + ADDI R2,2 ; No -- Check next entry. + SOJG R1,FJCSCN + + + +; Case 3: No JRP destination matches this label. + +; The which was just defined has a conditional value, +; pending resolution of at least one previous forward JRP. +; Append an entry to CONSYM for this label. + + MOVE R1,CONSYM ; Get CONSYM's entry count. + CAIL R1,64. ; Is there room for another entry? + 0 ; %%%% temp %%%% - no! + AOS R1,CONSYM ; Yes - Increment entry count. + + MOVEI R0,@VALPNT ; Prepare entry: pointer to symtab + HRL R0,RLOC ; value word in RH, value in LH. + MOVEM R0,CONSYM(R1) ; Store new entry at end of list. + + JRST STMNT ; Process rest of line. + + + + + +; Case 2: R2 points to FJLIST entry for a JRP resolved +; by this label definition. + +FJC2: CALL FADDUP ; Update conditional addresses + ; if JRP will generate JR. + +; Delete the FJLIST entry for the JRP just resolved. + + HRLZI R1,2(R2) ; Set up regs for a block transfer + HRR R1,R2 ; to copy end of list forward + SOS R2,FJLIST ; over the entry being deleted. + LSH R2,1 ; (. . . and decrement entry count) + BLT R1,FJLIST(R2) + + JRST FJCHEK ; Repeat resolution processing + ; in case more than 1 JRP is + ; resolved by this label. + +; Case 1: New label resolves 1st JRP in FJLIST. + +; Start by updating conditional addresses if necessary. + +FJC1: MOVEI R2,FJLIST+1 ; Point to resolved FJLIST entry. + CALL FADDUP ; Update conditional addresses if + ; JRP will become JR. + +; Delete the first (resolved) FJLIST entry. + + SOSE R1,FJLIST ; Decrement FJLIST entry count. + JRST FJC1A ; .. More left: Update lists. + ; .. FJLIST emptied: . . . + +; The entry being deleted was for the last unresolved +; forward JRP. Leave FJLIST clear, clear CONSYM, and +; quit. + + SETZM CONSYM ; Clear conditional symbol list. + JRST STMNT ; Process rest of line. + +; Entry being deleted isn't the only one . . . + +FJC1A: LSH R1,1 ; Set index to locate last entry. + MOVE R2,[FJLIST+3,,FJLIST+1] ; Use block transfer to copy + BLT R2,FJLIST(R1) ; entire end of list over 1st entry. + +; Delete CONSYM entries for symbols which precede the first +; remaining unresolved forward JRP. + +FJC1D: SKIPN CONSYM ; Is CONSYM list already empty? + JRST FJCHEK ; Yes - Iterate again. + ; No -- Check 1st entry. + HLRZ R0,CONSYM+1 ; Get addr from 1st CONSYM entry. + CAML R0,FJLIST+2 ; Is it below 1st unresolved JRP? + JRST FJCHEK ; No -- Iterate again. + ; Yes - Delete this entry. + + SOS R1,CONSYM ; Decrement entry count. + MOVE R2,[CONSYM+2,,CONSYM+1] ; Copy all entries forward + BLT R2,CONSYM+1(R1) ; except the first. + + JRST FJC1D ; Check new 1st entry. + +; Forward JRP list: + +; Location FJLIST contains the number of entries currently in the list; +; Entries begin at FJLIST+1. + +; Entry format: + +; +0 JRP destination symbol in mod40 format +; +1 JRP instruction end address (opcode address + 2) + +FJLIST: BLOCK 65. + +; Conditionally defined symbol list: +; Location CONSYM contains the number of entries currently in the list; +; Entries begin at CONSYM+1. +; Entry format: +; +0 LH: Address currently assigned to symbol +; +0 RH: Address of "value" word in symbol table entry + +CONSYM: BLOCK 65. + +; Subroutine FADDUP: + +; Update address of labels and forward JRP ends +; within the range of a forward JRP being resolved. + +; -- If the current address - 1 is more than 127 bytes beyond +; the JRP end address, pass 2 will generate a JP and no +; address modification is required. +; -- Else pass 2 will generate a JR, and the values of labels +; within this range must be decremented. This includes the +; value of the label just defined and the value of RLOC. + +; At entry to FADDUP R2 points to the FJLIST entry +; for the JRP being resolved. + + + +FADDUP: MOVE R1,RLOC ; Compute .-1-(JRP end addr). + SOJ R1, ; This is the offset which would + SUB R1,1(R2) ; be assembled as a JR operand. + + TRNE R1,777400 ; Is the offset within range for a JR? + RETURN ; No -- Don't modify addresses. + ; Yes - Update label definitions. + + SOJ RLOC, ; Decrement current location. + HRRM RLOC,@VALPNT ; Reset value of label just defined. + + + + +; Update end addresses of forward JRPs which follow +; the one being resolved. + + MOVEI R1,2(R2) ; R1 = ptr to next entry in FJLIST. + MOVE R0,R1 ; Compute (negated) number of + SUBI R0,FJLIST+1 ; entries remaining in FJLIST + LSH R0,-1 ; from this point. + SUB R0,FJLIST + JUMPE R0,FAD2 ; ..JRP being resolved is last in list: + ; Skip JRP end address update. + HRL R1,R0 ; .. Not last: Set up to loop thru + ; remaining entries. + +FAD3: AOJ R1, ; Point to end addr in this entry. + SOS 0(R1) ; Decrement JRP end address. + AOBJN R1,FAD3 ; Repeat until reaching end of list. + + + +; Update addresses of conditionally defined symbols +; which follow the JRP being resolved. + +FAD2: SKIPG R1,CONSYM ; Is CONSYM table empty? + RETURN ; Yes - Nothing more to update. + ; No -- Scan it. + +; Scan CONSYM from back to front, looking for labels +; between the resolved JRP and the current address. + +FAD1: HLRZ R0,CONSYM(R1) ; Get next entry's label address. + CAMGE R0,1(R2) ; Is it above the resolved JRP? + RETURN ; No -- Finished with symbol update. + SOJ R0, ; Yes - Decrement symbol's addr. + HRLM R0,CONSYM(R1) ; Reset label addr in CONSYM entry. + HRRZ R3,CONSYM(R1) ; Get pointer to symtab's value word. + HRRM R0,0(R3) ; Update value in symbol table. + SOJG R1,FAD1 ; Check previous entry. + + RETURN ; Updated entire table - Return. + + +; RESET CURRENT LOCAL SYMBOL BLOCK DUE TO FINDING +; A LABEL DEFINITION OR .CSECT DIRECTIVE, UNLESS +; .ENABL LSB HAS BEEN ISSUED TO PROLONG CURRENT BLOCK. + +LOCRES: TLNE RMODE,LSBFLG ; .ENABL LSB IN EFFECT? + RETURN ; YES - DON'T DO ANYTHING. +Locras: AOS LSBLOC ; NO -- INCREMENT BLOCK NUMBER + MOVEI R1,64. ; RESET VALUE OF NEXT LOCAL SYMBOL + MOVEM R1,NEXGS ; TO GENERATE IN A MACRO CALL. + RETURN ; RETURN + +ASGMT: ;ASSIGNMENT PROCESSOR + PUSH P,R0 ; SAVE SYMBOL ON STACK. + CALL GETNB ; GET CHARACTER AFTER "=". + CAIE RBYTE,"= ; IS NEXT CHAR ANOTHER "="? + JRST ASGMT3 ; NO -- SYMBOL'S LOCAL. + TLO R16,GEQBIT ; YES - SYMBOL WILL BE GLOBAL. + CALL GETNB ; SKIP 2ND "=". +ASGMT3: SKIPE STRSYM ; Is something to be equated or set? + TRO RERR,ERRQ ; Yes - Can't do 2 in 1 line. + POP P,STRSYM ; Set STRSYM to equatee symbol. + JRST SET80 ; Skip check for Z80 SET op code. + +SET80: TROA R16,SETBIT ; Indicate SET in progress. +EQU: TRZ R16,SETBIT ; Indicate EQU in progress. + SKIPE STRSYM ; Is there a symbol to set? + JRST SET2 ; Yes - Proceed. +SET1: TRO RERR,ERRQ ; Flag bad syntax. + RETURN ; Quit without doing anything. + +SET2: CALL EXPR ; Get value to assign to symbol. + JRST SET1 ; None => bad syntax. +SETENT: PUSH P,R1 ; Save value while muddling thru symtab + + MOVE R0,STRSYM ; Retrieve symbol to be defined. + SETZM STRSYM ; Show it's been processed. + CALL SSRCH ; Look it up. + JRST SET3 ; New symbol's always legal. + + TLNN R1,DEFSYM ; Name's known; Is it defined? + JRST SET3 ; No -- Perfectly legal. +; Symbol is already defined. This is legal only if +; the operation in progress is SET (not EQU) and the +; existing definition was also performed by a SET. + + TLNE R1,SETSYM ; Is existing definition a SET symbol + TRNN R16,SETBIT ; and current operation another SET? + JRST SETM. ; No -- Multiple definition illegal. + ; Yes - Multiple definition allowed. + +; Note that the following code retains any attribute bits +; already set for the SET symbol. + +SET3: POP P,R3 ; Retrieve expression value. + HRR R1,R3 ; Set symbol value = expr value. + HRROM R1,PF1 ; Set for alternate binary list format. + TLZE R16,GEQBIT ; Is this a global set (==)? + TLO R1,GLBSYM ; Yes - Set "global" attribute. + TRNE R16,SETBIT ; Is this a SET rather than EQU? + TLO R1,SETSYM ; Yes - Set "set" attribute. + TLO R1,DEFSYM ; In any case mark it as "defined". + + CALL INSRT ; Insert or reset symbol table entry. + MOVE R0,SEQ ; Get current line number. + HRLM R0,@CR1PNT ; Store as symbol's definition line. + RETURN + + +; Multiple definition processing . . . + +; Pass 1: + +; Multiple definition attempted for a symbol defined +; by EQU or by a label: Flag it and process the EQU +; or SET anyway. + +; Pass 2: + +; If previous definition is only from pass 1, the symbol's +; multiple definition flag is 0: Just check to be sure +; it's value is the same & issue a phase error flag if it +; isnt. If MDFSYM was set, flag the multiple definition +; for the benefit of listing output. In all cases finish +; by processing the EQU or SET, no matter how illegal it is. + +SETM.: TLNN R15,P1F ; Which pass is this? + JRST SETM2 ; Pass 2 + ; Pass 1 +SETM1: TRO RERR,ERRM ; Set multiple definition error flag. + TLO R1,MDFSYM ; Set same attribute for symbol. + JRST SET3 ; Proceed as if it's ok. + +SETM2: ; Pass 2 checks . . . + TLNE R1,MDFSYM ; Did pass 1 report it multiply defined? + JRST SETM1 ; Yes - Flag this line & proceed. + TDC R1,0(P) ; No -- . . . + TRNE R1,-1 ; Pass 1 value = pass 2 value? + TRO RERR,ERRP ; No -- Flag phase error. + JRST SET3 ; Set the symbol's value. + +PROPC: ;PROCESS OP CODES + +; At entry register 1 contains the op table entry +; for this machine instruction. + +; 1. Set INSLEN to length of instruction (in bytes) - 1; +; this indicates how many bytes (0, 1, or 2) of immediate +; data must be assembled. +; 2. Set OPCODE to the instruction's op skeleton. +; 3. Select a register operand parser to match the instruction +; type and call it. This routine ors register fields into +; OPCODE. +; 4. Copy OPCODE into CODBUF, the object output buffer. +; 5. If INSLEN > 0 assemble INSLEN bytes (1 or 2) of immediate +; data into CODBUF. + + + LDB R2,SUBPNT ; Retrieve instruction type. + LDB R0,LENPNT ; Get instruction length code. + MOVEM R0,INSLEN ; INSLEN = length code. + MOVEM R1,OPCODE ; OPCODE = skeleton for 1st byte. + +; Only the low order 8 bits of OPCODE will be used for +; code generation. Extraneous fields stored by the preceding +; instruction will be ignored. + + XCT OPFORT(R2) ; Parse register operand(s). + MOVE R1,OPCODE ; Copy OPCODE into CODBUF. + IDPB R1,CODPNT + + SKIPN R1,INSLEN ; Is immediate data required? + JRST OPEX ; No -- Update PC & exit. + ; Yes - Assemble an expression. + SOJG R1,LONG ; Check operand length. + + + +; Assemble 1 byte of immediate data. + + CALL EXPR ; Evaluate operand expression. + TRO RERR,ERRA ; No valid expression => error. + HRRZ R0,R1 ; Test for negative expression + TRZ R0,600377 ; before testing for excessive value. + CAIN R0,177400 ; Was expression negative? + JRST PSNT ; Yes - Don't diagnose byte oflo. + TRZE R1,177400 ; Truncate expr value to 8 bits. + TRO RERR,ERRT ; Truncated 1-bits: Flag error. +PSNT: IDPB R1,CODPNT ; Store expr value in single byte. + ADDI RLOC,2 ; Update PC. + RETURN ; Done: Exit. + ; Assemble 2 bytes of immediate data. + +LONG: CALL EXPR ; Evaluate operand expression. + TRO RERR,ERRA ; No valid expression => error. + IDPB R1,CODPNT ; Store low order byte first + LSH R1,-8 ; in CODBUF, + IDPB R1,CODPNT ; then high order byte. + ADDI RLOC,3 ; Update PC. + RETURN ; Done: Exit. + + + +OPEX: AOJ RLOC, ; Update PC for 1-byte instruction. + RETURN ; Exit. + + SUBTTL 8080 instruction assembly + +; Instruction format 1: + +; --------------------------------- +; ! ! ! +; ! op code ! regm ! +; ! ! ! +; --------------------------------- +; : 7 : 6 : 5 : 4 : 3 : 2 : 1 : 0 : + + +OPFOR1: CALL REGM ; Evaluate register expression. + TRO RERR,ERRA ; None => operand error. + IORM R1,OPCODE ; Or reg value into skeleton. + RETURN + +; Direct return is acceptable for format 1 because these +; instructions have no immediate data; the source register +; is the last field to be parsed. + + +; Instruction format 2: + +; --------------------------------- +; ! ! ! ! +; ! op ! regm ! op ! +; ! ! ! ! +; --------------------------------- +; : 7 : 6 : 5 : 4 : 3 : 2 : 1 : 0 : + + +OPFOR2: CALL REGM ; Evaluate register expression. + TRO RERR,ERRA ; None => operand error. + + LSH R1,3 ; Shift reg value for destination field +POP4E: IORM R1,OPCODE ; Or into instruction skeleton. + +SKIPCO: SKIPN INSLEN ; Is additional data required? + RETURN ; No -- Return. + ; Yes - Skip reg expr's delimiter. + +; Skip delimiter following a destination register specification. + +SKIPCM: CALL SETCHR ; %%%% + CAIE RBYTE,", ; Is delimiter a comma? + TROA RERR,ERRQ ; No -- Flag questionable syntax. + JRST GETCHR ; Yes - Skip it & return. + RETURN ; -- Return after syntax error. + +; Instruction format 3: + +; --------------------------------- +; ! ! ! ! +; ! op ! regm ! regm ! +; ! ! ! ! +; --------------------------------- +; : 7 : 6 : 5 : 4 : 3 : 2 : 1 : 0 : + + +OPFOR3: CALL REGM ; Evaluate first register expression. + TRO RERR,ERRA ; None => operand error. + LSH R1,3 ; Align value with destination field. + IORM R1,OPCODE ; Or into instruction skeleton. + CALL SKIPCM ; Skip "," following destination reg. + + CALL REGM ; Evaluate second register expression. + TRO RERR,ERRA ; None => operand error. + IORM R1,OPCODE ; Or into source field in skeleton. + RETURN + + + +; Instruction format 4: + +; --------------------------------- +; ! ! ! ! +; ! op ! rp ! op code ! +; ! ! ! ! +; --------------------------------- +; : 7 : 6 : 5 : 4 : 3 : 2 : 1 : 0 : + + +OPFOR4: CALL RP ; Evaluate reg pair expression. + TRO RERR,ERRA ; None => operand error. +POP4: LSH R1,4 ; Align reg value with rp field. + JRST POP4E ; Finish as in format 2. + +; Instruction format 5: +; Same as format 4 except for parsing the rp (register pair) field -- +; "PSW", rather than "SP", maps into value 3. + +OPFOR5: CALL RP5 ; Evaluate variant of rp expression. + TRO RERR,ERRA ; None => operand error. + JRST POP4 ; Finish as in format 2. + + + +; Instruction format 6: +; Same as format 2 except that the "destination" field is +; set to an arbitrary 3-bit expression value, rather than +; to a register address. + +; The only instruction using format 6 is RST. In order to +; allow assembling both 8080 and Z80 RST syntax, the expression +; value (n from "RST n") is compiled as follows: + +; n < 8: assembled value = n +; n > 7: assembled value = n/8; operand error if +; n/8 > 7 or n mod 8 <> 0. + +OPFOR6: CALL EXPR ; Evaluate an expression. + TRO RERR,ERRA ; None => operand error. + TRNN R1,777770 ; Is expression value > 7? + JRST OPF6C ; No -- Compile 8080 RST syntax. + ; Yes - Compile Z80 RST syntax. + TRNE R1,7 ; Is expression mod 8 = 0? + TRO RERR,ERRA ; No -- Report operand error. + LSH R1,-3 ; Divide expression value by 8. + TRZE R1,777770 ; Is resulting value still too large? + TRO RERR,ERRA ; Yes - Report operand error. + +OPF6C: LSH R1,3 ; Align value with "destination" field. + IORM R1,OPCODE ; Or into op skeleton. + RETURN + + + +; Instruction format 7: +; Same as format 4 except that only two register pairs +; (B & D) may be specified. + +OPFOR7: CALL RP7 ; Evaluate variant of rp expr. + TRO RERR,ERRA ; None => operand error. + JRST POP4 ; Finish as in format 4. + + SUBTTL Z80 Instruction assembly + +; First parse the instruction's operands; the op code can't +; be identified without knowing the operand type! + +; Operand type & value codes are . . . + +; Type code Value +; --------- ----- + +; [null] 0 0 +; register: 1 +; B 0 +; C 1 +; D 2 +; E 3 +; H 4 +; L 5 +; A 7 +; register pair: 2 +; BC 0 +; DE 1 +; HL 2 +; SP 3 +; AF 4 +; AF' 5 +; special registers: 3 +; I 0 +; IX 1 +; IY 2 +; R 3 +; Indirect: 4 +; (HL) 0 +; (DE) 1 +; (BC) 2 +; (SP) 3 +; (IX) 4 +; (IY) 5 +; (C) 6 +; (IX+d) 5 d +; (IY+d) 6 d +; expr 7 expr +; (expr) 8 expr + + +; At entry to Z80PRS R1's low order half contains a pointer +; to the parse table for the given Z80 op code. +OP1: BLOCK 1 ; Encoded first operand for Z80 instr. +OP2: BLOCK 1 ; Encoded 2nd operand for Z80 instr. + +Z80PRS: + PUSH P,R1 ; Save Z80 op table pointer. + SETZM OP1 ; Initialize OP1 & OP2 to represent + SETZM OP2 ; null arguments. + + CALL SETNB ; Check next byte. + CAIE R4,SCLE ; Is it an end of line char or ";"? + CAIN RBYTE,"; + JRST Z80LUP ; Yes - Leave both operands null. + CAIN RBYTE,", ; Is it ","? + JRST Z80OP2 ; Yes - Leave 1st operand null. + + CALL Z80OP ; Parse one operand. + MOVEM R1,OP1 ; Store its encoded value. + CALL SETNB ; Check next byte. + +Z80OP2: CAIN RBYTE,", ; Is 1st operand followed by ","? + CALL GETNB ; Yes - Skip it. + + CAIE R4,SCLE ; Is next byte an end of line character + CAIN RBYTE,"; ; or ";"? + JRST Z80LUP ; Yes - Leave 2nd operand null. + + CALL Z80OP ; Encode the 2nd operand. + MOVEM R1,OP2 ; Store it. + + + +; Encoded values have been set for both operands; +; Look up the operand types in the op code's parse table +; to identify the instruction to assemble. + +Z80LUP: POP P,R2 ; Retrieve op parse table address. + +Z80LSR: HLRZ R1,0(R2) ; Get 1st op type from table, + HLRZ R0,OP1 ; get actual 1st operand type. + CAME R0,R1 ; Does 1st operand type match? + JRST Z80LNX ; No -- Skip this table entry. + ; Yes - Check for suitable value. + HRRZ R1,0(R2) ; Check required operand value. + TRNE R1,400000 ; Is any operand value satisfactory? + JRST O1OK ; Yes - 1st operand suits tbl entry. + HRRZ R0,OP1 ; No -- Check for exact value match. + CAME R0,R1 ; Does value match exactly? + JRST Z80LNX ; No -- Skip this table entry. + ; Yes - 1st operand matches. + +; First operand matches current table entry: +; Check second operand. + +O1OK: HLRZ R1,1(R2) ; Get required 2nd op type from table, + HLRZ R0,OP2 ; get actual 2nd operand type. + CAME R0,R1 ; Does 2nd operand type match? + JRST Z80LNX ; No -- Skip this table entry. + ; Yes - Check for suitable value. + HRRZ R1,1(R2) ; Check required operand value. + TRNE R1,400000 ; Is any value satisfactory? + JRST Z80OF ; Yes - Instr matches this entry. + HRRZ R0,OP2 ; No -- Check for exact value match. + CAMN R0,R1 ; Does value match exactly? + JRST Z80OF ; Yes - Instr matches this entry. + ; No -- Skip this entry. + +; Skip to next entry in Z80 instruction parse table. + +Z80LNX: ADDI R2,4 ; Point to next entry. + SKIPE 0(R2) ; Is this end-of-table marker? + JRST Z80LSR ; No -- Check next entry. + ; Yes - Illegal operand(s) for + ; this op code! + TRO RERR,ERRA ; Set A flag & don't assemble anything. + RETURN + + + +; Found entry in Z80 instruction parse table to match +; current input line; set up to assemble the instruction. + +Z80OF: MOVE R1,3(R2) ; Set OPCODE to op skeleton + MOVEM R1,OPCODE ; (up to 4 8-bit bytes). + MOVS R1,2(R2) ; Fetch instruction type code. + ; [LH = operand length code] + PUSH P,R1 ; Save format & length code for + ; common exit routines. + + XCT Z80JT(R1) ; Assemble according to format + +Z80JT: JRST ZFOR0 ; Format 0 + JRST ZFOR1 ; Format 1 + JRST ZFOR2 ; . + JRST ZFOR3 ; . + JRST ZFOR4 ; . + JRST ZFOR5 + JRST ZFOR6 + JRST ZFOR7 + JRST ZFOR8 + JRST ZFOR9 + JRST ZFOR10 + JRST ZFOR11 + JRST ZFOR12 + JRST ZFOR13 + JRST ZFOR14 + JRST ZFOR15 + +; Parse a single operand for a Z80 instruction. + +Z80OP: CAIN RBYTE,"( ; Does operand start with "("? + JRST ZIN ; Yes - Probably indirect register. + ; No -- . . . + CALL GETSYM ; Try to collect a symbol. + JRST ZEXPR ; No symbol: Assume an expression. + + MOVE R2,[-RSSIZE,,RSTAB] ; Prepare to scan table of + ; reserved (register) symbols. + +RSSER: CAMN R0,0(R2) ; Does symbol match this table entry? + JRST RSGOT ; Yes - Found it. + AOJ R2, ; No -- Skip to next table entry. + AOBJN R2,RSSER + + +; Symbol wasn't in table: Backtrack to its beginning +; and treat it as an expression. + + MOVE RBPTR,SYMBEG ; Point to start of symbol again. +ZEXPR: CALL EXPR ; Evaluate the expression. + TRO RERR,ERRA ; .. Flag error if no expr. + HRLI R1,7 ; Set operand type = 7 for expr, + RETURN ; return type & expr value. + +; Found symbol in table: Return its value. + +RSGOT: MOVE R1,1(R2) + CAME R1,[2,,4] ; Is this "AF"? + RETURN ; No -- Return this value. + CAIE RBYTE,"' ; Yes - Check for "AF'". + RETURN ; ... Just AF + CALL GETNB ; ... AF' -- Skip "'". + MOVE R1,[2,,5] ; Indicate reg pair 5 instead of 4. + RETURN + + + +; Operand starts with "(": Look for reserved register symbols +; which may be parenthesized. + +ZIN: CALL GETNB ; Skip "(". + CALL GETSYM ; Collect a symbol. + JRST ZIEXPR ; No symbol: Must be "(expr)". + + MOVE R2,[-RISIZE,,RITAB] ; Prepare to scan table of register + ; names which may be prefixed by "(". + +RISER: CAMN R0,0(R2) ; Does symbol match this table entry? + JRST RIGOT ; Yes - Look no farther. + AOJ R2, ; No -- Scan on. + AOBJN R2,RISER + +; "(" isn't followed by a suitable register name: +; Assume operand is "(expr)". + + MOVE RBPTR,SYMBEG ; Backtrack to start of symbol. +ZIEXPR: CALL EXPR ; Evaluate expression. + TRO RERR,ERRA ; Flag an error if no valid expr found. + HRLI R1,8 ; Set operand type = 8 for "(expr)". + JRST IRET1 ; Skip ")" and return. + + + +; Got a register name in indirect or indexed context, +; such as "(HL)" or "(IX+d)". + +RIGOT: MOVE R1,1(R2) ; Pick up type & value code. + CAME R1,[4,,4] ; Is operand "(IX" or "(IY" so far? + CAMN R1,[4,,5] + JRST RINCK ; Yes - Check for "+d)". + +IRET1: CALL SETNB ; Check terminator byte: +IRET2: CAIN RBYTE,") ; It should be ")". + JRST GETNB ; Ok -- Skip ")" & return. + TRO RERR,ERRA ; Bad - Flag error & return. + RETURN + + + +; Decide whether operand is of form "(IX)" or "(IX+d)". + +RINCK: CAIE RBYTE,"+ ; Is byte after reg name "+"? + JRST IRET2 ; No -- Must be "(IX)" or "(IY)". + ; Yes - Must be indexed form. + AOJ R1, ; New operand type = old value + 1 + HRLZ R1,R1 ; to indicate (IX+d) or (IY+d). + PUSH P,R1 ; Save new operand type. + CALL EXPR ; Evaluate "+d". + TRO RERR,ERRA ; Flag operand error if d invalid. + POP P,R2 ; Retrieve type code. + HLL R1,R2 ; Return type code & value of d. + JRST IRET1 ; Skip ")" and return. + +; Common finish points for assembling Z80 instructions: + +ZFLONG: MOVE 2,[241000,,OPCODE] ; Long instruction + MOVEI R0,2 ; Set basic instruction length. + JRST ZFMEM +ZFSHOR: MOVE 2,[341000,,OPCODE] ; Short instruction + MOVEI R0,1 ; Set basic instruction length. + + + +; Set memory operands (if any) in the op skeleton. + +ZFMEM: POP P,R1 ; Retrieve format & mem op code. + HLRZ R1,R1 ; R1 = memory operand code. + ADD R0,MEMOPL(R1) ; Add mem op length to instr. length. + MOVEM R0,INSLEN + XCT GENMEM(R1) ; Select action to suit mem op code: + +MEMOPL: 0 ; Memory operand length + 1 ; for each operand code + 1 + 2 + 2 + 2 + +GENMEM: JRST ZFIN ; 0 -- No memory operands + JRST GM011 ; 1 -- Op1 is a 1-byte operand + JRST GM021 ; 2 -- Op2 is a 1-byte operand + JRST GM012 ; 3 -- Op1 is a 2-byte operand + JRST GM022 ; 4 -- Op2 is a 2-byte operand + JRST GM2OP ; 5 -- Op1 & op2 are both 1-byte ops + + + +GM011: MOVE R1,OP1 ; Assemble op1 as a 1-byte operand. + JRST GM000 + +GM021: MOVE R1,OP2 ; Assemble op2 as a 1-byte operand. +GM000: HRRZ R0,R1 ; Check for negative expression + TRZ R0,600377 ; before testing for truncation error. + CAIN R0,177400 ; Was expression negative? + JRST GMNOTE ; Yes - No truncation error. + TRNE R1,177400 ; Is op value more than 8 bits-worth? + TRO RERR,ERRT ; Yes - Flag truncation error. +GMNOTE: IDPB R1,R2 + JRST ZFIN + +GM012: MOVE R1,OP1 ; Assemble op1 as a 2-byte operand. + JRST GMOL + +GM022: MOVE R1,OP2 ; Assemble op2 as a 2-byte operand. + +GMOL: IDPB R1,R2 ; Assemble a 2-byte operand. + LSH R1,-8 + IDPB R1,R2 + JRST ZFIN + +GM2OP: MOVE R1,OP1 ; Assemble both op1 & op2 + IDPB R1,R2 ; as 1-byte operands. + MOVE R1,OP2 + IDPB R1,R2 + +ZFIN: MOVE 2,[441000,,OPCODE] ; Set pointer to 1st skeleton byte. + +ZFINL: ILDB R1,R2 ; Get next byte from filled in skeleton + IDPB R1,CODPNT ; Output it. + AOJ RLOC, ; Increment location counter. + SOSLE INSLEN ; Decrement byte count. + JRST ZFINL ; Repeat until entire instr's out. + + + RETURN + +ZFOR0= ZFSHOR ; Z80 format 0: Nothing more than + ; memory operands, at most. + +ZFOR1: MOVE R2,OP2 ; Z80 format 1: + TLNN R2,-1 ; Choose rightmost operand + MOVE R2,OP1 ; as source register. + + LDB R0,[341000,,OPCODE] + IOR R0,R2 ; Or source reg into op code byte. + DPB R0,[341000,,OPCODE] + JRST ZFSHOR + +ZFOR2: HRRZ R2,OP1 ; Z80 format 2: + LSH R2,3 ; First operand is destination register + + LDB R0,[341000,,OPCODE] + IOR R0,R2 ; Or destination reg into op code. + DPB R0,[341000,,OPCODE] + JRST ZFSHOR + +ZFOR3: HRRZ R1,OP1 ; Z80 format 3: + LSH R1,3 ; First operand is destination reg, + IOR R1,OP2 ; 2nd operand is source register. + + LDB R0,[341000,,OPCODE] + IOR R0,R1 ; Or source & destination with op code. + DPB R0,[341000,,OPCODE] + JRST ZFSHOR + +ZFOR4: HRRZ R2,OP1 ; Z80 format 4: +ZF6A: CAIGE R2,4 ; First operand is register pair + JRST ZF4A ; other than AF or AF'. + TRO RERR,ERRA ; AF or AF' was specified: Flag error + MOVEI R2,0 ; & assemble 0 as reg value. + +ZF4A: LSH R2,4 ; Align with rp field. + LDB R0,[341000,,OPCODE] + IOR R0,R2 ; Or reg pair into op code. + DPB R0,[341000,,OPCODE] + JRST ZFSHOR + +ZFOR5: HRRZ R2,OP1 ; Z80 format 5: + CAIG R2,2 ; First operand is register pair + JRST ZF5A ; other than SP or AF'. + CAIE R2,4 ; Reg pair is SP, AF, or AF'; is it AF? + JRST ZF5B ; No -- Illegal. + MOVEI R2,3 ; Yes - Map AF value (4) to proper + JRST ZF5A ; object code value (3). + +ZF5B: MOVEI R2,0 ; SP or AF' was specified: Assemble 0 + TRO RERR,ERRA ; and flag an error. + JRST ZF5A + +ZF5A= ZF4A ; Same object format as format 4. + +ZFOR6: HRRZ R2,OP2 ; Z80 format 5: + JRST ZF6A ; Same as format 4, but register + ; is identified by 2nd operand instead + ; of first. + +ZFOR7: 0 ; Z80 Format 7: Reserved + +ZFOR8= ZFLONG ; Z80 format 8: + ; Nothing but memory operands + +ZFOR9: MOVE R1,OP2 ; Z80 format 9: + TLNN R1,-1 ; Pick rightmost operand + MOVE R1,OP1 ; as source register. + +ZF9A: LDB R0,[241000,,OPCODE] + IOR R0,R1 ; Or register value into op code. + DPB R0,[241000,,OPCODE] + JRST ZFLONG + +ZFOR10: HLRZ R1,OP1 ; Z80 format 10: + SOJN R1,ZF10A ; .. Be sure op1 is a register. + HRRZ R1,OP1 ; Normal case: First operand + LSH R1,3 ; is destination register. + JRST ZF9A + +ZF10A: HRRZ R1,OP2 ; Abnormal case [OUT (C),r]: + LSH R1,3 ; Second operand is source register + JRST ZF9A ; in destination register field. + +ZFOR11: HRRZ R2,OP1 ; Z80 format 11: +ZF12A: CAIG R2,3 ; First operand is register pair + JRST ZF11A ; other than AF or AF'. + MOVEI R2,0 ; AF or AF': Assemble 0 and + TRO RERR,ERRA ; flag an error. + +ZF11A: LSH R2,4 ; Align reg pair value with obj field. + LDB R0,[241000,,OPCODE] + IOR R0,R2 ; Or rp value into 2nd byte of instr. + DPB R0,[241000,,OPCODE] + JRST ZFLONG ; Assemble memory operands, if any. + +ZFOR12: HRRZ R2,OP2 ; Z80 format 12: + JRST ZF12A ; Same as format 11, but with + ; register pair defined by second + ; operand instead of first. + +ZFOR13: POP P,R1 ; Z80 format 13: + MOVEI R1,4 ; Discard stacked length code, + MOVEM R1,INSLEN ; force instruction length to 4 bytes. + + MOVE R2,[241000,,OPCODE] ; Set pointer for 1-byte operand. + JRST GM011 ; Store op1 as 1-byte operand & + ; finish up. + +ZFOR14: HRRZ R1,OP1 ; Z80 format 14: + CAILE R1,7 ; First operand is bit #; Is it < 8? + TRO RERR,ERRT ; No -- Flag truncation error. + TRZ R1,777770 ; Insure bit # is between 0 & 7. + + LDB R0,[241000,,OPCODE] ; Get 2nd opcode byte. + LSH R1,3 ; Align bit # with "b" field. + IOR R0,R1 ; Or bit number into op code. + + MOVE R1,OP2 ; Get 2nd ("m") operand. + CAMN R1,[4,,0] ; Is this "(HL)"? + MOVEI R1,6 ; Yes - Supply correct operand value + + TLZ R1,777777 ; Insure operand type is cleared. + IOR R0,R1 ; Or operand address into op code. + DPB R0,[241000,,OPCODE] ; Store completed op code byte. + JRST ZFLONG ; Finish up. + +ZFOR15: POP P,R1 ; Z80 format 15: + MOVEI R1,4 ; Discard table's length code, + MOVEM R1,INSLEN ; force instruction length to 4 bytes. + + HRRZ R1,OP1 ; Get first operand (bit #). + CAILE R1,7 ; Is bit # < 8? + TRO RERR,ERRT ; No -- Flag truncation error. + TRZ R1,777770 ; Insure bit # is in valid range. + + LDB R0,[041000,,OPCODE] ; Get last byte of opcode. + LSH R1,3 ; Align bit # with "b" field. + IOR R0,R1 ; Or bit number into opcode. + DPB R0,[041000,,OPCODE] ; Store updated opcode byte. + + MOVE R2,[241000,,OPCODE] ; Set pointer & store "d" from + JRST GM021 ; "(IX+d)" or "(IY+d)". + + SUBTTL Z80 jump/call/return instruction assembly + +Z80JP: + SETZM OPCODE ; Initialize op skeleton to 0. + XCT Z80CTL(R1) ; Choose processing to suit op code. + +Z80CTL: JRST ZJP ; Subtype 0: JP + JRST ZJR ; Subtype 1: JR + JRST ZJRP ; Subtype 2: JRP + JRST ZDJNZ ; Subtype 3: DJNZ + JRST ZCALL ; Subtype 4: CALL + JRST ZRET ; Subtype 5: RET + + + + + + +; JP: May be . . . + +; JP nn +; JP cc,nn +; JP (HL) +; JP (IX) +; JP (IY) + + + +ZJP: TLNN R15,Z80FLG ; Assembling for a Z80? + JRST JUMPOS ; No -- 8080 jump if positive + ; Yes - Z80 jump of some sort + CALL SETNB ; Check first operand byte. + CAIN RBYTE,"( ; Is operand in register indirect mode? + JRST JPAREG ; Yes - Look for specific operands. + MOVEI R0,3 ; No -- Preset instruction length + MOVEM R0,INSLEN ; for a 3-byte instruction. + + CALL ZJCOND ; Look for a jump condition code. + JRST ZJPNC ; No condition: Assemble JP nn. + +; Assemble JP cc,nn. + + IORI R0,302 ; Or op code skeleton with cond code. + DPB R0,[341000,,OPCODE] ; Store op code byte. + CALL GETNB ; Skip "," after condition code. + JRST ZJPNN ; Assemble jump address. + +; Assemble JP nn. + +ZJPNC: MOVEI R0,303 ; Set op code for unconditional jump. + DPB R0,[341000,,OPCODE] ; Store it. + +; Assemble "nn" of either "JP nn" or "JP cc,nn". + +ZJPNN: CALL EXPR ; Evaluate expression as jump address. + TRO RERR,ERRA ; .. No expr: Flag error & use 0. + DPB R1,[241000,,OPCODE] ; Store expression value + LSH R1,-8 ; in opcode skeleton. + DPB R1,[141000,,OPCODE] + JRST ZFIN ; Output the instruction. + + +; JP with Z80 mode off: Assemble as 8080 JP (Z80 JP p,). + +JUMPOS: MOVEI R0,362 ; Set opcode for jump if positive. + DPB R0,[341000,,OPCODE] + MOVEI R0,3 ; Set instruction length to 3 bytes. + MOVEM R0,INSLEN + JRST ZJPNN ; Assemble jump's destination address. + + + + + +; Register indirect addressing: +; "JP (HL)", "JP (IX)", or "JP (IY)". + +JPAREG: CALL Z80OP ; Parse register indirect expression. + CAMN R1,[4,,0] ; Is it "(HL)"? + JRST JPAHL + CAMN R1,[4,,4] ; Is it "(IX)"? + JRST JPAIX + CAMN R1,[4,,5] ; Is it "(IY)"? + JRST JPAIY + +; Illegal register indirect operand: +; Assemble 3 bytes of 0 to allow lots of patching. + + MOVEI R0,3 ; Set instruction length + MOVEM R0,INSLEN ; to 3 bytes. + JRST ZFIN ; Output 0's. + +; "JP (HL)" . . . + +JPAHL: MOVEI R0,351 ; Set opcode (equivalent to PCHL). + DPB R0,[341000,,OPCODE] + MOVEI R0,1 ; Set instruction length to 1 byte. + MOVEM R0,INSLEN + JRST ZFIN ; Output the instruction. + +; "JP (IX)" . . . + +JPAIX: MOVE R0,[.BYTE 8 ? 335 ? 351 ? .BYTE ? ] ; Load op code. + JRST JPAIXY ; Output it. + +; "JP (IY)" . . . + +JPAIY: MOVE R0,[.BYTE 8 ? 375 ? 351 ? .BYTE ? ] ; Load op code. + +; Operand is either (IX) or (IY) . . . + +JPAIXY: MOVEM R0,OPCODE ; Store opcode. + MOVEI R0,2 ; Set instruction length to 2 bytes. + MOVEM R0,INSLEN + JRST ZFIN ; Output the instruction. + +; Subroutine ZJCOND: Parse a Z80 jump condition +; Return to 0(P) indicates no valid jump condition was found; +; Return to 1(P) indicates a valid condition was found, and +; R0 contains the matching condition code bits shifted +; into alignment with the cc field in JP, CALL, and RET +; instructions. + +; ZRCOND is an alternate entry to ZJCOND, and is used by +; RET parsing. ZJCOND requires that the condition code +; be followed by a comma in order to be recognized as a cc, +; rather than a jump address symbol, whereas ZRCOND doesn't +; make this check. + +ZRCOND: + CALL GETSYM ; Try to get a symbol. + RETURN ; .. No symbol => no return condition + JRST ZJRCND ; Search cc table for this symbol. + + +ZJCOND: + CALL GETSYM ; Try to get a symbol. + RETURN ; .. No symbol => no jump condition. + CAIE RBYTE,", ; Was symbol followed by ","? + JRST SNOTJC ; No -- Backtrack & return false. + ; Yes - Search table of conditions. + +ZJRCND: MOVE R1,[-8,,ZJCTAB] ; Prepare to scan jump cond table. + +ZJCSER: CAMN R0,0(R1) ; Does symbol match this condition? + JRST GOTJC ; Yes - Found jump condition. + AOBJN R1,ZJCSER ; No -- Scan on. + + + +; Symbol didn't match any valid jump condition: +; Backtrack over the symbol and return to 0(P). + +SNOTJC: MOVE RBPTR,SYMBEG ; Set source byte pointer back to + CALL SETNB ; start of symbol, set to its 1st char, + RETURN ; and return to caller. + + + +; Found jump condition in table: Set R0 to cc value +; (offset from start of table) shifted to align with +; normal cc fields. + +GOTJC: HLRZ R0,R1 ; R0 = table offset - 8. + ADDI R0,8 ; R0 = table offset = cc value. + LSH R0,3 ; Align to or into cc field. + HRRZ R0,R0 ; Clear stray bit in left half of R0. + JRST CPOPJ1 ; Return to 1(P). + +; JR: Jump relative + +; This can be either "JR e" or "JR cc,e", where the only +; legal values for cc in this instruction are NZ, Z, NC, and C. + + +ZJR: MOVEI R0,2 ; Set instruction length + MOVEM R0,INSLEN ; to 2 bytes. + + CALL ZJCOND ; Look for a jump condition field. + JRST ZJRNC ; .. No cond: Unconditional JR. + +; Conditional JR: Check for valid condition for this instruction. + + CAIG R0,30 ; Is condition code > 3? + JRST ZJRC ; No -- It's valid. + TRO RERR,ERRA ; Yes - Report operand error. + CALL GETNB ; Skip "," after cc. + JRST ZJRNC ; Assemble as unconditional JR. + +ZJRC: IORI R0,040 ; Or op code with condition code. + DPB R0,[341000,,OPCODE] ; Store op code in instr. skeleton. + CALL GETNB ; Skip "," after cc field. + JRST JRDISP ; Evaluate displacement. + + +; Unconditional JR . . . + +ZJRNC: MOVEI R0,030 ; Set op code for unconditional + DPB R0,[341000,,OPCODE] ; JR in instruction skeleton. + +; Assemble displacement for both breeds of JR. + +JRDISP: CALL EXPR ; Evaluate expr for dest address. + TROA RERR,ERRA ; .. No expr: Flag err & assemble + ; nop: JR $+2. + SUBI R1,2(RLOC) ; Disp = expr-pc-2 to allow for + ; pc update. + TRNN R1,177600 ; Are bits 7-15 all 0? + JRST JRDOK ; Yes - Valid positive displacement. + HRRZ R0,R1 ; No -- Check for negative disp. + TRZ R0,600177 ; Check high order 9 bits . . . + CAIN R0,177600 ; Are they all 1 bits? + JRST JRDOK ; Yes - Valid negative displacement. + TRO RERR,ERRT ; No -- Flag truncation error & + MOVEI R1,-2 ; assemble JR $ (inf loop). + +JRDOK: DPB R1,[241000,,OPCODE] ; Store displacement in op skeleton. + JRST ZFIN ; Output the instruction. + +; JRP: Assemble either a JR or a JP, depending on which +; is appropriate to the type of the instruction's operands +; and how far the destination is from the current address. + +ZJRP: CALL SETNB ; Check next byte. + CAIN RBYTE,"( ; Is this a reg indirect expression? + JRST ZJP ; Yes - Assemble a JP. + ; No -- Check further. + + CALL ZJCOND ; Parse a condition code, if one exists + MOVEI R0,7 ; -- No cc: Flag this via value 7. + + PUSH P,R0 ; Save cc value for later reference. + CAIN RBYTE,", ; Was there a cc terminated by ","? + CALL GETNB ; Yes - Skip the comma. + +; Get jump's destination address. +; This must be a symbol which corresponds (either now or later) +; to a label in the source. + + CALL GETSYM ; Get destination symbol. + JRST ZJPERR ; None -- Assemble JP & flag it. + CALL SSRCH ; Look up the symbol. + CALL INSRT ; No symtab entry - Insert one. + CALL CRFREF ; Record the reference. + + TLNE R1,MDFSYM ; Is this symbol multiply defined? + TRO RERR,ERRD ; Yes - Give this line a D flag. + TLNN R1,DEFSYM ; Is this symbol defined? + JRST ZJRPU ; No -- Prob. fwd ref on pass 1. + ; Yes - Check offset. + + + SUBI R1,2(RLOC) ; Dest offset for JR = dest-pc-2. + TRNN R1,177600 ; Are high 9 bits of offset 0? + JRST ZJRPJR ; Yes - Valid positive offset. + HRRZ R0,R1 ; No -- Check for negative offset. + TRZ R0,600177 + CAIN R0,177600 ; Are high 9 bits of offset 1? + JRST ZJRPJR ; Yes - Valid negative offset. + ; No -- Destination is out of range + ; for JR: Assemble JP. + ADDI R1,2 ; Translate expression value + ADD R1,RLOC ; back to destination address. + JRST ZJRPJP + + + + + +; Jump is to an undefined symbol; This should be either +; a global symbol or a forward reference on pass 1. + +ZJRPU: TLNE R1,GLBSYM ; Is this a global (external) symbol? + JRST ZJRPJP ; Yes - Generate JP. + TRO RERR,ERRU ; No -- Flag ref to undefined sym. + TLNN R15,P1F ; Is this pass 1? + JRST ZJPERR ; No -- Generate JP 0. + ; Yes - Assume forward ref. + +; Apparent forward reference in pass 1: +; Record it in the forward JRP list and presume +; a JP should be generated. If label definition later +; finds the destination within range for a JR it will +; decrement the addresses of labels within this JRP's range +; so that pass 2 will generate the proper code. + + MOVE R1,FJLIST ; Get fwd JRP list's entry count. + CAIL R1,32. ; Is there room for another entry? + 0 ; %%%% temp %%%% no - add diag & halt. + LSH R1,1 ; Yes - Get index for 1st empty slot + + MOVE R0,@SYMPNT ; Set new entry: Operand symbol 1st. + MOVEM R0,FJLIST+1(R1) + MOVEI R0,2(RLOC) ; 2nd word is instruction end address + MOVEM R0,FJLIST+2(R1) ; (start addr + 2). + + AOS FJLIST ; Increment list's entry count. + JRST ZJRPJP ; Generate JP for now. + + + +; Destination's close: Generate a JR, unless this is +; a conditional jump for one of the conditions which +; can't be tested by a JR. + +ZJRPJR: POP P,R0 ; Retrieve condition code. + CAIL R0,40 ; Is this a cond invalid for JR? + JRST ZJRPPP ; Yes - Assemble JP. + ; No -- Assemble JR. + CAIN R0,7 ; Is this an unconditional jump? + JRST ZJRPUN ; Yes - Set op code to suit. + IORI R0,040 ; No -- Or op code with cc bits. + JRST ZJRPRS + +ZJRPUN: MOVEI R0,030 ; Supply op code for uncond. JR. + +ZJRPRS: DPB R0,[341000,,OPCODE] ; Store op code. + DPB R1,[241000,,OPCODE] ; Store JR displacement. + MOVEI R0,2 ; Set instruction length + MOVEM R0,INSLEN ; to 2 bytes. + JRST ZFIN ; Output the instruction. + + + + + +; Can't assemble JR for various reasons: Assemble JP. + +ZJPERR: TRO RERR,ERRA ; No destination address: Flag error + SETZ R1, ; and assemble JP 0 + JRST ZJRPJP ; to allow patching. + +ZJRPPP: PUSH P,R0 ; Cond code forces JP: Restack cc + ; to simplify entry to ZJRPJP. + +ZJRPJP: MOVEI R0,3 ; Set instruction length to 3 bytes. + MOVEM R0,INSLEN + + POP P,R0 ; Retrieve condition code. + CAIN R0,7 ; Is this a conditional jump? + JRST ZJRPNU ; No -- Assemble uncond. op code. + IORI R0,302 ; Yes - Or op code with cc field. + JRST ZJRPE + +ZJRPNU: MOVEI R0,303 ; Supply op code for unconditional JP. + +ZJRPE: DPB R0,[341000,,OPCODE] ; Store op code in skeleton. + DPB R1,[241000,,OPCODE] ; Store LSB of destination address. + LSH R1,-8 + DPB R1,[141000,,OPCODE] ; Store MSB of destination address. + JRST ZFIN ; Output the instruction. + + + + + +; Assemble DJNZ after the fashion of a JR. + +ZDJNZ: MOVEI R0,2 ; Set instruction length + MOVEM R0,INSLEN ; to 2 bytes. + MOVEI R0,020 ; Store op code + DPB R0,[341000,,OPCODE] ; in instruction skeleton. + JRST JRDISP ; Assemble relative displacement. + + + + + +; CALL . . . + +ZCALL: MOVEI R0,3 ; Set instruction length to 3 bytes. + MOVEM R0,INSLEN + + CALL ZJCOND ; Try to parse a condition code field. + JRST ZCUN ; .. No cc: Unconditional call. + ; .. Cc: Conditional call. + + IORI R0,304 ; Or op code with cc field. + DPB R0,[341000,,OPCODE] ; Store opcode. + CALL GETNB ; Skip comma delimiting cc field. + JRST ZJPNN ; Assemble call address as in + ; a JP instruction. + +ZCUN: MOVEI R0,315 ; Set opcode for unconditional call. + DPB R0,[341000,,OPCODE] + JRST ZJPNN ; Assemble call address. + + + + + +; RET . . . + +ZRET: MOVEI R0,1 ; Set instruction length to 1 byte. + MOVEM R0,INSLEN + + CALL ZRCOND ; Try to parse a condition code field. + JRST ZRUN ; .. No cc: Unconditional return. + ; .. Cc: Conditional return. + + IORI R0,300 ; Or opcode with cc field. + DPB R0,[341000,,OPCODE] ; Store opcode. + JRST ZFIN ; Output the instruction. + +ZRUN: MOVEI R0,311 ; Set opcode for unconditional return. + DPB R0,[341000,,OPCODE] + JRST ZFIN ; Output the instruction. + + SUBTTL Register expression evaluation: regm, rp, rp5, & rp7 + + +; regm expression evaluation + +; The following symbols are treated as reserved within +; the context of source or destination fields which +; require regm expressions: + + +; symbol: A B C D E H L M +; matching value: 7 0 1 2 3 4 5 6 + +; A regm expression is either one of these reserved symbols +; or an absolute expression which evaluates to a value +; in the range [0,7]. + +; Note that 8080 architecture uses M as a pseudo-register +; representing the byte addressed by HL. This allows +; assembling such memory references as register references. + + +; At exit R1 contains the value of the regm expression, +; truncated to 3 bits. Successful return is to 1(P), +; 0(P) if the next input text was not a valid regm expression. + +GLBPNT: BLOCK 1 +GLBBUF: BLOCK 40 + +REGM: + CALL SETCHR ; %%%% + LDB R0,C8PNTR ; Check type of next input byte. + CAIE R0,.ALP + CAIN R0,.HEX + JRST RMALPH ; Alphabetic: Check for reserved name. + ; Non-alpha: Treat as expression. + +RMEXP: CALL EXPR ; Evaluate an absolute expression. + RETURN ; If EXPR fails, REGM fails. + TRZE R1,777770 ; Is value too large? + TRO RERR,ERRT ; Yes - Truncate & flag error. + JRST CPOPJ1 ; Take "success" exit. + + + +; Check for one of the reserved register names. + +RMALPH: MOVE R2,RBYTE ; Save current input byte. + MOVE R3,RBPTR ; Save current input pointer. + CALL GETCHR ; Get next byte. + CAIE R4,SCSE + CAIN R4,SCLE ; Is it a delimiter? + JRST RMA1 ; Yes - Check saved input byte. + ; No -- Can't be 1-byte symbol. +; Input wasn't a reserved register name. +; Back up the input pointer to its original position +; and try to parse the input as an expression. + +RMBACK: MOVE RBPTR,R3 ; Restore original input pointer value. + CALL SETCHR ; Restore info on byte pointed to. + JRST RMEXP ; Try to parse an expression. + + +; Input is a single alphabetic byte followed by a delimiter. +; Look for it in table of reserved register symbols. + +RMA1: MOVE R1,REGMAP-"A(R2) ; Get byte's matching value. + TRZE R1,777770 ; Is it valid? + JRST RMBACK ; No -- Parse as expression. + JRST CPOPJ1 ; Yes - Return this value. + + +; ***** Warning: "@" and "?" cause REGMAP to be indexed by -1 and -2, +; ***** picking up the values of the two previous instructions. + +REGMAP: ; Values matching reserved names + 7 ; A + 0 ; B + 1 ; C + 2 ; D + 3 ; E + -1 ; F - invalid + -1 ; G - invalid + 4 ; H + -1 ; I - invalid + -1 ; J - invalid + -1 ; K - invalid + 5 ; L + 6 ; M + -1 ; N - invalid + -1 ; O - invalid + -1 ; P - invalid + -1 ; Q - invalid + -1 ; R - invalid + -1 ; S - invalid + -1 ; T - invalid + -1 ; U - invalid + -1 ; V - invalid + -1 ; W - invalid + -1 ; X - invalid + -1 ; Y - invalid + -1 ; Z - invalid + +; Register pair expression evaluation + + +; rp expressions recognize "B", "D", "H", and "SP" +; as reserved names with values of 0, 1, 2, and 3, respectively. +; Anything else is parsed as an absolute expression. + +; At return the expression value is R1, truncated to 2 bits. +; Successful return is to 1(P), failure return to 0(P). + + +RP: + CALL SETCHR ; %%%% + MOVE R3,RBPTR ; Save input pointer for possible rescan + +; Check for possible beginnings of reserved register pair names. + +RP5ENT: CAIN RBYTE,"H ; .. "H" + JRST RPHL + CAIN RBYTE,"D ; .. "D" + JRST RPDE + CAIN RBYTE,"B ; .. "D" + JRST RPBC + CAIE RBYTE,"S ; .. "SP" + JRST RPEXP ; None of above: Parse as expr. + + + +; First input byte is "S". Check up to 2 more bytes to see +; if this is "SP". If it isn't, restore input pointer +; to its original value and try to parse an expression. + + CALL GETCHR ; Get byte following "S". + CAIE RBYTE,"P ; Is it "P"? + JRST RPBEXP ; No -- Look for expression. + MOVEI R1,3 ; Preload return value 3 for SP. + JRST RPCDEL ; Check for delimiter next. +; Current input matches a reserved name. Preload associated +; value in R1 for return & check next byte: If it's a delimiter +; take successful return, else restore original input pointer +; and try to parse an expression. + +RPDE: MOVEI R1,1 ; "D" => reg pair DE. + JRST RPCDEL + +RPBC: TDZA R1,R1 ; "B" => reg pair BC. +RPHL: MOVEI R1,2 ; "H" => reg pair HL. + +RPCDEL: CALL GETCHR ; Get next input byte. + CAIE R4,SCSE + CAIN R4,SCLE ; Is it a delimiter? + JRST CPOPJ1 ; Yes - Return reserved name value. + ; No -- Try parsing as expression. + +RPBEXP: MOVE RBPTR,R3 ; Restore original input pointer. + CALL SETCHR ; Prime for next parser. + +RPEXP: CALL EXPR ; Parse input as expression. + RETURN ; No expr => no rp expr. + TRZE R1,777774 ; Is expression in proper range? + TRO RERR,ERRT ; No -- Truncate & flag error. + JRST CPOPJ1 ; Take "success" return. + +; rp5 expression evaluation + +; rp5 expressions are identical to rp expressions except +; that "PSW", rather than "SP", is the reserved name +; corresponding to value 3. + + +RP5: + CALL SETCHR ; %%%% + MOVE R3,RBPTR ; Save current input pointer. + CAIE RBYTE,"P ; Is next input byte "P"? + JRST RP5ENT ; No -- Parse as rp expression. + ; Yes - Look for "SW". + + CALL GETCHR ; Check for "S". + CAIE RBYTE,"S + JRST RPBEXP ; Not S => expression. + + CALL GETCHR ; Check for "W". + CAIE RBYTE,"W + JRST RPBEXP ; Not W => expression. + +; Initial input is "PSW": Preload return value (3) +; and check for delimiter, as in ordinary rp expressions. + + MOVEI R1,3 ; Prepare to return 3 as rp5 value. + JRST RPCDEL ; Check for delimiter. + +; rp7 expression evaluation + + +; rp7 expressions are identical to rp expressions, except +; that only BC and DE (values 0 & 1) may be specified. + + +RP7: + CALL RP ; Parse a full rp expression. + RETURN ; Propagate a failure return. + TRZE R1,2 ; Is rp value valid for rp7? + TRO RERR,ERRT ; No -- Truncate & flag error. + JRST CPOPJ1 ; Take "success" return. + + +; %%%%%%% glitches: + +; "sp" for rp5 will be parsed as reserved name instead of expr. +; "DE" or "SP" for rp7 will get T flag instead of A. +OPCERR: ;ILLEGAL OP CODE + TRO R15,ERRO + RETURN + +QERR: ; OTHER ROUTINES DO THIS TOO. +.RADER: TRO RERR,ERRQ ;ERROR IF n NOT ONE OF 2,4,8,10,16 + RETURN ;EXIT W/O CHANGING RADIX + + +EXPR: ;EXPRESSION PROCESSOR, REGISTER ALLOWED + +EXPRF: ;EXPRESSION FIN, NO REGISTERS ALLOWED + MOVE R2,GLBRDX ;GET GLOBAL RADIX + TLNE R15,HOVFLG ;CHECK IF HEX OVERRIDE ENABLED + TRO R2,HEXENB ; YES, SET HEXENB IN LOCRDX +RADEXP: MOVEM R2,LOCRDX ;MOVE TO LOCAL RADIX + SETZB R6,RELLVL ;CLEAR RELOCATION LEVEL COUNT + CALL EXPR0 ;GO EVALUATE EXPRESSION + RETURN ; NULL, EXIT + SOSLE RELLVL ;RELOCATION LEVEL .GT. 1? + TRO RERR,ERRA ; YES, FLAG ERROR + MOVE R1,R10 ; Insure expr value returned in R1. + JRST CPOPJ1 ;EXIT GOOD + +EXPR0: ;EXPRESSION PROCESSOR + PUSH P,LOCRDX ;SAVE CURRENT RADIX + CALL TERM ;GET THE FIRST TERM + JRST EXPEX ; NULL, GO EXIT + CALL SETNB ; Set to check next nonblank character. + POP P,LOCRDX ;RESTORE RADIX + CALL EXPRPX ;SET RELOCATION LEVEL +EXPR1: LDB R2,C4PNTR ;MAP NEXT CHAR USING COLUMN 4 + XCT EXPRJT(R2) ;EXECUTE TABLE TO SAVE OP ADDR + CALL GETNB ;GET THE NEXT NON-BLANK CHAR +EXPR2: HRLM R2,0(P) ;AND SAVE OP ADDRESS + PUSH P,R10 ;STACK CURRENT VALUE + PUSH P,LOCRDX ;SAVE CURRENT RADIX + CALL TERM ;GET NEXT TERM + TRO RERR,ERRQ ; NULL, FLAG ERROR + CALL SETNB ; Set to check next nonblank character. + POP P,LOCRDX ;RESTORE RADIX + POP P,R1 ;GET PREVIOUS VALUE + HLRZ R2,0(P) ; AND OPERATOR + CALL 0(R2) ;PERFORM OPERATOR + TRO RERR,ERRA ; IF ERROR, FLAG IT + TRZ R10,600000 ;CLEAR ANY OVERFLOW + JRST EXPR1 ;TEST FOR MORE + +EXPEX: POP P,LOCRDX ;RESTORE RADIX + RETURN ;EXIT + + + +; Check for operators spelled out by Intel: +; AND, OR, XOR, MOD, SHL, and SHR. + +EXPR3: PUSH P,RBPTR ; Save current input pointer. + CALL GETSYM ; Get a symbol. + JFCL ; Guaranteed there'll be one. + SETZ R2, ; Presume it won't match an operator. + + CAMN R0,M40AND ; Check for "AND". + MOVEI R2,EXPRAN + CAMN R0,M40OR ; Check for "OR". + MOVEI R2,EXPROR + CAMN R0,M40XOR ; "XOR" + MOVEI R2,EXPRXR + CAMN R0,M40MOD ; "MOD" + MOVEI R2,EXPRMD + CAMN R0,M40SHL ; "SHL" + MOVEI R2,EXPRSH + CAMN R0,M40SHR ; "SHR" + MOVEI R2,EXPRSR + + SKIPE R2 ; Was the symbol one of these? + JRST [SUB P,[1,,1] ; Yes - Discard old RBPTR + JRST EXPR2 ] ; and evaluate + POP P,RBPTR ; No -- Restore ptr to unknown input + JRST CPOPJ1 ; & exit with current expression value. + +EXPRPL: ; + + TDZA R6,R6 ;ZERO FOR ADD +EXPRMI: ; - + HRROI R6,1 ;ONE FOR SUBTRACT + CALL EXPRPX ;UPDATE RELOCATION COUNT +EXPRP1: LDB R2,SUBPNT ;GET RELOCATION + EXCH R10,R1 + LDB R3,SUBPNT + JUMPE R3,EXPRM1 ;BRANCH IF SUBTRACTING ABS + TLON R6,-1 ;NOT ABS, FIRST-TIME ADDITION? + JRST EXPRP1 ; YES, REVERSE + TLNN R1,GLBSYM ;IF EITHER IS GLOBAL, + TLNE R10,GLBSYM + JRST EXPRM2 ; ERROR + CAME R2,R3 ;LAST CHANCE, BOTH SAME RELOCATION + JRST EXPRM2 ; FORGET IT + SKIPN RELLVL ;IF BACK TO ZERO, + TLZ R10,(PFMASK) ;MAKE ABSOLUTE +EXPRM1: AOS 0(P) ;INDICATE GOOD RESULT +EXPRM2: XCT [ADDM R10,R1 ? SUBM R10,R1](R6) ;PERFORM OP + DPB R1,[002000,,R10] ;STORE TRIMMED RESULT + RETURN ;EXIT + +EXPRPX: ;UPDATE RELOCATION LEVEL + TLNE R10,(PFMASK) ;IF ABS, + TLNE R10,GLBSYM ; OR GLOBAL, + RETURN ; NO ACTION + XCT [AOSA RELLVL ? SOSGE RELLVL](R6) + TRO R15,ERRA ; NEGATIVE COUNT, ERROR + RETURN + +EXPROR: JSP R3,EXPXCT ; ! or OR + IOR R10,R1 + +EXPRXR: JSP R3,EXPXCT ; XOR + XOR R10,R1 + +EXPRAN: JSP R3,EXPXCT ; & or AND + AND R10,R1 + +EXPRMU: JSP R3,EXPXCT ; * + IMUL R10,R1 + +EXPRDV: JSP R3,EXPXCT ; / + CALL [ ANDI R10,177777 + IDIV R10,R1 + RETURN ] + +EXPRMD: JSP R3,EXPXCT ; MOD + CALL [ IDIV R10,R1 + MOVE R10,R11 + RETURN ] + +EXPRSR: MOVNS R10 ; SHR -- Make shift count negative. + HRRZ R10,R10 ; Keep relocation bits clear. +EXPRSH: JSP R3,EXPXCT ; _ or SHL + CALL [ ANDI R10,177777 ;get rid of extended sign + LSH R10,0(R1) ; so this is a logical shift + RETURN ] + + +EXPXCT: PUSH P,0(R3) ;STACK INSTRUCTION + CALL EXPXC1 ;TEST FOR ABSOLUTE + EXCH R10,R1 + CALL EXPXC1 ;DITTO FOR OTHER + POP P,R3 ;FETCH INSTRUCTION + XCT R3 ;EXECUTE IT + ANDI R10,177777 ;MAKE ABSOLUTE + JRST CPOPJ1 ;GOOD EXIT + +EXPXC1: CALL ABSTST ;TEST FOR ABSOLUTE + LSH R10,<36.-16.> + ASH R10,-<36.-16.> ;EXTEND SIGN + RETURN + + ABSEXP: ;ABSOLUTE EXPRESSION + CALL EXPR + TRO R15,ERRA +ABSTST: TLZE R10,(\pfmask) + TRO R15,ERRA ;ERROR IF GLOBAL OR RELOCATABLE + ANDI R10,177777 + RETURN +TERPL: CALL GETNB ; Skip "+" + +TERM: ;TERM PROCESSOR + SETZB R10,R1 ;RETURN VALUE IN R10 + CALL GETSYM ;TRY FOR SYMBOL + JRST TERM4 ; NOT A SYMBOL + CAMN R0,M40NOT ; Is this a unary NOT? + JRST TERMNT ; Yes . . . + CALL SSRCH ;SEARCH TABLE + JRST TERM2 ; NOT THERE + TLNE R1,MDFSYM ;MULTIPLY DEFINED? + TRO R15,ERRD ; YES + TLNN R1,DEFSYM\GLBSYM ;UNDEFINED? + TRO R15,ERRU ; YES + MOVE R3,R1 ;GET AN EXTRA COPY + TLZ R1,776000 ;CLEAR ALL BITS + TLNN R3,DEFSYM ;DEFINED? + TLNN R3,GLBSYM ; NO, GLOBAL? + JRST TERM1 ; LOCAL + TLO R1,GLBSYM ;JUST GLOBAL + AOS R6,GLBPNT ;GLOBAL + MOVEM R0,GLBBUF(R6) ;SAVE NAME + DPB R6,SUBPNT ;SAVE NUMBER IN RELOCATION +TERM1: CALL CRFREF ;CREF IT + MOVE R10,R1 ;RESULT TO R10 + JRST CPOPJ1 ;GOOD EXIT + +TERM2: CALL OSRCH ;TRY OP CODES + JRST TERM3 ; NO + CAIE R2,OCOP ;PSEUDO-OP? + JRST TERM3 ; YES + CALL CRFREF + HRRZ R10,R1 ;YES, TREAT AS NUMERIC + JRST CPOPJ1 ;GOOD EXIT + +TERM3: CALL SSRCH ;NOT YET DEFINED + CALL INSRT ;INSERT + TRO R15,ERRU ;FLAG ERROR + JRST CPOPJ1 ;RETURN WITH ZERO + +TERM4: LDB R2,C5PNTR ;NON-SYMBOLIC + XCT TERMJT(R2) ;EXECUTE TABLE + JRST CPOPJ1 ;GOOD EXIT + +TERMNM: ;NUMERIC TERM + PUSH P,R6 ;SAVE R6. + MOVE R6,LOCRDX ;GET RADIX + SETZB R0,R1 ;CLEAR ACCUMULATORS + SETZB R2,R3 + SETZB R10,R11 + +TERMN1: CAILE R14,"9 ;CHECK IF NUMERIC + JRST TERMN6 ; NO, GO CHECK IF HEX + ASH R10,1 ;SHIFT BINARY AC ONE PLACE + ADDI R10,-"0(R14) ;ADD NUMERIC VALUE OF DIGIT + ASH R1,2 ;SHIFT QUATERNARY AC ONE PLACE + ADDI R1,-"0(R14) ;ADD + ASH R2,3 ;SHIFT OCTAL + ADDI R2,-"0(R14) + IMULI R3,10. ;DECIMAL + ADDI R3,-"0(R14) + ASH R0,4 ;HEXADECIMAL + ADDI R0,-"0(R14) +TERMN2: CAMGE R11,R14 ;LARGEST DIGIT SO FAR? + MOVE R11,R14 ; YES, SAVE IT + CALL GETCHR ;GET THE NEXT CHARACTER +TERMNA: CAIL R14,"0 ;CHECK IF NUMERIC + JRST TERMN1 ; POSSIBLY, GO CHECK FURTHER + + +; Found a non-numeric digit: + +TERMN3: MOVE R4,[-5,,0] ; Set up to scan radix ident table. + +TERMN4: CAMN RBYTE,RADCHR(R4) ; Is terminator this radix selector? + JRST TERMN5 ; Yes - Force to matching radix. + AOBJN R4,TERMN4 ; No -- Check next radix selector. + + +TERMN7: TRNE R6,OCTRDX ;CHECK IF RADIX OCTAL + JRST TERMNO ; YES, PROCESS ACCORDINGLY + TRNE R6,DECRDX ;DECIMAL + JRST TERMND + TRNE R6,HEXRDX ;HEXADECIMAL + JRST TERMNH + TRNE R6,QUARDX ;QUATERNARY + JRST TERMNQ + CAIG R11,"1 ;BINARY: CHECK IF ALL DIGITS < 2 + JRST TERMN8 ; YES, JUMP OUT + TRO RERR,ERRN ; NO, FLAG ERROR +TERMNQ: MOVE R10,R1 ;MOVE QUATERNARY IN + CAIG R11,"3 ;CHECK IF ALL DIGITS < 4 + JRST TERMN8 ; YES, JUMP OUT + TRO RERR,ERRN ; NO, FLAG ERROR +TERMNO: MOVE R10,R2 ;MOVE OCTAL IN + CAIG R11,"7 ;CHECK IF ALL DIGITS < 8 + JRST TERMN8 ; YES, JUMP OUT + TRO RERR,ERRN ; NO, FLAG ERROR +TERMND: MOVE R10,R3 ;MOVE DECIMAL IN + CAIG R11,"9 ;CHECK IF ALL DIGITS <= 9 + JRST TERMN8 ; YES, JUMP OUT + TRO RERR,ERRN ; NO, FLAG ERROR +TERMNH: MOVE R10,R0 ;MOVE HEXADECIMAL IN +TERMN8: TDZE R10,[-1_16.] ;OVERFLOW? + TRO RERR,ERRT ; YES, FLAG truncation ERROR + POP P,R6 ;RESTORE R6. + JRST SETNB ; Find next nonblank byte & exit. + + + +; Found a radix selector in RADCHR: Set selected radix +; to the matching value from RADTAB. + +TERMN5: MOVE R6,RADTAB(R4) ; Get mask bit for selected radix. + CALL GETNB ; Skip the radix selector byte. + JRST TERMN7 ; Check for valid value in this radix. + + +TERMN6: CAIL R14,"A ;TEST IF LEGAL HEX DIGIT + CAILE R14,"F + JRST TERMN3 ; NO, GO FINISH UP + ASH R0,4 ; YES, SHIFT HEXADECIMAL AC ONE PLACE + ADDI R0,-"A+10.(R14) ;ADD NUMERIC VALUE OF DIGIT + + CAIE RBYTE,"D ; Is this digit "B" or "D"? + CAIN RBYTE,"B + CAIA ; Yes - May be a radix selector. + JRST TERMN2 ; No -- Rejoin numeric loop. + +; Digit was "B" or "D": Decide whether this is a hex digit +; or a radix selector for binary or decimal by checking for +; the next byte being a delimiter. + + PUSH P,RBPTR ; Save current input pointer. + CALL GETCHR ; Get next byte. + CAIE R4,SCSE ; Is it a separator or line-end byte? + CAIN R4,SCLE + JRST TERMN9 ; Yes - Select binary or decimal. + ; No -- Continue collecting hex. + MOVEI R11,"D ; Indicate largest digit in hex range. + SUB P,[1,,1] ; Discard old input pointer. + JRST TERMNA ; Continue with next digit. + +TERMN9: POP P,RBPTR ; Restore old input pointer. + CALL SETCHR ; Restore "B" or "D" as current byte. + JRST TERMN3 ; Select binary or decimal radix. +TERMSQ: ; "'" + +; Collect an ASCII string delimited by single quotes. +; If more than two bytes are supplied, the last two +; determine the 16-bit value of the expression. + + TLO R16,FOLBIT ; Suppress folding to collect ASCII. + +TSQ1: CALL GETNT ; Get anything except EOL. + JRST TERMQE ; EOL: Flag error & quit here. + CAIN RBYTE,"' ; Is next byte "'"? + JRST TSQ2 ; Yes - Probably end of string. + ; No -- Make it LSB of term value. +TSQ3: LSH R10,8 ; Shift term value left 1 byte. + IOR R10,RBYTE ; Set LSB = new byte. + JRST TSQ1 ; Get next character. + +TSQ2: CALL GETCHR ; "'" encountered: Get next byte. + CAIN RBYTE,"' ; Is this a "''" sequence? + JRST TSQ3 ; Yes - Equivalent to "'" as data. + TLZ R16,FOLBIT ; No -- Restore folding. + JRST SETCHR ; Return with folded input byte. + + + +TERMDL: ; "$" + MOVE R10,RLOC ; Term value = current PC value. + JRST GETCHR ; Skip "$" and return. + + +TERMQE: TRO R15,ERRQ ;RAN OUT OF CHARACTERS + RETURN + +TERM2C: ;"-" + CALL GETNB ;GOBBLE "-" + CALL TERM ;GET A TERM + TRO RERR,ERRQ ; ERROR IF NULL + MOVN R0,R10 ;TAKE 2'S COMPLEMENT + TRZ R0,600000 + HRR R10,R0 ;PUT 16 BITS OF IT IN R10 + RETURN ;EXIT + +TERMNT: ; NOT + CALL TERM ; Get another term. + TRO RERR,ERRQ ; None => syntax error. + TRC R10,-1 ; Complement it. + TRZ R10,600000 ; Trim it to 16 bits. + JRST CPOPJ1 ; Exit as if successful. + +TERMEX: ;"(" + PUSH P,RELLVL ; Save current relocation level on stack. + SETZM RELLVL ; Start nested expression at reloc level 0. + SETZ r6, ; Clear possible record of "-" preceding "(". + CALL GETNB ;GOBBLE "(" + + +; Try to resolve ambiguity between +; "(machine instruction)" and "(expression)". + + CALL GETSYM ; Try to get a symbol. + JRST TERMX0 ; None -- must be (expr). + CALL OSRCH ; Got one - Is it an op code? + JRST TERMA1 ; No -- Treat as (expr). + ; Yes - Assume (machine instr). + +; "(machine instruction)" . . . + + PUSH P,RLOC ; Save info destroyed by + PUSH P,OPCODE ; assembling a machine instruction. + PUSH P,CODPNT + PUSH P,INSLEN + + CALL PROPC ; Assemble the parenthesized instr. + HRRZ R10,OPCODE ; Return its op code byte + TRZ R10,777400 ; as the term value. + + POP P,INSLEN ; Restore info needed to assemble + POP P,CODPNT ; the instruction whose operand + POP P,OPCODE ; was an instruction. + POP P,RLOC + + CALL SETNB ; %%%% [insure Rbyte gets ")"] + JRST TERMX2 ; Finish parsing term via ")" check. + + + +; "(expression)" . . . + +TERMA1: MOVE RBPTR,SYMBEG ; Restore pointer to start of expr. + +TERMX0: CALL EXPR0 ;GET AN EXPRESSION + TRO RERR,ERRQ ; ERROR IF NULL +TERMX2: POP P,RELLVL ; Restore relocation level. + CAIE R14,") ;CHECK FOR CLOSING ")" + TROA RERR,ERRQ ; NO, FLAG ERROR + JRST GETNB ; YES, GOBBLE ">" & EXIT + + + + WPB== 30. ; MACRO BLOCK SIZE + MACNES== 32. ; MACRO NESTING LIMIT + ; -- THIS APPLIES TO BOTH NESTED MACRO + ; DEFINITIONS AND NESTED CALLS. + +PRGTTL: BLOCK 1 + +SUBMSG: BLOCK 30 ;SUBTITLE BUFFER AREA +TTLMSG: BLOCK 30 ; TITLE AREA +TTLFLA: BLOCK 1 ;=-1 IF PROGRAM NAME TYPED + +FSEQ: BLOCK 2 ; FORMATTED LINE SEQUENCE NUMBER + +CURSUM: BLOCK 1 ; Current value of checksum for a code segment +GLBRDX: BLOCK 1 ;GLOBAL RADIX (SET BY .RADIX) +RADVAL: BLOCK 1 ; VALUE OF GLOBAL RADIX + ; (GLBRDX CONTAINS FLAGS!) +SKPCNT: BLOCK 1 ; Number of lines to skip following "skip n". +LSTCNT: BLOCK 1 ;LIST LEVEL COUNT +LSTCTL: BLOCK 1 ; LISTING CONTROL FLAGS +LIWORD: BLOCK 1 ; LISTING OVERRIDE FLAGS +ENACTL: BLOCK 1 +ENWORD: BLOCK 1 ; ENABLE OVERRIDE FLAGS +NEXGS: BLOCK 1 ; NUMERIC VALUE OF NEXT + ; MACRO-GENERATED LOCAL SYMBOL +PAGNUM: BLOCK 1 ;PAGE NUMBER +SEQ: BLOCK 1 ; LINE SEQUENCE NUMBER (BINARY) +LSBLOC: BLOCK 1 ; LOCAL SYMBOL BLOCK NUMBER +REPLVL: BLOCK 1 ;REPEAT LEVEL COUNTER +REQCNT: BLOCK 1 ; Level counter of .REQUIREs +CONLVL: BLOCK 1 ;CONDITIONAL LEVEL COUNTER +UNSLVL: BLOCK 1 ;UNSATISFIED CONDITIONAL NESTING LEVEL +NEXT: BLOCK 1 ;GARBAGE COLLECTION CHAIN +REPEXP: BLOCK 1 ;REPEAT EXPRESSION +REPPNT: BLOCK 1 ;REPEAT POINTER + +ARGCNT: BLOCK 1 ; MACRO ARGUMENT COUNTER +ARGLEN: BLOCK 1 ; LENGTH OF MACRO-TYPE ARGUMENT +ARGSTR: BLOCK 100. ; SPACE FOR ARG AS ASCIZ STRING +ARGDEL: BLOCK 1 ; MACRO (.IRP) ARGUMENT DELIMITER + +MWPNTR: BLOCK 1 ;MACRO WRITE POINTER + +RELLVL: BLOCK 1 ;RELOCATION LEVEL + +CALPNT: BLOCK 1 ;POINTER TO CURRENT MACRO CALL BLOCK +MACLVL: BLOCK 1 ;MACRO NESTING LEVEL +MLSAVE: BLOCK 1 ; MACRO LEVEL SAVED BY .MEXIT +MARMAS: BLOCK 1 ; MACRO ARGUMENT BIT MASK (FOR "?") +ARGLST: BLOCK 65. ; TEMP STORAGE FOR MACRO ARGUMENTS +MACNAM: BLOCK MACNES ; NESTED MACRO DEFINITION NAME TABLE +MCLREP= MACNAM ; SAVED REPEAT LEVEL TABLE +MCLCON: BLOCK MACNES ; SAVED CONDITIONAL LEVEL TABLE +MCLUNS: BLOCK MACNES ; SAVED UNSATISFIED LEVEL TABLE +OPCCNT: BLOCK 8. + +CALLM: + MOVE R0,LSTCTL ; LOAD LIST CONTROL FLAGS + TRNN R0,LMC ; .NLIST MC IN EFFECT? + JRST [ TLO R16,NLISLN ; Yes - suppress list of this line + JRST IRPCAL ] ; and continue + TRNN R0,LME ; Should we print PC? + SKIPN MACLVL ; No - but first level always gets printed + MOVEM RLOC,PF0 ; Set PC for printout + +IRPCAL: TLZA R16,IRPBIT ; ENTRY FROM .IRPC -- +IRPAR: TLO R16,IRPBIT ; ENTRY FROM .IRP -- + TLO R16,FOLBIT ; DON'T FOLD ARG VALUES. + PUSH P,R1 ;SAVE POINTER TO DEFINITION BLOCK + AOS (R1) ; Increment the reference count + MOVE R7,1(R1) ;GET ARGUMENT COUNT + MOVE R0,2(R1) ; GET "?" ARGUMENT BIT MASK, + MOVEM R0,MARMAS ; SAVE IT IN MARMAS. + CALL GETBLK ;GET A BLOCK FROM FREE STORAGE + PUSH P,MWPNTR ;SAVE THE STARTING ADDRESS + SETZM ARGCNT ; -- CLEAR ARGUMENT COUNT. + MOVEI R0,5 + ADDM R0,MWPNTR ;MOVE BYTE POINTER PAST WORD STORAGE + MOVEI R14,QUEARG + CALL WTIMT ;INITIALIZE ARGUMENT LIST + JUMPE R7,MAC50 ;TEST FOR NO ARGS + +MAC10: SETZM ARGLEN ; PRESUME ARG WILL BE OMITTED. + CALL SETNB ;SET NON-BLANK + CAIE R14,"; ;IF SEMI-COLON + CALL TSTNT ; OR TERMINATOR, + JRST MAC50A ; NO MORE ARGUMENTS. + + AOS ARGCNT ; INCREMENT ARGUMENT COUNT. + CAIN R14,", ; IS NEXT BYTE A COMMA? + JRST MAC40 ; YES -- EXPLICITLY NULL ARG. + + CAIN R14,"\ + JRST MAC70 ;EXPRESSION TO ASCII CONVERSION + CALL MACART ; PARSE A MACRO ARG & STORE IN + ; THE MACRO CALL BLOCK. + TLNN R16,IRPBIT ; IS THIS A .IRP? + JRST MAC40 ; NO -- MARK END OF ARGUMENT. + CAIN RBYTE,", ; YES - SKIP COMMA, IF ANY. + IBP RBPTR ; KEEP DELIMITER IN RBYTE! + JRST MAC50A ; QUIT AFTER PRECISELY 1 ARG. +MAC40: ; END-OF-ARGUMENT PROCESSING + SKIPG ARGLEN ; WAS ARGUMENT NULL? + CALL GENSYM ; YES - GENERATE A LOCAL SYMBOL + ; IF NECESSARY. +MAC41: PUSH P,RBYTE ; SAVE ARGUMENT DELIMITER. + MOVEI RBYTE,QUEARG + CALL WTIMT ;MARK END OF ARGUMENT + POP P,RBYTE ; RESTORE DELIMITER BYTE. + CAIN RBYTE,", ; IS IT A COMMA? + IBP RBPTR ; YES - SKIP IT. + SOJG R7,MAC10 ;BRANCH IF MORE ARGS + +MAC50A: MOVEM RBYTE,ARGDEL ; SAVE ARG DELIMITER (FOR .IRP) + +MAC50: ;END OF LINE PROCESSOR + PUSH P,ARGCNT ; Save arg counter + AOS ARGCNT ; INCREMENT ARG COUNT FOR SYM GENERATOR. + CALL GENSYM ; GEN A LOCAL SYMBOL IF NECESSARY. + MOVEI R14,QUEARG + CALL WTIMT ;PAD MISSING ARGS + SOJGE R7,MAC50+1 + POP P,ARGCNT ; Restore arg count + POP P,R10 ; GET POINTER TO CALL BLOCK. + MOVEM R12,0(R10) ;SAVE CURRENT READ POINTER + MOVE R1,CALPNT + MOVEM R1,1(R10) ;SAVE CURRENT CALL BLOCK POINTER + MOVEM R10,CALPNT ;SET NEW POINTER + POP P,R12 ;GET POINTER TO BASIC BLOCK + HRLI R12,(440700,,0) ;FORM A BYTE POINTER + MOVEM R12,2(R10) ;SAVE IT FOR DECMAC + HRRM R14,3(R10) ;SAVE LAST CHARACTER READ + MOVE R14,ARGCNT ; SAVE ARGUMENT COUNT + HRLM R14,3(R10) ; IN MACRO CALL BLOCK. + ADDI R12,3 ;POINT PAST WORD STORAGE + AOS MACLVL + +; SAVE REPEAT AND CONDITIONAL NESTING LEVELS +; FOR LATER USE IF A .MEXIT IS ISSUED. + + MOVE R14,MACLVL ; LOAD MACRO CALL LEVEL + MOVE R0,REPLVL ; SAVE .REPT LEVEL + MOVEM R0,MCLREP(R14) + MOVE R0,CONLVL ; SAVE NEXTED CONDITIONAL LEVEL + MOVEM R0,MCLCON(R14) + MOVE R0,UNSLVL ; SAVE UNSATISFIED COND LEVEL + MOVEM R0,MCLUNS(R14) + + LDB RBYTE,RBPTR ; RESTORE LAST CHARACTER. + RETURN + +MAC70: ;"\" + CALL GETNB ;BYPASS UNARY OP + PUSH P,R7 ;PROTECT ARG COUNT + TLZ R16,FOLBIT ; FOLD TO UPPER CASE FOR EXPR EVALUATION. + CALL ABSEXP ;EVALUATE THE EXPRESSION + TLO R16,FOLBIT ; CEASE FOLDING AGAIN. + CALL MAC71 ;CONVERT TO ASCII + POP P,R7 ;RESTORE ARG COUNT + CALL SETNB ; AND LAST CHARACTER + +MAC70A: CAIE R4,SCLE ; IS EXPR DELIMITER A VALID ARG + CAIN R4,SCSE ; DELIMITER? (",", BLANK, ";", OR EOL) + JRST MAC40 ; YES - DO END-OF-AR PROCESSING. + TRO RERR,ERRQ ; NO -- FLAG QUESTIONABLE SYNTAX + CALL GETNB ; AND SKIP TO VALID DELIMITER. + JRST MAC70A + + + +MAC71: IDIV R10,RADVAL ; DIVIDE NUMBER BY DEFAULT RADIX. + HRLM R11,0(P) + CAIE R10, ;TEST FOR END + CALL MAC71 + HLRZ R14,0(P) + ADDI R14,"0 ;FORM TEXT + CAILE R14,"9 ; CHECK FOR HEX DIGITS A-F. + ADDI R14,"A-"9-1 + JRST WCIMT ;WRITE INTO SKELETON + ; SUBROUTINE GENSYM GENERATES A LOCAL SYMBOL IN THE +; RANGE OF 64$ - 127$ IF AN OMITTED ARGUMENT WAS FLAGGED +; WITH A "?" IN THE MACRO PROTOTYPE. + +GENSYM: MOVEI R0,1 ; TRANSLATE FROM ARGUMENT # + MOVE R1,ARGCNT ; TO A MASK BIT. + ROT R0,-1(R1) + TDNN R0,MARMAS ; DOES THIS ONE WANT A SYMBOL? + RETURN ; NO -- IT'S HAPPY TO BE NULL. + ; YES - .... GROAN. + + MOVE R0,NEXGS ; GET VALUE FOR NEXT GENERATED SYMBOL. + TRZE R0,777400 ; DON'T LET IT EXCEED 127! + TRO RERR,ERRT ; * FLAG TRUNCATION ERROR IF IT DOES. + AOS NEXGS ; SET NEW VALUE FOR NEXT SYMBOL. + + PUSH P,RBYTE ; SAVE CURRENT SOURCE BYTE. + CALL LOCVRT ; CONVERT NUMERIC PART OF LOCAL SYMBOL. + MOVEI RBYTE,"$ ; APPEND "$". + CALL WCIMT ; WRITE IT IN CALL BLOCK. + POP P,RBYTE ; REFURBISH USED REGISTER. + RETURN + +; LOCVRT IS YET ANOTHER VARIANT ON THE UBIQUITOUS +; RECURSIVE SUBROUTINE THAT CONVERTS AN INTEGER +; TO DECIMAL. THIS ONE STUFFS ITS DIGITS INTO +; THE MACRO CALL BLOCK AS A PARAMETER VALUE. + +LOCVRT: IDIVI R0,10. ; PICK OFF THE NEXT DIGIT. + HRLM R1,0(P) ; SAVE IT ON THE STACK. + CAIE R0,0 ; HAS QUOTIENT VANISHED? + CALL LOCVRT ; NO -- DO IT AGAIN. + HLRZ RBYTE,0(P) ; YES - RETRIEVE THE DIGIT. + TRO RBYTE,"0 ; TRANSLATE IT TO ASCII. + JRST WCIMT ; WRITE IN MACRO TREE & RETURN. + + SUBTTL MACRO STORAGE HANDLERS +MACEND: ;END OF MACRO CALL + MOVE R10,CALPNT ;IN CASE WE GOT WIPED + MOVE R12,0(R10) ;RESET PREVIOUS READ POINTER + MOVE R1,1(R10) + MOVEM R1,CALPNT ;LIKEWISE + MOVE R1,2(R10) ;GET POINTER TO BASIC BLOCK + CALL DECMAC ;DECREMENT THE REFERENCE + HRRZ R14,3(R10) ;RESTORE LAST CHARACTER + MOVE R1,R10 + CALL REMMAC ;RETURN THIS BLOCK FOR DEPOSIT + SOS R14,MACLVL ; DECREMENT MACRO CALL DEPTH LEVEL + RETURN ;FINIS + +WTIMT: ;WRITE TWO CHARACTERS IN MACRO TREE + PUSH P,R14 ;STACK CURRENT CHARACTER + MOVEI R14,RUBOUT ;SET FLAG CHARACTER + CALL WCIMT ;WRITE IT + POP P,R14 ;RESTORE CHARCTER AND FALL THROUGH + +WCIMT: ;WRITE CHARACTER IN MACRO TREE + TLZE R15,CONFLG ;CONCATENATION CHARACTER PENDING? + JRST WCIMT2 ; YES, WRITE IT OUT + IBP MWPNTR ;POINT TO ACTUAL WORD + SKIPN @MWPNTR ;END OF BLOCK? + JRST WCIMT1 ; YES, GET ANOTHER + DPB R14,MWPNTR ;NO, STORE BYTE + RETURN ;EXIT + +WCIMT1: PUSH P,MWPNTR ;NEAD A NEW BLOCK, SAVE CURRENT POINTER + CALL GETBLK ;GET IT + HRRZ R11,MWPNTR ;GET START OF NEW BLOCK + EXCH R11,0(P) ;EXCHANGE WITH POINTER TO LAST + POP P,0(R11) ;STORE VECTOR + JRST WCIMT ;TRY AGAIN + +WCIMT2: PUSH P,R14 ;STACK CURRENT CHARACTER + MOVEI R14,"' + CALL WCIMT ;WRITE CONCATENATION CHARACTER + POP P,R14 ;RESTORE CHARACTER + JRST WCIMT ;CONTINUE + + + +; --- MACARG --- + +; .. SUBROUTINE TO GET A MACRO-TYPE ARGUMENT. THE ARGUMENT +; IS A CHARACTER STRING WHICH MAY BE DELIMITED IN ANY OF +; THREE WAYS: + +; STRING@ WHERE "@" REPRESENTS ",", ";", BLANK, TAB, +; OR ANY END-OF-LINE DELIMITER. + +; ^\STRING\ WHERE "\" IS ANY CHARACTER EXCEPT AN END-OF-LINE. + +; [STRING MAY INCLUDE NESTED "<...>" CONSTRUCTIONS] + +; MACARG STORES "STRING" BEGINNING AT LOCATION ARGSTR +; IN ASCIZ FORMAT, AND STORES THE NUMBER OF BYTES IN THE STRING +; IN ARGLEN. + +MACART: TDZA R10,R10 ; FLAG MACRO CALL ENTRY; + +; WHEN ENTERED VIA MACART, THE ARGUMENT BEING PARSED IS +; WRITTEN INTO A MACRO CALL BLOCK. + +MACARG: TRO R10,1 ; FLAG NON-MACRO CALL ENTRY. + PUSH P,R3 ; SAVE WORK REGISTERS. + PUSH P,R4 + SETZM ARGLEN ; INIT STRING LENGTH TO 0. + MOVE R3,[440700,,ARGSTR] ; POINT TO SPACE FOR ARG STRING. + + CALL SETNB ; GET 1ST NONBLANK BYTE. + CAIN R4,SCLE ; Is it end of line? + JRST MAREXA ; YES - ARGUMENT IS NULL. + + CAIN RBYTE,"< ; IS STRING BRACKETED? + JRST MARBRA + CAIN RBYTE,"^ ; IS IT "^" CONSTRUCTION? + JRST MARAR + + +; STRING OF FIRST TYPE; COLLECT UP TO A SEPARATOR. + +MARSTR: CAIN R4,SCSE ; Check for a separator. + JRST MAREXA + +; ** CHARACTER ISN'T A DELIMITER; APPEND IT TO THE STRING +; BEING COLLECTED & INCREMENT ITS LENGTH. + + CALL SMB ; STORE THE CHARACTER. + CALL GETNT ; GET NEXT BYTE + JRST MAREXA ; .. END OF LINE => QUIT. + JRST MARSTR ; GO BACK TO CHECK NEW BYTE. + + +MARERR: TRO RERR,ERRQ ;<<<< UNEXPECTED END OF LINE + +MAREX: CALL TSTNT ; IS STRING DELIMITED BY END OF LINE? + CAIA ; YES -- DON'T SKIP DELIMITER. + CALL GETNB ; NO --- SKIP DELIMITER. +MAREXA: SETZ R4, ; APPEND A 0 BYTE TO THE STRING. + IDPB R4,R3 + POP P,R4 ; RESTORE REGISTER CONTENTS. + POP P,R3 + RETURN ; ... RETURN TO CALLER ... + + + +; "^\....\" + +MARAR: CALL GETNT ; SKIP "^". + JRST MARERR ; CAN'T TOLERATE END OF LINE HERE. + MOVE R1,RBYTE ; SAVE DELIMITER IN R1. + +MARARB: CALL GETNT ; GET NEXT BYTE OF STRING. + JRST MARERR ; .. CAN'T BE END OF LINE. + CAMN RBYTE,R1 ; IS THIS THE DELIMITER? + JRST MAREX ; YES - QUIT HERE. + CALL SMB ; NO -- STORE THE BYTE. + JRST MARARB ; KEEP ON TRUCKIN' + + + +; "<.....>" + +MARBRA: MOVEI R1,1 ; SET BRACKET LEVEL TO 1. + +MARB: CALL GETNT ; GET NEXT BYTE. + JRST MARERR ; .. CAN'T BE END OF LINE. + CAIN RBYTE,"< ; IS IT NESTED MACRO ARG? + AOJ R1, ; YES .. INCR NEST LEVEL + CAIE RBYTE,"> ; IS IT END OF A BRACKETED STRING? + JRST MARBS ; NO .. JUST A STRING BYTE. + SOJLE R1,MAREX ; YES .. DECR NEST LEVEL + ; BUT QUIT AT OUTERMOST ">" + +MARBS: CALL SMB ; APPEND BYTE TO THE STRING. + JRST MARB ; GO BACK FOR MORE. + + +SMB: IDPB RBYTE,R3 ; STORE NEXT BYTE IN ARG STRING. + AOS ARGLEN ; INCREMENT STRING LENGTH. + TRNN R10,1 ; BUILDING A CALL BLOCK? + CALL WCIMT ; YES - ALSO WRITE INTO TREE. + RETURN + + +;**************** + SUBTTL SYMBOL TABLE HANDLERS + +; Symbol table entry format: + +; @SYMPNT Symbol in rad50 format +; Bit 0 = 1 => symbol is macro name + +; @VALPNT Left half: Attribute bits +; Right half: Value + +; Remaining two words contain cross-ref info: + +; @CR1PNT Left half: Line # of symbol definition +; Right half: Line # of first reference + +; @CR2PNT Left half: Line # of second reference +; Right half: Link to reference block + +; 0 in any cross-ref field => "none". +DELTA: BLOCK 1 ;BINARY SEARCH OFFSET + + +MSRCH: TLOA R0,MACBIT +SSRCH: ;SYMBOL SEARCH + TLZ R0,MACBIT + MOVE R7,DELTA ;SET OFFSET FOR INDEX + MOVE R2,R7 + ASH R2,-1 ;SET INCREMENT +SSRCH1: CAMGE R0,@SYMPNT ;ARE WE LOOKING ABOVE SYMBOL? + JRST SSRCH2 ; YES, MOVE DOWN + CAMG R0,@SYMPNT ;NO, POSSIBLY AT IT? + JRST SSRCH4 ; YES + TDOA R7,R2 ; NO, INCREMENT INDEX +SSRCH2: SUB R7,R2 ;DECREMENT INDEX + ASH R2,-1 ;DECREMENT DELTA + CAIG R2,1 ; Is DELTA too small now? + JRST SSRCH3 ; Yes - No such symbol defined. + CAMG R7,SYMLEN ; No -- Out of bounds? + JRST SSRCH1 ; No -- Check this entry. + JRST SSRCH2 ; Yes - Move back down. + +SSRCH3: SETZB R1,R2 + SUBI R7,2 ; Set index to start (not middle!) + RETURN ; of entry and take not-found exit. + +SSRCH4: MOVE R1,@VALPNT ;FOUND, FETCH VALUE + LDB R2,TYPPNT ;SET TYPE POINTER + JRST CPOPJ1 ;EXIT +1 + + SUBTTL OP CODE TABLE + +TYPOFF== 17. ;PACKING PARAMETERS +SUBOFF== 15. +LENOFF== 11. + +BC1== 1 +BC2== 2 + +;;TYPPNT: POINT 2,R1,TYPOFF ;TYPE POINTER +;;SUBPNT: POINT 4,R1,SUBOFF ;SUB-TYPE POINTER +;;LENPNT: POINT 2,R1,LENOFF ;INSTRUCTION LENGTH POINTER +;;CCSPNT: POINT 8,R5,SUBOFF ;CURRENT CSECT POINTER + +typpnt: <<35.-typoff>_12.>+000200,,r1 +subpnt: <<35.-suboff>_12.>+000400,,r1 +lenpnt: <<35.-lenoff>_12.>+000200,,r1 + +MACBIT== 400000 + +;;PFMASK== 377B +pfmask==377_<35.-suboff> +ADMASK== 177777 +;;;;PCMASK== PFMASK\ADMASK +PCMASK== ADMASK + +DEFINE OP A,B,C,D,E,F,TYPE,LENGTH,VALUE + GENM40 A,B,C,D,E,F + _2>\<_6>>,,VALUE +TERMIN + +DEFINE DIRDEF A,B,C,D,E,F,ADDRESS + GENM40 A,B,C,D,E,F + DIOP,,ADDRESS +TERMIN + +OPTBOT: ;OP TABLE BOTTOM + OP A,C,I,,,,0,1,316 ; ACI CE + OP A,D,C,,,,8,0,ADCTAB ; ADC [88 or Z80 op] + OP A,D,D,,,,8,0,ADDTAB ; ADD [80 or Z80 op] + OP A,D,I,,,,0,1,306 ; ADI C6 + OP A,N,A,,,,1,0,240 ; ANA A0 + OP A,N,D,,,,8,0,ANDTAB ; AND [Z80 op] + OP A,N,I,,,,0,1,346 ; ANI E6 + OP B,I,T,,,,8,0,BITTAB ; BIT [Z80 op] + OP C,A,L,L,,,9,0,4 ; CALL [CD & Z80 op] + OP C,C,,,,,0,2,334 ; CC DC + OP C,C,F,,,,0,0,077 ; CCF 3F [Z80 op for CMC] + OP C,M,,,,,0,2,374 ; CM FC + OP C,M,A,,,,0,0,057 ; CMA 2F + OP C,M,C,,,,0,0,077 ; CMC 3F + OP C,M,P,,,,1,0,270 ; CMP B8 + OP C,N,C,,,,0,2,324 ; CNC D4 + OP C,N,Z,,,,0,2,304 ; CNZ C4 +;;;; OP C,P,,,,,0,2,364 ; CP F4 +;;;; OP C,P,,,,,8,0,CPTAB ; CP [Z80 op] + DIRDEF C,P,,,,,CPOP +;****************************************************************** +; CP assembles as either a Z80 compare or an 8080 call-if-positive, +; depending on the setting of Z80FLG. +;****************************************************************** + + OP C,P,D,,,,8,0,CPDTAB ; CPD [Z80 op] + OP C,P,D,R,,,8,0,CPDRTB ; CPDR [Z80 op] + OP C,P,E,,,,0,2,354 ; CPE EC + OP C,P,I,,,,8,0,CPITAB ; CPI [May be Z80 op] + OP C,P,I,R,,,8,0,CPIRTB ; CPIR [Z80 op] + OP C,P,L,,,,0,0,057 ; CPL 2F [Z80 op for CMA] + OP C,P,O,,,,0,2,344 ; CPO E4 + OP C,Z,,,,,0,2,314 ; CZ CC + OP D,A,A,,,,0,0,047 ; DAA 27 + OP D,A,D,,,,4,0,011 ; DAD 09 + DIRDEF D,B,,,,,DB + OP D,C,R,,,,2,0,005 ; DCR 05 + OP D,C,X,,,,4,0,013 ; DCX 0B + OP D,E,C,,,,8,0,DECTAB ; DEC [Z80 op] + OP D,I,,,,,0,0,363 ; DI F3 + DIRDEF D,I,S,A,B,L,.DSABL + OP D,J,N,Z,,,9,0,3 ; DJNZ [Z80 instruction] + DIRDEF D,S,,,,,DS + DIRDEF D,W,,,,,DW + OP E,I,,,,,0,0,373 ; EI FB + DIRDEF E,N,A,B,L,E,.ENABL + DIRDEF E,N,D,,,,..END +ENDIF: DIRDEF E,N,D,I,F,,ENDC0 +ENDM: DIRDEF E,N,D,M,,,.ENDM + DIRDEF E,Q,U,,,,EQU + OP E,X,,,,,8,0,EXTAB ; EX [Z80 op] + OP E,X,X,,,,0,0,331 ; EXX [Z80 op] + OP H,A,L,T,,,0,0,166 ; HALT 76 [Z80 op for HLT] + OP H,L,T,,,,0,0,166 ; HLT 76 +IF: DIRDEF I,F,,,,,INIF + OP I,M,0,,,,8,0,IM0TAB ; IM0 [Z80 op] + OP I,M,1,,,,8,0,IM1TAB ; IM1 [Z80 op] + OP I,M,2,,,,8,0,IM2TAB ; IM2 [Z80 op] + OP I,N,,,,,8,0,INTAB ; IN [DB or Z80 op] + OP I,N,C,,,,8,0,INCTAB ; INC [Z80 op] + OP I,N,D,,,,8,0,INDTAB ; IND [Z80 op] + OP I,N,D,R,,,8,0,INDRTB ; INDR [Z80 op] + OP I,N,I,,,,8,0,INITAB ; INI [Z80 op] + OP I,N,I,R,,,8,0,INIRTB ; INIR [Z80 op] + OP I,N,R,,,,2,0,004 ; INR 04 + OP I,N,X,,,,4,0,003 ; INX 03 + OP J,C,,,,,0,2,332 ; JC DA + OP J,M,,,,,0,2,372 ; JM FA + OP J,M,P,,,,0,2,303 ; JMP C3 + OP J,N,C,,,,0,2,322 ; JNC D2 + OP J,N,Z,,,,0,2,302 ; JNZ C2 + OP J,P,,,,,9,0,0 ; JP [F2 orZ80 op] +;************************************************************* +; JP is ambiguous between 8080 & Z80 assembly language; +; Which way it assembles depends on the setting of Z80FLG +; (set by "enable z80flg" or "disabl z80flg"). +;************************************************************* + + OP J,P,E,,,,0,2,352 ; JPE EA + OP J,P,O,,,,0,2,342 ; JPO E2 + OP J,R,,,,,9,0,1 ; JR [Z80 op] + OP J,R,P,,,,9,0,2 ; JRP [Z80 op, JR or JP] + OP J,Z,,,,,0,2,312 ; JZ CA + OP L,D,,,,,8,0,LDTAB ; LD [Z80 instructions] + OP L,D,A,,,,0,2,072 ; LDA 3A + OP L,D,A,X,,,7,0,012 ; LDAX 0A + OP L,D,D,,,,8,0,LDDTAB ; LDD [Z80 op] + OP L,D,D,R,,,8,0,LDDRTB ; LDDR [Z80 op] + OP L,D,I,,,,8,0,LDITAB ; LDI [Z80 op] + OP L,D,I,R,,,8,0,LDIRTB ; LDIR [Z80 op] + OP L,H,L,D,,,0,2,052 ; LHLD 2A + DIRDEF L,I,S,T,,,.LIST + OP L,X,I,,,,4,2,001 ; LXI 01 +MACRO: DIRDEF M,A,C,R,O,,DEFIN0 + DIRDEF M,E,X,I,T,,.MEXIT + OP M,O,V,,,,3,0,100 ; MOV 40 + OP M,V,I,,,,2,1,006 ; MVI 06 + DIRDEF N,A,R,G,,,.NARG + DIRDEF N,C,H,R,,,.NCHR + OP N,E,G,,,,8,0,NEGTAB ; NEG [Z80 op] + DIRDEF N,L,I,S,T,,.NLIST + OP N,O,P,,,,0,0,000 ; NOP 00 + OP O,R,,,,,8,0,ORTAB ; OR [Z80 op] + OP O,R,A,,,,1,0,260 ; ORA B0 + DIRDEF O,R,G,,,,ORG + OP O,R,I,,,,0,1,366 ; ORI F6 + OP O,T,D,R,,,8,0,OTDRTB ; OTDR [Z80 op] + OP O,T,I,R,,,8,0,OTIRTB ; OTIR [Z80 op] + OP O,U,T,,,,8,0,OUTTAB ; OUT [D3 or Z80 op] + OP O,U,T,D,,,8,0,OUTDTB ; OUTD [Z80 op] + OP O,U,T,I,,,8,0,OUTITB ; OUTI [Z80 op] + DIRDEF P,A,G,E,,,.PAGE + OP P,C,H,L,,,0,0,351 ; PCHL E9 + OP P,O,P,,,,8,0,POPTAB ; POP [C1 or Z80 instr] + OP P,U,S,H,,,8,0,PUSHTB ; PUSH [C5 or Z80 instr] + DIRDEF R,A,D,I,X,,..RADIX + OP R,A,L,,,,0,0,027 ; RAL 17 + OP R,A,R,,,,0,0,037 ; RAR 1F + OP R,C,,,,,0,0,330 ; RC D8 + OP R,E,S,,,,8,0,RESTAB ; RES [Z80 op] + OP R,E,T,,,,9,0,5 ; RET [C9 & Z80 op] + OP R,E,T,I,,,8,0,RETITB ; RETI [Z80 op] + OP R,E,T,N,,,8,0,RETNTB ; RETN [Z80 op] + OP R,I,M,,,,0,0,040 ; RIM 20 [8085 op] + OP R,L,,,,,8,0,RLTAB ; RL [Z80 op] + OP R,L,A,,,,0,0,027 ; RLA 17 [Z80 op for RAL] + OP R,L,C,,,,8,0,RLCTAB ; RLC 07 or Z80 op + OP R,L,C,A,,,0,0,007 ; TLCA 07 [Z80 op for RLC] + OP R,L,D,,,,8,0,RLDTAB ; RLD [Z80 op] + OP R,M,,,,,0,0,370 ; RM F8 + OP R,N,C,,,,0,0,320 ; RNC D0 + OP R,N,Z,,,,0,0,300 ; RNZ C0 + OP R,P,,,,,0,0,360 ; RP F0 + OP R,P,E,,,,0,0,350 ; RPE E8 + OP R,P,O,,,,0,0,340 ; RPO E0 + OP R,R,,,,,8,0,RRTAB ; RR [Z80 op] + OP R,R,A,,,,0,0,037 ; RRA 1F [Z80 op for RAR] + OP R,R,C,,,,8,0,RRCTAB ; RRC 0F or Z80 op + OP R,R,C,A,,,0,0,017 ; RRCA 0F [Z80 op for RRC] + OP R,R,D,,,,8,0,RRDTAB ; RRD [Z80 op] + OP R,S,T,,,,6,0,307 ; RST C7 + OP R,Z,,,,,0,0,310 ; RZ C8 + OP S,B,B,,,,1,0,230 ; SBB 98 + OP S,B,C,,,,8,0,SBCTAB ; SBC [Z80 op] + OP S,B,I,,,,0,1,336 ; SBI DE + OP S,C,F,,,,0,0,067 ; SCF 37 [Z80 op for STC] + DIRDEF S,E,T,,,,SET +;*************************************************************** +; SET is ambiguous: If Z80FLG is set, SET directive +; processing enters Z80PRS to assemble a Z80 bit-set +; operation; otherwise it handles an 8080 assembly-time +; assignment. SETT is synonymous with 8080 SET, even +; when Z80FLG is set. +;*************************************************************** + + DIRDEF S,E,T,T,,,SET80 ; Z80 version of 8080 SET + OP S,H,L,D,,,0,2,042 ; SHLD 22 + OP S,I,M,,,,0,0,060 ; SIM 30 [8085 op] + DIRDEF S,K,I,P,,,SKIP. + OP S,L,A,,,,8,0,SLATAB ; SLA [Z80 op] + OP S,P,H,L,,,0,0,371 ; SPHL F9 + OP S,R,A,,,,8,0,SRATAB ; SRA [Z80 op] + OP S,R,L,,,,8,0,SRLTAB ; SRL [Z80 op] + OP S,T,A,,,,0,2,062 ; STA 32 + OP S,T,A,X,,,7,0,002 ; STAX 02 + OP S,T,C,,,,0,0,067 ; STC 37 + OP S,U,B,,,,8,0,SUBTAB ; SUB [90 or Z80 op] + DIRDEF S,U,B,H,E,D,.SBHED + DIRDEF S,U,B,T,T,L,.SBTTL + OP S,U,I,,,,0,1,326 ; SUI D6 + DIRDEF T,I,T,L,E,,.TITLE + OP X,C,H,G,,,0,0,353 ; XCHG EB + OP X,O,R,,,,8,0,XORTAB ; XOR [Z80 op] + OP X,R,A,,,,1,0,250 ; XRA A8 + OP X,R,I,,,,0,1,356 ; XRI EE + OP X,T,H,L,,,0,0,343 ; XTHL E3 + DIRDEF .,C,K,S,U,M,.CKSUM + DIRDEF .,E,R,R,O,R, .ERROR +;; DIRDEF .,G,L,O,B,L,.GLOBL +.IFX: DIRDEF .,I,F,,,,.IF +.IFFX: DIRDEF .,I,F,F,,,.IFF +.IFTX: DIRDEF .,I,F,T,,,.IFT +.IFTFX: DIRDEF .,I,F,T,F,,.IFTF +.IFY: DIRDEF .,I,I,F,,,.IIF + DIRDEF .,I,N,S,E,R,.INSERT +.IRPOP: DIRDEF .,I,R,P,,,.IRP +.IRCOP: DIRDEF .,I,R,P,C,,.IRPC +;; DIRDEF .,L,I,M,I,T,.LIMIT + DIRDEF .,O,P,D,E,F,.OPDEF + DIRDEF .,P,R,I,N,T,.PRINT +;; DIRDEF .,P,S,E,C,T,PSECT +.REPTX: DIRDEF .,R,E,P,T,,REPEA0 +OPTTOP: -1_-1 ;OP TABLE TOP + + SUBTTL Z80 Parse tables for individual mnemonics + +; Table entry format: +; XWD type,value ; Type & value code for 1st operand +; XWD type,value ; Type & value code for 2nd operand +; XWD format,memopcode +; BYTE (8) [op skeleton] + + + + +; Operand type & value codes are . . . + +; Type code Value +; --------- ----- + +; [null] 0 0 +; register: 1 [also called regm] +; B 0 +; C 1 +; D 2 +; E 3 +; H 4 +; L 5 +; M 6 +; A 7 +; register pair: 2 +; BC 0 +; DE 1 +; HL 2 +; SP 3 +; AF 4 +; AF' 5 +; special registers: 3 +; I 0 +; IX 1 +; IY 2 +; R 3 +; Indirect: 4 +; (HL) 0 +; (DE) 1 +; (BC) 2 +; (SP) 3 +; (IX) 4 +; (IY) 5 +; (C) 6 +; (IX+d) 5 d +; (IY+d) 6 d +; expr 7 expr +; (expr) 8 expr + +; Memopcode (memory operands code) is . . . + +; 0 No memory operands are appended to basic op skeleton +; 1 Op1 is a 1-byte memory operand +; 2 Op2 is a 1-byte memory operand +; 3 Op1 is a 2-byte memory operand +; 4 Op2 is a 2-byte memory operand +; 5 Op1 & op2 are both 1-byte memory operands + + + + + +; Format codes & the instruction formats they represent . . . +; -- All formats except 13 & 15 may be followed by +; a one-byte operand, a two-byte operand, or +; two one-byte operands. + + + + +; --------------------------------- +; Format 0: ! opcode ! +; --7---6---5---4---3---2---1---0-- + + + +; --------------------------------- +; Format 1: ! opcode ! regm ! +; --7---6---5---4---3---2---1---0-- + + + +; --------------------------------- +; Format 2: ! op ! regm ! op ! +; --7---6---5---4---3---2---1---0-- + + + +; --------------------------------- +; Format 3: ! op ! regm ! regm ! +; --7---6---5---4---3---2---1---0-- + + + +; --------------------------------- +; Format 4: ! op ! rp[1] ! op ! +; --7---6---5---4---3---2---1---0-- + + + +; --------------------------------- +; Format 5: ! op ! rp5 ! op ! +; --7---6---5---4---3---2---1---0-- + + + +; --------------------------------- +; Format 6: ! op ! rp[2] ! op ! +; --7---6---5---4---3---2---1---0-- + + + +; --------------------------------- +; Format 7: ! op ! rp7 ! op ! +; --7---6---5---4---3---2---1---0-- + + + +; --------------------------------- +; ! opcode ! +; Format 8: --7---6---5---4---3---2---1---0-- +; ! opcode ! +; --7---6---5---4---3---2---1---0-- + + + +; --------------------------------- +; ! opcode ! +; Format 9: --7---6---5---4---3---2---1---0-- +; ! opcode ! reg ! +; --7---6---5---4---3---2---1---0-- + + + +; --------------------------------- +; ! opcode ! +; Format 10: --7---6---5---4---3---2---1---0-- +; ! op ! reg ! op ! +; --7---6---5---4---3---2---1---0-- + + + +; --------------------------------- +; ! opcode ! +; Format 11: --7---6---5---4---3---2---1---0-- +; ! op ! rp[1] ! op ! +; --7---6---5---4---3---2---1---0-- + + + +; --------------------------------- +; ! opcode ! +; Format 12: --7---6---5---4---3---2---1---0-- +; ! op ! rp[2] ! op ! +; --7---6---5---4---3---2---1---0-- + + + +; --------------------------------- +; ! opcode ! +; --7---6---5---4---3---2---1---0-- +; ! opcode ! +; Format 13: --7---6---5---4---3---2---1---0-- +; ! displacement value ! +; --7---6---5---4---3---2---1---0-- +; ! opcode ! +; --7---6---5---4---3---2---1---0-- + + + +; --------------------------------- +; ! opcode ! +; Format 14: --7---6---5---4---3---2---1---0-- +; ! op ! bit ! reg ! +; --7---6---5---4---3---2---1---0-- + + + +; --------------------------------- +; ! opcode ! +; --7---6---5---4---3---2---1---0-- +; ! opcode ! +; Format 15: --7---6---5---4---3---2---1---0-- +; ! displacement value ! +; --7---6---5---4---3---2---1---0-- +; ! op ! bit ! op ! +; --7---6---5---4---3---2---1---0-- + +LDTAB: ; LD + 1,,-1 + 1,,-1 ; LD r,r' + 3,,0 + .BYTE 8 ? 100 ? .BYTE + + 1,,-1 + 7,,-1 ; LD r,n + 2,,2 + .BYTE 8 ? 006 ? .BYTE + + 1,,-1 + 4,,0 ; LD r,(HL) + 3,,0 + .BYTE 8 ? 106 ? .BYTE + + 1,,-1 + 5,,-1 ; LD r,(IX+d) + 10.,,2 + .BYTE 8 ? 335 ? 106 ? .BYTE + + 1,,-1 + 6,,-1 ; LD r,(IY+d) + 10.,,2 + .BYTE 8 ? 375 ? 106 ? .BYTE + + 4,,0 + 1,,-1 ; LD (HL),r + 3,,0 + .BYTE 8 ? 160 ? .BYTE + + 5,,-1 + 1,,-1 ; LD (IX+d),r + 9.,,1 + .BYTE 8 ? 335 ? 160 ? .BYTE + + 6,,-1 + 1,,-1 ; LD (IY+d),r + 9.,,1 + .BYTE 8 ? 375 ? 160 ? .BYTE + + 4,,0 + 7,,-1 ; LD (HL),n + 2,,2 + .BYTE 8 ? 066 ? .BYTE + + 5,,-1 + 7,,-1 ; LD (IX+d),n + 8,,5 + .BYTE 8 ? 335 ? 066 ? .BYTE + + 6,,-1 + 7,,-1 ; LD (IY+d),n + 8,,5 + .BYTE 8 ? 375 ? 066 ? .BYTE + + 1,,7 + 4,,2 ; LD A,(BC) + 0,,0 + .BYTE 8 ? 012 ? .BYTE + + 1,,7 + 4,,1 ; LD A,(DE) + 0,,0 + .BYTE 8 ? 032 ? .BYTE + + 1,,7 + 8,,-1 ; LD A,(nn) + 2,,4 + .BYTE 8 ? 072 ? .BYTE + + 4,,2 + 1,,7 ; LD (BC),A + 0,,0 + .BYTE 8 ? 002 ? .BYTE + + 4,,1 + 1,,7 ; LD (DE),A + 0,,0 + .BYTE 8 ? 022 ? .BYTE + + 8,,-1 + 1,,7 ; LD (nn),A + 0,,3 + .BYTE 8 ? 062 ? .BYTE + + 1,,7 + 3,,0 ; LD A,I + 8,,0 + .BYTE 8 ? 355 ? 127 ? .BYTE + + 1,,7 + 3,,3 ; LD A,R + 8,,0 + .BYTE 8 ? 355 ? 137 ? .BYTE + + 3,,0 + 1,,7 ; LD I,A + 8,,0 + .BYTE 8 ? 355 ? 107 ? .BYTE + + 3,,3 + 1,,7 ; LD R,A + 8,,0 + .BYTE 8 ? 355 ? 117 ? .BYTE + + 2,,-1 + 7,,-1 ; LD dd,nn + 4,,4 + .BYTE 8 ? 001 ? .BYTE + + 3,,1 + 7,,-1 ; LD IX,nn + 8,,4 + .BYTE 8 ? 335 ? 041 ? .BYTE + + 3,,2 + 7,,-1 ; LD IY,nn + 8,,4 + .BYTE 8 ? 375 ? 041 ? .BYTE + + 2,,2 + 8,,-1 ; LD HL,(nn) + 0,,4 + .BYTE 8 ? 052 ? .BYTE + + 2,,-1 + 8,,-1 ; LD dd,(nn) + 11.,,4 + .BYTE 8 ? 355 ? 113 ? .BYTE + + 3,,1 + 8,,-1 ; LD IX,(nn) + 8,,4 + .BYTE 8 ? 335 ? 052 ? .BYTE + + 3,,2 + 8,,-1 ; LD IY,(nn) + 8,,4 + .BYTE 8 ? 375 ? 052 ? .BYTE + + 8,,-1 + 2,,2 ; LD (nn),HL + 0,,3 + .BYTE 8 ? 042 ? .BYTE + +;;;; 8,,-1 +;;;; 2,,-1 ; LD (nn),dd +;;;; 11.,,3 +;;;; .BYTE 8 ? 355 ? 103 ? .BYTE + + 8,,-1 + 2,,0 ; LD (nn),BC + 8,,3 + .BYTE 8 ? 355 ? 103 ? .BYTE + + 8,,-1 + 2,,1 ; LD (nn),DE + 8,,3 + .BYTE 8 ? 355 ? 123 ? .BYTE + + 8,,-1 + 2,,3 ; LD (nn),SP + 8,,3 + .BYTE 8 ? 355 ? 163 ? .BYTE + + 8,,-1 + 3,,1 ; LD (nn),IX + 8,,3 + .BYTE 8 ? 335 ? 042 ? .BYTE + + 8,,-1 + 3,,2 ; LD (nn),IY + 8,,3 + .BYTE 8 ? 375 ? 042 ? .BYTE + + 2,,3 + 2,,2 ; LD SP,HL + 0,,0 + .BYTE 8 ? 371 ? .BYTE + + 2,,3 + 3,,1 ; LD SP,IX + 8,,0 + .BYTE 8 ? 335 ? 371 ? .BYTE + + 2,,3 + 3,,2 ; LD SP,IY + 8,,0 + .BYTE 8 ? 375 ? 371 ? .BYTE + + 0 ; End of LD parse table + + + + + +PUSHTB: ; PUSH + 2,,-1 + 0 ; PUSH qq + 5,,0 + .BYTE 8 ? 305 ? .BYTE + + 3,,1 + 0 ; PUSH IX + 8,,0 + .BYTE 8 ? 335 ? 345 ? .BYTE + + 3,,2 + 0 ; PUSH IY + 8,,0 + .BYTE 8 ? 375 ? 345 ? .BYTE + + 1,,0 + 0 ; PUSH B [8080 syntax] + 0 + .BYTE 8 ? 305 ? .BYTE + + 1,,2 + 0 ; PUSH D [8080 syntax] + 0 + .BYTE 8 ? 325 ? .BYTE + + 1,,4 + 0 ; PUSH H [8080 syntax] + 0 + .BYTE 8 ? 345 ? .BYTE + + 0 ; End of PUSH parse table + + +POPTAB: ; POP + 2,,-1 + 0 ; POP qq + 5,,0 + .BYTE 8 ? 301 ? .BYTE + + 3,,1 + 0 ; POP IX + 8,,0 + .BYTE 8 ? 335 ? 341 ? .BYTE + + 3,,2 + 0 ; POP IY + 8,,0 + .BYTE 8 ? 375 ? 341 ? .BYTE + + 1,,0 + 0 ; POP B [8080 syntax] + 0 + .BYTE 8 ? 301 ? .BYTE + + 1,,2 + 0 ; POP D [8080 syntax] + 0 + .BYTE 8 ? 321 ? .BYTE + + 1,,4 + 0 ; POP H [8080 syntax] + 0 + .BYTE 8 ? 341 ? .BYTE + + 0 ; End of POP parse table + + + +EXTAB: ; EX + 2,,1 + 2,,2 ; EX DE,HL + 0 + .BYTE 8 ? 353 ? .BYTE + + 2,,4 + 2,,5 ; EX AF,AF' + 0 + .BYTE 8 ? 010 ? .BYTE + + 4,,3 + 2,,2 ; EX (SP),HL + 0 + .BYTE 8 ? 343 ? .BYTE + + 4,,3 + 3,,1 ; EX (SP),IX + 8,,0 + .BYTE 8 ? 335 ? 343 ? .BYTE + + 4,,3 + 3,,2 ; EX (SP),IY + 8,,0 + .BYTE 8 ? 375 ? 343 ? .BYTE + + 0 ; End of EX parse table + + + + + +LDITAB: ; LDI + 0 + 0 ; LDI + 8,,0 + .BYTE 8 ? 355 ? 240 ? .BYTE + + 0 ; End of LDI parse table + + + + + +LDIRTB: ; LDIR + 0 + 0 ; LDIR + 8,,0 + .BYTE 8 ? 355 ? 260 ? .BYTE + + 0 ; End of LDIR parse table + + + + + +LDDTAB: ; LDD + 0 + 0 ; LDD + 8,,0 + .BYTE 8 ? 355 ? 250 ? .BYTE + + 0 ; End of LDD parse table + + + + + +LDDRTB: ; LDDR + 0 + 0 ; LDDR + 8,,0 + .BYTE 8 ? 355 ? 270 ? .BYTE + + 0 ; End of LDDR parse table + + +CPITAB: ; CPI + 0 + 0 ; CPI + 8,,0 + .BYTE 8 ? 355 ? 241 ? .BYTE + + 7,,-1 + 0 ; CPI n [8080 instruction] + 0,,1 + .BYTE 8 ? 376 ? .BYTE + + 0 ; End of CPI parse table + + + + + +CPIRTB: ; CPIR + 0 + 0 ; CPIR + 8,,0 + .BYTE 8 ? 355 ? 261 ? .BYTE + + 0 ; End of CPIR parse table + + +CPDTAB: ; CPD + 0 + 0 ; CPD + 8,,0 + .BYTE 8 ? 355 ? 251 ? .BYTE + + 0 ; End of CPD parse table + + + + + +CPDRTB: ; CPDR + 0 + 0 ; CPDR + 8,,0 + .BYTE 8 ? 355 ? 271 ? .BYTE + + 0 ; End of CPDR parse table + + + + + +ADDTAB: ; ADD + 1,,7 + 1,,-1 ; ADD A,r + 1,,0 + .BYTE 8 ? 200 ? .BYTE + + 1,,7 + 7,,-1 ; ADD A,n + 0,,2 + .BYTE 8 ? 306 ? .BYTE + + 1,,7 + 4,,0 ; ADD A,(HL) + 0,,0 + .BYTE 8 ? 206 ? .BYTE + + 1,,7 + 5,,-1 ; ADD A,(IX+d) + 8,,2 + .BYTE 8 ? 335 ? 206 ? .BYTE + + 1,,7 + 6,,-1 ; ADD A,(IY+d) + 8,,2 + .BYTE 8 ? 375 ? 206 ? .BYTE + + 1,,-1 + 0 ; ADD r [8080 syntax] + 1,,0 + .BYTE 8 ? 200 ? .BYTE + + 2,,2 + 2,,-1 ; ADD HL,ss + 6,,0 + .BYTE 8 ? 011 ? .BYTE + + 3,,1 + 2,,0 ; ADD IX,BC + 8,,0 + .BYTE 8 ? 335 ? 011 ? .BYTE + + 3,,1 + 2,,1 ; ADD IX,DE + 8,,0 + .BYTE 8 ? 335 ? 031 ? .BYTE + + 3,,1 + 3,,1 ; ADD IX,IX + 8,,0 + .BYTE 8 ? 335 ? 051 ? .BYTE + + 3,,1 + 2,,3 ; ADD IX,SP + 8,,0 + .BYTE 8 ? 335 ? 071 ? .BYTE + + 3,,2 + 2,,0 ; ADD IY,BC + 8,,0 + .BYTE 8 ? 375 ? 011 ? .BYTE + + 3,,2 + 2,,1 ; ADD IY,DE + 8,,0 + .BYTE 8 ? 375 ? 031 ? .BYTE + + 3,,2 + 3,,2 ; ADD IY,IY + 8,,0 + .BYTE 8 ? 375 ? 051 ? .BYTE + + 3,,2 + 2,,3 ; ADD IY,SP + 8,,0 + .BYTE 8 ? 375 ? 071 ? .BYTE + + 0 ; End of ADD parse table + + + + + +ADCTAB: ; ADC + 1,,7 + 1,,-1 ; ADC A,r + 1,,0 + .BYTE 8 ? 210 ? .BYTE + + 1,,7 + 7,,-1 ; ADC A,n + 0,,2 + .BYTE 8 ? 316 ? .BYTE + + 1,,7 + 4,,0 ; ADC A,(HL) + 0,,0 + .BYTE 8 ? 216 ? .BYTE + + 1,,7 + 5,,-1 ; ADC A,(IX+d) + 8,,2 + .BYTE 8 ? 335 ? 216 ? .BYTE + + 1,,7 + 6,,-1 ; ADC A,(IY+d) + 8,,2 + .BYTE 8 ? 375 ? 216 ? .BYTE + + 1,,-1 + 0 ; ADC r [8080 syntax] + 1,,0 + .BYTE 8 ? 210 ? .BYTE + + 2,,2 + 2,,-1 ; ADC HL,ss + 12.,,0 + .BYTE 8 ? 355 ? 112 ? .BYTE + + 0 ; End of ADC parse table + + + + + +SUBTAB: ; SUB + 1,,-1 + 0 ; SUB r + 1,,0 + .BYTE 8 ? 220 ? .BYTE + + 7,,-1 + 0 ; SUB n + 0,,1 + .BYTE 8 ? 326 ? .BYTE + + 4,,0 + 0 ; SUB (HL) + 0,,0 + .BYTE 8 ? 226 ? .BYTE + + 5,,-1 + 0 ; SUB (IX+d) + 8,,1 + .BYTE 8 ? 335 ? 226 ? .BYTE + + 6,,-1 + 0 ; SUB (IY+d) + 8,,1 + .BYTE 8 ? 375 ? 226 ? .BYTE + + 0 ; End of SUB parse table + + + +SBCTAB: ; SBC + 1,,7 + 1,,-1 ; SBC A,r + 1,,0 + .BYTE 8 ? 230 ? .BYTE + + 1,,7 + 7,,-1 ; SBC A,n + 0,,2 + .BYTE 8 ? 336 ? .BYTE + + 1,,7 + 4,,0 ; SBC A,(HL) + 0,,0 + .BYTE 8 ? 236 ? .BYTE + + 1,,7 + 5,,-1 ; SBC A,(IX+d) + 8,,2 + .BYTE 8 ? 335 ? 236 ? .BYTE + + 1,,7 + 6,,-1 ; SBC A,(IY+d) + 8,,2 + .BYTE 8 ? 375 ? 236 ? .BYTE + + 2,,2 + 2,,-1 ; SBC HL,ss + 12.,,0 + .BYTE 8 ? 355 ? 102 ? .BYTE + + 0 ; End of SBC parse table + + + + + +ANDTAB: ; AND + 1,,-1 + 0 ; AND r + 1,,0 + .BYTE 8 ? 240 ? .BYTE + + 7,,-1 + 0 ; AND n + 0,,1 + .BYTE 8 ? 346 ? .BYTE + + 4,,0 + 0 ; AND (HL) + 0,,0 + .BYTE 8 ? 246 ? .BYTE + + 5,,-1 + 0 ; AND (IX+d) + 8,,1 + .BYTE 8 ? 335 ? 246 ? .BYTE + + 6,,-1 + 0 ; AND (IY+d) + 8,,1 + .BYTE 8 ? 375 ? 246 ? .BYTE + + 0 ; End of AND parse table + + + + + +ORTAB: ; OR + 1,,-1 + 0 ; OR r + 1,,0 + .BYTE 8 ? 260 ? .BYTE + + 7,,-1 + 0 ; OR n + 0,,1 + .BYTE 8 ? 366 ? .BYTE + + 4,,0 + 0 ; OR (HL) + 0,,0 + .BYTE 8 ? 266 ? .BYTE + + 5,,-1 + 0 ; OR (IX+d) + 8,,1 + .BYTE 8 ? 335 ? 266 ? .BYTE + + 6,,-1 + 0 ; OR (IY+d) + 8,,1 + .BYTE 8 ? 375 ? 266 ? .BYTE + + 0 ; End of OR parse table + + + + + +XORTAB: ; XOR + 1,,-1 + 0 ; XOR r + 1,,0 + .BYTE 8 ? 250 ? .BYTE + + 7,,-1 + 0 ; XOR n + 0,,1 + .BYTE 8 ? 356 ? .BYTE + + 4,,0 + 0 ; XOR (HL) + 0,,0 + .BYTE 8 ? 256 ? .BYTE + + 5,,-1 + 0 ; XOR (IX+d) + 8,,1 + .BYTE 8 ? 335 ? 256 ? .BYTE + + 6,,-1 + 0 ; XOR (IY+d) + 8,,1 + .BYTE 8 ? 375 ? 256 ? .BYTE + + 0 ; End of XOR parse table + + + + + +CPTAB: ; CP + 1,,-1 + 0 ; CP r + 1,,0 + .BYTE 8 ? 270 ? .BYTE + + 7,,-1 + 0 ; CP n + 0,,1 + .BYTE 8 ? 376 ? .BYTE + + 4,,0 + 0 ; CP (HL) + 0,,0 + .BYTE 8 ? 276 ? .BYTE + + 5,,-1 + 0 ; CP (IX+d) + 8,,1 + .BYTE 8 ? 335 ? 276 ? .BYTE + + 6,,-1 + 0 ; CP (IY+d) + 8,,1 + .BYTE 8 ? 375 ? 276 ? .BYTE + + 0 ; End of CP parse table + + + + + +INCTAB: ; INC + 1,,-1 + 0 ; INC r + 2,,0 + .BYTE 8 ? 004 ? .BYTE + + 4,,0 + 0 ; INC (HL) + 0,,0 + .BYTE 8 ? 064 ? .BYTE + + 5,,-1 + 0 ; INC (IX+d) + 8,,1 + .BYTE 8 ? 335 ? 064 ? .BYTE + + 6,,-1 + 0 ; INC (IY+d) + 8,,1 + .BYTE 8 ? 375 ? 064 ? .BYTE + + 2,,-1 + 0 ; INC ss + 4,,0 + .BYTE 8 ? 003 ? .BYTE + + 3,,1 + 0 ; INC IX + 8,,0 + .BYTE 8 ? 335 ? 043 ? .BYTE + + 3,,2 + 0 ; INC IY + 8,,0 + .BYTE 8 ? 375 ? 043 ? .BYTE + + 0 ; End of INC parse table + + + + + +DECTAB: ; DEC + 1,,-1 + 0 ; DEC r + 2,,0 + .BYTE 8 ? 005 ? .BYTE + + 4,,0 + 0 ; DEC (HL) + 0,,0 + .BYTE 8 ? 065 ? .BYTE + + 5,,-1 + 0 ; DEC (IX+d) + 8,,1 + .BYTE 8 ? 335 ? 065 ? .BYTE + + 6,,-1 + 0 ; DEC (IY+d) + 8,,1 + .BYTE 8 ? 375 ? 065 ? .BYTE + + 2,,-1 + 0 ; DEC ss + 4,,0 + .BYTE 8 ? 013 ? .BYTE + + 3,,1 + 0 ; DEC IX + 8,,0 + .BYTE 8 ? 335 ? 053 ? .BYTE + + 3,,2 + 0 ; DEC IY + 8,,0 + .BYTE 8 ? 375 ? 053 ? .BYTE + + 0 ; End of DEC parse table + + + + + +NEGTAB: ; NEG + 0 + 0 ; NEG + 8,,0 + .BYTE 8 ? 355 ? 104 ? .BYTE + + 0 ; End of NEG parse table + + + + + +IM0TAB: ; IM0 + 0 + 0 ; IM0 + 8,,0 + .BYTE 8 ? 355 ? 106 ? .BYTE + + 0 ; End of IM0 parse table + + + + + +IM1TAB: ; IM1 + 0 + 0 ; IM1 + 8,,0 + .BYTE 8 ? 355 ? 126 ? .BYTE + + 0 ; End of IM1 parse table + + + + + +IM2TAB: ; IM2 + 0 + 0 ; IM2 + 8,,0 + .BYTE 8 ? 355 ? 136 ? .BYTE + + 0 ; End of IM2 parse table + + + + + +RLCTAB: ; RLC + 0 + 0 ; RLC [8080 op for RLCA] + 0,,0 + .BYTE 8 ? 007 ? .BYTE + + 1,,-1 + 0 ; RLC r + 9,,0 + .BYTE 8 ? 313 ? 000 ? .BYTE + + 4,,0 + 0 ; RLC (HL) + 8,,0 + .BYTE 8 ? 313 ? 006 ? .BYTE + + 5,,-1 + 0 ; RLC (IX+d) + 13.,,0 + .BYTE 8 ? 335 ? 313 ? 0 ? 006 ? .BYTE + + 6,,-1 + 0 ; RLC (IY+d) + 13.,,0 + .BYTE 8 ? 375 ? 313 ? 0 ? 006 ? .BYTE + + 0 ; End of RLC parse table + + + + + +RLTAB: ; RL + 1,,-1 + 0 ; RL r + 9,,0 + .BYTE 8 ? 313 ? 020 ? .BYTE + + 4,,0 + 0 ; RL (HL) + 8,,0 + .BYTE 8 ? 313 ? 026 ? .BYTE + + 5,,-1 + 0 ; RL (IX+d) + 13.,,0 + .BYTE 8 ? 335 ? 313 ? 0 ? 026 ? .BYTE + + 6,,-1 + 0 ; RL (IY+d) + 13.,,0 + .BYTE 8 ? 375 ? 313 ? 0 ? 026 ? .BYTE + + 0 ; End of RL parse table + + + + + +RRCTAB: ; RRC + 0 + 0 ; RRC [8080 op for RRCA] + 0,,0 + .BYTE 8 ? 017 ? .BYTE + + 1,,-1 + 0 ; RRC r + 9,,0 + .BYTE 8 ? 313 ? 010 ? .BYTE + + 4,,0 + 0 ; RRC (HL) + 8,,0 + .BYTE 8 ? 313 ? 016 ? .BYTE + + 5,,-1 + 0 ; RRC (IX+d) + 13.,,0 + .BYTE 8 ? 335 ? 313 ? 0 ? 016 ? .BYTE + + 6,,-1 + 0 ; RRC (IY+d) + 13.,,0 + .BYTE 8 ? 375 ? 313 ? 0 ? 016 ? .BYTE + + 0 ; End of RRC parse table + + + + + +RRTAB: ; RR + 1,,-1 + 0 ; RR r + 9,,0 + .BYTE 8 ? 313 ? 030 ? .BYTE + + 4,,0 + 0 ; RR (HL) + 8,,0 + .BYTE 8 ? 313 ? 036 ? .BYTE + + 5,,-1 + 0 ; RR (IX+d) + 13.,,0 + .BYTE 8 ? 335 ? 313 ? 0 ? 036 ? .BYTE + + 6,,-1 + 0 ; RR (IY+d) + 13.,,0 + .BYTE 8 ? 375 ? 313 ? 0 ? 036 ? .BYTE + + 0 ; End of RR parse table + + + + + +SLATAB: ; SLA + 1,,-1 + 0 ; SLA r + 9,,0 + .BYTE 8 ? 313 ? 040 ? .BYTE + + 4,,0 + 0 ; SLA (HL) + 8,,0 + .BYTE 8 ? 313 ? 046 ? .BYTE + + 5,,-1 + 0 ; SLA (IX+d) + 13.,,0 + .BYTE 8 ? 335 ? 313 ? 0 ? 046 ? .BYTE + + 6,,-1 + 0 ; SLA (IY+d) + 13.,,0 + .BYTE 8 ? 375 ? 313 ? 0 ? 046 ? .BYTE + + 0 ; End of SLA parse table + + + + + +SRATAB: ; SRA + 1,,-1 + 0 ; SRA r + 9,,0 + .BYTE 8 ? 313 ? 050 ? .BYTE + + 4,,0 + 0 ; SRA (HL) + 8,,0 + .BYTE 8 ? 313 ? 056 ? .BYTE + + 5,,-1 + 0 ; SRA (IX+d) + 13.,,0 + .BYTE 8 ? 335 ? 313 ? 0 ? 056 ? .BYTE + + 6,,-1 + 0 ; SRA (IY+d) + 13.,,0 + .BYTE 8 ? 375 ? 313 ? 0 ? 056 ? .BYTE + + 0 ; End of SRA parse table + + + + + +SRLTAB: ; SRL + 1,,-1 + 0 ; SRL r + 9,,0 + .BYTE 8 ? 313 ? 070 ? .BYTE + + 4,,0 + 0 ; SRL (HL) + 8,,0 + .BYTE 8 ? 313 ? 076 ? .BYTE + + 5,,-1 + 0 ; SRL (IX+d) + 13.,,0 + .BYTE 8 ? 335 ? 313 ? 0 ? 076 ? .BYTE + + 6,,-1 + 0 ; SRL (IY+d) + 13.,,0 + .BYTE 8 ? 375 ? 313 ? 0 ? 076 ? .BYTE + + 0 ; End of SRL parse table + + + + + +RLDTAB: ; RLD + 0 + 0 ; RLD + 8,,0 + .BYTE 8 ? 355 ? 157 ? .BYTE + + 0 ; End of RLD parse table + + + + + +RRDTAB: ; RRD + 0 + 0 ; RRD + 8,,0 + .BYTE 8 ? 355 ? 147 ? .BYTE + + 0 ; End of RRD parse table + + + + + +BITTAB: ; BIT + 7,,-1 + 1,,-1 ; BIT b,r + 14.,,0 + .BYTE 8 ? 313 ? 100 ? .BYTE + + 7,,-1 + 4,,0 ; BIT b,(HL) + 14.,,0 + .BYTE 8 ? 313 ? 100 ? .BYTE + + 7,,-1 + 5,,-1 ; BIT b,(IX+d) + 15.,,0 + .BYTE 8 ? 335 ? 313 ? 0 ? 106 ? .BYTE + + 7,,-1 + 6,,-1 ; BIT b,(IY+d) + 15.,,0 + .BYTE 8 ? 375 ? 313 ? 0 ? 106 ? .BYTE + + 0 ; End of BIT parse table + + + + + +SETTAB: ; SET + 7,,-1 + 1,,-1 ; SET b,r + 14.,,0 + .BYTE 8 ? 313 ? 300 ? .BYTE + + 7,,-1 + 4,,0 ; SET b,(HL) + 14.,,0 + .BYTE 8 ? 313 ? 300 ? .BYTE + + 7,,-1 + 5,,-1 ; SET b,(IX+d) + 15.,,0 + .BYTE 8 ? 335 ? 313 ? 0 ? 306 ? .BYTE + + 7,,-1 + 6,,-1 ; SET b,(IY+d) + 15.,,0 + .BYTE 8 ? 375 ? 313 ? 0 ? 306 ? .BYTE + + 0 ; End of SET parse table + + + + + +RESTAB: ; RES + 7,,-1 + 1,,-1 ; RES b,r + 14.,,0 + .BYTE 8 ? 313 ? 200 ? .BYTE + + 7,,-1 + 4,,0 ; RES b,(HL) + 14.,,0 + .BYTE 8 ? 313 ? 200 ? .BYTE + + 7,,-1 + 5,,-1 ; RES b,(IX+d) + 15.,,0 + .BYTE 8 ? 335 ? 313 ? 0 ? 206 ? .BYTE + + 7,,-1 + 6,,-1 ; RES b,(IY+d) + 15.,,0 + .BYTE 8 ? 375 ? 313 ? 0 ? 206 ? .BYTE + + 0 ; End of RES parse table + + + + + +RETITB: ; RETI + 0 + 0 ; RETI + 8,,0 + .BYTE 8 ? 355 ? 115 ? .BYTE + + 0 ; End of RETI parse table + + +RETNTB: ; RETN + 0 + 0 ; RETN + 8,,0 + .BYTE 8 ? 355 ? 105 ? .BYTE + + 0 ; End of RETN parse table + + + +INTAB: ; IN + 7,,-1 + 0 ; IN n [8080 syntax] + 0,,1 + .BYTE 8 ? 333 ? .BYTE + + 1,,7 + 8,,-1 ; IN A,(n) + 0,,2 + .BYTE 8 ? 333 ? .BYTE + + 1,,-1 + 4,,6 ; IN r,(C) + 10.,,0 + .BYTE 8 ? 355 ? 100 ? .BYTE + + 0 ; End of IN parse table + + + + + +INITAB: ; INI + 0 + 0 ; INI + 8,,0 + .BYTE 8 ? 355 ? 242 ? .BYTE + + 0 ; End of INI parse table + + + + +INIRTB: ; INIR + 0 + 0 ; INIR + 8,,0 + .BYTE 8 ? 355 ? 262 ? .BYTE + + 0 ; End of INIR parse table + + + + + +INDTAB: ; IND + 0 + 0 ; IND + 8,,0 + .BYTE 8 ? 355 ? 252 ? .BYTE + + 0 ; End of IND parse table + + + + + +INDRTB: ; INDR + 0 + 0 ; INDR + 8,,0 + .BYTE 8 ? 355 ? 272 ? .BYTE + + 0 ; End of INDR parse table + + + + + +OUTTAB: ; OUT + 7,,-1 + 0 ; OUT n [8080 syntax] + 0,,1 + .BYTE 8 ? 323 ? .BYTE + + 8,,-1 + 1,,7 ; OUT (n),A + 0,,1 + .BYTE 8 ? 323 ? .BYTE + + 4,,6 + 1,,-1 ; OUT (C),r + 10.,,0 + .BYTE 8 ? 355 ? 101 ? .BYTE + + 0 ; End of OUT parse table + + + + + +OUTITB: ; OUTI + 0 + 0 ; OUTI + 8,,0 + .BYTE 8 ? 355 ? 243 ? .BYTE + + 0 ; End of OUTI parse table + + + + + +OTIRTB: ; OTIR + 0 + 0 ; OTIR + 8,,0 + .BYTE 8 ? 355 ? 263 ? .BYTE + + 0 ; End of OTIR parse table + + + + + +OUTDTB: ; OUTD + 0 + 0 ; OUTD + 8,,0 + .BYTE 8 ? 355 ? 253 ? .BYTE + + 0 ; End of OUTD parse table + + + + + +OTDRTB: ; OTDR + 0 + 0 ; OTDR + 8,,0 + .BYTE 8 ? 355 ? 273 ? .BYTE + + 0 ; End of OTDR parse table + +OSRCH: ;OP TABLE SEARCH + TLZ R0,MACBIT ;CLEAR POSSIBLE MACRO BIT + MOVEI R2,1_<35.-.LZ ,> ;SET UP OFFSET AND DELTA + MOVEI R1,<1_<35.-.LZ ,>>/2 +OSRCH1: CAMN R0,OPTBOT-2(R2) ;ARE WE LOOKING AT IT? + JRST OSRCH3 ; YES + CAML R0,OPTBOT-2(R2) ;TEST FOR DIRECTION OF NEXT MOVE + TDOA R2,R1 ;ADD +OSRCH2: SUB R2,R1 ;SUBTRACT + ASH R1,-1 ;HALVE DELTA + JUMPE R1,OSRCH4 ;EXIT IF END + CAILE R2,OPTTOP-OPTBOT ;YES, ARE WE OUTOF BOUNDS? + JRST OSRCH2 ;YES, MOVE DOWN + JRST OSRCH1 ;NO, TRY AGAIN + +OSRCH3: MOVE R1,OPTBOT-1(R2) ;FOUND, PLACE TYPE IN R2 + LDB R2,TYPPNT + JRST CPOPJ1 + +OSRCH4: SETZB R1,R2 + RETURN + +PF0: BLOCK 1 +PF1: BLOCK 1 +PF2: BLOCK 1 +PF3: BLOCK 1 + +PFT0: BLOCK 1 +PFT1: BLOCK 1 + + +SRCJFN: BLOCK 1 ; Current source JFN +SFILNM: BLOCK 20. ; Source file name string area +SRCCNT: BLOCK 1 ;Count of chars in source buffer +SRCPNT: BLOCK 1 ;Pointer into source buffer +srcbsz==2000 ;Buffer a page at a time... +srcbuf: block srcbsz +srclen: block 1 ;Total size in bytes of current input file +srcpos: block 1 ;# bytes which have been read already. +srcipt: block 1 ;Pointer to SRCTAB for last real input file + ;(i.e. doesn't change for .INSERTed files) + +REQSP: BLOCK 1 ; Require stack pointer +RQSTKL== 20.*3. ; Length of the require stack +REQSTK: BLOCK RQSTKL ; Require stack space + +;;r1 has the filename block +SFINIT: aos srcjfn ;Indicate that a different file now + ;(In the ITS version, this is only used in + ;endlr, for checking if file has changed and + ;hence filename must be typed out...) + syscal open,[%clbit,,.uai ? %climm,,srcch + 0(r1) ? 1(r1) ? 2(r1) ? 3(r1)] + .Lose %LsFil + syscal fillen,[%climm,,srcch ? %clout,,srclen] + .Lose %LsFil + setzm srcpos +SFINI1: syscal rfname,[%climm,,srcch + %clout,,0(r1) ? %clout,,1(r1) + %clout,,2(r1) ? %clout,,3(r1)] + .Lose %LsFil +; Create new source file string name + push p,r2 + push p,r3 + push p,r4 + push p,r1 + push p,r14 + move r2,r1 + move r14,[440700,,SFILNM] ; Address to place string + call rfn"pfn + setz r1, + idpb r1,r14 + pop p,r14 + + setzm srccnt ;Set byte count + move r2,[440700,,srcbuf] + movem r2,srcpnt ;Set new byte pointer + + pop p,r1 + move r2,2(r1) ;Get file type in sixbit + setz r4, ;Accumulate leading digits as the version +sfini4: ldb r3,[360600,,r2] ;E.g. 221ASM would be version 221 + caig r3,'9 ;No version will be version 0... + caige r3,'0 + jrst sfini5 + imuli r4,10. + addi r4,-'0(r3) + lsh r2,6 + jrst sfini4 +sfini5: hrli r4,defsym +;;SETVEC: + PUSH P,R0 ; Save a register + MOVE R0,[ GENM40 .,V,R,S,N,. + ] + CALL SSRCH ; Find it in the symbol table + JFCL ; Forget can't find return + MOVE R1,R4 ; Get value + TLO R1,HFKSYM ; Make .VRSN. half killed + CALL INSRT ; and insert it + POP P,R0 + pop p,r4 + pop p,r3 + pop p,r2 + return + + +.insu: tro r15,erru + return + +.insert: + TDZ R6,R6 ; Clear page throw flag + skipl reqsp ;Make sure not nested too deeply + jrst .insu + MOVE R14,R13 ; Load string pointer to the filename + SOJ R14, ; Back up 5 bytes + IBP R14 ? IBP R14 ? IBP R14 ? IBP R14 ; Forward 4 bytes + move r4,r14 ;Save + setz r1, ;fake an eol at comment. +.ins1: move r2,r1 + ildb r1,r4 + jumpe r1,.ins2 + caie r2,40 + cain r2,^I + caie r1,"; + jrst .ins1 + setz r2, ;Have , must be a comment + dpb r2,r4 +.ins2: push p,r1 ;Save the char + syscal rfname,[%climm,,srcch ;Default from current source file + %clout,,fblk+0 + %clout,,fblk+1 + %clout,,fblk+2 + %clout,,fblk+3] + .Lose %LsFil + setzm fblk+1 ;Except for filename + movei r2,fblk + call rfn"rfn + pop p,r1 ;Undo fake eol + dpb r1,r4 + skipn fblk+1 + jrst .insu ;No filename + syscal open,[%clbit,,.uai ? %climm,,tmpch + fblk ? fblk+1 ? fblk+2 ? fblk+3] + jrst .insu ;No file + .close tmpch, + TLO R16,REQBIT ; Say that we in a .REQUIRE +;; AOS R3,REQCNT ; Bump and load counter + +; Now we are ready to get input from a new file so we must save the status, +; byte count, JFN, and other stuff about the previous source file. + +;;REQSAV: + MOVE R4,REQSP ; Get require stack pointer + PUSH R4,SRCJFN + move r1,srcpos ;Save logical filepos + sub r1,srccnt + push r4,r1 + .access srcch,r1 ;Make it physically true as well + push r4,srclen ;Save source file length + MOVEM R4,REQSP ; Save the stack pointer + + .iopush srcch, ;Make channel available + +; Now we can initialize the new source file + movei r1,fblk + CALL SFINIT ; Init the new file + CAIE R6, ; Don't do page throw if .INSERT + TRO R16,HDRBIT ; If .REQUIRE or .INCLUDE then page throw + JRST GETEOL ; Go to end of the line and return + + +;; Read a character from current source +CHAR: + JUMPN R12,[CALL READMC ;GET A CHARACTER FROM MACRO TREE + JRST CHAR ; NULL, TRY AGAIN + TLO R16,MEXBIT ; SHOW MACRO EXPANSION IN PROGRESS + JRST CHAR1] ; CHECK THE CHARACTER +CHAR1A: SOSGE SRCCNT ;DECREMENT ITEM COUNT + JRST CHAR4 ;GET ANOTHER BUFFER IF NECESSARY + ILDB RBYTE,SRCPNT ; LOAD NEXT BYTE. +CHAR1: LDB R2,C7PNTR ;MAP CHARACTER TYPE. + XCT CHARTB(R2) ;DECIDE WHAT TO DO + RETURN ;ACCEPT IT + +CHAR4: + MOVE R14,R1 ; Save R1 + PUSH P,R3 ; Save some other registers + PUSH P,R4 + move r1,srclen + sub r1,srcpos ;# chars remaining + jumple r1,CHAR4A ;All chars read - get next file if any + caile r1,srcbsz ;read at most srcbsz this time + movei r1,srcbsz + addm r1,srcpos ;New position + movem r1,srccnt ;New count + move r2,[440700,,srcbuf] + movem r2,srcpnt ;New pointer + syscal siot,[%climm,,srcch ? r2 ? r1] + .Lose %LsFil + jumpe r1,char4b + movn r1,r1 ;This shouldn't happen, but... + addm r1,srccnt + addm r1,srcpos +CHAR4B: POP P,R4 ; Restore saved registers + POP P,R3 + + MOVE R1,R14 ; All restored + JRST CHAR1A ; Get next byte + +CHAR4A: .close srcch, ;All done with this file + TLNE R16,REQBIT ; Were we in a .REQUIRE? + JRST REQPOP ; Yes + movei r1,4 ; Try next input filename + addb r1,srcipt + skipn (r1) + JRST CHAR6 ;All done + CALL SFINIT ; Init this file + TRO R16,HDRBIT ; New header page please + JRST CHAR4B ;Go clean up stack and get next char + +CHAR6: ; No more input file test for end + TLO R15,ENDFLG ; Set flag to indicate so + MOVEI R14,LF ; End with LF + POP P,R4 ; Restore saved registers + POP P,R3 + MOVE R1,R14 + RETURN ; Back to caller + +; Here we must pop off saved pointers and counts to get back to the source +; input that we were using prior to the .REQUIRE + +REQPOP: + MOVE R4,REQSP ; Get back saved stack pointer + pop r4,srclen + pop r4,srcpos + POP R4,SRCJFN + CAMN R4,[-RQSTKL,,REQSTK-1] ; Back to original SP? + TLZ R16,REQBIT ; Yes - out of .REQUIRE now + MOVEM R4,REQSP ; Save stack pointer + .iopop srcch, ;Restore state of channel + movei r1,fblk + call sfini1 ;Restore SFILNM, @VERS@, srccnt,srcpnt + JRST CHAR4B ; Resume + +READMC: ;READ MACRO CHARACTER + CALL READMB ;GET A MACRO BYTE + CAIE R14,RUBOUT ;SPECIAL? + JRST CPOPJ1 ; NO, JUST EXIT + CALL READMB ;YES, GET TYPE + TRZE R14,100 ;SYMBOLIC? + JRST GETDS ; YES + JRST .(R14) ; NO, TRANSFER ON TYPE + + OFFSET 1-. +QUEMAC:: JRST MACEND ;END OF MACRO +QUEARG:: JRST DSEND ;END OF MACRO ARGUMENT +QUEREP:: JRST REPEND ;END OF REPEAT + OFFSET 0 + + +READMB: ;READ MACRO BYTE + ILDB R14,R12 ;GET CHARACTER + JUMPN R14,CPOPJ ;EXIT IF NON-NULL + MOVE R12,0(R12) ;END OF BLOCK, GET LINK + HRLI R12,(440700,,0) ;SET ASCII BYTE POINTER + JRST READMB ;TRY AGAIN + + +GETDS: ;GET DUMMY SYMBOL + MOVE R11,CALPNT ;GET POINTER TO CALL BLOCK + MOVEM R12,4(R11) ;SAVE CURRENT READ POINTER + MOVE R12,R11 ;SET NEW READ POINTER + ADDI R12,5 ;MOVE PAST WORDS + MOVE R11,R14 ;GET ARG NUMBER + ANDI R11,37 +GETDS1: PUSH P,R11 ;STACK WORKING REGISTER +GETDS2: CALL READMB ;GET A MACRO BYTE + CAIE R14,RUBOUT ;FLAGGED? + JRST GETDS2 ; NO, TRY AGAIN + CALL READMB ;YES, BYPASS END CODE + POP P,R11 ;RESTORE WORKING REGISTER + SOJG R11,GETDS1 ;TEST FOR COMPLETION + RETURN ; YES, EXIT + + +DSEND: ;DUMMY SYMBOL END + MOVE R12,CALPNT ;GET POINTER TO CALL BLOCK + MOVE R12,4(R12) ;RESTORE PREVIOUS READ POINTER + RETURN ;EXIT + CPL1== 72. ; CHARACTERS PER LOGICAL LINE + CPL2== 83. ; CHARACTERS PER PHYSICAL LINE + +GETLIN: ;GET THE NEXT SOURCE LINE + TLZ R16,NLISLN\MEXBIT\FOLBIT ; RESET LIST-RELATED FLAGS + ; AND INPUT FOLDING OVERRIDE. + AOS SEQ ; INCREMENT LINE SEQUENCE # + MOVEI R6,1 ;SET COUNT TO FIRST CHAR + MOVE R13,[440700,,LINBUF] ;SET POINTER +GETLI1: CALL CHAR ;GET AN INPUT CHARACTER + CAIN R14,FF ;FORM FEED? + TROA R16,FFBIT ; YES, FLAG AND SKIP + CAIN R14,LF ;OR LINE FEED? + JRST GETLI5 ; YES, END OF LIE + CAIG R6,CPL1 ;PAST NORMAL END? + JRST GETLI4 ; NO, STORE IT + CAIE R6,CPL1+1 ; YES - IS THIS THE MAGIC + JRST GETLI3 ; COLUMN FOR CDR MODE? + +; NEXT BYTE IS IN COLUMN 73 OF INPUT LINE. IF +; .ENABL CDR WAS ISSUED, INPUT IS CARD IMAGES; IN +; THIS CASE SUPPLY AN END-LOGICAL-LINE CHARACTER +; IN ORDER TO TREAT SEQUENCE NUMBERS IN 73-80 +; AS COMMENTARY INFORMATION. + + TLNN RMODE,CDRFLG ; READING CARD IMAGES? + JRST GETLI3 ; NO - CHECK FOR OVERFLOW. + MOVEI R11,ELLCHR ; YES - SET END LINE CHARACTER + IDPB R11,R13 ; AND STORE IN BUFFER + JRST GETLI4 ;ALSO STORE NORMAL CHAR + +GETLI3: CAIGE R6,CPL3 ;NORMAL MODE, SKIP IF OVERFLOW + JRST GETLI4 ; OK, STORE IT + TRO R15,ERRL ; NO, FLAG ERROR + JRST GETLI1 ;DON'T STORE IN EITHER CASE + +GETLI4: IDPB R14,R13 ;OK, STORE CHARACTER IN BUFFER + AOJA R6,GETLI1 ;BUMP COUNT AND LOOP + +GETLI5: IDPB R14,R13 ;END OF LINE, STORE + SETZ R14, + IDPB R14,R13 ;STORE NULL FOR EASY REFERENCE +GETLI6: TLNE R15,ENDFLG ;PERCHANCE END OF FILE? + TRO R15,ERRE ; YES, FLAG "NO END STATEMENTT" + MOVE R13,[440700,,LINBUF] ;SET FOR READ + JRST GETNB ;RETURN WITH FIRST NON-BLANK + + +macmem: PgmEnd ;Start of free memory for macro/cref storage +SYMBOT: PgmEnd ;BASE OF SYMBOL TABLE +SYMTOP: PgmEnd+PSLEN ;TOP OF SYMBOL TABLE +SYMLEN: BLOCK 1 ;LENGTH OF SYMBOL TABLE + +symrel: ;;Relocate symbol table + push p,r2 + push p,r1 + move r1,symtop + addi r1,3777 ;Get at least a page + trz r1,1777 + .suset [.smemt,,r1] + move r2,symtop + hrl r2,symlen + tlo r2,400000 + soj r1, + movem r1,symtop + pop r2,(r1) + soj r1, + jumpl r2,.-2 + aoj r1, + movem r1,symbot + pop p,r1 + pop p,r2 + jrst SRCHI ;Exit through reinit routine + +; GBLOCK gets a block of storage from the area +; used for macro info, but initializes it differently. +; It clears the entire block. + +; At return the block's start address is in R2; +; All other registers are intact. + +GBLOCK: SKIPE R2,NEXT ; Garbage collected block available? + JRST GBLK1 ; Yes - Use it. + MOVEI R2,WPB ; No -- Get virgin memory. + addb r2,macmem ; Allocate the new block. + camle r2,symbot ; Does it overlap the symbol table? + call symrel ; Yes -- move up the symbol table to make room + movei r2,-wpb(r2) ; Point to block's first word. + SETZM WPB-1(R2) ; Clear link field in last word. + +GBLK1: PUSH P,WPB-1(R2) ; Dequeue block from garbage list, + POP P,NEXT ; if that's where it is. + + HRLI R2,-WPB ; Clear entire block. + SETZM 0(R2) + AOBJN R2,.-1 + + MOVEI R2,-WPB(R2) ; Set R2 to block's bottom address. + RETURN ; Return. + +GETBLK: ;GET A BLOCK FOR MACRO STORAGE + SKIPE R11,NEXT ;ANY REMNANTS OF GARBAGE COLLECTION? + JRST GETBL1 ; YES, RE-USE + MOVEI R11,WPB + ADDB R11,macmem ;UPDATE FREE LOCATION POINTER + CAMLe R11,SYMBOT ;ANY ROOM? + call symrel ;No -- move up symbol table to make room + MOVEI R11,-WPB(R11) ;POINT TO START OF BLOCK + SETZM WPB-1(R11) ;CLEAR link field +GETBL1: HRLI R11,(440700,,0) ;FORM BYTE POINTER + MOVEM R11,MWPNTR ;SET NEW BYTE POINTER + HRLI R11,- ;GET SET TO INITIALIZE BLOCK + SETOM 0(R11) ;CLEAR ENTRY + AOBJN R11,.-1 ;SET ALL EXCEPT LAST TO -1 + PUSH P,0(R11) ;GET TOP + POP P,NEXT ;SET FOR NEXT BLOCK + SETZM 0(R11) ;CLEAR LAST WORD + RETURN ;EXIT + +SRCHI: ;INITIALIZE FOR SEARCH + PUSH P,R1 ;STACK WORKING REGISTERS + PUSH P,R2 + MOVE R1,SYMTOP ;GET THE TOP LOCATION + SUB R1,SYMBOT ;COMPUTE THE DIFFERENCE + MOVEM R1,SYMLEN ;SAVE IT + MOVEI R2,1 ;SET LOW BIT + LSH R2,1 ;SHIFT OVER ONE + TDZ R1,R2 ;CLEAR CORRESPONDING ONE + JUMPN R1,.-2 ;TEST FOR ALL BITS CLEARED + MOVEM R2,DELTA ;END, SAVE LEADING BIT FOR SEARCH OFFSET + MOVE R1,SYMBOT ;GET THE BASE + HRLI R1, ;SET INDEX + MOVEM R1,SYMPNT ;SET SYMBOL POINTER + SUBI R1,1 + MOVEM R1,VALPNT ;SET VALUE POINTER + SUBI R1,1 + MOVEM R1,CR1PNT ; Set pointer to 1st cross ref word. + SUBI R1,1 + MOVEM R1,CR2PNT ; Set pointer to 2nd cross ref word. + POP P,R2 ;RESTORE REGISTERS + POP P,R1 + RETURN ;EXIT + +insrt0: call symrel +INSRT: ;INSERT ITEM IN SYMBOL TABLE + CAMN R0,@SYMPNT ;IS IT HERE ALREADY? + JRST INSRT1 ; YES + MOVNI R6,4 ;NO, PREPARE TO INSERT + ADD R6,SYMBOT ;DECREMENT POINTER TO BOTTOM OF TABLE + CAMGe R6,macmem ;ARE WE INTRUDING ON THE MACROS? + jrst insrt0 ;Yes - shift it all up (who, me, efficient?) + movem r6,symbot + HRLI R6,4(R6) ;SET UP BLT + BLT R6,@SYMPNT ;MOVE LOWER SYMBOLS DOWN + CALL SRCHI ;RE-INITIALIZE THE POINTERS + ADDI R7,4 ;COMPENSATE FOR SHIFT + MOVEM R0,@SYMPNT ;STORE SYMBOL +INSRT1: MOVEM R1,@VALPNT ;STORE VALUE + RETURN + + SUBTTL PSEUDO-OPS + +ENDVEC: BLOCK 1 + +SET: TLNN RMODE,Z80FLG ; Which source language is in use? + JRST SET80 ; -- 8080: Set a variable + ; -- Z80: Assemble bit set op. + MOVEI R1,SETTAB ; Point to Z80 SET parse table. + JRST Z80PRS ; Enter Z80 parsing. + +; CP opcode: Assemble either Z80 compare or +; 8080 call-if-positive, depending on Z80FLG. + +CPOP: MOVEI R1,CPTAB ; Preload Z80 CP parse table address. + TLNE RMODE,Z80FLG ; Is assembly for Z80? + JRST Z80PRS ; Yes - Assemble Z80 compare. + ; No -- Assemble 8080 call-positive. + MOVEI R1,364 ; Load opcode. + IDPB R1,CODPNT ; Store it for output. + CALL EXPR ; Evaluate call address. + TRO RERR,ERRA ; .. Flag error if no valid expr. + IDPB R1,CODPNT ; \ + LSH R1,-8 ; *--- Store dest addr for output. + IDPB R1,CODPNT ; / + ADDI RLOC,3 ; Update "$" for 3-byte instruction. + RETURN + +ORG: ; ORG: Set location counter. + CALL CODOUT ; Dump any current binary output. + MOVE R0,CODPNT ; Set IPNT to show + MOVEM R0,IPNT ; line has no data. + CALL EXPR ; Get new value for PC. + TROA RERR,ERRA ; None => operand error, keep old pc + MOVE RLOC,R1 ; Set location counter = expr. + HRROM RLOC,PF1 ; Print new PC in alternate format. + MOVEM RLOC,CODLOC ; Set address for next data byte. + RETURN + + + + +..END: ;"END" PSEUDO-OP + SKIPN CONLVL ;IF IN CONDITIONAL + SKIPE REPLVL ; OR REPEAT, + TRO R15,ERRE ; FLAG ERROR + TLO R15,ENDFLG ;FLAG "END SEEN" + TLZ R16,SBTBIT ;TURN OFF SUBTITLE SWITCH + CALL EXPRF ;EVALUATE THE ADDRESS + SETZ R10, ; If null force transfer loc = 0. + HRROM R10,PF1 ; List transfer address in alt fmt. + MOVEM R10,ENDVEC + TRNE R15,ERRU ;ANY UNDEFINED SYMBOLS? + TRO R15,ERRP1 ; YES, PASS ONE ERROR + RETURN + + +; .CKSUM is equivalent to a DB directive which stores +; the negation of the sum of all bytes between the +; last .CKSUM directive and the current location. + +; The basic intention for .CKSUM is to provide a way +; to assemble checksums automatically at the end of +; ROM chips. If the code being output in a segment +; includes ORG directives which leave gaps in the chip, +; .CKSUM's behavior assumes these gaps contain 0. + + +.CKSUM: + CALL CODOUT ; Update CURSUM & output all bytes + ; of segment except the checksum. + MOVE R0,CODPNT ; Update IPNT to match new CODPNT + MOVEM R0,IPNT ; to insure proper listing. + + MOVN R1,CURSUM ; Checksum = negation of sum of all + ; previous bytes in segment. + IDPB R1,CODPNT ; Store the checksum. + AOJ RLOC, ; Increment the current location. + RETURN ; That's all. + + +; Note that event though the checksum byte is logically part of +; the preceding segment (so that the entire segment sums to 0) +; it is handled as the first byte of the next segment in order +; to simplify implementation. When .CKSUM returns the new segment +; consists of one byte, whose value is the negation of CURSUM; +; this is equivalent to resetting the checksum for the next segment. +DS: ; Define Storage directive + + CALL CODOUT ; Dump binary before resetting PC. + MOVE R0,CODPNT ; Set IPNT to show + MOVEM R0,IPNT ; no data on line. + TLO R16,LBLBIT ; Force loc to print. + CALL EXPR ; Get length of area to reserve. + TROA RERR,ERRQ ; No expr: Flag error, keep old PC. + ADD RLOC,R1 ; New PC = old + area length + MOVEM RLOC,CODLOC ; Set address for next binary data. + RETURN + + + +DW: ; Define Word(s) directive + + CALL EXPR ; Get a 16-bit expression. + JRST QERR ; None => invalid syntax. + IDPB R1,CODPNT ; Store LSB in code buffer. + LSH R1,-8 ; Align MSB for store. + IDPB R1,CODPNT ; Store MSG in code buffer. + ADDI RLOC,2 ; Adjust PC for this "word". + + CAIE RBYTE,", ; Is next byte a comma? + RETURN ; No -- Finished. + CALL GETNB ; Yes - Skip it & get another word. + JRST DW + + + +DB: ; Define Byte(s) directive + + CALL SETNB ; %%%% + CAIN RBYTE,"' ; Is first byte of field "'"? + JRST DBA ; Yes - Get ASCII string. + CALL EXPR ; No -- Get 8-bit expression. + JRST QERR ; No expr => bad syntax. + HRRZ R0,R1 ; Test for negative expression + TRZ R0,600377 ; before testing for excessive value. + CAIN R0,177400 ; Was expression negative? + JRST DB2 ; Yes - Don't flag truncation error. + TRZE R1,777400 ; Will expr value fit in a byte? + TRO RERR,ERRT ; No -- Truncate & flag error. +DB2: IDPB R1,CODPNT ; Store byte in code buffer. + AOJ RLOC, ; Increment PC to account for it. + +DB1: CAIE RBYTE,", ; Is next byte a comma? + RETURN ; No -- Finished. + CALL GETNB ; Yes - Skip it & get another field. + JRST DB + +; Field starts with "'": Gather an ASCII string up to a matching +; "'". "''" represents a singe "'" as a data byte. + +DBA: TLO R16,FOLBIT ; Override folding to gather string. + +DBA1: CALL GETNT ; Get anything except an EOL. + JRST QERR ; EOL => invalid syntax. + CAIN RBYTE,"' ; Is this byte a string delimiter? + JRST DBA2 ; Yes - Check further. + ; No -- Accept it as data. +DBA3: IDPB RBYTE,CODPNT ; Deposit byte in code buffer. + AOJA RLOC,DBA1 ; Increment PC & get next byte. + +DBA2: CALL GETCHR ; Found "'". + CAIN RBYTE,"' ; Is it followed by another one? + JRST DBA3 ; Yes - Treat it as data byte. + TLZ R16,FOLBIT ; No -- Reset folding mode, + JRST DB1 ; and check for another field. +..RADIX: ;".RADIX n" PSEUDO-OP + MOVEI R2,DECRDX ;SET RADIX TO 10 TO EVALUATE OPERAND + CALL RADEXP ;EVALUATE OPERAND + JRST .RAD8 ; DEFAULT NULL TO OCTAL + SETZ R0, ;CLEAR AC + CAIN R10,2. ;CHECK IF n=2 + MOVEI R0,BINRDX ; YES, SET BINARY RADIX + CAIN R10,4. ;CHECK IF n=4 + MOVEI R0,QUARDX ; YES, SET QUATERNARY RADIX +.RAD8: CAIN R10,8. ;CHECK IF n=8 + MOVEI R0,OCTRDX ; YES, SET OCTAL RADIX + CAIN R10,10. ;CHECK IF n=10 + MOVEI R0,DECRDX ; YES, SET DECIMAL RADIX + CAIN R10,16. ;CHECK IF n=16 + MOVEI R0,HEXRDX ; YES, SET HEXADECIMAL RADIX + JUMPE R0,.RADER ;JUMP IF NOT LEGAL RADIX + HRRM R0,GLBRDX ;SET THE NEW RADIX + MOVEM R10,RADVAL ; SAVE ITS NUMERIC VALUE TOO!!! + RETURN ;EXIT GOOD + +.OPDEF: ;.OPDEF HANDLER + CALL GETSYM ;GET THE NAME + JRST .OPDE2 ; NULL, ERROR + CAIE R14,", ;TEST FOR COMMA + JRST .OPDE2 ; MISSING + CALL GETNB ;BYPASS COMMA + PUSH P,R0 ;STACK NAME + CALL GETSYM ;GET THE TYPE + JRST .OPDE1 ; NOT A SYMBOL, ERROR + CAIE R14,", + JRST .OPDE1 ;MISSING COMMA + CALL GETNB ;BYPASS COMMA + CALL OSRCH ;SEARCH THE OP-CODE TABLE + JRST .OPDE1 ; NOT THERE + CAIE R2,OCOP ;OP CODE? + JRST .OPDE1 ; NO, ERROR + PUSH P,R1 ;OK, STACK TYPE + CALL ABSEXP ;COMPUTE BASIC VALUE + POP P,R0 ;RETRIEVE TYPE + DPB R10,[002000,,R0] ;STORE NEW VALUE + EXCH R0,0(P) ;EXCHANGE FOR NAME + CALL MSRCH ;SET SEARCH INDEX + JFCL ; MOX NIX IF FOUND + POP P,R1 ;RETRIEVE VALUE + TLNN RMODE,P1F ; Is this pass 2? + TLO R1,MD2SYM ; Yes - Mark as defined on pass 2. + CALL INSRT ;INSERT IN TABLE + MOVE R0,SEQ ; Get current line number. + HRLM R0,@CR1PNT ; Set in cross ref's definition field. + RETURN + +.OPDE1: POP P,0(P) ;PRUNE STACK +.OPDE2: TRO R15,ERRA ;FLAG ERROR + RETURN ;EXIT + +.TITLE: ;TITLE PSEUDO-OP + MOVE R11,[440700,,TTLMSG] + TLO R16,FOLBIT ; DON'T FOLD TITLE INTO UPPER CASE. + + CAIN RBYTE,"' ; Is first byte of title "'"? + JRST TITLEI ; Yes - Use Intel format string. + ; No -- Gather string to EOL. + PUSH P,RBPTR ; Save current input pointer. + CAIA ; SKIP ILDB THIS FIRST TIME + +TTLP: CALL GETCHR ; GET A CHAR + CALL TSTNT ; END OF LINE? + JRST TTLEND ; YES, FINISH IT UP + IDPB R14,R11 ; STORE CHAR IN BUFFER + JRST TTLP ; BACK AGAIN + +TTLEND: SETZ R0, + IDPB R0,R11 ; NULL BYTE INDICATES END + TLZ R16,FOLBIT ; RESUME FOLDING FOR GETSYM. + POP P,R13 ; RESTORE POINTER + CALL GETSYM ;GET THE SYMBOL + JRST TTLRT ; Don't set title if no symbol. + MOVEM R0,PRGTTL ;OK, STORE TITLE + SETOM TTLFLA ;SET FLAG +TTLRT: JUMPE R14,CPOPJ ;EXIT IF END OF LINE + CALL GETNB ;AVOID Q ERROR + JRST .-2 + RETURN + +; Intel format TITLE operand: Title string is delimited +; by "'" and "''" must be translated to "'" as a data byte. + + +TITLEI: MOVE RBYTE,RBPTR ; Use RBYTE temporarily to generate + IBP RBYTE ; pointer to byte after "'". + PUSH P,RBYTE ; Save for symbol lookup. + CAIA ; No deposit for leading delimiter. + +TITLED: IDPB RBYTE,R11 ; Deposit next byte of data in string. + + CALL GETNT ; Get next byte of string. + JRST TITLEE ; EOL => missing delimiter. + CAIE RBYTE,"' ; Is this a delimiter? + JRST TITLED ; No -- Deposit it. + ; Yes - Check for consecutive delims + CALL GETNT ; Get byte following delimiter. + JRST TTLEND ; EOL => legit end of string. + CAIN RBYTE,"' ; Is it another delimiter? + JRST TTLEND ; No -- End string. + JRST TITLED ; Yes - Treat it as data. + + +TITLEE: TRO RERR,ERRQ ; Missing delimiter: Bad syntax. + JRST TTLEND + +TOCSUB: ASCIZ / Table of Contents/ +SBMEND= . +.PAGE: ; FORCE A PAGE EJECT + SKIPL LSTCNT ; If .NLIST is in effect don't do it + TLNE RMODE,P1F ; IS THIS PASS 2? + RETURN ; NO - TAKE NO ACTION. + MOVE R0,LSTCTL ; Get listing mode flags + TLNE R16,MEXBIT ; If in macro expansion and + TRNE R0,LME ; listing is suppressed then skip + TRO R16,HDRBIT ; New page +SKIPEX: TRNN R0,LLD ; IS .NLIST LD IN EFFECT? + TLO R16,NLISLN ; YES -- DON'T LIST .PAGE + RETURN + + + +; SKIP n directive: Skip n lines. + +SKIP.: SKIPL LSTCNT ; Ignore if listing suppressed + TLNE RMODE,P1F ; or not running in pass 2. + JRST GETEOL + MOVE R0,LSTCTL ; Also ignore if in macro expansion + TLNE R16,MEXBIT ; and LIST ME not in effect. + TRNE R0,LME + CAIA + JRST GETEOL + + +SKIP1: CALL EXPR ; Get number of lines to skip. + MOVEI R1,1 ; Default to 1. + TRZE R1,777700 ; Limit skip count to 63. + TRO RERR,ERRT ; Flag any value > 63. + HRRZM R1,SKPCNT ; Save for end of line processing. + JRST SKIPEX ; Don't list "SKIP n" if + ; NLIST LD in effect. + + + + +.SBHED: ; SUBHEADING DIRECTIVE + TDZA R2,R2 ; CLEAR R2 TO FLAG .SBHED ENTRY. +.SBTTL: ;"SUBTITLE" PSEUDO-OP + SETO R2, ; SET R2 TO BITS TO FLAG .SBTTL ENTRY. + TLO R16,FOLBIT ; DON'T FOLD INPUT. + TLNE RMODE,P1F ; IS THIS PASS 1? + JRST SBP1 ; YES - JUST LIST STUFF + +; ---------- PASS 2 PROCESSING ----------- + + SKIPA R11,[440700,,SUBMSG] ;OBTAIN POINTER TO BUFFER +SBLP: CALL GETCHR ; GET NEXT CHARACTER. + CALL TSTNT ;END OF LINE SEEN? + JRST SBEND ;YES, GET OUT + IDPB R14,R11 ;PUT BYTE AWAY + JRST SBLP ;DO ANOTHER +SBEND: MOVEI 0 ;END OF SUBTITLE + IDPB R11 ;IS A ZERO BYTE + TLO R16,SBTBIT ;MARK THAT WE HAVE SEEN A SBTTL + CAIN R2,0 ; Was this a subhed directive? + TRO R16,HDRBIT ; Yes - Force a page skip. + RETURN + + + +; ------------- PASS 1 PROCESSING --------------- + +SBP1: MOVE R0,LSTCTL ; IS TOC LISTING ENABLED? + TRNE R0,LTOC + SKIPGE LSTCNT + RETURN ; NO - QUIT. + TLOE R16,SBTBIT ; YES - SUBHEAD ALREADY SET? + JRST SBTOCL + +; SUPPLY 'TABLE OF CONTENTS' AS SUBTITLE. + + MOVE R0,[TOCSUB,,SUBMSG] ; COPY TOC PROSE + BLT R0,SUBMSG+SBMEND-TOCSUB ; INTO SUBTITLE BUFFER + TRO R16,HDRBIT ; FORCE PAGE SKIP + +; LIST OPERAND FIELD OF .SBTTL DIRECTIVE + +SBTOCL: CALL FORSEQ ; FORMAT SEQUENCE # FIELD. +SBSEQ: CALL LPTOUT ; LIST A BYTE. + ILDB R2,R6 ; GET NEXT BYTE OF FORMATTED SEQ. + JUMPN R2,SBSEQ ; REPEAT UNTIL FINDING 0. + + CALL LSTTAB ; FOLLOW WITH 2 TABS. + CALL LSTTAB + + CALL SETCHR ; LOAD FIRST BYTE OF SUBTITLE + +SBTOCN: MOVE R2,R14 ; COPY BYTE TO R2 FOR LPTOUA + CALL TSTNT ; CHECK FOR END OF LINE + JRST SBENDL ; <- RET 0 - END OR NULL + ; <- RET 1 - PART OF TEXT + CALL LPTOUA ; PRINT NEXT BYTE +SBTGNX: CALL GETCHR ; SCAN TO FOLLOWING BYTE. + JRST SBTOCN + +SBENDL: JUMPE R2,SBTGNX ; IGNORE A NULL BYTE + TDZ R2,R2 ; END OF LINE -- PRINT CR/LF + CALL LPTOUA + RETURN + + +; ============ .LIST & .NLIST ============ + +.LIST: MOVE R0,[LISSET,,LISTBL] ; CALL SUBROUTINE TO PARSE + CALL ARGSET ; ARGUMENT FIELD + AOSA LSTCNT ; ** NO ARGS -- INCREMENT LIST LEVEL + RETURN + JRST LISTYP + + +.NLIST: MOVE R0,[LISRES,,LISTBL] ; CALL ARG PARSER + CALL ARGSET + SOSA LSTCNT ; ** NO ARGS -- DECREMENT LIST LEVEL + RETURN + +LISTYP: HRRZ R0,LSTCTL ; EITHER .LIST OR .NLIST HAD NO ARGS + TRNN R0,LLD ; SHOULD IT BE LISTED? + TLO R16,NLISLN ; NO - SET "UNLIST LINE" FLAG + RETURN + + + +LISSET: CALL LSSSUB ; /// EXECUTED BY ARGSET /// +LISRES: CALL LSRSUB ; /// EXECUTED BY ARGSET /// + + +LSSSUB: HRLZ R2,R2 ; MOVE MODE BIT TO LH. + IORM R2,LSTCTL ; OR IT ON IN MEMORY. + JRST SETLF ; SET LIST FLAGS & RETURN. + +LSRSUB: HRLZ R2,R2 ; MOVE MODE BIT TO LH. + ANDCAM R2,LSTCTL ; CLEAR IT IN MEMORY. + ; SET LIST FLAGS & RETURN. + +; SETLF SETS THE EFFECTIVE LISTING MODE FLAGS +; IN THE RIGHT HALF OF LSTCTL TO ACCOUNT FOR +; DIRECTIVES IN THE SOURCE AND OVERRIDES IN +; THE COMMAND STRING. IT'S CALLED BY INITIALIZATION, +; SWITCH PROCESSING, AND THE TWO SUBROUTINES ABOVE. + +; NOTE THAT THE MANIPULATIONS BELOW DEAL WITH ONLY +; THE RIGHT HALF OF R0 & R1. THE LEFT HALF GOES +; ALONG FOR THE RIDE, BUT NEVER GETS STORED. + +SETLF: MOVS R0,LIWORD ; LOAD OVERRIDE MASK. + HLRZ R1,LSTCTL ; LOAD SOURCE MODES. + ANDCAM R0,R1 ; CLEAR OVERRIDDEN BITS. + AND R0,LIWORD ; R0 = OVERRIDDEN BITS TO BE + IOR R1,R0 ; FORCED ON. + HRRM R1,LSTCTL ; STORE FINAL RESULT. + RETURN + +; =========== .ENABL & .DSABL ============ + +.ENABL: + PUSH P,RMODE ; SAVE MODE FLAGS + MOVE R0,[ENASET,,ENATBL] ; LOAD PARMS & CALL ARGSET + CALL ARGSET ; TO SET FLAGS + TRO RERR,ERRQ ; NO PARMS => Q ERROR + + POP P,R0 ; RETRIEVE OLD FLAGS + XOR R0,RMODE ; R0 = BITS TURNED ON BY .ENABL + TLNE R0,ABSFLG ; WAS ABS MODE SET? + TLZ RLOC,(PFMASK) ; YES - RESET RELOCATION + RETURN + + +.DSABL: + MOVE R0,[ENARES,,ENATBL] + CALL ARGSET ; CALL SUBR TO INTERPRET ARGS + TRO RERR,ERRQ ; NONE => Q ERROR + RETURN + + +ENASET: CALL ENSSUB ; ** EXECUTED TO ENABLE A MODE ** +ENARES: CALL ENRSUB ; ** EXECUTED TO DISABLE A MODE ** + + +ENSSUB: HRLZ R2,R2 ; SET AN ENABL OPTION BIT. + IORM R2,ENACTL ; STORE IN ENACTL LH. + tlne r2,Lsbflg ; Was a local symbol block enabled? + call Locras ; Yes - Reset local symbol block. + JRST SETEN ; RETURN VIA SETEN. + +ENRSUB: HRLZ R2,R2 ; CLEAR AN ENABL OPTION BIT. + ANDCAM R2,ENACTL ; STORE IN ENACTL LH. + ; RETURN VIA SETEN. + + +; SETEN SETS THE EFFECTIVE ENABL MODE BITS IN ENACTL +; AND IN RMODE (R15) IN ESSENTIALLY THE SAME WAY +; SETLF SETS LISTING MODES. THE ONLY DIFFERENCE IS +; IN COPYING THE RESULTING BIT VALUES INTO RMODE. + +SETEN: MOVS R0,ENWORD ; GET OVERRIDE OPTION BITS. + HLRZ R1,ENACTL ; LOAD OPTIONS SET IN SOURCE. + ANDCAM R0,R1 ; CLEAR OVERRIDDEN BITS. + AND R0,ENWORD ; R0 = BITS TO FORCE ON. + IOR R1,R0 ; ... FORCE THEM. + HRRM R1,ENACTL ; STORE RESULT. + TLZ RMODE,ENMASK ; CLEAR ALL ENABL BITS IN RMODE. + TLO RMODE,0(R1) ; SET THOSE WHICH ARE STILL ON. + RETURN + +; ************ .ERROR AND .PRINT ************* + +.ERROR: TRO RERR,ERRP ; FLAG LINE WITH "P" (!) + +.PRINT: TLNE RMODE,P1F ; IGNORE .ERROR & .PRINT + RETURN ; ON PASS 1 + + TLO R16,LBLBIT\PF1BIT\ERRBIT ; PRINT LOC & EXPR VALUE + MOVEM RLOC,PF0 ; ON BOTH TTY & LISTING + +; LIST EXPRESSION VALUE, IF ONE EXISTS + + CALL EXPR ; EVALUATE EXPRESSION, IF ANY. + CAIA ; NO EXPRESSION - LEAVE PF1=0 + MOVEM R10,PF1 ; STORE EXPR VALUE IN PRINT FIELD 1 + + RETURN ; LET ENDL DO THE REST. + + SUBTTL MACRO-RELATED ASSEMBLER DIRECTIVES + +.NARG: ; ==== .NARG ==== + SKIPG MACLVL ; Is a macro expanding? + JRST OPCERR ; NO -- ISSUE AN 'O' FLAG. + + MOVE R3,CALPNT ; LOCATE CURRENT CALL BLOCK. + HLRZ R1,3(R3) ; LOAD THE ARG COUNT. +SETCAL: TRO R16,SETBIT ; Indicate SET (not EQU) in progress. + JRST SETENT ; Set location field symbol. + + + +.NCHR: ; ====== .NCHR ====== + CALL MACARG ; GET A MACRO-TYPE ARGUMENT. + MOVE R1,ARGLEN ; LOAD LENGTH (# OF CHARACTERS) + JRST SETCAL ; Enter SET processing. + + SUBTTL MACRO HANDLERS + +; ... MACRO STORAGE BLOCK FORMATS ... + + +; CALL BLOCK + +; 0 -- SAVED INPUT POINTER (FROM R12) +; 1 -- SAVED MACRO CALL POINTER (CALPNT) +; 2 -- BYTE POINTER TO MACRO PROTOTYPE +; 3LH -- ARGUMENT COUNT (# ARGS ACTUALLY SUPPLIED) +; 3RH -- LAST CHARACTER READ +; 4 -- ????? +; 5 & FOLLOWING ... ARGUMENT LIST AS AN ASCII STRING + + + +; MACRO PROTOTYPE TEXT + +; 0 -- REFERENCE COUNT +; 1 -- NUMBER OF DUMMY ARGUMENTS +; 2 -- BIT MASK INDICATING WHICH ARGS WERE PRECEDED BY "?" +; 3 & FOLLOWING ... PROTOTYPE TEXT AS AN ASCII STRING + + + +; IRP ARGUMENT VALUE BLOCK + +; 0 -- BYTE POINTER TO START OF ARGUMENT STRING +; 1 -- IRP TYPE FLAG: 0 FOR .IRP, 1 FOR .IRPC +; 2 & FOLLOWING ... ARGUMENTS AS A SINGLE ASCIZ STRING + +; <<<<<<< .IRP & .IRPC >>>>>>> + +; .... ADD A COMMENT BLOCK HERE .... + +.IRP: TDZA R10,R10 ; FLAG .IRP INVOCATION. +.IRPC: MOVEI R10,1 ; FLAG .IRPC INVOCATION. + PUSH P,R10 ; SAVE ENTRY FLAG ON STACK + + CALL MDLTST ; TEST MACRO DEF LISTING MODE. + SETZM MACNAM ; ACT LIKE NAMELESS MACRO. + CALL GETSYM ; GET NAME OF THE ARGUMENT. + TRO RERR,ERRQ ; QUESTIONABLE SYNTAX IF NONE. + MOVEM R0,ARGLST ; SAVE ARG NAME. + + CAIN RBYTE,", ; IS ARG DELIM A COMMA? + CALL GETNB ; YES - SKIP IT. + +; SAVE ARGUMENT STRING, THEN READ .IRP BLOCK DEFINITION. + + CALL GETBLK ; GET SPACE FOR ARG BLOCK. + POP P,R1 ; RETRIEVE IRP/IRPC FLAG. + PUSH P,CALPNT ; SAVE CURRENT CALL BLOCK POINTER. + HRRZ R10,MWPNTR ; GET ADDR OF ARG BLOCK. + PUSH P,R10 ; SAVE FOR LATER USE. + + MOVEM R1,1(R10) ; STORE IRP/IRPC FLAG IN BLOCK. + MOVEI R0,2 ; SET INITIAL BYTE POINTER + ADD R0,MWPNTR ; FOR ARGUMENT TEXT. + MOVEM R0,MWPNTR + IBP R0 + MOVEM R0,0(R10) + + TLO R16,FOLBIT ; SUPPRESS CASE FOLDING. + CALL MACARG ; GET THE ARGUMENT FIELD. + MOVE R10,[440700,,ARGSTR] ; POINT TO IT. + +; COPY ARGUMENT FIELD TO ARGUMENT VALUE BLOCK. + +IRPA: ILDB RBYTE,R10 ; Get first argument byte. + MOVEM RBYTE,ARGDEL ; Save it as first delimiter value. + +; The initial setting of ARGDEL is 0 if no arguments are +; supplied (".irp dummy,<>", for instance), else nonzero. + + CAIA ; Enter loop. +IRPB: ILDB RBYTE,R10 ; GET NEXT ARG BYTE. + IDPB RBYTE,MWPNTR ; WRITE IT IN ARG BLOCK. + JUMPN RBYTE,IRPB ; REPEAT TIL END OF ASCIZ STRING. + + CALL DEFIRP ; DRAG IN THE IRP DEFINITION. + PUSH P,R1 ; SAVE ITS ADDRESS ON STACK. + SETOM 0(R1) ; DELETE DEFINITION AFTER LAST CALL. + +; -- CURRENT STACK CONTENTS: + +; 0(P) - ADDRESS OF DEFINITION BLOCK. +; -1(P) - ADDRESS OF IRP ARGUMENT VALUE BLOCK. +; -2(P) - CONTENTS OF CALPNT (POINTER TO CALL BLOCK +; OF A MACRO THAT INVOKED .IRP) + + +; GENERATE A CALL BLOCK FOR EACH ARGUMENT. + + +IRPNAR: HRRZ R1,-1(P) ; LOCATE ARG BLOCK. + MOVE RBPTR,0(R1) ; POINT TO NEXT PROSE TO PARSE. + SKIPE 1(R1) ; WHICH BRAND OF IRP IS THIS? + JRST IRPCAR + +; ; ///// .IRP ///// + SKIPN ARGDEL ; WAS PREVIOUS ARG DELIM 0? + JRST IRPGO ; YES - IT WAS THE LAST. + HRRZ R1,0(P) ; RETRIEVE DEFINITION ADDR. + CALL IRPAR ; LET CALL BLOCK GENERATOR + HRRZ R1,-1(P) ; PARSE THE ARGUMENT. + MOVEM RBPTR,0(R1) ; STORE UPDATED ARG POINTER. + JRST IRPREQ ; REQUEUE CALL BLOCK JUST GEND. + + +; ; ///// .IRPC ///// +IRPCAR: LDB RBYTE,RBPTR ; GET ARGUMENT BYTE. + JUMPE RBYTE,IRPGO ; QUIT IF IT'S THE ARG DELIMITER. + IBP RBPTR ; POINT TO NEXT BYTE. + LSH RBYTE,29. ; CONVERT CURRENT BYTE TO + MOVEM RBYTE,ARGSTR ; ASCIZ STRING FORMAT & STORE. + + MOVEM RBPTR,0(R1) ; SAVE UPDATED BYTE POINTER. + HRRZ R1,0(P) ; LOAD ADDR OF DEFINITION BLOCK. + MOVE RBPTR,[350700,,ARGSTR] ; POINT TO THE ARGUMENT. + CALL IRPCAL ; GENERATE CALL BLOCK. + + +; REQUEUE CALL BLOCK JUST GENERATED, UNLESS IT WAS FOR +; THE FIRST ARGUMENT. THE CALL BLOCK GENERATOR STACKS +; THEM, SO THE ORDER OF ARGUMENT SUBSTITUTION WOULD BE +; RIGHT TO LEFT WITHOUT THIS MANIPULATION. + +IRPREQ: MOVE R0,-2(P) ; LOCATE FIRST NON-IRP CALL BLOCK. + MOVE R1,CALPNT ; LOCATE BLOCK JUST GENERATED. + MOVE R2,1(R1) ; LOCATE ITS SUCCESSOR. + + CAMN R0,R2 ; IS SUCCESSOR 1ST NON-IRP? + JRST IRPNAR ; YES - NO ACTION NEEDED + ; (THIS WAS 1ST ARGUMENT) + + MOVEM R2,CALPNT ; DEQUEUE THE NEW BLOCK. + MOVEM R0,1(R1) ; LINK IT TO 1ST NON-IRP. + +; SCAN CALL BLOCK QUEUE FOR SPOT TO INSERT THE NEW ONE; +; IT SHOULD BE INSERTED BETWEEN IRP-GENERATED BLOCKS +; AND THE FIRST NON-IRP-GENERATED BLOCK. + + CAIA ; DON'T MISS 1ST BLOCK. + +IRPQSR: MOVE R2,1(R2) ; LOCATE NEXT BLOCK + CAME R0,1(R2) ; DOES IT POINT TO NON-IRP BLK? + JRST IRPQSR ; NO - KEEP SEARCHING. + + MOVEM R1,1(R2) ; INSERT NEW BLOCK IN QUEUE. + MOVE R0,0(R1) ; SWAP SAVED INPUT POINTERS + MOVE R3,0(R2) ; IN NEW BLOCK & BLOCK JUST FOUND. + MOVEM R0,0(R2) + MOVEM R3,0(R1) + JRST IRPNAR ; GO BACK FOR NEXT ARG. + + +; ALL CALL BLOCKS READY ... START EXPANDING. + +IRPGO: POP P,R0 ; POP DEFINITION LOC OFF STACK + POP P,R1 ; POP ARG BLOCK OFF. + POP P, ; GET RID OF SAVED CALPNT. + JRST REMMAC ; DELETE ARG BLOCK & RETURN. + +DEFIRP: ; ENTRY FROM .IRP TO MACRO DEFINITION + CALL GETBLK ; GET A BLOCK FOR DEFINITION. + PUSH P,MWPNTR ; SAVE POINTER TO IT ON STACK. + MOVEI R1,3 ; SKIP TO TEXT STORAGE AREA. + ADDM R1,MWPNTR + MOVEI R7,1 ; INDICATE 1 ARGUMENT. + JRST DEF02 ; ENTER DEFINITION PROCESSING + ; IN THE MIDDLE. + + +DEFIN0: ; .MACRO DIRECTIVE + CALL MDLTST ; ACT ON MD LISTING MODE + MOVE R0,STRSYM ; Get macro name from front of line. + JUMPE R0,DEFERR ; If none, can't define macro. + SETZM STRSYM ; Indicate name's been processed. + MOVEM R0,MACNAM ; SAVE MACRO NAME IN NEST NAME TBL + CALL GETBLK ;OK, GET A BLOCK FROM STORAGE + CALL MSRCH ;SEE IF ALREADY DEFINED + MOVSI R1,MAOP ;NOT THERE, FLAG AS MACRO + TLNN RMODE,P1F ; Is this pass 2? + TLO R1,MD2SYM ; Yes - Mark as defined on pass 2. + TRNE R1,-1 ;PREVIUSLY DEFINED? + CALL DECMAC ; YES, DECREMENT REFERENCE + HRR R1,MWPNTR ;GET POINTER TO START OF BLOCK + CALL INSRT ;INSERT/DELETE IN SYMBOL TABLE + MOVE R0,SEQ ; Set cross ref's definition field + HRLM R0,@CR1PNT ; to current line number. + PUSH P,MWPNTR ;STACK POINTER TO START OF BLOCK + MOVEI R1,3 + ADDM R1,MWPNTR ;MOVE PAST REFERENCE LEVEL AND ARG COUNT + SETZM MARMAS ; CLEAR PROTOTYPE ARGUMENT MASK. + CALL SETNB ; %%%% + TDZA R7,R7 ; Set arg count = 0 & don't skip a byte. + + +DEF01: CALL GETNB ;MOVE PAST COMMA +DEF01B: ; [ECL3] + + CAIE RBYTE,"% ; IS NEXT BYTE "%"? + JRST DEF01A ; NO -- THIS IS A MUNDANE ARGUMENT. + ; YES - THIS ARG MAY REQUIRE AN + ; AUTOMATICALLY GENNED SYMBOL. + MOVEI R0,1 ; SET A BIT IN THE ARG MASK CORRESPONDING + ROT R0,0(R7) ; TO THE RELATIVE POSITION OF THIS ARG. + IORM R0,MARMAS + CALL GETCHR ; SKIP THE "%". + +DEF01A: CALL GETSYM ;GET AN ARG + JRST DEF02 ; NOT THERE + MOVEM R0,ARGLST(R7) ;STORE IN LIST + ADDI R7,1 ;BUMP POINTER + CAIN R14,", ;ANY MORE? + JRST DEF01 ; YES + +; the following is to make .MACRO allow blanks or tabs [ECL3] +; between arguments [ECL3] + CAIE R14,"; ;statement ends on semi-colon [ECL3]. + CAIN R4,SCLE ; or end of line + JRST DEF02 + JRST DEF01B ;failing to find an end of [ECL3] + ;line, we assume the next [ECL3] + ;is a new arg separated from [ECL3] + ;the previous one by blanks [ECL3] + ;and/or tabs. Treat like a [ECL3] + ;comma already skipped. [ECL3] + +DEF02: PUSH P,R7 ;STACK ARG COUNT + SETZM ARGLST(R7) ;MARK END + CALL ENDLR ;LIST THE LINE + SETZ R7, ;INIT LEVEL COUNT + +; CODE FROM DEF03 TO DEF04 IS CONCERNED WITH +; KEEPING TRACK OF .MACRO/.ENDM PAIRS IN POTENTIALLY +; NESTED MACRO DEFINITIONS. + +; WHEN A .MACRO DIRECTIVE IS FOUND, THE NESTING LEVEL +; IN R7 IS INCREMENTED, AND THE MACRO NAME IS RECORDED +; IN MACNAM(R7). R7 = 0 FOR THE OUTERMOST MACRO. +; .REPT, .IRP, AND .IRPC ARE TREATED AS NAMELESS MACRO +; DEFINITIONS (I.E., .MACRO WITHOUT AN OPERAND). + + +; WHEN A .ENDM IS FOUND THE ACTION DEPENDS ON ITS OPERAND. +; -- .ENDR IS TREATED AS A SYNONYM FOR .ENDM. + +; NO OPERAND: THE NESTING LEVEL (R7) IS DECREMENTED. +; IF IT GOES NEGATIVE, THE OUTERMOST (I.E., CURRENT) +; MACRO DEFINITION IS TERMINATED. + +; SYMBOLIC OPERAND: THE SYMBOL IS MATCHED WITH NAMES IN +; MACNAM. WHEN ONE MATCHES, THE NESTING LEVEL IS +; A) DECREMENTED (DEC'S WAY), OR +; B) SET TO THE OFFSET OF THE MACRO NAME IN MACNAM. +; THIS TERMINATES MACRO DEFINITIONS WITH HIGHER +; NESTING LEVELS WHICH ARE STILL OPEN. + +; THE LATTER ACTION IS TAKEN ONLY IF NONSTANDARD +; FEATURES ARE ENABLED. + + +DEF03: CALL GETMLI ;GET THE NEXT LINE + JRST DEF13 ; EOF SEEN + CAMN R0,MACRO ; Is this "macro"? + AOJA R7,DEF03B ; Yes - Increment nest level & proceed. + CAME R0,.REPTX ; IS IT .REPT? + CAMN R0,.IRPOP ; .IRP? + AOJA R7,DEF03D ; YES - INCR CALL LEVEL + CAMN R0,.IRCOP ; IS IT .IRPC? + AOJA R7,DEF03D ; YES - LIKE .IRP (ETC) + CAME R0,ENDM ; Is op "ENDM"? + JRST DEF04 ; NOT .MACRO OR .ENDM - SKIP + + CALL GETSYM ; .ENDM -- GET ITS OPERAND, IF ANY + JRST DEF03A ; NO OPERAND -- JUST POP NEST LEVEL + +; -- PROCESS A .ENDM SPECIFYING A SPECIFIC MACRO TO TERMINATE. + + MOVE R1,R7 ; COPY NEST LEVEL TO SPARE REG + + CAMN R0,MACNAM(R1) ; IS THIS THE .ENDM OPERAND? + JRST DEF03C ; YES - GO TO POPPER + SOJGE R1,.-2 ; NO - BACK UP TO HIER LEVEL + + TRO RERR,ERRA ; NO SUCH MACRO IS OPEN . . . + JRST DEF03A ; GIVE IT AN "A" FLAG. + +; -- NESTED .MACRO FOUND - ADD ITS NAME TO TABLE & INCR NEST LEVEL. + +DEF03B: CALL GETSYM ; GET MACRO NAME +DEF03D: SETZ R0 ; NAMELESS .MACRO\.REPT\.IRP\.IRPC + ; MACRO DIRECTIVES WITHOUT MACRO NAMES WILL BE FLAGGED + ; WHEN THE MACRO IS DEFINED; IN THIS CASE THAT HAPPENS + ; WHEN AN OUTER MACRO IS CALLED. + MOVEM R0,MACNAM(R7) ; STORE NAME IN NESTED NAME TABLE + JRST DEF04 + +; -- MODIFY NESTING LEVEL FOR A .ENDM WHICH TERMINATES +; A SPECIFIC MACRO. + +DEF03C: MOVE R7,R1 ; YES - SET, THEN POP, NEST LEVEL +DEF03A: SOJL R7,DEF13 ;END IF MINUS +DEF04: MOVE R13,[440700,,LINBUF] ;SET TO START OF LINE + TLO R16,FOLBIT ; LEAVE LOWER CASE INTACT. +DEF05: CALL GETCHR ;GET THE NEXT CHARACTER +DEF06: CAIE R14,"' ;CONCATENATION CHARACTER? + JRST DEF06C ; NO, BRANCH AROUND +DEF06A: CALL GETCHR ;YES, GET THE NEXT CHARACTER + CAIE R14,"' ;MULTIPLE? + JRST DEF06B ; NO + CALL WCIMT ;YES, SAVE ONLY ONE + JRST DEF06A ;TEST FOR MORE +DEF06B: TLO R15,CONFLG ;FLAG THE CONCATENATION CHARACTER +DEF06C: MOVE R0,RBYTE ; COPY BYTE IN CASE IT'S LOWER CASE. + CAIL RBYTE,140 ; IF NECESSARY, FOLD THE ORIGINAL + SUBI RBYTE,40 ; BYTE INTO UPPER CASE TO CHECK ITS TYPE. + +; **** ADD A NEW COLUMN TO CHJTBL SOME DAY SOON **** + + LDB R2,C8PNTR ;MAP + JUMPE R14,DEF12 ;BRANCH IF END OF LINE + CAIE R2,.ALP ;IF ALPHA + CAIN R2,.NUM ; OR NUMERIC + JRST DEF07 ; BRANCH + CAIN R2,.HEX ; SOME ALPHAS ARE TYPED + JRST DEF07 ; AS HEX DIGITS. + + MOVE RBYTE,R0 ; RESTORE UNFOLDED BYTE. + CALL WCIMT ;WRITE IN TREE + JRST DEF05 ;TRY FOR ANOTHER + +DEF07: TLZ R16,FOLBIT ; TURN FOLDING ON AGAIN . . . + SETZ R0, ;POSSIBLE ARGUMENT + MOVSI R3,(440600,,R0) + MOVEM R13,SYMBEG ;SAVE START JUST IN CASE +DEF08: SUBI R14,40 ;CONVERT TO SIXBIT + TLNE R3,770000 + IDPB R14,R3 ; YES, DO SO + CALL GETCHR ;GET THE NEXT CHARACTER + LDB R2,C8PNTR ;MAP + CAIE R2,.ALP ;IF ALPHA + CAIN R2,.NUM ; OR NUMERIC + JRST DEF08 ; BRANCH + CAIN R2,.HEX + JRST DEF08 + CALL SIXM40 + SETZ R2, ;INIT SEARCH INDEX +DEF09: SKIPN ARGLST(R2) ;TEST FOR END + JRST DEF10 ; YES + CAME R0,ARGLST(R2) ;NO, HAVE WE A MATCH? + AOJA R2,DEF09 ; NO,TRY THE NEXT SLOT + +; ** FOUND MATCH -- IDENTIFY DUMMY SYMBOL IN THE PROTOTYPE TEXT. + + TLZ R15,CONFLG ;REMOVE POSSIBLE CONCATENATION CHARACTER + MOVEI R14,101(R2) ;SET DUMMY SYMBOL POINTER + CALL WTIMT ;WRITE IN TREE + TLO R16,FOLBIT ; TURN OFF FOLDING AGAIN. + CALL SETCHR ;SET CHARACTER + CAIN R14,"' ;CONCATENATION CHARACTER? + JRST DEF05 ; YES, BYPASS IT + JRST DEF06 ; NO, PROCESS IT + +DEF10: MOVE R13,SYMBEG ;MISSED, RESET POINTER + TLO R16,FOLBIT ; QUIT FOLDING AGAIN. + CALL SETCHR ;RESET CHARACTER +DEF11: MOVE R0,RBYTE ; SAVE UNFOLDED BYTE, THEN + CAIL RBYTE,140 ; FOLD TO UPPER CASE TO CHECK + SUBI RBYTE,40 ; ITS TYPE. + LDB R2,C8PNTR ;MAP + MOVE RBYTE,R0 ; RESTORE UNFOLDED COPY OF BYTE. + CAIE R2,.ALP ;IF ALPHA + CAIN R2,.NUM ; OR NUMERIC + JRST DEF11A + CAIE R2,.HEX + JRST DEF06 ;ELSE BRANCH +DEF11A: CALL WCIMT ;OK, WRITE IN TREE + CALL GETCHR ;GET NEXT CHAR + JRST DEF11 ;TEST IT + +DEF12: CALL ENDLR ;LIST IT + TLNN R15,ENDFLG ;SKIP IF EOF SEEN + JRST DEF03 ;GET THE NEXT LINE + +DEF13: + MOVEI R14,QUEMAC ;FINISHED, SET "END OF MACRO DEFINITION" + CALL WTIMT ;WRITE IT, WITH QUE, IN TREE + POP P,R2 ;RETRIEVE COUNT + POP P,R1 ; AND POINTER TO START OF BLOCK + SETZM 0(R1) ;ZERO LEVEL COUNT + HRRZM R2,1(R1) ;STORE ARG COUNT IN SECOND RUNG + MOVE R0,MARMAS ; STORE "?" ARG BIT MASK + MOVEM R0,2(R1) ; IN THIRD WORD. + RETURN + + +DEFERR: + TRO R15,ERRQ + RETURN + +; ########## .MEXIT ########### + +; .MEXIT RESTORES THE LEVEL COUNTERS FOR REPEATS, +; CONDITIONALS, AND UNSATISFIED CONDITIONALS TO +; THEIR VALUES AT THE MACRO CALL. IT LISTS +; THE REMAINING MACRO LINES AND ENTERS .ENDM PROCESSING. + + +.MEXIT: SKIPG MACLVL ; IS A MACRO EXPANDING? + JRST OPCERR ; NO - FLAG THE LINE. + + MOVE R14,MACLVL ; LOAD LEVEL OF NESTED CALLS + MOVE R0,MCLREP(R14) ; RESTORE REPEAT LEVEL + MOVEM R0,REPLVL + MOVE R0,MCLCON(R14) ; RESTORE COND LEVEL + MOVEM R0,CONLVL + MOVE R0,MCLUNS(R14) ; RESTORE UNSATISFIED LEVEL + MOVEM R0,UNSLVL + + +; LIST REMAINING LINES OF MACRO. NOTE THAT +; .ENDM PROCESSING (MACEND) IS ENTERED FROM +; READMC, WHICH IS CALLED BY CHAR2 IN CHAR, +; WHICH IS CALLED BY GETLIN. THE MACRO'S END +; IS DETECTED FROM HERE BY WATCHING FOR +; MACEND'S DECREMENT OF MACLVL. + + MOVEM R14,MLSAVE ; SAVE MACLVL + +MEXLST: CALL ENDLR ; LIST NEXT LINE. + CALL GETLIN ; GET ITS SUCCESSOR. + MOVE R0,MACLVL + CAME R0,MLSAVE ; DID MACLVL CHANGE? + JRST STMNT ; Yes - process this line 1st, return + CALL GETEOL ; No -- Position to end of line. + JRST MEXLST ; Continue until exiting this level. + + +DECMAC: ;DECREMENT MACRO STORAGE + SOSL 0(R1) ;TEST FOR END + RETURN ; NO, EXIT + +REMMAC: ;REMOVE MACRO STORAGE + PUSH P,R1 ;SAVE POINTER + HRLS R1 ;SAVE CURRENT POINTER + HRR R1,WPB-1(R1) ;GET NEXT LINK + TRNE R1,-1 ;TEST FOR END (NULL) + JRST .-3 ; NO + HLRZS R1 ;YES, GET RETURN POINTER + HRL R1,NEXT ;GET CURRENT START OF CHAIN + HLRM R1,WPB-1(R1) ;STORE AT TOP + POP P,R1 ;RESTORE BORROWED REGISTER + HRRZM R1,NEXT ;SET NEW START + RETURN ;EXIT + + SUBTTL REPEAT HANDLER + +REPEA0: ;"REPEAT" PSEUDO-OP + CALL MDLTST ; TEST MD LISTING MODE + CALL ABSEXP ;EVALUATE EXPRESSION + TRNE R15,ERRU ;ANY UNDEFINED ERRORS? + TRO R15,ERRP1 ; YES, MENTION ON PASS 1 + LSH R10,+<36.-16.> ;ADJUST SIGN TO 36 BITS + ASH R10,-<36.-16.> + CAIN R10,1 ;IF SINGLE, + JRST BEGR0 ; PROCESS IN LINE + PUSH P,R10 ;STACK EXPRESSION + CALL ENDLR ;LIST LINE + CALL GETBLK ;MULTIPLE, SDT FOR STORAGE + PUSH P,MWPNTR ;SAVE STARTING BLOCK ADDRESS + MOVEI R11,3 + ADDM R11,MWPNTR ;POINT PAST POINTER STORAGE + SETZ R7, ;ZERO LEVEL COUNT +REPEA1: CALL GETMLI ;GET THE NEXT SOURCE LINE + JRST REPEA3 ; END OF FILE + CAMN R0,.REPTX + AOJA R7,REPEA2 ; INCREMENT AND BRANCH + CAMN R0,ENDM ; Is this "ENDM"? + SOJL R7,REPEA3 ; DECREMENT AND BRANCH IF END +REPEA2: TLO R16,FOLBIT ; DON'T FOLD LC TO UC IN DEFINITION. + SKIPA RBPTR,[440700,,LINBUF] ; POINT TO START OF LINE. + CALL WCIMT ;WRITE CHAR IN MACRO TREE + CALL GETCHR ;GET THE NEXT CHARACTER + JUMPN R14,.-2 ;TEST FOR CR + CALL ENDLR ;LIST THE LINE + TLNN R15,ENDFLG ;SKIP IF EOF SEEN + JRST REPEA1 ;TRY THE NEXT LINE + +REPEA3: MOVEI R14,QUEREP ;END, SET TO CLOSE + CALL WTIMT ;WRITE FLAG AND "REPEAT END" + POP P,R11 ;RETRIEVE STARTING POINTER + MOVEI R10,-1(R11) ;SET FOR PUSH + PUSH R10,R12 ;STORE READ POINTER + PUSH R10,REPPNT ; REPEAT POINTER + PUSH R10,REPEXP ; AND REPEAT EXPRESSION + MOVEM R11,REPPNT ;SET NEW REPEAT POINTER + POP P,REPEXP ; AND REPEAT COUNT +; JRST REPEND +REPEND: ;REPEAT END + MOVE R12,REPPNT ;ASSUME ANOTHER ITERATION + ADDI R12,3 ;POINT PAST POINTERS + SOSL REPEXP ;END? + RETURN ; NO + MOVE R1,REPPNT ; YES, GET SET TO CLEAN UP + HRROI R10,2(R1) ;POINT TO TOP POINTER + POP R10,REPEXP ;REPLACE STORED ITEMS + POP R10,REPPNT + POP R10,R12 + CALL REMMAC ;GARBAGE COLLECT + RETURN ;EXIT + + +; REPEATS CAN BE ENDED BY EITHER A .ENDM OR A .ENDR; +; .ENDM'S WHICH END A MACRO ARE PROCESSED ONLY BY +; THE MACRO DEFINITION PROCESSOR -- WHEN THE STATEMENT +; PROCESSOR FINDS A .ENDM, AND DISPATCHES TO LOCATION +; .ENDM, IT MUST BE THE END OF A REPEAT. + +.ENDM: + +ENDR0: ; ".ENDR" PSEUDO-OP + SKIPG REPLVL ;IN REPEAT? + JRST OPCERR ; NO, ERROR + SOSA REPLVL ;YES, DECREMENT LEVEL COUNT +BEGR0: AOS REPLVL ;REPEAT ONCE + RETURN + + SUBTTL REPEAT/CONDITIONAL ROUTINES + +.IFNDF: TDZA R2,R2 +.IFDF: SETO R2, ;SET TRUE + SETOB R3,R4 ;SET RESULT AND CHAR TRUE (&) +.IFDF1: PUSH P,R4 ;STACK CURRENT RESULTS + PUSH P,R3 + PUSH P,R2 + CALL GETSYM ;GET THE NEXT SYMBOL + TROA R15,ERRA ; NOT THERE, ERROR AND SKIP + CALL SSRCH ;SEARCH THE SYMBOL TABLE + SETZ R1, ; NOT THERE OR GETSYM ERROR + CAIE R0, ;DON'T CREF NULL + CALL CRFREF + TLNE R1,MDFSYM + TRO R15,ERRD ;FLAG IF MULTI-DEFINED SYM + TLNN R1,DEFSYM ;FLAGGED AS DEFINED? + TDZA R1,R1 ; NO, CLEAR TO ZERO + SETO R1, ; YES, SET TRUE + POP P,R2 ;RETRIEVE REGISTERS + POP P,R3 + POP P,R4 + XCT [AND R3,R1 ? IOR R3,R1]+1(R4) + MOVE R4,R2 ;ANTICIPATE END + EQV R4,R3 + HRLI R4,1 ;MARK PNZ + CAIN R14,"& ;TEST FOR OPS + MOVE R4,R2 + CAIN R14,"! + SETCM R4,R2 + JUMPG R4,@[BEGC0 ? FALSE]+1(R4) + IBP RBPTR ;FOUND OP, BYPASS IT + JRST .IFDF1 ;LOOP + +JMPER: + MOVE R1,CONDX+1(R3) + JRST 0(R1) + +CONDX: + DIRDEF B,,,,,,.IFB + DIRDEF D,F,,,,,.IFDF + DIRDEF D,I,F,,,,.IFDIF + DIRDEF E,Q,,,,,IFZ0 + DIRDEF G,,,,,,IFG0 + DIRDEF G,E,,,,,IFGE0 + DIRDEF G,T,,,,,IFG0 + DIRDEF I,D,N,,,,.IFIDN + DIRDEF L,,,,,,IFL0 + DIRDEF L,E,,,,,IFLE0 + DIRDEF L,T,,,,,IFL0 + DIRDEF N,B,,,,,.IFNB + DIRDEF N,D,F,,,,.IFNDF + DIRDEF N,E,,,,,IFNZ0 + DIRDEF N,Z,,,,,IFNZ0 + DIRDEF Z,,,,,,IFZ0 +CONDY: + +.IFFLG: BLOCK 1 + +INIF: ; Intel IF directive + CALL EXPR ; Evaluate true/false expression. + TROA RERR,ERRQ ; No expr => bad syntax. + JUMPN R1,BEGC0 ; Assemble if expr <> 0, + JRST FALSE ; skip block if expr = 0. + + + +.IIF: TLO R16,IIFBIT ; MARK .IIF ENTRY TO CONDITIONAL STUFF + +.IF: + CALL GETSYM ;GET CONDITION + TROA R15,ERRA ;NO CONDITION + CAIN RBYTE,", ; WAS DELIMITER A COMMA? + CALL GETNB ; YES - SKIP IT. + + MOVSI R3,- ;SET FOR SCAN + TRNN R3,1 ;IGNORE ODD LOCATIONS + CAME R0,CONDX(R3) ;MATCH + AOBJN R3,.-2 ;NO + CAIG R3, + JRST JMPER +.IFBAD: TROA R15,ERRA ;CONDITION DIDN'T MATCH + RETURN + + +.IFB: ;IF BLANK CONDITIONAL + SKIPG MACLVL ;IN MACRO EXPANSION + JRST OPCERR ;NO! + CALL MACARG ; PARSE THE ARGUMENT. + SKIPN ARGLEN ; FIELD WAS BLANK IF PARSED LENGTH = 0. + JRST BEGC0 ;IT WAS BLANK + JRST FALSE ;NOT BLANK + + +.IFNB: + SKIPG MACLVL ;IN MACRO EXPANSION + JRST OPCERR ;NO! + CALL MACARG ; GET THE ARGUMENT. + SKIPN ARGLEN ; IS ITS LENGTH 0? + JRST FALSE ;ARG WAS BLANK + JRST BEGC0 + +.IFT: ;GENERATING CODE UNDER .IFTF OR .IFF + SKIPG CONLVL ;EXPANDING A MACRO + JRST OPCERR + MOVE R1,.IFFLG + TRNN R1,TRUE ;SKIP IF TRUE + + JRST .IFIF ;LAST CONDITION WAS FALSE + JRST BEGC01 ;LAST CONDITION WAS TRUE + + +.IFTF: ;GENERATING CODE UNDER .IFT,.IFF + SKIPG CONLVL ;EXPANDING A MACRO + JRST OPCERR ;NO + JRST BEGC01 ; Yes - test if this should list + + + +.IFF: ;GENERATING CODE UNDER .IFTF, .IFT + SKIPG CONLVL ;EXPANDING MACRO + JRST OPCERR ;NO + MOVE R1,.IFFLG ; RELOAD LAST CONDITION WORD + TRNN R1,TRUE ;TEST LAST CONDITION RESULT + JRST BEGC01 ; Last condition false + JRST .IFIF ;LAST CONDITION WAS TRUE + +FALSE: ;GET HERE WHEN OUTER LEVEL + ;IS FALSE + TLZE R16,IIFBIT ; IS THIS A .IIF DIRECTIVE? + JRST GETEOL ; YES - JUST FLUSH THE LINE. + + AOS CONLVL ;COULD GET OUT ON .IFF THEN .ENDC + MOVE R1,.IFFLG + LSH R1,1 ;SHIFT IN 0 + MOVEM R1,.IFFLG ;MEANS FALSE + +.IFIF: ;USED DURING 0 LEVEL OF NO CODE + ;GENERATION + CALL CNLTST ;TEST FOR .NLIST + CALL ENDLR ;LIST THE LINE + CALL GETMLI ;GET NEXT LINE + RETURN ;EOF SEEN + MOVSI R3,-<.IFY-.IFX> ;SET FOR SCAN + TRNN R3,1 ;IGNORE IF ODD LOCATION + CAME R0,.IFX(R3) + AOBJN R3,.-2 + CAIG R3, ;GREATER IF NO MATCH + JRST TESTIF ;IT'S AN IF + CAMN R0,ENDIF ; Not IF -- Is it ENDIF? + JRST ENDC0 ;YES IT WAS .ENDC + CALL TSTNT ;TERMINATOR + JRST .IFIF ;YES + CALL GETNT ;NO, GET ONE + JRST .IFIF ;GOT IT + JRST .-2 + + +FAL: ;PREVIOUS CONDITION WAS FALSE + CAMN R0,.IFFX ;.IFF WHEN IN FALSE + + JRST BEGC01 ;YES -- GO GENERATE CODE + CAMN R0,.IFTX + JRST .IFIF + JRST ..NOGO ;NO -- RETURN + + +TRU: ;LAST CONDITION WAS TRUE + CAMN R0,.IFTX ;.IFT WHEN IN TRUE + JRST BEGC01 ;YES,GENERATE CODE + CAMN R0,.IFFX + JRST .IFIF + JRST ..NOGO + + +TESTIF: ;UNDER FALSE, FOUND .IFF, .IFT, + ;OR .IFTF, .IF CONDITION + CAMN R0,.IFTFX ;.IFTF + JRST BEGC01 ;YES + MOVE R1,.IFFLG + TRNN R1,TRUE ;ARE WE IN A TRUE CONDITION + JRST FAL + JRST TRU ;IN TRUE +..NOGO: AOS UNSLVL ;LEVEL COUNTER + CALL UNSCO2 ;FIND .ENDC + RETURN ;EOF SEEN + JRST .IFIF ;RETURN AFTER .ENDC MATCHING + + +IFZ0: JSP R3,IF0 + CAIE R10, + +IFNZ0: JSP R3,IF0 + CAIN R10, + +IFG0: JSP R3,IF0 + CAIG R10, + +IFGE0: JSP R3,IF0 + CAIGE R10, + +IFL0: JSP R3,IF0 + CAIL R10, + +IFLE0: JSP R3,IF0 + CAILE R10, + +IF0: PUSH P,0(R3) ;STACK INSTRUCTION + CALL ABSEXP ;VALUATE EXPRESSION + LSH R10,+<36.-16.> ;ADJUST SIGN + ASH R10,-<36.-16.> + POP P,R3 ;RETRIEVE INSTRUCTION + XCT R3 ;EXECUTE IT + JRST FALSE ; DIDN'T MAKE IT + JRST BEGC0 ;SATISFIED + + +.IFDIF: ; .IF DIF -- ARE ARGS DIFFERENT? + CALL IDNDIF ; COMPARE 2 STRINGS. + JRST BEGC0 ; .. DIFFERENT + JRST FALSE ; .. IDENTICAL + +SECLEN: BLOCK 1 ; LENGTH OF SECONDARY ARGUMENT +SECSTR: BLOCK 100. ; SPACE FOR SAME + +.IFIDN: ; .IF IDN -- ARE ARGS IDENTICAL? + CALL IDNDIF ; COMPARE 2 STRINGS. + JRST FALSE ; .. DIFFERENT + JRST BEGC0 ; .. IDENTICAL + + +IDNDIF: CALL MACARG ; GET A MACRO-TYPE ARGUMENT. + MOVE R3,[ARGLEN,,SECLEN] ; COPY IT TO A SAFE PLACE. + MOVE R1,ARGLEN ; MOVE (# BYTES)/4 + 2 WORDS. + LSH R1,-2 + BLT R3,SECSTR+1(R1) + + CAIN RBYTE,", ; WAS ARGUMENT DELIMITER A COMMA? + CALL GETNB ; YES - SKIP IT. + + CALL MACARG ; GET ANOTHER ARGUMENT. + MOVE R0,ARGLEN ; DOES LENGTH OF EACH ARG MATCH? + CAME R0,SECLEN + RETURN ; .. NO - RETURN +1. + + MOVE R3,[440700,,ARGSTR] ; PREPARE TO COMPARE. + MOVE R4,[440700,,SECSTR] + +IDNCMP: ILDB R1,R3 ; LOAD NEXT BYTE OF PRIMARY AND + ILDB R2,R4 ; SECONDARY STRINGS. + JUMPE R1,CPOPJ1 ; ** END OF STRING - RETURN +2 + CAMN R1,R2 ; DO BYTES MATCH? + JRST IDNCMP ; YES - KEEP COMPARING. + RETURN ; NO -- RETURN +1. +UNSCON: SETZM UNSLVL ;CREAR LEVEL COUNT +UNSCO1: CALL CNLTST ; TEST FOR .NLIST CND + CALL ENDLR ;LIST THE LINE + CALL GETMLI ;GET THE NEXT LINE + RETURN ;EOF SEEN + MOVSI R3,-<.IFY-.IFX> ;SET FOR SCAN + TRNN R3,1 ;IGNORE IF ODD LOCATION + CAME R0,.IFX(R3) ;SKIP IF MATCH + AOBJN R3,.-2 ;LOOP IF NOT END + CAIGE R3, ;END, SKIP IF NO MATCH + JRST CHKADDR ;DON'T INCR FOR .IFF,ETC + CAMN R0,ENDIF ; "ENDIF"? + SOSLE UNSLVL ; YES, SKIP IF NOT NESTED + JRST UNSCO2 ; TRY FOR MORE. + JRST CPOPJ1 ;GOOD, RETURN+1 + +UNSCO2: CALL TSTNT ;TEST FOR TERMINATION + JRST UNSCO1 ; YES + CALL GETNT ;NO, GET ONE + JRST UNSCO1 + JRST .-2 + + +CHKADD: CAMN R0,.IFFX ;.IFF + JRST UNSCO2 ;YES, DON'T LOOK FOR .ENDC + CAMN R0,.IFTX ;.IFT + JRST UNSCO2 ;YES, DON'T LOOK FOR .ENDC + CAMN R0,.IFTFX ;.IFTF + JRST UNSCO2 ;YES, DON'T LOOK FOR .ENDC + AOS UNSLVL ;IT WAS .IF COND, LOOK FOR .ENDC + JRST UNSCO2 + + + +ENDC0: ; ".ENDC" + SKIPG CONLVL ;ARE WE IN A CONDITIONAL? + JRST OPCERR ; NO, ERROR + MOVE R1,.IFFLG + LSH R1,-1 + MOVEM R1,.IFFLG + + SOS CONLVL ;YES, DECREMENT LEVEL + JRST BEGC01 + +BEGC0: TLZE R16,IIFBIT ; IS THIS AN IMMEDIATE IF? + JRST IMII ; YES -- EXPAND REST OF LINE. + AOS CONLVL ;INCREMENT LEVEL + MOVE R1,.IFFLG + LSH R1,1 + TRO R1,TRUE + MOVEM R1,.IFFLG + +BEGC01: CALL CNLTST ; TEST FOR .NLIST CND + RETURN + +IMII: CALL SETNB ; SUCCESSFUL IMMEDIATE IF . . . + CAIN RBYTE,", ; WAS DELIMITER A COMMA? + CALL GETNB ; YES -- SKIP IT. + JRST STMNT ; ASSEMBLE REST OF LINE. + + +GETMLI: ;GET MACRO-TYPE LINE + + CALL GETLIN ; GET A BASIC LINE + CALL MDLTST ; TEST MD LISTING MODE +GETML1: CALL GETSYM ;TRY FOR A SYMBOL + JRST GETML2 ; NO + CAIE R14,": ;LABEL? + JRST GETML2 ; NO + CALL GETNB ;YES, GET ANOTHER + JRST GETML1 + +GETML2: TLNE R15,ENDFLG ;EOF SEEN? + RETURN ; YES, BAD EXIT + JRST CPOPJ1 ;GOOD EXIT + + SUBTTL ASSEMBLER DIRECTIVE ARGUMENT INTERPRETER + +; SUBROUTINE ARGSET PARSES THE REMAINING INPUT ON THE LINE, +; CHECKING FOR ARGUMENTS SPECIFIED IN A TABLE SUPPLIED BY +; THE CALLER. WHEN IT FINDS ONE, IT EXECUTES AN INSTRUCTION +; SUPPLIED BY THE CALLER WITH A VALUE FROM THE TABLE IN R2. + +; INPUT TO ARGSET: + +; R0 HIGH ORDER HALFWORD = ADDRESS OF INSTRUCTION TO EXECUTE +; WHEN A PROPER ARG IS FOUND +; R0 LOW ORDER HALFWORD = ADDRESS OF ARGUMENT TABLE + +; CALL IS VIA "CALL ARGSET" + +; RETURNS: + +; 0(P) -- NO ARGUMENTS FOUND +; 1(P) -- ONE OR MORE ARGUMENTS WERE FOUND + +; IF AN INVALID ARGUMENT APPEARS IN THE SOURCE LINE +; ARGSET SETS "ERRQ" TO GENERATE A Q FLAG. + + +; FORMAT OF ARG TABLE: + +; WORD 0: XWD -(# OF ENTRIES IN TABLE),.+1 +; WORDS 1-N : VALUE,ARGCODE +; +; VALUE IS ANY VALUE DESIRED (LIKELY A BIT MASK) +; TO BE LOADED IN R2 WHEN THE ARG IS FOUND +; & THE CALLER'S INSTRUCTION IS EXECUTED. + +; ARGCODE IS THE ARGUMENT IN MOD40 FORMAT + + +ARGSET: PUSH P,R0 ; SAVE CALLER'S PARMS + CALL GETSYM ; DECODE NEXT SYMBOL + CAIA ; - SKIP IF NONE + JRST ARSER ; EXIT TO SEARCH TABLE + + POP P,R0 ;**** NO ARGUMENT -- POP STACK + RETURN ; & RETURN TO CALLER + + +; *** SCAN FOR NEXT ARGUMENT *** + +ARNEX: IBP RBPTR ; SKIP "," + CALL GETSYM ; TRY FOR ANOTHER SYMBOL + JRST AREXIT ; NONE -- QUIT HERE + +; SEARCH ARGUMENT TABLE FOR THE SYMBOL JUST FOUND + +ARSER: TRZE R0, ; IS SYMBOL LONGER THAN 3 CHARS? + JRST ARBAD ; YES -- INVALID ARGUMENT + MOVSS R0, ; NO -- MOVE SYM TO RIGHT HALF + HRRZ R1,0(P) ; LOAD TABLE LOC, THEN + MOVE R1,0(R1) ; LOOP CONTROL WORD INTO R1 + +ARSERL: MOVE R3,0(R1) ; LOAD ARG VALUE FROM TABLE + CAIN R0,(R3) ; DOES OPERAND MATCH? + JRST ARFOUN ; YES + AOBJN R1,ARSERL ; NO - KEEP SEARCHING + +ARBAD: TRO RERR,ERRQ ; INVALID ARG -- SET Q FLAG + JRST AREXIT ; & QUIT + +ARFOUN: HLRZ R2,R3 ; FOUND ARG -- LOAD VALUE + HLRZ R1,0(P) ; FROM TABLE & EXECUTE + XCT 0(R1) ; CALLER'S INSTRUCTION + + LDB R0,RBPTR ; CHECK NEXT SOURCE BYTE + CAIN R0,", ; TEST FOR "," + JRST ARNEX ; "," => GET ANOTHER ARG + +AREXIT: POP P,R0 ; RETURN AFTER FINDING AN ARG + JRST CPOPJ1 + +; SUBROUTINE MDLTST CHECKS THE MACRO DEFINITION LISTING +; CONTROL FLAG; IF IT ISN'T SET, .NLIST MD MUST BE +; IN EFFECT: SET NLISLN FLAG TO SUPPRESS LISTING +; OF THIS LINE. + +MDLTST: PUSH P,R0 ;SAVE FOR .IF'S + MOVE R0,LSTCTL ;LOAD LISTING CONTROL FLAGS + TRNN R0,LMD ; MD TO BE LISTED? + TLO R16,NLISLN ; NO - SUPPRESS LINE ON LISTING + POP P,R0 ;FOR .IF'S + RETURN + + +; SUBROUTINE CNLTST CHECKS THE LISTING CONTROL FLAG +; WHICH GOVERNS LISTING OF UNEXPANDED CONDITIONAL +; CODE AND ALL .IF'S & .ENDC'S. THIS FLAG IS 0 IF +; .NLIST CND IS IN EFFECT; IF THIS IS THE CASE, +; CNLTST SETS THE NLISLN FLAG TO SUPPRESS +; LISTING OF THE CURRENT LINE. + +CNLTST: PUSH P,R0 + MOVE R0,LSTCTL ;LOAD LISTING CONTROL FLAGS. + TRNN LCND ; .NLIST CND IN EFFECT? + TLO R16,NLISLN ; YES - SUPPRESS LINE LISTING + POP P,R0 + RETURN + +; ORDINARY SYMBOLS ARE A SEQUENCE OF ALPHAMERIC CHARACTERS +; BEGINNING WITH AN ALPHABETIC CHARACTER; "@" AND "?" +; ARE CONSIDERED ALPHABETIC. + +; LOCAL SYMBOLS ARE A DECIMAL INTEGER FOLLOWED BY +; A "$". THE INTEGER'S VALUE MUST BE IN THE RANGE +; [1,65535]. + +; IF GETSYM FAILS TO FIND A SYMBOL, IT RETURNS TO 0(P) +; WITH R0 = 0. + +; IF THE NEXT NONBLANK TEXT IS A SYMBOL, GETSYM RETURNS TO +; 1(P) WITH THE SYMBOL'S MOD40 EQUIVALENT IN R0. +; ANY CHARACTERS AFTER THE SIXTH IN THE SYMBOL ARE SKIPPED. + +; FOR LOCAL SYMBOLS, THE VALUE RETURNED (IN R0) IS . . . +; LEFT HALF: INTEGER PART OF SYMBOL (16 BITS); +; HIGH ORDER BITS ARE 0 & 1 (200000) +; RIGHT HALF: BLOCK NUMBER OF CURRENT LOCAL SYMBOL BLOCK + + +SYMDEL: BLOCK 1 ; SYMBOL DELIMITER, SAVED BY GETSYM + +GETSYM: ;GET A SYMBOL + CALL SETNB ;BYPASS LEADING BLANKS + MOVEM R13,SYMBEG ;SAVE START FOR RESCAN + MOVSI R1,(440600,,R0) ;SET POINTER + TDZA R0,R0 ;CLEAR AC AND SKIP +GETSY1: CALL GETCHR ;GET NEXT CHARACTER + LDB R2,C8PNTR ;MAP CHARACTER TYPE + XCT GETSYT(R2) ;EXECUTE TABLE +GETSY0: SUBI R14,40 ;VALID, CONVERT TO SIXBIT + TLNE R1,770000 ;ARE WE FULL? + IDPB R14,R1 ; NO, STORE CHARACTER + JRST GETSY1 + +GETSY2: JUMPE R0,CPOPJ ;EXIT IF EMPTY + MOVEM RBYTE,SYMDEL ; SAVE SYMBOL DELIMITER FOR PARSERS. + CALL SETNB ;SYMBOL, RETURN NON-BLANK + CALL SIXM40 ;CONVERT TO MOD40 + JRST CPOPJ1 ;EXIT +1 + +GETSY3: SETCM R3,LOCRDX ;GET LOCAL RADIX COMPLEMENTED + TRNE R3,HEXRDX\HEXENB ;CHECK HEX RADIX AND HEX ENABLED + JRST GETSY0 ; NO, CONTINUE WITH SYMBOL + RETURN ; YES, EXIT EMPTY + +; ******* GET A LOCAL SYMBOL ******* + +; IF THE NUMERIC PART DOESN'T END WITH A "$", THIS +; CAN'T BE A LOCAL SYMBOL. IN THAT CASE RESTORE +; THE ORIGINAL SOURCE INPUT POINTER & RETURN SAYING +; NO SYMBOL WAS FOUND. + +; INITIAL ENTRY TO THIS BLOCK OF CODE IS AT GETLSY. + + +GETL1: CALL GETCHR ; GET NEXT BYTE + LDB R2,C8PNTR ; LOAD ITS TYPE + XCT GETLTS(R2) ; -- CHECK TYPE + + IMULI R0,10. ; TYPE IS NUMERIC -- ACCUMULATE +GETLSY: SUBI R14,"0 ; BINARY INTEGER. + ADD R0,R14 + JRST GETL1 + + +GETLDO: CALL GETCHR ; Dollar sign -- SKIP THIS BYTE + + CAIE R0, ; INSURE THAT INTEGER IS + CAIL R0,65536. ; IN [1,65535] + TRO RERR,ERRT ; GIVE A T FLAG IF IT ISN'T + TRZ R0,400000 ; FORCE HIGH ORDER BIT OFF, + TRO R0,200000 ; LOW ORDER BIT ON. + + HRL R0,R0 ; COPY INTEGER TO LEFT HALF, + HRR R0,LSBLOC ; LS BLOCK # TO RIGHT HALF. + JRST CPOPJ1 ; RETURN. + + +; --- FOUND A DISTINCTLY UNKOSHER CHARACTER BEFORE +; COMING ACROSS A "$". UNDECIDE THAT THIS IS A SYMBOL. + +GETLNS: MOVE R13,SYMBEG ; RESTORE INPUT POINTER + LDB R14,R13 ; RELOAD FIRST BYTE. + SETZ R0 ; RETURN 0 + RETURN + +GETNT: ; GET NON-TERMINATOR. + CALL GETCHR ; GET NEXT BYTE. + +TSTNT: ; TEST FOR NON-TERMINATOR. + LDB R4,C6PNTR ; LOAD CURRENT BYTE'S TYPE. + CAIE R4,SCLE ; IS IT END-OF-LINE OF ANY SORT? + AOS (P) ; NO -- RETURN + 2. + RETURN ; YES - RETURN + 1. + +SETCHI: TRO RERR,ERRI ; SET I FLAG FOR ILLEGAL CHAR. + ; DROP THRU TO GETCHR TO SKIP IT. + +GETCHR: ;GET THE NEXT CHARACTER + IBP RBPTR ;INDEX BYTE POINTER +SETCHR: ;SET THE CURRENT CHAR IN RBYTE + LDB RBYTE,RBPTR ;PICK IT UP + LDB R4,C6PNTR ; LOAD CHARACTER'S TYPE. + XCT SCHTAB(R4) ; CHECK FOR LOWER CASE & THINGS. + RETURN + + +GETEOL: CALL GETNT ; SKIP TO END OF LINE. + RETURN ; .... FOUND IT: RETURN. + JRST GETEOL ; .... NOT THERE YET: KEEP GOING. + +FOLTST: TLNN R16,FOLBIT ; IS FOLDING OVERRIDEN AT PRESENT? + SUBI RBYTE,40 ; NO -- FOLD INTO UPPER CASE. + RETURN ; RETURN WITH BYTE, FOLDED OR NOT. + +GETNB: ;GET NON-BLANK CHARACTER + IBP RBPTR ;INDEX BYTE POINTER +SETNB: ;SET TO NON-BLANK CHARACTER + CALL SETCHR ;SET CHARACTER IN RBYTE + CAIE RBYTE,SPACE ;IF SPACE + CAIN RBYTE,TAB ; OR TAB; + JRST GETNB ; BYPASS + RETURN ;OTHERWISE EXIT + +psout.: push p,r2 + hlrz r2,r1 + cain r2,-1 + hrli r1,440700 + skipa +psout1: .iot tyoch,r2 + ildb r2,r1 + jumpn r2,psout1 +psout2: pop p,r2 + return + + PAGSIZ==84. ; Default page size is 54 lines. + + COLLPT== 132. ;CPL LPT + + COLTTY== 79. ;CPL TTY + +$CRLF: .BYTE 7 ? CRR ? LF ? 0 ? .BYTE +TABCNT: BLOCK 1 +COLCNT: BLOCK 1 +LINCNT: BLOCK 1 ;EXEC LINE COUNTER +INPGNM: BLOCK 1 ; Input file page number + + CPL3== 144. ; CHARACTERS PER .PDP10 LINE + +LINBUF: BLOCK CPL3/5+2 ;SOURCE LINE BUFFER + +LSTFIL: + MOVE R10,[440700,,SFILNM] ; Load source file name pointer + CALL LSTASC ; List it + JRST LSTTAB ; List a tab and return + +LSTCR: TDZA R2,R2 ;LIST CR-LF +LSTTAB: MOVEI R2,TAB ;LIST A TAB +LSTOUT: ;LISTING ROUTINE + TLNN R16,LSTBIT ;LISTING REQUESTED? + CALL LPTOUT ; YES + TLNE R16,ERRBIT ;ERROR LISTING? + TLNE R16,TTYBIT ; YES, TO TTY? + RETURN ; NO + JUMPE R2,LSTOU1 ;BRANCH IF CR-LF + EXCH R1,R2 ; Save R1 and get the byte + PBOUT ; Output the byte + EXCH R1,R2 ; Restore R1 + RETURN ;EXIT + +LSTOU1: + PUSH P,R1 + HRROI R1,$CRLF + PSOUT + POP P,R1 + RETURN ;CR-LF TO TTY + +LPTOUT: ;OUTPUT TO LISTING DEVICE + SKIPGE LSTCNT ;IF LIST LEVEL IS NEGATIVE + RETURN ;THEN DON'T LIST +LPTOUA: TRZE R16,HDRBIT ;TIME FOR A HEADING? + CALL HEADER ; YES + JUMPE R2,LPTOU4 ;BRANCH IF CR-LF + CAIN R2,TAB + JRST LPTOU3 ;DON'T LIST TABS IMMEDIATELY + SKIPG TABCNT ;ANY TABS TO BE OUTPUT? + JRST LPTOU2 ; NO + PUSH P,R2 ;YES, STACK CURRENT CHARACTER +LPTOU1: MOVEI R2,7 + IORM R2,COLCNT ;FUDGE COLUMN COUNT + MOVEI R2,TAB + CALL LPTOU2 ;OUTPUT THE TAB + SOSE TABCNT ;DECREMENT, ANY MORE? + JRST LPTOU1 ;YES + POP P,R2 ;NO, RESTORE CHARACTER + +LPTOU2: AOSG COLCNT ;ANY COLUMNS AVAILABLE? + JRST LSTDMP ; YES + RETURN ; NO, EXIT + +LPTOU3: AOS TABCNT ;TAB, BUMP COUNT + RETURN + +LPTOU4: MOVEI R2,CRR ;CR-LF + CALL LSTDMP + MOVEI R2,LF + CALL LSTDMP + SOSG LINCNT ;END OF PAGE? +LPTINI: TRO R16,HDRBIT ; YES, SET FLAG + MOVNI R2,COLLPT ;SET FOR COLUMN COUNT + HRRZ R0,LSTCTL ; LOAD LIST CONTROL FLAGS + TRNE R0,LTTM ; IS IT TTY MODE? + MOVNI R2,COLTTY + MOVEM R2,COLCNT + SETZB R2,TABCNT ;ZERO TAB COUNT AND REGISTER + RETURN + +AC00: BLOCK 1 ;AC EXCHANGE BLOCK +AC01: BLOCK 1 +AC02: BLOCK 1 +AC03: BLOCK 1 +AC04: BLOCK 1 +AC05: BLOCK 1 +AC06: BLOCK 1 +AC07: BLOCK 1 +AC10: BLOCK 1 +AC11: BLOCK 1 +AC12: BLOCK 1 +AC13: BLOCK 1 +AC14: BLOCK 1 + +ACEXCH: ;SWAP AC'S + TLC R16,MODBIT ;TOGGLE MODE BIT + EXCH R0,AC00 + EXCH R1,AC01 + EXCH R2,AC02 + EXCH R3,AC03 + EXCH R4,AC04 + EXCH R5,AC05 + EXCH R6,AC06 + EXCH R7,AC07 + EXCH R10,AC10 + EXCH R11,AC11 + EXCH R12,AC12 + EXCH R13,AC13 + EXCH R14,AC14 + RETURN + + SUBTTL Print header on page routine + + +HEADER: CALL ACEXCH ;YES, SAVE THE ACCUMULATORS + PUSH P,R16 ;SAVE CURRENT FLAGS + MOVEI R2,FF ;GET A FORM FEED + CALL LSTOUT ;OUTPUT IT + MOVEI R10,PAGSIZ+3 ;RESET LINE COUNTER REGISTER + MOVEM R10,LINCNT ;... + SKIPN TTLFLA ;DO WE HAVE TITLE? + JRST [ MOVE R0,PRGTTL ; No - get program title + CALL LSTSYM ; and print it + JRST .+3 ] ; Merge back + MOVE R10,[440700,,TTLMSG] ;YES - PRINT OUT WHOLE TITLE + CALL LSTASC + CALL LSTTAB + MOVE R0,TITLE. + CALL LSTSIX + CALL LST3SP + MOVE R0,ASMVER ;PRINT VERSION NO. + CALL LSTSIX + CALL LST3SP + + MOVE R10,[440700,,DATSTR] ; LIST TIME AND DATE. + CALL LSTASC + +;THIS SECTION OF CODING PICKS UP THE WORD "PAGE " AND +;STORES IT IN THE PROPER PLACE IN THE TITLE BUFFER. + CALL LST3SP + MOVE R0,[SIXBIT /PAGE/] + CALL LSTSIX ;PRINT "PAGE" + MOVEI R2,40 + CALL LSTOUT ;SPACE + AOS INPGNM ; Increment source-oriented page number. + AOS R11,PAGNUM ; Increment actual page number. + + MOVE R2,LSTCTL ; Check for source-oriented numbering . . . + TRNE R2,LSON ; .list son in effect? + MOVS R11,INPGNM ; Yes - Get input-related page number. + ; No -- Keep output page number. + HLLM R11,(P) ; Save page extension, if any. + TLZ R11,-1 ; Trim down to source or listing page number. + CALL DNC ; Convert to decimal and print it. + + HLRZ R11,(P) ; Retrieve page extension. + JUMPE R11,NOPGEX ; ... 0 means there isn't one. + MOVEI R2,"- ; Output the separator for "page-ext". + CALL LSTOUT + CALL DNC ; Convert & print the extension. +NOPGEX: CALL LSTCR ; Terminate the line. + + +;THE FINAL SECTION OF CODE PICKS UP A SUBTITLE (IF AVAILABLE) +;AND PUTS IT ON THE SECOND LINE OF THE PAGE + CALL LSTFIL ;PRINT FILE NAME FIRST + TLNN R16,SBTBIT ;DO WE HAVE A SUBTITLE? + JRST NOSBTL ;NONE SEEN + MOVE R10,[440700,,SUBMSG] ; POINT TO SUBTITLE BUFFER + CALL LSTASC ; LIST IT. +NOSBTL: CALL LSTCR ; END THE LINE. + + CALL LSTCR ;SECOND LINE CRLF + POP P,R2 ;RESTORE FLAGS + JRST ACEXCH ;RESTORE F4 REGS AND EXIT + +LSTSYM: ;LIST SYMBOL + PUSH P,R0 + TLNE R0,200000 ; IS THIS A LOCAL SYMBOL? + JRST LSTLOC ; -- YES -- DECODE ITS NAME + ; -- NO -- SYMBOL IS IN MOD40 + CALL M40SIX ;CONVERT TO SIXBIT + PUSH P,R1 ;STACK A WORKING REGISTER + MOVSI R1,(440600,,R0) +LSTSY1: ILDB R2,R1 + ADDI R2,40 ;CONVERT TO ASCII + CALL LSTOUT + TLNE R1,770000 ;TEST FOR END + JRST LSTSY1 +LSTRET: POP P,R1 + POP P,R0 ;RESTORE ORIGINAL + RETURN + + +; ***** LIST A LOCAL SYMBOL ***** + +; SYMBOL'S NUMERIC PART IS A 16-BIT NON-ZERO BINARY +; INTEGER IN THE LEFT HALF OF R0. + +LSTLOC: TLZ R0,600000 ; RESET LOCAL SYMBOL FLAG BIT. + HLRZ R0,R0 ; ALIGN NUMERIC PART IN RIGHT HALF + PUSH P,R1 ; SAVE WORKING REGS + PUSH P,R3 + MOVEI R3,6 ; INIT BYTE COUNT TO 6 + ; FOR COUNT DOWN TO 0. + +; CONVERT NUMERIC PART OF SYMBOL TO DECIMAL. + + CALL LSTLNU + + MOVEI R2,"$ ; SUPPLY "$" SUFFIX + CALL LSTOUT + SOJE R3,LSTL5 ; QUIT IF FIELD IS FULL + +LSTL4: CALL LSTSP ; PAD TO 6 BYTES WITH SPACES + SOJG R3,LSTL4 + +LSTL5: POP P,R3 ; RESTORE WORK REGS & RETURN + JRST LSTRET + +; RECURSIVE SUBROUTINE TO PRINT A DECIMAL NUMBER +; DECREMENTING A BYTE COUNT IN R3 .... + +LSTLNU: IDIVI R0,10. ; GENERATE NEXT DIGIT. + HRLM R1,0(P) ; SAVE FOR PRINTING IN REVERSE ORDER. + CAIE R0,0 ; WAS QUOTIENT 0? + CALL LSTLNU ; NO -- REPEAT FOR NEXT DIGIT. + SOJ R3, ; YES - DECREMENT BYTE COUNT. + HLRZ R2,0(P) ; PICK UP NEXT DIGIT, + JRST LSTNUM ; PRINT IT, & POP BACK TO CALLER. + +LSTASC: ILDB R2,R10 ; LOAD NEXT BYTE. + JUMPE R2,CPOPJ ; QUIT WHEN FINDING A 0 BYTE. + CALL LSTOUT ; OUTPUT THE BYTE. + JRST LSTASC +LSTSIX: MOVSI R6,(440600,,R0) +LSTSI1: ILDB R2,R6 + JUMPE R2,CPOPJ + ADDI R2,40 + CALL LSTOUT + TLNE R6,770000 + JRST LSTSI1 + RETURN + +LST3SP: ;LIST SPACES + CALL LSTSP +LST2SP: CALL LSTSP +LSTSP: MOVEI R2,SPACE + JRST LSTOUT + +DNC: IDIVI R11,10. ;RECURSIVE SUBROUTINE + HRLM R12,0(P) ;SAVE REMAINDER ON PUSHDOWN LIST + CAIE R11, ;ALL DONE? + CALL DNC ;NO, CALL DNC AGAIN + HLRZ R2,0(P) ;RETRIEVE NUMBER FROM PD LIST + JRST LSTNUM ;LIST NUMERIC AND EXIT + +; List a 16-bit hex address, in right half of R0. + +LSTHEX: MOVE R1,[200400,,R0] ; Set pointer before 1st hex digit. + +; Output hex digits until the byte pointer increments +; from R0 to R1. + +LSTH1: ILDB R2,R1 ; Get next hex digit. + TRNE R1,1 ; Did pointer increment past R0? + RETURN ; Yes - Finished. + TRO R2,"0 ; Convert to ascii for 0-9. + CAILE R2,"9 ; Was this digit in range A-F? + ADDI R2,7 ; Yes - Convert to alphabetic ascii. + PUSH P,R0 ; Save registers from LSTOUT. + PUSH P,R1 + CALL LSTOUT ; Output the byte. + POP P,R1 ; Restore registers. + POP P,R0 + JRST LSTH1 ; Repeat for next digit. + +; List a single hex byte. + +LSTHB: MOVE R1,[100400,,R0] ; Set pointer for rightmost 8 bits. + JRST LSTH1 ; Output 2 digits. + +LSTNUM: TROA R2,"0 ;LIST NUMERIC + ADDI R2,40 ;CONVERT SIXBIT TO ASCII + JRST LSTOUT +; =========== SUBROUTINE FORSEQ -============== + +; FORMAT A SEQUENCE NUMBER FOR AN OUTPUT LINE. +; THE BINARY LINE SEQUENCE NUMBER IS LOCATION SEQ; +; THE FORMATTED VERSION IS LOCATION FSEQ. + +; IF THE LINE WAS EXPANDED FROM A MACRO, PRINT THE +; MACRO CALL NESTING LEVEL TO THE LEFT OF THE LINE +; NUMBER. + +; AT RETURN, . . . + +; FSEQ CONTAINS AN ASCIZ-STYLE STRING, +; R6 CONTAINS A POINTER TO ITS FIRST BYTE, +; R2 CONTAINS THE FIRST BYTE. + + +FORSEQ: SETZM FSEQ ; CLEAR FORMATTED STRING FIELDS. + SETZB R2,FSEQ+1 ; R2 = 0 TO COUNT BYTES. + MOVE R0,SEQ ; LOAD BINARY SEQUENCE NUMBER. + +; SEQUENCE NUMBER CONVERSION IS BINARY TO DECIMAL, ONE BYTE +; AT A TIME VIA REPEATED DIVISION BY 10. BYTES ARE PUSHED +; ONTO THE STACK IN ASCENDING ORDER OF SIGNIFICANCE. + +FSCVT: IDIVI R0,10. ; DIVIDE TO GET (#/10, # MOD 10). + TRO R1,"0 ; CONVERT DIGIT TO ASCII. + PUSH P,R1 ; PUSH IT ONTO THE STACK. + AOJ R2, ; INCREMENT DIGIT COUNT. + JUMPN R0,FSCVT ; REPEAT UNTIL QUOTIENT GOES TO 0. + +; R2 = # OF SIGNIFICANT DIGITS. FIGURE OUT HOW MANY +; BLANKS TO FORMAT IN ORDER TO RIGHT-JUSTIFY THE SEQUENCE +; NUMBER. . . + +; # OF BLANKS = 7 - M - S - E, WHERE +; M = # OF DIGITS IN MACRO LEVEL +; S = # OF SIGNIFICANT DIGITS +; E = # OF ERROR FLAGS PRINTED + +; S IS IN R2; COMPUTE 7-E IN R0 BY COUNTING THE NUMBER +; OF BITS ON IN RERR (RIGHT HALF OF R15). + + MOVEI R3,7 + TLNN R16,MEXBIT ; IS THIS LINE FROM A MACRO EXPANSION? + JRST FSNM ; NO -- JUST FORMAT SEQ NUM. + MOVE R0,MACLVL ; YES - LOAD CALL NESTING LEVEL. + PUSH P,R2 ; KEEP R2 KOSHER & + CALL LSTLNU ; PRINT MACLVL WITH A BORROWED SUBR. + POP P,R2 + +FSNM: HRRZ R6,RERR ; SET R6 TO ERROR FLAGS. + JUMPE R6,FSCDUN ; DONE IF NO BITS ON. + +; THE FOLLOWING LOOP IS ITERATED ONCE FOR EACH +; 1 BIT IN R6. R6 IS DESTROYED IN THE PROCESS +; OF COUNTING ITS BITS. + +FSCNT: SOJ R3, ; DECREMENT BLANK COUNT. + MOVN R1,R6 ; A XOR (-A) TURNS OFF LOW BIT, + XOR R1,R6 ; WHEREVER IT MAY BE. + AND R1,R6 ; RECONSTRUCT HIGH ORDER BITS. + MOVE R6,R1 ; COPY BACK FOR NEXT ITERATION. + JUMPN R6,FSCNT ; REPEAT UNLESS NO BITS REMAIN. + +; END OF BIT COUNT -- R3 = 7-M-E. + +FSCDUN: MOVE R6,[440700,,FSEQ] ; LOAD SEQ FIELD POINTER. + SUB R3,R2 ; BLANK COUNT = (7-E)-S. + JUMPLE R2,FSDIGT ; BEWARE GOBS OF FLAGS! + MOVEI R1,40 ; LOAD LITERAL BLANK TO DEPOSIT. + +FSLEAD: IDPB R1,R6 ; SUPPLY A LEADING BLANK. + SOJG R3,FSLEAD ; REPEAT TIL COUNT IS EXHAUSTED. + +; POP SIGNIFICANT DIGITS OFF THE STACK (IN DESCENDING +; ORDER OF SIGNIFICANCE) & APPEND TO FSEQ. + +FSDIGT: POP P,R1 ; GET NEXT DIGIT. + IDPB R1,R6 ; STORE IN FSEQ. + SOJG R2,FSDIGT ; REPEAT TIL ALL DIGITS DONE. + +; LOAD REGS WITH BYTE & BYTE POINTER, THEN RETURN. + + MOVE R6,[440700,,FSEQ] ; LOAD PTR TO START OF FIELD. + ILDB R2,R6 ; LOAD FIRST BYTE. + RETURN + + +; LOWER CASE CHARACTER -- FOLD INTO UPPER CASE +; UNLESS .ENABL LC IS IN EFFECT. + +CHFOLD: TLNN RMODE,LCFLG ; IS LOWER CASE ENABLED? + SUBI R14,40 ; NO - FOLD INTO UPPER CASE. + RETURN + +; Enter line number of a reference +; in a symbol's cross ref list. + +CRFREF: + TLNE R15,P1F ; Is this pass 2? + RETURN ; No -- Don't bother with ref's. + PUSH P,R1 ; Save volatile registers. + PUSH P,R2 + + MOVE R1,@CR1PNT ; Retrieve 1st cref word. + TRNE R1,-1 ; Is 1st reference slot empty? + JRST CREF1 ; No -- Check second. + HRR R1,SEQ ; Yes - Set it to + MOVEM R1,@CR1PNT ; current line number. + JRST CRET ; Return. + +CREF1: MOVE R1,@CR2PNT ; Retrieve 2nd cref word. + TLNE R1,-1 ; Is 2nd ref slot empty? + JRST CREF2 ; No -- Look for 1st ref block. + HRL R1,SEQ ; Yes - Set it to current line #. + MOVEM R1,@CR2PNT + JRST CRET ; Return. + +CREF2: HRRZ R2,R1 ; Set R2 = addr(1st cref block). + JUMPN R2,CREF3 ; Proceed if one exists. + +; Symbol table entry doesn't have any reference blocks linked +; to it. Allocate the first one and set last half word of +; cref info in the symtab entry to point to it. + + CALL GBLOCK ; Get a block for reference info. + HRR R1,R2 ; Set new block loc in symtab link. + MOVEM R1,@CR2PNT + JRST CREF9 ; Set first entry in new block. + +CREF3: HRLI R2,- ; Scan all but last word of ref block. + +CREF4: MOVE R1,0(R2) ; Get next word. + TLNE R1,-1 ; Is 1st (left) slot open? + JRST CREF5 ; No -- Try right half. + HRL R1,SEQ ; Yes - Set it. + MOVEM R1,0(R2) + JRST CRET ; Return. + +CREF5: TRNE R1,-1 ; Is 2nd (right) slot open? + JRST CREF6 ; No -- Try next word. + HRR R1,SEQ ; Yes - Set it. + MOVEM R1,0(R2) + JRST CRET ; Return. + +CREF6: AOBJN R2,CREF4 ; Advance to next word. + +; This block's full: Get next. + + MOVE R1,R2 ; Save pointer to current block. + SKIPE R2,0(R2) ; Is there another block in chain? + JRST CREF3 ; Yes - Search it. + CALL GBLOCK ; No -- Get a new one. + HRRM R2,0(R1) ; Set link to new block. + +CREF9: MOVE R1,SEQ ; Set first entry in a new block + HRLM R1,0(R2) ; to current line number. +CRET: POP P,R2 ; Restore volatile registers. + POP P,R1 + RETURN ; Return. + +LSTBUF: BLOCK 50 ; Output line buffer area [ECL2] +LSTBFL=<.-LSTBUF>*5-1 ; number of characters buffer [ECL2] + ; will hold [ECL2] +LSTBFC: BLOCK 1 ; count of chars left in lstbuf [ECL2] +LINPTR: BLOCK 1 ; Changing string pointer + +LSTDMP: + TLNE R16,LSTBIT ; Need to print? + RETURN ; No, just return now + IDPB R2,LINPTR ; No - save it in the line + SOSG LSTBFC ; Full buffer? [ECL2] + JRST LSTDM1 ; yes, dump the buffer [ECL2] + CAIE R2,LF ; Dump the line? + RETURN ; Return now + +LSTDM1: + PUSH P,R1 ; Save some registers for SOUT + PUSH P,R2 + PUSH P,R3 + SETZ R3, ; ASCIZ string to output + IDPB R3,LINPTR ; Make it so +;; MOVE R1,LSTJFN ; Load listing JFN + HRROI R2,LSTBUF ; Get pointer to the output line buffer +;; SOUT ; Dump it + + tlza r2,337077 +lstdmi: .iot lstch,r1 + ildb r1,r2 + jumpn r1,lstdmi + + MOVE R1,[440700,,lstbuf] ; Load original string pointer + MOVEM R1,LINPTR ; Reset byte pointer + MOVEI R1,LSTBFL ; buffer length [ECL2] + MOVEM R1,LSTBFC ; count left [ECL2] + POP P,R3 ; Restore clobbered registers + POP P,R2 + POP P,R1 + RETURN ; Exit +; Output code accumulated in CODBUF and reset the buffer +; for further assembly. + +; Alternate entries are TROUT, which outputs a transfer address +; when the code buffer is empty, and CODRES, which is used +; to reset buffer info at the start of each pass. + +; Output record format: + +; +0 LSB of data start address +; +1 MSB of data start address +; +2 Count of data bytes (n) +; +3 to +(n+2) Data +; +(n+3) Negated checksum + + + +CHKSUM: BLOCK 1 ;CHECK SUM + +CODOUT: + +; First update the checksum value for the current code segment. + + MOVE R1,CURSUM ; Current sum value = cursum. + MOVE R2,[441000,,CODBUF] ; Set pointer to start of CODBUF. + +CSUP: CAMN R2,CODPNT ; At end of data in CODBUF? + JRST CSET ; Yes - Set checksum. + ILDB R0,R2 ; No -- Get next byte. + ADD R1,R0 ; Sum = sum + (current byte). + JRST CSUP ; Repeat until reaching end of data. + +CSET: MOVEM R1,CURSUM ; Store updated checksum value. + MOVE R0,CODPNT ; Retrieve current buffer pointer. + CAMN R0,[441000,,CODBUF] ; Is the buffer empty? + JRST CODRES ; Yes - Skip physical output. +TROUT: TLNE R15,P1F ; Is this pass 1? + JRST CODRES ; Yes - Just reset the buffer. + TLNE R16,BINBIT ; Is binary output suppressed? + JRST CODRES ; Yes - Skip physical output. + + +; Output the data start address. + +;; MOVE R1,BINJFN ; Preload output file's jfn. + HRRZ R2,CODLOC ; Get PC value for start of line. + ADDM R2,CHKSUM ; Subtract from checksum. +;; BOUT ; Output it. + call binout + + HRRZ R2,CODLOC ; Retrieve data address again. + LSH R2,-8 ; Discard LSB, align MSB for output. + ADDM R2,CHKSUM ; Account for it in checksum. +;; BOUT ; Output it. + call binout + +; Compute length of data and subtract each data byte from +; the checksum. Data will ultimately be output via SOUT. + +; This code operates correctly even when the buffer is +; empty, as required for output of a transfer address. + + MOVE R2,[441000,,CODBUF] ; Point to first data byte. + SETZ R3, ; Initial count = 0. + +CODOU1: CAMN R2,CODPNT ; Has scan reached end of data? + JRST CODOU2 ; Yes - Do physical i/o. + ILDB R0,R2 ; No -- Get next byte. + ADDM R0,CHKSUM ; Subtract byte from checksum. + SOJA R3,CODOU1 ; Count the byte & go back for next. + +CODOU2: MOVN R2,R3 ; Output byte count as positive #. + ADDM R2,CHKSUM ; Include it in checksum. +;; BOUT + call binout + + JUMPE R3,CODOU3 ; Skip SOUT if there's no data. +;; MOVE R2,[441000,,CODBUF] ; Output the data as a single string. +;; SOUT + push p,r4 + move r4,[441000,,codbuf] +bnsout: ildb r2,r4 + call binout + aojl r3,bnsout + pop p,r4 + +CODOU3: MOVN R2,CHKSUM ; Finally, output the checksum. +;; BOUT + call binout + + +; Reset code buffer information. + +CODRES: MOVEM RLOC,CODLOC ; Next data addr is current PC. + MOVE R0,[441000,,CODBUF] ; Reset buffer pointer + MOVEM R0,CODPNT ; to start of buffer. + SETZM CHKSUM ; Initial checksum = 0. + RETURN + +binblk: 0 ? 0 ? 0 ? 0 +lstblk: 0 ? 0 ? 0 ? 0 + +; Now we can open the file (end of pass 1). +SETBIN: + TLNE R16,BINBIT ; Do we have a binary file to open? + RETURN ; Nope, return then + CALL ACEXCH ; Get EXEC's ACs + syscal open,[%clbit,,.uio ? %climm,,binch + binblk+0 ? binblk+1 ? binblk+2 ? binblk+3] + .Lose %LsFil + JRST ACEXCH ; Swap AC's and return + +binsz=2000 + +binbf: block binsz +binptr: 441000,,binbf + +binout: idpb R2,binptr + move R1,binptr + came R1,[041000,,binbf+binsz-1] + return + move R1,[441000,,binbf] + movem R1,binptr + hrli R1,444400 + movei R2,binsz + syscal siot,[%climm,,binch ? R1 ? R2] + .Lose %LsFil + return + +bincls: skipge r1,binptr + jrst bincl1 ;Negative, must be 441000,,binbf + movei r1,1-binbf(r1) + move r2,[444400,,binbf] + syscal siot,[%climm,,binch ? r2 ? r1] + .Lose %LsFil +bincl1: .close binch, + return + +XESAVE: BLOCK 1 ;FILE NAME STORAGE FOR TTY ERROR MESSAGES +ERRCNT: BLOCK 1 ;ERROR COUNT + +ENDLR: ;END OF LINE PROCESSOR + +; The following test detects an extraneous symbol +; at the start of a line: If the first item on a line +; is a symbol it should have been processed by EQU or SET, +; which reset STRSYM to 0. + + SKIPE STRSYM ; Unprocessed symbol at start of line? + TRO RERR,ERRQ ; Yes - Flag error & ignore it. + TLNE R15,P1F + JRST ENDLFA ;BYPASS IF PASS 1 + MOVE R11,RBPTR ; SAVE POINTER TO CURRENT BYTE. + CALL SETNB ;SET FIRST NON-BLANK + CAIE R14,0 ;IF NULL + CAIN R14,"; ;OR SEMI-COLON + JRST ENDLF ; BRANCH O.K. + + SETZ R11, ; NOT AT A COMMENT - CLEAR R11 + ; TO SHOW NO COMMENT + CAIN R14,CRR ;CARRIAGE RETURN? + CALL GETCHR ; YES, BYPASS IT + CAIE R14,LF ;IF LINE FEED + CAIN R14,FF ; OR FORM FEED, + CAIA ; O.K. + TRO R15,ERRQ ;OTHERWISE FLAG Q ERROR + +ENDLF: ;ENDL FIN +; THE NEXT FEW LINES HANDLE .NLIST COM. THE CODE +; FOLLOWING LOCATION ENDL HAS LEFT R11 AS . . . +; 0 IF FIRST UNPARSED TEXT ISN'T COMMENT, OR +; BYTE POINTER TO BEGINNING OF COMMENT. + + JUMPE R11,ENDLFA ; SKIP COM CHECK IF NOT AT COMMENT. + SETZ R2, ; PREPARE NULL BYTE IN R2 + MOVE R0,LSTCTL ; LOAD LISTING CONTROL FLAGS. + TRNN R0,LCOM ; ARE COMMENTS BEING LISTED? + DPB R2,R11 ; NO - STORE NULL AT COM START. + +; WHEN THE LINE IS LISTED LATER THE NULL BYTE IS TAKEN AS +; A SIGNAL TO STOP LISTING THE LINE. THE CODE IMMEDIATELY +; PRECEDING LOCATION ENDL10 HANDLES THIS. + +ENDLFA:ENDLC: TRZN R15,ERRP1 ; LIST ON PASS 1? + TLNN R15,P1F ; NO, ARE WE IN PASS2? + CAIA ; YES, LIST THIS LINE + JRST ENDL11 ;PASS 1, NO ERRORS, DON'T LIST + TRNN R15,-1 ;ANY ERRORS? + JRST ENDL6 ; NO + + AOS ERRCNT ; YES, TALLY ERROR COUNT + TLZ R16,NLISLN ; OVERRIDE LINE LIST SUPPRESSION + TLO R16,ERRBIT ;MESSAGE TO TTY + MOVE R1,SRCJFN ; Get current source file JFN + CAMN R1,XESAVE ; Same as before? + JRST ENDL4 ; Yes - don't print file name + MOVEM R1,XESAVE ; No - save it for next time and print filename + HRROI R1,SFILNM ; String pointer to current source file + PSOUT ; Print it + HRROI R1,$crlf + PSOUT +ENDL4: HRLZ R0,R15 ;PUT FLAGS IN AC0 LEFT + MOVE R1,[440700,,[ASCII /ABDEILMOPQRTUNZ/]] +ENDL5: ILDB R2,R1 ;FETCH CHARACTER + CAIGE R0, ;THIS CHARACTER? + CALL LSTOUT ; YES + LSH R0,1 + JUMPN R0,ENDL5 ;TEST FOR END +ENDL6: TLNE R16,NLISLN ; SUPPRESS LIST OF THIS LINE? + JRST ENDL12 ; YES - JUST CLEAN UP + + MOVE R0,LSTCTL ; Get listing mode flags + +; *** CHECK FOR MACRO EXPANSION LIST MODES *** + +; .LIST ME ** LIST ALL GENERATED LINES +; .NLIST ME, .LIST MEB ** LIST LINES WHICH GEN CODE +; .NLIST ME, .NLIST MEB ** LIST NO EXPANDED LINES + + TLNN R16,MEXBIT ; IS MACRO EXPANSION IN PROGRESS? + JRST ENDL6A ; ** NO - LIST THE LINE + TRNE RERR,-1 ; ** YES - IF LINE HAD ERRORS + JRST ENDL6A ; LIST IT REGARDLESS OF OPTIONS. + + TRNE R0,LME ; Is .LIST ME in effect? + JRST ENDL6A ; Yes - List the line. + TRNN R0,LMEB ; No -- .LIST MEB in effect? + JRST ENDL12 ; No -- Don't list it. + MOVE R0,IPNT ; Yes - List only if + CAMN R0,CODPNT ; it generated code. + JRST ENDL12 + +; *** CHECK FOR COMPLETELY BLANK LINE TO BE LISTED *** +; SUCH A LINE SHOULD BE LISTED AS ONLY CR/LF +; FOR THE SAKE OF LISTING READABILITY & EFFICIENCY. + +ENDL6A: + TRNN R16,ASCBIT ; Suppress binary listing? + JRST ENDL6B ; No - don't fiddle with listing mode + TLNE R16,BEXBIT ; Continuation of a line? + JRST ENDL11 ; Yes - skip all of this then + PUSH P,R0 ; Save current listing mode + TRZE R0,LBIN ; Test binary listing bit and clear it + MOVEM R0,LSTCTL ; Wasn't off so set this mode word + CALL PRNTA ; List it + POP P,LSTCTL ; Restore listing mode word + TRNA ; Skip over binary listing call +ENDL6B: CALL PRNTA ;LIST THE OCTAL + +ENDL8: TRNE RERR,-1 ; DID LINE HAVE ERRORS? + JRST ENDL8A ; YES - ALWAYS LIST SOURCE. + MOVE R0,LSTCTL ; NO - CHECK FOR .NLIST SRC. + TRNN R0,LSRC ; IS SOURCE LIST WANTED? + JRST ENDL10 ; NO - SKIP IT. + +ENDL8A: CALL LSTTAB + SKIPA R6,[440700,,LINBUF] ;GET SET TO PRINT LINE +ENDL9: CALL LSTOUT ;LIST A CHARACTER +ENDL9A: ILDB R2,R6 ;GET ANOTHER CHARACTER + CAIN R2,ELLCHR ;END OF LOGICAL LINE CHAR? + JRST ENDL9A ; YES, DON'T LIST + CAIN R2,ILLCHR ;ILLEGAL? + MOVEI R2,"? ; YES, REPLACE WITH QM + CAIL R2,12 ;DON'T LIST IF BETWEEN LF + CAILE R2,15 ; AND CARRIAGE RETURN + JUMPN R2,ENDL9 ;TEST FOR END + JUMPN R2,ENDL9A ;BRANCH IF CR-LF +ENDL10: CALL LSTCR ;END,LIST CR/LF +ENDL11: CALL ENDLIF ;SEMI-INIT LINE + TLNE RMODE,P1F ; Which pass is this? + JRST ENDL12 ; 1 -- No listing. + MOVE R0,IPNT ; 2 -- Did binary output listing + CAMN R0,CODPNT ; overflow its field? + JRST ENDL12 ; No -- Line listing's complete. + ; Yes - List binary extension + ; on new line. + +; ****** BINARY EXTENSION PROCESSING ******* + + TLO R16,BEXBIT ; FLAG STATE OF LISTING EXTENSION. + MOVE R0,LSTCTL ; CHECK LIST OPTIONS -- + TRNE R0,LBEX ; ARE BINARY EXTENSIONS TO LIST? + JRST ENDLC ; Yes - List it. + ; No -- Finish up. + +ENDL12: + HRRZ R0,CODPNT ; Get current binary output pointer. + CAIL R0,CODBUF+30 ; About 128 bytes available? + CALL CODOUT ; Yes - Dump the buffer. + SKIPL LSTCNT ; If .NLIST'd then forget formfeed check + TRNN R16,FFBIT ;FORM FEED ENCOUNTERED? + JRST ENDLI ; NO + TLNN RMODE,P1F ; IF THIS IS PASS 2 . . . + TRO R16,HDRBIT ;SET HEADER BIT + HLLOS INPGNM ; Skip to next page. +ENDLI: TRZ R16,ASCBIT\FFBIT ; Reset ASCII output flag and formfeed bit +ENDLIF: AND R5,[PCMASK] ;CLEAN UP PC + SETZM GLBPNT ;CLEAR GLOBAL POINTER + SETZB R2,PF1 + DPB R2,[350700,,LINBUF] ;FLAG LINE + TRZ R15,-1 + TLZ R16,ERRBIT\LBLBIT\PF1BIT\BEXBIT + + SKIPN R4,SKPCNT ; Is current line .skip directive? + RETURN ; No -- Return. + SETZB R2,SKPCNT ; Yes - Skip some lines. + +SKIPL.: CALL LSTOUT ; List an empty line. + SOJG R4,SKIPL. ; Iterate (SKPCNT) times. + + RETURN + +; PRNTA LISTS ASSEMBLER - GENERATED INFORMATION +; AT THE LEFT SIDE OF EACH LINE: + +; -- LINE NUMBER FIELD +; -- LOCATION (UNLESS .NLIST LOC IS IN EFFECT) +; -- BINARY CODE (UNLESS .NLIST BIN IS IN EFFECT) + +; .. THREE WORDS OF BINARY CODE ARE LISTED +; IF TTM LISTING MODE IS NOT IN EFFECT. +; .. ONE WORD OF BINARY CODE IS LISTED +; IF TTM LISTING MODE IS IN EFFECT + +; PRNTA IS CALLED FROM ONLY ONE PLACE (A LOCATION +; BETWEEN ENDL6 AND ENDL7). + +PRNTA: ;PRINT BASIC LINE OCTAL + + MOVE R0,LSTCTL ; **** SEQ # FIELD **** + TRNN R0,LSEQ ; SEQUENCE # TO BE LISTED? + JRST PRNTA0 ; NO - JUST TAB TO LOC FIELD + TLNE R16,BEXBIT ; YES - LIST SEQ UNLESS THIS + JRST PRNTA0 ; IS A BINARY EXTENSION LINE. +; =========== LIST LINE SEQUENCE NUMBER =========== + + CALL FORSEQ ; FORMAT THE FIELD. +PRNSEQ: CALL LSTOUT ; LIST A BYTE OF IT. + ILDB R2,R6 ; GET NEXT BYTE + JUMPN R2,PRNSEQ ; REPEAT UNTIL FINDING 0 BYTE. + +PRNTA0: CALL LSTTAB ;LIST A TAB + + MOVE R0,LSTCTL ; **** LOCATION FIELD **** + TRNN R0,LLOC ; IS LOC TO BE LISTED? + JRST PRNTA1 ; NO - GO TO NEXT FIELD. + ; YES - PRINT LOC IF IT WAS GENERATED. + TLNE R16,LBLBIT ;Force loc to be printed? + JRST PRNTAL ; Yes, go print it + SKIPE PF1 ; Alternate output format to be used? + JRST PRNTA3 ; Yes - Leave loc field blank. + MOVE R0,IPNT ; No -- . . . + CAMN R0,CODPNT ; Any code generated on this line? + JRST PRNTA3 ; No -- Leave loc field blank. +PRNTAL: MOVE R0,ILOC ; Yes - List PC value + CALL LSTHEX ; at start of line. +PRNTA3: CALL LSTTAB ;OUTPUT TAB + +PRNTA1: MOVE R0,LSTCTL ; **** BINARY FIELD **** + TRNN R0,LBIN ; BINARY TO BE LISTED? + JRST PRNTA2 ; No - fill fields with tabs + ; YES - LIST WHATEVER WAS GENERATED. + MOVE R0,PF1 ; Retrieve "alternate" binary field. + JUMPE PRNTA4 ; Alternate list format requested? + CALL LSTHEX ; Yes - List 16-bit address + JRST PRNTA2 ; stored in PF1. + +PRNTA4: MOVE R10,IPNT ; Get pointer to line's 1st byte of data + CAMN R10,CODPNT ; Was any data generated? + JRST PRNTA2 ; No -- Leave field blank. + ; Yes - List data from CODBUF. + +; List data generated by current line. Limit this to +; 7 bytes for output to a line printer, or 3 bytes for +; output to a teletype. Remaining data will appear on +; subsequent lines if .LIST BEX is in effect. + + MOVEI R6,11. ; Set byte counter for 11 bytes. + MOVE R0,LSTCTL ; Retrieve listing flags. + TRNE R0,LTTM ; Is .LIST TTM in effect? + MOVEI R6,7 ; Yes - Reset for 7 bytes. + +PRNTA5: ILDB R0,R10 ; Get next byte of binary data. + CALL LSTHB ; List it. + CAME R10,CODPNT ; Was it the last byte generated? + SOJG R6,PRNTA5 ; No -- List next byte if room allows + +; Finished listing available data or available space to format +; was exhausted: Save necessary info for binary extension processing +; and align to source field. + + MOVEM R10,IPNT ; Save pointer to last byte output. + CAILE R6,8. ; Is there space for 2 tabs? + CALL LSTTAB ; Yes - List first. + CAILE R6,4 ; Space for 1 tab yet? + CALL LSTTAB ; Yes - List it. + RETURN + + +PRNTA2: + CALL LSTTAB ; Tab across PF1 + MOVE R0,LSTCTL ; Get listing mode + TRNN R0,LTTM ; Teletype mode? + CALL LSTTAB ; No - fill with a tab + RETURN ; Yes- return + +SEQND: BLOCK 1 ; # of significant digits in largest seq #. + + +SYMTB: ;LIST THE SYMBOL TABLE +;; MOVE R1,[440700,,SUBMSG] ; Set subhead string. +;; HRROI R2,[ASCIZ /Symbol table/ ] +;; SETZ R3, +;; SOUT ; Copy string via SOUT. + move r1,[ascii/Symbo/] + movem r1,submsg + move r1,[ascii/l tab/] + movem r1,submsg+1 + move r1,[ascii/le/] + movem r1,submsg+2 + SETZ R7, ; Set initial table index = 0. +;; IDPB R7,R1 ; Use it as delimiter for string. + TLO R16,SBTBIT ; Indicate subtitle present. + TRO R16,HDRBIT ; Force a page skip. + + MOVE R0,SEQ ; Check on number of significant + CALL NSIG ; digits in last sequence number. + MOVEM R4,SEQND ; Save to compute line # padding count. + +SYMTBE: CALL LSTCR ; Terminate current line. + CALL GETSTE ; Get next symbol table entry. + RETURN ; No more => quit. + + CALL LSTSYM ; List the symbol itself. + + CALL LSTTAB ; Tab to definition field. + HLRZ R0,@CR1PNT ; Get definition line number. + SKIPE R0 ; 0 => undefined symbol. + CALL LSTLN ; List definition line #. + + CALL LSTTAB ; Tab to value field. + MOVE R0,@VALPNT ; Get symbol's value. + TLNE R0,DEFSYM ; Is symbol defined? + CALL LSTHEX ; Yes - Output value in hex. + ; No -- Leave field blank. + +; List references to this symbol. + + CALL SYMSET ; Set counter for # ref's to go + ; before starting new line. + HRRZ R0,@CR1PNT ; Get first reference. + JUMPE R0,SYMTBE ; 0 => no ref's: Done with symbol. + CALL LSTTAB ; Tab to first ref field. + HRRZ R0,@CR1PNT ; Retrieve 1st ref line number. + CALL LSTLN ; List it. + + HLRZ R0,@CR2PNT ; Check second reference. + JUMPE R0,SYMTBE ; 0 => No more for this symbol. + CALL LSTTAB ; Tab to second ref field. + HLRZ R0,@CR2PNT ; Restore ref line number. + CALL LSTLN ; List it. + + HRRZ R0,@CR2PNT ; Get link to first ref block. + JUMPE R0,SYMTBE ; None => done with symbol. + SOJ R10, ; Account for starting with 2 refs. + + +SYMTB2: MOVE R11,R0 ; Set pointer & counter + HRLI R11,- ; to scan ref block. + +SYMTB3: HLRZ R0,0(R11) ; Check left half of current word. + JUMPE R0,SYMTBE ; Empty => no more for this symbol. + SOJG R10,.+2 ; Is there room on the line for 1 more? + CALL SYMRLE ; No -- Advance to next line. + CALL LSTTAB ; Tab to next ref field. + HLRZ R0,0(R11) ; Retrieve current reference. + CALL LSTLN ; List it. + + HRRZ R0,0(R11) ; Repeat same procedure + JUMPE R0,SYMTBE ; for reference in right half + SOJG R10,.+2 ; of current word. + CALL SYMRLE + CALL LSTTAB + HRRZ R0,0(R11) + CALL LSTLN + + AOBJN R11,SYMTB3 ; Advance to next word. + +; Block's full: Find next block, if any. + + MOVE R0,0(R11) ; Get link to next ref block. + JUMPN R0,SYMTB3 ; One exists: Scan it. + JRST SYMTBE ; No more: End for this symbol. + + +; Filled a line with references & there's another to print. + +SYMRLE: CALL LSTCR ; Terminate current line. + CALL LSTTAB ; Output 2 tabs; caller will + CALL LSTTAB ; supply 3rd to align with + ; 1st reference field. + +; Reset count of available reference fields left in line. + +SYMSET: MOVEI R10,12. ; Presume 12 fields for a printer. + HRRZ R0,LSTCTL ; Check for .LIST TTM . . . + TRNE R0,LTTM ; Listing in teletype mode? + MOVEI R10,7 ; Yes - Limit it to 7 refs/line. + RETURN + + +GETSTE: ;GET SYMBOL TABLE ENTRY + ADDI R7,4 ;MOVE UP four + CAML R7,SYMLEN ;TEST FOR END + RETURN ; YES, EXIT + MOVE R0,@SYMPNT + MOVE R1,@VALPNT + LDB R2,TYPPNT + JUMPN R2,GETSTE ;BYPASS IF OP + JRST CPOPJ1 ;OK, PERFORM SKIP-RETURN +; Compute number of significant decimal digits for +; the number in R0. + +; At return R4 = digit count, R0 = 0. + +NSIG: SETZ R4, ; Initial digit count = 0. + +NSIG1: AOJ R4, ; Increment digit count. + IDIVI R0,10. ; Divide # or last quotient by 10. + JUMPN R0,NSIG1 ; Repeat if quotient > 0. + + RETURN + + +; List a "middle-adjusted" line number: +; This means supplying minimal padding on left to align +; rightmost digits of each line number with rightmost +; digit of largest line number. + +LSTLN: PUSH P,R0 ; Save number to be listed. + CALL NSIG ; Get # of significant digits in it. + + SUB R4,SEQND ; Padding count = + JUMPE R4,LSTLN2 ; # digits in largest line number + MOVNS R4 ; - # digits in this line number. + MOVEI R2,40 ; Load padding byte for output calls. + +LSTLN1: CALL LSTOUT ; List a leading blank. + SOJG R4,LSTLN1 ; Iterate to suit padding count. + +LSTLN2: POP P,R0 ; Restore line number to output. + JRST LSTLNU ; List it & return to caller. + +LINE: ;PROCESS ONE LINE + CALL GETLIN ;GET A SOURCE LINE + CALL STMNT ;PROCESS ONE STATEMENT + CALL ENDLR ;PROCESS END OF LINE + TLZN R15,ENDFLG ;TEST FOR END STATEMENT + JRST LINE ;GET THE NEXT LINE + ;Really should check for being inside an .INSERT, so might have + ;channels pushed? Especially on pass1. + .close srcch, + ;;END OF PASS + TLNN R15,P1F ;PASS 1? + JRST [CALL CODOUT ;END OF PASS 2 + MOVE R2,ENDVEC ;GET THE VECTOR + MOVEM R2,CODLOC ; Set transfer address as data loc. + JRST TROUT] ; Output transfer record & return + ;;IF .ENABL GBL IS IN EFFECT, SCAN THE SYMBOL TABLE + ;;FOR UNDEFINED NAMES & RE-TYPE THEM AS GLOBAL. + TLNN RMODE,GBLFLG ; IS .ENABL GBL IN EFFECT? + return ; NO -- LEAVE SYM TAB AS IS. + ; YES - SCAN FOR UNDEFINED SYMS. + SETZ R7, ; CLEAR INDEX INTO TABLE. +ENDUS: ADDI R7,4 ; ADVANCE TO NEXT SYMBOL. + CAML R7,SYMLEN ; IS THIS THE END? + return ; YES - ALL DONE. + ; NO -- CHECK NEXT SYMBOL. + MOVE R0,@VALPNT ; LOAD SYMBOL'S DEFINITION. + TLNN R0,DEFSYM ; IS IT DEFINED? + TLO R0,GLBSYM ; NO -- MARK IT GLOBAL. + MOVEM R0,@VALPNT ; STORE NEW DEFINITION. + JRST ENDUS ; GO BACK FOR NEXT SYMBOL. + +LSTMCR: CALL LSTMSG + JRST LSTCR ;LIST MESSAGE AND CRR + +LSTMSG: TLOA R10,(440700,,0) ;SET BYTE POINTER AND SKIP +LSTMS4: CALL LSTOUT ;TYPE CHARACTER +LSTMS5: ILDB R2,R10 ;GET CHARACTER + JUMPE R2,CPOPJ ;TEST FOR END + CAIE R2,"% ; Special for number print? + JRST LSTMS4 ; No - take as a valid character + CALL DNC ; Print number + JRST LSTMS5 ;GET NEXT CHARACTER + +consta +variab +PgmEnd==. +;; SUBTTL Predefined symbols (prototype symbol table) + 400000,,000000 ; Table bottom marker + + 0 ; End-of-table marker + 0 ; (1 complete entry) + 0 + 377777,,777777 +PSLEN=.-PgmEnd-1 +end macn80 \ No newline at end of file