'HEAD' CODE GENERATORS C EDIT DATE 14JAN79 09:01 C SOURCE FILE CODE2AJH.FS C AUTHOR A. J. HOWARD C CLUSTER 12 'OUTFILE' CODE2AJH.FR N OVERLAY OLCD2 SUBROUTINE CODE2 (OPTYPE) 'INCLUDE' LOGOSAJH.IN, 'INCLUDE' ATESTAJH.IN, 'INCLUDE' BLDPOAJH.IN, 'INCLUDE' NLISTCFTM.IN, 'INCLUDE' OPERSAJH.IN, 'INCLUDE' REGSJHP.IN, 'INCLUDE' STKDFA.IN, 'INCLUDE' STKDFB.IN, 'INCLUDE' STKDFC.IN, 'INCLUDE' STKDFD.IN, 'INCLUDE' WFLAGSJHP.IN, 'INCLUDE' OPINXJHP.IN, 'INCLUDE' GENCMB.IN, INTEGER OPTYPE INTEGER NOTEMP, SHFTB, TCVAL, TS INTEGER QQMOD LOGICAL OPEQU, OPNEQ INTEGER NLOPS, ENTNUM LOGICAL NLTEST GO TO ( 1, 1, 1, 1, 1, 1, ^ 700, 100, 500, 1, 300, 600, ^ 400, 400, 200, 1), OPTYPE 1 CALL FATAL (6) 'EJECT' C ADD / SUBTRACT / OR / XOR / AND C CHECK FOR 'LOC' A [K1] - 'LOC' B [K2] C 100 'IF' (OP .EQ. MINUS ^ .AND. LOCFLG (NEXTX) .NE. 0 ^ .AND. LOCFLG (TOPX) .NE. 0 ^ .AND. SUBX (NEXTX) .EQ. 0 ^ .AND. SUBX (TOPX) .EQ. 0) 'IF' (.NOT. NLTEST (OPNXTX, PBIT) ^ .AND. NLOPS (DFINED, OPNXTX) .NE. 0) 'IF' (NLOPS (NLXLCI, OPNXTX) .EQ. NLOPS (NLXLCI, OPTOPX)) NUMBER = NLOPS (NAMLOC, OPNXTX) + BIAS (NEXTX) ^ - NLOPS (NAMLOC, OPTOPX) - BIAS (TOPX) BIAS (NEXTX) = 0 NAMEX (NEXTX) = ENTNUM (DUMMY) LOCFLG (NEXTX) = 0 GO TO 199 'ENDIF' 'ENDIF' 'IF' (LOGICF .EQ. 0) C IN THE NOUN LIST C CALL BLDBLK (OPTOPX, WF16) BIAS (NEXTX) = BIAS (NEXTX) - BIAS (TOPX) GO TO 199 'ENDIF' 'ENDIF' TCVAL=1 //**ICLMOD** ASSIGN 101 TO TCVAL GO TO 2000 // CHECK FOR CONSTANTS C CHECK FOR +/- CONSTANT ] C 101 'IF' (OP .LE. MINUS) 'IF' (NEXTOP .EQ. RBK .AND. NLTEST (OPTOPX, CBIT)) SBIAS = NLOPS (CVALUE, OPTOPX) IF (OP .EQ. MINUS) SBIAS = -SBIAS GO TO 199 'ENDIF' 'ENDIF' 'EJECT' C IF THE SUBSCRIPT PART OF TOP IS IN A REGISTER, AND THE OPERATION C IS COMMUNITIVE; SWAP THE ORDER OF OPERATION C TS = SUBX (TOPX) 'IF' (TS .NE. 0) IF (NLTEST (TS, REGBIT) .AND. OP .NE. MINUS) ^ CALL GENER (SWAP) 'ENDIF' CALL GENER (SMODEX) 'IF' (OP .EQ. AANDOP) 'IF' (MODEX .EQ. 2) C SP & DP, DP & SP IS SP C CALL GENER (TOPSP - RAWMDX + 3) MODEX = 1 'ENDIF' C LOOK FOR SPECIAL CASES C SP & 080 = 0: C SP & 080 # 0: OPEQU = NEXTOP .EQ. EQUAL OPNEQ = NEXTOP .EQ. NEQUAL 'IF' (MODEX .EQ. 1 .AND. (OPEQU .OR. OPNEQ)) 'IF' (NLTEST (OPTOPX, CBIT) ^ .AND. NLOPS (CVALUE, OPTOPX) .EQ. 128) OPX = OPX + 1 NOTEMP = NEXTOP CALL ADVAN CALL STUFF OPX = OPX - 1 'IF' (CFLAG .NE. 0 .AND. NEXTOP .EQ. COLON ^ .AND. NLOPS (CVALUE, NAMEX (OPX+1)) .EQ. 0) ATEST = .TRUE. IF (OPEQU) NEXTOP = GEQ IF (OPNEQ) NEXTOP = LESS GO TO 199 'ENDIF' NEXTOP = NOTEMP 'ENDIF' 'ENDIF' 'ENDIF' 'IF' (OP .NE. MINUS) SPTR = TOPX CALL GENER (TSTSTK) // SEE IF TOP IS A REGISTER NOW IF (GENRET .EQ. 1) ^ CALL GENER (SWAP) 'ENDIF' CALL MSTAK (NEXTX, NEXTX+2) CALL SETUP (LDAINX, NEXTX) CALL SETUP (LDAINX, TOPX) CALL GEN (-1, NEXTX, -2) CALL GEN (OP, NEXTX, TOPX) // LOAD AND OPERATE CALL GEN (-1, -2, -2) CALL GENER (OUT) // SET NEW STATUS 199 RETURN 'EJECT' C COMPLEMENT 200 IF (OPNXTX .NE. 0) CALL FAULTP (50) 'IF' (CFLAG .NE. 0) NUMBER = NOT (NLOPS (CVALUE, OPTOPX)) NAMEX (NEXTX) = ENTNUM (DUMMY) RETURN 'ENDIF' GO TO 610 // SHARED WITH 'NEG' C SHIFTS 300 TCVAL=2 //**ICLMOD** ASSIGN 301 TO TCVAL GO TO 2000 // CHECK FOR CONSTANTS C GENERATE CODE 301 CALL MSTAK (NEXTX, NEXTX+2) CALL SETUP (LDAINX, TOPX) CALL SETUP (LDAINX, NEXTX) CALL GEN (-1, NEXTX, -2) CALL GEN (OP, NEXTX, TOPX) CALL GEN (-1, -2, -2) CALL GENER (OUT) RETURN C INCREMENT / DECREMENT 400 IF (OPNXTX .NE. 0) CALL FAULTP (50) 'IF' (IAND (OSTACK (TOPX), OCBIT) .NE. 0 ^ .OR. LOCFLG (TOPX) .NE. 0) CALL FAULTP (23) 'ELSE' C GENERATE CODE C CALL MSTAK (TOPX, NEXTX) CALL SETUP (LDAINX, TOPX) CALL GEN (OP, NEXTX, TOPX) 'ENDIF' STOAC = 1 RETURN 'EJECT' C MULTIPLY / DIVIDE / MOD 500 TCVAL=3 //**ICLMOD** ASSIGN 501 TO TCVAL GO TO 2000 // CHECK FOR CONSTANTS C GENERATE CODE C 501 TS = TOPX + 1 CALL CLRSTK (TS) NAMEX (TS) = REMNLX CALL SETUP (STAINX, TS) CALL SETUP (LDAINX, NEXTX) CALL SETUP (LDAINX, TOPX) MODE (TS) = MODE (NEXTX) NOTEMP = NEXTOP NEXTOP = COMMA CALL GEN (ARROW, NEXTX, TS) ACTHI = 0 ACTLO = 0 BIAS (TS) = 2 MODE (TS) = MODE (TOPX) CALL GEN (ARROW, TOPX, TS) NEXTOP = NOTEMP ACTHI = 0 ACTLO = 0 CALL GEN (OP, NEXTX, TOPX) RETURN C NEGATE 600 'IF' (CFLAG .NE. 0) NUMBER = -NLOPS (CVALUE, OPTOPX) NAMEX (NEXTX) = ENTNUM (DUMMY) RETURN 'ENDIF' C GENERATE CODE FOR NEGATE OR COMPLEMENT C 610 CALL SETUP (LDAINX, TOPX) MODE (NEXTX) = MODE (TOPX) CALL GEN (OP, TOPX, TOPX) CALL GENER (OUT) RETURN 'EJECT' C STORE 700 IF (IAND (OSTACK (TOPX), OCBIT) .NE. 0 ^ .OR. LOCFLG (TOPX) .NE. 0) ^ CALL FAULTP (23) IF (OPTOPX .EQ. OPNXTX ^ .AND. LOCFLG (NEXTX) .EQ. 0 ^ .AND. MODE (TOPX) .EQ. MODE (NEXTX) ^ .AND. SUBX (TOPX) .EQ. SUBX (NEXTX) ^ .AND. BIAS (TOPX) .EQ. BIAS (NEXTX) ) GO TO 799 C SAVE THE ORIGINAL FORM OF THE OPERANDS C CALL MSTAK (NEXTX, NEXTX + 2) CALL MSTAK (TOPX, TOPX + 2) C SETUP THE ADDRESSES AND DO THE STORE C CALL SETUP (LDAINX, NEXTX) CALL SETUP (STAINX, TOPX) CALL GEN (-1, NEXTX, TOPX) CALL GEN (ARROW, NEXTX, TOPX) CALL GEN (-1, -2, -2) CALL GENER (OUT) 799 STOAC = 1 RETURN 'EJECT' C TEST CONSTANT VALUES 2000 'IF' (CFLAG .NE. 0 ^ .AND. IAND (OSTACK (OPX-1), OCBIT) .NE. 0) QVALUE = 0 L = NLOPS (CVALUE, OPTOPX) K = NLOPS (CVALUE, OPNXTX) SHFTB = 8 IF (K .LT. 0 .OR. K .GT. 255) SHFTB = 16 TS = OP - PLUS + 1 GO TO (2010, 2020, 2030, 2040, 2050, ^ 2060, 2070, 2060, 2080, 2070, ^ 2090, 2100, 2110, 2120, 2130, 2140), TS 2010 NUMBER = K + L GO TO 2500 2020 NUMBER = K - L GO TO 2500 2030 NUMBER = K * L GO TO 2500 2040 NUMBER = K / L GO TO 2500 2050 NUMBER = QQMOD (K, L) GO TO 2500 2060 NUMBER = IOR (K, L) GO TO 2500 2070 NUMBER = IAND (K, L) GO TO 2500 2080 NUMBER = IEOR (K, L) GO TO 2500 2090 NUMBER = ISHFT (K, L) IF (SHFTB .EQ. 8) GO TO 2115 GO TO 2500 2100 NUMBER = ISHFT (K, -L) GO TO 2500 'EJECT' C LEFT CYCLE C 2110 NUMBER = ISHFT (K, L) + ISHFT (K, L-SHFTB) IF (SHFTB .NE. 8) GO TO 2500 2115 NUMBER = IAND (NUMBER, 255) GO TO 2500 C RIGHT CYCLE C 2120 NUMBER = ISHFT (K, SHFTB-L) + ISHFT (K, -L) IF (SHFTB .EQ. 8) GO TO 2115 GO TO 2500 C A LEFT SHIFT C 2130 NUMBER = ISHFT (K, L) IF (SHFTB .EQ. 8) GO TO 2115 'IF' (K .LT. 0) NUMBER = IOR (NUMBER, ISHFT (1, 15)) 'ELSE' NUMBER = IAND (NUMBER, 32767) 'ENDIF' GO TO 2500 C A RIGHT SHIFT C 2140 NUMBER = ISHFT (K, -L) IF (SHFTB .EQ. 8) GO TO 2115 IF (K .LT. 0) NUMBER = IOR (NUMBER, ISHFT (-1, 16-L)) 2500 NAMEX (NEXTX) = ENTNUM (DUMMY) RETURN 'ENDIF' CFLAG = 0 'IF' (LOGICF .EQ. 0) CALL FAULTP (11) // CAN'T HAVE VARIABLES IN NOUNLIST RETURN 'ENDIF' GOTO (101,301,501),TCVAL //**ICLMOD** GO TO TCVAL END