'HEAD' BRACE PROCESSING SUBROUTINES C EDIT DATE 09DEC78 16:43 C SOURCE FILE BRACESFTM.FS C AUTHOR F. T. MICKEY C CLUSTER 11 'OUTFILE' SETLLFTM.FR N OVERLAY OLSLL C C SET LIMITS FOR LOOP AND WHILE CONSTRUCTIONS C SUBROUTINE SETLL 'INCLUDE' LOGOSAJH.IN, 'INCLUDE' BRACEFTM.IN, 'INCLUDE' CODE1FTM.IN, 'INCLUDE' STKDFA.IN, 'INCLUDE' STKDFB.IN, 'INCLUDE' GENCMB.IN, 'INCLUDE' WFLAGSJHP.IN, 'INCLUDE' NLISTCFTM.IN, 'INCLUDE' OPERSAJH.IN, 'INCLUDE' RMCODES.IN, 'INCLUDE' BLDPOAJH.IN, 'INCLUDE' OPINXJHP.IN, 'INCLUDE' CPAREAJH.IN, INTEGER INCTL, IOP, CLXTS, LIOPX, TESTTL INTEGER CTS, TLTS, BRANCH, LOOPOP INTEGER NLOPS // EXTERNAL FUNCTION 'EJECT' CALL REGLEV (1) // SET REG LEVEL LOOPT (LSX) = TLI INCTL = TLI TESTTL = TLI + 1 TLI = TLI + 2 CALL BLDOP (76, WF8, 0, TESTTL, WF9) // JMP TO TEST CALL DEFTL (INCTL) // START OF INCREMENT CODE CALL REGMAN (CLRSTA, 0, 0) CALL REGMAN (CLRACV, 0, 0) CALL SET (0, FLSAVE, 6) C RECOVER LOOP INDEX C LIOPX = OPX - 1 NAMEX (LIOPX) = NAMEX (OPX + 3) MODE (LIOPX) = MODE (OPX + 3) CALL DUMST ('SLL ') C CHECK TYPE OF LOOP C CALL PEEK 'IF' (PEEKS .EQ. MINUS) C DECREMENTING LOOP C CALL FNZS // EAT THE MINUS IOP = MINUS BRANCH = 144 // BCC FOR SINGLE PRECISION LOOPOP = GEQ 'ELSE' C INCREMENTING LOOP C IOP = PLUS BRANCH = 176 // BCS FOR SINGLE PRECISION LOOPOP = LESSEQ 'ENDIF' C COMPILE INCREMENT VALUE C CALL BLDPO C SETUP FOR LOOP INDEX INCREMENT C CALL CLRSTK (OPX) NAMEX (OPX) = NAMEX (LIOPX) MODE (OPX) = MODE (LIOPX) TOPX = OPX - 1 NEXTX = OPX 'EJECT' C LOOK FOR SPECIAL CASES OF INCREMENT C NEXTX: LOOP INDEX C TOPX: INCREMENT C CALL GENER (SETX) CALL DUMST ('SLLI') 'IF' (CFLAG .NE. 0) 'IF' (NLOPS (CVALUE, OPTOPX) .EQ. 1) 'IF' (IOP .EQ. PLUS) C CASE IS 'FOR' A -> B, 1, X'LBR' -- USE INCREMENT C IOP = UPARO BRANCH = 240 // BEQ 'ELSE' C CASE IS 'FOR' A -> B, -1, X'LBR' -- USE DECREMENT C IOP = DNARO 'IF' (MODE (LIOPX) .EQ. SPMODE) C LOAD THE LOOP INDEX C CALL SETUP (LDAINX, NEXTX) CALL GEN (COM + 1, NEXTX, LIOPX) C RESERVE TWO TRANSFER LIST LABELS TLTS = TLI TLI = TLI + 2 C CHECK FOR CASE 'FOR' A -> B, -1, 0'LBR' C OPX = OPX + 1 CALL ADVAN 'IF' (NEXTOP .EQ. LBRACE .AND. CFLAG .NE. 0) IF (NLOPS (CVALUE, NAMEX (OPX)) .NE. 0)GO TO 50 C FOUND THE SPECIAL CASE, C CALL BLDOP (208, WF5, 0, TLTS, WF9) // BNE IN CALL BLDOP (76, WF8, 0, TLTS + 1, WF9) // JMP LOOPE LOOPE (LSX) = TLTS + 1 CALL DEFTL (TLTS) // IN: C NOW DO DECREMENT, SETUP ALREADY DONE CALL GEN (DNARO, LIOPX, NEXTX) CALL DEFTL (TESTTL) // TEST: GO TO 100 // CLEAN UP AND EXIT 'ENDIF' 50 CALL STUFF // UNDO THE ADVANCE OPX = OPX - 1 CALL BLDOP (240, WF5, 0, TLTS, WF9) // BEQ OUT CALL GEN (-2, TLTS, 0) // SET INTBR BRANCH = 0 // TEST DONE 'ENDIF' 'ENDIF' 'ENDIF' 'ENDIF' 'EJECT' C GENERATE LOOP INCREMENT CODE C CALL SETUP (LDAINX, NEXTX) 'IF' (IOP .LE. MINUS) C DO ADD OR SUBTRACT, NEED STORE C CALL SETUP (LDAINX, TOPX) CALL GEN (IOP, NEXTX, TOPX) CALL GENER (OUT) CALL CLRSTK (OPX) NAMEX (OPX) = NAMEX (LIOPX) MODE (OPX) = MODE (LIOPX) CALL SETUP (STAINX, NEXTX) CALL GEN (-1, -2, LIOPX-2) CALL GEN (ARROW, TOPX, NEXTX) CALL GEN (-1, -2, -2) 'ELSE' C DO INCREMENT OR DECREMENT C CALL GEN (IOP, LIOPX, NEXTX) 'ENDIF' OPX = OPX - 1 'IF' (MODE (LIOPX) .EQ. SPMODE) C ADDITIONAL END CONDITION CODE FOR SP LOOPS C TLTS = TLI TLI = TLI + 1 CALL ADVAN 'IF' (NEXTOP .EQ. LBRACE .AND. CFLAG .NE. 0) CTS = NLOPS (CVALUE, NAMEX (OPX)) 'IF' (CTS .EQ. 0 .AND. IOP .EQ. MINUS) C CASE 'FOR' A -> B, -C, 0'ELSE' C BRANCH = 176 // BCS IN GO TO 900 'ENDIF' 'IF' (CTS .EQ. 255 .AND. IOP .NE. MINUS) 'IF' (IOP .EQ. UPARO) C SPECIAL CODE FOR 'FOR' A -> B, 1, 255'LBR' C BRANCH = 208 // BNE IN 'ELSE' BRANCH = 144 // BCC IN 'ENDIF' GO TO 900 'ENDIF' 'ENDIF' CALL STUFF // UNDO ADVANCE 'IF' (BRANCH .NE. 0) CALL BLDOP (BRANCH, WF5, 0, TLTS, WF9) // BCS/BCC LOOPE CALL GEN (-2, TLTS, 0) // SET INTBR TO TLTS 'ENDIF' 'ENDIF' 'EJECT' CALL REGLEV (3) // RECOVER REG LEVEL CALL REGMAN (CLRSTA, 0, 0) CALL DEFTL (TESTTL) // DEFINE THE TEST POINT CALL SET (0, FLSAVE, 6) CALL BLDPO // COMPILE THE SECOND LIMIT C NEXTX: LOOP INDEX C TOPX: SECOND LIMIT C TOPX = OPX - 1 NEXTX = LIOPX CALL DUMST ('SLLX') CALL SETUP (LDAINX, NEXTX) CALL SETUP (LDAINX, TOPX) CLXTS = CLX ILB = 0 TRUEF = -1 CALL GEN (LOOPOP, NEXTX, TOPX) // STANDARD CONDITIONAL CODE 'FOR' (I = CLXTS; I .LT. CLX; I = I + 1) L = CPLOC (I) IF (L .LT. 0) ^ LOOPE (LSX) = -L // SAVE TO JUMP TO FALSE INDEX IF (L .GT. 0) CALL DEFTL (L) // BRANCHES INTO LOOP CPLOC (I) = 0 'END' CLX = CLXTS 100 STOAC = 0 LOOPF (LSX) = 0 // THIS IS A LOOP BRACE LSX = LSX + 1 OPX = 2 BSTACK (BRACEX) = 0 IF (NEXTOP .NE. LBRACE)CALL FAULTP (58) 'IF' (BRACEX .LT. 9) BRACEX = BRACEX + 1 'ELSE' CALL FAULTP (59) 'ENDIF' RETURN C ALL TEST CODE GENERATED WITHOUT CALL TO GEN FOR <=, >= CODE C 900 CALL BLDOP (BRANCH, WF5, 0, TESTTL, WF9) // BCS/BNE/BCC CALL BLDOP (76, WF8, 0, TLTS, WF9) // JMP LOOPE CALL DEFTL (TESTTL) // IN: TEST: LOOPE (LSX) = TLTS GO TO 100 END 'OUTFILE' STSLXFTM.FR SUBROUTINE STSLX (FUNC) C FUNC = 1 -- STEP SELX C FUNC = 2 -- BUMP SELX C INTEGER FUNC 'INCLUDE' BRACEFTM.IN, 'INCLUDE' NLISTCFTM.IN, IF (FUNC .EQ. 1) PARCNT = 0 SELX = SELX + 1 'IF' (SELX .GT. 9) SELX = 9 CALL FAULTP (52) 'ELSE' PARCNT = PARCNT + PARFLG 'ENDIF' IF (FUNC .EQ. 1) CALL ADVAN RETURN END 'OUTFILE' PLBRFTM.FR SUBROUTINE PLBR 'INCLUDE' BRACEFTM.IN, 'INCLUDE' LOGOSAJH.IN, 'INCLUDE' OPERSAJH.IN, 'INCLUDE' NLISTCFTM.IN, 'INCLUDE' WFLAGSJHP.IN, 'INCLUDE' CODE1FTM.IN, BSTACK (BRACEX) = 1 'IF' (PARCNT .NE. 0) NUMBER = (PARCNT * 2) - 1 CALL BLDOP (160, WF5, NUMBER, NULLX, WF7) // LDY =PARCNT CALL DEFTL (TLI) CALL SET (1, FLSAVE, PARCNT) CALL BLDOP (185, WF8, 0, FLS (1), WF7) // LDA FL0,Y CALL BLDOP (153, WF8, 0, PARSAV, WF7) // STA TEMP,Y CALL BLDBLK (136, WF4) // DEY CALL BLDOP (16, WF5, 0, TLI, WF9) // BPL XXXTL TLI = TLI + 1 'ENDIF' IF (NEXTOP .NE. LBRACE) CALL FAULTP (58) 'IF' (BRACEX .GT. 9) CALL FAULTP (59) 'ELSE' BRACEX = BRACEX + 1 'ENDIF' RETURN END 'OUTFILE' PRBRFTM.FR N OVERLAY OLRBR SUBROUTINE PRBR 'INCLUDE' LOGOSAJH.IN, 'INCLUDE' WFLAGSJHP.IN, 'INCLUDE' NLARAYFTM.IN, 'INCLUDE' NLISTCFTM.IN, 'INCLUDE' BRACEFTM.IN, 'INCLUDE' RMCODES.IN, INTEGER PLCTS, PLCLIM INTEGER GCHAR, MODTXT BRACEX = BRACEX - 1 'IF' (BRACEX .LT. 1) CALL FAULTP (14) BRACEX = 1 'ELSE' L = BSTACK (BRACEX) 'IF' (L .EQ. 0) C POST LOOP CONTROL C LSX = LSX - 1 PLCTS = LOOPT (LSX) CALL BLDOP (76, WF8, 0, PLCTS, WF9) // JMP TO LOOPI/'DO' 'IF' (LOOPF (LSX) .EQ. 0) // LOOP RIGHT BRACE CALL DEFTL (LOOPE (LSX)) 'ELSE' 'IF' (WHLOW (LSX) .GE. 0) // WHILE RIGHT BRACE SELX = WHLOW (LSX) PLCLIM = WHHIGH (LSX) - 1 'DOLOOP' PLCTS = SELX, PLCLIM CALL DEFTL (SUBENT (PLCTS)) 'END' 'ENDIF' 'ENDIF' CALL REGMAN (CLRACV, 0, 0) CALL SET (0, FLSAVE, 6) LOOPT (LSX) = 0 LOOPE (LSX) = 0 LOOPF (LSX) = 0 'ELSE' 'EJECT' 'IF' (L .GT. 0) C FUNCTION AND SUBROUTINE TERMINATION C SELX = SELX - 1 'IF' (SELX .LT. 1) SELX = 1 CALL FAULTP (53) 'ELSE' PARCNT = SUBENT (SELX) SELXB = SELX - PARCNT 'IF' (PARCNT .NE. 0) SPARFL = 0 'FOR' (K = SELXB; K .LT. SELX; K = K + 1) NLX = SUBENT (K) TX = MODTXT (NLX) CALL PCHAR (NTEXT (TX), 1, ^ GCHAR (NTEXT (TX), 1) + LOCALB) 'END' 'ENDIF' SELX = SELXB 'IF' (SELX .LT. 1) SELX = 1 CALL FAULTP (53) 'ENDIF' 'ENDIF' CALL BLDBLK (96, WF4) // RTS 'ENDIF' 'ENDIF' 'ENDIF' RETURN END