XLIST DEFINE DEFTTL (NAME,MAJOR,MINOR,EDIT,DATE) < LALL TITLE NAME V'MAJOR DATE SUBTTL INITIALIZATION ; COPYRIGHT DIGITAL EQUIPMENT CORPORATION ; 1977, 1978 MNNUM== "MINOR"-100 IFIDN <> IFIDN <> DEFINE DEFOUT < OUTSTR [ASCIZ /NAME: /]> TWOSEG LOC <.JBVER==:137> EXP 0B2!B11!B17!EDIT LOC <.JBREN==:124> 0,,START RELOC 0 RELOC 400000 SYN RELOC,.LOC SYN RELOC,.RELOC SYSPPN: 1,,4 SYSDEV: SIXBIT /DSK/ ;SYSTEM DEVICE TITLE: ASCIZ /NAME MAJOR'MINOR(EDIT)/ ENTRY COLD EXTERNAL .JBREL,.JBFF,.JBUUO,.JB41,.JBHRL SALL > LIST DEFTTL ,6,,31,<9-FEB-78> DEFINE ASCNAM < EXP "C","R","O","S","S"> SUBTTL CONCISE CHANGE HISTORY COMMENT % Edit # Description ********************************************************************* 1 FIRST VERSION OF X6502 CROSS ASSEMBLER 2 ADD PAPER TAPE FEATURE FOR KIM-1 3 FIX LISTING FORMAT, FIX .ASCII/Z PSEUDO OPS 4 FIX .NTYPE AND MISC. OTHERS 5 MORE LISTING FORMAT FIX, ADD TIMING CODE 6 RANDOM AEXP BUGS (ALLOW NEG EXPRESSIONS) 7 JSR HAD WRONG TIMING INFO, BCS HAD WRONG OP-CODE 10 MAKE .ADDR PSEUDO-OP TO GENERATE LOW,HIGH , .WORD TO GENERATE HIGH,LOW 11 FIRST VERSION W/ 8080 CODE ADDED 12 ADDED PTP FORMAT & TIMING FOR 8080 13 FIRST VERSION W/ 6800 CODE ADDED 14 FIX BUGS IN M6800 CODE 15 ADD ".LIST MB" FOR MACRO BINARY ONLY (NO SOURCE) 16 ADD Z80 OPCODE INFO 17 FIX REGISTER INIT LOGIC 20 ADD 8008 MACHINE DEFS (USING 8080 COMPATIBLE MNEMONICS) 21 ADD 8008 MACHINE DEFS (USING ORIGINAL INTEL MNEMONICS) ADD NOP TO PREVIOUS 8008 MNEMONICS 22 ADD /OCT SWITCH TO PROVIDE OCTAL LISTINGS. FIX PROBLEM GENERATING HIGH OR LOW BYTES OF ADDRESS TAGS FOR IMMEDIATE MODE 8008 BY CHANGING PARSING TO PERMIT THE USE OF TAG FOR LOWER HALF OR TAG^ FOR UPPER HALF. 23 FIX TIMING INFORMATION FOR 8008 CONDITIONAL JUMPS & CALLS 24 FIX TTY LISTING FORMAT AND CORRECT EXPR^ TO WORK CORRECTLY WITH OTHER EXPRESSION MODIFIERS 25 FIX PTP OUTPUT FOR 16-BIT WORD FORMATS (DON'T SWAP BYTES) 26 ADD CDP1802 MACHINE (RCA COSMAC) 27 CHANGE BINARY PREFIX (PERCENT) FOR 6800 AND 6502 ONLY, ALL OTHERS -- REGISTER DEFINITION 30 RE-FIX TTY LISTING FORMAT. 31 ADD .ENABL M85 FOR 8085 OP CODES (RIM,SIM) % SUBTTL VARIABLE PARAMETERS DEFINE GENPAR (NAME,VALUE) < IFNDEF NAME, > GENPAR PAGSIZ,^D54 ; NUMBER OF LINES ON A PAGE GENPAR NUMBUF,2 ; NUMBER OF BUFFERS PER DEVICE GENPAR CORINC,2000 ; CORE INCREMENT GENPAR SPL,4 ; SYMBOLS PER LINE (SYMBOL TABLE LISTING) GENPAR SPLTTY,3 ; SYMBOLS PER LINE (TTY) GENPAR DATLEN,^D350 ; DATA BLOCK LENGTH GENPAR RLDLEN,^D40 GENPAR LSRNGE,^D65534 ;LOCAL SYMBOL RANGE GENPAR WPB,10 ; MACRO BLOCK SIZE GENPAR CPL,^D132 ; CHARACTERS PER LINE GENPAR PDPLEN,100 ; PUSH-DOWN POINTER LENGTH GENPAR COLLPT,^D128 ;CPL LPT GENPAR COLTTY,^D72 ;CPL TTY GENPAR TTLLEN,COLLPT-^D<8*5> ;TITLE AND SUB-TITLE BUFFER SIZE GENPAR LCFDEF,LC.MB!LC.ME!LC.MEB!LC.LD ;DEFAULT LISTING SUPPRESSION BKT1== 1 BKT2== 2 BKT3== 3 BKT4== 4 BKT6== 6 .LOC IFDEF DEBUG < PATCH: BLOCK 100 ;DEBUGGING PATCH AREA > RSXSW: BLOCK 1 ;NON-ZERO IF RSW PSECT DEFAULTS ;ARE ENABLED PDPSTK: BLOCK PDPLEN CCLTOP: BLOCK 1 ;TOP OF CCL STORAGE CCLPNT: BLOCK 1 ;CCL POINTER BZCOR: .RELOC SUBTTL ACCUMULATOR ASSIGNMENTS SYM= 0 ; ACCUMULATION OF SIXBIT SYMBOL, SCRATCH T1= 1 ; SYMBOL VALUE AND FLAGS SET BY SRCH. SCRATCH T2= 2 ; SCRATCH T3= 3 ; UNIVERSAL SCRATCH T4= 4 ; UNIVERSAL SCRATCH +1 PC= 5 ; LOCATION COUNTER Q1= 6 ; SCRATCH Q2= 7 ; SYMBOL TABLE SEARCH INDEX VAL= 10 ; EXPRESSION OR TERM VALUE, SCRATCH Q3= 11 ; SCRATCH ASM= 12 ; LBP= 13 ; LINE BUFFER BYTE POINTER CHR= 14 ; CURRENT CHARACTER (ASCII) FLG= 15 ; LH - ASSEMBLER FLAGS, RH - ERROR FLAGS EXF= 16 ; EXEC FLAGS P= 17 ; PUSH-DOWN POINTER SUBTTL FLAG REGISTERS ; EXF - LH LSTBIT== 000001 ; 1- SUPPRESS LISTING OUTPUT BINBIT== 000002 ; 1- SUPPRESS BINARY OUTPUT CRFBIT== 000004 ; 1- CREF DISABLED OCTBIT== 000010 ; 1- LIST OCTAL SOLBIT== 000020 ; 1- SEQUENCE OUTPUT LINES NSWBIT== 000040 ; 1- SUPPRESS ERRORS ON TTY FMTBIT== 000100 ; 1- GNS MODE TTYBIT== 000200 ; 1- LISTING IS ON TTY ERRBIT== 000400 ; 1- ERROR MESSAGES ENABLED P1LBIT== 001000 ; 1- LIST ON PASS 1 CDRBIT== 002000 ; 1- /CDR MODE LPTBIT== 004000 ; 1- SUPPRESS LISTING TO LPT GBLDIS== 010000 ; 1- DEFAULT GLOBALS DISABLED INFBIT== 020000 ; 1- VALID INFORMATION SEEN HDRBIT== 040000 ; 1- TIME FOR NEW LISTING PAGE REGBIT== 100000 ; 1- REGISTERS SET AT COMMAND LEVEL MODBIT== 200000 ; 1- USER MODE AC'S SET GBLCCL== 400000 ;INDICATES WHETHER GBLDIS WAS SET BEFORE ;SOURCE SCANNING BEGAN ; EXF - RH RSXBIT== 000001 ; 1- RSX defaults freshly enabled ; FLG - LH PSWFLG== 000004 ; 1- PTP FORMAT OUTPUT ASZFLG== 000010 ; 1- ASCIZ MODE NQEFLG== 000020 ; 1- NO "Q" ERRORS AT END OF LINE ENDFLG== 000040 ; 1- END OF SOURCE ENCOUNTERED FFFLG== 000100 ; 1- ISOLATED FORM FEED FMTFLG== 000200 ; 1- OVER-RIDE LC.FMT LSBFLG== 000400 ; 1- NEW LOCAL SYMBOL RANGE DEFFLG== 001000 ; 1- CREF DEFINITION DSTFLG== 002000 ; 1- CREF DESTINATION DS2FLG== 004000 ; 1- DITTO, 2ND FIELD DISBIT== 010000 ; 1- DISABLE CURRENTLY IN EFFECT LHMFLG== 020000 ; 1- MOVE LISTING TO LH MARGIN FLTFLG== 040000 ; 1- ERROR ENCOUNTERED IN FLOATING ROUTINE ISWFLG== 100000 ; 1- /I SEEN P1F== 400000 ; 1- PASS 1 IN PROGRESS SUBTTL ERROR FLAGS ERR.A== 400000 ERR.B== 200000 ERR.D== 100000 ERR.E== 040000 ERR.I== 020000 ERR.L== 010000 ERR.M== 004000 ERR.O== 002000 ERR.P== 001000 ERR.Q== 000400 ERR.R== 000200 ERR.T== 000100 ERR.U== 000040 ERR.N== 000020 ERR.Z== 000010 ;MARGINAL INSTRUCTION ERR.X== 000004 ERR.P1== 000001 ERRMNE: ASCIZ /ABDEILMOPQRTUNZX/ ;DEFINE ERROR TYPES CONSIDERED "FATAL" QMEMSK== ERR.A!ERR.B!ERR.D!ERR.E!ERR.I!ERR.L!ERR.M QMEMSK==QMEMSK! ERR.O!ERR.P!ERR.Q!ERR.R!ERR.T!ERR.U!ERR.N SUBTTL MICRO DEFINITIONS ;ADDRESSING MODES .M65A1==1 ;ABSOLUTE OR ZERO PAGE .M65A2==2 ; LOC,X " .M65A3==3 ; LOC,Y " .M63A4==4 ; (LOC,X) .M65A5==5 ; (LOC),Y .M65A6==6 ; (LOC) .M65A7==7 ; # .M65ZO==7 ;ZERO PAGE OFFSET .M65RG==20 ;IMPLIED ADDRS (A,S,X,Y,P) AM%IND==1B0 ;INDIRECT SEEN "(" AM%ZP==1B1 ;ADDRESS .LT. 256 (00-FF) AM%ACC==1B2 ;ADDRESS IS ACCUMULATOR "A" ;HEX CODE DEFINITIONS %%0==0 %%1==1 %%2==2 %%3==3 %%4==4 %%5==5 %%6==6 %%7==7 %%8==10 %%9==11 %%A==12 %%B==13 %%C==14 %%D==15 %%E==16 %%F==17 ;MACHINE TYPE CODES M65==0 ;MOS 6502 M68==1 ;MOTOROLA 6800 M80==2 ;8080/Z80 M88==3 ;8008 - UPWARD COMPATIBLE M08==4 ;8008/MPS - INTEL M18==5 ;RCA CDP1802 (COSMAC) MF8==6 ;FAIRCHILD F8 MXX==7 ;MAX TYPE +1 FOR PSRCH (DIRECTIVES) ;ADDRESS MODES FOR 6800 .M68A1==1 ;IMMEDIATE (8/16 BIT) .M68A2==2 ;DIRECT (ZERO PAGE) .M68A3==3 ;RELATIVE (BRANCHES) .M68A4==4 ;ABSOLUTE ADDRS SUBTTL MISCELLANEOUS PARAMETERS TTYDEV== 000010 ; 1- DEVICE IS A TTY PTRDEV== 000200 ; 1- DEVICE IS A PTR LPTDEV== 040000 ; 1- DEVICE IS A LPT CDRDEV== 100000 ; 1- DEVICE IS A CDR IODATA== 200000 ; 1- IO DATA ERROR IODEV== 100000 ; 1- IO PARITY ERROR IOWRLK== 400000 ; 1- IO WRITE LOCK ERROR IOBKTL== 040000 ; 1- IO BLOCK TOO LARGE IOEOF== 020000 ; 1- END OF FILE ON IO DEVICE ; DEVICE PARAMETERS BIN== 1 LST== 2 SRC== 3 CCL== 3 CRF== 4 MAC== 5 SWI== 6 ;CHANNEL NUMBER FOR SWITCH.INI INBIT== 2 ;DEVICE CAN DO INPUT ALMODE== 1 ;ASCII LINE MODE .IOASC== 0 ;ASCII MODE IO.EOF== 1B22 ;EOF BIT IN DEVICE STATUS SUBTTL OPDEFS OPDEF CALL [PUSHJ P,] OPDEF RETURN [POPJ P,] OPDEF SPUSH [PUSH P,] OPDEF SPOP [POP P,] OPDEF RESET [CALLI 0] OPDEF DEVCHR [CALLI 4] OPDEF CORE [CALLI 11] OPDEF EXIT [CALLI 12] OPDEF DATE [CALLI 14] OPDEF APRENB [CALLI 16] OPDEF MSTIME [CALLI 23] OPDEF RUNTIM [CALLI 27] OPDEF ZBINK [CLOSE BIN,] OPDEF OUTCHR [TTCALL 1,] OPDEF OUTSTR [TTCALL 3,] OPDEF INCHWL [TTCALL 4,] DEFINE GENM40 (SYM) < ..V==0 ;;INIT SYMBOL ..M==50*50 ;;INIT MULTIPLIER ..C==-3 ;;INIT COUNT IRPC ,< ..T==..M*$'SYM IFL ..C,<..V==<..T,,0>+..V> IFGE ..C,<..V==..V+..T> ..C==..C+1 IFE ..C,<..M==50*50*50> ..M==..M/50 > EXP ..V > ;TABLE LENGTH CHECKING MACRO DEFINE CHKTAB (TNAME) < IFN <.-TNAME-MXX>,< PRINTX TABLE TNAME IS INCORRECT LENGTH (SEE MXX) > > SUBTTL UUO HANDLERS DEFINE UUODEF (NAME,SUBR) < OPDEF NAME [<.-UUOTBL>B8] Z SUBR > UUOTBL: ;UUO TRANSFER TABLE 0 ;ZERO IS ILLEGAL UUODEF DEVSET, DEVSE0 ;DEVICE INITIALIZATION UUODEF FERROR, FERRO0 ;FATAL ERROR UUODEF LSTSTR, LSTST0 ;LIST ASCIZ STRING UUODEF LSTMSG, LSTMS0 ;LIST ASCIZ MESSAGE UUODEF DNC, DNC0 ;DECIMAL NUMBER CONVERSION UUODEF LSTSYM, LSTSY0 ;LIST SYMBOL OPDEF LSTSIX [LSTSYM 2,] UUODEF LSTICH, LSTIC0 ;LIST IMMEDIATE CHARACTER UUODEF SETLCT, SETLC0 ;SET LCTST ; UUODEF TSTLCT, TSTLC0 ;SKIP IF ARG NOT SET IN LCFLGS ; UUODEF TSTEDT, TSTED0 ;SKIP IF NOT SET UUODEF WCIMT, WCIMT0 ;WRITE CHARACTER IN MACRO TREE ; UUODEF ERRSET, ERRSE0 ;SET ERROR FLAG (FLG RH) ; UUODEF ERRSKP, ERRSK0 ;DITTO, AND SKIP UUODEF ERRXIT, ERRXI0 ;DITTO, AND EXIT OPDEF SKPLCR [TLNE ASM,] ;REPLACES TSTLCT OPDEF SKPLCS [TLNN ASM,] ;SKIP IF LISTING CONTROL SET OPDEF SKPEDR [TRNE ASM,] ;REPLACES TSTEDT OPDEF SKPEDS [TRNN ASM,] ;SKIP IF ENABLE SET OPDEF ERRSET [TRO FLG,] OPDEF ERRSKP [TROA FLG,] BLOCK 40+UUOTBL-. ;ZERO REMAINDER OF TABLE UUOPRO: ;UUO PROCESSOR SPUSH T2 ;STACK WORK REGISTER LDB T2,[POINT 9,.JBUUO,8] ;GET INDEX SKIPN T2,UUOTBL(T2) ;FETCH VECTOR, NULL? HALT . ; YES, ERROR EXCH T2,0(P) ;NO, SET VECTOR AND RESTORE REG RETURN ; "CALL" THE ROUTINE SUBTTL EXEC INITIALIZATION COLD: ;INITIAL ENTRY POINT SETZM RSXSW ;ENABLE RSX DEFAULTS HLLZS EXF ;CLEAR RH EXF START: SETZM CCLTOP ;CLEAR CCL POINTER NXTCCL: RESET SKIPE T3,CCLTOP ;CCL IN PROGRESS? HRRZM T3,.JBFF ; YES MOVE 0,.JBFF ;GET FIRST FREE ADDI 0,200*NUMBUF*2+200+200 ;MAKE ROOM FOR BUFFERS, ETC. CORE 0, ;SET CORE HALT . ; DIDN'T MAKE IT MOVSI P,-P SETZM SYM(P) AOBJN P,.-1 MOVEI T1,M65 ;SET DEFAULT MACHINE TYPE MOVEM T1,MACHT TLO ASM,LCFDEF ;SET DEFAULT LISTING FLAGS TRO ASM,ED.ABS ;DEFAULT ABSOLUTE HRLI EXF,BINBIT!LSTBIT!CRFBIT ;INIT "EXEC" FLAG REGISTER MOVE P,[IOWD PDPLEN,PDPSTK] ;BASIC PDP MOVSI T3,- SETZM BZCOR(T3) ;CLEAR VARIABLES AOBJN T3,.-1 MOVE 0,[CALL UUOPRO] MOVEM 0,.JB41 ;SET UUO TRAP MOVEI 0,ERR.X MOVEM 0,ERRSUP ;DEFAULT DISABLE OF "X" FLAG CALL SETSYM SETZM 0 RUNTIM 0, ;GET CURRENT RUN TIME, MOVEM 0,RUNTIM DATE 0, ; AND DATE, MOVEM 0,DATE MSTIME 0, ; AND TIME MOVEM 0,MSTIME TLZ EXF,GBLDIS SUBTTL SWITCH.INI PROCESSING MOVE T2,[XWD SWIOPN,LSWOPN] BLT T2,LSWOPN+2 MOVE T2,[XWD SWILOO,LSWLOO] BLT T2,LSWLOO+3 OPEN SWI,LSWOPN ;INITIALIZE CHANNEL HALT . LOOKUP SWI,LSWLOO ;OPEN FILE JRST SWIEND ;SWITCH.INI NOT PRESENT INBUF SWI,1 ;SET UP THE RING WITH ONLY ONE BUFFER CALL SWIRD ;GET FIRST BUFFERFUL JRST SWIEND ;...MUST HAVE BEEN EMPTY MOVE T2,SWIBUF+2 ;COLLECT BYTE COUNT SWINB: ;LOOK FOR NON-BLANKS CALL SWICHR ;GET A CHARCTER JRST SWIEND ;ALL DONE CAIE CHR,SPACE CAIN CHR,TAB JRST SWINB ;BYPASS THIS BLANK-TYPE CHARACTER MOVSI T1,-5 ;SET UP COUNTER JRST .+3 ;BYPASS FIRST COLLECTION SWICMP: ;COMPARE SYMBOL WITH "CROSS" CALL SWICHR JRST SWIEND CAME CHR,NMTABL(T1) JRST SWIEOL ;NO GOOD. GO TO END OF LINE. AOBJN T1,SWICMP ;BACK FOR MORE(PERHAPS) ;MATCHED! MOVE Q1,[POINT 7,SWIBYT] ;PREPARE TO FILL INTERMED. BUFFER SWIMOV: ;FILL INTERMEDIATE BUFFER CALL SWICHR ;GET ONE JRST SWIGET CAIN CHR,CRR ;END OF LINE? JRST SWIGET ;YES CAIN CHR,"-" ;HYPHEN? JRST SWICON ;YES...ASSUME CONTINUATION IDPB CHR,Q1 ;ELSE, PUT THE CHARACTER INTO THE BUFFER JRST SWIMOV ;CONTINUE SWICON: ;PROCESS LINE CONTINUATION CALL SWICHR JRST SWIERR ;PROBLEMS... CAIE CHR,CRR ;EOL YET? JRST SWICON ;NO CALL SWICHR ;CHECK FOR PRESENCE OF LINE FEED CAIA ;THIS IS THE ERROR RETURN CAIE CHR,LF ;SKIP IF LINE FEED JRST SWIERR ;CRAP OUT JRST SWIMOV ;BACK FOR CONTINUATION LINE SWIGET: SETZ CHR, IDPB CHR,Q1 MOVE LBP,[POINT 7,SWIBYT,6] ;FAKE UP AC13 FOR GETNB, ET.AL. CALL SETNB CAIE CHR,"/" ;FIRST CHARACTER A SLASH? JRST SWIERR ;NO. CALL SSWPRO ;GO PROCESS SWITCHES SWIEND: CLOSE SWI, OUTSTR [BYTE (7) CRR,LF,0] JRST START0 SWIERR: ;ERROR IN SWITCH.INI OUTSTR [BYTE (7) CRR,LF,0] OUTSTR [ASCIZ /? ERROR IN SWITCH.INI FILE/] OUTSTR [BYTE (7) CRR,LF,0] EXIT ;SUBROUTINES SWIRD: ;GET A BUFFERFUL OF DATA IN SWI, ;GET IT JRST CPOPJ1 ;GOOD...TAKE SKIP RETURN STATO SWI,IO.EOF ;WAS IT AN END OF FILE? OUTSTR [ASCIZ /ERROR IN READING SWITCH.INI/] RETURN ;TAKE NORMAL RETURN SWICHR: ;GET A SINGLE CHARACTER IN AC14 SOJL T2,SWCHR2 ;JUMP ON END-OF-FILE IBP SWIBUF+1 ;INCREMENT INPUT BYTE POINTER MOVE CHR,@SWIBUF+1 ;GET ENTIRE WORD TRNE CHR,1 ;LINE NUMBER? JRST SWICH1 ;YES LDB CHR,SWIBUF+1 ;GET THE CHARACTER CAIL CHR,"A"+40 ;LOWER-CASE? CAILE CHR,"Z"+40 ;...? CAIA ;NO SUBI CHR,40 ;CONVERT TO UPPER CASE JRST CPOPJ1 ;TAKE SKIP-RETURN SWICH1: ;LINE SEQ NUMBER AOS SWIBUF+1 ;INCREMENT POINTER AROUND LSN SUBI T2,5 ;DECREMENT COUNTER JUMPGE T2,SWICHR ;IF COUNT OK, BACK FOR MORE ;ELSE, FALL INTO COLLECTION OF ANOTHER LOAD SWCHR2: CALL SWIRD ;GET ANOTHER LOAD RETURN ;TERMINAL RETURN MOVE T2,SWIBUF+2 ;GET BYTE COUNT JRST SWICHR ;BACK FOR MORE ;LOOK FOR END OF LINE SWEOL0: CALL SWICHR JRST SWIEND SWIEOL: CAIE CHR,LF ;LINE FEED? JRST SWEOL0 ;NO JRST SWINB ;NEW LINE AT LAST ;DATA AREAS NMTABL: ASCNAM ;NAME TO MATCH SWIOPN: EXP .IOASC ;ASCII MODE SIXBIT /DSK/ ;DEVICE XWD 0,SWIBUF SWILOO: SIXBIT /SWITCH/ SIXBIT /INI/ EXP 0 XWD 0,0 ;USE CURRENT PPN .LOC LSWOPN: BLOCK 3 LSWLOO: BLOCK 4 SWIBUF: BLOCK 3 ;BUFFER HEADER SWIBYT: BLOCK ^D29 ;INTERMEDIATE BUFFER FOR CROSS LINE .RELOC SUBTTL CONTINUATION OF OPENING FESTIVITIES START0: SKIPN CCLTOP OUTCHR ["*"] ;AWAKEN THE USER MOVE LBP,.JBFF HLL LBP,ASCBYT MOVEM LBP,TTIBEG START1: CALL CCLGET ;GET A TTI CHAR CAIE CHR,SPACE CAIN CHR,TAB JRST START1 ;IGNORE BLANKS CAIL CHR,"A"+40 ;UPPER CASE? CAILE CHR,"Z"+40 CAIA SUBI CHR,40 ; YES, CONVERT TO UPPER CAIN CHR,CRR JRST START1 ;DITTO FOR CR'S CAIE CHR,LF ;IF LINE FEED CAIN CHR,ALTMOD ; OR ALTMODE, MOVEI CHR,0 ;SET END OF ENTRY DPB CHR,LBP IBP LBP JUMPN CHR,START1 ADDI LBP,1 HRRZM LBP,.JBFF MOVE LBP,TTIBEG SETCHR ;SET THE FIRST CHAR JUMPE CHR,NXTCCL ;RESTART IF NOTHING TO PROCESS CALL GETBIN ;INIT THE BINARY TLNN FLG,PSWFLG ;PTP MODE? JRST STRT1A ;NO, PROCEED SETSTS BIN,.IOASC ;YES, SET ASCII MODE HRLI T3,(POINT 7,,0) HLLM T3,BINPNT ;CHANGE BYTE PNTR STRT1A: CAIE CHR,"," ;ANOTHER FIELD? JRST START2 ; NO GETCHR ;YES, BYPASS COMMA CALL GETLST ;INIT THE LISTING FILE START2: MOVE T3,SYSDEV MOVEM T3,DEVNAM DEVSET MAC,1 XWD 0,MACBUF MOVE T3,.JBFF MOVEM T3,JOBFFM INBUF MAC,NUMBUF CAIE CHR,"_" ;TEST FOR LEGAL SEPARATOR CAIN CHR,"<" ;> MOVEI CHR,"=" CAIE CHR,"=" FERROR [ASCIZ /NO = SEEN/] ;FATAL ERROR MOVEM LBP,TTISAV ;SAVE FOR PASS2 RESCAN HLLZM ASM,LCFLGS MOVE T3,[XWD LCBLK,LCSAVE] BLT T3,LCSAVE+LCLEN-1 ;SAVE LISTING FLAGS HRRZM ASM,EDFLGS MOVE T3,[XWD EDBLK,EDSAVE] BLT T3,EDSAVE+EDLEN-1 ; AND ENABLE/DISABLE FLAGS MOVE T3,.JBFF MOVEM T3,CRFBAS CALL ACEXCH ;GET USER AC'S SKIPE CCLTOP DEFOUT SKIPN CCLTOP OUTSTR [BYTE (7) CRR,LF,0] ;CONFIRM ALL'S WELL CALL ASSEMB ;CALL THE ASSEMBLER SETZM T3 RUNTIM T3, MOVEM T3,RUNTIM+2 TLNN EXF,LSTBIT CALL SYMTB SETZM T3 RUNTIM T3, MOVEM T3,RUNTIM+3 CALL ACEXCH ;GET EXEC AC'S SKPINC ;RESET POSSIBLE ^O JFCL CALL LSTCR ;LIST A CR/LF SPUSH EXF SKIPN ERRCNT SKIPN CCLTOP TLO EXF,ERRBIT ;MESSAGE TO LPT AND TTY TLZ EXF,NSWBIT ;CLEAR /N CALL LSTCR SKIPE Q3,ERRCNT ;ANY ERRORS? LSTICH "?" ; YES, FLAG THE LISTING LSTMSG [ASCIZ / ERRORS DETECTED: 5/] SKIPE Q3,ERRCNT+1 ;ANY NON-FATAL ERRORS? LSTMSG [ASCIZ -/5-] ; YES SKIPE Q3,DGCNT ;ANY DEFAULT GLOBALS? LSTMSG [ASCIZ / DEFAULT GLOBALS GENERATED: 5/];GUESS SO LSTMSG [ASCIZ /00/] SPOP SYM TLNE SYM,NSWBIT ;WAS /N SET? TLO EXF,NSWBIT ; YES, RE-SET IT SETZM STLBUF LSTICH SPACE LSTICH "*" LSTSTR @TTIBEG LSTMSG [ASCIZ /0 RUN-TIME: /] MOVSI T1,-3 START4: MOVE T3,RUNTIM+1(T1) SUB T3,RUNTIM(T1) IDIVI T3,^D1000 DNC T3 LSTICH SPACE AOBJN T1,START4 SKIPN Q3,TIMCNT JRST START5 LSTMSG [ASCIZ /(5-/] MOVE T3,TIMTIM IDIVI T3,^D1000 MOVE Q3,T3 LSTMSG [ASCIZ /5) /] START5: LSTMSG [ASCIZ /SECONDS0/] HRRZ Q3,.JBREL ;GET TOP OF COR ASH Q3,-^D10 ;CONVERT TO "K" ADDI Q3,1 ;BE HONEST ABOUT IT LSTMSG [ASCIZ / CORE USED: 5K0/] SKPEDS ED.WRP JRST START6 MOVE T3,WRPCNT+1 IMULI T3,^D100 IDIV T3,WRPCNT MOVE Q3,T3 LSTMSG [ASCIZ / WRAP-AROUND: 5%0/] START6: CALL LSTCR ;FALL INTO THE NEXT PAGE... EXIT: TLNE EXF,MODBIT ;EXEC MODE? CALL ACEXCH ; NO, GET AC'S CLOSE LST, ;CLOSE THE LISTING FILE TLNE FLG,PSWFLG ;PTP OUTPUT? TLNE EXF,BINBIT ; AND BIN FILE OPEN? JRST EXIT1 ;NO - DON'T BOTHER HRRZ T1,MACHT ;ELSE DO MACHINE WRAPUP CALL @EOFTB(T1) EXIT1: CLOSE BIN, ;CLOSE THE BINARY FILE TLON EXF,LSTBIT ;WAS THERE A LISTING FILE? CALL LSTTST ;YES, TEST FOR FINAL ERROR TLON EXF,BINBIT ;IS THERE A BINARY FILE? CALL BINTST ;YES, TEST FOR FINAL ERROR TDZE CHR,CHR ;END OF COMMAND STRING? FERROR [ASCIZ /NOT ALL INPUT FILES PROCESSED/] ; NO JRST NXTCCL ;RESTART FERRO0: ; "FERROR" UUO TRZE EXF,RSXBIT ;NON-RSX DEFAULTS FRESHLY ENABLED? JRST START ;YES. IT'S OK... PUSH P,.JBUUO ;SAVE ARG TLNE EXF,MODBIT CALL ACEXCH ;SET EXEC AC'S HRLI EXF,ERRBIT!LSTBIT!BINBIT!CRFBIT ;FUDGE FLAGS LSTMSG [ASCIZ /0? /] LSTMSG @0(P) ;OUTPUT BASIC MESSAGE LSTMSG [ASCIZ /00*/] MOVEI T3,0 DPB T3,LBP LSTSTR @TTIBEG LSTICH "?" LSTMSG [ASCIZ /00/] ;TWO CR/LF'S JRST START EOFTB: CPOPJ ;6502 CPOPJ ;6800 M80EOF ;8080 M80EOF: MOVEI T2,"$" ;EOF CHARACTER CALL BCHOUT MOVEI T2,CRR ;CRLF CALL BCHOUT MOVEI T2,LF CALL BCHOUT ;... JRST BINDMP ;DUMP BUFFERS .LOC RUNTIM: BLOCK 4 DATE: BLOCK 1 MSTIME: BLOCK 1 ERRCNT: BLOCK 2 DGCNT: BLOCK 1 ;NUMBER OF DEFAULT GLOBALS GENERATED .RELOC TIMTST: JFCL CAIA AOS 0(P) SPOP TIMTMP SPUSH T2 SETZM T2 RUNTIM T2, EXCH T2,0(P) CALL @TIMTMP CAIA AOS -1(P) EXCH T2,-1(P) MOVEM T2,TIMTMP SETZM T2 RUNTIM T2, SUB T2,0(P) ADDM T2,TIMTIM AOS TIMCNT SPOP T2 SPOP T2 JRST @TIMTMP .LOC TIMTIM: BLOCK 1 TIMCNT: BLOCK 1 TIMTMP: BLOCK 1 .RELOC SUBTTL FILE INITIALIZATION GETBIN: ;GET BINARY FILE MOVE T3,SYSDEV MOVEM T3,DEVNAM ;SET DEFAULT DEVICE CALL CSIFLD ;GET THIS FIELD RETURN ; NO, EXIT CAIN CHR,"@" ;CCL? JRST CCLSET ; YES DEVSET BIN,10 ;INIT IMAGE MODE XWD BINBUF,0 ;ARG OUTBUF BIN,NUMBUF ;BUMP .JBFF MOVE T3,[XWD DEVNAM,BINBLK] BLT T3,BINBLK+4 ;SAVE NAME FOR LATER ENTER TLZ EXF,BINBIT ;INDICATE GOOD BINARY FILE RETURN SETBIN: ;SET BIN (END OF PASS 1) TLNE EXF,BINBIT ;ANY BINARY? RETURN ; NO, EXIT CALL ACEXCH ;YES, GET EXEC AC'S MOVS T3,[XWD DEVNAM,BINBLK] BLT T3,DEVNAM+4 ;SET UP BLOCK SKIPE T3,FILEXT ;EXPLICIT EXTENSION? JRST SETBI1 ; YES MOVSI T3,(SIXBIT /OBJ/) SKPEDR ED.ABS ;ABS MODE? MOVSI T3,(SIXBIT /BIN/) ; YES TLNE FLG,PSWFLG ;PTP FILE? MOVSI T3,(SIXBIT /PTP/) SETBI1: HLLZM T3,FILEXT ;SET IN LOOKUP BLOCK ENTER BIN,FILNAM ;ENTER FILE NAME IN DIRECTORY FERROR [ASCIZ /NO ROOM FOR 3/] ; FULL SETZM RECCNT ;CLEAR RECORD COUNT JRST ACEXCH ;TOGGLE AC'S AND EXIT GETLST: ;GET LISTING FILE MOVE T3,SYSDEV MOVEM T3,DEVNAM ;SET DEFAULT DEVICE CALL CSIFLD ;GET THIS FIELD RETURN ; NO, EXIT DEVSET LST,1 ;INIT ASCII MODE XWD LSTBUF,0 OUTBUF LST,NUMBUF SKIPN T3,FILEXT ;EXPLICIT EXTENSION? MOVSI T3,(SIXBIT /LST/) ; NO, SUPPLY ONE HLLZM T3,FILEXT ENTER LST,FILNAM FERROR [ASCIZ /NO ROOM FOR 3/] ; FULL MOVE SYM,DEVNAM DEVCHR SYM, ;GET DEVICE CHARACTERISTICS MOVEI T3,LC.TTM TLNE SYM,TTYDEV ;IS DEVICE TELETYPE? TLOA EXF,TTYBIT ; YES, FLAG AND SKIP TDNE T3,LCMSK ;NO, TTM SEEN? CAIA TLO ASM,0(T3) ;NO, SUPPRESS TELETYPE MODE TLZ EXF,LSTBIT ;INDICATE A GOOD LISTING FILE JRST LPTINI ;INIT LINE OUTPUT AND EXIT SETCRF: TLNE EXF,LSTBIT!CRFBIT RETURN CALL ACEXCH CALL GETCOR MOVE T3,SYSDEV MOVEM T3,DEVNAM DEVSET CRF,10 XWD CRFBUF,0 OUTBUF CRF, MOVEI SYM,3 PJOB T2, SETCR1: IDIVI T2,^D10 ADDI T3,"0"-40 LSHC T3,-6 SOJG SYM,SETCR1 HRRI T4,(SIXBIT /CRF/) MOVEM T4,CRFNAM MOVEM T4,FILNAM MOVSI T3,(SIXBIT /TMP/) MOVEM T3,FILEXT SETZM FILPPN ENTER CRF,FILNAM FERROR [ASCIZ /NO ROOM FOR 3/] JRST ACEXCH SETSRC: ;SET FOR SOURCE SCAN (EACH PASS) CALL ACEXCH ;GET EXEC AC'S SETZM T3 RUNTIM T3, MOVEM T3,RUNTIM+1 MOVE LBP,TTISAV ;SET CHAR POINTER SETCHR ;SET THE FIRST CHARACTER MOVE T3,SYSDEV MOVEM T3,DEVNAM ;SET DEFAULT DEVICE NAME SETZM PPNSAV ;CLEAR PROJECT-PROGRAMMER NUMBER SETZM LINNUM ;CLEAR SEQUENCE NUMBER SETZM LINNUB ; AND ITS BACKUP TLNE EXF,SOLBIT ;SEQUENCE OUTPUT LINES? AOS LINNUM ; YES, PRESET MOVS T3,[XWD LCBLK,LCSAVE] BLT T3,LCBLK+LCLEN-1 ;RESTORE LC FLAGS HLL ASM,LCFLGS MOVS T3,[XWD EDBLK,EDSAVE] BLT T3,EDBLK+EDLEN-1 ; AND ENABLE/DISABLE FLAGS HRR ASM,EDFLGS CALL GETSRC ;PROCESS FIRST FIELD JRST ACEXCH ;EXCHANGE AC'S AND EXIT GETSRC: ;GET A SOURCE FILE GETCHR ;BYPASS DELIMITER CALL CSIFLD ;GET THE FIELD FERROR [ASCIZ /NULL SOURCE FIELD/] ; NO DEVSET SRC,1 ;INIT DEVICE XWD 0,SRCBUF MOVEI T3,JOBFFS EXCH T3,.JBFF ;SET TO TOP OF INPUT BUFFER INBUF SRC,NUMBUF MOVEM T3,.JBFF ;RESTORE .JBFF MOVE SYM,DEVNAM DEVCHR SYM, TLNN SYM,TTYDEV JRST GETSR3 OUTSTR [BYTE (7) 15,12] SKPINC ;TYPED AHEAD? CAIA ; NO RETURN ;YES, NO MESSAGE OUTSTR [ASCIZ /READY/] OUTSTR [BYTE (7) 15,12] RETURN GETSR3: SKIPE T1,FILEXT ;EXPLICIT EXTENSION? JRST GETSR1 ; YES MOVE T3,[-MXX,,TYPET] GETSR5: HLLZ T1,0(T3) ;FILE EXTN CALL GETSR2 ;TRY IT JRST GETSR4 ;SUCCESS AOBJN T3,GETSR5 ;TRY AGAIN SETZM T1 GETSR1: CALL GETSR2 ; NO, TRY NULL NEXT JRST GETSR6 ;SUCCESS - CHECK WHAT TYPE ;NO DICE FERROR [ASCIZ /CANNOT FIND 3/] GETSR2: HLLZM T1,FILEXT ;SAVE EXTENSION IN LOOKUP BLOCK LOOKUP SRC,FILNAM ;LOOKUP FILE NAME JRST CPOPJ1 ; NOT FOUND, SKIP-RETURN MOVE T1,[XWD FILNAM,SRCSAV] BLT T1,SRCSAV+1 RETURN ;EXIT GETSR6: HLRZ SYM,FILEXT ;WHAT SUCCEEDED MOVE T3,[-MXX,,TYPET] GTSR6A: HLRZ T2,0(T3) ;TABLE VALUE CAME SYM,T2 ;MATCH? AOBJN T3,GTSR6A ;NO - TRY AGAIN JUMPGE T3,CPOPJ ;EXIT IF NONE FOUND GETSR4: HRRZ T1,0(T3) ;MACHINE CODE SETMCH: MOVEM T1,MACHT ;SET MACHINE TYPE RETURN TYPET: 'M65',,M65 'M68',,M68 'M80',,M80 'M88',,M88 'M08',,M08 'M18',,M18 'MF8',,MF8 CHKTAB (TYPET) CCLSET: ;SET CCL INPUT SKIPE CCLTOP FERROR [ASCIZ /NESTED CCL'S/] MOVE SYM,DEVNAM DEVCHR SYM, TDC SYM,[XWD 2,2] TDNE SYM,[XWD 2,2] ;LEGIT FILE? FERROR [ASCIZ /DEVICE INPUT ERROR FOR COMMAND STRING/] DEVSET CCL,1 ;YES, INIT XWD 0,SRCBUF ;BORROW SOURCE BUFFER SKIPE T3,FILEXT ;EXPLICIT EXTENSION? JRST CCLSE1 ; YES MOVSI T3,(SIXBIT /CCL/) ;TRY THE DEFAULT HLLZM T3,FILEXT LOOKUP CCL,FILNAM TDZA T3,T3 ; MISSED JRST CCLSE2 ;OK CCLSE1: HLLZM T3,FILEXT LOOKUP CCL,FILNAM FERROR [ASCIZ /CANNOT FIND 3/] ;MISSED COMPLETELY CCLSE2: MOVE T1,.JBFF ;GET CURRENT FIRST FREE HRLI T1,(POINT 7,,) ;FORM BYTE POINTER MOVEM T1,CCLPNT ;SAVE IT MOVEI T3,JOBFFS ;SET TO READ INTO SOURCE BUFFER MOVEM T3,.JBFF INBUF CCL,NUMBUF SETZM FLG ;CLEAR ERROR FLAG CCLSE3: CALL CHAR ;GET A CHARACTER TLZE FLG,ENDFLG ;END? JRST CCLSE4 ; YES TRZE FLG,-1 ;NO, GOOD CHARACTER? JRST CCLSE3 ;NO, GET ANOTHER HRRZ Q1,T1 ;COLLECT RIGHT HALF OF BYTE POINTER CAML Q1,.JBREL ;COMPARE IT TO LAST FREE CORE ADDR FERROR [ASCIZ /CCL FILE TOO LARGE/]; IDPB CHR,T1 ;STORE THE CHAR JRST CCLSE3 ;BACK FOR MORE CCLSE4: SETZM CHR IDPB CHR,T1 ;STORE TERMINATOR AOS T1 HRRZM T1,CCLTOP ;SET TOP POINTER JRST NXTCCL CCLGET: ;GET A CCL CHAR SKIPN CCLTOP ;ANY CCL? JRST CCLGE1 ; NO ILDB CHR,CCLPNT ;YES, GET A CHAR JUMPN CHR,CPOPJ ;EXIT IF NON-NULL EXIT ; FINIS CCLGE1: INCHWL CHR ;GET A TTY CHAR RETURN DEVSE0: ; "DEVSET" UUO MOVE T3,.JBUUO HRRZM T3,DEVBLK ;SET MODE MOVE T4,DEVNAM MOVEM T4,DEVBLK+1 ;XFER NAME MOVE T4,@0(P) ;FETCH ARG (BUFFER ADDRESS) MOVEM T4,DEVBLK+2 AND T3,[Z 17,] ;MASK TO AC FIELD IOR T3,[OPEN DEVBLK] ;FORM UUO XCT T3 FERROR [ASCIZ /CANNOT ENTER 3/] ;MISSED CALL SWPRO ;PROCESS SWITCHES CPOPJ1: AOS 0(P) ;BYPASS ARG CPOPJ: RETURN .LOC ;FILE INITIALIZATION VARIABLES DEVBLK: BLOCK 3 ;"OPEN" BLOCK ;FOLLOWING 5 MUST BE KEPT TOGETHEI DEVNAM: BLOCK 1 ;DEVICE NAME FILNAM: BLOCK 1 ;FILE NAME FILEXT: BLOCK 1 ;EXTENSION BLOCK 1 FILPPN: BLOCK 1 ;PROJECT-PROGRAMMER NUMBER BINBLK: BLOCK 5 ;STORAGE FOR ABOVE BINBUF: BLOCK 1 ;BINARY BLOCK HEADER BINPNT: BLOCK 1 BINCNT: BLOCK 1 BINPCT: BLOCK 1 LSTBUF: BLOCK 1 LSTPNT: BLOCK 1 LSTCNT: BLOCK 1 CRFBUF: BLOCK 1 CRFPNT: BLOCK 1 CRFCNT: BLOCK 1 SRCBUF: BLOCK 1 SRCPNT: BLOCK 1 SRCCNT: BLOCK 1 SRCSAV: BLOCK 2 TTIBEG: BLOCK 1 ;BEGINNING OF TTY BUFFER TTISAV: BLOCK 1 ;TELETYPE POINTER SAVE PPNSAV: BLOCK 1 ;PPN STORAGE CRFBAS: BLOCK 1 JOBFFS: BLOCK 204*NUMBUF ;SOURCE BUFFER .RELOC SUBTTL COMMAND STRING FIELD SCANNER CSIFLD: ;PROCESS CLMMAND SCANNER FIELD TLZ EXF,INFBIT ;CLEAR INFO BIT CALL CSISYM ;TRY FOR A SYMBOL CAIE CHR,":" ;DEVICE? JRST CSIFL1 ; NO MOVEM SYM,DEVNAM ;YES, STORE IT GETCHR ;BYPASS COLON CALL CSISYM ;GET ANOTHER SYMBOL CSIFL1: MOVEM SYM,FILNAM ;ASSUME FILE NAME SETZM FILEXT ;CLEAR EXTENSION CAIE CHR,"." ;EXPLICIT ONE? JRST CSIFL2 ; YES GETCHR ;BYPASS PERIOD CALL CSISYM ;GET EXTENSION HLLOM SYM,FILEXT ;STUFF IT CSIFL2: CAIE CHR,"[" ;PPN? JRST CSIFL6 ; NO SETZM PPNSAV ;CLEAR CELL CSIFL3: HRLZS PPNSAV ;MOVE RH TO LH CSIFL4: GETCHR ;GET THE NEXT CHAR CAIN CHR,"]" ;FINISHED? JRST CSIFL5 ; YES CAIN CHR,"," ;SEPARATOR? JRST CSIFL3 ; YES CAIL CHR,"0" ;TEST FOR OCTAL NUMBER CAILE CHR,"7" FERROR [ASCIZ /ILLEGAL PPN/] HRRZ T3,PPNSAV ;MERGE NEW CHAR IMULI T3,8 ADDI T3,-"0"(CHR) HRRM T3,PPNSAV JRST CSIFL4 ;LOOP CSIFL5: GETCHR CSIFL6: MOVE T3,PPNSAV MOVEM T3,FILPPN ;SAVE BACKGROUND PPN TLNE EXF,INFBIT ;ANYTHING PROCESSED? JRST CPOPJ1 ; YES, SKIP-EXIT JRST SWPRO ;NO, BE SURE TO PROCESS SWITCHES CSISYM: ;COMMAND SCANNER SYMBOL CALL GETSYM ;GET ONE IN RAD50 JUMPE SYM,CPOPJ ;EXIT IF NULL TLO EXF,INFBIT ;OK, SET INFO BIT JRST M40SIX ;CONVERT TO SIXBIT SSWPRO: ;SPECIAL ENTRY POINT FOR SWITCH.INI PROCESSING SETOM SWPENT ;SIGNAL SOURCE OF CALL CAIA SWPRO: ;SWITCH PROCESSOR SETZM SWPENT ;SIGNAL NORMAL ENTRY CAIE CHR,"/" ;SWITCH? RETURN ; NO, EXIT CALL GETNB ;YES, BYPASS SLASH CALL CSISYM ;GET THE SYMBOL MOVSI T3,- ;SET FOR TABLE SCAN AOBJN T3,.+1 CAME SYM,SWPRT-1(T3) ;COMPARE AOBJN T3,.-2 ; NO JUMPG T3,SWPRO1 ;MISSED, ERROR SETZM ARGCNT ;CLEAR ARGUMENT COUNT XCT SWPRT(T3) TRZN FLG,-1 ;SKIP IF ERRORS ENCOUNTERED JRST SWPRO ;TRY FOR MORE SWPRO1: SKIPN SWPENT ;SWITCH.INI? FERROR [ASCIZ /BAD SWITCH/] ;NO. ABORT NORMALLY JRST SWIERR SETM68: SKIPA T1,[M68] ;6800 MACHINE TYPE SETM65: MOVEI T1,M65 ;6502 MACHINE TYPE JRST SETMCH ;STORE TYPE CODE SETM88: SKIPA T1,[M88] ;8008 COMPATIBLE MNEMONICS SETM08: MOVEI T1,M08 ;8008 INTEL MNEMONICS JRST SETMCH SETM18: SKIPA T1,[M18] ;1802 MACHINE TYPE SETM80: MOVEI T1,M80 ;8080/Z80 MACHINE TYPE JRST SETMCH SETMF8: MOVEI T1,MF8 ;F8 MACHINE TYPE JRST SETMCH DEFINE GENSWT (MNE,ACTION) ;GENERATE SWITCH TABLE < SIXBIT /MNE/ ACTION > SWPRT: ;SWITCH PROCESSOR TABLE GENSWT LI, GENSWT NL, GENSWT EN, GENSWT DS, GENSWT CRF, GENSWT N, GENSWT I, GENSWT P, GENSWT GNS, GENSWT SOL, GENSWT CDR, GENSWT EQ, GENSWT NSQ, GENSWT M80, GENSWT M65, GENSWT M68, GENSWT M88, GENSWT M08, GENSWT M18, GENSWT MF8, GENSWT PTP, GENSWT OCT, SWPRTE: SWPGNS: TLO EXF,FMTBIT ;SET FLAG MOVEI T3,LC.SEQ!LC.LOC!LC.BIN!LC.BEX!LC.ME!LC.TOC TLO ASM,0(T3) ;SUPPRESS SELECTED FLAGS IORM T3,LCMSK ;ALSO RESTRICT SOURCE OVER-RIDES RETURN PROEQ: CALL GSARG RETURN CALL SSRCH JFCL TLON T1,DEFSYM TRZ T1,177777 CALL INSRT JRST PROEQ PRONSQ: SETZM P10SEQ SETOM P10SEQ+1 RETURN .LOC SWPENT: BLOCK 1 ;NON-ZERO IN SWPRO IF ENTERED FROM ;SWITCH.INI PROCESSING .RELOC SUBTTL HEADER ROUTINE HEADER: CALL ACEXCH ;YES, SAVE THE ACCUMULATORS SPUSH EXF ;SAVE CURRENT FLAGS TLO EXF,NSWBIT ;DON'T OUTPUT TO TTY MOVEI T2,FF ;GET A FORM FEED CALL LSTDMP ;OUTPUT IT MOVEI T3,PAGSIZ+3 ;RESET LINE COUNTER REGISTER MOVEM T3,LPPCNT MOVN Q3,COLCNT ;GET COLUMNS PER LINE SUBI Q3,8*5+3 ;LEAVE ROOM FOR DATE, ETC. MOVE T1,[POINT 7,TTLBUF] TDZA VAL,VAL ;ZERO COUNT HEADE3: CALL LSTOUT ILDB T2,T1 ;FETCH CHAR FROM BUFFER CAIN T2,TAB ;TAB? IORI VAL,7 ; YES, FUDGE ADDI VAL,1 CAMGE VAL,Q3 JUMPN T2,HEADE3 CALL LSTTAB LSTSTR TITLE CALL LST2SP ;THE FOLLOWING SECTION PRINTS THE DATE, WHICH IS FOUND IN ;REGISTER XDATE IN THE FORM ; ((Y-1964)*12 + (M-1))*31 + (D-1) MOVE VAL,DATE ;GET THE DATE IN VAL IDIVI VAL,^D31 ;DIVIDE BY 31 DECIMIAL ADDI Q3,1 DNC Q3 ;OUTPUT DAY IDIVI VAL,^D12 ;DIVIDE BY 12 DECIMAL LSTSIX MONTH(Q3) MOVEI Q3,^D64(VAL) ;GET THE YEAR DNC Q3 CALL LST2SP ;OUTPUT TAB MOVE T3,MSTIME ;GET THE CURRENT TIME IDIVI T3,^D60*^D1000 ;NUMBER OF MIN. SINCE MIDNITE IDIVI T3,^D60 ;NUMBER OF HOURS SPUSH T4 ;SAVE MINUTES CAIG T3,9 LSTICH "0" DNC T3 ;OUTPUT THE HOURS LSTICH ":" ;OUTPUT A COLON AFTER THE HOURS SPOP Q3 ;PUT MINUTES IN OUTPUT AC CAIG Q3,^D9 ;IS IT A ONE-DIGIT NUMBER? LSTICH "0" ;YES, OUTPUT A ZERO DNC Q3 ;OUTPUT THE MINUTES TLNE FLG,P1F JRST HEADE1 MOVE Q3,PAGNUM ;GET PAGE NUMBER LSTMSG [ASCIZ / PAGE 5/] AOSE Q3,PAGEXT ;INCREMENT, PICK UP, AND TEST LSTMSG [ASCIZ /-5/] HEADE1: CALL LSTCR TLNN EXF,SOLBIT ;SEQUENCE OUTPUT? JRST HEADE2 AOS PAGNUM ; YES, BUMP COUNT SETOM PAGEXT HEADE2: LSTSIX SRCSAV HLLZ SYM,SRCSAV+1 JUMPE SYM,.+3 LSTICH "." LSTSIX SYM CALL LSTTAB LSTSTR STLBUF ;LIST SUB-TITLE CALL LSTCR CALL LSTCR SPOP T2 ;RESTORE FLAGS TLNN T2,NSWBIT TLZ EXF,NSWBIT JRST ACEXCH ;RESTORE F4 REGS AND EXIT MONTH: SIXBIT /-JAN-/ SIXBIT /-FEB-/ SIXBIT /-MAR-/ SIXBIT /-APR-/ SIXBIT /-MAY-/ SIXBIT /-JUN-/ SIXBIT /-JUL-/ SIXBIT /-AUG-/ SIXBIT /-SEP-/ SIXBIT /-OCT-/ SIXBIT /-NOV-/ SIXBIT /-DEC-/ .LOC PAGNUM: BLOCK 1 ;PAGE NUMBER PAGEXT: BLOCK 1 ;PAGE EXTENSION .RELOC SUBTTL AC EXCHANGE LOOP ACEXCH: ;SWAP AC'S TLC EXF,MODBIT ;TOGGLE MODE BIT EXCH SYM,AC00 EXCH T1,AC01 EXCH T2,AC02 EXCH T3,AC03 EXCH T4,AC04 EXCH PC,AC05 EXCH Q1,AC06 EXCH Q2,AC07 EXCH VAL,AC10 EXCH Q3,AC11 ; EXCH ASM,AC12 EXCH LBP,AC13 EXCH CHR,AC14 RETURN .LOC AC00: BLOCK 1 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 .RELOC SUBTTL BINARY OUTPUT ROUTINE BINOUT: ;BINARY OUTPUT SPUSH T2 ANDI T2,377 ;MASK TO 8 BITS ADDM T2,CHKSUM ;UPDATE CHECKSUM BINOU2: TLNE EXF,BINBIT ;BINARY REQUESTED? JRST BINOU6 ; NO, EXIT TLNN FLG,ISWFLG ;PACKED MODE? JRST BINOU3 ; YES CALL BCHOUT ;OUTPUT CHAR TO FILE JRST BINOU6 BINOU3: SOSLE BINPCT JRST BINOU4 CALL BINDMP MOVE T3,BINCNT IMULI T3,4 MOVEM T3,BINPCT BINOU4: MOVN T3,BINPCT ANDI T3,3 JUMPN T3,BINOU5 SOS BINCNT IBP BINPNT BINOU5: DPB T2,BINTBL(T3) BINOU6: SPOP T2 RETURN BINDMP: OUTPUT BIN, BINTST: STATO BIN,IODATA!IODEV!IOWRLK!IOBKTL RETURN FERROR [ASCIZ /BINARY OUTPUT ERROR/] BINTBL: POINT 8,@BINPNT,17 POINT 8,@BINPNT, 9 POINT 8,@BINPNT,35 POINT 8,@BINPNT,27 ;BASIC OUTPUT A CHARACTER ROUTINE BCHOUT: SOSG BINCNT CALL BINDMP IDPB T2,BINPNT RETURN BHXOUT: SPUSH T1 ;SAVE REGS SPUSH T2 ;SAVE REGS ANDI T2,377 ;MASK TO 8 BITS ADDM T2,CHKSUM ;... MOVSI T1,(POINT 4,0(P),35-8) BHXOU1: ILDB T2,T1 ;GET CHAR CAILE T2,^D9 ;DIGIT ADDI T2,"A"-"9"-1 ;NOPE, HEXIT ADDI T2,"0" ;MAKE ASCII CALL BCHOUT ;DUMP IT TLNE T1,770000 ;DONE JRST BHXOU1 ;NO - GET MORE SPOP T2 SPOP T1 ;RESTORE RETURN ;AND RETURN SUBTTL LISTING OUTPUT LSTST0: TDZA T3,T3 ; "LSTSTR" UUO LSTMS0: SETOM T3 ; "LSTMSG" UUO HLLM T3,0(P) ;SAVE FLAG MOVEI VAL,@.JBUUO ;FETCH ARG TLOA VAL,(POINT 7,,) ;SET BYTE POINTER AND SKIP LSTMS1: CALL LSTOUT ;TYPE CHARACTER LSTMS2: ILDB T2,VAL ;GET CHARACTER JUMPE T2,CPOPJ ;TEST FOR END CAIL T2,"0" ;TEST FOR SWITCH CAILE T2,"5" JRST LSTMS1 ;NO, TYPE THE CHARACTER SKIPL 0(P) ;STRING? JRST LSTMS1 ; YES, PRINT NUMERICS XCT LMT-"0"(T2) ;EXECUTE TABLE JRST LSTMS2 ;GET NEXT CHARACTER LMT: CALL LSTCR ; 0 - CR/LF LSTICH 0(CHR) ; 1 - CHARACTER CALL LM2 ; 2 - DEV: CALL LM3 ; 3 - DEV:FILNAM.EXT HALT . DNC Q3 ; 5 - DECIMAL NUMBER LM2: LSTSIX DEVNAM LSTICH ":" RETURN LM3: CALL LM2 LSTSIX FILNAM LSTICH "." HLLZ SYM,FILEXT LSTSIX SYM RETURN DNC0: ; "DNC" UUO MOVE T3,@.JBUUO ;FETCH ARG LDB T4,[POINT 4,.JBUUO,12] DNC1: SPUSH T4 IDIVI T3,^D10 HRLM T4,-1(P) SPOP T4 SOS T4 SKIPE T3 CALL DNC1 DNC2: HLRZ T2,0(P) SOJL T4,LSTNUM LSTICH SPACE JRST DNC2 LSTSY0: ;"LSTSYM" UUO SPUSH SYM ;STACK A COUPLE REGISTERS SPUSH T1 LDB T2,[POINT 4,.JBUUO,12] ;FETCH FLAG DPB T2,[POINT 1,-2(P),0] MOVE SYM,@.JBUUO ;FETCH WORD TRNN T2,2 ;SIXBIT? CALL M40SIX ; NO, CONVERT TO IT MOVSI T1,(POINT 6,SYM) LSTSY1: ILDB T2,T1 ;GET THE NEXT CHAR SKIPL -2(P) ;IF NO FLAG, JUMPE T2,LSTSY2 ; BRANCH ON BLANK ADDI T2,40 ;CONVERT TO ASCII CALL LSTOUT ;LIST IT TLNE T1,770000 JRST LSTSY1 LSTSY2: SPOP T1 SPOP SYM RETURN LSTIC0: ; "LSTICH" UUO MOVEI T2,@.JBUUO JRST LSTOUT LSTFLD: ;LIST FIELD MOVEI T2,5 ;5-COL FIELDS MOVEM T2,FLDCNT ;SET COUNT JUMPE VAL,LSTFL1 ;EXIT IF NULL CALL LSTWB ;LIST WORD/BYTE MOVEI T2,"'" TLNE VAL,GLBSYM MOVEI T2,"G" TDNE VAL,[PFMASK] ;RELOCATABLE? CALL LSTOUT LSTFL1: SKIPN VAL,FLDCNT ;GET COUNT RETURN ;ZERO - RETURN CALL LSTSP ;SPACE OVER SOJG VAL,.-1 RETURN ;RETURN WHEN DONE LSTWB: ;LIST WORD OR BYTE LDB T3,[POINT 2,VAL,17] CAIN T3,1 JRST LSTBY1 ;BYTE LSTWRD: TLNE EXF,OCTBIT ;WORD - OCTAL FORMAT? SKIPA T3,[POINT 3,VAL,35-18] ;OCTAL MOVE T3,[POINT 4,VAL,35-16] ;HEX JRST LSTWD1 LSTBYT: CALL LSTSP ;LIST BYTE (SPACES FIRST) LSTBY1: TRZ VAL,177400 ;CLEAR BITS TLNN EXF,OCTBIT ;OCTAL FORMAT? JRST LSTBY2 ;HEX CALL LSTSP MOVE T3,[POINT 3,VAL,35-9] JRST LSTWD1 ;OCTAL FORMAT LSTBY2: CALL LST2SP MOVE T3,[POINT 4,VAL,35-8] LSTWD1: ILDB T2,T3 SPUSH T3 ;SAVE PNTR CAILE T2,^D9 ;DIGIT? ADDI T2,"A"-"9"-1 ;ADD IN HEX OFFSET ADDI T2,"0" ;MAKE INTO ASCII CALL LSTOUT SPOP T3 TLNE T3,770000 JRST LSTWD1 ;GET NEXT CHAR RETURN LST3SP: ;LIST SPACES CALL LSTSP LST2SP: CALL LSTSP LSTSP: MOVEI T2,SPACE JRST LSTOUT LSTNUM: TROA T2,"0" ;LIST NUMERIC LSTASC: ADDI T2,40 ;CONVERT SIXBIT TO ASCII JRST LSTOUT LSTCR: TDZA T2,T2 ;LIST CR-LF LSTTAB: MOVEI T2,TAB ;LIST A TAB LSTOUT: ;LISTING ROUTINE SOS FLDCNT ;DECR COUNTER TLNN EXF,LSTBIT!LPTBIT ;LISTING REQUESTED? CALL LPTOUT ; YES TLNE EXF,ERRBIT ;ERROR LISTING? TLNE EXF,NSWBIT!TTYBIT ; YES, TO TTY? RETURN ; NO JUMPE T2,LSTOU1 ;BRANCH IF CR-LF OUTCHR T2 ;LIST CHARACTER RETURN ;EXIT LSTOU1: OUTSTR [BYTE (7) CRR, LF, 0] RETURN ;CR-LF TO TTY .LOC FLDCNT: BLOCK 1 ;COUNTER FOR LSTFLD .RELOC LPTOUT: ;OUTPUT TO LISTING DEVICE TLNN EXF,FMTBIT ;FMT MODE? JRST LPTOU1 ;NO, NORMAL TLNN FLG,FMTFLG ;YES, IN OVER-RIDE? RETURN ; NO JUMPN T2,LSTDMP ;YES JRST LPTOU5 LPTOU1: TLZE EXF,HDRBIT ;TIME FOR A HEADING? CALL HEADER ; YES JUMPE T2,LPTOU5 ;BRANCH IF CR-LF CAIN T2,TAB JRST LPTOU4 ;DON'T LIST TABS IMMEDIATELY AOSLE COLCNT ;OFF LINE? JRST LPTOU2 SKIPE TABCNT ;ANY IMBEDDED TABS? CALL PROTAB ; YES, PROCESS THEM JRST LSTDMP ;LIST THE CHARACTER LPTOU2: SKIPN WRPSAV MOVEM LBP,WRPSAV RETURN LPTOU4: AOS TABCNT ;TAB, BUMP COUNT SPUSH T2 MOVEI T2,7 IORM T2,COLCNT AOS COLCNT SPOP T2 RETURN LPTOU5: MOVEI T2,CRR ;CR-LF CALL LSTDMP MOVEI T2,LF LPTOU6: CALL LSTDMP SOSG LPPCNT ;END OF PAGE? LPTINI: TLO EXF,HDRBIT ; YES, SET FLAG LPTINF: MOVNI T2,COLTTY ;SET FOR COLUMN COUNT SKPLCR LC.TTM MOVNI T2,COLLPT MOVEM T2,COLCNT SETZB T2,TABCNT ;ZERO TAB COUNT AND REGISTER SETZM WRPSAV RETURN PROTAB: ;PROCESS IMBEDDED TABS SKIPG TABCNT ;ANY LEFT? RETURN ; NO SOS TABCNT ;YES, DECREMENT COUNT SPUSH T2 MOVEI T2,TAB CALL LSTDMP ;LIST ONE SPOP T2 JRST PROTAB ;TEST FOR MORE LSTDMP: SOSG LSTCNT ;DECREMENT ITEM COUNT CALL LSTDM1 ;EMPTY ENTIRE BUFFER IDPB T2,LSTPNT ;STORE THE CHARACTER CAIN T2,LF ;IF LINE FEED, TLNN EXF,TTYBIT ; AND LISTING IS ON TTY, DUMP BUFFER RETURN ;DUMP THE BUFFER LSTDM1: OUTPUT LST, ;EMPTY A BUFFER LSTTST: STATO LST,IODATA!IODEV!IOWRLK!IOBKTL ;CHECK FOR ERRORS RETURN ;NO, EXIT FERROR [ASCIZ /LISTING OUTPUT ERROR/] .LOC COLCNT: BLOCK 1 ;COLUMN COUNT TABCNT: BLOCK 1 ;TAB COUNT LPPCNT: BLOCK 1 ;LINES/PAGE COUNT WRPSAV: BLOCK 1 WRPCNT: BLOCK 2 .RELOC SUBTTL SOURCE INPUT CHAR: CALL CHARLC CAIN T2,QJLC SUBI CHR,40 RETURN CHARLC: CHAR0: SKIPE MCACNT JRST CHAR10 SKIPE MSBMRP JRST CHAR2 ;BRANCH IF IN MACRO SOSGE SRCCNT ;DECREMENT ITEM COUNT JRST CHAR4 ;GET ANOTHER BUFFER IF NECESSARY IBP SRCPNT ;INCREMENT THE BYTE POINTER MOVE CHR,@SRCPNT ;PICK UP AN ENTIRE WORD FROM BUFFER TRZE CHR,1 ;IS THE SEQUENCE NUMBER BIT ON? JRST CHAR8 ;YES, SKIP AROUND IT LDB CHR,SRCPNT ;NO, PICK UP A GOOD CHARACTER CHAR1: LDB T2,C7PNTR ;MAP XCT CHARTB(T2) ;DECIDE WHAT TO DO RETURN ;ACCEPT IT CHAR2: CALL READMC ;GET A CHARACTER FROM MACRO TREE JRST CHAR0 ; NULL, TRY AGAIN JRST CHAR1 ;TEST IT CHAR4: INPUT SRC, ;CALL MONITIOR FOR A BUFFER STATZ SRC, IODATA+IODEV+IOBKTL+IOWRLK CHAR4A: FERROR [ASCIZ /INPUT DATA ERROR/] STATO SRC, IOEOF ;WAS AN END OF FILE REACHED? JRST CHAR0 ;GET NEXT CHAR CHAR5: CLOSE SRC, SKIPE AC14 ;CRR SEEN BY COMMAND SCANNER? TLNN EXF,MODBIT JRST CHAR6 CALL ACEXCH ;GET EXEC AC'S CALL GETSRC ;GET THE NEXT SOURCE FILE CALL ACEXCH ;SAVE EXEC AC'S AND RETURN JRST CHAR0 CHAR6: TLO FLG,ENDFLG ;YES, FLAG END MOVEI CHR,LF ;MAKE IT A LINE JRST CHAR1 CHAR8: SKIPL P10SEQ+1 MOVEM CHR,P10SEQ MOVSI CHR,(B6) IORM CHR,P10SEQ+1 AOS SRCPNT ;INCREMENT POINTER PAST WORD MOVNI CHR,5 ;GET -5 ADDM CHR,SRCCNT ;SUBTRACT 5 FROM WORD COUNT JRST CHAR0 CHAR10: SOSGE MACBUF+2 ;MORE CHARS TO GET W/OUT INPUT? JRST CHAR11 ;NO IBP MACPNT ;INCREMENT MACRO POINTER MOVE CHR,@MACPNT ;GET A WHOLE WORD FROM SOURCE BUFFER TRZE CHR,1 ;SEQUENCE NUMBER? JRST CHAR12 ;YES. LDB CHR,MACPNT JRST CHAR1 CHAR11: INPUT MAC, STATZ MAC,740000 JRST CHAR4A STATO MAC,IOEOF JRST CHAR JRST CHAR6 CHAR12: SKIPL P10SEQ+1 ;SOMETHING THERE ALREADY? MOVEM CHR,P10SEQ ;NO MOVSI CHR,(B6) IORM CHR,P10SEQ+1 AOS MACPNT ;BOOST POINTER AROUND SEQ NR & TAB MOVNI CHR,5 ;SET UP -5 ADDM CHR,MACBUF+2 ;DECREMENT THE WORD COUNT JRST CHAR10 ;GO BACK AND TRY AGAIN CHARTB: ;CHARACTER JUMP TABLE PHASE 0 MOVEI CHR,RUBOUT ;ILLEGAL CHARACTER QJNU:! JRST CHAR0 ;NULL, TRY AGAIN QJCR:! JFCL ;END OF STATEMENT QJVT:! MOVEI CHR,LF ;VERTICAL TAB QJTB:! JFCL ;TAB QJSP:! JFCL ;SPACE QJPC:! JFCL ;PRINTING CHARACTER QJLC:! JFCL DEPHASE SUBTTL BASIC ASSEMBLY LOOP ASSEMB: ;ASSEMBLER PROPER TLO FLG,P1F ;SET FOR PASS 1 MOVE T3,.MAIN. MOVEM T3,PRGTTL ;INIT TITLE MOVE T3,.ABS. MOVEM T3,SECNAM ;INIT ABSOLUTE SECTOR MOVE T3,[XWD [ASCIZ /.MAIN./],TTLBUF] BLT T3,TTLBUF+2 MOVE T3,[XWD [ASCIZ /TABLE OF CONTENTS/],STLBUF] BLT T3,STLBUF+4 ;PRESET SUBTTL BUFFER CALL INIPAS ;INITIALIZE PASS ONE CALL BLKINI ;INITIALIZE BINARY OUTPUT TLNE EXF,GBLDIS ;HAVE DFLT GLOBALS BEEN DISABLED? TLOA EXF,GBLCCL ;YES. SAVE SETTING TLZ EXF,GBLCCL ;RESET CCL-LEVEL DLFT GLOBAL SW CALL LINE ;GO DO PASS ONE. TLZ FLG,P1F ;RESET TO PASS 2 TLNE EXF,GBLCCL ;SHLD GBLDIS REMAIN SET? TLOA EXF,GBLDIS ;YES TLZ EXF,GBLDIS ;... CALL SETCRF ;SET CREF OUTPUT FILE SKIPN CCLTOP JRST ASSEM1 TLO EXF,LPTBIT!ERRBIT ;LIST TO TTY LSTSYM PRGTTL CALL LSTCR TLZ EXF,LPTBIT!ERRBIT ASSEM1: CALL INIPAS SETZM STLBUF CALL LINE ;CALL THE ASSEMBLER (PASS TWO) RETURN LINE: ;PROCESS ONE LINE CALL GETLIN ;GET A SOURCE LINE CALL STMNT ;PROCESS ONE STATEMENT CALL ENDL ;PROCESS END OF LINE TLZN FLG,ENDFLG ;TEST FOR END STATEMENT JRST LINE ;GET THE NEXT LINE JRST ENDP ;END OF PASS INIPAS: CALL SETSRC ;RESET INPUT COMMAND STRING SKPEDR ED.ABS ;ABSOLUTE? TDZA PC,PC ; YES, SET PC TO ZERO MOVSI PC,(1B) ; NO, SET TO RELOCATABLE HRRZ T3,MACHT ;GET MACHINE TYPE CALL @MCHINI(T3) ;M-DEPENDANT INIT MOVSI T3,-^D256 SETZM SECBAS(T3) ;INIT SECTOR BASES AOBJN T3,.-1 SETZM MSBMRP SETZM MSBLVL ;RESET MACRO INFO SETZM LSBNUM CALL LSBINC ;INIT LOCAL SYMBOLS MOVEI T3,^D10 ;DEFAULT BASE 10 MOVEM T3,CRADIX MOVEI SYM,1 MOVEM SYM,PAGNUM ;INITIALIZE PAGE NUMBER MOVEM SYM,ERPNUM ; AND ERROR PAGE NUMBER SETOM ERPBAK ;BE SURE TO PRINT FIRST TIME SETOM PAGEXT ; AND EXTENSION TLO EXF,HDRBIT SETZM CNDMSK ;CLEAR CONDITIONAL MASK SETZM CNDWRD ; AND TEST WORD SETZM CNDLVL SETZM CNDMEX MOVEM ASM,TIMBLK ;PRESERVE R12 SETZM REPSW ;CLEAR REPEAT SWITCH SETZM REPBLK ;;AND FIRST WORD OF BLOCK MOVEI ASM,REPBLK-1 ;INITIALIZE 'STACK' POINTER MOVEM ASM,REPCT ;..... MOVE ASM,[REPBLK,,REPBLK+1];PREPARE FOR AND.... BLT ASM,REPBLK+^D127 ;...EXECUTE THE BLT TO CLEAR THE STACK SETZ ASM, ;CLEAR THE REGISTER EXCH ASM,TIMBLK ;AND THEN TIMBLK W/ REG RESTORE SETZM TIMBLK+1 SETZM PHAOFF SETZM WRPCNT SETZM WRPCNT+1 JRST ENDLI ;EXIT THROUGH END OF LINE ROUTINE .MAIN.: GENM40 <.MAIN.> .ABS.: GENM40 <. ABS.> MCHINI: CPOPJ ;*** 6502 *** CPOPJ ;*** 6800 *** M80INI ;*** 8080 *** M88INI ;*** 8008 *** M08INI ; M18INI ;*** 1802 *** CPOPJ ;*** F8 *** CHKTAB (MCHINI) M88INI: M08INI: M18INI: M80INI: TLNN EXF,REGBIT ;ENABLED AT COMMAND LEVEL? CALL .ENABA ;NO - SET DEFALUT REGS RETURN SUBTTL STATEMENT EVALUATOR STMNT: ;STATEMENT PROCESSOR SETZM ARGCNT SKIPN CNDWRD ;UNSATISIFIED CONDITIONAL? SKIPE CNDMEX ;OR PERHAPS AN .MEXIT? JRST STMNT5 ;YES... STMNTF: SETZM ARGCNT ;CLEAR ARGUMENT COUNT CALL GETSYM ;TRY FOR SYMBOL JUMPE SYM,STMNT3 ;BRANCH IF NULL CAIN CHR,":" ;LABEL? JRST LABEL ; YES CAIN CHR,"=" ;ASSIGNMENT? JRST ASGMT ; YES CALL OSRCH ;NO, TRY MACROS OR OPS JRST STMNT2 ;TREAT AS EXPRESSION STMNT1: CALL CRFOPR ;CREF OPERATOR REFERENCE LDB T2,TYPPNT ;RESTORE TYPE XCT STMNJT(T2) ;EXECUTE TABLE STMNJT: ;STATEMENT JUMP TABLE PHASE 0 JRST STMNT2 ;BASIC SYMBOL MAOP:! JRST MACROC ;MACRO Z8OP:! JRST PROPCZ ;Z80 OP CODE OCOP:! JRST PROPC ;OP CODE DIOP:! JRST 0(T1) ;PSEUDO-OP DEPHASE STMNT2: MOVE LBP,SYMBEG ;NON-OP SYMBOL, RESET CHAR POINTER CALL SETNB ;SET CURRENT CHAR CAIE CHR,";" ;IF SEMI-COLON CAIN CHR,0 ; OR LINE TERMINATOR, RETURN ; NULL LINE JRST .BYTE ;NEITHER, TREAT AS ".BYTE" STMNT3: CALL GETLSB ;IT'S A LOCAL SYMBOL, RIGHT? JUMPE SYM,STMNT2 ;WRONG. CAIE CHR,":" ;THEN IT'S A LABEL, RIGHT? JRST STMNT2 ;SORRY, WRONG AGAIN. IT'S AN EXPRESSION CAMLE PC,LSBMAX ;WITHIN RANGE? ERRSET ERR.A ; NO, ERROR JRST LABELF STMNT4: CALL GETNB CAIN CHR,":" ;ANOTHER COLON? CALL GETNB ;YES...BYPASS IT. STMNT5: ;TRAP FOR .MEXIT OR UNSATISIFED CONDITIONALS CALL GETSYM CAIN CHR,":" JRST STMNT4 CAIN CHR,"=" JRST STMNT6 CALL TSTMLI ;CONDITIONED OUT CAIE T3,DCCND ;TEST FOR CONDITIONAL OP CODE CAIN T3,DCCNDE JRST STMNT1 ; YES, PROCESS IT STMNT6: SETLCT LC.CND ;NO, SET LISTING FLAG TLO FLG,NQEFLG RETURN LABEL: ;LABEL PROCESSOR CALL LSBTST ;TEST FOR NEW LOCAL SYM RANGE LABELF: MOVSI T4,0 ;ASSUME NO GLOBAL DEFINITION CALL GETNB ;BYPASS COLON CAIE CHR,":" ;ANOTHER COLON? JRST .+3 ;NO MOVSI T4,GLBSYM ;GET GLOBAL FLAG CALL GETNB ;BYPASS SECOND COLON SPUSH T4 ;STACK GLOBAL FLAG CALL SSRCH ;SEARCH SYMBOL TABLE JRST LABEL0 ;NOT THERE. TLNE T1,REGSYM ;REGISTER? JRST LABEL2 ;YES, ERROR LABEL0: TLNE T1,DEFSYM ;SYMBOL DEFINED? JRST LABEL1 ;YES TLNE T1,FLTSYM ;DEFAULTED GLOBAL SYMBOL? TLZ T1,FLTSYM!GLBSYM ;YES-CLEAR FLAGS. TDO T1,0(P) ;INSERT GLOBAL BIT TDO T1,PC ;SET CURRENT PC VALUE LABEL1: MOVE T3,T1 ;COPY VALUE REGISTER TDC T3,PC ;COMPARE WITH PC TDNN T3,[PCMASK] ;EQUAL ON MEANINGFUL BITS JRST LABEL3 ; YES LABEL2: TLNN FLG,P1F ;NO, PASS 1? TLNE T1,MDFSYM ;NO, MULTIPLY DEFINED ALREADY? TLOA T1,MDFSYM ; YES, FLAG SYMBOL ERRSET ERR.P ;NO, PHASE ERROR CAIA LABEL3: TLO T1,LBLSYM!DEFSYM ;OK, FLAG AS LABEL CAMN SYM,M40DOT ;PERCHANCE PC? ERRSKP ERR.M ; YES, FLAG ERROR AND SKIP CALL INSRT ;INSERT/UPDATE TLNE T1,MDFSYM ;MULTIPLY DEFINED? ERRSET ERR.M ; YES SPOP T4 ;CLEAN STACK CALL SETNB ; MOVEM LBP,CLILBL CALL CRFDEF CALL SETPF0 JRST STMNTF ;RETURN TO STATEMENT EVALUATOR ASGMT: ;ASSIGNMENT PROCESSOR MOVSI T4,0 ;ASSUME NO GLOBAL DEFINITION CALL GETNB ;GET NEXT NON-BLANK CAIE CHR,"=" ;ANOTHER EQUALS? JRST .+3 ;NO MOVSI T4,GLBSYM ;SET GLOBAL SYMBOL FLAG CALL GETNB ;GET NEXT NON-BLANK SPUSH T4 ;STACK FLAG SPUSH SYM ;STACK SYMBOL CALL RELEXP CALL SETPF1 JRST ASGMT0 ASGMTF: CALL SETPF1 ASGMTX: MOVSI T4,0 ;SET ZERO FLAG EXCH T4,0(P) ;EXCHANGE WITH SYMBOL SPUSH T4 ;STACK SYMBOL AGAIN ASGMT0: SPOP SYM ;RETRIEVE SYMBOL CALL SSRCH ;SEARCH TABLE JFCL ;NOT THERE YET CALL CRFDEF TLNE T1,LBLSYM ;LABEL? JRST ASGMT1 ; YES, ERROR TLNE T1,FLTSYM ;DEFAULTED GLOBAL SYMBOL? TLZ T1,FLTSYM!GLBSYM ;YES-CLEAR DEFAULT FLAGS AND T1,[XWD GLBSYM!MDFSYM,0] ;MASK TRNN FLG,ERR.U!ERR.A ;ANY UNDEFINED SYMBOLS OR ADDRSNG ERRS? TLO T1,DEFSYM ; NO, FLAG AS DEFINED TDOA T1,VAL ;MERGE NEW VALUE ASGMT1: TLO T1,MDFSYM ; ERROR, FLAG AS MULTIPLY DEFINED TLNE T1,MDFSYM ;EVER MULTIPLY DEFINED? ERRSET ERR.M ; YES CAME SYM,M40DOT ;LOCATION COUNTER? TDO T1,0(P) ;NO - MERGE GLOBAL DEFINITION BIT SPOP T4 ;CLEAN STACK CAME SYM,M40DOT ;SKIP IF LOCATION COUNTER JRST INSRT ;INSERT AND EXIT CALL TSTMAX ;TEST FOR NEW HIGH LDB T2,SUBPNT LDB T3,CCSPNT CAME T2,T3 ;CURRENT SECTOR? ASGMT2: ERRXIT ERR.A!ERR.P1 ; ERROR, DON'T STORE CALL INSRT JRST SETRLD SUBTTL END OF LINE PROCESSOR ENDL: ;END OF LINE PROCESSOR SKIPE MCACNT JRST ENDLI SKIPE ARGPNT HALT . SETCHR CAIA ENDL01: CALL GETNB ;SET NON-BLANK CHARACTER CAIE CHR,0 ;IF CR/LF CAIN CHR,";" ; OR COMMENT, JRST ENDL02 ; BRANCH TLNE FLG,NQEFLG ;NO, OK? JRST ENDL01 ; YES, TRY AGAIN ERRSET ERR.Q ; NO, FLAG ERROR ENDL02: SKPLCR LC.COM ;COMMENT SUPPRESSION? MOVEM LBP,CLIPNT+1 ; YES, MARK IT MOVE T1,CLIPNT SKPLCR LC.SRC ;SOURCE SUPPRESSION? MOVEM T1,CLIPNT+1 ; YES SETZM CODPNT ;INITIALIZE FOR CODE OUTPUT CALL PROCOD ;PROCESS CODE JFCL ; NO CODE, IGNORE THIS TIME ENDL10: TDZ FLG,ERRSUP TRNE FLG,-1-ERR.P1 TRZ FLG,ERR.P1 TRZN FLG,ERR.P1 ;PASS 1 ERROR? TLNN FLG,P1F ; NO, ARE WE IN PASS2? CAIA ; YES, LIST THIS LINE TRZ FLG,-1 ;PASS 1, CLEAR ANY ERROR FLAGS TRNE FLG,-1 ;ANY ERRORS? TLO EXF,ERRBIT ; YES, SET BIT TLNE EXF,ERRBIT!P1LBIT ;ERRORS OR PASS1 LISTING? JRST ENDL11 ; YES TLNN EXF,LSTBIT TLNE FLG,FFFLG ;NO, PASS ONE? JRST ENDL41 ; YES, DON'T LIST SKIPL LCLVLB ;IF LISTING DIRECTIVE SKIPGE T2,LCLVL ; OR LISTING SUPPRESSED, JRST ENDL41 ; BYPASS SKPLCR @LCTST ; AND SUPPRESSION BITS JUMPLE T2,ENDL41 ; YES TLNE FLG,P1F JRST ENDL42 JRST ENDL20 ;NO, LIST THIS LINE ENDL11: TRNN FLG,-1 ;ARE WE HERE DUE TO ERRORS? JRST ENDL20 ; NO TRNE FLG,-1-ERR.Q ;ERRORS OTHER THAN "Q"? TRZ FLG,ERR.Q ; YES, DON'T LIST IT TRNE FLG,QMEMSK ;ANY FATAL TYPES? AOSA ERRCNT ; YES AOS ERRCNT+1 ;NO, TALLY SECONDARY MOVE T3,LINPNT MOVEM T3,CLIPNT ;LIST ENTIRE LINE SETZM CLIPNT+1 TLO EXF,LPTBIT MOVE Q3,ERPNUM CAME Q3,ERPBAK LSTMSG [ASCIZ /**PAGE 50/] MOVEM Q3,ERPBAK TLZ EXF,LPTBIT HRLZ SYM,FLG ;PUT FLAGS IN AC0 LEFT MOVE T1,[POINT 7,ERRMNE,] ENDL12: ILDB T2,T1 ;FETCH CHARACTER SKIPGE SYM ;THIS CHARACTER? CALL LSTOUT ; YES LSH SYM,1 JUMPN SYM,ENDL12 ;TEST FOR END ENDL20: SKPLCR LC.SEQ JRST [CALL LST2SP JRST ENDL23] TLO FLG,FMTFLG MOVE T1,LINNUM EXCH T1,LINNUB CAME T1,LINNUB JRST ENDL21 SKIPLE Q3,MSBLVL LSTMSG [ASCIZ / (5)/] JRST ENDL22 ENDL21: HRRZ SYM,COLCNT IDIVI SYM,8 MOVE T3,LINNUM IDIVI T3,^D10 ADDI T1,1 JUMPN T3,.-2 CALL LSTSP CAIGE T1,5 AOJA T1,.-2 DNC LINNUM ENDL22: CALL LSTTAB ENDL23: TLO FLG,FMTFLG TLNE FLG,LHMFLG ;TO BE LEFT-JUSTIFIED? JRST ENDL30 ; YES SKPLCR LC.LOC JRST ENDL24 ;SKIP MOVE VAL,PF0 ;FIRST FIELD TO BE PRINTED? CALL LSTFLD ; YES ENDL24: SKPLCR LC.BIN JRST ENDL25 MOVE VAL,PF1 ;PRINT PF1 CALL LSTFLD SKPLCS LC.TTM JRST ENDL25 ; YES, THROUGH FOR NOW MOVE VAL,PF2 CALL LSTFLD ; NO, LIST MOVE VAL,PF3 CALL LSTFLD MOVE T1,COLCNT CAIE T1,140 ;NO TAB IF PAST COL 140 ENDL25: CALL LSTTAB ;TAB OVER ; .. ; .. ENDL30: SKIPE P10SEQ LSTSTR P10SEQ TLNN FLG,P1F SKPEDS ED.TIM ;TIMING REQUESTED? JRST ENDL35 ; NO SKIPN T1,TIMBLK+1 ;YES, ANY INCREMENT? JRST ENDL34 ; NO, JUST A TAB ADDM T1,TIMBLK ;YES, UPDATE MASTER IDIVI T1,^D10 SPUSH T2 DNC 4,T1 LSTICH "." SPOP T2 LSTICH "0"(T2) SETZM TIMBLK+1 ;CLEAR INCREMENT ENDL34: CALL LSTTAB ENDL35: SKIPN MSBLVL ;IN MACRO? JRST ENDL37 ;NO - CONTINUE MOVEI T3,LC.MB ;YES - WANT BINARY ONLY? TDNE T3,LCTST ;??? JRST ENDL40 ;YES - SKIP SOURCE LISTING ENDL37: SKIPN LBP,CLIPNT ;ANY LINE TO LIST? JRST ENDL40 ; NO SKIPE T3,CDRCHR ;CDR CHAR TO STUFF? DPB T3,CDRPNT ; YES, DO SO MOVEI T3,0 DPB T3,CLIPNT+1 ;MARK END OF PRINTING LINE ENDL36: LDB T2,LBP ;SET FIRST CHARACTER ILDB T1,ILCPNT SKIPE ILCPNT TLO T1,(1B0) DPB T3,ILCPNT JUMPE T2,ENDL33 ENDL31: CALL LSTOUT ;LIST THIS CHARACTER ILDB T2,LBP ;GET THE NEXT ENDL32: JUMPN T2,ENDL31 ;LOOP IF NOT END ENDL33: JUMPE T1,ENDL40 ;BRANCH IF NO ILLEGAL CHARS STORED MOVEI T2,"?" ;YES, MARK THE LISTING CALL LSTOUT HRRZ T2,T1 ;GET SAVED CHARACTER MOVEI T1,0 ;RESET ILLEGAL CHARACTER JRST ENDL32 ENDL40: SKPEDR ED.WRP SKIPN LBP,WRPSAV JRST ENDL44 AOS WRPCNT+1 SPUSH COLCNT CALL LSTCR SPOP T3 ADD T3,COLCNT MOVNS T3 IDIVI T3,^D8 MOVEM T3,TABCNT JRST ENDL36 ENDL44: AOS WRPCNT CALL LSTCR ;LIST CR/LF ENDL42: TLNE EXF,SOLBIT ;SEQUENCE OUTPUT? SKPLCR LC.BEX ; YES, EXTENSION LINE? CAIA ; YES, IGNORE AOS LINNUM ;NO, BUMP LINE NUMBER ENDL41: CALL ENDLIF ;SEMI-INIT LINE CALL PROCOD ;PROCESS ADDITIONAL CODE, IF ANY JRST ENDL50 SETLCT LC.BEX JRST ENDL10 ;MORE CODE, LOOP ENDL50: SKIPN T3,FFCNT ;FORM FEED ENCOUNTERED? JRST ENDLI ; NO SETZM TIMBLK ;RESET TIMING AT END OF LINE HRRZS T3 TLNN FLG,P1F ;SKIP IF PASS 1 SKIPGE LCLVL CAIA TLO EXF,HDRBIT ;SET HEADER BIT JUMPE T3,ENDLI TLNN EXF,SOLBIT ADDM T3,PAGNUM ;YES, BUMP PAGE NUMBER SETOM PAGEXT TLNE EXF,FMTBIT TLNE FLG,P1F JRST ENDLI TLO FLG,FMTFLG LSTICH CRR LSTICH FF SOJG T3,.-2 ENDLI: SETZM CODPNT SETZM LCTST SETZM GLBPNT SETZM FFCNT TLZ FLG,FMTFLG SETZM LINPNT SETZM CLIPNT+1 ENDLIF: AND PC,[PCMASK] ;CLEAN UP PC SETZM PF0 ;CLEAR PRINT WORDS SETZM PF1 SETZM PF2 SETZM PF3 SETZM CLIPNT SETZM CLILBL SETZM LCLVLB SKIPL T3,P10SEQ+1 MOVEM T3,P10SEQ SETZM CDRCHR SETZM ILCPNT TRZ FLG,-1 TLZ FLG,NQEFLG!FFFLG!DSTFLG!DS2FLG!LHMFLG TLZ EXF,ERRBIT!P1LBIT RETURN .LOC PF0: BLOCK 1 ;PRINT FIELD STORAGE PF1: BLOCK 1 PF2: BLOCK 1 PF3: BLOCK 1 PFT0: BLOCK 1 ;TEMPS FOR ABOVE PFT1: BLOCK 1 LINNUM: BLOCK 1 ;SEQUENCE NUMBER LINNUB: BLOCK 1 P10SEQ: BLOCK 2 .RELOC SUBTTL ERROR FLAGGING ERRSK0: AOSA 0(P) ;FLAG ERROR AND SKIP ERRXI0: SPOP 0(P) ;FLAG ERROR AND EXIT ERRSE0: TRO FLG,@.JBUUO ;FLAG ERROR RETURN SUBTTL OP CODE HANDLERS PROPCZ: LDB T2,SUBPNT ;GET TYPE CODE TLO T1,-1 ;MARK Z80 OPCODE SKPEDS ED.Z80 ;ALLOWED? ERRSET ERR.Z ;NO - FLAG IT HRRZM T1,MZ8TMP ;SAVE PARAM ADDRS HRR T1,0(T1) ;SET UP RHS (SAME AS 80) JRST PROPC1 ;JOIN COMMON CODE PROPC: ;PROCESS OP CODES LDB T2,SUBPNT ;GET CLASS HRLI T1,BC1 ;ONE BYTE ONLY PROPC1: MOVEM T1,OPCODE ;SAVE TABLE ADDRS SETZM ADRLOW SETZM ADRHGH MOVE T3,MACHT ;GET MACHINE TYPE XCT MOVTBL(T3) ;GET PROPER DISPATCH ENTRY TRZ T3,777 ;MASK OFF XTRA BITS TLO FLG,0(T3) ;SET CREF FLAGS HLRZS T3 ;GET DISPATCH CALL 0(T3) ;PERFORM ADDRESS PARSE MOVE T3,MACHT ;MACHINE TYPE JRST @STOTBL(T3) ;STORE FOR CODE(S) MOVTBL: MOVE T3,PRPM65(T2) ;*** 6502 *** MOVE T3,PRPM68(T2) ;*** 6800 *** MOVE T3,PRPM80(T2) ;*** 8080 *** MOVE T3,PRPM88(T2) ;*** 8008 *** MOVE T3,PRPM08(T2) ; MOVE T3,PRPM18(T2) ;*** 1802 *** MOVE T3,PRPMF8(T2) ;*** F8 *** CHKTAB (MOVTBL) STOTBL: M65STO M68STO M80STO M88STO M08STO M18STO MF8STO CHKTAB (STOTBL) ;STORE OP LOW HIGH M80STO: SKIPL OPCODE ;CHECK SPECIAL JRST M65STO ;NO - SAME AS 6502 MOVE T1,@MZ8TMP ;GET REMAINDER OF OP LSH T1,-^D10 ;POSITION HIGH BYTE ANDI T1,177400 ;MASK BYTE IOR T1,OPCODE ;FETCH LOW BYTE HRLI T1,BC2 ;ASSUME 2-BYTES TRNN T1,177400 ;HAVE HIGH BYTE? HRLI T1,BC1 ;NO - SINGLE BYTE MOVEM T1,OPCODE ;STORE OPCODE INFO ;FALL INTO M65STO M88STO: ;8008 - SAME AS 6502 M08STO: M65STO: SKIPE T1,OPCODE ;FETCH OPCODE CALL STCODE ;STASH OPCODE SKIPE T1,ADRLOW ;LOW ADDRS BITS CALL STCODE SKIPE T1,ADRHGH ;HIGH ADDRS BITS CALL STCODE ;STASH RETURN ;STORE OP HIGH LOW MF8STO: M18STO: M68STO: SKIPE T1,OPCODE ;FETCH OPCODE CALL STCODE ;STASH OPCODE SKIPE T1,ADRHGH ;HIGH ADDRS BITS CALL STCODE SKIPE T1,ADRLOW ;LOW ADDRS BITS CALL STCODE ;STASH RETURN ;6502 OPCODE CLASS HANDLERS M65CL5: ;CLASS 1 WITH DEST CREF MOVEI T2,^D20 ;XTRA 2 CYCLES FOR THESE ADDM T2,TIMBLK+1 M65CL1: CALL M65AEX ;GET ADDRS EXPRESSION JRST POPERA ;ADDRESS ERROR HRRZ T3,T4 ;GET ADDRESS TYPE TLNE T4,(AM%ACC) ;ARG WAS ACCUMULATOR JRST [MOVEI T2,^D20 ;TWO CYCLES FOR ACCUM ADDM T2,TIMBLK+1 JRST M65C4A] ;TREAT AS IMPLIED CAIN T3,.M65A6 ;INDIRECT INVALID JRST POPERA CAIG T3,.M65A3 ;EASY CASES JRST M65C1A ;HANDLE ABS CAIN T3,.M65A7 ;IMMEDIATE (#) JRST [MOVEI T2,^D20 ;TWO CYCLES FOR IMMEDIATE ADDM T2,TIMBLK+1 JRST M65C1B] MOVEI T2,^D50 ;ASSUME (IND),Y CAIN T3,.M63A4 ;IS IT (INC,X)? ADDI T2,^D10 ;YES ADDM T2,TIMBLK+1 TLC T4,(AM%IND!AM%ZP) ;THESE MUST BE ON NOW TLCE T4,(AM%IND!AM%ZP) JRST POPERA ;ADDRESS ERROR M65C1D: HRLI T1,BC1 ;SINGLE BYTE MOVEM T1,ADRLOW ;SAVE IT HRRZ T1,OPCODE ;GET OPCODE TABLE PNTR LDB T2,[POINT 9,2(T1),35] MOVNS T2 ;NEGATE THIS (DIVIDEND) ADDM T2,TIMBLK+1 ;ADJUST TIME BLOCK LDB T1,OPPNT(T3) ;FETCH OPCODE JUMPE T1,POPERA ;DONt HAVE THIS MODE JRST M651A1 ;COMMON EXIT M65C1A: MOVEI T2,^D40 ;BASIC ABSOLUTE ADDM T2,TIMBLK+1 TLNE T4,(AM%IND) ;BETTER BE OFF JRST POPERA ;SORRY CALL POPSTA ;STASH ADDRS TLNE T4,(AM%ZP) ADDI T3,.M65ZO ;OFFSET ADDRS MODE HRRZ T1,OPCODE ;OPCODE TABLE LDB T2,[POINT 9,2(T1),35] TRZN T2,400 ;XTRA? MOVNS T2 ;AMOUNT TO ADJUST BASIC TIME ADDM T2,TIMBLK+1 LDB T2,OPPNT(T3) ;GET OPCODE JUMPE T2,[SUBI T3,.M65ZO LDB T1,OPPNT(T3) JUMPE T1,POPERA ;ERROR IF NONE HERE JRST M651A1] MOVE T1,T2 ;COPY OPCODE TO CORRECT PLACE TLNN T4,(AM%ZP) ;ZERO PAGE? JRST M651A1 ;NO - STORE MOVNI T2,^D10 ;YES - GET REFUND CAIN T3,.M65A1+.M65ZO ;FOR REAL ZERO PAGE ONLY ADDM T2,TIMBLK+1 SETZM ADRHGH ;AND NO HIGH BYTE THEN M651A1: MOVEI T2,0 ;ASSUME NONE TRZE T1,400 ;CHECK XTRA CYCLE MOVEI T2,^D10 ;YES ADDM T2,TIMBLK+1 ;ACCOUNT FOR IT HRRM T1,OPCODE ;STORE OPCODE RETURN ;AND RETURN M65C1B: TLNE T4,(AM%ZP) ;ONE BYTE? TLNE T4,(AM%IND) ; AND NO INDIRECT JRST POPERA ; ELSE ERROR JRST M65C1D ;JOIN COMMON CASE ;GENERAL ROUTINES POPERA: MOVEI T1,00 ;MAKE INTO BREAK HRRM T1,OPCODE ERRSET ERR.A RETURN ;RETURN ERROR OPCERR: ERRSET ERR.O MOVEI T1,00 ;STORE ZERO HRRM T1,OPCODE RETURN POPSTA: LDB T2,[POINT 8,T1,35] HRLI T2,BC1 ;SAVE LOW ORDER ADDRS MOVEM T2,ADRLOW LDB T2,[POINT 8,T1,35-8] HRLI T2,BC1 ;ONE BYTE MOVEM T2,ADRHGH ;NO, SAVE HIGH ORDER ADDRS RETURN M80BYT: CALL BYTEXP ;GET 8-BIT EXPR TLNE VAL,REGSYM ;NO REGS ALLOWED HERE ERRSET ERR.A HRLI T1,BC1 ;SET CODE MOVEM T1,ADRLOW ;SAVE BYTE RETURN RELBYT: CALL RELADR ;PARSE RELATIVE ADDRS MOVNS VAL ;NEGATE TRNE VAL,200 ;NEGATIVE ADDRS TRC VAL,177400 ;CHECK FOR MORE THAN 1 BYTE TRNE VAL,177400 ERRSET ERR.A ;ADDRESS ERROR TRNE FLG,ERR.A MOVEI VAL,377 ;MAKE JMP . HRLI VAL,BC1 ;ONE BYTE MOVEM VAL,ADRLOW ;SAVE XFER BYTE RETURN ; AND EXIT M65CL2: CALL RELBYT ;PARSE RELATIVE ADDRS TO ADRLOW MOVEI T2,^D20 ;2 CYCLES FOR RELATIVE ADDM T2,TIMBLK+1 RETURN ;AND RETURN ;MAKE ADDRS -.-2 RELADR: CALL EXPR ;PARSE EXPRESSION ERRSET ERR.A SETZB T4,RELLVL ;SET RELOC LEVEL CALL EXPRPX ;CHECK IT MOVE T1,PC ;GET PC ADDI T1,2 ;OFFSET FOR CURRENT LOC CALL EXPRMI ;SUBTRACT ERRSET ERR.A CALL ABSTST ;CHECK ABSOLUTE RETURN ;DONE M65CL3: CALL M65AEX ;GET ADDRESS MODE JRST POPERA ;ADDRESS ERROR MOVEI T2,^D30 ;ASSUME 3 CYCLES TLNE T4,(AM%IND) ;INDIRECT? ADDI T2,^D20 ;YES - THEN 5 CYCLES ADDM T2,TIMBLK+1 TLZ T4,(AM%ZP) ;CLEAR THIS CALL POPSTA ;STORE ADDRS M65C4A: HRRZ T1,OPCODE LDB T1,OPPNT(T4) ;USE INDIRECT/ABS ENTRY JUMPE T1,POPERA ;ERROR IF ZERO HRRM T1,OPCODE ;STORE RETURN M65CL4: ;USE COMMON ROUTINE POPTIM: HRRZ T3,OPCODE ;GET TABLE ENTRY LDB T2,[POINT 9,T3,26] ADDM T2,TIMBLK+1 ;UPDATE TIMING INFO ANDI T3,377 ;ISOLATE OP-CODE HRRM T3,OPCODE ;STORE RETURN ;EXIT ;6800 OPCODE CLASS HANDLERS M68CL4: ;CLASS 1 W/MODIFICATION M68CL1: CALL M68AEX ;GET ADDRS EXPRESSION JRST POPERA HRRZ T3,T4 ;GET ADDRS TYPE M68C1A: CAIN T3,.M68A2 ;JUST ADDRS? JRST M68C1C ;YES - CHECK FOR Z.P. SPUSH T3 ;SAVE MODE INFO SPUSH T4 CALL BYTTST ;CHECK FOR REAL BYTE SPOP T4 ;RESTORE MODE SPOP T3 HRLI T1,BC1 ;STORE BYTE MOVEM T1,ADRLOW M68C1B: SETZM ADRHGH ;NO HIGH PART M68CLO: HRRZ T1,OPCODE ;GET OP TABLE ADDRS LDB T1,OPPNT(T3) ;FETCH ACTUAL BYTE JUMPE T1,POPERA ;ADDRS ERROR HRRM T1,OPCODE ;STASH OPCODE RETURN ;EXIT M68C1C: CALL POPSTA ;STORE ARGS TLNE T4,(AM%ZP) ;ZERO PAGE? JRST [HRRZ T1,OPCODE LDB T1,OPPNT(T3) ;CHECK IF DIR ADDRS OK JUMPN T1,M68C1B JRST .+1] ;NO - HANDLE 16-BIT MOVEI T3,.M68A4 ; AND SETUP EXT ADDRS JRST M68CLO ;STORE OP ;OP CLASS 2 - RELATIVE ADDRS M68CL2: JRST RELBYT ;COOK UP RELADR ;OP CLASS 3 - IMPLIED M68CL3: JRST POPTIM ;JUST DO TIMING ;OP CLASS 5 - (ALLOW 16-BIT IMMEDIATES) M68CL5: CALL M68AEX ;GET ADDRS EXPR JRST POPERA HRRZ T3,T4 ;GET TYPE CODE CAIE T3,.M68A1 ;IMMED? JRST M68C1A ;NO - HANDLE NORMAL CASE CALL POPSTA ;STORE ADDRS FIELD JRST M68CLO ; AND OPCODE ;8080/Z80 OPCODE CLASS HANDLERS ;OPLC1 - MOV M80CL1: SETZM MZ8MOV ;CLEAR TEMP CALL EXPR ;GET AN EXPRESSION ERRSET ERR.A TLZN VAL,REGSYM ;REGISTER? JRST [CALL MZ8CL1 ;PARSE Z80 INDEX ARG JRST POPERA ;ERROR JRST .+1] ;CONTINUE PROCESSING SPUSH VAL ;SAVE VALUE CAIE CHR,"," ;COMMA DELIMITER? JRST [POP P,VAL ;CLEAN PDL JRST POPERA] CALL GETNB ;GET NEXT NON-BLANK CALL EXPR ;GET 2ND ARG ERRSET ERR.A TLZN VAL,REGSYM JRST [CALL MZ8CL1 ;PARSE INDEX EXPR JRST [SPOP VAL ;CLEAN PDL JRST POPERA] JRST .+1] HRRZ T1,OPCODE ;GET BASIC VALUE LDB T2,[POINT 9,T1,26] ;GET TIMING INFO ANDI T1,377 ;OP-CODE ONLY DPB VAL,[POINT 3,T1,35] SPOP T3 ;RETRIEVE OTHER REG DPB T3,[POINT 3,T1,32] HRRM T1,OPCODE ;STASH OPCODE CAIE VAL,6 ;CHECK MEMORY OPERAND CAIN T3,6 ; FOR EITHER ADDI T2,^D20 ;INCREASE TIME ADDM T2,TIMBLK+1 ;ACCUMULATE TIMING INFO CAIN T1,166 ;ACTUALLY 76 HEX ERRSET ERR.A SKIPN T2,MZ8MOV ;WAS THIS FOR THE Z80? RETURN HRRZ T1,OPCODE ;GET LOW BYTE TRZ T2,377 ;CLEAR LOW GARBAGE IOR T1,T2 ;COMBINE MOVEM T1,OPCODE ;RE-STASH (HAS BC2 ON) RETURN .LOC MZ8MOV: BLOCK 1 ;TEMP STORAGE FOR Z80 MOV INSTR MZ8TMP: BLOCK 1 ;TEMP STORAGE FOR Z80 STORE .RELOC MZ8CL1: SPUSH OPCODE ;SAVE THIS SETZM OPCODE ; SOME GOOD TRASH CALL MZ8IDX ;SEE IF D(II) JRST [SPOP OPCODE ;RESTORE VALUE RETURN] ;ERROR EXIT MOVEM T1,MZ8MOV ;SAVE TEMP SPOP OPCODE ;RESTORE OPCODE MOVE VAL,[REGSYM,,6] ;RETURN MEMORY OPERAND JRST CPOPJ1 ;GOOD RETURN ;OPCL2 - OP ADDRS M80CL2: CALL EXPR ;GET ADDRS EXPR ERRSET ERR.Q ;NULL EXPR CALL POPTIM ;HANDLE TIMING INFO TLNE VAL,REGSYM ;DISALLOW REGS JRST POPERA HRRZ T1,VAL ;GOOD PLACE JRST POPSTA ;STORE ADDRS (LOW,HIGH) ;OPCL3 - OP M80CL3: JRST POPTIM ;HANDLE TIMING AND RETURN ;OPCL4 - OP REG OR OP BYTE(II) M80CL4: CALL EXPR ;GET AN EXPRESSION ERRSET ERR.Q TLNN VAL,REGSYM ;A REGISTER SYMBOL? JRST MZ8CL4 ;POSSIBLE Z80 INSTR HRRZ T2,VAL ;GET VALUE OR REG INDEX M80CLO: HRRZ T1,OPCODE ;GET TABLE ADDRS CAILE T2,^D9 ;CHECK MAX REG VALUE JRST [LDB T3,OPPNT1+1 ;ILLEGAL IF 16BIT REG JUMPN T3,POPERA ;JUMP IF NOT B,D,SP,ETC.. SKPEDS ED.Z80 ;Z80 ALLOWED ERRSET ERR.Z ;NO - FLAG ERROR JRST MZ8CLO] ;PROCESS Z80 OP LDB T3,[POINT 9,2(T1),35] CAIN T2,6 ;CHECK "M" ADDI T3,^D30 ;ADD 3 CYCLES FOR MEM LDB T1,OPPNT1(T2) ;GET ACTUAL OPCODE JUMPE T1,POPERA ;NO SUCH TRZE T1,400 ;CHECK FOR SPECL TIMING ADDI T3,^D20 ;2 XTRA CYCLES HRRM T1,OPCODE ;STASH GOOD VALUE ADDM T3,TIMBLK+1 ;ACCOUNT TIME RETURN MZ8CL4: CALL MZ8IDX ;HANDLE INDEXED VALUE JRST POPERA ;ADDRS ERROR RETURN ;DONE - RETURN MZ8IDX: CAIE CHR,"(" ;CHECK INDEX RETURN ;NOPE - ERROR SKPEDS ED.Z80 ;Z80 ENABLED? ERRSET ERR.Z ;NO - FLAG ERROR CALL BYTTST ;VALIDATE BYTE (8-BIT) HRLI VAL,BC1 ;SAVE VALUE MOVEM VAL,ADRLOW ; AS 3RD BYTE FOR THIS OP CALL GETNB ;SKIP PAREN CALL EXPR ;GET EXPRESSION IN PARENS ERRSET ERR.Q TLZE VAL,REGSYM ;BETTER BE A REG CAIGE VAL,12 ; AND X OR Y RETURN ;ADDRS LOSAGE CAIE CHR,")" ;CHECK TERMINATOR ERRSET ERR.Q CALL GETNB ;SKIP IT HRRZ T2,VAL ;COPY VALUE TO HERE CALL MZ8CLO ;MAKE OPCODE JRST CPOPJ1 ; AND GIVE GOOD RETURN MZ8CLO: MOVEI T3,IX_^D8 ;HIGH BYTE FOR "X" CAIE T2,12 ;WAS IT X OR Y MOVEI T3,IY_^D8 ;MUST BE "Y" HRRZ T1,OPCODE ;GET TABLE ADDRS JUMPE T1,MZ8CLA ;SPECIAL CASE IF ZERO LDB T1,OPPNT1+12 ;GET LOW BYTE OF OP SKIPN T1 ;VALID OP ERRSET ERR.A ;NO - ERROR MZ8CLA: IOR T1,T3 ;COMBINE FOR 16-BIT OPCODE HRLI T1,BC2 ;FLAG AS 2BYTE MOVEM T1,OPCODE ;STORE RETURN ; AND RETURN ;OPCL5 - OP REG,BYTE OR OP BYTE(II),BYTE M80CL5: CALL EXPR ;GET EXPR ERRSET ERR.A TLZN VAL,REGSYM ;REGISTER SYMBOL? JRST MZ8CL5 ;CHECK FOR D(II) CALL REGTST ;VALIDATE REGISTER CAIE CHR,"," ;PARSE A COMMA JRST POPERA ;ERROR SPUSH VAL ;SAVE VALUE CALL GETNB CALL M80BYT ;GET A BYTE INTO ADRLOW SPOP T2 ;GET BACK REGISTER M80C5A: HRRZS T2 JRST M80CLO ;GET OPCODE MZ8CL5: CALL MZ8IDX ;PARSE INDEX EXPR JRST POPERA ;FAILURE CAIE CHR,"," ;BETTER BE A COMMA JRST POPERA CALL GETNB ;SKIP IT SPUSH ADRLOW ;SAVE THIS CALL M80BYT ;PARSE A BYTE MOVEM T1,ADRHGH ;SAVE AS HIGH BYTE SPOP ADRLOW ;RESTORE LOW BYTE RETURN ;DONE - RETURN ;OPCL6 - OP REG,ADDRS M80CL6: CALL EXPR ;PARSE EXPRESSION ERRSET ERR.Q ;HUH? TLZN VAL,REGSYM JRST POPERA ;NOT A VALID REG CAIE CHR,"," ;BETTER BE A COMMA JRST POPERA ;ERROR SPUSH VAL ;SAVE VALUE CALL GETNB ;GET NEXT CHAR CALL EXPR ;PARSE ADDRS ERRSET ERR.Q TLNE VAL,REGSYM ;DISALLOW REGS JRST [SPOP VAL ;PRUNE PDL JRST POPERA] HRRZ T1,VAL ;PUT HERE FOR COMMON ROUTINE CALL POPSTA ;STASH ADDRS SPOP T2 ;RESTORE REG VALUE CAIGE T2,12 ;MAYBE X OR Y JRST M80C5A ;NO - FETCH OPCODE JRST MZ8CLO ;YES - BUILD OP ;OPCL7 - OP BYTE M80CL7: CALL M80BYT ;GET BYTE JRST POPTIM ; AND RETURN (ADJUST TIME) ;OPCL8 - RST # M80CL8: CALL REGEXP ;GET 0-7 TLNE VAL,REGSYM JRST POPERA ;NO REGS HERE HRRZ T2,VAL ;SET UP FOR OPCODE SELECT JRST M80CLO ;... ;OPCL9 - BIT , SET , RES #,DEST M80CL9: SETZM MZ8MOV ;CLEAR TEMP CALL REGEXP ;GET NUMBER 0-7 TLNE VAL,REGSYM ;REGISTER INVALID JRST POPERA ;EXIT CODE CAIE CHR,"," ;MUST BE COMMA JRST POPERA ;ELSE ERROR CALL GETNB ;SKIP OVER IT M80C9C: SPUSH VAL ;SAVE BIT # CALL EXPR ;GET NEXT EXPRESSION ERRSET ERR.Q TLZN VAL,REGSYM ;REGISTER? JRST [CALL MZ8CL1 ;NO - TRY DD(II) JRST [SPOP VAL ;ERROR JRST POPERA] JRST .+1] HRRZ T1,OPCODE ;GET BASIC VALUE ANDI T1,377 ;JUST OP DPB VAL,[POINT 3,T1,35] ;STORE REG # SPOP T3 ;GET BIT # BACK CAIE T3,-1 ;ALL ONES? DPB T3,[POINT 3,T1,32] ;STORE BIT SKIPE T2,MZ8MOV ;INDEXED? JRST M80C9A ;YES - 4 BYTE OP IOR T1,[BC2,,BITV_^D8] ;FORM 2 BYTE OP MOVEM T1,OPCODE ;ACTUAL OP RETURN M80C9A: ANDI T2,177400 ;ISOLATE BITS WE WANT IOR T2,[BC2,,BITV] ;FORM OPCODE MOVEM T2,OPCODE ;SAVE IT HRLI T1,BC1 ;FORM LAST BYTE MOVEM T1,ADRHGH ;SAVE AS HIGH ADDR BYTE RETURN ;EXIT ;OPCL10 - OP RELATIVE M80C10: JRST RELBYT ;COOK UP RELADR ;OPCL11 - OP DEST (KIND OF LIKE BIT INSTRS) M80C11: SETZM MZ8MOV ;CLEAR THIS MOVEI VAL,-1 ;SPECIAL FLAG FOR BIT # JRST M80C9C ;ENTER COMMON CODE ;OPCL12 - OP (8085 ONLY) M80C12: SKPEDS ED.M85 ;ENABLED? JRST OPCERR ;NO - NO SUCH OPCODE JRST POPTIM ;HANDLE TIMING ETC. ;8008 OPCODE CLASS HANDLERS ;OPCL1 - MOV M88CL1: CALL REGEXP ;GET AN EXPRESSION ERRSET ERR.A ;??? TLZN VAL,REGSYM ;MUST BE REGISTER JRST POPERA CAIE CHR,"," ;MUST BE COMMA JRST POPERA ;ELSE ERROR SPUSH VAL ;SAVE VALUE CALL GETNB ;SKIP OVER IT CALL REGEXP ;GET A REGISTER EXPR TLZN VAL,REGSYM ;MUST BE A REG JRST [SPOP VAL JRST POPERA] ;ERROR IF NOT REG HRRZ T1,OPCODE ;GET BASIC VALUE LDB T2,[POINT 9,T1,26] ;GET TIMING INFO ANDI T1,377 ;OP-CODE ONLY DPB VAL,[POINT 3,T1,35] SPOP T3 ;DESTINATION REG DPB T3,[POINT 3,T1,32] HRRM T1,OPCODE ;STASH OP CAIE T3,7 ;CHECK FOR EITHER MEMORY OPERAND CAIN VAL,7 ADDI T2,^D20 ;YES - EXTRA CYCLES CAIN VAL,7 ;READ OR WRITE ADDI T2,^D10 ;READ - 1 MORE CYCLE ADDM T2,TIMBLK+1 ;ADD TO TIMING INFO CAIN T1,377 ;ACUALLY FF HEX ERRSET ERR.A RETURN ;ALL DONE ;OPCL2 - OP ADDRS M88CL2: JRST M80CL2 ;SAME AS 8080/Z80 ;OPCL3 - OP M88CL3: JRST POPTIM ;HANDLE TIMING AND RETURN ;OPCL4 - OP REG M88CL4: CALL REGEXP ;GET REGISTER EXPR TLZN VAL,REGSYM ;MUST BE REGISTER SYMBOL JRST POPERA ; ELSE ERROR HRRZ T2,VAL ;GET REG VALUE M88CLO: HRRZ T1,OPCODE ;OPCODE TABLE ADDRS LDB T3,[POINT 9,2(T1),35] ;FETCH TIMING INFO CAIN T2,7 ;MEMORY OPERAND ADDI T3,^D30 ;XTRA CYCLES IF MEMORY LDB T1,OPPNT1(T2) ;FETCH ACTUAL OPCODE JUMPE T1,POPERA ;ERROR IF ZERO HRRM T1,OPCODE ;STASH OP ADDM T3,TIMBLK+1 ;UPDATE TIMING RETURN ;RETURN ;OPCL5 - OP REG,BYTE M88CL5: CALL REGEXP ;GET REGISTER EXPR TLZN VAL,REGSYM ;MUST BE REGISTER SYMBOL JRST POPERA ; ELSE ERROR CAIE CHR,"," ;CHECK COMMA DELIMITER JRST POPERA ;ERROR SPUSH VAL ;SAVE VALUE CALL GETNB ;SKIP OVER COMMA CALL M80BYT ;GET A BYTE INTO ADRLOW SPOP T2 ;GET BACK REGISTER HRRZS T2 ;REG VALUE ONLY JRST M88CLO ;COMMON OPCODE HANDLER ;OPCL6 - OP BYTE M88CL6: CALL EXPR ;GET 8-BIT EXPR OR HALF ADDRESS CONSTANT ERRSET ERR.Q MOVE T1,VAL ;GET VALUE HRLI T1,BC1 ;SET CODE MOVEM T1,ADRLOW ;SAVE BYTE JRST POPTIM ; AND RETURN (ADJUST TIME) ;OPCL7 - IN N (0-7) M88CL7: CALL REGEXP ;GET 0-7 TLNE VAL,REGSYM ;MUST NOT BE REGISTER SYMBOL JRST POPERA MOVE T4,[POINT 3,T1,34] M88C7A: HRRZ T1,OPCODE ;GET BASIC VALUE LDB T3,[POINT 9,T1,26] ADDM T3,TIMBLK+1 ;TIMING UPDATE ANDI T1,377 ;OPCODE ONLY DPB VAL,T4 ;STASH VAL INTO OP HRRM T1,OPCODE ;SAVE OPCODE RETURN ;AND RETURN ;OPCL8 - OUT N (0-27) M88CL8: CALL EXPR ;GET EXPRS ERRSET ERR.A TLZN VAL,REGSYM ;NO REGS CAILE VAL,27 ;CHECK MAX VALUE JRST POPERA ADDI VAL,10 ;ADD IN OFFSET MOVE T4,[POINT 5,T1,34] JRST M88C7A ;COMMON CODE ;OPCL9 - RST N (0-7) M88CL9: CALL REGEXP ;NUMBER IN RANGE 0-7 TLNE VAL,REGSYM ;DISSALLOW REGS JRST POPERA MOVE T4,[POINT 3,T1,32] JRST M88C7A ;JOIN COMMON CODE ;1802 OPCODE CLASS HANDLERS ;OPCL1 - OP REG M18CL1: CALL EXPR ;GET EXPRS ERRSET ERR.A TDZE VAL,[B17!377B!177760] ERRSET ERR.R ;NOT VALID RANGE TLZN VAL,REGSYM ;MUST BE A REG SYM JRST POPERA ;ERROR M18CLO: HRRZ T1,OPCODE ;FIRST PART OF OPCODE ANDI VAL,17 ;MASK TO WANTED BITS IOR T1,VAL ;OR INTO OPCODE SKIPN T1 ;00 - ILLEGAL ERRSET ERR.A HRRM T1,OPCODE ; AND STORE M18TIM: MOVEI T1,^D160 ;ADJUST TIMING FOR 1 BYTE INSTR ADDM T1,TIMBLK+1 ;... RETURN ; AND EXIT ;OPCL2 - OP M18CL2: JRST M18TIM ;HACK TIMING AND EXIT ;OPCL3 - OP BYTE M18CL3: CALL M80BYT ;GET BYTE JRST M18TIM ;HANDLE TIME AS 1 BYTE ;OPCL4 - OP ADDR M18CL4: CALL EXPR ;GET ADDRS EXPR ERRSET ERR.Q ;NULL EXPR MOVEI T1,^D240 ;TIMING INFO FOR 3 BYTER ADDM T1,TIMBLK+1 TLNE VAL,REGSYM ;DISALLOW REGS JRST POPERA HRRZ T1,VAL JRST POPSTA ;STORE ADDRS (LOW,HIGH) ;OPCL5 - OP ADDR (LOW BYTE) M18CL5: CALL EXPR ;GET EXPRS ERRSET ERR.Q ;NULL ADDRS TLNE VAL,REGSYM ;NO REGS ALLOWED JRST POPERA MOVE T1,PC ;GET CURRENT PC ADDI T1,1 ;STEP TO ADDRS BYTE PC ANDI T1,177400 ;MASK TO PAGE NUMBER HRRZ T2,VAL ;GET DEST ADDRS ANDI T2,177400 ;MASK PAGE NUMBER CAME T1,T2 ;SAME? ERRSET ERR.A ;NO - SET ADDRS ERROR ANDI VAL,377 ;KEEP LOW BYTE HRLI VAL,BC1 ;SET CODE MOVEM VAL,ADRLOW ;SAVE IT JRST M18TIM ; UPDATE TIMING AND EXIT ;OPCL6 - INP N (1-7) M18CL6: CALL REGEXP ;GET NUMBER IN RANGE 0-7 HRRZ T1,VAL ;VALUE ONLY SKIPE T1 ;ZERO ILLEGAL TLNE VAL,REGSYM ;DISALLOW REGS JRST POPERA JRST M18CLO ;HANDLE AS CLASS 1 ;OP-CODE DISPATCH TABLES FOR ALL MACHINES PRPM65: ;TABLE FOR 6502 PHASE 0 0 ;ILLEGAL OPCL1:! XWD M65CL1,0 ;GENERAL ADDRESSES OPCL2:! XWD M65CL2,0 ;BRANCHES OPCL3:! XWD M65CL3,0 ;JUMP INSTR (SPECIAL) OPCL4:! XWD M65CL4,0 ;IMPLIED OPCL5:! XWD M65CL5,DSTFLG ;SAME AS CLASS 1 DEPHASE PRPM68: ;TABLE FOR 6800 PHASE 0 0 ;ILLEGAL OPCL1:! XWD M68CL1,0 ;GENERAL ADDRESSES OPCL2:! XWD M68CL2,0 ;BRANCHES OPCL3:! XWD M68CL3,0 ;IMPLIED OPCL4:! XWD M68CL4,DSTFLG ;SAME AS CLASS 1 OPCL5:! XWD M68CL5,0 ;CLASS 1 W/ 16-BIT IMMED. DEPHASE PRPM80: ;TABLE FOR 8080 PHASE 0 0 OPCL1:! XWD M80CL1,0 ;MOV INSTRUCTIONS OPCL2:! XWD M80CL2,0 ;JUMP/CALL INSTRS OPCL3:! XWD M80CL3,0 ;IMPLIED ADDRS/REG OPCL4:! XWD M80CL4,0 ;REGISTER OPCL5:! XWD M80CL5,0 ;MVI OPCL6:! XWD M80CL6,0 ;LXI OPCL7:! XWD M80CL7,0 ;ACCUM IMMED OPCL8:! XWD M80CL8,0 ;RST OPCL9:! XWD M80CL9,0 ;BIT FIDDLING INSTRS OPCL10:!XWD M80C10,0 ;JUMP RELATIVE OPCL11:!XWD M80C11,0 ;FANCY ROTATE/SHIFT OPCL12:!XWD M80C12,0 ;RIM/SIM (8085) DEPHASE PRPM88: ;TABLE FOR 8008 PRPM08: PHASE 0 0 OPCL1:! XWD M88CL1,0 ;MOV INSTRUCTIONS OPCL2:! XWD M88CL2,0 ;JUMP/CALL INSTRS OPCL3:! XWD M88CL3,0 ;IMPLIED REG/ADDRS OPCL4:! XWD M88CL4,0 ;REGISTER OPCL5:! XWD M88CL5,0 ;MVI REG,BYTE OPCL6:! XWD M88CL6,0 ;ACCUM IMMED OPCL7:! XWD M88CL7,0 ;INPUT OPCL8:! XWD M88CL8,0 ;OUTPUT OPCL9:! XWD M88CL9,0 ;RESET (RST) DEPHASE PRPM18: ;TABLE FOR 1802 PHASE 0 0 OPCL1:! XWD M18CL1,0 ;REGISTER OPS OPCL2:! XWD M18CL2,0 ;IMPLIED ADDRS (SKIPS) OPCL3:! XWD M18CL3,0 ;IMMED. OPCL4:! XWD M18CL4,0 ;LONG BRANCH OPCL5:! XWD M18CL5,0 ;SHORT BRANCH OPCL6:! XWD M18CL6,0 ;INPUT/OUTPUT DEPHASE PRPMF8: ;TABLE FOR F8 PHASE 0 0 DEPHASE .LOC OPCODE: BLOCK 1 ADRLOW: BLOCK 1 ADRHGH: BLOCK 1 TIMBLK: BLOCK 2 ;TIMING INFO MACHT: BLOCK 1 ;MACHINE TYPE CODE .RELOC OPPNT: POINT 9,[0],35 ;ERROR IF ZERO OPPNT1: POINT 9,0(T1),8 ;MODE 1 POINT 9,0(T1),17 ;MODE 2 POINT 9,0(T1),26 ;MODE 3 POINT 9,0(T1),35 ;MODE 4 POINT 9,1(T1),8 ;MODE 5 POINT 9,1(T1),17 ;MODE 6 POINT 9,1(T1),26 ;MODE 7 POINT 9,1(T1),35 ;MODE 10 POINT 9,2(T1),8 ;MODE 11 POINT 9,2(T1),17 ;MODE 12 POINT 9,2(T1),26 ;MODE 13 SUBTTL DIRECTIVES .ABS: MOVEI T3,ED.ABS TDNE T3,EDMSK ;MASKED OUT? RETURN ; YES TRO ASM,0(T3) ;NO, SET IT HRRM ASM,EDFLGS TLZ PC,(PFMASK) ;CLEAR RELOCATION RETURN .ASECT= OPCERR .CSECT= OPCERR .GLOBL= OPCERR .LOCAL= OPCERR .LIMIT= OPCERR .PSECT= OPCERR TSTMAX: LDB T3,CCSPNT ;GET CURRENT SEC HLRZ T4,SECBAS(T3) ;MAX FOR THIS ONE CAIGE T4,0(PC) ;NEW MAX? HRLM PC,SECBAS(T3) ; YES RETURN .LOC SECNAM: BLOCK ^D256 ;SECTOR NAMES SECBAS: BLOCK ^D256 ;SECTOR BASES SECLCF: BLOCK ^D<256/36>+1 ;SECTOR LOCAL FLAGS SECLCP: BLOCK 1 ;SECTOR LOCAL POINTER PSCFLG: BLOCK ^D256 ;PSECT ATTRIBUTE FLAGS ;THOSE SLOTS WHICH CORRESPOND TO PSECTS HAVE ALL ONES IN THE LH ;OF THE WORD PSCTSW: BLOCK 1 ;SET TO ONES DURING PSECT PROCESSING .RELOC DEFINE ATARG (SYM,BIT,SET) < SYM==SET'B<35-BIT> GENM40 EXP SET'B0!1B<35-BIT> > ATRARG: ;ATTRIBUTE ARGUMENT TABLE ATARG ,0,1 ATARG ,0,0 ATARG ,2,0 ATARG ,2,1 ATARG ,4,0 ATARG ,4,1 ATARG ,5,0 ATARG ,5,1 ATARG ,6,0 ATARG ,6,1 ATARG ,7,0 ATARG ,7,1 ATREND: ;END OF TABLE .PHASE: CALL RELEXP MOVE T3,PC TRO T3,600000 SUB T3,VAL TLNE T3,(PFMASK) ERRXIT ERR.A!ERR.P1 ANDI T3,177777 MOVEM T3,PHAOFF .PHASX: TRZ VAL,600000 SPUSH M40DOT JRST ASGMTF .DEPHA: SETZM VAL EXCH VAL,PHAOFF .DEPHX: ADD VAL,PC JRST .PHASX .LOC PHAOFF: BLOCK 1 .RELOC .BLKB: TDZA T3,T3 .BLKW: SETOM T3 HLLM T3,0(P) CALL SETPF0 ;LIST LOCATION CALL EXPR MOVEI VAL,1 CALL ABSTST CALL SETPF1 SKIPGE 0(P) ASH VAL,1 ADD VAL,PC TRZ VAL,600000 SPUSH M40DOT JRST ASGMTX .EQUIV: ;.EQUIV DEFSYM,ANYSYM CALL GSARG ;GET SYMBOLIC ARG JRST OPCERR ; ERROR MOVEM SYM,.EQUI9 ;OK, SAVE IT CALL GSARG ;GET SECOND ARG JRST OPCERR ; MISSING EXCH SYM,.EQUI9 ;GET FIRST MNEMONIC CALL OSRCH ;TEST FOR MACRO/OP CODE JRST .EQUI1 ; NO CALL CRFOPR JRST .EQUI2 .EQUI1: CALL SSRCH ;NO, TRY USER SYMBOL JRST OPCERR ; MISSING CALL CRFREF .EQUI2: CAIN T2,MAOP ;FOUND, MACRO? CALL INCMAC ;YES, INCREMENT USE LEVEL MOVE SYM,.EQUI9 ;GET SECOND MNEMONIC MOVEM T1,.EQUI9 ;SAVE VALUE CAIE T2,0 ;USER SYMBOL? MOVEI T2,1 ;NO NO, TREAT AS OP SPUSH T2 CALL @[EXP SSRCH,MSRCH](T2) ;CALL PROPER SEARCH JFCL CAIN T2,MAOP ;MACRO? TRNE T2,-1 CAIA CALL DECMAC ; YES, DECREMENT REFERENCE MOVE T1,.EQUI9 ;GET NEW VALUE SPOP T2 CALL @[EXP CRFDEF,CRFOPD](T2) JRST INSRT ;INSERT AND EXIT .LOC .EQUI9: BLOCK 1 .RELOC .PDP10: RETURN ;NO-OP, FOR COMPATIBILITY W/ MACX11 .TITLE: ;TITLE PSEUDO-OP SPUSH SYMEND ;SAVE START CALL GETSYM ;GET THE SYMBOL SPOP LBP SKIPN SYM ;ONE FOUND? ERRXIT ERR.A ; NO, FLAG ERROR AND EXIT MOVEM SYM,PRGTTL ;YES, STORE TITLE MOVEI T1,TTLBUF ;POINT TO TITLE BUFFER JRST .SBTT1 ;EXIT THROUGH SUB-TITLE .SBTTL: ;SUB-TITLE PROCESSOR MOVE LBP,SYMEND TLNN FLG,P1F ;PASS ONE? JRST .SBTT3 ; NO MOVEM LBP,CLIPNT ;YES, FUDGE FOR TABLE OF CONTENTS SKPLCS LC.TOC TLO EXF,P1LBIT TLO FLG,NQEFLG!LHMFLG RETURN .SBTT3: MOVEI T1,STLBUF ;POINT TO PROPER BUFFER .SBTT1: HRLI T1,(POINT 7,) ;COMPLETE BYTE POINTER MOVEI T2,TTLLEN ;SET COUNT .SBTT2: GETCHR ;GET THE NEXT CHARACTER SOSL T2 IDPB CHR,T1 ;STORE IN BUFFER JUMPN CHR,.SBTT2 IDPB CHR,T1 ;BE SURE TO STORE TERMINATOR RETURN .LOC TTLBUF: BLOCK /5+1 ;TITLE BUFFER STLBUF: BLOCK /5+1 ;SUB-TITLE BUFFER PRGTTL: BLOCK 1 ;PROGRAM TITLE PRGIDN: BLOCK 1 ;PROGRAM IDENT .RELOC .REM: ;REMARK JUMPE CHR,OPCERR ;ERROR IF EOL SPUSH CHR .REM1: GETCHR .REM2: CAMN CHR,0(P) JRST .REM3 JUMPN CHR,.REM1 CALL ENDL TLNE FLG,ENDFLG JRST .REM4 CALL GETLIN SKPLCS LC.TTM TLO FLG,LHMFLG ;LEFT JUSTIFY IF IN TTM MODE JRST .REM2 .REM3: CALL GETNB .REM4: SPOP 0(P) RETURN .ERROR: TLNE FLG,P1F ; ".ERROR", PASS ONE? RETURN ; YES, IGNORE AOS ERRCNT .PRINT: ; ".PRINT" DIRECTIVE TLO EXF,ERRBIT ;FORCE TTY LISTING CALL SETPF0 CALL EXPR ;ANY EXPRESSION? RETURN ; NO JRST SETPF1 .EOT: RETURN .ROUND: TDZA T3,T3 .TRUNC: MOVEI T3,1 MOVEI T1,ED.FPT TDNN T1,EDMSK XCT [EXP , ](T3) HRRM ASM,EDFLGS RETURN .RADIX: MOVEI T3,^D10 EXCH T3,CRADIX SPUSH T3 CALL ABSEXP CAIL VAL,^D2 CAILE VAL,^D10 ERRSKP ERR.N MOVEM VAL,0(P) POP P,CRADIX RETURN .LOC CRADIX: BLOCK 1 ;CURRENT RADIX .RELOC .END: ;"END" PSEUDO-OP SKIPE CNDLVL ;IF IN CONDITIONAL ERRSET ERR.E ; FLAG ERROR TLO FLG,ENDFLG ;FLAG "END SEEN" CALL EXPR ;EVALUATE THE ADDRESS END2: MOVEI VAL,0 ; NULL, USE ZERO MOVEM VAL,ENDVEC TRNE FLG,ERR.U ;ANY UNDEFINED SYMBOLS? ERRSET ERR.P1 ; YES, PASS ONE ERROR JRST SETPF1 .LOC ENDVEC: BLOCK 1 ;END VECTOR .RELOC SUBTTL DATA-GENERATING DIRECTIVES .ASCII: TLZA FLG,ASZFLG ; ".ASCII" DIRECTIVE .ASCIZ: TLO FLG,ASZFLG ; ".ASCIZ" DIRECTIVE .ASCI2: CALL GTCHR ;GET A TEXT CHARACTER JRST .ASCI6 ; NO TRZE VAL,177400 ;OVERFLOW? ERRSET ERR.T ; YES .ASCI3: MOVE T1,VAL ;COPY CHARACTER HRLI T1,BC1 ;SINGLE BYTE CALL STCODE JRST .ASCI2 ;GET NEXT CHAR .ASCI6: HRLZI T1,BC1 ;MAYBE NULL TLZE FLG,ASZFLG ;ASCIZ? CALL STCODE ;YES - DUMP NULL RETURN ;RETURN .BYTE: ;"BYT" PSEUDO-OP SPUSH PC ;STACK PC .BYTE1: CALL EXPR ;EVALUATE EXPRESSION JFCL ; ACCEPT NULLS TRNE VAL,177400 ;ANY HIGH ORDER BITS SET? TRC VAL,177400 ; YES, TOGGLE FOR TEST CALL TSTARB ;TEST ARITHMETIC BYTE TLC T1,BC1!BC2 ;RESET TO ONE BYTE CALL STCODE HRROS ARGCNT CALL TGARG ;ANY MORE? JRST .WORDX ; NO AOJA PC,.BYTE1 ;INCREMENT PC AND LOOP .WORD: TDZA T2,T2 ;"WORD" PSEUDO-OP .ADDR: SETO T2, ;"ADDR" PSEUDO-OP SPUSH PC ;STACK PC SPUSH T2 ;STACK FLAG .ADDR1: CALL EXPR ;GET EXPRESSION JFCL ;ACCEPT NULLS CALL TSTAR TLC T1,BC1!BC2 ;MAKE INTO SINGLE BYTE HRRZ T2,T1 ;COPY VALUE SKIPN 0(P) ;WORD/ADDR? JRST [LSH T2,-^D8 ;WORD - DO HIGH BYTE FIRST EXCH T1,T2 HLL T1,T2 ;GET BACK FLAGS CALL STCODE ;STASH MOVE T1,T2 ;NOW DO LOW BYTE TRZ T1,177400 JRST .ADDR2] TRZ T1,177400 ;LOW BYTE CALL STCODE LSH T2,-^D8 HRR T1,T2 ;HIGH VALUE .ADDR2: CALL STCODE HRROS ARGCNT CALL TGARG ;END OF STRING JRST .ADDRX ;YES, EXIT ADDI PC,2 ;ADVANCE PC JRST .ADDR1 .ADDRX: SPOP PC ;CLEAN OFF STACK .WORDX: SPOP PC ;RESTORE PC RETURN .FLT2: SKIPA T3,[2] ;TWO WORD FLOATING .FLT4: MOVEI T3,4 ;FOUR WORD FLOATING MOVEM T3,FLTLEN ;SET LENGTH FOR ROUNDING .FLT2A: CALL FLTG ;PROCESS FLOATING POINT TLNE FLG,FLTFLG ;ANY ERRORS? ERRSET ERR.A ; YES MOVN Q1,FLTLEN ;SET NEGATIVE OF LENGTH HRLZS Q1 ;SET INDEX .FLT2B: MOVE T1,FLTNUM(Q1) ;GET A VALUE HRLI T1,BC2 CALL STCODE ;STORE IT AOBJN Q1,.FLT2B ;LOOP IF MORE HRROS ARGCNT CALL TGARG ;MORE? RETURN ; NO JRST .FLT2A ;GET ANOTHER SUBTTL "A" EXPRESSION EVALUATOR M65AEX: ;"A" EXPRESSION EVALUATOR FOR 6502 CALL M65A0A TRNE T4,-1 ;SOMETHING? AOS 0(P) ;YES, GOOD RETURN RETURN M65A0A: SPUSH [0] ;INIT MODE M65A01: CAIN CHR,"#" JRST M65A02 ;PARSE CONSTANT CAIN CHR,"(" JRST M65A05 ;SET INDIRECT CAIN CHR,"A" JRST M65A40 ;PROCESS ACCUMULATOR JRST M65A10 ;NORMAL EXPRESSION M65A02: CALL GETNB ;PASS OVER # CALL BYTEXP ;GET BYTE EXPRESSION SPOP T4 HRRI T4,.M65A7 ;IMMEDIATE EXPRESSION JRST M65AR2 ;EXIT (TEST FOR BYTE) M65A05: MOVSI T4,(AM%IND) ;SET INDIRECT BIT TDNE T4,0(P) ;CHECK IF 2ND TIME HERE ERRSET ERR.Q IORM T4,0(P) CALL GETNB ;BYPASS CHARACTER JRST M65A01 ;HERE TO PARSE A NORMAL ADDRESS EXPRESSION M65A10: CALL EXPR ERRSET ERR.Q SPOP T4 ;GET MODES CAIN CHR,"," ;CHECK FOR COMMA JRST M65A20 ;HANDLE INDEXING CAIN CHR,")" ;POSSIBLE INDIRECT JRST M65A30 TLNE T4,(AM%IND) ;ERROR? ERRSET ERR.Q HRRI T4,.M65A1 ;ABSOLUTE ADDRS JRST M65AR1 ;RETURN ;COMMA SEEN M65A20: CALL GETNB ;PASS OVER , CAIN CHR,"X" ;X INDEX? JRST M65A25 ;YES , CHECK IT OUT CAIN CHR,"Y" ;Y INDEX TLNE T4,(AM%IND) ;YES, INDIRECT SEEN? ERRSET ERR.Q ;YES, ERROR HRRI T4,.M65A3 ;OK - IDEXED BY "Y" JRST M65ART M65A25: HRRI T4,.M65A2 ;ASSUME INDEXED BY X TLNN T4,(AM%IND) ;UNLESS INDIRECT SEEN JRST M65ART CALL GETNB ;PASS TO NEXT CHAR HRRI T4,.M63A4 ;INDIRECT INDEXED CAIE CHR,")" ;CHECK SYNTAX ERRSET ERR.Q JRST M65ART ;RETURN VALUE ETC. ;END OF INDIRECT SPEC ")" SEEN M65A30: TLON T4,(AM%IND) ;FUDGE CLOSE BRACKET ERRSET ERR.Q ;ERROR IF NOT ALREADY ON CALL GETNB ;PASS OVER ")" HRRI T4,.M65A6 ;ASSUME PLAIN INDIRECT CAIE CHR,"," ;COMMA IS DIFFERENT JRST M65AR1 ;EXIT AT CHARACTER CALL GETNB ;PASS OVER COMMA CAIE CHR,"Y" ;ONLY VALID CHARACTER ERRSET ERR.Q HRRI T4,.M65A5 ;INDEXED INDIRECT JRST M65ART ;RETURN ;HERE WHEN "A" SEEN M65A40: MOVEM LBP,SYMBEG ;INCASE NOT JUST AN "A" CALL GETNB ;PASS OVER CHAR CAIE CHR,0 ;ACCEPT ONLY EOL CAIN CHR,";" ; AND COMMENTS JRST M65A45 MOVE LBP,SYMBEG ;RESTORE PNTR CALL SETNB ;AND CHARACTER JRST M65A10 ; AND PARSE AS EXPRESSION M65A45: SPOP T4 ;GET MODES TLO T4,(AM%ACC) HRRI T4,.M65A6 ;FUDGE INDIRECT RETURN ;RETURN ;COMMON A-EXPRESSION RETURN M65ART: CALL GETNB ;SKIP TERMINATOR M65AR1: MOVE T1,VAL ;COPY EXPRESSION TO CORRECT PLACE TRNE FLG,ERR.U ;IF UNDEFINED THEN DONE RETURN ; TEST PAGE 0 M65AR2: TRNN T1,177400 ;CHECK PAGE 0 TLO T4,(AM%ZP) RETURN ;RETURN ;"A" EXPRESSION EVALUATOR FOR 6800 M68AEX: CALL M68A0A ;CALL INNER ROUTINE TRNE T4,-1 ;ANYTHING? AOS 0(P) ;YES - SKIP RETRN RETURN M68A0A: SPUSH [0] ;INIT MODE INFO CAIN CHR,"#" ;IMMED? JRST M68A20 ;YES - HANDLE CALL EXPR ;GET EXPRESSION ERRSET ERR.Q SPOP T4 ;GET MODES CAIN CHR,"," ;CHECK FOR INDEXED JRST M68A10 HRRI T4,.M68A2 ;NO - JUST SAY ADDRS JRST M65AR1 ;COMMON EXIT ;COMMA SEEN M68A10: CALL GETNB ;SKIP OVER IT CAIE CHR,"X" ;ONLY LEGAL CHAR ERRSET ERR.Q HRRI T4,.M68A3 ;SET MODE 3 JRST M65ART ;EXIT - SKIP CHAR ;# SEEN M68A20: CALL GETNB ;SKIP OVER CHAR CALL EXPR ;EVAL EXPR ERRSET ERR.Q SPOP T4 ;GET MODE HRRI T4,.M68A1 ;SET IMMEDIATE JRST M65AR1 ;COMMON EXIT TSTARB: ;TEST ARITHMETIC BYTE CALL TSTAR ;TEST ARITHMETIC TRZE T1,177400 ;OVERFLOW? ERRSET ERR.A ; YES LDB T2,MODPNT ;GET CLASS BITS CAIE T2,RLDT1 ;IF ONE CAIN T2,RLDT15 ; OR FIFTEEN ERRSET ERR.A ;THEN ERROR SKIPE T2 ;ABSOLUTE? TRO T2,200 ; NO - MAKE BIT MODIFY DPB T2,MODPNT ;... RETURN TSTAR: ;TEST ADDITIVE RELOCATION (0,1,5,15) MOVE T1,VAL ;COPY TO FINAL AC LDB T2,SUBPNT ;GET RELOCATION HRLI T1,BC2 ;SET FOR TWO BYTES JUMPE T2,CPOPJ ;EXIT IF ABS MOVEI T3,RLDT5 ;ASSUME EXTERNAL TLNE VAL,GLBSYM ;GLOBAL? JRST TSTAR1 ; YES MOVEI T3,RLDT1 LDB T4,CCSPNT CAMN T2,T4 ;CURRENT SECTOR? JRST TSTAR3 ; YES MOVE T4,SECNAM(T2) AOS T2,GLBPNT MOVEM T4,GLBBUF(T2) ;STORE SECTOR NAME MOVEI T3,RLDT15 ;TYPE 15 TSTAR1: DPB T2,SUBPNT TSTAR2: DPB T3,MODPNT RETURN TSTAR3: SKPEDR ED.PIC ;PIC ENABLED? ERRSET ERR.R ; YES, NO DIRECT REFS TO CURRENT JRST TSTAR2 .LOC GLBPNT: BLOCK 1 GLBBUF: BLOCK 40 .RELOC SUBTTL EXPRESSION EVALUATOR ABSEXP: ;ABSOLUTE EXPRESSION CALL EXPR ERRSET ERR.A ABSTST: TLZE VAL,(B17!377B) ERRSET ERR.A ;ERROR IF GLOBAL OR RELOCATABLE ANDI VAL,177777 RETURN RELEXP: ;RELOCATABLE EXPRESSION CALL EXPR ERRSET ERR.A RELTST: TLNE VAL,GLBSYM ;NO GLOBALS ALLOWED JRST ABSTST ;LET ABS FLAG IT RETURN REGEXP: ;REGISTER EXPRESSION CALL EXPR ERRSET ERR.A ; NULL, ERROR REGTST: TDZE VAL,[B17!377B!177770] ERRSET ERR.R ; ERROR RETURN BYTEXP: ;BYTE EXPRESSION (8-BITS) CALL EXPR ;GATHER EXPRESSION ERRSET ERR.Q ; NULL, ERROR BYTTST: TRNE VAL,177400 ;ANY HIGH ORDER BITS? TRC VAL,177400 ;TOGGLE FOR TEST JRST TSTARB EXPR: ;EXPRESSION PROCESSOR, REGISTER ALLOWED CALL TERM ;GET THE FIRST TERM POPJ P, ; NULL, EXIT SETZB T4,RELLVL ;CLEAR RELOCATION LEVEL COPNT CALL EXPRPX ;SET, IF NECESSARY EXPR1: CAIE CHR,"^" ;UPPER HALF ADDRESS? JRST EXPR2 ;NO LSH VAL,-10 ;YES, SHIFT OFF LOWER BITS CALL GETNB ;BYPASS THE ^ JRST EXPR3 EXPR2: LDB T3,C4PNTR ;MAP CHARACTER USING COLUMN 4 JUMPE T3,EXPR3 ;BRANCH IF NULL SPUSH EXPRJT(T3) ;STACK ENTRY SPUSH VAL ;STACK CURRENT VALUE CALL GETNB ;BYPASS OP CALL TERM ;GET THE NEXT EXPRESSION TERM ERRSET ERR.Q ; NULL, FLAG ERROR SPOP T1 ;GET PREVIOUS VALUE SPOP T2 CALL 0(T2) ;CALL ROUTINE ERRSET ERR.A ; ERROR TRZ VAL,600000 ;CLEAR ANY OVERFLOW JRST EXPR1 ;TEST FOR MORE EXPR3: SOSLE RELLVL ;RELOCATION LEVEL .GT. 1? ERRSET ERR.A ; YES JRST CPOPJ1 ;EXIT GOOD EXPRJT: ;EXPRESSION JUMP TABLE PHASE 0 0 EXPL:! MOVEI T2,EXPRPL ; + EXMI:! MOVEI T2,EXPRMI ; - EXOR:! IOR VAL,EXPXCT ; ! EXAN:! AND VAL,EXPXCT ; & EXMU:! IMUL VAL,EXPXCT ; * EXDV:! IDIV VAL,EXPXCT ; / EXSH:! LSH VAL,EXPXCI(T1) ; _ DEPHASE EXPRPL: ; + TDZA T4,T4 ;ZERO FOR ADD EXPRMI: ; - HRROI T4,1 ;ONE FOR SUBTRACT CALL EXPRPX ;UPDATE RELOCATION COUNT EXPRP1: LDB T2,SUBPNT ;GET RELOCATION EXCH VAL,T1 LDB T3,SUBPNT TLNE T1,REGSYM TLO VAL,REGSYM ;TRANSFER REGISTER FLAG JUMPE T3,EXPRM1 ;BRANCH IF SUBTRACTING ABS TLON T4,-1 ;NOT ABS, FIRST-TIME ADDITION? JRST EXPRP1 ; YES, REVERSE TLNN T1,GLBSYM ;IF EITHER IS GLOBAL, TLNE VAL,GLBSYM JRST EXPRM2 ; ERROR CAME T2,T3 ;LAST CHANCE, BOTH SAME RELOCATION JRST EXPRM2 ; FORGET IT SKIPN RELLVL ;IF BACK TO ZERO, TLZ VAL,(PFMASK) ;MAKE ABSOLUTE EXPRM1: AOS 0(P) ;INDICATE GOOD RESULT EXPRM2: XCT [EXP ,](T4) ;PERFORM OP DPB T1,[POINT 16,VAL,35] ;STORE TRIMMED RESULT RETURN ;EXIT EXPRPX: ;UPDATE RELOCATION LEVEL TLNE VAL,(PFMASK) ;IF ABS, TLNE VAL,GLBSYM ; OR GLOBAL, RETURN ; NO ACTION XCT [EXP ,](T4) ERRSET ERR.A ; NEGATIVE COUNT, ERROR RETURN EXPXCI: TRZA T2,-1 ;IMMEDIATE FORM OF EXPXCT EXPXCT: HRRI T2,T1 ;COMPLETE INSTRUCTION SPUSH T2 ;STACK INSTRUCTION CALL EXPXC1 ;TEST FOR ABSOLUTE EXCH VAL,T1 CALL EXPXC1 ;DITTO FOR OTHER SPOP T2 ;FETCH INSTRUCTION XCT T2 ;EXECUTE IT ANDI VAL,177777 ;MAKE ABSOLUTE JRST CPOPJ1 ;GOOD EXIT EXPXC1: CALL ABSTST ;TEST FOR ABSOLUTE LSH VAL,^D<36-16> ASH VAL,-^D<36-16> ;EXTEND SIGN RETURN .LOC RELLVL: BLOCK 1 ;RELOCATION LEVEL .RELOC SUBTTL TERM EVALUATOR TERM: ;TERM PROCESSOR SETZB VAL,T1 ;RETURN VALUE IN VAL CALL GETSYM ;TRY FOR SYMBOL JUMPE SYM,TERM4 ; NOT A SYMBOL CALL SSRCH ;SEARCH TABLE JRST TERM2 ; NOT THERE TERM0: CALL CRFREF ; TLNE T1,MDFSYM ;MULTIPLY DEFINED? ERRSET ERR.D ;YES TLNN T1,DEFSYM!GLBSYM ;UNDEFINED? ERRSET ERR.U ;YES. NOTE THAT THIS TRAP CAN BE ;ENTERED ONLY WHEN THE DEFAULT GLOBALS ARE DISABLED. MOVE T3,T1 ;GET EXTRA COPY TLZ T1,776000-REGSYM ;CLEAR ALL BUT REGISTER BIT TLNN T3,DEFSYM ;DEFINED? TLNN T3,GLBSYM ; NO, GLOBAL? JRST TERM1 ; LOCAL TLO T1,GLBSYM ;JUST GLOBAL AOS T4,GLBPNT ;GLOBAL MOVEM SYM,GLBBUF(T4) ;SAVE NAME DPB T4,SUBPNT ;SAVE NUMBER IN RELOCATION TERM1: MOVE VAL,T1 ;RESULT TO VAL JRST CPOPJ1 ;GOOD EXIT TERM2: CALL OSRCH ;TRY OP CODES JRST TERM3 ; NO CAIE T2,OCOP ;PSEUDO-OP? JRST TERM3 ; YES CALL CRFOPR HRRZ VAL,T1 ;YES, TREAT AS NUMERIC JRST CPOPJ1 ;GOOD EXIT TERM3: CALL SSRCH ;NOT YET DEFINED SKPEDS ED.ABS ;SKIP IF ABSOLUTE ASSEMBLY TLNE EXF,GBLDIS ;ARE DEFAULT GLOBALS ENABLED? JRST TERM5 ;NO. TLO T1,FLTSYM!GLBSYM ;DEFAULT GLOBAL SYMBOL CALL INSRT JRST TERM0 TERM4: LDB T2,C5PNTR ;NON-SYMBOLIC XCT TERMJT(T2) ;EXECUTE TABLE JRST CPOPJ1 ;GOOD EXIT TERM5: ;DEFAULT GLOBALS DISALLOWED CALL INSRT CALL CRFREF ERRSET ERR.U ;FLAG THE STATEMENT JRST CPOPJ1 ;TAKE THE SKIP RETURN TERMJT: ;TERM JUMP TABLE PHASE 0 RETURN ;NULL RETURN TEPL:! CALL TERMPL ; + TEMI:! CALL TERMMI ; - TEUA:! CALL TERMUA ; ^ TEAB:! CALL TERMAB ; <> TESQ:! CALL TERMSQ ; ' TEDQ:! CALL TERMDQ ; " TEPC:! CALL TERMPC ; % TENM:! CALL TERMNM ; 0-9 TEHX:! CALL TERMHX ; $ TEOC:! CALL TERMOC ; @ DEPHASE TERMPL: ; + CALL GETNB CALL TERM ERRSET ERR.A RETURN TERMMI: ; - CALL TERMUC ADDI VAL,1 TRZ VAL,600000 RETURN TERMUA: ; ^ CALL GETNB CAIN CHR,"F" JRST TERMUF CAIN CHR,"C" JRST TERMUC SETZ T3, CAIN CHR,"D" MOVEI T3,^D10 CAIN CHR,"O" MOVEI T3,^D8 CAIN CHR,"B" MOVEI T3,^D2 SKIPN T3 ERRXIT ERR.A SPUSH CRADIX MOVEM T3,CRADIX CALL TERMPL SPOP CRADIX RETURN TERMUC: CALL TERMPL CALL ABSTST TRC VAL,177777 RETURN TERMUF: CALL GETNB MOVEI T3,4 MOVEM T3,FLTLEN CALL FLTG TLNE FLG,FLTFLG ERRSET ERR.A LDB VAL,[POINT 16,FLTNUM,35] RETURN TERMAB: ; <> CALL GETNB SPUSH RELLVL CALL EXPR ERRSET ERR.A CAIE CHR,">" ;"<" ERRSKP ERR.A CALL GETNB SPOP RELLVL RETURN TERMPC: ; % MOVE T3,MACHT ;CHECK MACHINE TYPE CAIE T3,M68 ;FOR 6800 CAIN T3,M65 ; OR 6502 JRST TERMBN ;TREAT % AS BINARY PREFIX CALL GETNB ;SKIP OVER CHARACTER CALL TERM ;GET A TERM ERRSET ERR.R ; INVALID REG TLZE VAL,(B17!377B) ERRSET ERR.R ;ERROR IF GLOBAL OR RELOC TLO VAL,REGSYM ;SET FLAG RETURN ;EXIT TERMNM: ;NUMERIC TERM SETZB SYM,T1 ;CLEAR ACS TERMN1: IMULI VAL,^D10 ;DECIMAL ACCUMULATOR ADDI VAL,-"0"(CHR) IMUL T1,CRADIX ADDI T1,-"0"(CHR) CAIGE SYM,-"0"(CHR) ;HIGHEST NUMBER SO FAR? MOVEI SYM,-"0"(CHR) ; YES, SAVE IT GETCHR ;GET THE NEXT CHARACTER CAIL CHR,"0" ;TEST NUMERIC CAILE CHR,"9" CAIA ; NO JRST TERMN1 ;YES, PROCESS IT CAIE CHR,"." ;DECIMAL POINT? JRST TERMN2 ; NO CALL GETNB ;YES, BYPASS IT JRST TERMN3 ;SKIP AROUND TEST TERMN2: CAIN CHR,"$" JRST TERMN4 CAML SYM,CRADIX ;IN BOUNDS? ERRSKP ERR.N ; YES, FLAG ERROR AND LEAVE DECIMAL MOVE VAL,T1 ;NO, MOVE OCTAL IN TERMN3: TDZE VAL,[-1B19] ;OVERFLOW? ERRSET ERR.T ; YES, FLAG TRUNCATION ERROR JRST SETNB TERMN4: MOVE SYM,VAL HRL SYM,LSBNUM TLO SYM,ST.LSB TLO FLG,LSBFLG CALL SSRCH ERRSET ERR.U MOVE VAL,T1 JRST GETNB TERMDQ: ; """ GETCHR ;GET THE NEXT NON-TERMINATOR JUMPE CHR,TERMQE ; END OF LINE, ERROR LDB VAL,LBP ;LOAD UN-MAPPED CHARACTER GETCHR ;TRY ONE MORE JUMPE CHR,TERMQE ; ERROR LDB CHR,LBP DPB CHR,[POINT 8,VAL,35-8] ;STORE IN UPPER JRST GETNB ;RETURN WITH NEXT NON-BLANK TERMSQ: ; "'" GETCHR ;GET NON-TERMINATOR JUMPE CHR,TERMQE ; TERMINATOR, ERROR LDB VAL,LBP ;LOAD UN-MAPPED CHARACTER JRST GETNB ;RETURN NON-BLANK TERMQE: ERRSET ERR.Q ;RAN OUT OF CHARACTERS RETURN TERMBN: MOVEI T3,^D2 ;BINARY CONSTANT TERMOC: MOVEI T3,^D8 ;OCTAL CONSTANT SPUSH CRADIX MOVEM T3,CRADIX CALL TERMPL SPOP CRADIX RETURN TERMHX: SETZ VAL, ;INIT NUMBER MOVEI T3,4 ;MAX 4 DIGITS TERMH1: CALL GETNB ;PASS OVER CHAR JUMPE CHR,TERMH2 CAIL CHR,"0" ;CHECK VALID CAILE CHR,"F" ;RANGE JRST TERMH2 ;CHECK TERMINATOR CAIGE CHR,"A" CAIG CHR,"9" SKIPA JRST TERMH2 CAILE CHR,"9" ;ADJUST ALPHAS SUBI CHR,"A"-"9"-1 LSH VAL,4 ;SHIFT OVER ADDI VAL,-"0"(CHR) ;ADD IN CHARACTER SOJG T3,TERMH1 TERMH2: JUMPE T3,GETNB ;GET NEXT CHAR IF 4 SEEN RETURN ;ELSE ALREADY HAVE IT SUBTTL SYMBOL/CHARACTER HANDLERS GETSYM: ;GET A SYMBOL MOVEM LBP,SYMBEG ;SAVE START FOR RESCAN SETZB SYM,T1 ;CLEAR AC AND COUNT GETSY1: MOVEM LBP,SYMEND ;SAVE END LDB T2,ANPNTR ;MAP CHARACTER TYPE XCT GETSYT(T2) ;EXECUTE TABLE JRST SETNB ; FINISHED, RETURN NEXT NON-BLANK CAIL T1,6 ;OVERFLOW? JRST GETSY2 ; YES, DON'T STORE HLRZ T3,RADTBL-40(CHR) ;MAP CHAR IMUL T3,RAD50M(T1) ;SKIFT IT ADD SYM,T3 ;ACCUMULATE GETSY2: GETCHR ;GET THE NEXT CHAR AOJA T1,GETSY1 ;TRY FOR MORE GETSYT: ;GETSYM TABLE PHASE 0 JFCL ;NON-ALPHA/NUMBERIC .DOT:! TLNN EXF,MODBIT ;DITTO .ALP:! CAIA .NUM:! CALL GETSY3 ;NUMERIC, DOUBLE TEST DEPHASE GETSY3: TLNE EXF,MODBIT ;ACCEPT IF IN COMMAND STRING JUMPE SYM,CPOPJ ; NO, NULL IF FIRST JRST CPOPJ1 RAD50M: ;RAD50 MULTIPLIERS XWD 50*50, XWD 50, XWD 1, XWD ,50*50 XWD ,50 XWD ,1 GETLSB: ;GET LOCAL SYMBOL SETZM SYM GETLS1: CAIL CHR,"0" ;TEST RANGE CAILE CHR,"9" JRST GETLS2 ; OUTSIDE IMULI SYM,^D10 ;OK, ACCUMULATE NUMBER ADDI SYM,-"0"(CHR) GETCHR JRST GETLS1 GETLS2: JUMPE SYM,GETLS3 CAIE CHR,"$" JRST GETLS3 CAILE SYM,^D32767 ;NUMBER TOO LARGE? ERRSET ERR.T ; YES, ERROR HRL SYM,LSBNUM ;STUFF IN BLOCK NUMBER TLO SYM,ST.LSB ;FLAG IT TLO FLG,LSBFLG JRST GETNB GETLS3: MOVE LBP,SYMBEG ;MISSED, RESTORE POINTER SETZM SYM JRST SETNB OPDEF GETNB [CALL .] GETNB: ;GET NON-BLANK CHARACTER IBP LBP ;INDEX BYTE POINTER OPDEF SETNB [CALL .] SETNB: ;SET TO NON-BLANK CHARACTER SETCHR ;SET CHARACTER IN CHR CAIE CHR,SPACE ;IF SPACE CAIN CHR,TAB ; OR TAB; JRST GETNB ; BYPASS RETURN ;OTHERWISE EXIT ; OPDEF GETCHR [ILDB CHR,LBP] OPDEF GETCHR [CALL .] GETCHR: ;GET THE NEXT CHARACTER IBP LBP ;INDEX BYTE POINTER ; OPDEF SETCHR [LDB CHR,LBP] OPDEF SETCHR [CALL .] SETCHR: ;SET THE CURRENT CHAR IN CHR LDB CHR,LBP CAIL CHR,"A"+40 CAILE CHR,"Z"+40 RETURN SUBI CHR,40 RETURN .LOC SYMBEG: BLOCK 1 ;SYMBOL START SYMEND: BLOCK 1 ;SYMBOL END .RELOC SUBTTL ARGUMENT HANDLERS TGARG: ;TEST FOR GENERAL ARGUMENT SETZM GTCDEL ;CLEAR DELIMITER TLNN EXF,MODBIT ;EXEC MODE? JRST TGARG1 ; YES CAIE CHR,";" ;EOL? CAIN CHR,0 RETURN ; YES SKIPL ARGCNT ;END OF EXPRESSION? JRST TGARG5 ; NO HRRZS ARGCNT ;YES, CLEAR FLAG CAIN CHR,"," ;REQUIRED COMMA SEEN? JRST TGARG2 ; YES RETURN ;NO, CONSIDER NULL TGARG5: SKIPE ARGCNT ;NO, FIRST ARGUMENT? CAIE CHR,"," ; NO, COMMA TO BYPASS? JRST TGARG3 ; NO JRST TGARG2 ;YES TGARG1: CAIE CHR,":" ;EXEC MODE, ARGUMENT? RETURN ; NO TGARG2: CALL GETNB ;YES, BYPASS TERMINATOR TGARG3: AOS ARGCNT ;INCREMENT ARG COUNT JRST CPOPJ1 ;GOOD EXIT GSARG: ;GET SYMBOLIC ARGUMENT CALL TGARG ;TEST FOR EXISTENCE RETURN ; NO GSARGF: CALL GETSYM ;YES, GET SYMBOL JUMPN SYM,CPOPJ1 ;GOOD EXIT ERRSET ERR.A ; ERROR RETURN ;ERROR, BAD EXIT .LOC ARGBLK: ;GENERAL ARGUMENT BLOCK ARGPNT: BLOCK 1 ;POINTER TO PREVIOUS ARGBEG: BLOCK 1 ;START OF ARG ARGEND: BLOCK 1 ;END OF ARG ARGCHC: BLOCK 1 ;CHARACTER COUNT ARGTXP: BLOCK 1 ;TEXT POINTER ARGCNT: BLOCK 1 ;ARGUMENT NUMBER COUNT ARGLEN== .-ARGBLK .RELOC GTCHR: ;GET TEXT CHARACTER SKIPE GTCDEL ;DELIMITER IN PROGRESS? JRST GTCHR3 ; YES SKIPE ARGCNT ;NO, FIRST ARG? CAIE CHR,";" ;NO, EOL? CAIN CHR,0 RETURN ; YES, TAKE NULL EXIT CAIE CHR,"<" ;EXPRESSION MODE? JRST GTCHR2 ; NO CALL GETNB ;YES, BYPASS CHARACTER SPUSH SYM ;STACK REGISTERS SPUSH T1 CALL ABSEXP ;EVALUATE EXPRESSION SPOP T1 SPOP SYM CAIE CHR,">" ;GOOD TERMINATION? ERRSKP ERR.A ; NO CALL GETNB ;YES, BYPASS IT GTCHR1: AOS ARGCNT ;BUMP ARG COUNT JRST CPOPJ1 ;GOOD EXIT GTCHR2: MOVEM CHR,GTCDEL ;SET DELIMITER GTCHR3: GETCHR ;GET THE NEXT CHARACTER CAME CHR,GTCDEL ;TERMINATOR? JRST GTCHR4 ; NO SETZM GTCDEL ;YES, CLEAR DELIMITEP CALL GETNB ;BYPASS DELIMITER ;BLOWUP IF THE LINE IS HENCEFORTH EMPTY JRST GTCHR ;TRY AGAIN GTCHR4: LDB VAL,LBP ;GET UN-MAPPED COPY JUMPN VAL,GTCHR1 ;BRANCH IF NOT EOL MOVEI 6,";" ;SEE IF LAST DELIMITER WAS A SEMICOLON CAME Q1,GTCDEL ;WAS IT? ERRSET ERR.A ;NO, FLAG ERROR SETZM GTCDEL RETURN ;NULL EXIT .LOC ;ARGUMENT STORAGE WORDS GTCDEL: BLOCK 1 ;ARGUMENT DELIMITER .RELOC SUBTTL END OF PASS ROUTINES ENDP: ;END OF PASS ROUTINES CALL TSTMAX ;BE SURE TO TRAP MAX PC LDB T2,CCSPNT HRRM PC,SECBAS(T2) ;SET HIGH LOCATION TLNN FLG,P1F ;PASS 1? JRST ENDP20 ; NO CALL SETBIN ;SET BINARY (OBJ OR BIN) RETURN ; AND EXIT ENDP20: CALL BLKDMP ;END OF PASS 2 MOVEI T2,BKT6 ;ASSUME RELOCATABLE SKPEDR ED.ABS ;ABSOLUTE? MOVE T2,ENDVEC ; YES, SET XFER VECTOR CALL BSWORD ;STORE IT JRST BLKDMP ;DUMP THE BUFFER AND EXIT SUBTTL CODE ROLL HANDLERS SETRLD: ;SET RLD HEADER MOVE T1,PC ADD T1,PHAOFF ANDI T1,177777 HRLI T1,(B) STCODE: ;STOW CODE SPUSH T3 AOS T3,CODPNT ;INCREMENT INDEX MOVEM T1,CODBUF-1(T3) ;STORE SPOP T3 RETURN PROCOD: ;PROCESS CODE CALL PROCO1 ;PROCESS ONE WORD RETURN ; NULL, EXIT MOVEM SYM,PF0 ;OK, SET PRINT FIELDS MOVEM T1,PF1 SKPLCR LC.TTM ;EXIT IF TTY CALL PROCO1 JRST CPOPJ1 ; NULL, BUT GOOD EXIT MOVEM T1,PF2 CALL PROCO1 JRST CPOPJ1 MOVEM T1,PF3 JRST CPOPJ1 PROCO1: CALL FETCOD ;FETCH AN ENTRY RETURN ; END CALL PROWRD ;PROCESS WORD MOVE SYM,PFT0 ;TRANSFER PRINT STUFF MOVE T1,PFT1 JRST CPOPJ1 SETPF0: ;SET PRINT FIELD 0 MOVE T3,PC TLO T3,DEFSYM MOVEM T3,PF0 RETURN SETPF1: ;SET PRINT FIELD 1 MOVE T3,VAL TLO T3,DEFSYM MOVEM T3,PF1 RETURN FETCOD: MOVE T3,CODPNT ;FETCH INDEX SKIPN T1,CODBUF(T3) ;NULL? RETURN ; YES, EXIT NULL SETZM CODBUF(T3) AOS CODPNT ;BUMP POINTER JRST CPOPJ1 PROWRD: ;PROCESS WORD LDB T2,MODPNT ;GET CLASS ANDI T2,177 ;MASK OUT BYTE BIT MOVE VAL,RLDTBL(T2) ;GET PROPER TABLE ENTRY MOVE T3,PF0 MOVE T4,PF1 CAIE T2,RLDT7 CAIN T2,RLDT10 JRST PROWR6 MOVE T3,PC ;GET A COPY OF THE PC TLO T3,DEFSYM ;WITH DEFINED BIT SET TLNN T1,BC1!BC2 ;CODE TO BE GENNED? SETZM T3 ; NO, DON'T PRINT LOCATION MOVE T4,VAL ;FLAGS TO T4 DPB T1,[POINT 36-8,T4,35] ;REMAINDER FROM T1 CAIN T2,RLDT1 ;SPECIAL IF CLASS 1 TLO T4,(1B) PROWR6: MOVEM T3,PFT0 MOVEM T4,PFT1 ;SET TEMP PRINT FIELD 1 PROWR3: LDB T2,[POINT 8,T1,35-8] TLNE T1,BC2 ;HIGH BYTE? CALL BYTOUT ; YES, OUTPUT HIGH BYTE LDB T2,[POINT 8,T1,35] TLNE T1,BC1!BC2 ;CODE? CALL BYTOUT ; YES, OUTPUT LOW BYTE TLNN T1,BC1!BC2 ;CODE? CALL BLKDMP ; NO, SPECIAL. DUMP THE BUFFER RETURN RLDTBL: PHASE 0 RLDT0:! XWD DEFSYM! 0, 0 RLDT1:! XWD DEFSYM! 1, 4 RLDT2:! XWD 0! 0, 6 RLDT3:! XWD DEFSYM! 1, 4 RLDT4:! XWD 0! 0, 6 RLDT5:! XWD GLBSYM! 1, 10 RLDT6:! XWD GLBSYM! 1, 10 RLDT7:! XWD 0! 1, 10 RLDT10:! XWD DEFSYM! 1, 4 RLDT11:! XWD DEFSYM! 0, 2 RLDT12:! XWD 0! 0, 0 RLDT13:! XWD 0! 0, 0 RLDT14:! XWD 0! 0, 0 RLDT15:! XWD DEFSYM! 1, 10 RLDT16:! XWD DEFSYM! 1, 10 RLDT17:! XWD 0! 0, 0 DEPHASE .LOC CODPNT: BLOCK 1 ;CODE ROLL POINTER CODBUF: BLOCK ^D100 ;CODE ROLL BUFFER .RELOC SUBTTL OCTAL OUTPUT ROUTINES BYTOUT: ;OUTPUT A BYTE OF CODE TLNN FLG,P1F ;PASS 1 SKPEDR ED.NPP JRST BYTOU2 ; YES, JUST INCREMENT AND EXIT SKPEDS ED.ABS JRST BYTOU1 ; NO MOVE T3,BYTCNT ;YES GET BYTE COUNT TLNE FLG,PSWFLG ;PTP OUTPUT? JRST [CAIGE T3,^D24+2 ;BUFFER FULL? CAME PC,CURADR CALL BLKDMP ;DUMP BUFFER JRST BYTOUA] CAIGE T3,DATLEN+2 ;OUT OF ROOM? CAME PC,CURADR ; OR A SEQUENCE BREAK? CALL BLKDMP ; YES, DUMP THE BUFFER BYTOUA: SKIPE BYTCNT ;DO WE NEED INITIALIZATION? JRST BYTOU1 ; NO, STORE IT SPUSH T2 ;STACK CURRENT CHARACTER MOVE T2,PC ;GET PC CALL BSWORD ;STORE IT MOVEM PC,CURADR ;NEW SEQUENCE BREAK TEST SPOP T2 ;RETRIEVE BYTE BYTOU1: CALL BSBYTE ;STORE THE BYTE AOS CURADR ;UPDATE CURRENT ADDRESS BYTOU2: MOVEI T3,LC.ME SKPLCR LC.MB ;SKIP IF WE WANT BINARY SKPLCS LC.MEB ;MACRO EXPANSION OF BINARY? ANDCAM T3,LCTST ; YES, DISABLE LC.ME SKPLCS LC.MB ;BINARY ONLY? SETLCT LC.MB ;YES - FLAG LISTING TEST AOJA PC,CPOPJ ;INCREMENT CLC AND EXIT BSWORD: ;BINARY STORAGE OF WORD SPUSH T2 CALL BSBYTE ;STORE LOW ORDER LDB T2,[POINT 8,0(P),35-8] ;FETCH HIGH BYTE CALL BSBYTE ;STORE IT SPOP T2 ;RESTORE WORD RETURN ; AND EXIT BSBYTE: ;BINARY STORAGE OF BYTE AOS T3,BYTCNT ;INCREMENT AND FETCH THE BYTE COUNT MOVEM T2,DATBLK-1(T3) ;STORE CURRENT BYTE IN BUFFER RETURN BLKDMP: ;DUMP THE CURRENT BLOCK SKIPN BYTCNT ;IS IT EMPTY? JRST BLKINI ; YES, RE-INIT SPUSH T1 ;GET A COUPLE OF SCRATCH REGISTERS SPUSH T2 BLKDM1: TLNE FLG,PSWFLG ;PTP MODE? JRST PTPDMP ;YES - SPECIAL DUMP MOVEI T2,01 ;BLOCK TYPE ONE CALL BINOUT ;OUTPUT FLAG WORD LSH T2,-8 CALL BINOUT MOVE T2,BYTCNT ;FETCH BYTE COUNT ADDI T2,4 ;FUDGE FOR HEADER CALL BINOUT ;OUTPUT IT LSH T2,-8 CALL BINOUT HRLZ T1,BYTCNT ;GET BYTE COUNT MOVNS T1 ;NEGATE BYTE CT MOVE T2,DATBLK(T1) ;GET AN ITEM FROM THE DATA BLOCK CALL BINOUT ;DUMP IT AOBJN T1,.-2 ;RECYCLE IF NOT DONE MOVN T2,CHKSUM ;GET NEG OF CHECKSUM. CALL BINOUT ;DUMP IT SETZ T2, ;FINISHED WITH BLOCK MOVEI T1,^D6 CALL BINOUT ;DUMP SOME BLANK TAPE SOJG T1,.-1 SPOP T2 ;RESTORE REGISTERS SPOP T1 BLKINI: ;CODE BLOCK INITIALIZATION SETZM BYTCNT ;CLEAR BYTE COUNT RETURN ;EXIT ;SPECIAL PTP FORMAT OUTPUT FOR KIM-1, 8080, ETC... ;(T1 & T2 ON STACK) PTPDMP: TLNE EXF,BINBIT ;BINARY ON? JRST PTPDMX ;NO - EXIT MOVE T1,DATBLK ;EXCHANGE (CORRECT) EXCH T1,DATBLK+1 ; ADDRS BYTES MOVEM T1,DATBLK ;... MOVE T1,MACHT ;GET MACHINE TYPE CALL @RECHD(T1) ;DO INIT JUMPGE T1,PTPDM2 ;DONE IF ZERO PTPDM1: MOVE T2,0(T1) ;FETCH BYTE CALL BHXOUT ;DUMP IT AOBJN T1,PTPDM1 ;LOOP PTPDM2: MOVE T1,MACHT ;MACHINE TYPE CALL @GCKSUM(T1) ;OUTPUT CHECKSUM MOVEI T2,CRR ;ADD CRLF CALL BCHOUT MOVEI T2,LF ;... CALL BCHOUT MOVEI T1,6 MOVEI T2,0 ;DUMP 6 NULLS CALL BCHOUT SOJG T1,.-1 AOS RECCNT ;COUNT # OF RECORDS PTPDMX: SPOP T2 ;RESTORE REGS SPOP T1 JRST BLKINI ;RETURN ;MACHINE DEPENDENT RECORD HEADER SETUP RECHD: M65HED ;6502 M68HED ;6800 M80HED ;8080 M88HED ;8008 M08HED M18HED MF8HED CHKTAB (RECHD) ;CHECKSUM FETCH GCKSUM: M65CKS ;6502 CHECKSUM M68CKS ;6800 M80CKS ;8080 CHECKSUM M88CKS ;8008 CHECKSUM M08CKS M18CKS MF8CKS CHKTAB (GCKSUM) ;6502 RECORD HEADER ROUTINE M18HED: MF8HED: M68HED: M65HED: MOVEI T2,";" ;BEGINNING OF RECORD M80HX: CALL BCHOUT MOVE T2,BYTCNT ;FETCH BYTE COUNT SUBI T2,2 ;ADJUST FOR ADDRS SETZM CHKSUM ;START CHECKSUM NOW CALL BHXOUT ;DUMP COUNT HRLZ T1,BYTCNT ;GET BYTE COUNT FOR MOVNS T1 ;AOBJN PNTR HRRI T1,DATBLK ;... RETURN ;8080 RECORD HEADER ROUTINE M88HED: ;8008 ENTRY M08HED: M80HED: MOVEI T2,":" ;RECORD MARK CALL M80HX ;COMMON CODE MOVE T2,0(T1) ;OUTPUT ADDRS BYTES CALL BHXOUT MOVE T2,1(T1) ;... CALL BHXOUT MOVEI T2,0 ;DUMP A ZERO BYTE (REC TYPE CODE) CALL BHXOUT ADD T1,[2,,2] ;UPDATE AOBJN PNTR RETURN ;RETURN ;CHECKSUM ROUTINES M18CKS: MF8CKS: M68CKS: M65CKS: MOVE T1,CHKSUM ;GET CHECKSUM MOVE T2,T1 ;COPY TO 2 LSH T2,-^D8 ;HIGH BYTE FIRST CALL BHXOUT MOVE T2,T1 ;THEN LOW BYTE JRST BHXOUT ; AND RETURN M88CKS: ;8008 ENTRY M08CKS: M80CKS: MOVN T2,CHKSUM ;NEGATE JRST BHXOUT ; AND DUMP ONE BYTE ONLY .LOC RECCNT: BLOCK 1 ;COUNT OF RECORDS CURADR: BLOCK 1 ;SEQUENCE BREAK TEST CHKSUM: BLOCK 1 ;CHECK SUM BYTCNT: BLOCK 1 ;BYTE COUNT DATBLK: BLOCK DATLEN+10 ;ABS BUFFER .RELOC SUBTTL INPUT LINE ACCUMULATORS GETLIN: ;GET THE NEXT SOURCE LINE SETZM CRRCNT SETZM LINCHC SETZM LINTBC ;TAB ORIENTED CHAR COUNT MOVE LBP,[POINT 7,LINBUF] GETLI1: CALL CHARLC ;GET AN INPUT CHARACTER LDB T2,C7PNTR ;GET CHARCTERISTICS XCT GETLIT(T2) ;EXECUTE TABLE SKIPE CRRCNT ;OK, ANY IMBEDDED CR'S? CALL ILCPRO ; YES, ERROR AOS T3,LINCHC CAIL T3,CPL ERRSKP ERR.L IDPB CHR,LBP AOS LINTBC ;UPDATE TAB COUNT JRST GETLI1 ; OK, STORE IT GETLI2: MOVEI T3,7 IORM T3,LINTBC ;FUDGE TAB COUNT RETURN GETLI3: CAIE CHR,CRR ;TERMINATOR, CR? JRST GETLI5 ; NO, A REAL ONE SKIPN CRRCNT ;YES, FIRST? AOSA CRRCNT ; YES, FLAG IT GETLI4: CALL ILCPRO ; NO, ERROR JRST GETLI1 GETLI5: CAIN CHR,FF ;FORM FEED? SKIPE MCACNT JRST GETLI6 ; NO SKIPN LINCHC TLO FLG,FFFLG AOS FFCNT AOS ERPNUM ;BUMP ERROR PAGE COUNT GETLI6: MOVEI CHR,0 IDPB CHR,LBP MOVEI LBP,LINBUF HLL LBP,ASCBYT MOVEM LBP,LINPNT MOVEM LBP,CLIPNT SKIPE MCACNT JRST SETNB SKIPN MSBMRP ;MACRO EXPANSION? AOSA CHR ; NO, INCREMENT LINE COUNT SETLCT LC.ME ; IGNORE MEB FOR NOW TLNN EXF,SOLBIT ;SEQUENCE OUTPUT LINES? ADDM CHR,LINNUM ; NO, BUMP TLNE FLG,ENDFLG ;PERCHANCE END OF FILE? ERRSET ERR.E ; YES, FLAG "NO END STATEMENT" LDB T3,CDRPNT MOVEM T3,CDRCHR MOVEI T3,0 TLNE EXF,CDRBIT ;/CDR MODE? DPB T3,CDRPNT ; YES, STUFF A NULL JRST SETNB ;RETURN WITH FIRST NON-BLANK GETLC: SKPEDS ED.LC SUBI CHR,40 RETURN ILCPRO: ;ILLEGAL CHARACTER PROCESSOR ERRSET ERR.I ;FLAG ERROR SKIPN ILCPNT ;FIRST IN THIS LINE? MOVEM LBP,ILCPNT ; YES RETURN GETLIT: ;GETLIN MAP TABLE PHASE 0 JRST GETLI4 QJNU:! JRST GETLI4 ;ILLEGAL CHARACTER QJCR:! JRST GETLI3 QJVT:! JRST GETLI3 QJTB:! CALL GETLI2 QJSP:! JFCL QJPC:! JFCL QJLC:! CALL GETLC DEPHASE GETMLI: ;GET MACRO-TYPE LINE CALL GETLIN ;GET A STANDARD LINE CALL GETSYM TSTMLI: SKIPE SYM CALL OSRCH SETZB T1,T2 ; NO CAIE T2,DIOP ;DIRECTIVE? TDZA T3,T3 ; NO LDB T3,SUBPNT ;YES, RETURN WITH FLAGS RETURN CDRPNT: POINT 7,LINBUF+^D14,6+7+7 ;POINTER TO COLUMN 73 .LOC CDRCHR: BLOCK 1 ;/CDR SAVE CHARACTER LINPNT: BLOCK 1 ;POINTER TO START OF LINE CLIPNT: BLOCK 2 CLILBL: BLOCK 1 ILCPNT: BLOCK 1 ;ILLEGAL CHARACTER POINTER FFCNT: BLOCK 1 ;TERMINATION CHARACTER ERPNUM: BLOCK 1 ;ERROR PAGE NUMBER ERPBAK: BLOCK 1 ;ONE MESSAGE PER PAGE CRRCNT: BLOCK 1 LINCHC: BLOCK 1 LINTBC: BLOCK 1 LINBUF: BLOCK CPL/5+2 .RELOC SUBTTL SYMBOL TABLE LISTING SYMTB: ;LIST THE SYMBOL TABLE TLNN EXF,CRFBIT ;CREF SUPPRESSED? JRST CRFLST ; NO, DO IT SKPLCR LC.SYM ;HOW ABOUT SYMBOL TABLE? RETURN ; NO, EXIT SETZ Q2, ;INITIALIZE POINTER TLO EXF,HDRBIT ;FLAG NEW PAGE MOVE T3,[XWD [ASCIZ /SYMBOL TABLE/],STLBUF] BLT T3,STLBUF+4 SYMTB1: MOVEI Q1,SPLTTY ;SET "SYMBOLS PER LINE" SKPLCR LC.TTM ;TELETYPE? MOVEI Q1,SPL ; NO SYMTB2: CALL GETSTE ;GET THE NEXT SYMBOL TABLE ENTRY JRST SYMTB3 ; END TLNE SYM,ST.MAC!ST.LSB JRST SYMTB2 CALL LSTSTE ;LIST SYMBOL TABLE ENTRY SOJG Q1,SYMTB2 ;TEST FOR MORE ITEMS ON LINE CALL LSTCR JRST SYMTB1 ;START NEW LINE SYMTB3: MOVE SYM,M40DOT MOVE T1,PC ;PRINT PC TLO T1,DEFSYM CALL LSTSTE SYMTBF: CALL LSTCR CALL LSTCR RETURN CRFLST: MOVE SYM,M40DOT CALL SRCHF JFCL MOVE T1,PC TLO T1,DEFSYM CALL INSRTF SETZB SYM,Q2 CALL CRFPUT ;OUTPUT A NULL CRFL01: CALL GETSTE JRST CRFL10 TLNE SYM,ST.MAC!ST.LSB JRST CRFL01 CALL CRFPUT MOVE SYM,T1 CALL CRFPUT JRST CRFL01 CRFL10: RELEAS SRC, MOVE T3,[XWD [ASCIZ /CROSS REFERENCE TABLE/],STLBUF] BLT T3,STLBUF+6 MOVSI SYM,(1B0) MOVEM SYM,CRFMIN SETCAM SYM,CRFMAX SETOM CRFTMP CRFL20: CLOSE CRF, MOVE T3,SYSDEV MOVEM T3,DEVNAM DEVSET CRF,10 XWD 0,CRFBUF MOVEI T3,JOBFFS MOVEM T3,.JBFF INBUF CRF,NUMBUF MOVE T3,CRFBAS MOVEM T3,.JBFF MOVE T3,CRFNAM MOVEM T3,FILNAM MOVSI T3,(SIXBIT /TMP/) MOVEM T3,FILEXT SETZM FILPPN LOOKUP CRF,FILNAM HALT . SETZM LINNUM SETZM NEXT CALL SETSYM CRFL30: CALL CRFGET JRST CRFL50 JUMPE SYM,CRFL50 TLNE SYM,-1 ;SYMBOL? JRST CRFL31 ; YES CAMGE SYM,LINNUM ;NO, VALID LINE NUMBER? HALT . ; NO MOVEM SYM,LINNUM ;YES, SET IT JRST CRFL30 CRFL31: TLC SYM,(1B0) MOVEM SYM,CRFSAV TRZ SYM,600000 ;CLEAR FLAGS CRFL32: CAML SYM,CRFMIN CAML SYM,CRFMAX JRST CRFL30 HRRZ T3,.JBFF ADDI T3,WPB+10 CAMGE T3,SYMBOT JRST CRFL40 MOVE T3,.JBREL CORE T3, HALT . HLRZ T4,.JBHRL ADD T4,.JBREL ASH T4,-^D10 CAILE T3,1(T4) JRST CRFL40 MOVNI Q2,2 ADD Q2,SYMLEN CAIG Q2,4 HALT . MOVE T1,@SYMPNT MOVEM T1,CRFMAX MOVE T1,@VALPNT CALL REMMAC HRRZ T2,.JBREL CRFL33: MOVE T3,-4(T2) MOVEM T3,-2(T2) SUBI T2,1 SOJGE Q2,CRFL33 MOVEI T2,2 ADDM T2,SYMBOT CALL SRCHI CAML SYM,CRFMAX JRST CRFL30 CRFL40: CALL SRCHF ;SEARCH SYMBOL TABLE CAIA JRST CRFL41 CALL GETBLK ;GET A STORAGE BLOCK HRLI T1,(POINT 18,,35) MOVEM T1,0(T1) ;STORE TERMINAL CALL INSRTF SPUSH T1 JRST CRFL4X CRFL41: SPUSH T1 MOVE T1,0(T1) ;GET CURRENT POINTER LDB T2,T1 ;PEEK AT LAST LDB T3,[POINT 16,T2,35] CAMN T3,LINNUM ;NEW LINE? JRST CRFL43 ; YES CRFL4X: IBP T1 ;NO, BUMP POINTER SKIPE 0(T1) ;END OF BLOCK? JRST CRFL42 ; NO MOVE T2,T1 ;YES, SAVE CURRENT POINTER CALL GETBLK ;GET ANOTHER BLOCK HRLI T1,(POINT 18,,17) HRRZM T1,0(T2) ;SET LINK CRFL42: MOVE T2,LINNUM ;SET LINE NUMBER CRFL43: SPOP T3 ;RESTORE VALUE MOVE SYM,CRFSAV ANDI SYM,600000 ;ISOLATE FLAGS IOR T2,SYM ;MERGE INTO VALUE DPB T2,T1 ;SET IT MOVEM T1,0(T3) ;STORE NEW POINTER JRST CRFL30 CRFL50: MOVSI T3,(1B0) MOVEM T3,CRFSAV MOVEI Q2,0 CRFL51: CALL GETSTE JRST CRFL60 SPUSH T1 LDB T2,[POINT 2,SYM,1] CAME T2,CRFTMP TLO EXF,HDRBIT MOVEM T2,CRFTMP CAIN T2,2 CRFL52: CAMG SYM,CRFSAV JRST CRFL53 MOVEM SYM,CRFSAV+1 CALL CRFGET SETOM SYM TLC SYM,(1B0) MOVEM SYM,CRFSAV CALL CRFGET JFCL EXCH SYM,CRFSAV+1 JRST CRFL52 CRFL53: CAME SYM,CRFSAV TDZA T1,T1 MOVE T1,CRFSAV+1 CALL LSTSTQ SPOP T1 SPUSH 0(T1) CRFL54: MOVN T3,COLCNT CAIL T3,8 JRST CRFL55 CALL LSTCR CALL LSTTAB MOVE T2,CRFTMP CAIN T2,2 SKPLCR LC.SYM JRST CRFL55 CALL LSTTAB CALL LSTTAB CRFL55: ILDB Q3,T1 JUMPN Q3,CRFL56 MOVE T1,0(T1) HRLI T1,(POINT 18,) JRST CRFL55 CRFL56: ANDI Q3,177777 DNC 5,Q3 LDB Q3,T1 TRNE Q3,400000 LSTICH "#" TRNE Q3,200000 LSTICH "*" CALL LSTTAB CAME T1,0(P) JRST CRFL54 SPOP 0(P) CALL LSTCR JRST CRFL51 CRFL60: HRLOI T3,377777 EXCH T3,CRFMAX MOVEM T3,CRFMIN CAME T3,CRFMAX JRST CRFL20 SETZM FILNAM RENAME CRF,FILNAM JFCL JRST SYMTBF CRFGET: SOSLE CRFCNT JRST CRFGE1 INPUT CRF, STATZ CRF,IOEOF RETURN CRFGE1: ILDB SYM,CRFPNT JRST CPOPJ1 .LOC CRFNAM: BLOCK 1 CRFTMP: BLOCK 1 CRFMAX: BLOCK 1 CRFMIN: BLOCK 1 CRFSAV: BLOCK 2 .RELOC LSTSTQ: LDB T2,[POINT 2,SYM,1] TRC T2,2 SKPLCS LC.SYM JUMPE T2,LSTSTE LSTSYM SYM JRST LSTTAB LSTSTE: ;LIST SYMBOL TABLE ENTRY LSTSYM 1,SYM ;LIST IT MOVEI T2,"=" TLNE T1,LBLSYM MOVEI T2,SPACE CALL LSTOUT MOVEI T2,"%" TLNN T1,REGSYM ;REGISTER? MOVEI T2,SPACE ; NO CALL LSTOUT LDB VAL,[POINT 16,T1,35] TLNE T1,DEFSYM JRST LSTST1 LSTSTR [ASCIZ /******/] CAIA LSTST1: CALL LSTWRD LDB VAL,SUBPNT MOVEI T2,SPACE JUMPL Q2,LSTST2 SKIPE VAL MOVEI T2,"R" LSTST2: CALL LSTOUT MOVEI T2,SPACE JUMPL Q2,LSTST3 TLNN T1,DEFSYM!GLBSYM ;DEFINED SYMBOL? MOVEI T2,"U" ;NO. NOTE THAT THIS TRAP WILL ;BE ENTERED ONLY WHEN THE DEFAULT ;GLOBALS ARE DISABLED. CALL LSTOUT MOVEI T2,SPACE TLNE T1,GLBSYM MOVEI T2,"G" LSTST3: CALL LSTOUT MOVEI T2,SPACE ;ASSUME NOT DEFAULTED GLOBAL JUMPL Q2,LSTST4 ;IF LT DON'T CHECK TLNE T1,FLTSYM ;DEFAULTED GLOBAL? MOVEI T2,"X" ;YES LSTST4: CALL LSTOUT ;OUTPUT CHARACTER CAILE VAL,1 CALL LSTBYT ;OUTPUT SECTION NR WITH 2 LEADING SPACES JRST LSTTAB SUBTTL USER SYMBOL TABLE HANDLERS MSRCH: TLOA SYM,ST.MAC SSRCH: ;SYMBOL SEARCH TLZ SYM,ST.MAC CAMN SYM,M40DOT ;PC? JRST SSRCH3 ; YES SRCHF: MOVE Q2,DELTA ;SET OFFSET FOR INDEX MOVE T2,Q2 ASH T2,-1 ;SET INCREMENT SSRCH1: CAMGE SYM,@SYMPNT ;ARE WE LOOKING ABOVE SYMBOL? JRST SSRCH2 ; YES, MOVE DOWN CAMG SYM,@SYMPNT ;NO, POSSIBLY AT IT? JRST SSRCH4 ; YES TDOA Q2,T2 ; NO, INCREMENT INDEX SSRCH2: SUB Q2,T2 ;DECREMENT INDEX ASH T2,-1 ;DECREMENT DELTA CAMG Q2,SYMLEN ;ARE WE OUT OF BOUNDS? JUMPN T2,SSRCH1 ; NO, BRANCH IF NOT THROUGH JUMPN T2,SSRCH2 ; YES, MOVE DOWN IF NOT THROUGH SETZB T1,T2 SOJA Q2,CPOPJ ;NOT FOUND, SET INDEX AND EXIT NORMAL SSRCH3: MOVE T1,PC TLOA T1,DEFSYM ;SET PC AS DEFINED SSRCH4: MOVE T1,@VALPNT ;FOUND, FETCH VALUE LDB T2,TYPPNT ;SET TYPE POINTER JRST CPOPJ1 ;EXIT +1 INSRT: ;INSERT ITEM IN SYMBOL TABLE CAMN SYM,M40DOT ;PC? JRST INSRT2 ; YES INSRTF: CAMN SYM,@SYMPNT ;IS IT HERE ALREADY? JRST INSRT1 ; YES MOVNI Q1,2 ;NO, PREPARE TI INSERT ADDB Q1,SYMBOT ;DECREMENT POINTER TO BOTTOM OF TABLE CAMG Q1,.JBFF ;ARE WE INTRUDING ON THE MACROS? CALL GETCOR ; YES, GET MORE CORE MOVE Q1,SYMBOT HRLI Q1,2(Q1) ;SET UP BLT BLT Q1,@SYMPNT ;MOVE LOWER SYMBOLS DOWN CALL SRCHI ;RE-INITIALIZE THE POINTERS ADDI Q2,2 ;COMPENSATE FOR SHIFT MOVEM SYM,@SYMPNT ;STORE SYMBOL INSRT1: MOVEM T1,@VALPNT ;STORE VALUE RETURN INSRT2: MOVE PC,T1 ;".", SET PC AND PC,[PCMASK] ;MAKE SURE ITS CLEAN RETURN SRCHI: ;INITIALIZE FOR SEARCH SPUSH T1 ;STACK WORKING REGISTERS SPUSH T2 MOVE T1,SYMTOP ;GET THE TOP LOCATION SUB T1,SYMBOT ;COMPUTE THE DIFFERENCE MOVEM T1,SYMLEN ;SAVE IT MOVEI T2,1 ;SET LOW BIT LSH T2,1 ;SHIFT OVER ONE TDZ T1,T2 ;CLEAR CORRESPONDING ONE JUMPN T1,.-2 ;TEST FOR ALL BITS CLEARED MOVEM T2,DELTA ;END, SAVE LEADING BIT FOR SEARCH OFFSET MOVE T1,SYMBOT ;GET THE BASE HRLI T1,(Z (Q2)) ;SET INDEX MOVEM T1,SYMPNT ;SET SYMBOL POINTER SUBI T1,1 MOVEM T1,VALPNT ;SET VALUE POINTER SPOP T2 ;RESTORE REGISTERS SPOP T1 RETURN ;EXIT GETSTE: ;GET SYMBOL TABLE ENTRY ADDI Q2,2 ;MOVE UP TWO CAML Q2,SYMLEN ;TEST FOR END RETURN ; YES, EXIT MOVE SYM,@SYMPNT MOVE T1,@VALPNT LDB T2,TYPPNT JRST CPOPJ1 ;OK, PERFORM SKIP-RETURN .LOC SYMPNT: BLOCK 1 ;POINTER TO SYMBOL TABLE MNEMONIC VALPNT: BLOCK 1 ;POINTER TO SYMBOL TABLE VALUE SYMLEN: BLOCK 1 ;SYMBOL TABLE LENGTH DELTA: BLOCK 1 ;BINARY SEARCH OFFSET .RELOC SUBTTL CREF HANDLERS CRFOPD: TLOA FLG,DEFFLG ;CREF OP DEFINITION CRFOPR: TLZ FLG,DEFFLG ;CREF OP REFERENCE TLNN EXF,LSTBIT!CRFBIT TLNE FLG,P1F RETURN SPUSH SYM TLNN SYM,ST.MAC TLO SYM,ST.MAC!ST.LSB CALL CRFREX SPOP SYM RETURN CRFDEF: TLOA FLG,DEFFLG CRFREF: TLZ FLG,DEFFLG TLNN EXF,LSTBIT!CRFBIT TLNE FLG,P1F RETURN TLNE SYM,ST.MAC!ST.LSB RETURN CRFREX: SPUSH SYM TLNE FLG,DEFFLG TRO SYM,400000 TLNE FLG,DSTFLG TRO SYM,200000 EXCH SYM,LINNUM CAME SYM,CRFSAV CALL CRFPUT MOVEM SYM,CRFSAV EXCH SYM,LINNUM CALL CRFPUT SPOP SYM RETURN CRFPUT: SOSG CRFCNT CALL CRFDMP IDPB SYM,CRFPNT RETURN CRFDMP: OUTPUT CRF, CRFTST: STATZ CRF,IODATA!IODEV!IOWRLK!IOBKTL FERROR [ASCIZ /CREF OUTPUT ERROR/] RETURN SUBTTL MEMORY MANAGEMENT GETCOR: ;GET CORE SPUSH SYM ;GET A COULPLE OF WORKING REGISTERS SPUSH T1 HRRO T1,.JBREL ;GET TOP OF CURRENT CORE MOVEI SYM,CORINC(T1) ;COMPUTE NEXT K CORE SYM, ;MAKE A REQUEST FERROR [ASCIZ /INSUFFICIENT CORE/] MOVEI SYM,1(T1) SUB SYM,SYMBOT ;COMPUTE NUMBER OF ITEMS TO BE MOVED POP T1,CORINC(T1) ;POP ITEM UP ONE K SOJG SYM,.-1 ;TEST FOR COMPLETION MOVEI T1,CORINC ;UPDATE POINTERS ADDM T1,SYMBOT ADDM T1,SYMPNT ADDM T1,VALPNT ADDM T1,SYMTOP SPOP T1 ;RESTORE REGISTERS SPOP SYM RETURN ;EXIT .LOC SYMBOT: BLOCK 1 ;SYMBOL TABLE BBASE SYMTOP: BLOCK 1 ;SYMBOL TABLE TOP .RELOC SETSYM: ;SET SYMBOL TABLE HRRZ T3,.JBREL MOVEM T3,SYMTOP ;SET TOP OF SYMBOL TABLE SUBI T3,2 MOVEM T3,SYMBOT ; AND BOTTOM MOVSI T3,(1B0) MOVEM T3,@SYMBOT ;SET BOTTOM AND SETCAM T3,@SYMTOP ; TOP BUMPERS JRST SRCHI SUBTTL ENABLE/DISABLE HANDLERS .ENABL: ; ".ENABL" DIRECTIVE TLZ FLG,DISBIT ;SET THIS INDICATOR BIT TDZA T3,T3 ;CLEAR AC3 AND SKIP .DSABL: MOVEI T3,1 ; ".DSABL" DIRECTIVE HRLM T3,0(P) ;SAVE FLAG SKIPE T3 ;WAS IT A DISABLE? TLO FLG,DISBIT ;YEAH, KLUDGE IT UP SOME MORE .ENAB1: CALL GETEDT ;ARGS, GET ONE JRST .ENAB2 ; BRANCH IF NULL HLRZ T2,0(P) ;GET INDEX MOVE T3,EDMSK ;SET REGS TLNN EXF,MODBIT ;COMMAND STRING? TDOA T3,T1 ; YES, SET MASK AND SKIP TDNN T3,T1 ;NO, SUPPRESSED? XCT [EXP ,](T2) SETZM T1 TRO ASM,ED.ABS MOVEM T3,EDMSK SKPEDR ED.ABS ;ABS? TLZ PC,(PFMASK) ; YES, JUST IN CASE TRNE T1,ED.LSB CALL .ENAB3 TRNE T1,ED.GBL ;DEALING WITH DEFAULT GLOBALS? CALL .ENAB4 ;YES TRNE T1,ED.REG ;DEALING WITH REGISTER DEFAULTS CALL .ENAB9 ;YES TLNE EXF,MODBIT TRNN T1,ED.NPP CAIA CALL SETRLD TRNN T1,ED.ERF JRST .ENAB1 MOVE LBP,SYMBEG GETCHR GETCHR .ENAB5: GETCHR MOVSI T3,1 MOVE T4,[POINT 7,ERRMNE] .ENAB6: LSH T3,-1 ILDB SYM,T4 JUMPE SYM,.ENAB7 CAME SYM,CHR JRST .ENAB6 XCT [EXP , ](T2) TLO T2,(1B0) JRST .ENAB5 .ENAB7: CAMN LBP,SYMEND JRST .ENAB8 ERRSET ERR.A ANDCAM FLG,ERRSUP TLO T2,(1B0) .ENAB8: MOVEI T3,-1-ERR.P1 TLZN T2,(1B0) XCT [EXP , ](T2) MOVE LBP,SYMEND CALL SETNB JRST .ENAB1 .ENAB2: HRRM ASM,EDFLGS SKIPN ARGCNT ;END, ANY ARGS? ERRSET ERR.A ; NO, ERROR RETURN .ENAB3: ;LSB TEST TLNN EXF,MODBIT ;COMMAND STRING? ERRSKP ERR.A ; YES, ERROR JUMPE T2,LSBINC ;NO, NEW BLOCK IF .ENABL RETURN .ENAB4: ;DEFAULT GLOBALS TLNE FLG,DISBIT ;ENABLE DEFAULT GLOBALS? TLOA EXF,GBLDIS ;NO. TLZ EXF,GBLDIS ;YES RETURN .ENAB9: ;DEFAULT REGISTER STUFF TLO EXF,REGBIT ;TELL THE WORLD THAT WE WERE HERE. TLNE FLG,DISBIT ;ENABLE? JRST .ENABB ;NO. PARDON THE HEX... .ENABA: ;SET UP DEFAULT REGISTER DEFINITIONS SPUSH PC ;SAVE AC5 FOR SCRATCH MOVE PC,MACHT ;GET MACHINE TYPE SKIPN PC,REGPTR(PC) ;HAVE REGS? JRST .ENABE ;NO - JUST RETURN .ENABC: MOVE T1,MACHT ;GET MACHINE TYPE XCT REGTBL(T1) ;GET REGISTER SYMBOL CALL SSRCH ;SRCH FOR IT TO SET UP SYMPNT,VALPNT JFCL ;IT DOESN'T REALLY MATTER IF IT'S HERE OR NOT TLNE T1,DFLSYM ;WAS IT ALREADY A DEFAULT SYMBOL? JRST .ENABE ;YES. DON'T CHANGE THEM MOVEM T1,REGSAV(PC) ;SAVE AWAY THE OLD VALUE SETZM T1 ;CLEAR WHATEVER WAS THERE BEFORE TLO T1,REGSYM!DEFSYM!DFLSYM ;SET DEFINITION, REGISTER AND ;DEFAULT BITS ADDI T1,0(PC) ;GENERATE VALUE CALL INSRT ;AND PUT IT INTO THE TABLE AOBJN PC,.ENABC ;LOOP OVER ALL .ENABE: SPOP PC ;RESTORE AC5. RETURN ;RETURN .ENABB: ;DISABLE THE DEFAULT VALUES SPUSH PC ;GENERATE A SCRATCH REGISTER MOVE PC,MACHT ;GET MACHINE TYPE SKIPN PC,REGPTR(PC) ;GET REGISTER POINTER JRST .ENABF ;EXIT IF NO REGS .ENABD: MOVE T1,MACHT ;LOAD MACHINE TYPE CODE XCT REGTBL(T1) ;GET T1BOL CALL SSRCH ;FIND IT JFCL ;DOESN'T MATTER... TLNN T1,DFLSYM ;IS IT ALREADY A NON-DEFAULT? JRST .ENABF ;YES. DON'T FUTZ AROUND. MOVE T1,REGSAV(PC) ;RESTORE THE OLD VALUE CALL INSRT ;AND STUFF IT BACK IN AOBJN PC,.ENABD ;LOOP OVER ALL .ENABF: SPOP PC ;RESTORE AC5 RETURN ;AND RETURN .LOC NREGS==^D16 ;MAX NUMBER OF REGS REGSAV: BLOCK NREGS ;AREA TO STORE REGISTER DEFINITIONS ;WHILE DEFAULTS ARE ENABLED .RELOC ;TABLES FOR REGISTER SETTING , INDEXED BY MACHINE TYPE REGPTR: 0 ;6502 0 ;6800 -^D12,,0 ;8080/Z80 -^D8,,0 ;8008 -^D8,,0 -^D16,,0 ;1802 0 ;F8 CHKTAB (REGPTR) REGTBL: 0 ;6502 0 ;6800 MOVE SYM,REGM80(PC) ;8080/Z80 MOVE SYM,REGM88(PC) ;8008 MOVE SYM,REGM08(PC) MOVE SYM,REGM18(PC) ;1802 0 ;F8 CHKTAB (REGTBL) GETEDT: ;GET ED TYPE CALL GSARG ;TRY FOR ARGUMENT RETURN ; MISSED HLLZS SYM MOVSI T3,- ;SET FOR SEARCH CAME SYM,EDTBL(T3) ;MATCH? AOBJN T3,.-1 ; NO SETZM T1 SKIPL T3 ;FOUND? ERRSKP ERR.A ; NO, ERROR MOVEI T1,1 ;YES, SET FLAG LSH T1,0(T3) ;COMPUTE BIT POSITION JRST CPOPJ1 DEFINE EDTGEN (SYM) < ED.'SYM== 1_. GENM40 > EDTBL: PHASE 0 EDTGEN EDTGEN EDTGEN EDTGEN EDTGEN EDTGEN EDTGEN EDTGEN EDTGEN EDTGEN EDTGEN EDTGEN EDTGEN EDTGEN EDTGEN DEPHASE EDTBLE: .LOC EDBLK: EDFLGS: BLOCK 1 ;FLAGS EDMSK: BLOCK 1 ;MASK EDLVL: BLOCK 1 ;LISTING LEVEL ERRSUP: BLOCK 1 EDLEN== .-EDBLK EDSAVE: BLOCK EDLEN ;STORAGE FOR ABOVE .RELOC SUBTTL LOCAL SYMBOL HANDLERS LSBTST: SKPEDR ED.LSB RETURN TLNE FLG,LSBFLG LSBINC: ;LOCAL SYMBOL BLOCK INCREMENT AOS LSBNUM ;INCREMENT BLOCK NUMBER MOVEI T3,LSRNGE-1 ADD T3,PC MOVEM T3,LSBMAX ;SET MAX RANGE MOVEI T3,^D64-1 MOVEM T3,LSBGEN ;PRESET GENERATED SYMBOL NUMBER TLZ FLG,LSBFLG RETURN .LOC LSBNUM: BLOCK 1 LSBGEN: BLOCK 1 LSBMAX: BLOCK 1 ;MAX RANGE .RELOC SUBTTL LISTING CONTROL .LIST: TDZA T3,T3 ; ".LIST" DIRECTIVE .NLIST: MOVEI T3,1 ; ".NLIST" DIRECTIVE HRLM T3,0(P) ;SAVE FLAG .LIST1: CALL GETLCT ;ARGS, GET ONE JRST .LIST2 ; BRANCH IF NULL HLRZ T2,0(P) ;GET INDEX MOVE T3,LCMSK ;SET REGS TLNN EXF,MODBIT ;COMMAND STRING? TDOA T3,T1 ; YES, SET MASK AND SKIP TDNN T3,T1 ;NO, SUPPRESSED? XCT [EXP ,](T2) SETZM T1 MOVEM T3,LCMSK JRST .LIST1 .LIST2: SKIPE ARGCNT ;END, ANY ARGS? JRST LPTINF HLRZ T2,0(P) ;SET INDEX TLNE EXF,MODBIT ;COMMAND STRING? JRST .LIST3 ; NO SETOM T3 XCT [EXP , ](T2) RETURN .LIST3: XCT [EXP ,](T2) .LIST4: SKPLCR LC.LD ;LISTING DIRECTIVE SUPPRESSED? SETOM LCLVLB ; YES, FLAG IT RETURN SETLC0: ;"SETLCT" OPDEF EXCH T3,LCTST ;FETCH TEST WORD TRO T3,@.JBUUO ;SET BIT(S) EXCH T3,LCTST ;RESTORE RETURN .PAGE: HRROS FFCNT JRST .LIST4 GETLCT: ;GET LC TYPE CALL GSARG ;TRY FOR ARGUMENT RETURN ; MISSED MOVSI T3,- ;SET FOR SEARCH CAME SYM,LCTBL(T3) ;MATCH? AOBJN T3,.-1 ; NO SETZM T1 SKIPL T3 ;FOUND? ERRSKP ERR.A ; NO, ERROR MOVEI T1,1 ;YES, SET FLAG LSH T1,0(T3) ;COMPUTE BIT POSITION JRST CPOPJ1 DEFINE LCTGEN (SYM) < LC.'SYM== 1_. GENM40 > LCTBL: PHASE 0 LCTGEN LCTGEN LCTGEN LCTGEN LCTGEN LCTGEN LCTGEN LCTGEN LCTGEN LCTGEN LCTGEN LCTGEN LCTGEN LCTGEN LCTGEN LCTGEN DEPHASE LCTBLE: .LOC LCBLK: LCFLGS: BLOCK 1 ;FLAGS LCMSK: BLOCK 1 ;MASK LCLVL: BLOCK 1 ;LISTING LEVEL LCLEN== .-LCBLK LCSAVE: BLOCK LCLEN ;STORAGE FOR ABOVE LCTST: BLOCK 1 ;TEST WORD LCLVLB: BLOCK 1 .RELOC SUBTTL CONDITIONALS .IIF: ;IMMEDIATE IF CALL CNDSET CALL TCON ;TEST ARGS JRST .IIF1 ;FALSE MOVE T2,LBP ;FETCH CHARACACTER POINTER CAIN CHR,"," ;SITTING ON COMMA? IBP T2 ; YES, MOVE ONE CHAR PAST CALL TGARG ;TEST FOR ARG JRST OPCERR ; MISSING, ERROR SKIPE T3,CLILBL ERRSET ERR.Q SKPLCR LC.CND MOVEM T2,CLIPNT ;SAVE NEW START JRST STMNT .IIF1: TLO FLG,NQEFLG ;UNSAT, IGNORE REST OF LINE JRST .ENDCX .IFZ: .IFEQ: .IFNZ: .IFNE: .IFG: .IFGT: .IFL: .IFLT: .IFGE: .IFLE: .IFDF: .IFNDF: CALL CNDSET ;TEST LABEL HRLZS SYM ;LEFT JUSTIFY ARGUMENT SKIPE CNDWRD ;SUPPRESSED? TLOA FLG,NQEFLG ; YES, BUMP LEVEL BUT IGNORE CALL TCONF ;NO, PROCESS ARGUMENT JRST CNDXF ; FALSE JRST CNDXT ;TRUE .IF: ;".IF" DIRECTIVE CALL CNDSET SKIPE CNDWRD ;SUPPRESSED? TLOA FLG,NQEFLG ; YES, BUMP LEVEL BUT IGNORE CALL TCON ;TEST CNDXF: SKIPA T3,[-1] ;FALSE CNDXT: SETZM T3 MOVE T4,CNDMSK LSHC T3,-1 ;SET HIGH ORDER BIT OF MASK MOVEM T4,CNDMSK MOVE T4,CNDWRD LSHC T3,-1 ;DITTO FOR TEST WORD MOVEM T4,CNDWRD AOS VAL,CNDLVL ;BUMP LEVEL JRST .ENDCF .IFT: SKIPA T3,CNDMSK ;".IFT" .IFF: SETCM T3,CNDMSK ;".IFF" CAIA .IFTF: SETZM T3 HLLM T3,0(P) ;PROTECT IT CALL CNDSET ;TEST FOR LABEL LDB T3,[POINT 1,0(P),0] ;GET SIGN BIT DPB T3,[POINT 1,CNDWRD,0] JRST .ENDCX .ENDC: ;".ENDC" DIRECTIVE SKIPG CNDLVL ;IN CONDITIONAL? JRST OPCERR ; NO MOVE T3,CNDMSK LSH T3,1 ;MOVE MASK BITS DOWN MOVEM T3,CNDMSK MOVE T3,CNDWRD LSH T3,1 ;DITTO FOR TEST WORD MOVEM T3,CNDWRD SOS VAL,CNDLVL .ENDCF: HRLI VAL,1 ;PRINT BYTE CALL SETPF1 .ENDCX: SKIPG LCLVL SKPLCS LC.CND RETURN SKIPN T3,CLILBL SETLCT LC.CND MOVEM T3,CLIPNT+1 RETURN CNDSET: ;SET PRIOR CONDITIONS SKPLCR LC.CND ;CONDITIONAL SUPPRESSION? SKIPE CNDWRD ;SKIP IF IN SAT MODE SETZM CLILBL RETURN ;NO TCON: ;TEST CONDITIONAL CALL GSARG ;TEST FOR ARGUMENTS JRST TCON2 ; NO, ERROR TCONF: SETZM CNDREQ ;CLEAR "REQUEST" SETZM CNDRES ; AND RESULT MOVSI T1,- ;SET FOR SCAN TCON1: HLLZ T2,TCONT(T1) ;TRY LEFT HALF CAMN SYM,T2 ;MAKE IT? JRST TCON4 ; YES HRLZ T2,TCONT(T1) ;NO, TRY RIGHT HALF CAMN SYM,T2 JRST TCON3 AOBJN T1,.+1 AOBJN T1,TCON1 ;LOOP IF NOT END TCON2: ERRSET ERR.A ;NO MATCH, ERROR RETURN TCON3: SETOM CNDREQ ;RIGHT HALF, "FALSE" TCON4: MOVE T2,TCONT+1(T1) ;FOUND, GET ADDRESS HLLZM T2,CNDINS ;SAVE POSSIBLE INSTRUCTION CALL 0(T2) ;CALL HANDLER MOVE T3,CNDREQ ;GET REQUEST CAMN T3,CNDRES ;MATCH? AOS 0(P) ; YES, SKIP-RETURN RETURN DEFINE GTCON (SYM,ADDR) < GENM40 ADDR > TCONT: GTCON , GTCON , GTCON , GTCON , GTCON , GTCON , GTCON , GTCON , GTCON , GTCON , GTCON
  • , GTCON , TCONTE: TCONA: ;ARITHMETIC CONDITIONALS CALL TGARG ;TEST FOR ARGUMENT ERRSET ERR.A ; NULL, ERROR CALL ABSEXP ;EVALUATE THE EXPRESSION HRROS ARGCNT LSH VAL,+^D<36-16> ASH VAL,-^D<36-16> ;EXTEND SIGN XCT CNDINS ;EXECUTE INSTRUCTION SETOM CNDRES ; FALSE RETURN TCONS: ;TEST SYMBOLIC CONDITIONALS CALL TGARG ;TEST FOR ANOTHER ARG ERRSET ERR.A ; NO, ERROR MOVE T1,CNDREQ MOVEM T1,CNDRES SPUSH CNDREQ TCONS1: CALL GETSYM SKIPN SYM ERRSKP ERR.A CALL SSRCH ;SEARCH THE SYMBOL TABLE SETZ T1, ; NOT THERE OR GETSYM ERROR SKIPE SYM CALL CRFREF TLNE T1,MDFSYM ERRSET ERR.D ;FLAG IF MULTI-DEFINED SYM TLNE T1,DEFSYM ;FLAGGED AS DEFINED? TDZA T1,T1 SETOM T1 SPOP SYM CAME T1,CNDRES SETCAM SYM,CNDRES MOVE T1,CNDREQ CAIN CHR,"&" JRST TCONS2 CAIE CHR,"!" RETURN SETCA T1, TCONS2: SPUSH T1 CALL GETNB JRST TCONS1 TCONB: ;.IFB, .IFNB CALL TGARG RETURN ; NO ARG, OK CALL GGARG CALL SETNB ;BYPASS ALL BLANKS CAIE CHR,0 SETOM CNDRES JRST PGARG TCOND: CALL TGARG ERRSET ERR.A CALL GGARG SPUSH ARGBEG HRRZ Q1,ARGCHC ;PICK UP CHARACTER COUNT JUMPE Q1,TCOND2 ;JUMP IF ARGUMENT IS NON-NULL MOVE SYM,CHR GETCHR JUMPN CHR,.-2 TCOND2: GETNB CALL TGARG ERRSET ERR.A CALL GGARG SPOP SYM TCOND1: SETCHR IBP LBP MOVE T2,CHR EXCH SYM,LBP SETCHR IBP LBP EXCH SYM,LBP CAME T2,CHR SOSA CNDRES ;MISSED JUMPN CHR,TCOND1 CALL PGARG SPUSH LBP ;END OF SECOND ARGUMENT CALL PGARG ;RESTORE FIRST ARGUMENT SPOP LBP JRST SETCHR ;SET FINAL CHARACTER TCONL: CALL GETLCT JRST TCONL1 SKPLCR 0(T1) SETOM CNDRES RETURN TCONL1: SKIPGE LCLVL SETOM CNDRES RETURN TCONED: CALL GETEDT JFCL SKPEDS 0(T1) SETOM CNDRES RETURN TCONP: TLNN FLG,P1F ;PASS 1? SETOM CNDRES ;NO - PASS 2 RETURN .LOC CNDMSK: BLOCK 1 ;MASK BITS SET BY .IF CNDWRD: BLOCK 1 ;CNDMSK, ADJUSTED FOR .IFT, ETC. CNDLVL: BLOCK 1 ;CONDITIONAL LEVEL COUNT CNDREQ: BLOCK 1 ;CONDITIONAL "REQUEST" TYPE CNDRES: BLOCK 1 ;RESULT CNDINS: BLOCK 1 ;STORAGE FOR INSTRUCTION CNDMEX: BLOCK 1 ;MEXIT IN PROGRESS .RELOC SUBTTL MACRO STORAGE HANDLERS GETBLK: ;GET A BLOCK FOR MACRO STORAGE SKIPE T1,NEXT ;ANY REMNANTS OF GARBAGE COLLECTION? JRST GETBL1 ; YES, RE-USE MOVEI T1,WPB ADDB T1,.JBFF ;UPDATE FREE LOCATION POINTER CAML T1,SYMBOT ;ANY ROOM? CALL GETCOR ; NO, GET MORE CORE SUBI T1,WPB ;POINT TO START OF BLOCK SETZM WPB-1(T1) ;CLEAR VECTOR GETBL1: HLL T1,TXTBYT ;FORM BYTE POINTER MOVEM T1,MWPNTR ;SET NEW BYTE POINTER HRLI T1,- ;GET SET TO INITIALIZE BLOCK SETOM 0(T1) ;CLEAR ENTRY AOBJN T1,.-1 ;SET ALL EXCEPT LAST TO -1 PUSH P,0(T1) ;GET TOP POP P,NEXT ;SET FOR NEXT BLOCK SETZM 0(T1) ;CLEAR LAST WORD MOVE T1,MWPNTR ;RETURN POINTER IN T1 RETURN ;EXIT TXTBYT: POINT 8,,7 ASCBYT: POINT 7,,6 INCMAC: ;INCREMENT MACRO STORAGE AOSA 0(T1) DECMAC: ;DECREMENT MACRO STORAGE SOSL 0(T1) ;TEST FOR END RETURN ; NO, EXIT REMMAC: ;REMOVE MACRO STORAGE SPUSH T1 ;SAVE POINTER REMMA1: HRLS T1 ;SAVE CURRENT POINTER HRR T1,WPB-1(T1) ;GET NEXT LINK TRNE T1,-1 ;TEST FOR END (NULL) JRST REMMA1 ; NO HLRZS T1 ;YES, GET RETURN POINTER HRL T1,NEXT ;GET CURRENT START OF CHAIN HLRM T1,WPB-1(T1) ;STORE AT TOP SPOP T1 ;RESTORE BORROWED REGISTER HRRZM T1,NEXT ;SET NEW START RETURN ;EXIT .LOC NEXT: BLOCK 1 ;BLOCK CHAIN POINTER MWPNTR: BLOCK 1 ;MACRO WRITE POINTER .RELOC SUBTTL REPEAT/MACRO ROUTINES CF.SPC== 200 ;HIGH ORDER BIT INVOKES SPECIAL MODE CF.DSY== 100 ;DUMMY SYMBOL CF.TRP== 040 ;FLAGS END OF PROTOTYPE CF.ARG== 020 ;TRAPPED AT READMC/SETASC CH.MAC== CF.SPC!CF.TRP!T.MACR ;END OF MACRO CH.RPT== CF.SPC!CF.TRP!T.REPT ;END OF REPEAT CH.IRP== CF.SPC!CF.TRP!T.IRP ;END OF IRP CH.EOE== CF.SPC!CF.ARG!1 ;END OF ENTRY CH.FIN== CF.SPC!CF.ARG!2 ;IRP ARG DELIMITER ; THIS MACRO PUSHES THE ITERATION COUNT FOR REPEAT BLOCKS ONTO A PSEUDO-STACK CALLED REPBLK. ;THE POINTER IS CALLED REPCT. THE COUNT IS ASSUMED TO BE IN REGISTER 'REG'. DEFINE RCTPSH (REG) < AOS REPCT ;PUSH THE POINTER MOVEM REG,@REPCT ;STACK THE COUNT AOS @REPCT ;COMPENSATE FOR THE XTRA ENDM THAT WILL BE SEEN SETOM REPSW ;TELL EVERYBODY WE'RE IN A REPEAT BLOCK > .REPT: ;.REPT DIRECTIVE CALL ABSEXP ;EVALUATE ABSOLUTE EXPRESSION TRNE VAL,1B20 ;NEGATIVE? SETZM VAL ; YES, SET TO ZERO RCTPSH VAL ;PUSH THE COUNT SPUSH VAL ;SAVE PUSH P,[0] ;TO KEEP .RIF HAPPY .REPTF: CALL GETBLK ;GET STORAGE PUSH P,MWPNTR ;SAVE STARTING LOCATION SETZM @MWPNTR ;CLEAR LEVEL COUNT AOS MWPNTR ;START IN NEXT WORD SETZM @MWPNTR ;CLEAR SECOND WORD AOS MWPNTR CALL TMCLBL SETLCT LC.MD!LC.MC ;FLAG AS CALL SETZM MACCNT ;INIT ARG COUNT .REPT1: CALL ENDL CALL GETMLI ;GET A LINE SETLCT LC.MD!LC.MC ;FLAG FOR LISTING CAIN T3,DCRPT AOS MACCNT CAIN T3,DCRPTE SOSL MACCNT ;TEST FOR END TLNE FLG,ENDFLG ;OR END OF INPUT JRST .REPT2 ; YES MOVE LBP,LINPNT SETCHR CAIA GETCHR ;STORE LINE WCIMT 0(CHR) JUMPN CHR,.-2 ;TEST FOR EOL JRST .REPT1 .REPT2: MOVEI CHR,CH.RPT .REPTX: WCIMT 0(CHR) ;MARK END OF STORAGE CALL MPUSH ;STACK POP P,MSBTXP ;SET TEXT POINTER POP P,MSBAUX ; AND .RIF EXPRESSION POP P,MSBCNT ; AND COUNT HRLZS MSBCNT ;MOVE COUNT TO LEFT HALF JRST MPOP ;TEST FOR END ENDRPT: ;END OF REPEAT ENDIRP: AOS T3,MSBCNT ;BUMP COUNT, PLACE IN REG HLRZ T4,T3 ;GET END VALUE CAIGE T4,0(T3) ;FINISHED? JRST CPOPJ1 ; YES MOVE T3,MSBTXP ;NO, SET READ POINTER ADDI T3,2 MOVEM T3,MSBMRP RETURN .ENDM: .ENDR: JRST OPCERR ;CAN'T OCCUR OUTSIDE OF DEFINITION .IRP: TDZA T3,T3 ;".IRP", CLEAR FLAG .IRPC: MOVEI T3,1 ;".IRPC", SET FLAG ADDI T3,1 MOVEM T3,IRPTYP ;STORE IT CALL TGARG ;TEST FOR GENERAL ARGUMENT JRST OPCERR ; MISSING, ERROR CALL GGARG ;PROCESS THE ARGUMENT SETZM ARGCNT CALL PROMA ;PROCESS DUMMY ARGS CALL PGARG SETZM IRPCNT SETZM IRPMAX CALL GETBLK MOVEM T1,IRPBEG ;SAVE START .IRP1: AOS T3,IRPCNT ;BUMP COUNT HRRZ T4,MACCNT ;GET ARGUMENT COUNT CAMLE T3,T4 ;THROUGH? JRST .IRP2 ; YES CALL TGARG JFCL CALL GGARG CALL MCFINF WCIMT CH.FIN HRRZ T3,ARGCNT CAMLE T3,IRPMAX MOVEM T3,IRPMAX CALL PGARG JRST .IRP1 .IRP2: WCIMT CH.FIN EXCH ASM,IRPMAX ;GET THE ITERATION COUNT WHERE WE CAN USE IT AND..... RCTPSH ASM ;PUSH IT ONTO THE 'STACK' EXCH ASM,IRPMAX ;NOW PUT THINGS BACK WHERE THEY BELONG. SPUSH IRPMAX SPUSH IRPBEG CALL TMCLBL SETLCT LC.MD!LC.MC CALL ENDL ;POLISH OFF LINE CALL GETBLK SPUSH MWPNTR CALL PROMT ;PROCESS TEXT SETLCT LC.MD!LC.MC ;ARGUMENT MOVEI CHR,CH.IRP ;MARK AS .IRP JRST .REPTX ;EXIT THROUGH .REPT .MACR: ;.MACR DIRECTIVE .MACRO: CALL GSARG ;GET THE NAME JRST OPCERR MACROF: MOVEM SYM,MACNAM ;SAVE NAME CALL MSRCH MOVSI T1,MAOP ;RETURN POINT IF NAME NOT FOUND LDB T2,TYPPNT ;ISOLATE TYPE CAIE T2,MAOP ;MACRO? JRST OPCERR ; NO, ERROR TRNE T1,-1 CALL DECMAC HLLM T1,0(P) ;SAVE FLAGS, ETC. CALL GETBLK HLL T1,0(P) ;RESTORE FLAGS CALL INSRT CALL CRFOPD CALL PROMA ;PROCESS MACRO ARGUMENTS CALL TMCLBL SETLCT LC.MD CALL ENDL ;WRITE OUT THE LINE CALL PROMT ;PROCESS MACRO TEXT SETLCT LC.MD ; ARGUMENT WCIMT CH.MAC ;FLAG END CALL GSARG ;ARGUMENT? RETURN ; NO CAME SYM,MACNAM ;YES, DOES IT MATCH NAME? ERRSET ERR.A ; NO, ERROR RETURN PROMA: ;PROCESS MACRO ARGUMENTS SETZM DSYLST ;MARK END OF LIST SETZM MACCNT ;ZERO NUMBER PROMA1: CALL TGARG ;TEST FOR ARGUMENT RETURN ; NO CAIE CHR,"?" ;YES, PERHAPS GENERATION? JRST PROMA2 ;NO MOVN T3,MACCNT ;YES, GET COUNT MOVSI T4,(1B0) LSH T4,0(T3) ;SHIFT BIT IORM T4,MACCNT ;SAVE IT CALL GETNB ;BYPASS UNARY PROMA2: CALL GSARGF ;GET THE ARGUMENT RETURN ; ERROR AOS T3,MACCNT ;OK, BUMP COUNT MOVEM SYM,DSYLST-1(T3) ;STORE MNEMONIC SETZM DSYLST(T3) JRST PROMA1 ;TRY FOR MORE TMCLBL: MOVE T3,@0(P) SKPLCR (T3) SKIPN T3,CLILBL RETURN MOVEM T3,CLIPNT+1 JRST CPOPJ1 PROMT: ;PROCESS MACRO TEXT SETZB T3,@MWPNTR ;CLEAR LEVEL COUNT AOS MWPNTR EXCH T3,MACCNT ;SET AND CLEAR COUNT MOVEM T3,@MWPNTR AOS MWPNTR PROMT1: CALL GETMLI ;PUTS THE TYPE BITS IN AC3 XCT @0(P) ;EXECUTE ARGUMENT CAIN T3,DCMAC ;MACRO/RPT TYPE INSTRUCTION? AOS MACCNT ;YES CAIN T3,DCMACE ;END? SOSL MACCNT ;YES TLNE FLG,ENDFLG ;END ENCOUNTERED? JRST CPOPJ1 ;YES. RETURN AND BYPASS ARGUMENT CAIN T3,DCMCAL ;".MCALL"? SKIPN MCACNT ; YES, NESTED? CAIA ; NO CALL MCALLT ;YES, TEST FOR ADDITIONS MOVE LBP,LINPNT SETCHR PROMT2: CALL GETSYM JUMPE SYM,PROMT4 SETZM T2 PROMT3: SKIPN T3,DSYLST(T2) JRST PROMT4 CAME T3,SYM AOJA T2,PROMT3 SOS CONCNT WCIMT CF.SPC!CF.DSY+1(T2) SOS CONCNT SKIPA LBP,SYMEND PROMT4: MOVE LBP,SYMBEG SETCHR PROMT5: CAMN LBP,SYMEND JRST PROMT6 WCIMT 0(CHR) GETCHR JRST PROMT5 PROMT6: JUMPE CHR,PROMT8 SKPEDR ED.COM CAIE CHR,";" JRST PROMT7 GETCHR CAIN CHR,";" JRST PROMT8 WCIMT ";" JRST PROMT2 PROMT7: CAIN CHR,"'" AOSA CONCNT WCIMT 0(CHR) GETCHR JRST PROMT2 PROMT8: WCIMT 0 SKIPE ARGEND HALT . SETCHR SKIPGE MACCNT JRST GETSYM CALL ENDL JRST PROMT1 MACROC: ;MACRO CALL CALL SETPF0 TRNN T1,-1 ;EMPTY? JRST OPCERR ;OP VALUE = 0? SPUSH T1 ;STACK ADDRESS MOVE T3,1(T1) MOVEM T3,MACCNT ;SET COUNT CALL INCMAC CALL GETBLK SPUSH MWPNTR ;STACK START ADDRESS CALL MCFIN WCIMT CH.FIN ;PAD ANY MISSING ARGUMENTS MOVEI CHR,CH.MAC CALL MPUSH POP P,MSBAUX SPOP T1 HLL T1,TXTBYT MOVEM T1,MSBTXP ADDI T1,2 MOVEM T1,MSBMRP MOVE T3,ARGCNT HRLZM T3,MSBCNT ;SET FOR ".NARG" CALL TMCLBL SETLCT LC.MC RETURN MCFIN: SETZM IRPTYP MCFINF: SETZM ARGCNT SETZM ARGINC MCFIN1: MOVE T3,IRPTYP CALL @[EXP MCFMAC, MCFIRP, MCFIRC](T3) RETURN WCIMT CH.EOE JRST MCFIN1 MCFIRC: JUMPE CHR,MCFIRX WCIMT 0(CHR) AOS ARGCNT GETCHR JRST CPOPJ1 MCFMAC: MOVE T3,ARGCNT ADD T3,ARGINC SUB T3,MACCNT TRNN T3,(1B0) RETURN MCFIRP: CALL TGARG MCFIRX: AOSA ARGINC JRST MCFOK CALL MCFGEN SKIPN IRPTYP JRST CPOPJ1 RETURN MCFOK: AOS 0(P) ;ALL GOOD EXITS NOW CAIN CHR,"\" ;TEST UNARIES JRST MCFOK2 CALL GGARG JUMPE CHR,MCFOK1 WCIMT 0(CHR) GETCHR JUMPN CHR,.-2 JRST PGARG MCFOK1: CALL MCFGEN JFCL JRST PGARG MCFOK2: CALL GETNB ;"\", BYPASS CAIN CHR,"\" ;DOPBLE? JRST MCFOK3 ; YES CALL ABSEXP ;NO, EVALUATE EXPRESSION HRROS ARGCNT MOVE T3,VAL ;SET MOVE T1,CRADIX ;SET CHARACTERISTICS HRLI T1,"0" JRST MCFDIV MCFOK3: CALL GETNB ;BYPASS SECOND "\" CALL ABSEXP HRROS ARGCNT MOVE SYM,VAL ;GET VALUE CALL M40SIX ;CONVERT TO SIXBIT MOVE T3,SYM MOVE T1,[XWD 40,100] JRST MCFDIV MCFDIV: IDIVI T3,0(T1) ;DIVIDE NUMBER HRLM T4,0(P) ;STACK REMAINDER SKIPE T3 ;ANY MORE? CALL MCFDIV ; YES HLRZ T3,0(P) ;NO,RETRIEVE NUMBER HLRZ T4,T1 ;GET CONSTANT ADD T3,T4 ;ADD IT IN WCIMT 0(T3) ;STORE IT RETURN MCFGEN: ;GENERAT SYMBOL HLLZ T3,MACCNT MOVE T4,ARGCNT ADD T4,ARGINC LSH T3,-1(T4) JUMPE T3,CPOPJ JUMPG T3,CPOPJ1 AOS T3,LSBGEN ;BUMP GENERATED SYMBOL NUMBER MOVE T1,[XWD "0",^D10] ;SET CHARACTERISTICS CALL MCFDIV ;OUTPUT WCIMT "$" ;COMPLETE GENED SYMBOL JRST CPOPJ1 .NARG: CALL GSARG ;FETCH SYMBOL JRST OPCERR ; MISSING, ERROR SPUSH SYM ;STACK THE SYMBOL HLRZ VAL,MSBCNT ;GET COUNT JRST ASGMTF ;EXIT THROUGH "=" .NCHR: CALL GSARG ;GET THE SYMBOL JRST OPCERR ; MISSING, ERROR SPUSH SYM ;OK, STACK IT CALL TGARG ;TEST FOR SECOND ARG JFCL ; EH? CALL GGARG ;FETCH THE ARG SPUSH ARGCHC ;SAVE COUNT CALL PGARG ;FLUSH STORAGE SPOP VAL ;COUNT TO VAL HRRZS VAL JRST ASGMTF ;EXIT THROUGH "=" .NTYPE: CALL GSARG ;GET THE SYMBOL JRST OPCERR ; MISSING, ERROR SPUSH SYM ;OK, STACK IT CALL TGARG ;TEST FOR SECOND ARG JFCL ; EH? CALL M65AEX ;PROCESS ADDRESS EXPRESSION JFCL HRRZ VAL,T4 ;GET TYPE CODE TLNE T4,(AM%ACC) ;ACCUMULATOR JRST [MOVEI VAL,.M65RG JRST .NTYP1] ;TYPE := IMPLIED CAILE VAL,.M65A3 ;ZERO PAGE TYPES? JRST .NTYP1 ;NO - DONE TLNE T4,(AM%ZP) ;ADDRS .LE. $FF ADDI VAL,.M65ZO ;YES - SAY SO .NTYP1: SETZM CODPNT ;CLEAR CODE ROLL SETZM CODBUF JRST ASGMTF ;EXIT THROUGH "=" .MCALL: CALL MCALLT ;TEST ARGUMENTS SKIPN MCACNT RETURN TLNE FLG,P1F SKIPN T3,JOBFFM JRST MCALL6 EXCH T3,.JBFF INBUF MAC,NUMBUF MOVEM T3,.JBFF MOVE T3,[XWD MACLUP,MACFIL] BLT T3,MACPPN LOOKUP MAC,MACFIL ;TRY FOR SYSMAC IN USER UFD. PRESENT? CAIA ;NO JRST MCALL3 ;YES MOVE T3,SYSPPN ;NOT FOUND. SET UP FOR SEARCH IN SYS: MOVEM T3,MACPPN ;* LOOKUP MAC,MACFIL ;TRY AGAIN. GOOD? JRST MCALL6 ;NOPE. MCALL3: SETZM MCATMP MCALL4: CALL GETMLI TLNE FLG,ENDFLG JRST MCALL6 CAIN T3,DCMACE SOS MCATMP CAIE T3,DCMAC JRST MCALL4 AOS T3,MCATMP CAIE T3,1 JRST MCALL4 CALL GSARG JRST MCALL3 CALL MSRCH CAIA TRNE T1,-1 JRST MCALL4 CALL MACROF TLNE FLG,ENDFLG JRST MCALL6 SOSLE MCACNT JRST MCALL3 JRST MCALL7 MCALL6: ERRSET ERR.A MCALL7: SETZM MCACNT TLZ FLG,ENDFLG RETURN MCALLT: CALL GSARG ;GET NEXT ARGUMENT RETURN ; END, EXIT CALL MSRCH ;FOUND, ALREADY PROCESSED? AOSA MCACNT ; NO, INCREMENT COUNT AND SKIP JRST MCALLU ; YES, IGNORE MOVSI T1,MAOP ;FLAG AS MACRO CALL INSRT ;INSERT MCALLU: CALL CRFOPD JRST MCALLT MACLUP: SIXBIT /SYSMAC/ SIXBIT /SML/ EXP 0 XWD 0,0 .LOC MACFIL: BLOCK 1 MACEXT: BLOCK 1 BLOCK 1 MACPPN: BLOCK 1 JOBFFM: BLOCK 1 MCACNT: BLOCK 1 ;MACRO CALL COUNT MCATMP: BLOCK 1 MACBUF: BLOCK 1 MACPNT: BLOCK 1 BLOCK 1 .RELOC SUBTTL MACRO STORAGE HANDLERS WCIMT0: ;WRITE CHARACTER IN MACRO TREE SPUSH T2 ;STACK WORK REGISTER MOVEI T2,@.JBUUO ;FETCH ARG SOSL CONCNT ;ANY CONCATENATION CHARS? WCIMT "'" ;YES, WRITE THEM SETZM CONCNT ;CLEAR COUNT JUMPN T2,WCIMT1 ;BRANCH IF NON-DELIMITER MOVEI T2,LF WCIMT1: CALL WCIMT2 ;WRITE IT SPOP T2 RETURN WCIMT2: TRNN T2,177 ;ATTEMPT TO WRITE A NULL? HALT . ; YES, NASTY SKIPN @MWPNTR ;END OF BLOCK? JRST WCIMT3 ; YES, GET ANOTHER DPB T2,MWPNTR ;NO, STORE BYTE IBP MWPNTR ;POINT TO NEXT BYTE RETURN ;EXIT WCIMT3: SPUSH T1 PUSH P,MWPNTR ;NEAD A NEW BLOCK, SAVE CURRENT POINTER CALL GETBLK ;GET IT HRRZS T1 ;GET START OF NEW BLOCK EXCH T1,0(P) ;EXCHANGE WITH POINTER TO LAST POP P,0(T1) ;STORE VECTOR SPOP T1 JRST WCIMT2 ;TRY AGAIN READMC: ;READ MACRO CHARACTER CALL READMB ;GET A MACRO BYTE READMF: TRNN CHR,CF.SPC ;SPECIAL? JRST CPOPJ1 ; NO TRNE CHR,CF.DSY ;YES, DUMMY SYMBOL? JRST READM1 ; YES TRNE CHR,CF.TRP ;END OF SOMETHIN? JRST MPOP ; YES TRNE CHR,CF.ARG ;NO, CHAR TRAP AT THIS LEVEL? SKIPN T3,CALSAV JRST CPOPJ1 MOVEM T3,MSBMRP SETZM CALSAV JRST READMC READM1: TRZ CHR,CF.SPC!CF.DSY MOVE T3,MSBAUX EXCH T3,MSBMRP MOVEM T3,CALSAV MOVE T4,MSBTYP CAIE T4,CH.IRP ;IRP? JRST READM5 ; NO MOVEI T4,0(CHR) READM2: SOJLE T4,READM4 READM3: CALL READMB CAIE CHR,CH.FIN JRST READM3 JRST READM2 READM4: HRRZ CHR,MSBCNT READM5: MOVEI T4,0(CHR) ;GET COUNT READM6: SOJLE T4,READMC READM7: CALL READMB CAIN CHR,CH.FIN JRST READMF CAIE CHR,CH.EOE JRST READM7 JRST READM6 READMB: ;READ MACRO BYTE LDB CHR,MSBMRP ;GET CHARACTER IBP MSBMRP JUMPN CHR,CPOPJ ;EXIT IF NON-NULL MOVE CHR,MSBMRP MOVE CHR,0(CHR) ;END OF BLOCK, GET LINK HLL CHR,TXTBYT ;FORM BYTE POINTER MOVEM CHR,MSBMRP JRST READMB ;TRY AGAIN .MEXIT: SKIPN MSBTYP ;IN MACRO? JRST OPCERR ; NO, ERROR SETOM CNDMEX ;SET FLAG RETURN MPUSH: CALL GETBLK MOVSI T3,- PUSH P,MWPNTR MPUSH1: SETZM T4 EXCH T4,MSBTYP(T3) MOVEM T4,@MWPNTR AOS MWPNTR AOBJN T3,MPUSH1 MOVEM CHR,MSBTYP POP P,MSBPBP AOS MSBLVL RETURN MPOP: SKIPN MSBLVL HALT . CAMN CHR,MSBTYP JRST MPOP1 CALL MPOP1 ERRSET ERR.A JRST MPOP MPOP1: TRC CHR,CF.SPC!CF.TRP CAIL CHR,T.MIN CAILE CHR,T.MAX HALT . SKIPN REPSW ;ARE WE INSIDE A REPEAT BLOCK? JRST MPOP3 ;NO, SO DON'T MESS AROUND SOSLE @REPCT ;DECREMENT THE TOP LEVEL OF THE STACK JRST MPOP4 ;IF WE'RE STILL IN THE TOP LEVEL, SPLIT. SETZM CNDMEX ;OTHERWISE, ENABLE CODE GENERATION AGAIN, SOS REPCT ;POP THE STACK, EXCH ASM,REPCT ;, CAIN ASM,REPBLK-1 ;AND SEE IF IT'S EMPTY. IS IT? SETZM REPSW ;YES, SO TELL FOLKS WE'RE NOT IN A REPEAT ANY MORE. EXCH ASM,REPCT ;NOW PUT THINGS BACK WHERE THEY BELONG CAIA MPOP3: SETZM CNDMEX MPOP4: SPUSH LBP XCT MPOPT(CHR) JRST MPOP2 SKIPE T1,MSBTXP CALL DECMAC SKIPE T1,MSBAUX CALL REMMAC SKIPN T1,MSBPBP HALT . MOVSI T3,0(T1) HRRI T3,MSBTYP BLT T3,MSBTYP+MSBLEN-1 CALL REMMAC SOS MSBLVL MPOP2: SPOP LBP RETURN MPOPT: PHASE 0 HALT . T.MIN== . T.MACR:!CAIA T.REPT:!CALL ENDRPT T.IRP:! CALL ENDIRP T.MAX== .-1 DEPHASE .LOC MSBTYP: BLOCK 1 MSBPBP: BLOCK 1 MSBTXP: BLOCK 1 MSBAUX: BLOCK 1 MSBMRP: BLOCK 1 MSBCNT: BLOCK 1 MSBLEN== .-MSBTYP CALSAV: BLOCK 1 MACCNT: BLOCK 1 MSBLVL: BLOCK 1 MACNAM: BLOCK 1 CONCNT: BLOCK 1 DSYLST: BLOCK ^D65 ;MACRO ARGUMENT STORAGE IRPTYP: BLOCK 1 ;1=IRP,2=IRPC IRPBEG: BLOCK 1 IRPCNT: BLOCK 1 IRPMAX: BLOCK 1 ARGINC: BLOCK 1 REPSW: BLOCK 1 ;SET NON-ZERO WHILE INSIDE IRP,IRPC,REPT REPCT: BLOCK 1 ;POINTER TO 'STACK' IN REPBLK. REPBLK: BLOCK ^D128 ;'STACK' FOR REPEAT ITERATION COUNTS .RELOC GGARG: SPUSH LBP ;SAVE START OF FIELD MOVEM LBP,SYM ;AND END MOVEI T1,0 ;ZERO CHARACTER COUNT CAIE CHR,"<" JRST GGARG2 SETZM T2 GETCHR MOVEM LBP,0(P) ;SAVE NEW START MOVEM LBP,SYM ; AND END GGARG1: JUMPE CHR,GGARG6 CAIN CHR,"<" AOS T2 CAIN CHR,">" SOJL T2,GGARG7 CALL GGARG9 JRST GGARG1 GGARG2: CAIE CHR,"^" JRST GGARG5 CALL GETNB CAILE CHR,40 CAILE CHR,137 JRST GGARG6 MOVE T2,CHR GETCHR MOVEM LBP,0(P) ;SAVE NEW START MOVEM LBP,SYM ; AND END GGARG3: JUMPE CHR,GGARG6 CAMN CHR,T2 JRST GGARG7 CALL GGARG9 JRST GGARG3 GGARG5: CAIE CHR,";" CAIN CHR,"," JRST GGARG8 CAIE CHR,SPACE CAIN CHR,TAB JRST GGARG8 JUMPE CHR,GGARG8 CALL GGARG9 JRST GGARG5 GGARG6: ERRSKP ERR.A GGARG7: GETCHR GGARG8: SPUSH SYM ;STACK END SPUSH T1 ; ANC COUNT SPUSH MWPNTR ;PROTECT POINTER CALL GETBLK ;GET STORAGE SPOP MWPNTR MOVE T2,T1 ;GET COPY OF STORAGE POINTER HRLI T2,ARGBLK BLT T2,ARGLEN-1(T1) ;ZIP CUREENT MOVEM T1,ARGPNT ;SET NEW POINTER SPOP ARGCHC ;SET COUNT SPOP ARGEND SPOP ARGBEG LDB T3,ARGEND HRLM T3,ARGCHC MOVEI T3,0 DPB T3,ARGEND MOVEM LBP,ARGTXP ;SAVE END OF FIELD MOVE LBP,ARGBEG ;SET TO START OF ARG JRST SETCHR ;SET IT GGARG9: GETCHR ;GET THE NEXT CHARACTER MOVEM LBP,SYM ;SET NEW END AOJA T1,CPOPJ ;INCREMENT COUNT AND EXIT PGARG: ;POP GENARAL ARGUMENT SKIPN LBP,ARGTXP ;SET TEXT POINTER HALT . SKIPN T1,ARGPNT ;GET POINTER TO PREVIOUS HALT . SKIPN ARGEND HALT . HLRZ T3,ARGCHC DPB T3,ARGEND HRLZ T3,T1 HRRI T3,ARGBLK BLT T3,ARGBLK+ARGLEN-1 ;XFER DATA CALL REMMAC ;RETURN BLOCK FOR DEPOSIT JRST SETNB ;SET NON-BLANK AND EXIT SUBTTL FLOATING POINT EVALUATOR FLTG: TLZ FLG,FLTFLG ;CLEAR ERROR FLAG SETZB SYM,FLTNUM SETZB T1,FLTNUM+1 SETZB T2,FLTNUM+2 SETZB T3,FLTNUM+3 CAIN CHR,"-" TLO SYM,(1B0) EXCH SYM,FLTNUM SKIPL FLTNUM CAIN CHR,"+" FLTG2: GETCHR CAIL CHR,"0" CAILE CHR,"9" JRST FLTG3 TLNE SYM,760000 AOJA T3,FLTG2 ASHC SYM,1 MOVEM SYM,FLTTMP MOVEM T1,FLTTMP+1 ASHC SYM,2 ADD SYM,FLTTMP ADD T1,FLTTMP+1 ADDI T1,-"0"(CHR) TLZE T1,(1B0) ADDI SYM,1 AOBJP T3,FLTG2 FLTG3: CAIE CHR,"." JRST FLTG4 TRNE T2,400000 TLO FLG,FLTFLG MOVEI T2,400000(T3) JRST FLTG2 FLTG4: SKIPN T3 TLO FLG,FLTFLG TRZN T2,400000 HRRZ T2,T3 HLRZS T3 SUB T2,T3 CAIE CHR,"E" JRST FLTG6 GETCHR SPUSH SYM SPUSH T1 SETZB SYM,T1 CAIN CHR,"-" TLOA T1,(1B0) CAIN CHR,"+" FLTG5: GETCHR CAIL CHR,"0" CAILE CHR,"9" JRST FLTG5A IMULI SYM,^D10 ADDI SYM,-"0"(CHR) AOJA T1,FLTG5 FLTG5A: TLZE T1,(1B0) MOVNS SYM SKIPN T1 TLO FLG,FLTFLG ADD T2,SYM SPOP T1 SPOP SYM FLTG6: CAIN T1,0 JUMPE SYM,FLTG12 TDZA T3,T3 FLTG7: ASHC SYM,1 TLNN SYM,200000 SOJA T3,FLTG7 JUMPL T2,FLTG9 FLTG8: SOJL T2,FLTG10 MOVEM SYM,FLTTMP MOVEM T1,FLTTMP+1 ASHC SYM,-2 ADD SYM,FLTTMP ADD T1,FLTTMP+1 TLZE T1,(1B0) ADDI SYM,1 TLNE SYM,(1B0) CALL FLTG20 ADDI T3,3 JRST FLTG8 FLTG9: CAML SYM,[^D10B4] CALL FLTG20 SPUSH T1+1 DIV SYM,[^D10B4] DIV T1,[^D10B4] SPOP T1+1 SUBI T3,4 AOJL T2,FLTG9 FLTG10: SPUSH T3 ;STACK EXPONENT MOVSI T2,(1B<16-7>) ;SET ONE WORD ROUNDING BIT SETZ T3, ;CLEAR LOW ORDER SKIPA T4,FLTLEN ;GET LENGTH AND SKIP ASHC T2,-^D16 ;MOVE ROUNDING MASK SOJG T4,.-1 TDNN SYM,T2 ;TEST FOR ROUNDING REQUIRED TDNE T1,T3 SKPEDR ED.FPT ;YES, ".ROUND" MODE? JRST FLTG11 ; NO, FORGET ROUNDING ASHC T2,1 ;SHIFT BIT UP ONE ADD SYM,T2 ADD T1,T3 ;ADD IN BIT FLTG11: SPOP T3 ;RESTORE EXPONENT TLZE T1,(1B0) ;OVERFLOW, LOW ORDER? ADDI SYM,1 ; YES, ADD TO UPPER TLNE SYM,(1B0) ;OVERFLOW, HIGH ORDER? CALL FLTG20 ; YES, CORRECT LSH T1,1 ;MOVE OVER SIGN BIT LSHC SYM,-7 ;MAKE ROOM FOR EXPONENT ADDI T3,^D<35+35+128> DPB T3,[POINT 8,SYM,8] LDB T2,[POINT 8,SYM,8] CAME T2,T3 ;OVER/UNDER FLOW? ERRSET ERR.T ; YES FLTG12: IOR SYM,FLTNUM MOVSI T2,-4 FLTG13: LDB T3,[POINT 16,SYM,15] MOVEM T3,FLTNUM(T2) LSHC SYM,^D16 AOBJN T2,FLTG13 JRST SETNB FLTG20: LSH T1,1 LSHC SYM,-1 LSH T1,-1 AOJA T3,CPOPJ .LOC FLTNUM: BLOCK 4 ;FLOATING POINT NUMBER FLTLEN: BLOCK 1 ;LENGTH FLTTMP: BLOCK 2 .RELOC SUBTTL SIXBIT/RAD50 CONVERSION ROUTINES SIXM40: ;SIXBIT TO RAD50 SPUSH T1 SPUSH T2 SPUSH T3 ;STACK REGISTERS SETZ T1, MOVSI T3,(POINT 6,SYM) SIXM41: ILDB T2,T3 ;GET A CHARACTER HLRZ T2,RADTBL(T2) ;MAP IMULI T1,50 ADD T1,T2 TLNE T3,770000 ;FINISHED? JRST SIXM41 ; NO IDIVI T1,50*50*50 ;YES, SPLIT INTO HALVES HRLZ SYM,T1 ;HIGH ORDER HRR SYM,T2 ; AND LOW ORDER SPOP T3 ;RESTORE REGISTERS SPOP T2 SPOP T1 RETURN M40SIX: ;RAD50 TO SIXBIT SPUSH T1 SPUSH T2 SPUSH T3 LDB T1,[POINT 16,SYM,17] IMULI T1,50*50*50 ;MERGE ANDI SYM,177777 ADD SYM,T1 SETZ T2, ;ACCUMULATOR MOVSI T3,-6 M40SI1: IDIVI SYM,50 HRRZ T1,RADTBL(T1) ;MAP LSHC T1,-6 ;MOVE INTO COLLECTOR AOBJN T3,M40SI1 ;TEST FOR END MOVE SYM,T2 SPOP T3 SPOP T2 SPOP T1 RETURN RADTBL: XWD <$==0>, 0 XWD 0, "A"-40 XWD 0, "B"-40 XWD 0, "C"-40 XWD <$$==33>, "D"-40 XWD 0, "E"-40 XWD 0, "F"-40 XWD 0, "G"-40 XWD 0, "H"-40 XWD 0, "I"-40 XWD 0, "J"-40 XWD 0, "K"-40 XWD 0, "L"-40 XWD 0, "M"-40 XWD <$.==34>, "N"-40 XWD 0, "O"-40 XWD <$0==36>, "P"-40 XWD <$1==37>, "Q"-40 XWD <$2==40>, "R"-40 XWD <$3==41>, "S"-40 XWD <$4==42>, "T"-40 XWD <$5==43>, "U"-40 XWD <$6==44>, "V"-40 XWD <$7==45>, "W"-40 XWD <$8==46>, "X"-40 XWD <$9==47>, "Y"-40 XWD 0, "Z"-40 XWD 0, "$"-40 XWD 0, "."-40 XWD 0, 0 XWD 0, "0"-40 XWD 0, "1"-40 XWD 0, "2"-40 XWD <$A==1>, "3"-40 XWD <$B==2>, "4"-40 XWD <$C==3>, "5"-40 XWD <$D==4>, "6"-40 XWD <$E==5>, "7"-40 XWD <$F==6>, "8"-40 XWD <$G==7>, "9"-40 XWD <$H==10>, 0 XWD <$I==11>, 0 XWD <$J==12>, 0 XWD <$K==13>, 0 XWD <$L==14>, 0 XWD <$M==15>, 0 XWD <$N==16>, 0 XWD <$O==17>, 0 XWD <$P==20>, 0 XWD <$Q==21>, 0 XWD <$R==22>, 0 XWD <$S==23>, 0 XWD <$T==24>, 0 XWD <$U==25>, 0 XWD <$V==26>, 0 XWD <$W==27>, 0 XWD <$X==30>, 0 XWD <$Y==31>, 0 XWD <$Z==32>, 0 XWD 0, 0 XWD 0, 0 XWD 0, 0 XWD 0, 0 XWD 0, 0 SUBTTL PERMANENT SYMBOL TABLE ROUTINES OSRCH: ;OP TABLE SEARCH CALL MSRCH ;TRY FOR USER-DEFINED OPS FIRST TLZA SYM,ST.MAC ; NO, CLEAR FLAG AND SKIP JRST CPOPJ1 ;YES, GOOD EXIT MOVE T3,MACHT ;GET MACHINE TYPE CALL PSRCH ;SEARCH PERM SYMBOL TABLE SKIPA T3,[MXX] ;FAILED - TRY DIRECTIVE JRST CPOPJ1 ;SUCCESS PSRCH: HLRZ T2,DELTAX(T3) ;SET UP OFFSET AND DELTA HRRZ T1,DELTAX(T3) PSRCH1: CAMN SYM,@OPTBOT(T3) ;ARE WE LOOKING AT IT? JRST PSRCH3 ; YES CAML SYM,@OPTBOT(T3) ;TEST FOR DIRECTION OF NEXT MOVE TDOA T2,T1 ;ADD PSRCH2: SUB T2,T1 ;SUBTRACT ASH T1,-1 ;HALVE DELTA JUMPE T1,PSRCH4 ;EXIT IF END CAMLE T2,OPTSIZ(T3) ;YES, ARE WE OUT OF BOUNDS? JRST PSRCH2 ;YES, MOVE DOWN JRST PSRCH1 ;NO, TRY AGAIN PSRCH3: MOVE T1,@OPTBT1(T3) ;FOUND, PLACE VALUE IN T1 LDB T2,TYPPNT JRST CPOPJ1 PSRCH4: SETZB T1,T2 RETURN ;MACHINE TYPE TABLES FOR PSRCH DELTAX: 1B^L,,1B^L/2 1B^L,,1B^L/2 1B^L,,1B^L/2 1B^L,,1B^L/2 1B^L,,1B^L/2 1B^L,,1B^L/2 1B^L,,1B^L/2 CHKTAB (DELTAX) 1B^L,,1B^L/2 OPTBOT: Z M65BOT-2(T2) Z M68BOT-2(T2) Z M80BOT-2(T2) Z M88BOT-2(T2) Z M08BOT-2(T2) Z M18BOT-2(T2) Z MF8BOT-2(T2) CHKTAB (OPTBOT) Z DIRBOT-2(T2) OPTBT1: Z M65BOT-1(T2) Z M68BOT-1(T2) Z M80BOT-1(T2) Z M88BOT-1(T2) Z M08BOT-1(T2) Z M18BOT-1(T2) Z MF8BOT-1(T2) CHKTAB (OPTBT1) Z DIRBOT-1(T2) OPTSIZ: M65TOP-M65BOT M68TOP-M68BOT M80TOP-M80BOT M88TOP-M88BOT M08TOP-M08BOT M18TOP-M18BOT MF8TOP-MF8BOT CHKTAB (OPTSIZ) DIRTOP-DIRBOT SUBTTL SYMBOL TABLE FLAGS TYPOFF== ^D17 ;PACKING PARAMETERS SUBOFF== ^D14 MODOFF== ^D7 BC1== 1 BC2== 2 DEFSYM== 400000 ;DEFINED SYMBOL LBLSYM== 200000 ;LABEL REGSYM== 100000 ;REGISTER GLBSYM== 040000 ;GLOBAL MDFSYM== 020000 ;MULTIPLY-DEFINED FLAG FLTSYM== 010000 ;DEFAULTED GLOBAL SYMBOL DFLSYM== 004000 ;DEFAULT SYMBOL DEFINITION TYPPNT: POINT 3,T1,TYPOFF ;TYPE POINTER SUBPNT: POINT 7,T1,SUBOFF ;SUB-TYPE POINTER CCSPNT: POINT 7,PC,SUBOFF ;CURRENT CSECT POINTER MODPNT: POINT 8,T1,MODOFF ST.MAC== 200000 ST.LSB== 400000 MDMASK== 377B PFMASK== 377B ADMASK== 177777 PCMASK== PFMASK!ADMASK DCCND== 1 DCCNDE== 2 DCMAC== 3 DCMACE== 4 DCRPT== DCMAC DCRPTE== DCMACE DCMCAL== 7 M40DOT: GENM40 <.> SUBTTL PERMANENT SYMBOL TABLE REGM80: GENM40 GENM40 GENM40 GENM40 GENM40 GENM40 GENM40 GENM40 GENM40 GENM40 GENM40 GENM40 REGM88: REGM08: GENM40 GENM40 GENM40 GENM40 GENM40 GENM40 GENM40 GENM40 REGM18: GENM40 GENM40 GENM40 GENM40 GENM40 GENM40 GENM40 GENM40 GENM40 GENM40 GENM40 GENM40 GENM40 GENM40 GENM40 GENM40 ;MACRO TO DEFINE OPCODE SYMBOL TABLE DEFINE M65OPS < M65DEF ,OPCL1,<6D,7D,79,61,71,00,69,65,75,00> M65DEF ,OPCL1,<2D,3D,39,21,31,00,29,25,35,00> M65DEF ,OPCL5,<0E,11E,00,00,00,0A,00,06,16,00> M65DEF ,OPCL2,<90> M65DEF ,OPCL2, M65DEF ,OPCL2, M65DEF ,OPCL1,<2C,00,00,00,00,00,00,24,00,00> M65DEF ,OPCL2,<30> M65DEF ,OPCL2, M65DEF ,OPCL2,<10> M65DEF ,OPCL4,<00>,^D70 M65DEF ,OPCL2,<50> M65DEF ,OPCL2,<70> M65DEF ,OPCL4,<18>,^D20 M65DEF ,OPCL4,,^D20 M65DEF ,OPCL4,<58>,^D20 M65DEF ,OPCL4,,^D20 M65DEF ,OPCL1, M65DEF ,OPCL1, M65DEF ,OPCL1, M65DEF ,OPCL5, M65DEF ,OPCL4,,^D20 M65DEF ,OPCL4,<88>,^D20 M65DEF ,OPCL1,<4D,5D,59,41,51,00,49,45,55,00> M65DEF ,OPCL5, M65DEF ,OPCL4,,^D20 M65DEF ,OPCL4,,^D20 M65DEF ,OPCL3,<4C,00,00,00,00,6C,00,00,00,00> M65DEF ,OPCL1,<20,00,00,00,00,00,00,00,00,00>,424 M65DEF ,OPCL1, M65DEF ,OPCL1, M65DEF ,OPCL1, M65DEF ,OPCL5,<4E,15E,00,00,00,4A,00,46,56,00> M65DEF ,OPCL4,,^D20 M65DEF ,OPCL1,<0D,1D,19,01,11,00,09,05,15,00> M65DEF ,OPCL4,<48>,^D30 M65DEF ,OPCL4,<08>,^D30 M65DEF ,OPCL4,<68>,^D40 M65DEF ,OPCL4,<28>,^D40 M65DEF ,OPCL5,<2E,13E,00,00,00,2A,00,26,36,00> M65DEF ,OPCL5,<6E,17E,00,00,00,6A,00,66,76,00> M65DEF ,OPCL4,<40>,^D60 M65DEF ,OPCL4,<60>,^D60 M65DEF ,OPCL1, M65DEF ,OPCL4,<38>,^D20 M65DEF ,OPCL4,,^D20 M65DEF ,OPCL4,<78>,^D20 M65DEF ,OPCL5,<8D,19D,199,81,91,00,00,85,95,00>,^D20 M65DEF ,OPCL5,<8E,00,00,00,00,00,00,86,00,196>,^D20 M65DEF ,OPCL5,<8C,00,00,00,00,00,00,84,94,00>,^D20 M65DEF ,OPCL4,,^D20 M65DEF ,OPCL4,,^D20 M65DEF ,OPCL4,,^D20 M65DEF ,OPCL4,<8A>,^D20 M65DEF ,OPCL4,<9A>,^D20 M65DEF ,OPCL4,<98>,^D20 > ;END OF M65OPS DEFINE M68OPS < M68DEF ,OPCL3,<1B> M68DEF ,OPCL1,<89,99,A9,B9> M68DEF ,OPCL1, M68DEF ,OPCL1,<8B,9B,AB,BB> M68DEF ,OPCL1, M68DEF ,OPCL1,<84,94,A4,B4> M68DEF ,OPCL1, M68DEF ,OPCL1,<00,00,68,78> M68DEF ,OPCL3,<48> M68DEF ,OPCL3,<58> M68DEF ,OPCL1,<00,00,67,77> M68DEF ,OPCL3,<47> M68DEF ,OPCL3,<57> M68DEF ,OPCL2,<24> M68DEF ,OPCL2,<25> M68DEF ,OPCL2,<27> M68DEF ,OPCL2,<2C> M68DEF ,OPCL2,<2E> M68DEF ,OPCL2,<22> M68DEF ,OPCL1,<85,95,A5,B5> M68DEF ,OPCL1, M68DEF ,OPCL2,<2F> M68DEF ,OPCL2,<23> M68DEF ,OPCL2,<2D> M68DEF ,OPCL2,<2B> M68DEF ,OPCL2,<26> M68DEF ,OPCL2,<2A> M68DEF
    ,OPCL2,<20> M68DEF ,OPCL2,<20> M68DEF ,OPCL2,<8D> M68DEF ,OPCL2,<28> M68DEF ,OPCL2,<29> M68DEF ,OPCL3,<11> M68DEF ,OPCL3,<0C> M68DEF ,OPCL3,<0E> M68DEF ,OPCL4,<00,00,6F,7F> M68DEF ,OPCL3,<4F> M68DEF ,OPCL3,<5F> M68DEF ,OPCL3,<0A> M68DEF ,OPCL1,<81,91,A1,B1> M68DEF ,OPCL1, M68DEF ,OPCL4,<00,00,63,73> M68DEF ,OPCL3,<43> M68DEF ,OPCL3,<53> M68DEF ,OPCL5,<8C,9C,AC,BC> M68DEF ,OPCL3,<19> M68DEF ,OPCL4,<00,00,6A,7A> M68DEF ,OPCL3,<4A> M68DEF ,OPCL3,<5A> M68DEF ,OPCL3,<34> M68DEF ,OPCL3,<09> M68DEF ,OPCL1,<88,98,A8,B8> M68DEF ,OPCL1, M68DEF ,OPCL4,<00,00,6C,7C> M68DEF ,OPCL3,<4C> M68DEF ,OPCL3,<5C> M68DEF ,OPCL3,<31> M68DEF ,OPCL3,<08> M68DEF ,OPCL1,<00,00,6E,7E> M68DEF ,OPCL1,<00,00,AD,BD> M68DEF ,OPCL1,<86,96,A6,B6> M68DEF ,OPCL1, M68DEF ,OPCL5,<8E,9E,AE,BE> M68DEF ,OPCL5, M68DEF ,OPCL4,<00,00,64,74> M68DEF ,OPCL3,<44> M68DEF ,OPCL3,<54> M68DEF ,OPCL4,<00,00,60,70> M68DEF ,OPCL3,<40> M68DEF ,OPCL3,<50> M68DEF ,OPCL3,<01> M68DEF ,OPCL1,<8A,9A,AA,BA> M68DEF ,OPCL1, M68DEF ,OPCL3,<36> M68DEF ,OPCL3,<37> M68DEF ,OPCL3,<32> M68DEF ,OPCL3,<33> M68DEF ,OPCL4,<00,00,69,79> M68DEF ,OPCL3,<49> M68DEF ,OPCL3,<59> M68DEF ,OPCL4,<00,00,66,76> M68DEF ,OPCL3,<46> M68DEF ,OPCL3,<56> M68DEF ,OPCL3,<3B> M68DEF ,OPCL3,<39> M68DEF ,OPCL3,<10> M68DEF ,OPCL1,<82,92,A2,B2> M68DEF ,OPCL1, M68DEF ,OPCL3,<0D> M68DEF ,OPCL3,<0F> M68DEF ,OPCL3,<0B> M68DEF ,OPCL4,<00,97,A7,B7> M68DEF ,OPCL4,<00,D7,E7,F7> M68DEF ,OPCL4,<00,9F,AF,BF> M68DEF ,OPCL4,<00,DF,EF,FF> M68DEF ,OPCL1,<80,90,A0,B0> M68DEF ,OPCL1, M68DEF ,OPCL3,<3F> M68DEF ,OPCL3,<16> M68DEF ,OPCL3,<06> M68DEF ,OPCL3,<17> M68DEF ,OPCL3,<07> M68DEF ,OPCL1,<00,00,6D,7D> M68DEF ,OPCL3,<4D> M68DEF ,OPCL3,<5D> M68DEF ,OPCL3,<30> M68DEF ,OPCL3,<35> M68DEF ,OPCL3,<3E> > ;END OF M68OPS DEFINE M80OPS < M80DEF ,OPCL7,,^D70 M80DEF ,OPCL4,<88,89,8A,8B,8C,8D,8E,8F,00,00,8E>,^D40 M80DEF ,OPCL4,<80,81,82,83,84,85,86,87,00,00,86>,^D40 M80DEF ,OPCL7,,^D70 M80DEF ,OPCL4,,^D40 M80DEF ,OPCL7,,^D70 MZ8DEF ,OPCL9,<40> M80DEF ,OPCL2,,^D170 M80DEF ,OPCL2,,^D110 MZ8DEF ,OPCL3,, MZ8DEF ,OPCL3,, MZ8DEF ,OPCL3,, MZ8DEF ,OPCL3,, M80DEF ,OPCL2,,^D110 M80DEF ,OPCL3,<2F>,^D40 M80DEF ,OPCL3,<3F>,^D40 M80DEF ,OPCL4,,^D40 M80DEF ,OPCL2,,^D110 MZ8DEF ,OPCL2, M80DEF ,OPCL2,,^D110 MZ8DEF ,OPCL2, M80DEF ,OPCL2,,^D110 M80DEF ,OPCL2,,^D110 M80DEF ,OPCL7,,^D70 M80DEF ,OPCL2,,^D110 M80DEF ,OPCL2,,^D110 M80DEF ,OPCL3,<27>,^D40 M80DEF ,OPCL4,<09,00,19,00,29,00,00,00,39>,^D100 MZ8DEF ,OPCL4,<4A,00,5A,00,6A,00,00,00,7A>, MZ8DEF ,OPCL4,<09,00,19,00,00,00,00,00,39,00,29>,
    MZ8DEF ,OPCL4,<09,00,19,00,00,00,00,00,39,00,29>, M80DEF ,OPCL4,<05,0D,15,1D,25,2D,135,3D,00,00,35>,^D50 M80DEF ,OPCL4,<0B,00,1B,00,2B,00,00,00,3B,00,2B>,^D50 M80DEF ,OPCL3,,^D40 MZ8DEF ,OPCL10,<10> MZ8DEF ,OPCL4,<42,00,52,00,62,00,00,00,72>, M80DEF ,OPCL3,,^D40 MZ8DEF ,OPCL3,<08> MZ8DEF ,OPCL3, M80DEF ,OPCL3,<76>,^D70 MZ8DEF ,OPCL3,<46>, MZ8DEF ,OPCL3,<56>, MZ8DEF ,OPCL3,<5E>, M80DEF ,OPCL7,,^D100 MZ8DEF ,OPCL3,, MZ8DEF ,OPCL3,, MZ8DEF ,OPCL3,, MZ8DEF ,OPCL3,, MZ8DEF ,OPCL4,<40,48,50,58,60,68,00,78>, M80DEF ,OPCL4,<04,0C,14,1C,24,2C,134,3C,00,00,34>,^D50 M80DEF ,OPCL4,<03,00,13,00,23,00,00,00,33,00,23>,^D50 M80DEF ,OPCL2,,^D100 M80DEF ,OPCL2,,^D100 M80DEF ,OPCL2,,^D100 MZ8DEF ,OPCL10,<18> M80DEF ,OPCL2,,^D100 MZ8DEF ,OPCL2, M80DEF ,OPCL2,,^D100 MZ8DEF ,OPCL2, M80DEF ,OPCL2,,^D100 M80DEF ,OPCL2,,^D100 M80DEF ,OPCL2,,^D100 MZ8DEF ,OPCL10,<38> MZ8DEF ,OPCL10,<30> MZ8DEF ,OPCL10,<20> MZ8DEF ,OPCL10,<28> M80DEF ,OPCL2,,^D100 MZ8DEF ,OPCL2,<4B>, M80DEF ,OPCL2,<3A>,^D130 MZ8DEF ,OPCL3,<57>, MZ8DEF ,OPCL3,<5F>, M80DEF ,OPCL4,<0A,00,1A>,^D70 MZ8DEF ,OPCL3,, MZ8DEF ,OPCL3,, MZ8DEF ,OPCL2,<5B>, MZ8DEF ,OPCL3,, MZ8DEF ,OPCL3,, M80DEF ,OPCL2,<2A>,^D160 MZ8DEF ,OPCL2,<2A>,
    MZ8DEF ,OPCL2,<2A>, MZ8DEF ,OPCL2,<7B>, M80DEF ,OPCL6,<01,00,11,00,21,00,00,00,31,00,21>,^D100 M80DEF ,OPCL1,<40>,^D50 M80DEF ,OPCL5,<06,0E,16,1E,26,2E,36,3E,00,00,36>,^D70 MZ8DEF ,OPCL3,<44>, M80DEF ,OPCL3,<00>,^D40 M80DEF ,OPCL4,,^D40 M80DEF ,OPCL7,,^D70 M80DEF ,OPCL7,,^D100 MZ8DEF ,OPCL3,, MZ8DEF ,OPCL3,, MZ8DEF ,OPCL3,, MZ8DEF ,OPCL3,, MZ8DEF ,OPCL4,<41,49,51,59,61,69,00,79>, M80DEF ,OPCL3,,^D50 MZ8DEF ,OPCL3,,
    MZ8DEF ,OPCL3,, M80DEF ,OPCL4,,^D100 M80DEF ,OPCL4,,^D110 M80DEF ,OPCL3,<17>,^D40 MZ8DEF ,OPCL11,<10> M80DEF ,OPCL3,<1F>,^D40 MZ8DEF ,OPCL11,<18> M80DEF ,OPCL3,,^D50 MZ8DEF ,OPCL9,<80> M80DEF ,OPCL3,,^D100 MZ8DEF ,OPCL3,<4D>, MZ8DEF ,OPCL3,<45>, M80DEF ,OPCL12,<20> M80DEF ,OPCL3,<07>,^D40 MZ8DEF ,OPCL11,<00> MZ8DEF ,OPCL3,<6F>, M80DEF ,OPCL3,,^D50 M80DEF ,OPCL3,,^D50 MZ8DEF ,OPCL3, M80DEF ,OPCL3,,^D50 MZ8DEF ,OPCL3, M80DEF ,OPCL3,,^D50 M80DEF ,OPCL3,,^D50 M80DEF ,OPCL3,,^D50 M80DEF ,OPCL3,<0F>,^D40 MZ8DEF ,OPCL11,<08> MZ8DEF ,OPCL3,<67>, M80DEF ,OPCL8,,^D110 M80DEF ,OPCL3,,^D50 M80DEF ,OPCL4,<98,99,9A,9B,9C,9D,9E,9F,00,00,9E>,^D40 MZ8DEF ,OPCL2,<43>, M80DEF ,OPCL7,,^D70 MZ8DEF ,OPCL2,<53>, MZ8DEF ,OPCL9, M80DEF ,OPCL2,<22>,^D160 M80DEF ,OPCL12,<30> MZ8DEF ,OPCL2,<22>,
    MZ8DEF ,OPCL2,<22>, MZ8DEF ,OPCL11,<20> M80DEF ,OPCL3,,^D50 MZ8DEF ,OPCL3,,
    MZ8DEF ,OPCL3,, MZ8DEF ,OPCL11,<28> MZ8DEF ,OPCL11,<38> MZ8DEF ,OPCL2,<73>, M80DEF ,OPCL2,<32>,^D130 MZ8DEF ,OPCL3,<47>, MZ8DEF ,OPCL3,<4F>, M80DEF ,OPCL4,<02,00,12>,^D70 M80DEF ,OPCL3,<37>,^D40 M80DEF ,OPCL4,<90,91,92,93,94,95,96,97,00,00,96>,^D40 M80DEF ,OPCL7,,^D70 M80DEF ,OPCL3,,^D40 M80DEF ,OPCL4,,^D40 M80DEF ,OPCL7,,^D70 M80DEF ,OPCL3,,^D180 MZ8DEF ,OPCL3,,
    MZ8DEF ,OPCL3,, > ;END OF M80OPS DEFINE M88OPS < M88DEF ,OPCL6,<0C>,^D80 M88DEF ,OPCL4,<88,89,8A,8B,8C,8D,8E,8F>,^D50 M88DEF ,OPCL4,<80,81,82,83,84,85,86,87>,^D50 M88DEF ,OPCL6,<04>,^D80 M88DEF ,OPCL4,,^D50 M88DEF ,OPCL6,<24>,^D80 M88DEF ,OPCL2,<4E>,^D110 M88DEF ,OPCL2,<62>,^D90 M88DEF ,OPCL2,<72>,^D90 M88DEF ,OPCL4,,^D50 M88DEF ,OPCL2,<42>,^D90 M88DEF ,OPCL2,<4A>,^D90 M88DEF ,OPCL2,<52>,^D90 M88DEF ,OPCL2,<7A>,^D90 M88DEF ,OPCL6,<3C>,^D80 M88DEF ,OPCL2,<5A>,^D90 M88DEF ,OPCL2,<6A>,^D90 M88DEF ,OPCL4,<00,09,11,19,21,29,31,00>,^D50 M88DEF ,OPCL3,<00>,^D40 M88DEF ,OPCL7,<41>,^D80 M88DEF ,OPCL4,<00,08,10,18,20,28,30,00>,^D50 M88DEF ,OPCL2,<60>,^D90 M88DEF ,OPCL2,<70>,^D90 M88DEF ,OPCL2,<4C>,^D110 M88DEF ,OPCL2,<40>,^D90 M88DEF ,OPCL2,<48>,^D90 M88DEF ,OPCL2,<50>,^D90 M88DEF ,OPCL2,<78>,^D90 M88DEF ,OPCL2,<58>,^D90 M88DEF ,OPCL2,<68>,^D90 M88DEF ,OPCL1,,^D50 M88DEF ,OPCL5,<06,0E,16,1E,26,2E,36,3E>,^D80 M88DEF ,OPCL3,,^D50 M88DEF ,OPCL4,,^D50 M88DEF ,OPCL6,<34>,^D80 M88DEF ,OPCL8,<51>,^D60 M88DEF ,OPCL3,<12>,^D50 M88DEF ,OPCL3,<1A>,^D50 M88DEF ,OPCL3,<23>,^D30 M88DEF ,OPCL3,<0F>,^D50 M88DEF ,OPCL3,<02>,^D50 M88DEF ,OPCL3,<33>,^D30 M88DEF ,OPCL3,<03>,^D30 M88DEF ,OPCL3,<08>,^D30 M88DEF ,OPCL3,<13>,^D30 M88DEF ,OPCL3,<3B>,^D30 M88DEF ,OPCL3,<1B>,^D30 M88DEF ,OPCL3,<0A>,^D50 M88DEF ,OPCL9,<05>,^D50 M88DEF ,OPCL3,<28>,^D30 M88DEF ,OPCL4,<98,99,9A,9B,9C,9D,9E,9F>,^D50 M88DEF ,OPCL6,<1C>,^D80 M88DEF ,OPCL4,<90,91,92,93,94,95,96,97>,^D50 M88DEF ,OPCL6,<14>,^D80 M88DEF ,OPCL4,,^D50 M88DEF ,OPCL6,<2C>,^D80 > ;END OF M88OPS DEFINE M08OPS < M08DEF ,OPCL3,<88>,^D50 M08DEF ,OPCL3,<89>,^D50 M08DEF ,OPCL3,<8A>,^D50 M08DEF ,OPCL3,<8B>,^D50 M08DEF ,OPCL3,<8C>,^D50 M08DEF ,OPCL3,<8D>,^D50 M08DEF ,OPCL6,<0C>,^D80 M08DEF ,OPCL3,<8E>,^D50 M08DEF ,OPCL3,<8F>,^D80 M08DEF ,OPCL3,<80>,^D50 M08DEF ,OPCL3,<81>,^D50 M08DEF ,OPCL3,<82>,^D50 M08DEF ,OPCL3,<83>,^D50 M08DEF ,OPCL3,<84>,^D50 M08DEF ,OPCL3,<85>,^D50 M08DEF ,OPCL6,<04>,^D80 M08DEF ,OPCL3,<86>,^D50 M08DEF ,OPCL3,<87>,^D80 M08DEF ,OPCL2,<46>,^D110 M08DEF ,OPCL2,<42>,^D90 M08DEF ,OPCL2,<5A>,^D90 M08DEF ,OPCL2,<52>,^D90 M08DEF ,OPCL2,<4A>,^D90 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL6,<3C>,^D80 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL3,,^D80 M08DEF ,OPCL2,<62>,^D90 M08DEF ,OPCL2,<7A>,^D90 M08DEF ,OPCL2,<72>,^D90 M08DEF ,OPCL2,<6A>,^D90 M08DEF ,OPCL3,<09>,^D50 M08DEF ,OPCL3,<11>,^D50 M08DEF ,OPCL3,<19>,^D50 M08DEF ,OPCL3,<21>,^D50 M08DEF ,OPCL3,<29>,^D50 M08DEF ,OPCL3,<31>,^D50 M08DEF ,OPCL3,<00>,^D40 M08DEF ,OPCL3,<08>,^D50 M08DEF ,OPCL3,<10>,^D50 M08DEF ,OPCL3,<18>,^D50 M08DEF ,OPCL3,<20>,^D50 M08DEF ,OPCL3,<28>,^D50 M08DEF ,OPCL3,<30>,^D50 M08DEF ,OPCL7,<41>,^D80 M08DEF ,OPCL2,<40>,^D90 M08DEF ,OPCL2,<58>,^D90 M08DEF ,OPCL2,<50>,^D90 M08DEF ,OPCL2,<48>,^D90 M08DEF ,OPCL2,<44>,^D110 M08DEF ,OPCL2,<60>,^D90 M08DEF ,OPCL2,<78>,^D90 M08DEF ,OPCL2,<70>,^D90 M08DEF ,OPCL2,<68>,^D90 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL6,<06>,^D80 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL3,,^D80 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL6,<0E>,^D80 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL3,,^D80 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL6,<16>,^D80 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL3,,^D80 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL3,
    ,^D50 M08DEF ,OPCL6,<1E>,^D80 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL3,,^D80 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL6,<26>,^D80 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL3,,^D80 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL6,<2E>,^D80 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL3,,^D80 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL6,<36>,^D80 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL3,,^D80 M08DEF ,OPCL3,,^D70 M08DEF ,OPCL3,,^D70 M08DEF ,OPCL3,,^D70 M08DEF ,OPCL3,,^D70 M08DEF ,OPCL3,,^D70 M08DEF ,OPCL3,,^D70 M08DEF ,OPCL6,<3E>,^D90 M08DEF ,OPCL3,,^D70 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL6,<24>,^D80 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL3,,^D80 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL6,<34>,^D80 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL3,,^D80 M08DEF ,OPCL8,<51>,^D60 M08DEF ,OPCL3,<12>,^D50 M08DEF ,OPCL3,<1A>,^D50 M08DEF ,OPCL3,<07>,^D50 M08DEF ,OPCL3,<03>,^D30 M08DEF ,OPCL3,<1B>,^D30 M08DEF ,OPCL3,<13>,^D30 M08DEF ,OPCL3,<0B>,^D30 M08DEF ,OPCL3,<02>,^D50 M08DEF ,OPCL3,<0A>,^D50 M08DEF ,OPCL9,<05>,^D50 M08DEF ,OPCL3,<23>,^D30 M08DEF ,OPCL3,<3B>,^D30 M08DEF ,OPCL3,<33>,^D30 M08DEF ,OPCL3,<2B>,^D30 M08DEF ,OPCL3,<98>,^D50 M08DEF ,OPCL3,<99>,^D50 M08DEF ,OPCL3,<9A>,^D50 M08DEF ,OPCL3,<9B>,^D50 M08DEF ,OPCL3,<9C>,^D50 M08DEF ,OPCL3,<9D>,^D50 M08DEF ,OPCL6,<1C>,^D80 M08DEF ,OPCL3,<9E>,^D50 M08DEF ,OPCL3,<9F>,^D80 M08DEF ,OPCL3,<90>,^D50 M08DEF ,OPCL3,<91>,^D50 M08DEF ,OPCL3,<92>,^D50 M08DEF ,OPCL3,<93>,^D50 M08DEF ,OPCL3,<94>,^D50 M08DEF ,OPCL3,<95>,^D50 M08DEF ,OPCL6,<14>,^D80 M08DEF ,OPCL3,<96>,^D50 M08DEF ,OPCL3,<97>,^D80 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL6,<2C>,^D80 M08DEF ,OPCL3,,^D50 M08DEF ,OPCL3,,^D80 > ;END OF M08OPS DEFINE M18OPS < M18DEF ,OPCL2,<74> M18DEF ,OPCL3,<7C> M18DEF ,OPCL2, M18DEF ,OPCL3, M18DEF ,OPCL2, M18DEF ,OPCL3, M18DEF ,OPCL5,<33> M18DEF ,OPCL5,<33> M18DEF ,OPCL5,<3B> M18DEF ,OPCL5,<3B> M18DEF ,OPCL5,<3B> M18DEF ,OPCL5,<39> M18DEF ,OPCL5,<3A> M18DEF ,OPCL5,<3C> M18DEF ,OPCL5,<3D> M18DEF ,OPCL5,<3E> M18DEF ,OPCL5,<3F> M18DEF ,OPCL5,<33> M18DEF ,OPCL5,<31> M18DEF
    ,OPCL5,<30> M18DEF ,OPCL5,<32> M18DEF ,OPCL5,<34> M18DEF ,OPCL5,<35> M18DEF ,OPCL5,<36> M18DEF ,OPCL5,<37> M18DEF ,OPCL1,<20> M18DEF ,OPCL2,<71> M18DEF ,OPCL1,<90> M18DEF ,OPCL1,<80> M18DEF ,OPCL2,<00> M18DEF ,OPCL1,<10> M18DEF ,OPCL6,<68> M18DEF ,OPCL2,<60> M18DEF ,OPCL4, M18DEF ,OPCL4, M18DEF ,OPCL4, M18DEF ,OPCL4, M18DEF ,OPCL4, M18DEF ,OPCL4, M18DEF ,OPCL4, M18DEF ,OPCL1,<40> M18DEF ,OPCL3, M18DEF ,OPCL1,<00> M18DEF ,OPCL2, M18DEF ,OPCL2,<72> M18DEF ,OPCL2, M18DEF ,OPCL2, M18DEF ,OPCL2, M18DEF ,OPCL2, M18DEF ,OPCL2, M18DEF ,OPCL2, M18DEF ,OPCL2, M18DEF ,OPCL2, M18DEF ,OPCL2,<79> M18DEF ,OPCL5,<38> M18DEF ,OPCL4, M18DEF ,OPCL2, M18DEF ,OPCL2, M18DEF ,OPCL3, M18DEF ,OPCL6,<60> M18DEF ,OPCL1, M18DEF ,OPCL1, M18DEF ,OPCL2,<7A> M18DEF ,OPCL2,<70> M18DEF ,OPCL2,<7E> M18DEF ,OPCL2,<76> M18DEF ,OPCL2,<78> M18DEF ,OPCL2, M18DEF ,OPCL2,<75> M18DEF ,OPCL3,<7F> M18DEF ,OPCL3, M18DEF ,OPCL1, M18DEF ,OPCL2,<7B> M18DEF ,OPCL1, M18DEF ,OPCL2, M18DEF ,OPCL2,<7E> M18DEF ,OPCL2, M18DEF ,OPCL2,<76> M18DEF ,OPCL2,<38> M18DEF ,OPCL2, M18DEF ,OPCL2,<77> M18DEF ,OPCL3,<7F> M18DEF ,OPCL3, M18DEF ,OPCL1,<50> M18DEF ,OPCL2,<73> M18DEF ,OPCL2, M18DEF ,OPCL3, > DEFINE MF8OPS < > DEFINE M65DEF (OP,CLASS,VALUE,TIM<0>)< GENM40 ..F==0 IFIDN ,,< ..F==1 B32!OCOP,,OP'%0 > IFIDN ,,< ..F==1 B32!OCOP,,OP'%0 > IFIDN ,,< ..F==1 B32!OCOP,,OP'%0 > IFE ..F,< HX (..T,VALUE) B32!OCOP,,+..T > > DEFINE DIRDEF (SYM,TYPE)< IFDEF SYM,< GENM40 B32!DIOP,,SYM > > DEFINE HX(VAR,VAL) < VAR==0 IRPC , > ;SOME USEFUL VALUES FOR Z80 HX (IX,
    ) ;HIGH BYTE FOR (X) HX (IY,) ;HIGH BYTE FOR (Y) HX (BITV,) ;OP BYTE FOR BIT/RES/SET INSTRS ;ALSO RLCR/RALR/RRCR/RARR/SLAR/SRAR/SRLR M65BOT: ;OP TABLE BOTTOM M65OPS ;EXPAND OPTABLE M65TOP: -1B36 ;OP TABLE TOP DEFINE M80DEF (OP,CLASS,VALUE,TIM<0>)< GENM40 ..F==0 IFIDN ,,< ..F==1 B32!OCOP,,OP'%2 > IFIDN ,,< ..F==1 B32!OCOP,,OP'%2 > IFIDN ,,< ..F==1 B32!OCOP,,OP'%2 > IFIDN ,,< ..F==1 B32!OCOP,,OP'%2 > IFE ..F,< HX (..T,VALUE) B32!OCOP,,+..T > > DEFINE MZ8DEF (OP,CLASS,VALUE,HIGH<0>,TIM<0>) < GENM40 ..F==0 IFIDN ,,< ..F==1 HX (..T,HIGH) B32!Z8OP,,[<1B18+..T>,,OP'%2] > IFE ..F,< HX (..H,HIGH) HX (..L,VALUE) B32!Z8OP,,[1B18+..H,,+..L] > > M80BOT: ;OP TABLE BOTTOM 8080 M80OPS M80TOP: -1B36 ;OP TABLE TOP DEFINE M88DEF (OP,CLASS,VALUE,TIM<0>)< GENM40 ..F==0 IFIDN ,,< ..F==1 B32!OCOP,,OP'%3 > IFIDN ,,< ..F==1 B32!OCOP,,OP'%3 > IFE ..F,< HX (..T,VALUE) B32!OCOP,,+..T > > M88BOT: ;OP TABLE BOTTOM 8008 M88OPS M88TOP: -1B36 ;OP TABLE TOP COMPATIBLE MNEMONICS DEFINE M08DEF (OP,CLASS,VALUE,TIM<0>)< GENM40 HX (..T,VALUE) B32!OCOP,,+..T > M08BOT: ;OP TABLE BOTTOM 8008 M08OPS M08TOP: -1B36 ;OP TABLE TOP DEFINE M18DEF (OP,CLASS,VALUE)< GENM40 HX (..T,VALUE) B32!OCOP,,..T > M18BOT: ;OP TABLE BOTTOM 1802 M18OPS M18TOP: -1B36 ;OP TABLE TOP DEFINE MF8DEF (OP,CLASS,VALUE)< GENM40 HX (..T,VALUE) B32!OCOP,,..T > MF8BOT: ;OP TABLE BOTTOM F8 MF8OPS MF8TOP: -1B36 ;OP TABLE TOP DEFINE M68DEF (OP,CLASS,VALUE,TIM<0>)< GENM40 ..F==0 IFIDN ,,< ..F==1 B32!OCOP,,OP'%1 > IFIDN ,,< ..F==1 B32!OCOP,,OP'%1 > IFIDN ,,< ..F==1 B32!OCOP,,OP'%1 > IFE ..F,< HX (..T,VALUE) B32!OCOP,,+..T > > M68BOT: ;OP CODE TABLE FOR 6800 M68OPS M68TOP: -1B36 ;OP TABLE TOP DIRBOT: ;DIRECTIVE TABLE BOTTOM DIRDEF <.ABS > DIRDEF <.ADDR > DIRDEF <.ASCII> DIRDEF <.ASCIZ> DIRDEF <.ASECT> DIRDEF <.BLKB > DIRDEF <.BLKW > DIRDEF <.BYTE > DIRDEF <.CSECT> DIRDEF <.DEPHA> DIRDEF <.DSABL> DIRDEF <.ENABL> DIRDEF <.END > DIRDEF <.ENDC >,DCCNDE DIRDEF <.ENDM >,DCMACE DIRDEF <.ENDR >,DCRPTE DIRDEF <.EOT > DIRDEF <.EQUIV> DIRDEF <.ERROR> DIRDEF <.FLT2 > DIRDEF <.FLT4 > DIRDEF <.GLOBL> DIRDEF <.IF >,DCCND DIRDEF <.IFDF >,DCCND DIRDEF <.IFEQ >,DCCND DIRDEF <.IFF >,DCCND DIRDEF <.IFG >,DCCND DIRDEF <.IFGE >,DCCND DIRDEF <.IFGT >,DCCND DIRDEF <.IFL >,DCCND DIRDEF <.IFLE >,DCCND DIRDEF <.IFLT >,DCCND DIRDEF <.IFNDF>,DCCND DIRDEF <.IFNE >,DCCND DIRDEF <.IFNZ >,DCCND DIRDEF <.IFT >,DCCND DIRDEF <.IFTF >,DCCND DIRDEF <.IFZ >,DCCND DIRDEF <.IIF > DIRDEF <.IRP >,DCMAC DIRDEF <.IRPC >,DCMAC DIRDEF <.LIMIT> DIRDEF <.LIST > DIRDEF <.LOCAL> DIRDEF <.MACR >,DCMAC DIRDEF <.MACRO>,DCMAC DIRDEF <.MCALL>,DCMCAL DIRDEF <.MEXIT> DIRDEF <.NARG > DIRDEF <.NCHR > DIRDEF <.NLIST> DIRDEF <.NTYPE> DIRDEF <.PAGE > DIRDEF <.PDP10> DIRDEF <.PHASE> DIRDEF <.PRINT> DIRDEF <.PSECT> DIRDEF <.RADIX> DIRDEF <.REM > DIRDEF <.REPT >,DCRPT DIRDEF <.ROUND> DIRDEF <.SBTTL> DIRDEF <.TITLE> DIRDEF <.TRUNC> DIRDEF <.WORD> DIRTOP: -1B36 ;DIRECTIVE TAABLE TOP ;NOW EXPAND ACTUAL OP TABLE VALUES DEFINE M65DEF(OP,CLASS,LST,TIM<0>)< IFIDN ,,< OP'%0: MKOPTB (,TIM) > IFIDN ,,< OP'%0: MKOPTB (,TIM) > IFIDN ,,< OP'%0: MKOPTB (,TIM) > > DEFINE M80DEF(OP,CLASS,LST,TIM<0>)< IFIDN ,,< OP'%2: MKOPTB (,TIM) > IFIDN ,,< OP'%2: MKOPTB (,TIM) > IFIDN ,,< OP'%2: MKOPTB (,TIM) > IFIDN ,,< OP'%2: MKOPTB (,TIM) > > DEFINE MZ8DEF (OP,CLASS,LST,HGH<0>,TIM<0>) < M80DEF (OP,CLASS,,TIM) > DEFINE M88DEF(OP,CLASS,LST,TIM<0>)< IFIDN ,,< OP'%3: MKOPTB (,TIM) > IFIDN ,,< OP'%3: MKOPTB (,TIM) > > DEFINE M68DEF(OP,CLASS,LST,TIM<0>)< IFIDN ,,< OP'%1: MKOPTB (,TIM) > IFIDN ,,< OP'%1: MKOPTB (,TIM) > IFIDN ,,< OP'%1: MKOPTB (,TIM) > > DEFINE MKOPTB (ARGLST,TIM)< ..N==1 REPEAT ^D11,< DEFARG (\..N) ..N==..N+1 > ..N==1 IRP ,< ASGARG (\..N,ARGLST) ..N=..N+1 > BYTE (9)Z1,Z2,Z3,Z4 BYTE (9)Z5,Z6,Z7,Z10 BYTE (9)Z11,Z12,Z13,TIM > DEFINE DEFARG (N) DEFINE ASGARG (N,VAL)< HX (Z'N,VAL) > M65OPS ;EXPAND 6502 M68OPS ;EXPAND 6800 M80OPS ;EXPAND 8080/Z80 M88OPS ;EXPAND 8008 0 SUBTTL CHARACTER DISPATCH ROUTINES C1PNTR: POINT 4,CHJTBL(CHR), 3 C2PNTR: POINT 4,CHJTBL(CHR), 7 C3PNTR: POINT 4,CHJTBL(CHR),11 C4PNTR: POINT 4,CHJTBL(CHR),15 C5PNTR: POINT 4,CHJTBL(CHR),19 C6PNTR: POINT 4,CHJTBL(CHR),23 C7PNTR: POINT 4,CHJTBL(CHR),27 C8PNTR: POINT 4,CHJTBL(CHR),31 C9PNTR: POINT 4,CHJTBL(CHR),35 ANPNTR== C8PNTR CHJTBL: ;CHARACTER JUMP TABLE PHASE 0 BYTE (4) , , , , , ,QJNU, , ; BYTE (4) , , , , , , , , ; BYTE (4) , , , , , , , , ; BYTE (4) , , , , , , , , ; BYTE (4) , , , , , , , , ; BYTE (4) , , , , , , , , ; BYTE (4) , , , , , , , , ; BYTE (4) , , , , , , , , ; BYTE (4) , , , , , , , , ; TAB:! BYTE (4) , , , , , ,QJTB, , ; TAB LF:! BYTE (4) , , , , , ,QJCR, , ; LF BYTE (4) , , , , , ,QJVT, , ; FF:! BYTE (4) , , , , , ,QJCR, , ; FF CRR:! BYTE (4) , , , , , ,QJCR, , ; CR BYTE (4) , , , , , , , , ; BYTE (4) , , , , , , , , ; BYTE (4) , , , , , , , , ; BYTE (4) , , , , , , , , ; BYTE (4) , , , , , , , , ; BYTE (4) , , , , , , , , ; BYTE (4) , , , , , , , , ; BYTE (4) , , , , , , , , ; BYTE (4) , , , , , , , , ; BYTE (4) , , , , , , , , ; BYTE (4) , , , , , , , , ; BYTE (4) , , , , , , , , ; BYTE (4) , , , , , ,QJNU, , ; EOF BYTE (4) , , , , , , , , ; BYTE (4) , , , , , , , , ; BYTE (4) , , , , , , , , ; BYTE (4) , , , , , , , , ; BYTE (4) , , , , , , , , ; SPACE:! BYTE (4) , , , , , ,QJSP, , ; SPACE BYTE (4) , , ,EXOR, , ,QJPC, , ; ! BYTE (4) , , , ,TEDQ, ,QJPC, , ; " BYTE (4) , , , , , ,QJPC, , ; # BYTE (4) , , , ,TEHX, ,QJPC, , ; $ BYTE (4) , , , ,TEPC, ,QJPC, , ; % BYTE (4) , , ,EXAN, , ,QJPC, , ; & BYTE (4) , , , ,TESQ, ,QJPC, , ; ' BYTE (4) , , , , , ,QJPC, , ; ( BYTE (4) , , , , , ,QJPC, , ; ) BYTE (4) , , ,EXMU, , ,QJPC, , ; * BYTE (4) , , ,EXPL,TEPL, ,QJPC, , ; + BYTE (4) , , , , , ,QJPC, , ; , BYTE (4) , , ,EXMI,TEMI, ,QJPC, , ; - BYTE (4) , , , , , ,QJPC,.DOT, ; . BYTE (4) , , ,EXDV, , ,QJPC, , ; / BYTE (4) , , , ,TENM, ,QJPC,.NUM, ; 0 BYTE (4) , , , ,TENM, ,QJPC,.NUM, ; 1 BYTE (4) , , , ,TENM, ,QJPC,.NUM, ; 2 BYTE (4) , , , ,TENM, ,QJPC,.NUM, ; 3 BYTE (4) , , , ,TENM, ,QJPC,.NUM, ; 4 BYTE (4) , , , ,TENM, ,QJPC,.NUM, ; 5 BYTE (4) , , , ,TENM, ,QJPC,.NUM, ; 6 BYTE (4) , , , ,TENM, ,QJPC,.NUM, ; 7 BYTE (4) , , , ,TENM, ,QJPC,.NUM, ; 8 BYTE (4) , , , ,TENM, ,QJPC,.NUM, ; 9 BYTE (4) , , , , , ,QJPC, , ; : BYTE (4) , , , , , ,QJPC, , ; ; BYTE (4) , , , ,TEAB, ,QJPC, , ; < BYTE (4) , , , , , ,QJPC, , ; = BYTE (4) , , , , , ,QJPC, , ; > BYTE (4) , , , , , ,QJPC, , ; ? BYTE (4) , , , ,TEOC, ,QJPC, , ; @ BYTE (4) , , , , , ,QJPC,.ALP, ; A BYTE (4) , , , , , ,QJPC,.ALP, ; B BYTE (4) , , , , , ,QJPC,.ALP, ; C BYTE (4) , , , , , ,QJPC,.ALP, ; D BYTE (4) , , , , , ,QJPC,.ALP, ; E BYTE (4) , , , , , ,QJPC,.ALP, ; F BYTE (4) , , , , , ,QJPC,.ALP, ; G BYTE (4) , , , , , ,QJPC,.ALP, ; H BYTE (4) , , , , , ,QJPC,.ALP, ; I BYTE (4) , , , , , ,QJPC,.ALP, ; J BYTE (4) , , , , , ,QJPC,.ALP, ; K BYTE (4) , , , , , ,QJPC,.ALP, ; L BYTE (4) , , , , , ,QJPC,.ALP, ; M BYTE (4) , , , , , ,QJPC,.ALP, ; N BYTE (4) , , , , , ,QJPC,.ALP, ; O BYTE (4) , , , , , ,QJPC,.ALP, ; P BYTE (4) , , , , , ,QJPC,.ALP, ; Q BYTE (4) , , , , , ,QJPC,.ALP, ; R BYTE (4) , , , , , ,QJPC,.ALP, ; S BYTE (4) , , , , , ,QJPC,.ALP, ; T BYTE (4) , , , , , ,QJPC,.ALP, ; U BYTE (4) , , , , , ,QJPC,.ALP, ; V BYTE (4) , , , , , ,QJPC,.ALP, ; W BYTE (4) , , , , , ,QJPC,.ALP, ; X BYTE (4) , , , , , ,QJPC,.ALP, ; Y BYTE (4) , , , , , ,QJPC,.ALP, ; Z BYTE (4) , , , , , ,QJPC, , ; [ BYTE (4) , , , , , ,QJPC, , ; \ BYTE (4) , , , , , ,QJPC, , ; ] BYTE (4) , , , ,TEUA, ,QJPC, , ; ^ BYTE (4) , , ,EXSH, , ,QJPC, , ; _ BYTE (4) , , , , , , , , ; BYTE (4) , , , , , ,QJLC, , ; BYTE (4) , , , , , ,QJLC, , ; BYTE (4) , , , , , ,QJLC, , ; BYTE (4) , , , , , ,QJLC, , ; BYTE (4) , , , , , ,QJLC, , ; BYTE (4) , , , , , ,QJLC, , ; BYTE (4) , , , , , ,QJLC, , ; BYTE (4) , , , , , ,QJLC, , ; BYTE (4) , , , , , ,QJLC, , ; BYTE (4) , , , , , ,QJLC, , ; BYTE (4) , , , , , ,QJLC, , ; BYTE (4) , , , , , ,QJLC, , ; BYTE (4) , , , , , ,QJLC, , ; BYTE (4) , , , , , ,QJLC, , ; BYTE (4) , , , , , ,QJLC, , ; BYTE (4) , , , , , ,QJLC, , ; BYTE (4) , , , , , ,QJLC, , ; BYTE (4) , , , , , ,QJLC, , ; BYTE (4) , , , , , ,QJLC, , ; BYTE (4) , , , , , ,QJLC, , ; BYTE (4) , , , , , ,QJLC, , ; BYTE (4) , , , , , ,QJLC, , ; BYTE (4) , , , , , ,QJLC, , ; BYTE (4) , , , , , ,QJLC, , ; BYTE (4) , , , , , ,QJLC, , ; BYTE (4) , , , , , ,QJLC, , ; BYTE (4) , , , , , , , , ; BYTE (4) , , , , , , , , ; ALTMOD:!BYTE (4) , , , , , , , , ; BYTE (4) , , , , , , , , ; RUBOUT:!BYTE (4) , , , , , ,QJNU, , ; DEPHASE SUBTTL IMPURE AREA AND DEBUG PATCH AREA .LOC ;IMPURE STORAGE EZCOR: ;END OF ZERO'D CORE .RELOC ;BACK TO CODE SEGMENT IFDEF DEBUG, < ZZZ000: BLOCK 100 ;DEBUG PATCH AREA> END START ;....CROSS