C C P 2 S U D O C C PASS 2 PSEUDO OP HANDLER C C THIS ROUTINE IS CALLED WHENEVER A PSEUDO-OP IS FOUND DURING PASS 2. C EACH PSEUDO-OP HAS A SECTION WHICH PERFORMS ANY ACTIONS WHICH ARE C REQUIRED. IT SHOULD BE NOTED THAT SOME PSEUDO-OPS ARE NOT ACTED C ON DURING PASS 2, NOTABLY THE .TITLE PSEUDO-OP. EACH PSEUDO-OP WILL C BE DISCUSSED SEPERATELY IN THE APPROPRIATE SECTION. C SUBROUTINE P2SUDO(IFLAG) INCLUDE 'BSUCOM.CMN' INCLUDE 'LSTHDG.CMN' INCLUDE 'OUTLIN.CMN' INCLUDE 'PRMSYM.CMN' INCLUDE 'SRCLIN.CMN' INCLUDE 'USRSYM.CMN' INTEGER*4 IVAL, XFRADR INTEGER BLANKS , ZEROS , EQUALS , $ COMMAS , EOT EQUIVALENCE (KEYCHR(12) , BLANKS) , (KEYCHR(21),EQUALS) EQUIVALENCE (KEYCHR(20) , COMMAS) DATA ZEROS /2H00/, EOT /2H04/ C C BRANCH TO THE CORRECT PSEUDO-OP HANDLER SECTION C INDEX = OPINDX D WRITE (5,1) INDEX D 1 FORMAT (' P2SUDO , INDEX = ',I5) 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 CALL TRIVIA (3,J) !FIND FIRST NON-BLANK IN REMAIN IF (J.LE.EOR) GO TO 320 CALL FLGERR(15) !O-ERROR, NO TEXT RETURN 320 CONTINUE IDELIM = REMAIN(J) !SAVE DELIMITER J = J+1 !INCREMENT TO NEXT CHARACTER K = 1 DO 340 I=J,EOR IF (REMAIN(I).EQ.IDELIM) GO TO 350 !END OF TEXT CALL BINHEX(REMAIN(I),ABSCOD(K),2) !OUTPUT HEX IF (K.LT.6) GO TO 330 CALL PRTLIN(0) PCNTR = PCNTR+6 K = 1 CALL TRIVIA(1,L) !BLANK FILL LINBUF AND ERRFLG GO TO 340 330 CONTINUE K = K+1 340 CONTINUE CALL FLGERR(17) !Q-ERROR, NO TRAILING DELIMITER 350 CONTINUE DO 360 I=K,6 ABSCOD(I) = BLANKS 360 CONTINUE IF (INDEX.EQ.1) GO TO 370 !.ASCII - FINISHED IF (INDEX.EQ.2) ABSCOD(K) = EOT !.ASCIT - ADD EOT CHAR. IF (INDEX.EQ.3) ABSCOD(K) = ZEROS !.ASCIZ - ADD NULL CHAR K = K+1 370 CONTINUE IF (K.GT.1) CALL PRTLIN(0) !OUTPUT ANY REMAINING BYTES PCNTR = PCNTR+K-1 GO TO 10010 C C . B L O C K C =========== C 400 CONTINUE CALL XPRSIN(IFLAG,IVAL) !DETERMINE NUMBER OF BYTES IF (IFLAG.NE.1) GO TO 11000 GO TO 9000 C C . B Y T E . D B Y T E C =========================== C 500 CONTINUE 600 CONTINUE GO TO 12000 C C . D E F C ======= C 700 CONTINUE CALL FLGERR(22) !V-ERROR, NOT IMPLEMENTED GO TO 10000 C C . E N D C ======= C 800 CONTINUE CALL XPRSIN(IFLAG,XFRADR) IF (IFLAG.LE.0) GO TO 810 CALL BINHEX (XFRADR,ABSCOD(2),4) ABSCOD(1) = EQUALS 810 CONTINUE CALL PRTLIN(-1) IFLAG = -1 RETURN C C . E N D I F C =========== C 900 CONTINUE IF (IFCNT.GT.0) GO TO 910 CALL FLGERR(17) GO TO 10000 910 CONTINUE IFCNT = IFCNT-1 I = IPOP(IFFLAG) GO TO 10000 C C . E N D M C ========= C 1000 CONTINUE CALL FLGERR(22) !V-ERROR, NOT IMPLEMENTED GO TO 10000 C C . E N D R C ========= C 1100 CONTINUE CALL FLGERR(22) !V-ERROR, NOT IMPLEMENTED GO TO 10000 C C . E Q L C ======= C 1200 CONTINUE IF (LABEL(1).EQ.BLANKS) GO TO 10000 CALL XPRSIN(IFLAG,IVAL) IF (OPDATA(1).EQ.EQUALS) GO TO 9000 IF (IVAL.NE.SYMVAL(LABIDX)) CALL FLGERR(16) !P-ERROR GO TO 9000 C C .F C O N C ======== C 1300 CONTINUE CALL FLGERR(22) GO TO 10000 C C . G L O B L C =========== C 1400 CONTINUE CALL FLGERR(22) !V-ERROR, NOT IMPLEMENTED GO TO 10000 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 CALL FLGERR(22) GO TO 10000 C C . L I S T C ========= C 2500 CONTINUE CALL FLGERR(22) !V-ERROR, NOT IMPLEMENTED GO TO 10000 C C . M A C R O C =========== C 2600 CONTINUE CALL FLGERR(22) !V-ERROR, NOT IMPLEMENTED GO TO 10000 C C . N L I S T C =========== C 2700 CONTINUE CALL FLGERR(22) !V-ERROR, NOT IMPLEMENTED GO TO 10000 C C . O R G C ======= C 2800 CONTINUE CALL XPRSIN(IFLAG,IVAL) C IF (IVAL.LT.0) GO TO 11000 !CODE FOR 32 BIT MACHINE PCNTR = IVAL GO TO 9000 C C . Q B Y T E C =========== C 2900 CONTINUE CALL FLGERR(22) !V-ERROR, NOT IMPLEMENTED GO TO 10000 C C . R A D I X C =========== C 3000 CONTINUE CALL XPRSIN(IFLAG,IVAL) IF (IVAL.LT.2.OR.IVAL.GT.16) GO TO 11000 RADIX = IVAL C C THIS TRICK IS USED TO MAKE THE LISTED HEX RADIX APPEAR AS A C BASE 10 NUMBER. IE. IF THE RADIX IS SET TO 10 THEN IVAL+6=16 C AND THE BINARY TO HEX CONVERSION ROUTINE (BINHEX) AFTER STATEMENT C 9000 WILL OUTPUT A HEX 10 WHICH APPEARS TO BE A DECIMAL VALUE C OF THE RADIX. C IF (IVAL.GT.9) IVAL = IVAL+6 GO TO 9000 C C . R E P T C ========= C 3100 CONTINUE CALL FLGERR(22) !V-ERROR, NOT IMPLEMENTED GO TO 10000 C C . S B T T L C =========== C 3200 CONTINUE DO 3210 I=1,60 SUBTTL(I) = BLANKS 3210 CONTINUE CALL TRIVIA(3,J) !GET FIRST NON-BLANK IF (J.GT.EOR) GO TO 10000 !ALREADY BLANK! K = 1 L = MIN(EOR,60) DO 3220 I = J , L SUBTTL(K) = REMAIN(I) K = K + 1 3220 CONTINUE GO TO 10010 ! No listing of command C C . S L W C ======= C 3300 CONTINUE CALL HEADNG GO TO 10010 C C . T B Y T E C =========== C 3400 CONTINUE GO TO 12000 C C . T I T L E C =========== C 3500 CONTINUE GO TO 10010 !DON'T LIST IT C C . X M A C C ========= C 3600 CONTINUE CALL FLGERR(22) !V-ERROR, NOT IMPLEMENTED GO TO 10000 C C . X S Y M C ========= C 3700 CONTINUE CALL FLGERR(22) !V-ERROR, NOT IMPLEMENTED GO TO 10000 9000 CONTINUE CALL BINHEX(IVAL,ABSCOD(2),4) ABSCOD(1) = EQUALS IF (INDEX.EQ.4) GO TO 10050 10000 CONTINUE CALL PRTLIN(-1) 10010 CONTINUE IFLAG = 0 RETURN 10050 CONTINUE CALL PRTLIN(1) ! LISTING, BUT NO OPCODE GO TO 10150 10100 CONTINUE CALL PRTLIN(0) 10150 CONTINUE PCNTR = PCNTR+IVAL GO TO 10010 11000 CONTINUE CALL FLGERR(15) !O-ERROR, OPERAND ERROR CALL BINHEX(IVAL,ABSCOD(2),4) ABSCOD(1) = EQUALS IVAL = 0 IF (INDEX.EQ.3) GO TO 10100 GO TO 10000 12000 CONTINUE NBYTES = OPCSIZ(OPINDX) NHEX = NBYTES*2 K = 1 12010 CONTINUE CALL XPRSIN(IFLAG,IVAL) !,IHIGH) CALL BINHEX(IVAL,ABSCOD(K),NHEX) IF (K.LT.6) GO TO 12020 CALL PRTLIN(0) PCNTR = PCNTR+6 K = 1 CALL TRIVIA(1,L) GO TO 12040 12020 CONTINUE K = K+NBYTES 12040 CONTINUE IF (REMIDX.LT.EOR) GO TO 12010 INDEX = 1 GO TO 350 END