'HEAD' BASE LEVEL CODE GENERATION C EDIT DATE 05FEB79 14:13 C SOURCE FILE GENDOAJH.FS C AUTHOR A. J. HOWARD C CLUSTER 19 'OUTFILE' GENDOAJH.FR SUBROUTINE GENDO 'INCLUDE' NLISTCFTM.IN, 'INCLUDE' REGSJHP.IN, 'INCLUDE' RMCODES.IN, 'INCLUDE' STKDFA.IN, 'INCLUDE' STKDFB.IN, 'INCLUDE' STKDFE.IN, 'INCLUDE' STKDFF.IN, 'INCLUDE' WFLAGSJHP.IN, 'INCLUDE' GENCMA.IN, INTEGER OPTS, WFTS, BIASTS, TSUBX INTEGER DUMMY, TSUBXB, TSUBOP, TWFSOP INTEGER NAMXTS INTEGER MAGIC (28) INTEGER NLOPS LOGICAL NLTEST DATA MAGIC / ^ // CONVERT FROM LDA TO REAL OP CODE 32, ^ // = 32, ^ // # 64, ^ // > 64, ^ // >= 64, ^ // < 64, ^ // <= -32, ^ // -> -64, ^ // + 64, ^ // - 0, 0, 0,^ // * / 'MOD' NOT USED 0, 0, ^ // 'OR' & RELATIONAL NOT USED -160, ^ // 'OR' -96, ^ // 'XOR' -128, ^ // & 0, 0, 0,^ // SHIFTS USE LOAD 0, 0, 0,^ // SHIFTS USE LOAD 64, ^ // NEG SAME AS - 65, ^ // ^ 33, ^ // 'DEC' 0, ^ // 'COM' USES LOAD 0/ // LOAD 'EJECT' C IF THE SIDE IS RIGHT TURN THE LOAD OP CODE INTO C THE PROPER OP CODE FOR THE OPERATION C GENERATE THE INSTRUCTION C SET ACTREG (THIS) = AREG 'IF' (MODE (SIDE) .EQ. SPMODE .AND. THIS .EQ. HI) C THE HI BYTE OF AN SP VALUE IS 0 OPTS = LDAI IF (SIDE .EQ. RIGHT) OPTS = OPTS + MAGIC (BASE) CALL BLDOP (OPTS, WF5, 0, NULLX, WF7) 'ELSE' OPTS = OPCODE (SIDE) C ADJUST THE BIAS AND WORD FLAG AS NEEDED BIASTS = BIAS (SIDE) WFTS = WFOPND (SIDE) TSUBX = SUBX (SIDE) NAMXTS = NAMEX (SIDE) 'IF' (SIDE .EQ. RIGHT) C CONVERT OPCODE FROM LOAD OPTS = OPTS + MAGIC (BASE) 'ELSE' 'IF' (NLTEST (NAMXTS, REGBIT)) CALL GENTRA (NLOPS (REGNUM, NAMXTS), AREG) RETURN 'ENDIF' 'ENDIF' IF (TSUBX .NE. 0) ^ // SUBSCRIPTED ? GO TO 200 C NO SUBSCRIPT 'IF' (THIS .EQ. HI) 'IF' (WFTS .LE. WF8) BIASTS = BIASTS + 1 'ELSE' WFTS = WFTS + 1 'ENDIF' 'ENDIF' 100 CALL BLDOP (OPTS, WFOP (SIDE), BIASTS, NAMXTS, WFTS) 'ENDIF' IF (.NOT. EZSTA) ACTREG (THIS) = AREG RETURN 'HEAD' SUBSCRIPT CODE GENERATION 'EJECT' 200 'IF' (NLTEST (TSUBX, REGBIT)) C REGISTER AS SUBSCRIPT TS = NLOPS (REGNUM, TSUBX) 'IF' (TS .EQ. AREG) CALL REGMAN (SAVREG, YREG, DUMMY) CALL BLDBLK (168, WF4) // TAY SUBX (SIDE) = REGS (YREG) 'ELSE' IF (TS .EQ. XREG) ^ OPTS = OPTS + 4 // USE XREG FORM 'ENDIF' 'IF' (THIS .EQ. HI) 'IF' (OPCODE (SIDE) .EQ. 177) // LDA @Y CALL BLDBLK (200, WF4) // INY CALL REGMAN (CLRACX, YREG, 0) 'ELSE' BIASTS = BIASTS + 1 'ENDIF' 'ENDIF' 'ELSE' C SUBSCRIPT IS NOT A REGISTER TSUBXB = SUBXB (SIDE) 'IF' (THIS .EQ. HI) 'IF' (OPCODE (SIDE) .EQ. 177) // LDA @ Y TSUBXB = TSUBXB + 1 // ADJUST YREG VALUE 'ELSE' BIASTS = BIASTS + 1 // ADJUST ADDRESS BIAS 'ENDIF' 'ENDIF' TSUBOP = SUBOP (SIDE) TWFSOP = WFSOP (SIDE) CALL REGSRC (7, TSUBOP, TWFSOP, TSUBX, 0, TSUBXB, 0) IF (TSUBOP .GE. 0) ^ CALL BLDOP (TSUBOP, TWFSOP, TSUBXB, TSUBX, WF7) 'ENDIF' GO TO 100 END 'HEAD' LOAD A REGISTER 'OUTFILE' GENLAAJH.FR SUBROUTINE GENLA 'INCLUDE' GENCMA.IN, 'INCLUDE' REGSJHP.IN, 'INCLUDE' RMCODES.IN, 'INCLUDE' STKDFA.IN, 'INCLUDE' STKDFB.IN, INTEGER X, TRACK 'IF' (SIDE .EQ. LEFT) TRACK = LSTKX 'ELSE' TRACK = RSTKX 'ENDIF' X = 0 IF (TRACK .NE. 0) ^ CALL REGSRC (2, NAMEX (LSTKX), MODE (LSTKX), ^ SUBX (LSTKX), SUBXM (LSTKX), ^ BIAS (LSTKX), X) 'IF' (X .NE. AREG) IF (STAREG .NE. SIDE + STKSIZ) ^ CALL REGMAN (SAVREG, AREG, X) CALL GENDO 'ENDIF' 'IF' (TRACK .NE. 0) CALL REGMAN (SETREG, AREG, TRACK) 'ELSE' CALL REGMAN (CLRACX, AREG, 0) 'ENDIF' RETURN END 'HEAD' TRANSFER REGISTER/REGISTER 'OUTFILE' GENTRAAJH.FR SUBROUTINE GENTRA (INREG, OUTREG) INTEGER INREG, OUTREG 'INCLUDE' REGSJHP.IN, 'INCLUDE' RMCODES.IN, 'INCLUDE' WFLAGSJHP.IN, INTEGER REGREG (3, 3), X, DUMMY DATA REGREG / ^ 0, ^ // ERROR 138, ^ // TXA 152, ^ // TYA 170, ^ // TAX 0, ^ // ERROR 0, ^ // ERROR 168, ^ // TAY 0, ^ // ERROR 0/ // ERROR CALL REGMAN (SAVREG, OUTREG, DUMMY) X = REGREG (INREG, OUTREG) IF (X .EQ. 0) CALL FAULTP (6) CALL BLDBLK (X, WF4) STATUS (OUTREG) = STATUS (INREG) STATUS (INREG) = 0 ACTLO = OUTREG CALL REGMAN (TRAREG, INREG, OUTREG) RETURN END 'HEAD' LOAD X/Y REGISTER 'OUTFILE' GENLXYAJH.FR SUBROUTINE GENLXY (OREG) 'INCLUDE' GENLXYAJH.IN,P 'OUTFILE' GLXYAJH.FR SUBROUTINE GLXY (OREG) 'INCLUDE' GENLXYAJH.IN,P 'HEAD' STORE X/Y REGISTER 'OUTFILE' GENSXYAJH.FR SUBROUTINE GENSXY (IREG, TRANS) INTEGER IREG, TRANS 'INCLUDE' REGSJHP.IN, 'INCLUDE' STKDFA.IN, 'INCLUDE' STKDFE.IN, 'INCLUDE' GENCMA.IN, TS = OPCODE (RIGHT) 'IF' (TS .EQ. LDAZP .OR. TS .EQ. LDAABS) OPCODE (RIGHT) = TS + TRANS EZSTA = .TRUE. 'ELSE' C GO THROUGH AREG C CALL GENTRA (IREG, AREG) 'ENDIF' RETURN END 'HEAD' MOVE DP REGISTER 'OUTFILE' GENMOVAJH.FR SUBROUTINE GENMOV 'INCLUDE' LOGOSAJH.IN, 'INCLUDE' OPERSAJH.IN, 'INCLUDE' REGSJHP.IN, 'INCLUDE' RMCODES.IN, 'INCLUDE' STKDFA.IN, 'INCLUDE' STKDFE.IN, 'INCLUDE' WFLAGSJHP.IN, 'INCLUDE' GENCMA.IN, 'EJECT' C MOVE THE DP REG ONE WAY OR THE OTHER 'IF' (OP .GE. ARROW .AND. .NOT. EZSTA) 'IF' (NEXTOP .GT. RBRACE .OR. ^ (OP .NE. ARROW .AND. OP .NE. UPARO .AND. OP .NE. DNARO)) 'IF' (ACTREG (OTHER) .EQ. XREG) C XREG IS BUSY, USE CORE CALL REGMAN (CTFREE, TS, 1) CALL BLDOP (STAZP, WF5, THIS-1, REGS (TS), WF7) STATUS (TS) = SIDE ACTREG (THIS) = TS 'ELSE' C MOVE IT TO XREG CALL REGMAN (SAVREG, XREG, DUMMY) CALL BLDBLK (TAX, WF4) STXREG = SIDE ACTREG (THIS) = XREG 'ENDIF' 'ENDIF' 'ENDIF' C LOAD THE OTHER HALF C EXCHANGE SIDES TS = THIS THIS = OTHER OTHER = TS 'IF' (ACTREG (THIS) .EQ. XREG) 'IF' (EZSTA) C STORE DIRECTLY FROM XREG OPCODE (RIGHT) = OPCODE (RIGHT) + 1 'ELSE' CALL BLDBLK (TXA, WF4) STXREG = 0 ACTREG (THIS) = AREG 'ENDIF' 'ELSE' C IF IT IS IN A CT, LOAD IT TS = ACTREG (THIS) 'IF' (TS .GT. YREG) CALL BLDOP (LDAZP, WF5, THIS-1, REGS (TS), WF7) ACTREG (THIS) = AREG STATUS (TS) = 0 'ELSE' C IT IS STILL IN CORE, GET IT SIDE = LEFT CALL GENDO 'ENDIF' 'ENDIF' RETURN END