C C C P 1 S U D O C C PASS1 PSEUDO OP HANDLER C C THIS ROUTINE IS CALLED WHENEVER A PSEUDO-OP IS FOUND DURING PASS 1. C EACH PSEUDO-OP HAS A SECTION WHICH PERFORMS ANY ACTIONS WHICH ARE C REQUIRED.IT SHOULD BE NOTED THAT SEVERAL PSEUDO-OPS ARE NOT ACTED C ON DURING PASS 1 , NOTABLY THE LISTING CONTROL PSEUDO-OPS.EACH OF C THE PSEUDO-OPS WILL BE DISCUSSED IN THE APPROPRIATE SECTIONS. C SUBROUTINE P1SUDO ( IFLAG ) INCLUDE 'BSUCOM.CMN' INCLUDE 'IODEVS.CMN' INCLUDE 'LSTHDG.CMN' INCLUDE 'OUTLIN.CMN' INCLUDE 'PRGDAT.CMN' INCLUDE 'PRMSYM.CMN' INCLUDE 'SRCLIN.CMN' INCLUDE 'USRSYM.CMN' INTEGER*4 IVAL LOGICAL SUBTIT INTEGER BLANKS , COMMAS EQUIVALENCE ( KEYCHR(12) , BLANKS ) , ( KEYCHR(20) , COMMAS ) DATA SUBTIT/.FALSE./ IFTFLG = 1 INDEX = OPVALU(OPINDX) D WRITE (5,1) INDEX D 1 FORMAT (' P1SUDO CALLED TO HANDLE ',I6) GO TO (100 ,200 ,300 ,400 ,500 ,600 ,700 ,800 , * 900 , 1000 , 1100 , 1200 , 1300 , 1400 , 1500 , 1600 , * 1700 , 1800 , 1900 , 2000 , 2100 , 2200 , 2300 , 2400 , * 2500 , 2600 , 2700 , 2800 , 2900 , 3000 , 3100 , 3200 , * 3300 , 3400 , 3500 , 3600 , 3700 ) , INDEX C C . A S C I I. A S C I T. A S C I Z C ============================================= C 100 CONTINUE 200 CONTINUE 300 CONTINUE IVAL = 0 CALL TRIVIA ( 3 , J ) !FIND FIRST NON-BLANK IN REMAIN IF ( J .GT. EOR ) GO TO 11000 !OOPS NO TEXT IDELIM = REMAIN(J) !SAVE DELIMETER J = J + 1 DO 350 I = J , EOR !COUNT CHARACTERS IF ( REMAIN(I) .EQ. IDELIM ) GO TO 360 IVAL = IVAL + 1 350 CONTINUE 360 CONTINUE IF ( INDEX .GT. 1 ) IVAL = IVAL + 1 !FOR .ASCIT AND .ASCIZ GO TO 10000 C C . B L O C K C =========== C 400 CONTINUE CALL XPRSIN ( IFLAG , IVAL ) !DETERMINE NUMBER OF BYTES IF ( IVAL .LT. 0 ) IVAL = 0 !CAN'T BE NEGATIVE GO TO 10000 C C . B Y T E . D B Y T E C =========================== C 500 CONTINUE 600 CONTINUE GO TO 9000 C C . D E F C ======= C 700 CONTINUE GO TO 11000 C C . E N D C ======= C 800 CONTINUE IFLAG = -1 RETURN C C . E N D I F C =========== C 900 CONTINUE IF ( IFCNT .LE. 0 ) GO TO 11000 IFCNT = IFCNT - 1 I = IPOP(IFFLAG) GO TO 11000 C C . E N D M C ========= C 1000 CONTINUE GO TO 11000 C C . E N D R C ========= C 1100 CONTINUE GO TO 11000 C C . E Q L C ======= C 1200 CONTINUE IF ( LABEL(1) .EQ. BLANKS ) GO TO 11000 CALL XPRSIN ( IFLAG , IVAL ) SYMVAL(SYMNUM) = IVAL SYMFLG(SYMNUM) = BLANKS GO TO 11000 C C . F C O N C ========= C 1300 CONTINUE GO TO 11000 C C . G L O B L C =========== C 1400 CONTINUE GO TO 11000 C C . I F D E F C =========== C 1500 CONTINUE 1600 CONTINUE 1700 CONTINUE 1800 CONTINUE 1900 CONTINUE 2000 CONTINUE 2100 CONTINUE 2200 CONTINUE 2300 CONTINUE 2400 CONTINUE GO TO 11000 C C . L I S T C ========= C 2500 CONTINUE GO TO 11000 C C . M A C R O C =========== C 2600 CONTINUE GO TO 11000 C C . N L I S T C =========== C 2700 CONTINUE GO TO 11000 C C . O R G C ======= C 2800 CONTINUE CALL XPRSIN ( IFLAG , IVAL ) C IF ( IVAL .LT. 0 ) IVAL = PCNTR ! INSERT FOR 32 BIT MACHINES PCNTR = IVAL IF ( LABIDX .GT. 0 ) SYMVAL(LABIDX) = PCNTR GO TO 11000 C C . Q B Y T E C =========== C 2900 CONTINUE GO TO 11000 C C . R A D I X C =========== C 3000 CONTINUE CALL XPRSIN ( IFLAG , IVAL ) IF ( IVAL .GE. 2 .AND. IVAL .LE. 16 ) RADIX = IVAL GO TO 11000 C C . R E P T C ========= C 3100 CONTINUE GO TO 11000 C C . S B T T L C =========== C 3200 CONTINUE C C CLEAN OUT OLD SUBTITLE C IF(SUBTIT) GO TO 11000 !ONLY FIRST TIME THROUGH DO 3210 I=1,60 !AFTER THAT, SKIP IT SO SUBTTL(I) = BLANKS !THAT THE .SBTTL ON THE 3210 CONTINUE !FIRST PAGE STAYS THERE. C C SAVE THE SUBTITLE C CALL TRIVIA(3,J) !FIND FIRST REAL CHARACTER IF (J.GT.EOR) GO TO 11000 !NONE THERE, THAT'S IT K = 1 !NOW LET'S COPY IT L = MIN(EOR,60) DO 3220 I=J,L SUBTTL(K) = REMAIN(I) K = K+1 3220 CONTINUE SUBTIT = .TRUE. GO TO 11000 C C . S L W C ======= C 3300 CONTINUE C C NO OPERATION DURING PASS 1 C GO TO 11000 C C . T B Y T E C =========== C 3400 CONTINUE GO TO 9000 C C . T I T L E C =========== C 3500 CONTINUE C C CLEAN OUT OLD TITLE C DO 3510 I = 1 , 30 TITLE(I) = BLANKS 3510 CONTINUE C C SAVE THE NEW ONE C CALL TRIVIA(3,J) !GET FIRST REAL CHARACTER IF (J.GT.EOR) GO TO 11000 !ALL BLANK, THAT'S IT K = 1 L = MIN(EOR,30) DO 3520 I = J , L TITLE(K) = REMAIN(I) K = K + 1 3520 CONTINUE GO TO 11000 C C . X M A C C ========= C 3600 CONTINUE GO TO 11000 C C . X S Y M C ========= C 3700 CONTINUE GO TO 11000 C C UTILITY CODE C 9000 CONTINUE IVAL = 1 DO 9010 I = 1,EOR IF ( REMAIN(I) .EQ. COMMAS ) IVAL = IVAL + 1 9010 CONTINUE IVAL = IVAL * OPCSIZ(OPINDX) 10000 CONTINUE PCNTR = PCNTR + IVAL 11000 CONTINUE IFLAG = 0 RETURN 12000 CONTINUE IFCNT = IFCNT + 1 I = IPUSH ( IFFLAG ) IF ( IFFLAG .EQ. 1 ) GO TO 11000 IFFLAG = IFTFLG GO TO 11000 END