C C P 2 D I R C C PASS 2 ASSEMBLER DIRECTIVES HANDLER C C ARG: IFLAG = 0, NORMAL CODE C IFLAG = -1 END DIRECTIVE HANDLED C SUBROUTINE P2DIR(IFLAG) INCLUDE 'BSUCOM.CMN' INCLUDE 'LSTHDG.CMN' INCLUDE 'OUTLIN.CMN' INCLUDE 'PRMSYM.CMN' INCLUDE 'SRCLIN.CMN' INCLUDE 'USRSYM.CMN' INTEGER*4 IVAL INTEGER BLANKS, SMICLN, TABS, COMMAS, APOSTR, SWTCH EQUIVALENCE (KEYCHR(12),BLANKS),(KEYCHR(10),SMICLN) EQUIVALENCE (KEYCHR(20),COMMAS),(KEYCHR(22),APOSTR) EQUIVALENCE (KEYCHR(28),TABS) C C DETERMINE THE DIRECTIVE C D WRITE (5,1) OPINDX,(REMAIN(I),I=REMIDX,EOR) D 1 FORMAT (' P2DIR, OPINDX, REMAIN = ',I5,80(A1:)) IF (OPINDX.EQ.59) GO TO 100 ! DB IF (OPINDX.EQ.63) GO TO 200 ! DS IF (OPINDX.EQ.64) GO TO 300 ! DW IF (OPINDX.EQ.66) GO TO 400 ! END IF (OPINDX.EQ.67) GO TO 500 ! EQU IF (OPINDX.EQ.89) GO TO 600 ! ORG IF (OPINDX.EQ.112) GO TO 700 ! SET CALL FLGERR(22) GO TO 1000 C C DB C == C 100 CONTINUE INC = 1 102 CONTINUE CALL TRIVIA(3,J) ! FIND NON-BLANK REMIDX = J-1 K = 1 IF (J.LE.EOR) GO TO 105 104 CALL FLGERR(15) ! O - ERR, NO OPERAND GO TO 1000 105 CONTINUE IF (REMIDX+1.GT.EOR) GO TO 170 IDELIM = REMAIN(REMIDX+1) IF (IDELIM.NE.APOSTR) GO TO 140 108 DO 120 I = REMIDX+2 , EOR IF (REMAIN(I).EQ.IDELIM) GO TO 135 CALL BINHEX(REMAIN(I),ABSCOD(K),INC*2) IF (INC.EQ.2.AND.K.LT.5) GO TO 110 IF (INC.EQ.1.AND.K.LT.6) GO TO 110 CALL PRTLIN(0) PCNTR = PCNTR+6 K = 1 CALL TRIVIA(1,L) ! BLANK OUT LINBUF, ERRFLG CALL TRIVIA(5,L) ! BLANK OUT ABSCOD GO TO 130 110 CONTINUE K = K+INC 120 CONTINUE CALL FLGERR(17) ! Q-ERR, NO TRAILING DELIMITER GO TO 1000 130 CONTINUE REMIDX = I-1 GO TO 108 135 CONTINUE IF (I.GE.EOR) GO TO 170 IF (REMAIN(I+1).EQ.TABS.OR. $ REMAIN(I+1).EQ.BLANKS) GO TO 170 IF (REMAIN(I+1).NE.COMMAS) GO TO 104 REMIDX = I+1 GO TO 105 C C EXPRESSIONS C 140 CONTINUE CALL XPRSIN(IFLAG,IVAL) IF (IFLAG.EQ.1) GO TO 150 CALL FLGERR(15) CALL PRTLIN(0) GO TO 1000 150 CONTINUE CALL BINHEX(IVAL,ABSCOD(K),INC*2) IF (INC.EQ.1) GO TO 155 SWTCH = ABSCOD(K) ! INTEL STORES WORDS BACKWARDS ABSCOD(K) = ABSCOD(K+1) ABSCOD(K+1) = SWTCH 155 CONTINUE IF (INC.EQ.2.AND.K.LT.5) GO TO 160 IF (INC.EQ.1.AND.K.LT.6) GO TO 160 CALL PRTLIN(0) PCNTR = PCNTR+6 K = 1 CALL TRIVIA(1,L) GO TO 105 160 CONTINUE K = K+INC GO TO 105 170 CONTINUE DO 180 I=K,6 ABSCOD(I) = BLANKS 180 CONTINUE IF (K.GT.1) CALL PRTLIN(0) PCNTR = PCNTR+K-1 GO TO 1000 C C DS C == C 200 CONTINUE OPINDX = 4 ! SET = .BLOCK CALL P2SUDO(IFLAG) GO TO 1000 C C DW C == C 300 CONTINUE INC = 2 GO TO 102 C C END C === C 400 CONTINUE OPINDX = 8 CALL P2SUDO(IFLAG) !LET P2SUDO HANDLE THE .END GO TO 1100 C C EQU C === C 500 CONTINUE OPINDX = 12 ! .EQL CALL P2SUDO(IFLAG) GO TO 1000 C C ORG C === C 600 CONTINUE OPINDX = 28 CALL P2SUDO(IFLAG) GO TO 1000 C C SET C === C 700 CONTINUE KP = REMIDX IF (LABEL(1).EQ.BLANKS) GO TO 900 CALL XPRSIN(IFLAG,IVAL) SYMVAL(LABIDX) = IVAL REMIDX = KP OPINDX = 12 ! .EQL CALL P2SUDO(IFLAG) GO TO 1000 900 CONTINUE CALL FLGERR(17) CALL PRTLIN(0) 1000 CONTINUE IFLAG = 0 1100 CONTINUE D WRITE (5,2) IFLAG, IVAL D 2 FORMAT (' P2DIR END, IFLAG, IVAL = ',2I8) RETURN END