'HEAD' CRUTCH SYMBOLIC C EDIT DATE 11DEC78 16:01 C SOURCE FILE CRUTCHJHP.FS C AUTHOR J.H.PERINE C CLUSTER 5 'OUTFILE' CRDATAJHP.FR BLOCK DATA 'INCLUDE' CRUCOMJHP.IN,P C IMPLIED ADDRESS INSTRUCTIONS DATA IMPLID / 'BRK ', 0,'CLC ', 24,'CLD ',216,'CLI ', 88,^ 'CLV ',184,'DEX ',202,'DEY ',136,'INX ',232,^ 'INY ',200,'NOP ',234,'PHA ', 72,'PHP ', 8,^ 'PLA ',104,'PLP ', 40,'RTI ', 64,'RTS ', 96,^ 'SEC ', 56,'SED ',248,'SEI ',120,'TAX ',170,^ 'TAY ',168,'TYA ',152,'TSX ',186,'TXA ',138,^ 'TXS ',154 / DATA NIMPLI / 75 / C RELATIVE ADDRESS INSTRUCTIONS (BRANCH) DATA RELTIV / 'BCC ',144,'BCS ',176,'BEQ ',240,'BMI ', 48,^ 'BNE ',208,'BPL ', 16,'BVC ', 80,'BVS ',112 / DATA NRELTI / 24 / C GROUP 1 INSTRUCTIONS - ADDRESSING MODES COMPUTED DATA GROUP1 / 'ADC ', 97,'AND ', 33,'CMP ',193,'EOR ', 65,^ 'LDA ',161,'ORA ', 1,'SBC ',225,'STA ',129 / DATA NGROUP / 24 / DATA STAX / 22 / C OTHER INSTRUCTIONS - OP CODES BY ADDRESSING MODE C IMM ZP ZPX ZPY AB ABX ABY IND AREG DATA OTHERS /^ 'ASL ', -1, 6, 22, -1, 14, 30, -1, -1, 10,^ 'BIT ', -1, 36, -1, -1, 44, -1, -1, -1, -1,^ 'CPX ', 224, 228, -1, -1, 236, -1, -1, -1, -1,^ 'CPY ', 192, 196, -1, -1, 204, -1, -1, -1, -1,^ 'DEC ', -1, 198, 214, -1, 206, 222, -1, -1, -1,^ 'INC ', -1, 230, 246, -1, 238, 254, -1, -1, -1,^ 'JMP ', -1, -1, -1, -1, 76, -1, -1, 108, -1,^ 'JSR ', -1, -1, -1, -1, 32, -1, -1, -1, -1,^ 'LDX ', 162, 166, -1, 182, 174, -1, 190, -1, -1,^ 'LDY ', 160, 164, 180, -1, 172, 188, -1, -1, -1,^ 'LSR ', -1, 70, 86, -1, 78, 94, -1, -1, 74,^ 'ROL ', -1, 38, 54, -1, 46, 62, -1, -1, 42,^ 'ROR ', -1, 102, 118, -1, 110, 126, -1, -1, 106,^ 'STX ', -1, 134, -1, 150, 142, -1, -1, -1, -1,^ 'STY ', -1, 132, 148, -1, 140, -1, -1, -1, -1 / DATA NOTHER / 165 / END 'OUTFILE' CRUTCHJHP.FR C ROOT DRIVER FOR CRUSYM OVERLAY SUBROUTINE CRUSYM 'INCLUDE' CRUCOMJHP.IN, 'INCLUDE' LOGOSAJH.IN, 'INCLUDE' OPERSAJH.IN, 'INCLUDE' STKDFA.IN, INTEGER IERR EXTERNAL OLCRU C CHECK INITIAL ERROR IF (NAMEX (OPX).NE.0) CALL FAULTP (50) C CALL OVLOD (OLCRU) CALL OCRUSY 'IF' ( CSWFA .GT. 0 ) CALL BLDOP (CSOW, CSWFA, CSOFF, CSNLX, CSWFB) 'ELSE' CALL FAULTP (-CSWFA) IF (CSWFA .NE. -22) ^ CALL SCAN (SEMIC, 0, 0) 'ENDIF' NEXTOP = COMMA RETURN END 'OUTFILE' OCRUCHJHP.FR N OVERLAY OLCRU C NAME CRUSYM C PURPOSE COMPILE SINGLE MACHINE INSTRUCTIONS FOR THE MOS6502 C INPUT DESCRIPTION: C OP = OP CODE (ALWAYS 3 LETTERS) C N = UNSCRIPTED NAME (OPTIONAL) C +-C = CONSTANT EXPRESSION (OPTIONAL) C AREG = ACCUMULATOR RESERVED NAME C INDX = XREG OR YREG FOR INDEXING C FORMATS ADDRESSING MODES C $OP; IMPLIED C $OP, AREG; IMPLIED C $OP, N+-C; RELATIVE, ZP, OR ABS C $OP, >N+-C; IMMEDIATE, LEFT HALF C $OP, ) OR 128 (=) OR 256 (<) C XREG 4 C YREG 8 C ZERO PAGE 16 C ABSOLUTE 32 C AREG 64 C MODE CALCULATION TABLE FOR 'GROUP1' INSTRUCTIONS DATA G1MODE / 21, 0, 16, 0, 2, 0, 32, 0,^ 25, 0, 20, 24, 40, 0, 36, 0 / C MODE CALCULATION TABLE FOR 'OTHER' INSTRUCTIONS DATA OTHRMO / 2, 16, 20, 24, 32, 36, 40, 33, 64 / 'EJECT' C GET OP CODE & INITIALIZE CALL FNZS CALL PCHAR (CSOP, 1, SYMBOL) CALL FNZS CALL PCHAR (CSOP, 2, SYMBOL) CALL FNZS CALL PCHAR (CSOP, 3, SYMBOL) CALL FNZS CALL PCHAR (CSOP, 4, BLANK) INDFLG = 0 IMMFLG = 0 XFLG = 0 YFLG = 0 ZPFLG = 0 ABSFLG = 0 AFLG = 0 CSWFA = WF4 CSWFB = 0 CSOFF = 0 CSNLX = 0 C PARSE THE STATEMENT PLEASE IF ( PSYMB .EQ. SEMIC ) GO TO 1000 X CSDEB = 1 IF ( PSYMB .NE. COMMA ) GO TO 2000 CALL PEEK 'IF' ( PEEKS .EQ. ATSIGN ) INDFLG = 1 CALL FNZS 'ELSE' 'IF' ( PEEKS .EQ. GTR ) IMMFLG = 2 CALL FNZS 'ELSE' 'IF' ( PEEKS .EQ. EQUAL ) IMMFLG = 128 CALL FNZS 'ELSE' 'IF' ( PEEKS .EQ. LESS ) IMMFLG = 256 CALL FNZS 'ENDIF' 'ENDIF' 'ENDIF' 'ENDIF' C LOOK FOR N+-C CONSTRUCTION CALL ADVAN CSNLX = NAMEX (OPX) 'IF' ( CSNLX .EQ. 0 ) C NO NAME OR NUMBER 'IF' ( NEXTOP .EQ. SEMIC ) GO TO 1000 'ENDIF' GO TO 500 'ENDIF' C HAVE SOMETHING C CHECK FOR AREG 'IF' (NLTEST (CSNLX, REGBIT)) C REGISTER NAME - ONLY AREG ALLOWED HERE 'IF' (NLOPS (REGNUM, CSNLX) .EQ. AREG) AFLG = 64 CSNLX = NULLX GO TO 600 'ENDIF' X CSDEB = 3 GO TO 3000 'ENDIF' C CHECK CONSTANT 'IF' (NLTEST (CSNLX, CBIT)) CSOFF = NLOPS (CVALUE, CSNLX) CSNLX = NULLX 'ELSE' IF ( IMMFLG .EQ. 128 ) GO TO 3000 CSWFB = WF7 C CHECK FOR ZERO PAGE NAME 'IF' ( ZPTST (CSNLX, 0)) ZPFLG = 16 'ELSE' ABSFLG = 32 'ENDIF' 'ENDIF' 500 'IF' ( NEXTOP .GE. PLUS ) C GET CONSTANT EXPRESSION J = J - 1 NAMEX (OPX) = 0 CALL NEXP TS = NAMEX (OPX) 'IF' (TS .EQ. 0) CSWFA = -11 RETURN 'ENDIF' 'IF' (.NOT. NLTEST (TS, CBIT)) CSWFA = -11 RETURN 'ENDIF' CSOFF = CSOFF + NLOPS (CVALUE, TS) 'ENDIF' C SEE IF JUST HAVE CONSTANT - SET AS ZP OR ABS IF SO 'IF' ( ZPFLG + ABSFLG .EQ. 0 ) 'IF' ( CSOFF .GE. 0 .AND. CSOFF .LT. 256 ) ZPFLG = 16 'ELSE' ABSFLG = 32 'ENDIF' 'ENDIF' 'EJECT' C LOOK FOR INDEXING 600 IF ( NEXTOP .EQ. SEMIC ) GO TO 1000 X CSDEB = 4 IF ( NEXTOP .NE. COMMA ) GO TO 3000 CALL ADVAN NLX = NAMEX (OPX) X CSDEB = 5 IF ( NEXTOP .NE. SEMIC ) GO TO 3000 IF ( NLX .EQ. 0 ) GO TO 1000 X CSDEB = 6 IF (.NOT. NLTEST (NLX, REGBIT)) GO TO 3000 C HAVE REGISTER NAME TS = NLOPS (REGNUM, NLX) 'IF' ( TS .EQ. XREG ) XFLG = 4 'ELSE' 'IF' ( TS .EQ. YREG ) YFLG = 8 'ELSE' X CSDEB = 7 GO TO 3000 'ENDIF' 'ENDIF' C HAVE BASICALLY PARSED THE CONSTRUCTION 1000 OPTION = INDFLG+IMMFLG+XFLG+YFLG+ZPFLG+ABSFLG+AFLG C SEARCH FOR OP CODE CSOPX = OPSRCH (CSOP, IMPLID, NIMPLI, 3) X CSDEB = 8 IF ( CSOPX .GT. 0 ) GO TO 4000 CSOPX = OPSRCH (CSOP, RELTIV, NRELTI, 3) X CSDEB = 9 IF ( CSOPX .GT. 0 ) GO TO 5000 C RESET TO HANDLE POSSIBLE IMMEDIATE IF ( IMMFLG .NE. 0 ) OPTION=INDFLG+2+XFLG+YFLG+AFLG CSOPX = OPSRCH (CSOP, GROUP1, NGROUP, 3) X CSDEB = 10 IF ( CSOPX .GT. 0 ) GO TO 6000 CSOPX = OPSRCH (CSOP, OTHERS, NOTHER, 11) X CSDEB = 11 IF ( CSOPX .GT. 0 ) GO TO 7000 C UNKNOWN OP CODE CSWFA = -27 X CALL EST (CSOP, LBUF, 1, 4) X CALL SGLPRT RETURN C FAULT PROCESSING C MISSING SEMICOLON 2000 CSWFA = -22 X CALL ESP (CSDEB, LBUF, 1, 6) X CALL ESP (PSYMB, LBUF, 9, 14) X CALL ESP (NEXTOP, LBUF, 17, 22) X CALL SGLPRT RETURN C ILLEGAL CRUTCH CONSTRUCTION OF SOME SORT 3000 CSWFA = -75 X CALL ESP (CSDEB, LBUF, 1, 6) X CALL ESP (OPTION, LBUF, 9, 14) X CALL ESP (CSOPX, LBUF, 17, 22) X CALL ESP (NEXTOP, LBUF, 25, 30) X CALL SGLPRT RETURN 'EJECT' C CONSTRUCT INSTRUCTIONS C IMPLIED ADDRESSING 4000 IF ( OPTION .NE. 0 ) GO TO 3000 CSOW = IMPLID (CSOPX+2) GO TO 8000 C RELATIVE ADDRESSING 5000 TS = INDFLG + IMMFLG + XFLG + YFLG + AFLG IF ( TS .NE. 0 ) GO TO 3000 CSOW = RELTIV (CSOPX+2) CSWFA = WF5 CSWFB = WF7 GO TO 8000 C GROUP 1 INSTRUCTIONS - CHECK LEGAL MODE 6000 DO 6010 TS=1,16 IF ( OPTION .EQ. G1MODE (TS) ) GO TO 6020 6010 CONTINUE C INVALID OPTION GO TO 3000 C LOOKS OK 6020 'IF' ( ABSFLG .NE. 0 ) C 2 BYTE ADDRESS CSWFA = WF8 'ELSE' C 1 BYTE ADDRESS CSWFA = WF5 'ENDIF' C CHECK FOR ZP,Y - USE ABS,Y IF ( TS .EQ. 12 ) TS=13 CSOW = GROUP1 (CSOPX+2) + ISHFT (TS-1, 1) C CHECK STA IMMEDIATE - SPECIAL NONO IF ( CSOPX .EQ. STAX .AND. IMMFLG .NE. 0 ) GO TO 3000 GO TO 7500 C OTHER INSTRUCTIONS - SLOG IT OUT 7000 DO 7010 TS=1,9 IF ( OPTION .EQ. OTHRMO(TS) ) GO TO 7020 7010 CONTINUE C CHECK FOR INDIRECT ZP - MAKE INDIRECT ABS 'IF' ( OPTION .EQ. 17 ) TS = 8 GO TO 7020 'ENDIF' C INVALID OPTION X CSDEB = 12 GO TO 3000 C PICK OUT OP CODE 7020 CSOW = OTHERS (CSOPX+1+TS) X CSDEB = 13 IF ( CSOW .LT. 0 ) GO TO 3000 C SET UP WORD FLAGS X CSDEB = 14 CSWFA = WF5 IF ( AFLG .NE. 0 ) CSWFA = WF4 IF ( INDFLG .NE. 0 .OR. ABSFLG .NE. 0 ) CSWFA = WF8 C SET UP WF IF HAVE IMMEDIATE 7500 IF ( IMMFLG .EQ. 0 ) GOTO 8000 CSWFA = WF5 'IF' ( IMMFLG .EQ. 2 ) CSWFB = 13 'ELSE' CSWFB = 12 'ENDIF' GO TO 8010 C BUILD THE INSTRUCTION 8000 IF ( CSNLX .EQ. 0 ) CSNLX = NULLX 8010 IF ( CSWFB .EQ. 0 ) CSWFA = 4 CRUCNT = CRUCNT + 1 RETURN END 'OUTFILE' OPSRCHJHP.FR C NAME OPSRCH C MODULE# C PURPOSE SEARCH A TABLE FOR AN OP CODE (2 WORDS) C CALL VALUE = OPSRCH (NAME, TABLE, SIZE, STEP) C VALUE = TABLE INDEX IF FOUND C = 0 IF NOT FOUND INTEGER FUNCTION OPSRCH (NAME, TABLE, SIZE, STEP) INTEGER NAME(2), SIZE, TABLE(1), STEP, I OPSRCH = 0 DO 10 I=1,SIZE,STEP IF (NAME(1) .EQ. TABLE(I) .AND. NAME(2) .EQ. TABLE(I+1))GOTO 20 10 CONTINUE RETURN 20 OPSRCH = I RETURN END