C AS8008.FOR C C PDP-11 FORTRAN CROSS-ASSEMBLER FOR MPS C LOGICAL*1 LSTSYM(6),E,R,DELIM LOGICAL*1 PLUS,MINUS,RANGE,ONE,CK,CL,CP,PAGEIT LOGICAL*1 LINE(80),SYM(6),SYMTAB(2400),OPCTAB(1090),BUFR(17) LOGICAL*1 CHAR,FIL(11),FIL1(11),TODAY(9),PAGCHR LOGICAL*1 A,Z,ZERO,SEVEN,NINE,BLANK,TAB,ASTX,O,D,B,DLR,N INTEGER IB(70),EXP1,EXP2,OPERAT,ENDPAS,RADIX INTEGER CSYM(3),ISMTAB(1200) EQUIVALENCE (SYM,CSYM),(SYMTAB,ISMTAB) C C SYMBOL USE C C LINE CURRENT LINE BUFFER C SYM CURRENT SYMBOL OR OP-CODE C SYMTAB SYMBOL TABLE C OPCTAB OP-CODE TABLE C CHAR CURRENT CHARACTER C A CODE 'A' C E CODE "105 C R CODE 'R' C Z CODE 'Z' C ZERO CODE '0' C SEVEN CODE '7' C NINE CODE '9' C BLANK CODE 'BLANK' C TAB CODE 'TAB' C ASTX CODE '*' C O CODE 'O' C D CODE 'D' C B CODE 'B' C MSK BYTE MASK FOR .AND. LOW HALF WORD. C II POINTER TO CURRENT "CHAR" IN "LINE" C ISYM NUMBER OF SYMBOLS IN "SYMTAB" C IOPC NUMBER OF CODES IN "OPCTAB" C IV1 LOW BYTE VALUE OF SYMBOL C IV2 HIGH BYTE VALUE OF SYMBOL C ICD CODE FOR SYMBOL RETURNED BY SYMBOL PROCESSOR C KK POINTER TO SYMBOL VALUE IN "SYMTAB" OR END C IF SYMBOL UNDEFINED. C IPASS PASS NUMBER OF TWO PASS ASSEMBLER. C ILOC LOCATION COUNTER FOR ASSEMBLER C IEC ERROR COUNTER C ILBL LABEL FLAG SET TO ONE IF LABEL ON LINE. C MSYM MAX. SYMBOL COUNT = (DIM. SYMTAB)/8 C MOPC MAX. CODE COUNT = (DIM. OPCTAB)/5 C DLR CODE '$' C IRT RETURN CODE FOR SYMBOL PROCESSOR C N CODE 'N' C IBIN FLAG FOR DOING BINARY OUTPUT C ILIS FLAG FOR DOING LISTING OUTPUT C ILINE LINE COUNTER C IPC COUNT OF LINES PER PAGE C NB NUMBER OF BYTES C IB ARRAY FOR UP-TO THREE BYTES PER INSTRUCTION C OR 70 BYTES OF TEXT PSEUDO-OP C BUFR OUTPUT DATA FOR LISTING C IECD ERROR CODE FOR OUTPUT C PAGCHR CARRIAGE CONTROL CHARACTER C IPAGE PACE COUNTER C EXP1 LOWER EXPRESSION VALUE C EXP2 HIGHER EXPRESSION VALUE C PLUS CODE '+' C MINUS CODE '-' C OPERAT EXPRESSION OPERATOR CODE C RANGE RANGE FOR DIGITS OF SELECTED RADIX C RADIX RADIX SELECTED BY CONTROL CHARACTER C ONE CODE '1' C NOREAD FLAG FOR MULTI-INSTRUCTION PSEUDO-OPS C LISTON TEMPORARY LISTING CONTROL C LSTSYM LAST LABEL SEEN (USED BY ERROR PROCESSOR) C LSTLIN LINE NUMBER FOR LSTSYM. C MAXCHR LAST PRINTING CHARACTER ON A LINE C CK CODE 'K' C CL CODE 'L' C CP CODE 'P' C I GENERAL C J GENERAL C K GENERAL C L GENERAL C M GENERAL C C -- ASSIGN VALUES TO CONSTANTS. C E="105 R="122 CK="113 CL="114 CP="120 ONE="61 PLUS="53 MINUS="55 MSKLOC=16383 N="116 A="101 Z="132 ZERO="60 SEVEN="67 NINE="71 BLANK="40 TAB="11 ASTX="52 O="117 D="104 B="102 MSK=255 MSYM=300 MOPC=218 DLR="44 PERIOD="56 COMMA="54 SLASH="57 CALL DATE(TODAY) C C -- SECTION 000X C -- INPUT OP-CODE TABLE AND ESTABLISH I/O. C CALL ASSIGN(4,'AS8008.OPC',10,'RDO') IOPC=0 I=1 1 READ(4,8000)BUFR 8000 FORMAT(17A1) IF(BUFR(1).EQ.BLANK)GOTO 1 IF(BUFR(1).EQ.ASTX)GOTO 1 IF(BUFR(1).EQ.DLR)GOTO 3 IF(IOPC.GE.MOPC)GOTO 2 DECODE(11,8080,BUFR)IV1,IV2 8080 FORMAT(4X,O3,1X,O3) OPCTAB(I)=BUFR(1) OPCTAB(I+1)=BUFR(2) OPCTAB(I+2)=BUFR(3) OPCTAB(I+3)=IV1 OPCTAB(I+4)=IV2 I=I+5 IOPC=IOPC+1 GOTO 1 2 WRITE(5,9000) 9000 FORMAT(' TOO MANY OP-CODES OR NONE') STOP 3 CALL CLOSE(4) IF(IOPC.EQ.0)GOTO 2 C C -- ASK FOR INPUTS AND OUTPUTS. C 9998 LISTON=1 WRITE(5,9001) 9001 FORMAT(/' AS8008-001D'/'$INPUT: ') READ(5,8001)(FIL1(J),J=1,10),IBIN,ILIS,ICREF,LISTON 8001 FORMAT(10A1,4I2) CALL ASSIGN(1,FIL1,10,'RDO') IF(IBIN.EQ.0) GOTO 4 WRITE(5,9002) 9002 FORMAT('$BINARY: ') CALL ASSIGN(2,'AS8008.BIN',-10,'NEW') 4 IF(ILIS.EQ.0) GOTO 5 WRITE(5,9003) 9003 FORMAT('$LISTING: ') CALL ASSIGN(3,'AS8008.LIS',-10,'NEW') 5 IF(ICREF.EQ.0) GOTO 6 WRITE(5,9800) 9800 FORMAT('$CREF: ') CALL ASSIGN(4,'AS8008.CRF',-10,'NEW') C C -- INITIALIZE PASS 1 C 6 IPASS=1 ISYM=0 IPAGE=1 PAGCHR=ONE C C -- NEXT PASS C 8 ILINE=0 ILOC=0 IEC=0 ENDPAS=0 NOREAD=0 IPC=55 IF(LISTON.NE.2)LISTON=1 DO 9 I=1,6 SYM(I)=BLANK LSTSYM(I)=BLANK 9 CONTINUE LSTLIN=0 WRITE(5,9004)IPASS 9004 FORMAT(' BEGIN PASS ',I1) CALL CLOSE(5) C C -- SECTION 00XX C -- READ LINE AND TEST FIRST CHARACTER. C 10 IF(ENDPAS.NE.0)GOTO 1005 IF(NOREAD.NE.0)GOTO 20 READ(1,8002,END=30)LINE 8002 FORMAT(80A1) C C -- TEST FOR EMPTY LINE. C MAXCHR=0 DO 15 I=1,80 IF(LINE(I).NE.BLANK)MAXCHR=I 15 CONTINUE IF(MAXCHR.EQ.0)GOTO 10 C ILBL=0 II=1 NB=0 ILINE=ILINE+1 CHAR=LINE(II) IF((CHAR.EQ.BLANK).OR.(CHAR.EQ.TAB))GOTO 400 IF(CHAR.EQ.ASTX)GOTO 370 IF(CHAR.EQ.DLR) GOTO 380 IF(CHAR.EQ.SLASH) GOTO 100 IRT=1 IF((CHAR.GE.A).AND.(CHAR.LE.Z))GOTO 200 GOTO 350 C C -- IF NOREAD IS SET A MULTI-INSTRUCTION PSEUDO-OP C -- IS BEING PROCESSED FOR THIS LINE. THE LINE C -- SHOULD BE BLANKED FOR A NEAT LISTING. C 20 DO 25 I=1,80 LINE(I)=BLANK 25 CONTINUE GOTO 1505 C C -- NO "END" PSEUDO-OP C 30 WRITE(5,9901) 9901 FORMAT(' END OF INPUT FILE') GOTO 1005 C C -- SECTION 01XX C -- OUTPUT ROUTINES AND ILOC UP-DATE. C 100 IF(IPASS.NE.2)GOTO 140 IF(ILIS.NE.1)GOTO 130 IF(LISTON.NE.1)GOTO 130 IF(IPC.LT.55)GOTO 101 WRITE(3,9005)PAGCHR,(FIL1(I),I=1,10),TODAY,IPAGE 9005 FORMAT(A1,/,' AS8008-001D: ',10A1,5X,9A1,5X,'PAGE',I4// 1' LINE ADDR. BY1 BY2 BY3'//) IPAGE=IPAGE+1 IPC=0 C C -- CLEAR BUFFER FOR DATA C 101 DO 105 I=1,17 BUFR(I)=BLANK 105 CONTINUE IF(NB.EQ.0)GOTO 120 C C -- CONVERT OUTPUT TO OCTAL C CALL ACNVT(BUFR,5,ILOC) J=7 DO 110 I=1,NB CALL ACNVT(BUFR(J),3,IB(I)) J=J+4 IF(J.GT.17) GO TO 120 110 CONTINUE C C -- OUTPUT THE LINE AND COUNT LINES ON PAGE C 120 WRITE(3,9007)ILINE,BUFR,TAB,(LINE(I),I=1,MAXCHR) 9007 FORMAT(1X,I4,1X,17A1,A1,80A1) IPC=IPC+1 C C -- OUTPUT BINARY DATA C 130 IF((IBIN.NE.1).OR.(NB.EQ.0))GOTO 140 J=ILOC DO 135 I=1,NB WRITE(2)J,IB(I) J=J+1 135 CONTINUE 140 ILOC=(ILOC+NB).AND.MSKLOC GOTO 10 C C -- ERROR ROUTINE. C 190 IF(ILIS.NE.1)GOTO 192 IF(IPC.LT.55)GOTO 191 WRITE(3,9005)PAGCHR,(FIL1(I),I=1,10),TODAY,IPAGE IPAGE=IPAGE+1 IPC=0 191 I=ILINE-LSTLIN WRITE(3,9008)IECD,ILINE,ILOC,LSTSYM,I,SYM,CHAR 9008 FORMAT(' ?ERROR? ',I2,' L: ',I4,' P: ',O5, 1' T: ',6A1,'+',I4,' S: ',6A1,' C: ',A1) IPC=IPC+1 192 IEC=IEC+1 DO 193 I=1,3 IB(I)=0 193 CONTINUE C C -- DELETE ANY SYMBOL DEFINED IF THERE IS AN ERROR. C ISYM=ISYM-ILBL GOTO 100 C C -- SYSTEM ERROR ROUTINE (NO RECOVERY). C 199 WRITE(5,9999) 9999 FORMAT(' SYSTEM ERROR') STOP C C -- SECTION 02XX C -- SYMBOL PROCESSOR. C C -- CODE RETURNED C -- ICD: 1 NOT IN TABLE C -- 2 IN TABLE C C -- FIRST CLEAR SYMBOL. C 200 DO 210 I=1,6 SYM(I)=BLANK 210 CONTINUE I=0 C C -- LOOP LOOKING FOR THE SYMBOL C 220 IF(I.GE.6) GOTO 225 I=I+1 SYM(I)=CHAR IF(II.GE.80)GOTO 230 II=II+1 CHAR=LINE(II) IF((CHAR.GE.A).AND.(CHAR.LE.Z))GOTO 220 IF((CHAR.GE.ZERO).AND.(CHAR.LE.NINE))GOTO 220 GOTO 230 C C -- TOO MANY CHARACTERS. C 225 IECD=2 GOTO 190 C C -- IF REQUESTED OUTPUT THE SYMBOL TO THE CREF. FILE. C 230 IF((ICREF.NE.1).OR.(IPASS.NE.1))GOTO 232 ICREFT=BLANK IF(IRT.EQ.1)ICREFT=D WRITE(4,9805)(SYM(I),I=1,6),ICREFT,ILINE 9805 FORMAT(6A1,A1,I4) C C -- SEARCH FOR THE SYMBOL IN SYMTAB. C 232 L=0 IF(ISYM.EQ.0)GOTO 250 DO 245 I=1,ISYM DO 235 J=1,3 KK=L+J IF(CSYM(J).NE.ISMTAB(KK))GOTO 240 235 CONTINUE C C -- SYMBOL FOUND (ICD=2) C KK=L*2+7 IV1=SYMTAB(KK).AND.MSK IV2=SYMTAB(KK+1).AND.MSK ICD=2 GOTO 255 C C -- SYMBOLS DO NOT MATCH...TRY NEXT. C 240 L=L+4 245 CONTINUE C C -- SYMBOL IS NOT IN THE TABLE (ICD=1). C 250 KK=L*2+1 IV1=0 IV2=0 ICD=1 255 GOTO(300,620)IRT C C -- SECTION 03XX C -- LABEL PROCESSOR...LABEL FOUND BY SYMBOL PROCESSOR. C 300 IF(CHAR.NE.COMMA)GOTO 431 C C -- SAVE SYMBOL FOR ERROR PROCESSOR C LSTLIN=ILINE DO 305 I=1,6 LSTSYM(I)=SYM(I) 305 CONTINUE GOTO(310,330)ICD C C -- SYMBOL NOT IN TABLE, PUT IT THERE. C 310 IF(IPASS.NE.1)GOTO 360 IF(ISYM.GE.MSYM)GOTO 320 ISYM=ISYM+1 DO 315 I=1,6 SYMTAB(KK)=SYM(I) KK=KK+1 315 CONTINUE IV1=ILOC.AND.MSK IV2=ILOC/256 SYMTAB(KK)=IV1 SYMTAB(KK+1)=IV2 ILBL=1 GOTO 400 C C -- SYMBOL TABLE FULL C 320 WRITE(5,9009)MSYM 9009 FORMAT(' SYMBOL TABLE FULL',I5) STOP C C -- SYMBOL ALREADY DEFINED C 330 IF(IPASS.NE.1)GOTO 400 IECD=1 GOTO 190 C C -- ILLEGAL CHARACTER C 350 IECD=3 GOTO 190 C C -- LABEL UNDEFINED ON PASS 2 C 360 IECD=4 GOTO 190 370 KTYP=5 KVAL=1 GOTO 600 380 KTYP=4 KVAL=1 GOTO 698 C C -- SECTION 04XX C -- OP-CODE PROCESSOR C 400 IF(II.GE.78)GOTO 410 II=II+1 CHAR=LINE(II) IF(CHAR.EQ.DLR) GOTO 380 IF(CHAR.EQ.ASTX) GOTO 370 IF((CHAR.GE.A).AND.(CHAR.LE.Z))GOTO 415 IF((CHAR.EQ.BLANK).OR.(CHAR.EQ.TAB))GOTO 400 IF(CHAR.EQ.SLASH) GOTO 100 C C -- ILLEGAL CHARACTER C 405 IECD=5 GOTO 190 C C -- NO OP-CODE. C 410 IECD=6 GOTO 190 C C -- FETCH AND TEST OP-CODE C 415 DO 420 I=1,6 SYM(I)=BLANK 420 CONTINUE DO 430 I=1,3 IF((CHAR.GE.A).AND.(CHAR.LE.Z))GOTO 425 IF((CHAR.LT.ZERO).OR.(CHAR.GT.NINE))GOTO 405 425 SYM(I)=CHAR II=II+1 CHAR=LINE(II) 430 CONTINUE 431 IF((CHAR.EQ.BLANK).OR.(CHAR.EQ.TAB))GOTO 435 IECD=7 GOTO 190 C C -- SEARCH OPCTAB FOR CODE C 435 L=0 DO 450 I=1,IOPC DO 440 J=1,3 K=L+J IF(SYM(J).NE.OPCTAB(K))GOTO 445 440 CONTINUE C C -- OP-CODE FOUND, PROCESS IT. C KTYP=OPCTAB(K+1).AND.MSK KVAL=OPCTAB(K+2).AND.MSK GOTO(500,600,600,698,600,600)KTYP C C -- OP-CODE DOES NOT MATCH THIS ENTRY C 445 L=L+5 450 CONTINUE C C -- OP-CODE NOT IN TABLE C IECD=8 GOTO 190 C C -- SECTION 05XX C -- SINGLE INSTRUCTION WITH NO OPERAND. C 500 NB=1 IB(1)=KVAL GOTO 100 C C -- SECTION 06XX C -- INSTRUCTIONS AND PSEUDO-OPS WHICH C -- REQUIRE AN OPERAND. C 600 EXP1=0 EXP2=0 OPERAT=1 IDF=1 601 IF(II.LT.80)GOTO 605 IECD=9 GOTO 190 605 II=II+1 CHAR=LINE(II) IF((CHAR.GE.A).AND.(CHAR.LE.Z))GOTO 615 IF((CHAR.GE.ZERO).AND.(CHAR.LE.NINE))GOTO 900 IF(CHAR.EQ.PLUS)GOTO 651 IF(CHAR.EQ.MINUS)GOTO 650 IF(CHAR.EQ.PERIOD)GOTO 665 IF((CHAR.EQ.BLANK).OR.(CHAR.EQ.TAB))GOTO 601 C C -- ILLEGAL CHARACTER IN OPERAND FIELD. C 610 IECD=10 GOTO 190 C C -- SYMBOLIC OPERAND C 615 IRT=2 GOTO 200 620 GOTO(630,631)ICD C C -- UNDEFINED SYMBOL. C 630 IDF=0 IF(IPASS.EQ.1)GOTO 631 IECD=12 GOTO 190 C C -- DEFINED SYMBOL. C 631 GOTO(632,633)OPERAT C C -- ADDITION. C 632 EXP1=EXP1+IV1 EXP2=EXP2+IV2 IF(EXP1.GE.256)EXP2=EXP2+1 GOTO 645 C C -- SUBTRACTION. C 633 EXP1=EXP1-IV1 EXP2=EXP2-IV2 IF(EXP1.LT.0)EXP2=EXP2-1 GOTO 645 C C --FINISH VALUE AND TEST FOR MORE C 645 EXP1=EXP1.AND.MSK EXP2=EXP2.AND.MSK IF((CHAR.EQ.BLANK).OR.(CHAR.EQ.TAB))GOTO 646 IF(CHAR.EQ.PLUS)GOTO 651 IF(CHAR.EQ.MINUS)GOTO 650 GOTO 610 C C -- RETURN TO PROPER ROUTINE C 646 IV1=EXP1 IV2=EXP2 GOTO(199,700,800,199,699,750)KTYP C C -- SET OPERATOR CODE C 650 OPERAT=2 GOTO 660 651 OPERAT=1 GOTO 660 C C -- ALPHA-NUMERIC OR '.' MUST FOLLOW OPERATOR. C 660 II=II+1 CHAR=LINE(II) IF((CHAR.GE.A).AND.(CHAR.LE.Z))GOTO 615 IF((CHAR.GE.ZERO).AND.(CHAR.LE.NINE))GOTO 900 IF(CHAR.EQ.PERIOD)GOTO 665 GOTO 610 C C -- CURRENT LOC OPERAND. C 665 IV1=ILOC.AND.MSK IV2=ILOC/256 II=II+1 CHAR=LINE(II) GOTO 631 C C -- PSEUDO-OP WITH NO OPERAND C 698 GOTO(1000,2000,2010,2020,2030)KVAL C C -- PSEUDO-OP WITH OPERAND C 699 GOTO(1100,1200,1300,1400,1500,1600,1700,1800)KVAL C C -- SECTION 07XX C -- TWO BYTE INSTRUCTIONS C 700 NB=2 IB(1)=KVAL IB(2)=IV1 GOTO 100 750 NB=2 IB(1)=KVAL IB(2)=IV2 GOTO 100 C C -- SECTION 08XX C -- THREE BYTE INSTRUCTIONS C 800 NB=3 IB(1)=KVAL IB(2)=IV1 IB(3)=IV2 GOTO 100 C C -- SECTION 09XX C -- OCTAL NUMBER PROCESSOR C C -- DETERMINE THE RADIX OF THE NUMBER. C 900 I=II 901 IF(I.GE.80)GOTO 902 I=I+1 J=LINE(I) IF((J.GE.ZERO).AND.(J.LE.NINE))GOTO 901 IF(J.EQ.B)GOTO 903 IF(J.EQ.D)GOTO 904 C C -- OCTAL NUMBER. C 902 RADIX=8 RANGE=SEVEN GOTO 905 C C -- BINARY NUMBER. C 903 RADIX=2 RANGE=ONE GOTO 905 C C -- DECIMAL NUMBER. C 904 RADIX=10 RANGE=NINE C C -- PROCESS NUMBER C 905 IV1=0 IV2=0 910 I=CHAR-ZERO IV1=IV1*RADIX+I IV2=IV2*RADIX + IV1/256 IV1=IV1.AND.MSK IV2=IV2.AND.MSK IF(II.GE.80)GOTO 631 II=II+1 CHAR=LINE(II) IF((CHAR.GE.ZERO).AND.(CHAR.LE.RANGE))GOTO 910 IF((CHAR.EQ.B).OR.(CHAR.EQ.D).OR.(CHAR.EQ.O))GOTO 920 GOTO 631 C C -- NEXT CHARACTER C 920 IF(II.GE.80)GOTO 631 II=II+1 CHAR=LINE(II) GOTO 631 C C -- SECTION 10XX C -- END OF PASS ("END" PSEUDO-OP) C 1000 ENDPAS=1 GOTO 100 1005 WRITE(5,9900)IPASS,IEC 9900 FORMAT(' END PASS ',I1/' ERROR(S) ',I5) IF(IPASS.EQ.2)GOTO 1010 REWIND 1 IPASS=2 GOTO 8 C C -- OUTPUT ORDERED SYMBOL TABLE AT THE END OF PASS TWO. C 1010 IF((ISYM.LE.0).OR.(ILIS.NE.1))GOTO 1095 IPC=55 PAGCHR=ONE DO 1020 J=1,6 SYM(J)=0 1020 CONTINUE C C -- SEARCH FOR ORDERED SYMBOLS. C DO 1090 M=1,ISYM C C -- CLEAR OUT LINE FOR TEST. C DO 1025 J=1,6 LINE(J)=127 1025 CONTINUE DO 1026 J=7,21 LINE(J)=BLANK 1026 CONTINUE C C -- LOOK FOR THE NEXT HIGHER SYMBOL. C L=0 DO 1050 I=1,ISYM DO 1040 J=1,6 CHAR=SYMTAB(L+J) IF(CHAR.GT.SYM(J))GOTO 1041 IF(CHAR.LT.SYM(J))GOTO 1044 1040 CONTINUE GOTO 1044 1041 DO 1039 J=1,6 CHAR=SYMTAB(L+J) IF(CHAR.LT.LINE(J))GOTO 1042 IF(CHAR.GT.LINE(J))GOTO 1044 1039 CONTINUE C C -- NEW TRIAL SYMBOL. C 1042 DO 1043 J=1,6 LINE(J)=SYMTAB(L+J) 1043 CONTINUE IV1=SYMTAB(L+7).AND.MSK IV2=SYMTAB(L+8).AND.MSK 1044 L=L+8 1050 CONTINUE C C -- OUTPUT SYMBOL AND VALUE C IF(IPC.LT.55)GOTO 1055 WRITE(3,9020)PAGCHR,(FIL1(I),I=1,10),TODAY,IPAGE 9020 FORMAT(A1,/,' SYMBOL TABLE: ',10A1,5X,9A1,5X,'PAGE',I4// 1' SYMBOL WORD BY1 BY2'//) IPAGE=IPAGE+1 IPC=0 C C -- SAVE SYMBOL FOR NEXT. C 1055 DO 1056 J=1,6 SYM(J)=LINE(J) 1056 CONTINUE C C -- CONVERT DATA TO WORD AND BYTE VALUES IN ASCII. C EXP2=IV2/2 EXP1=IV1 IF((EXP2*2).NE.IV2)EXP1=EXP1+256 CALL ACNVT(LINE(8),3,EXP2) CALL ACNVT(LINE(11),3,EXP1) CALL ACNVT(LINE(15),3,IV1) CALL ACNVT(LINE(19),3,IV2) C C -- OUTPUT THE LINE. C WRITE(3,9021)(LINE(J),J=1,21) 9021 FORMAT(1X,21A1) IPC=IPC+1 C 1090 CONTINUE C C -- CLOSE ALL FILES. C 1095 CALL EXIT C C -- SECTION 11XX C -- SET ASSEMBLY ORGIN C 1100 IF(IDF.NE.1)GOTO 1105 ILOC=IV2*256 ILOC=ILOC+IV1 GOTO 100 1105 IECD=14 GOTO 190 C C -- "EQU" PSEUDO-OP C 1200 IF(IPASS.NE.1)GOTO 100 IF(ILBL.NE.1)GOTO 1210 IF(IDF.NE.1)GOTO 1215 SYMTAB(KK)=IV1 SYMTAB(KK+1)=IV2 GOTO 100 1210 IECD=15 GOTO 190 1215 IECD=16 GOTO 190 C C -- "DAT" PSEUDO-OP C 1300 NB=1 IB(1)=IV1 GOTO 100 C C -- "ADR" PSEUDO-OP C 1400 NB=2 IB(1)=IV1 IB(2)=IV2 GOTO 100 C C -- "SHL" PSEUDO-OP INSTRUCTION: C -- A COMBINATION OF "LHI" AND "LLI". C 1500 NB=2 IB(1)=46 IB(2)=IV2 NOREAD=1 GOTO 100 1505 NB=2 IB(1)=54 IB(2)=IV1 NOREAD=0 GOTO 100 C C -- "RST" INSTRUCTION PROCESSOR. C 1600 NB=1 IF((IV1.GT.7).OR.(IV2.NE.0))GOTO 1605 IB(1)=5+IV1*8 GOTO 100 1605 IECD=17 GOTO 190 C C -- "INP" INSTRUCTION PROCESSOR. C 1700 NB=1 IF((IV1.GT.7).OR.(IV2.NE.0))GOTO 1705 IB(1)=65+IV1*2 GOTO 100 1705 IECD=18 GOTO 190 C C -- "OUT" INSTRUCTION C 1800 NB=1 IF((IV1.LT.7).OR.(IV1.GT.31))GOTO 1805 IF(IV2.NE.0)GOTO 1805 IB(1)=65+IV1*2 GOTO 100 1805 IECD=19 GOTO 190 C C -- "LON" AND "LOF" PSEUDO-OPS. C 2000 IF(LISTON.EQ.2)GOTO 100 LISTON=1 GOTO 100 2010 IF(LISTON.EQ.2)GOTO 100 LISTON=0 GOTO 100 C C -- "PAG" PSEUDO-OP C 2020 IF((LISTON.NE.1).OR.(IPASS.NE.2))GOTO 100 IPC=54 GOTO 100 C C -- "TXT" PSEUD-OP C 2030 NB=0 DELIM=BLANK 2031 IF(II.LT.80) GOTO 2035 IECD=9 GOTO 190 2035 II=II+1 CHAR=LINE(II) IF(DELIM.NE.BLANK) GOTO 2040 IF((CHAR.EQ.BLANK).OR.(CHAR.EQ.TAB)) GOTO 2031 DELIM=CHAR GOTO 2031 2040 IF(CHAR.EQ.DELIM) GOTO 100 NB=NB+1 IB(NB)=CHAR GOTO 2031 C C ****** END OF PROGRAM ****** C END