C ....................................................... C C A S S 8 5 RSX11M VERSION (V2.1A) 1978. C USING "INDUSTRY STANDARD" MNEMONICS C C A CROSS ASSEMBLER FOR 8080 AND 8085 MICROCOMPUTERS C WRITTEN IN FORTRAN IV PLUS FOR USE ON PDP11 UNDER C RSX11M OPERATING SYSTEM C C NOTE THAT IF THE SPOOLING COMMANDS ARE CHANGED AND C THE CLOSE COMMAND , AND ALL "BYTE" VARIABLES C ARE CHANGED TO "LOGICAL*1" IT MIGHT STILL WORK ON C OTHER FORTRANS. (NOT TESTED) C C THE COPYRIGHT OF THIS VERSION BELONGS TO: C THE C EUROPEAN MOLECULAR BIOLOGY LABORATORY C HAMBURG OUTSTATION C NOTKESTR. 85 C 2000 HAMBURG 52 C WEST GERMANY C WHO ARE UNABLE TO PROVIDE ANY SUPPORT FOR THIS SOFTWARE. C C C THIS IS A SIMPLE TWO PASS ASSEMBLER FOR INTEL 8080 C WITH RIM AND SIM COMMANDS ADDED FOR 8085. C C ** LIMITATIONS ** C 1. PSEUDO OPS LIMITED TO C .ORG AAAA SETS ASSEMBLY PROGRAM COUNTER C .EQU NAME=DDDD EQUATES A SYMBOL TO A VALUE C .VAL DD LOADS ONE BYTE ONLY WITH AN 8 BIT VALUE C .DBL DDDD LOADS 2 BYTES WITH A 16 BIT VALUE C .ASC STRING (OR END OF LINE) C INSERTS AN ASCII STRING C .SKP NNNN ADVANCES ASSEMBLY PC COUNTER NNNN C .END SIGNALS END OF THE PROGRAM C C 2. SYMBOLS ARE INTERPRETED AS 4 CHARACTERS. IF MORE C THAN 4, FIRST 3 AND LAST ARE USED. C FIRST CHARACTER OF A SYMBOL MUST BE ALPHABETICAL. C ONLY A-Z AND 0-9 MAY BE USED ( L.AB IS ILLEGAL) C C 3. .VAL WILL ONLY LOAD ONE BYTE IN THIS VERSION C C 4. ARITHMETIC IS LEFT TO RIGHT WITH THE NORMAL C + - * / & ! BEING CARRIED OUT WITH THE C RUNNING RESULT AND THE NEXT VALUE ONLY.. C C THE OPERATOR ^, MEANING HIGH-BYTE,FOLLOWS THE C VALUE OR SYMBOL IT REFERS TO, AND INDICATES THAT C VALUE ONLY IS TO BE INTERPRETED AS / 256. C C UNARY SUBTRACTION CAN ONLY WORK PROPERLY C WITH THE FIRST VALUE OR SYMBOL. E.G. C -1, -FRED WILL WORK, 2*-2 WONT WORK... C C 5. COMMENT DELIMITER IS ; C 6. LABEL DELIMITER IS OPTIONAL AND IS : C 7. NUMBERS MUST BEGIN WITH A NUMERICAL CHARACTER C 0-9 OR MAY BEGIN WITH A # SIGN. C ALL NUMBERS ARE HEXADECIMAL UNLESS THEY END IN A . C C ** MODIFICATIONS ** C C CHANGING THE SIZE OF BOTH SYMB (2,400) AND BYHEX(400) C WILL ALLOW THE SYMBOL TABLE TO BE EXTENDED FOR BIGGER C PROGRAMMES. 400 IS ENOUGH FOR A NORMAL PROGRAM OF 4K+ C C THE SIZES OF THE LOOPS NEED TO BE CHANGED TOO C FOR CLEARING, LISTING, LOADING AND SEARCHING THE TABLE. C C THE PAGE SIZE HAS BEEN DEFINED USING THE DEFINITION C DATA PSIZE / XX / C SETTING IT TO 60 GIUES NORMAL FORMAT C SETTING IT TO 30 ALLOWS THE LISTING TO FIT SIDEWAYS C ON A4 PAPER. C IMPORTANT. THE FORMAT STATEMENT IN THE ORIGINAL SYMBOL C TABLE LISTING ROUTINE USES A DYNAMIC FIELD SIZE C . YOU MAY FIND IT A PROBLEM WITH OTHER FORTRANS. C C C .............................................................. C PROGRAM ASS85 C INPUT FROM A FILE IS LISTED, OR OUTPUT TO A FILE, C AND A 'INTEL-HEX' LOAD MODULE IS PRODUCED C C COMMON /INPUT/ INBUF,ICT,IPT,LNO,IPC COMMON /INFILE/ II,IFIL COMMON /OUTPUT/ OUT,IL,IO,IP,IPASS,PSIZE COMMON /SYMTAB/ SYMB COMMON /DATIM/ DAT BYTE INBUF(80),IFIL(40),LFIL(40),OFIL(40) BYTE DAT(18),TIM(8) BYTE HEXB(4) C NOTE USE OF INTEGER*4 FOR 16BIT VALUES TO SAVE C PROBLEMS WITH SIGN, ETC. C INTEGER*4 IPC,SYMB(2,400),OUT(3) !2,XXX TO CHANGE SIZE INTEGER*4 ILABEL,IOPER,IPARAM,ICVAL INTEGER*4 HEXI,BYHEX(400) !XXX TO CHANGE SIZE INTEGER*2 SIZE,PSIZE EQUIVALENCE (HEXB(1),HEXI) EQUIVALENCE (DAT(13),TIM(1) ) C DATA PSIZE /32/ DATA DAT /18*32/ C C -- MOD TO ALLOW ENTRY OF FILE NAME C 2 CALL GETMCR (INBUF,III) III=III-4 IF (III.GT.0) GOTO 20 C WRITE (5,1010) 1010 FORMAT ('$A85> ') READ (5,1000,END=875) III,(INBUF(I),I=5,III+4) C 20 IO=0 IL=0 II=0 C DO 25 I=5,III+4 J=I+1 IF (INBUF(I).EQ.1H, ) GOTO 30 IF (INBUF(I).EQ.1H= ) GOTO 40 IO=IO+1 25 OFIL(IO)=INBUF(I) STOP '*** FATAL *** NO INPUT FILE (1)' C 30 DO 35 I=J,III+4 J=I+1 IF (INBUF(I).EQ.1H=) GOTO 40 IL=IL+1 35 LFIL(IL)=INBUF(I) STOP '*** FATAL *** NO INPUT FILE (2)' C 40 IF (J.GT.III+4) STOP '*** FATAL *** NO INPUT FILE (3)' C DO 45 I=J,III+4 II=II+1 45 IFIL(II)=INBUF(I) C C C CALL TIME (TIM) CALL DATE (DAT) C C CLEAR THE SYMBOL TABLE 5 DO 10 I=1,400 !XXX TO CHANGE SIZE 10 SYMB(1,I)=0 C C CALL "LINE-OUT" ROUTINE TO INITIALISE ITS OUTPUT BUFFER CALL LOUT (-1) IPASS=1 IPC=0 LNO=0 C C - - - - - - - C MODIFICATION TO ENABLE INTERACTIVE INPUT OF FILES C ASSOCIATES UNIT 1 WITH AN INPUT DATASET C UNIT 4 WITH AN OUTPUT DATASET C UNIT 6 WITH A FILENAME (WHICH WILL BE SPOOLED) C OR "DEVICE" OR "DEVICE AND FILENAME" WHICH WONT... C TEST.LST ..WILL SPOOL C SY:TEST.LST ..WONT C TT4: ..COMES DIRECT C C 1000 FORMAT (Q,80A1) C C CALL ASSIGN (1,IFIL,II) IF (IL.GT.0) CALL ASNLUN (6,'SY',0) IF (IL.EQ.0) CALL ASNLUN (6,'TI',0) IF (IL.GT.0) CALL ASSIGN (6,LFIL,IL) IF (IO.GT.0) CALL ASSIGN (4,OFIL,IO) C - - - - - - - - C C ==== PASS 1 ==== C C ENTER PASS ONE TO GENERATE A SYMBOL TABLE. C THE SUBROUTINE "LINE" IS CALLED TO EVALUATE C THE LINE. "PUTSYM" IS USED TO ADD ANY C SYMBOLS FOUND TO THE TABLE. C C C == GET A LINE AND ANALYSE IT 100 READ (1,1000,END=200) ICT,(INBUF(I),I=1,ICT) LNO=LNO+1 CALL LINE (ILAB,IOPR,IPAR,IPS,ILABEL,IOPER) C IF (ILAB.EQ.1) CALL PUTSYM (ILABEL,IPC,IERR) IF (IPS.NE.1) GOTO 150 C C == WE DETECTED A PSEUDO-OP CALL PSEUDO (IOPER,IVAL) C A VALUE OF 2 IS END OF PASS IF (IVAL.EQ.2) GOTO 200 IF (IVAL.NE.1) GOTO 110 C A VALUE OF 1 IS AN ORIGIN CALL PARAM (IPARAM) IPC=IPARAM GOTO 100 C 110 IF (IVAL.NE.3) GOTO 120 C A VALUE OF 3 IS A VALUE IPC=IPC+1 GOTO 100 C 120 IF (IVAL.NE.4) GOTO 130 C C VALUE 4 SHOULD BE EQUATE, ENTER A NAME IN THE C SYMBOL TABLE, FOLLOWED BY ITS VALUE.... C BUT SOMETIMES THE THING YOURE EQUATING IS NOT C YET DEFINED C CALL EQUATE (ILABEL) CALL PARAM (IPARAM) CALL PUTSYM (ILABEL,IPARAM,IERR) C GOTO 100 C C VALUE 5 IS A .SKP C 130 IF (IVAL.NE.5) GOTO 140 CALL PARAM (IPARAM) IPC=IPC+IPARAM GOTO 100 C C THIS IS THE .ASC TEXT STRING PUTTER-IN. C FOR NOW WE ONLY NEED TO COUNT THE CHARACTERS AND BUMP C THE ASSEMBLY P.C. TO SUIT. C 140 IF (IVAL.NE.6) GOTO 145 C MARK=INBUF(IPT) 142 IPT=IPT+1 IF (IPT.GT.ICT) GOTO 100 IF (INBUF(IPT).EQ.MARK) GOTO 100 IPC=IPC+1 GOTO 142 C C C C THIS DEALS WITH THE .DBL COMMAND. ALL WE HAVE TO DO IS C TO BUMP THE APC THIS PASS C 145 IF (IVAL.EQ.7) IPC=IPC+2 GOTO 100 C C C == NO PSEUDOS SO NOW DEAL WITH CODE C ALL WE ARE INTERESTED IN IS HOW BIG THE COMMAND IS C TO BUMP THE ASSEMBLY PROGRAM-COUNTER 150 IF (IOPR.EQ.0) GOTO 100 CALL CODE (IOPER,ICVAL,SIZE) C IF (SIZE.EQ.0) GOTO 152 C IF (SIZE.LT.5) GOTO 160 IF (SIZE.LT.7) GOTO 155 C 152 IPC=IPC+1 155 IPC=IPC+1 160 IPC=IPC+1 GOTO 100 C C == END OF PASS 1 C WE GET HERE WITH A .END STATEMENT, OR WHEN THE SOURCE C RUNS OUT.. C C WE PUT A SYMBOL ".END" ON THE SYMBOL TABLE AND PRINT C THE SYMBOL TABLE ON THE SELECTED LISTING DEVICE C 200 CALL PUTSYM ('.END',IPC,IERR) C C ............... IF (IL.GT.0) WRITE (6,1210) (IFIL(K),K=1,II) , DAT 1210 FORMAT ('1*** ',A1,' *** ASS85 V2.1A--- PASS 1 ---' 1 ,2X,18A1,//) C C NOTE THE FIDDLE TO COUNT UP THE SYMBOLS DO 210 I=1,400 !XXX TO CHANGE SIZE J=I-1 IF (SYMB(1,I).EQ.0) GOTO 220 C WE LOOP ON IF THERE ARE MORE SYMBOLS CALL HEX (HEXB,1,4,SYMB(2,I)) BYHEX(I)=HEXI 210 CONTINUE C AND FALL THROUGH ONLY WHEN THERE ARE 400. XXX TO CHANGE SIZE J=400 !XXX TO CHANGE SIZE 220 IF (IL.GT.0) WRITE (6,1220) (SYMB(1,I),BYHEX(I),I=1,J) IF (IL.EQ.0) WRITE (5,1220) (SYMB(1,I),BYHEX(I),I=1,J) 1220 FORMAT (' SYMBOL TABLE',/,( 4(8X,A4,2X,A4)/),'1 ') REWIND (1) C ......... IPASS=2 C C ==== PASS 2 ==== C RUNS THROUGH LINE BY LINE AGAIN C LNO=0 IPC=0 C == GET THE THING LINE-BY-LINE AND OUTPUT A LISTING C 300 READ (1,1000,END=800) ICT,(INBUF(I),I=1,ICT) LNO=LNO+1 SIZE=0 CALL LINE (ILAB,IOPR,IPAR,IPS,ILABEL,IOPER) C IF (IPS.NE.1) GOTO 350 C C == WE DETECTED A PSEUDO OP CALL PSEUDO (IOPER,IVAL) C A VALUE OF 2 IS END OF PASS IF (IVAL.EQ.2) GOTO 800 IF (IVAL.NE.1) GOTO 310 C A VALUE OF 1 IS AN ORIGIN CALL PARAM (IPARAM) IPC=IPARAM CALL LOUT (SIZE) GOTO 300 C 310 IF (IVAL.NE.3) GOTO 320 C VALUE 3 ALLOCATES A VALUE TO A LOCATION C THE PARAMETER CAN BE ASCII OR SYMBOLIC TOO. C CALL PARAM (IPARAM) OUT(1)=JMOD (IPARAM,256) CALL LOUT (1) IPC=IPC+1 GOTO 300 C 320 IF (IVAL.NE.4) GOTO 330 C 4 IS AN EQUATE, AND THESE WERE DONE IN PASS 1 C UNLESS THE PARAMETERS WERE NOT DEFINED CALL EQUATE (ILABEL) CALL PARAM (IPARAM) CALL PUTSYM (ILABEL,IPARAM,IERR) CALL LOUT (0) GOTO 300 C C VALUE OF 5 IS THE THE .SKP N C ADVANCING PC BY N SPACES C 330 IF (IVAL.NE.5) GOTO 340 CALL PARAM (IPARAM) IPC=IPC+IPARAM CALL LOUT (0) GOTO 300 C C WE CAN DO ASCII STRINGS AS .ASC /STRING/ AS NORMAL C BUT HITTING THE END IF THE LINE WILL CHOP THE STRING TOO C NOTE.. WE USE THE ALTERNATIVE ENTRY AT LOUT1 TO SUPPRESS C PRINTOUT ON THE CONTINUATION LINES, SO WE HAVE TO CALL C LOUT1(-1) TO RESET IN CASE THE LAST CALL WAS TO LOUT1.. C 340 IF (IVAL.NE.6) GOTO 345 C MARK=INBUF(IPT) CALL LOUT1(-1) C C 342 III=0 DO 343 I=1,3 IPT=IPT+1 IF (IPT.GT.ICT) GOTO 344 IF (INBUF(IPT).EQ.MARK) GOTO 344 OUT(I)=INBUF(IPT) 343 III=III+1 CALL LOUT1(3) IPC=IPC+III GOTO 342 C 344 IF (III.GT.0) CALL LOUT1(III) IPC=IPC+III GOTO 300 C C C DEAL WITH DOUBLE STORAGE, LOW-HIGH, .DBL C 345 IF (IVAL.NE.7) GOTO 300 CALL PARAM(IPARAM) OUT(1)=IPARAM OUT(2)=IPARAM/256 CALL LOUT(2) IPC=IPC+2 GOTO 300 C C C == OPERATORS ARE DECODED ON THE SECOND PASS C IOPER IS LOADED (BY "LINE") WITH THE OPCODE C AND ICVAL RETURNS THE OPCODE VALUE C C SIZE ACTUALLY RETURNS THE TYPE AND NOT THE SIZE C 350 IF (IOPR.EQ.0) GOTO 675 CALL CODE (IOPER,ICVAL,SIZE) C C C NOW WE NEED TO SORT OUR CODES C GOTO (500,520,540,560,580,600,620,640) SIZE IPC=IPC+3 CALL LOUT(0) GOTO 300 C C FIRST THE SINGLE BYTE INSTRUCTIONS C C TYPE 1 OPCODES "OPR" 500 OUT(1)=ICVAL GOTO 570 C C TYPE 2 OPCODES "OPR +R" 520 CALL REG (IPARAM) OUT(1)=ICVAL+IPARAM GOTO 570 C C TYPE 3 OPCODES "OPR +8R" 540 CALL REG (IPARAM) OUT(1)=ICVAL+(8*IPARAM) GOTO 570 C C TYPE 4 OPCODES "OPR +8R1 +R2" 560 CALL REG (IPARAM) ICVAL=ICVAL+8*IPARAM CALL REG (IPARAM) OUT(1)=ICVAL+IPARAM C 570 CALL LOUT(1) IPC=IPC+1 GOTO 300 C C NOW THE TWO TYPES OF 2 BYTE INSTRUCTION C TYPE 7 OPR,LOW,HIGH C 580 OUT(1)=ICVAL GOTO 610 C C TYPE 8 OPR+8*R, LOW, HIGH 600 CALL REG(IPARAM) OUT(1)=ICVAL+ (8*IPARAM) C 610 CALL PARAM(IPARAM) OUT(2)=IPARAM CALL LOUT(2) IPC=IPC+2 GOTO 300 C C NOW THE TWO TYPES OF 3 BYTE INSTRUCTION C 620 OUT(1)=ICVAL GOTO 650 C 640 CALL REG (IPARAM) OUT(1)=ICVAL+ (8*IPARAM) C 650 CALL PARAM(IPARAM) OUT(2)=IPARAM OUT(3)=IPARAM/256 CALL LOUT(3) IPC=IPC+3 GOTO 300 C C DEAL WITH COMMENT LINES 675 CALL LOUT (0) GOTO 300 C C == COME HERE AT END OF PASS 2 == C C THE "END" LINE WILL NOT YET BE PRINTED 800 CALL LOUT (SIZE) C IF (IO.EQ.0) GOTO 700 C WRITE (4,1807) 1807 FORMAT (' :0000') C C ALTERNATIVE SYMBOL TABLE PRINTOUT C C COUNT UP THE SYMBOLS. 700 DO 710 I=1,400 J=I+1 IF (SYMB(1,I).EQ.0) GOTO 720 C CONVERT THE SYMBOLS TO HEX CALL HEX (HEXB,1,4,SYMB(2,I) ) BYHEX(I)=HEXI 710 CONTINUE C FELL THROUGH HERE IF THE SYMBOL TABLE IS FULL J=J+1 C C NOW PRINT IT. C SYMB (1,I) CONTAINS UNSORTED SYMBOLS C BYHEX(I) CONTAINS THE HEX EQUIVALENT C 720 LIN=0 DO 750 I="101,"132 C DO 740 K=1,J-1 C HEXI=SYMB(1,K) IF (HEXB(1).NE.I) GOTO 740 C IF (LIN.EQ.0) WRITE (6,1710) (IFIL(L),L=1,II),DAT 1710 FORMAT ('1*** ',A1, 1 ' *** ASS85 V2.1A--- SORTED SYMBOL TABLE ---' 1 ,2X,18A1,//) LIN=LIN+1 IF (LIN.GT.PSIZE) LIN=0 C WRITE (6,1740) SYMB(1,K),BYHEX(K) 740 CONTINUE 750 CONTINUE C 1740 FORMAT (8X,A4,2X,A4) C WRITE(6,1740) SYMB(I,J),BYHEX(J) C C IF (IL.EQ.0) CALL EXIT C THIS IS AN RSX FIDDLE SO THAT C WE WILL SPOOL ALL OUTPUT FILES EXCEPT LP: AND TTN: C SEE IF A DEVICE WAS MENTIONED, IF NOT, SPOOL C IF (LFIL(3).NE.1H:.AND.LFIL(4).NE.1H:) GOTO 850 C C A DEVICE WAS MENTIONED, HE WANTS TO KEEP IT CALL EXIT C -- 850 CONTINUE C THIS CLOSE DOES THE SPOOLING CLOSE (UNIT=6,DISPOSE='PRINT') 875 CALL EXIT END C C .............................................................. C LOUT C LOUT1 C C SUBROUTINE OUTPUTS A LINE TO THE PRINTER, IT CONVERTS C THE DATA TO HEXADECIMAL USING SUBROUTINE HEX. C C PARAMETER= 0,1,2,3 : IS NUMBER OF BYTES TO BE PRINTED C PARAMETER=-1: INITIALISES THAT ENTRY ONLY C C EACH INPUT LINE IS PRINTED, PRECEDED BY THE 16 BYTE BUFFER C OUTPUT. INITIALLY THIS CONTAINS 16 SPACES, BUT THE C ROUTINE "HEX" LOADS CORRESPONDING ELEMENTS WITH THE HEX C EQUIVALENT OF PC AND AS MANY ELEMENTS OF OUT AS C INDICATED BY "SIZE" C C C PRODUCES A HEXADECIMAL INTEL FORMAT PAPER TAPE FILE C WHICH PRODUCES ONE LINE OUT FOR EACH LINE OF CODE. C THIS IS WASTEFUL ON PAPER TAPE (!) AND ON LOADING C TIME VIA A TELETYPE, BUT GENERALLY YOU ONLY LOAD IT C ONCE, AND THEN DUMP IT BACK.... C C SUBROUTINE LOUT (SIZE) COMMON /INPUT/INBUF,ICT,IPT,LNO,IPC COMMON /INFILE/ II,IFIL COMMON /OUTPUT/ OUT,IL,IO,IP,IPASS,PSIZE COMMON /DATIM/ DAT BYTE INBUF(80),OUTBUF(16),CSUM(2),DAT(18),IFIL(40) INTEGER*4 IPC,OUT(3),ADRES,CKSUM,I256 INTEGER*2 MARK,SIZE,ADR(2),PAGE,PSIZE C EQUIVALENCE (ADRES,ADR(1)) DATA I256 /256/ C MARK=0 GOTO 5 C C ALTERNATIVE ENTRY C ENTRY LOUT1 (SIZE) IF (SIZE.GE.0) GOTO 2 MARK=0 RETURN C 2 MARK=MARK+1 C == DECODE THE OUTS INTO THE BUFFER 5 IF (SIZE.EQ.-1) PAGE=1 IF (SIZE.EQ.-1) GOTO 45 C C **THERE WERE TWO DIFFERENT CHECKSUM METHODS FOR INTEL** C CKSUM=0 CKSUM=IPC+SIZE C -- CALL HEX (OUTBUF,1,4,IPC) C -- IF (SIZE.EQ.0) GOTO 20 CKSUM=CKSUM+OUT(1) CALL HEX (OUTBUF,7,2,OUT(1)) C -- IF (SIZE.LT.2) GOTO 20 CKSUM=CKSUM+OUT(2) CALL HEX (OUTBUF,11,2,OUT(2)) C -- IF (SIZE.LT.3) GOTO 20 CKSUM=CKSUM+OUT(3) CALL HEX (OUTBUF,15,2,OUT(3)) C -- C C 20 J=ICT C IP=IP+1 IF (IP.GT.PSIZE) IP=1 IF (IL.GT.0.AND.IP.EQ.1) WRITE (6,1010) (IFIL(K),K=1,II) 1 ,DAT,PAGE 1010 FORMAT ('1*** ',A1,' *** ASS85 V2.1A--- PASS 2 ---' 1 ,2X,18A1,' PAGE',I4,//) IF (IL.GT.0 .AND. IP.EQ.1) PAGE=PAGE+1 IF (SIZE.GT.0.AND.ICT.GT.40) J=40 IF (SIZE.EQ.0.AND.ICT.GT.72) J=72 IF (MARK.LT.2 .AND. IL.GT.0) WRITE (6,1000) LNO,OUTBUF, 1 (INBUF(I),I=1,J) IF (MARK.GE.2 .AND. IL.GT.0) WRITE (6,1000) LNO, OUTBUF 1000 FORMAT (I7,5X,16A1,5X,72A1) C C C FORMATTED BINARY OUTPUT C IF (SIZE.LT.1.OR.IO.EQ.0) GOTO 45 C CKSUM=256-JMOD(CKSUM,I256) CALL HEX (CSUM,1,2,CKSUM) IF (SIZE.EQ.3) GOTO 40 OUTBUF(15)=1H0 OUTBUF(16)=1H0 IF (SIZE.EQ.2) GOTO 40 OUTBUF(11)=1H0 OUTBUF(12)=1H0 C 40 IF (SIZE.EQ.1) WRITE (4,1020) 1 SIZE,(OUTBUF(I),I=1,4),OUTBUF(7),OUTBUF(8), 2 CSUM(1),CSUM(2) C IF (SIZE.EQ.2) WRITE (4,1020) 1 SIZE,(OUTBUF(I),I=1,4),OUTBUF(7),OUTBUF(8), 2 OUTBUF(11),OUTBUF(12),CSUM(1),CSUM(2) C IF (SIZE.EQ.3) WRITE (4,1020) 1 SIZE,(OUTBUF(I),I=1,4),OUTBUF(7),OUTBUF(8), 2 OUTBUF(11),OUTBUF(12),OUTBUF(15),OUTBUF(16), 3 CSUM(1),CSUM(2) 1020 FORMAT (' :0',O1,4A1,'00',2A1,2A1,2A1,2A1) C 45 DO 50 I=1,16 50 OUTBUF(I)=32 C RETURN END C EQUATE C C THIS SUBROUTINE RETURNS THE NEXT BLOCK AS A NAME C OF UP TO 4 CHARACTERS. IT UPDATES IPT C AND IGNORES SPACES C C SUBROUTINE EQUATE (LABEL) COMMON /INPUT/ INBUF,ICT,IPT,LNO,IPC COMMON /OUTPUT/ OUT,IL,IO,IP,IPASS,PSIZE INTEGER*4 LABEL,XLABEL,SPACES BYTE LABL(4),INBUF(80),SPAC(4) INTEGER PSIZE EQUIVALENCE (XLABEL,LABL(1)) EQUIVALENCE (SPACES,SPAC(1)) DATA SPAC /4*32/ DATA TAB /"11/ C C WE WILL ACCEPT UP TO 8 CHARACTERS OF WHICH UP TO C THE THIRD AND THEN THE LAST ARE USED C LABEL=SPACES XLABEL=SPACES DO 10 I=1,8 IF (IPT.GT.ICT) GOTO 100 IF (INBUF(IPT).EQ.1H;) GOTO 100 IF (INBUF(IPT).EQ.32.OR.INBUF(IPT).EQ.TAB) GOTO 90 IF (INBUF(IPT).EQ.1H, .OR. INBUF(IPT).EQ.1H=) GOTO 95 IF (I.GE.4) LABL(4)=INBUF(IPT) IF (I.LT.4) LABL(I)=INBUF(IPT) 10 IPT=IPT+1 C C IF WE FELL THROUGH, THERE ARE 8 OR MORE CHARACTERS WRITE (5,1010) LNO, XLABEL IF (IPASS.EQ.2.AND.IL.NE.0) WRITE (6,1010) LNO , XLABEL 1010 FORMAT (/,' EQUATE NAME ERROR AT LINE ',I5,'..[',A4,']',/) C C IGNORE SPACES AND TABS 90 IF (IPT.GT.ICT) GOTO 100 IF (INBUF(IPT).EQ.1H;) GOTO 100 IF (INBUF(IPT).EQ.1H=) GOTO 95 IF (INBUF(IPT).NE.32.AND.INBUF(IPT).NE.TAB) GOTO 100 95 IPT=IPT+1 GOTO 90 C 100 LABEL=XLABEL RETURN END C REG C THIS SUBROUTINE COMPARES A 4 CHARACTER STRING, PADDED WITH C SPACES, WHICH IT GETS FROM THE INPUT STRING WITH 'EQUATE', C TO FIND THE NAME OF A REGISTER, REGISTER PAIR, OR C MEMORY FLAG 'M' IN AN OPCODE C IT ALSO CONVERTS A STRING WITH A NUMBER IN FIRST PLACE FOR C RST COMMANDS C SUBROUTINE REG (VAL) INTEGER*4 NAME,VAL,NAMES(22),VALS(22) C DATA NAMES /'B ','C ','D ','E ','H ','L ','M ' 1 ,'A ','SP ','PSW ','BC ','DE ','HL ','SP ' 2 ,'0 ','1 ','2 ','3 ','4 ','5 ','6 ' 3 ,'7 '/ DATA VALS /0,1,2,3,4,5,6,7,6,6,0,2,4,6,0,1,2,3,4,5,6,7/ C CALL EQUATE (NAME) C DO 100 I=1,22 IF (NAME.EQ.NAMES(I) ) GOTO 200 100 CONTINUE C I=1 200 VAL=VALS(I) RETURN END C HEX C C SUBROUTINE LOADS J ELEMENTS OF A BYTE BUFFER, STARTING C FROM ELEMENT I, WITH THE HEXADECIMAL REPRESENTATION C OF THE VARIABLE "IN". EITHER J=2 OR J=4 ARE LEGAL C SUBROUTINE HEX (OUTBUF,I,J,IN) BYTE OUTBUF(16) INTEGER*4 IN C K=I IF (J.LE.2) GOTO 10 OUTBUF(K)=IN/(16*16*16)+1H0 IF (OUTBUF(K).GT.1H9) OUTBUF(K)=OUTBUF(K)+7 OUTBUF(K+1)=JMOD (IN,16*16*16)/(16*16)+1H0 IF (OUTBUF(K+1).GT.1H9) OUTBUF(K+1)=OUTBUF(K+1)+7 K=K+2 C 10 OUTBUF(K)=JMOD(IN,(16*16))/16+1H0 IF (OUTBUF(K).GT.1H9) OUTBUF(K)=OUTBUF(K)+7 OUTBUF(K+1)=JMOD(IN,16)+1H0 IF (OUTBUF(K+1).GT.1H9) OUTBUF(K+1)=OUTBUF(K+1)+7 RETURN END C PARAM C C MODIFIED VERSION WITH LEFT-RIGHT ARITHMETIC C ACCEPTS C + - * / & ! AND ^ C C ^ FOLLOWS THE SYMBOL OR VALUE AND INDICATES /256 C C C SUBROUTINE TAKES THE VALUE FOLLOWING THE POINTER IPT C AS SYMBOL, AND LOOKS IT UP C WE LOOK AT THE FIRST LETTER AND START WITH C THE ASSUMPTION THAT IT IS A SYMBOL TO LOOK UP. C UNLESS 0-9 OR #,THEN TAKES FOLLOWING NUMBER AS NUMERICAL C OR IF ' OR #', TAKES FOLLOWING CHARACTER AS ASCII. C C IF NUMBER ENDS WITH A "." THEN TAKES IT DECIMAL C SUBROUTINE PARAM (IPARAM) COMMON /INPUT/ INBUF,ICT,IPT,LNO,IPC BYTE INBUF(80),BSYM(4),IOPR INTEGER*4 IPC,ISYM,IPARAM,LPARAM,IDEC INTEGER ARITH EQUIVALENCE (ISYM,BSYM(1)) C ARITH=0 IOPR=0 LPARAM=0 C 2 DO 5 I=1,4 5 BSYM(I)=32 C IPARAM=0 IDEC=0 C IF (INBUF(IPT).EQ.1H$) GOTO 50 IF (INBUF(IPT).EQ.1H.) GOTO 120 IF (INBUF(IPT).EQ.1H#) GOTO 100 IF (INBUF(IPT).EQ.1H') GOTO 200 IF (INBUF(IPT).LE.1H9.AND.INBUF(IPT).GE.1H0) GOTO 105 C DO 10 I=1,8 IF (IPT.GT.ICT) GOTO 20 IF (INBUF(IPT).LT.1H0 .OR. INBUF(IPT).GT.1HZ) GOTO 20 IF (INBUF(IPT).GT.1H9 .AND. INBUF(IPT).LT.1HA) GOTO 20 IF (I.LT.4) BSYM(I)=INBUF(IPT) IF (I.GE.4) BSYM(4)=INBUF(IPT) 10 IPT=IPT+1 20 CALL GETSYM (ISYM,IPARAM,IERR) GOTO 300 C C THE SYMBOL $ HAS THE CURRENT PC VALUE C 50 IPT=IPT+1 IPARAM=IPC GOTO 300 C == DEAL WITH A NUMERICAL PARAMETER 100 IPT=IPT+1 IF (IPT.LT.ICT.AND.INBUF(IPT).EQ.1H') GOTO 200 105 DO 110 I=1,8 IF (IPT.GT.ICT) GOTO 900 IF (INBUF(IPT).EQ.1H;) GOTO 900 IF (INBUF(IPT).EQ.1H.) GOTO 120 IF (INBUF(IPT).LT.1H0 .OR. INBUF(IPT).GT.1HZ) GOTO 300 IF (INBUF(IPT).GT.1H9 .AND. INBUF(IPT).LT.1H0) GOTO 300 IF (INBUF(IPT).LE.1H9) IDEC=IDEC*10 +(INBUF(IPT)-1H0) IF (INBUF(IPT).LE.1H9) IPARAM=IPARAM*16 +(INBUF(IPT)-1H0) IF (INBUF(IPT).GE.1HA) IPARAM=IPARAM*16 +(INBUF(IPT)+10-1HA) 110 IPT=IPT+1 GOTO 300 C A DECIMAL VALUE 120 IPT=IPT+1 IPARAM=IDEC GOTO 300 C C == DEAL WITH AN ASCII CHARACTER 200 IPT=IPT+1 IPARAM=INBUF(IPT) IPT=IPT+1 C C (FALL THROUGH) C C AT THIS POINT, WE HAVE FINISHED A SYMBOL C WE LOOK AT THE NEXT SYMBOL TO SEE IF ITS A ^ 300 IF (IPT.GT.ICT) GOTO 310 IF (INBUF(IPT).NE.1H^) GOTO 310 C IPARAM=IPARAM/256 IPT=IPT+1 C C WE LOOK AT THE STORED OPERATOR. IF 0 ITS OK 310 IF (IOPR.NE.0) GOTO 320 LPARAM=IPARAM GOTO 345 C C IF THERE IS AN OPERATOR, THE PARAMETER MUST BE UPDATED C 320 IF (IOPR.EQ.1H+) LPARAM=LPARAM+IPARAM IF (IOPR.EQ.1H-) LPARAM=LPARAM-IPARAM IF (IOPR.EQ.1H*) LPARAM=LPARAM*IPARAM IF (IOPR.EQ.1H/) LPARAM=LPARAM/IPARAM IF (IOPR.EQ.1H&) LPARAM=JIAND(LPARAM,IPARAM) IF (IOPR.EQ.1H!) LPARAM=JIOR(LPARAM,IPARAM) IOPR=0 C == SKIP SPACES 345 IF (INBUF(IPT).EQ.1H,) GOTO 500 IF (IPT.GT.ICT .OR. INBUF(IPT).EQ.1H;) GOTO 900 IF (INBUF(IPT).NE.32.AND.INBUF(IPT).NE.9) GOTO 350 IPT=IPT+1 GOTO 345 C 350 IF (IPT.GT.ICT .OR. INBUF(IPT).EQ.1H;) GOTO 900 IF (INBUF(IPT).EQ.1H,) GOTO 500 C C NOW WE WILL LOOK FOR A CURRENT OPERATOR, AND STORE IT C IF (INBUF(IPT).EQ.1H+ .OR. INBUF(IPT).EQ.1H-) ARITH=2 IF (INBUF(IPT).EQ.1H* .OR. INBUF(IPT).EQ.1H/) ARITH=2 IF (INBUF(IPT).EQ.1H& .OR. INBUF(IPT).EQ.1H!) ARITH=2 C IF (ARITH.NE.2) GOTO 2 ARITH=1 IOPR=INBUF(IPT) IPT=IPT+1 GOTO 2 C C SKIP SPACES AND TABS AFTER A COMMA C 500 IPT=IPT+1 IF (IPT.GT.ICT) GOTO 900 IF (INBUF(IPT).NE.32.AND.INBUF(IPT).NE.9.AND.INBUF(IPT).NE.1H,) 1 GOTO 500 C C WE FINALLY GET HERE AFTER A COMMA OR END, AND NEED TO SEE IF WE C HAD ANY ARITHMETICS C 900 IF (ARITH.EQ.0) GOTO 950 IF (IOPR.EQ.0) IPARAM=LPARAM C IF (IOPR.EQ.1H+) IPARAM=LPARAM+IPARAM IF (IOPR.EQ.1H-) IPARAM=LPARAM-IPARAM IF (IOPR.EQ.1H*) IPARAM=LPARAM*IPARAM IF (IOPR.EQ.1H/) IPARAM=LPARAM/IPARAM IF (IOPR.EQ.1H&) IPARAM=JIAND(LPARAM,IPARAM) IF (IOPR.EQ.1H!) IPARAM=JIOR(LPARAM,IPARAM) C C BUT THE RESULT COULD BE -VE, THATS "REAL MINUS" 950 IPARAM=JIAND(IPARAM,"177777) RETURN END C LINE C C THIS SUBROUTINE ANALYSES THE LINE HELD IN THE INPUT BUFFER C AND RETURNS ONE OR MORE FLAGS C ILAB A LABEL IS PRESENT (IN XLABEL) C IOPR AN OPCODE IS PRESENT (IN XOPER) C IPAR CONTAINS POINTER TO FIRST CHARACTER OF C A PARAMETER STRING C IPS A PSEUDO-OP IS PRESENT (IN XOPER) C C SUBROUTINE LINE (ILAB,IOPR,IPAR,IPS,XLABEL,XOPER) COMMON /INPUT/ INBUF,ICT,IPT,LNO,IPC COMMON /OUTPUT/ OUT,IL,IO,IP,IPASS,PSIZE BYTE INBUF(80) INTEGER*2 ICT,IPT,PSIZE C INTEGER*4 LABEL,OPER,SPACES,IPC INTEGER*4 XLABEL,XOPER BYTE LABL(4),OPR(4),SPAC(4),TAB EQUIVALENCE (LABL(1),LABEL),(OPR(1),OPER),(SPACES,SPAC(1)) DATA SPAC /4*32/ DATA TAB /"11/ C ILAB=0 IOPR=0 IPAR=0 IPS=0 LABEL=SPACES OPER=SPACES IPT=1 C == THROW OUT NULL LINES AND COMMENTS IF (ICT.EQ.0) GOTO 900 IF (INBUF(1).EQ.1H;) RETURN C == LOOK FOR A LABEL C NO LABEL IF WE BEGIN WITH "SPACE" OR "TAB" IF (INBUF(1).EQ.32.OR.INBUF(1).EQ.TAB) GOTO 90 ILAB=1 C WE WILL ACCEPT UP TO 8 CHARACTERS OF WHICH THE C FIRST 3 AND THE LAST ARE USED. WE TERMINATE ON C "SPACE",":",AND "TAB" DO 10 I=1,8 IF (IPT.GT.ICT) GOTO 900 IF (INBUF(IPT).EQ.1H;) GOTO 900 IF (INBUF(IPT).EQ.32.OR.INBUF(IPT).EQ.TAB) GOTO 90 IF (INBUF(IPT).EQ.1H:) GOTO 90 IF (I.GE.4) LABL(4)=INBUF(IPT) IF (I.LT.4) LABL(I)=INBUF(IPT) 10 IPT=IPT+1 C C IF WE FELL THROUGH, THERE WERE 8 OR MORE CHARACTERS CC TYPE *,' LABEL ERROR AT LINE',LNO WRITE (5,1010) LNO, LABEL IF (IPASS.EQ.2.AND.IL.NE.0) WRITE (6,1010) LNO,LABEL 1010 FORMAT (/,' LABEL ERROR AT LINE ',I5,'..[',A4,']',/) C === IGNORE SPACES AND TABS 90 IF (INBUF(IPT).EQ.1H:) IPT=IPT+1 IF (IPT.GT.ICT) GOTO 900 IF (INBUF(IPT).EQ.1H;) GOTO 900 IF (INBUF(IPT).NE.32.AND.INBUF(IPT).NE.TAB) GOTO 100 IPT=IPT+1 GOTO 90 C C == DEAL WITH AN OPERATOR 100 IF (IPT.GT.ICT) GOTO 900 IF (INBUF(IPT).EQ.1H;) GOTO 900 IF (INBUF(IPT).EQ.32.OR.INBUF(IPT).EQ.TAB) GOTO 190 IF (INBUF(IPT).NE.1H.) IOPR=1 IF (INBUF(IPT).NE.1H.) GOTO 105 IPS=1 IPT=IPT+1 C == C WE LOOP FIVE TIMES, SINCE THE LONGEST LEGAL OPCODE C IS ONLY 4 CHARACTERS WE WILL GET AN ERROR SIGNAL FOR 5 105 DO 110 I=1,5 IF (IPT.GT.ICT) GOTO 900 IF (INBUF(IPT).LT.1H0 .OR. INBUF(IPT).GT.1HZ) GOTO 190 IF (INBUF(IPT).LT.1HA .AND. INBUF(IPT).GT.1H9) GOTO 190 IF (I.LT.5) OPR(I)=INBUF(IPT) 110 IPT=IPT+1 CC TYPE *, ' OPCODE ERROR AT LINE ',LNO WRITE (5,1110) LNO, OPER IF (PASS.EQ.2.AND.IL.GT.0) WRITE (6,1110) LNO,OPER 1110 FORMAT (/,' OPCODE ERROR AT LINE ',I5,'...[',A4,']',/) C 190 IF (IPT.GT.ICT) GOTO 900 IF (INBUF(IPT).EQ.1H;) GOTO 900 IF (INBUF(IPT).NE.32.AND.INBUF(IPT).NE.TAB) GOTO 200 IPT=IPT+1 GOTO 190 C == DEAL WITH A PARAMETER HERE C ALL WE DO AFTER CHECKING IF THERE IS ONE C IS TO RETURN THE POINTER C 200 IF (IPT.GT.ICT)GOTO 900 IF (INBUF(I).EQ.1H;) GOTO 900 IPAR=IPT C C == END OF LINE 900 XLABEL=LABEL XOPER=OPER RETURN END C PUTSYM C C THIS SUBROUTINE PUTS THE SYMBOL AND VALUE (SYM,VAL) C IN THE NEXT FREE PAIR OF LOCATIONS IN SYMBOL TABLE. C IF THE SYMBOL IS ALREADY DEFINED, IT IS NOW C RE-DEFINED, AND IERR RETURNS -1. AN ERROR IS REPORTED C ONLY IF THE SYMBOL HAD A DIFFERENT VALUE . C C SUBROUTINE PUTSYM (SYM,VAL,IERR) COMMON /SYMTAB/ SYMB COMMON /INPUT/ INBUF,ICT,IPT,LNO,IPC COMMON /OUTPUT/ OUT,IL,IO,IP,IPASS,PSIZE BYTE INBUF(80) INTEGER PSIZE INTEGER*4 SYMB(2,400),SYM,VAL,IPC,OUT(3) !2,XXX TO CHANGE SIZE C DO 10 I=1,400 !XXX TO CHANGE SIZE J=I IF (SYMB(1,I).EQ.0) GOTO 100 IF (SYMB(1,I).EQ.SYM) GOTO 50 10 CONTINUE TYPE *, ' SYMBOL TABLE FULL AT',LNO IERR=-1 RETURN C C == WE GET HERE IF THE NAME APPEARS AGAIN C 50 IERR=1 IF (VAL.EQ.SYMB(2,J))RETURN IERR=-1 WRITE (5,1200) SYM,LNO IF (IPASS.EQ.2.AND.IL.NE.0) WRITE (6,1200) SYM, LNO 1200 FORMAT (6X,' WARNING. REDEFINED SYMBOL [',A4,'] AT LINE NO.',I5) C == WE GET HERE POINTING TO THE NEXT EMPTY LOCATION IN TABLE 100 SYMB(1,J)=SYM SYMB(2,J)=VAL IERR=1 RETURN END C GETSYM C C THIS SUBROUTINE COLLECTS THE VALUE (VAL) ASSOCIATED WITH C THE SYMBOL (SYM) BY LINEAR SEARCH IN THE SYMBOL TABLE. C THE NULL SYMBOL IS A SPECIAL CASE C IF THE SYMBOL IS NOT IN THE TABLE, IT IS ASSIGNED THE C VALUE 0 AND IERR IS RETURNED AS -1 C C SUBROUTINE GETSYM (SYM,VAL,IERR) COMMON /SYMTAB/ SYMB COMMON /INPUT/ INBUF,ICT,IPT,LNO,IPC COMMON /OUTPUT/ OUT,IL,IO,IP,IPASS,PSIZE BYTE INBUF(80),NULLS(4) INTEGER PSIZE INTEGER*4 SYMB (2,400), SYM, VAL, IPC, OUT(3) !XXX CHANGE SIZE INTEGER*4 NULL EQUIVALENCE (NULL,NULLS(1)) DATA NULLS /4*32/ C IF (SYM.EQ.NULL) GOTO 300 C C DO 10 I=1,400 !XXX TO CHANGE SIZE J=I IF (SYMB(1,I).EQ.0) GOTO 100 IF (SYMB(1,I).EQ.SYM) GOTO 200 10 CONTINUE 100 WRITE (5,1100) SYM,LNO IF (IPASS.NE.1.AND.IL.NE.0) WRITE (6,1100) SYM,LNO 1100 FORMAT (/,' SYMBOL [',A4,'] NOT IN TABLE AT LINE ',I5,/) IERR=-1 VAL=O RETURN 200 VAL=SYMB(2,I) IERR=1 RETURN 300 VAL=0 IERR=1 RETURN END C PSEUDO C C SUBROUTINE CHECKS THE GIVEN OPERATOR AGAINST A LIST AND C RETURNS A VALUE READY FOR A C GOTO (100,110....,200) IVAL C INSTRUCTION. C C SUBROUTINE PSEUDO (OPER,IVAL) COMMON /INPUT/ INBUF,ICT,IPT,LNO,IPC COMMON /OUTPUT/ OUT,IL,IO,IP,IPASS,PSIZE BYTE INBUF(80) INTEGER PSIZE INTEGER*4 PSEU(7),OPER,IPC,OUT(3) DATA PSEU /'ORG ','END ','VAL ','EQU ','SKP ','ASC ','DBL '/ C DO 10 I=1,7 IVAL=I IF (OPER.EQ.PSEU(I)) RETURN 10 CONTINUE TYPE *, 'PSEUDO OP ERROR AT LINE ',LNO IF (PASS.EQ.2.AND.IL.NE.0) WRITE (6,1010) OPER,LNO 1010 FORMAT (/,' PSEUDO OP ERROR [',A4,'] AT LINE NO.',I5,/) IVAL=0 RETURN END C CODE C C SUBROUTINE DOES A LINEAR SEARCH THROUGH A TABLE OF OPCODES AND C RETURNS THE VALUE OF THE OPCODE AND THE TYPE NUMBER 1,7 C CODES NOT IN THE TABLE RETURN AS 0 VALUE AND 0 SIZE C C NOTE THAT THE DATA IS INCLUDED IN THIS SUBROUTINE INSTEAD C OF IN A BLOCK DATA BECAUSE OF A PECULIARITY OF THE LIBRARY C UTILITY WHICH PREVENTED THE STORAGE OF THE BLOCK DATA C MODULE. C SUBROUTINE CODE (OPER,VAL,SIZE) COMMON /CODES/ OPCODE,VALUE,SIZES COMMON /INPUT/ INBUF,ICT,IPT,LNO,IPC C INTEGER*4 OPCODE(120),VALUE(120),OPER,VAL,IPC INTEGER*2 SIZES(120),SIZE BYTE INBUF(80) C INTEGER*4 OPR1(40),OPR2(40),OPR3(8) EQUIVALENCE (OPR1(1),OPCODE(1)),(OPR2(1),OPCODE(41)) EQUIVALENCE (OPR3(1),OPCODE(81)) C INTEGER*4 VAL1(40),VAL2(40),VAL3(8) EQUIVALENCE (VAL1(1),VALUE(1)),(VAL2(1),VALUE(41)) EQUIVALENCE (VAL3(1),VALUE(81)) C INTEGER*2 SIZES1(40),SIZES2(40),SIZES3(8) EQUIVALENCE (SIZES1(1),SIZES(1)),(SIZES2(1),SIZES(41)) EQUIVALENCE (SIZES3(1),SIZES(81)) C C == THIS IS A TABLE OF OPCODES, VALUES, AND COMMAND SIZES C DATA OPR1 / 1 'MOV ','MVI ','LXI ','LDA ','STA ','LHLD','SHLD','LDAX', 2 'STAX','XCHG','ADD ','ADI ','ADC ','ACI ','SUB ','SBI ', 3 'SBB ','SBI ','INR ','DCR ','INX ','DCX ','DAA ','ANA ', 4 'RST ','ANI ','XRA ','XRI ','ORA ','ORI ','CMP ','CPI ', 5 'RLC ','RRC ','RAL ','RAR ','CMA ','CMC ','STC ','PCHL'/ C DATA OPR2 / 1 'PUSH','POP ','XTHL','SPHL','IN ','OUT ','EI ','DI ', 2 'HLT ','NOP ','RIM ','SIM ','JMP ','JC ','JZ ','JM ', 3 'JPE ','JNC ','JNZ ','JP ','JPO ','CALL','CC ','CZ ', 4 'CM ','CPE ','CNC ','CNZ ','CP ','CPO ','RET ','RC ', 5 'RZ ','RM ','RPE ','RNC ','RNZ ','RP ','RPO ','SUI '/ C DATA OPR3 / 1 'DAD ',7*0/ C C DATA VAL1 / 1 "100,"006,"001,"072,"062,"052,"042,"012, 2 "002,"353,"200,"306,"210,"316,"220,"336, 3 "230,"236,"004,"005,"003,"013,"047,"240, 4 "307,"346,"250,"356,"260,"366,"270,"376, 5 "007,"017,"027,"037,"057,"077,"067,"351/ DATA VAL2 / 1 "305,"301,"343,"371,"333,"323,"373,"363, 2 "166,"000,"040,"060,"303,"332,"312,"372, 3 "352,"322,"302,"362,"342,"315,"334,"314, 4 "374,"354,"324,"304,"364,"344,"311,"330, 5 "310,"370,"350,"320,"300,"360,"340,"326/ C DATA VAL3 / 1 "011,7*0/ C DATA SIZES1 / 1 4, 6, 8, 7, 7, 7, 7, 3, 2 3, 1, 2, 5, 2, 5, 2, 5, 3 2, 5, 3, 3, 3, 3, 1, 2, 4 3, 5, 2, 5, 2, 5, 2, 5, 5 1, 1, 1, 1, 1, 1, 1, 1/ DATA SIZES2 / 1 3, 3, 1, 1, 5, 5, 1, 1, 2 1, 1, 1, 1, 7, 7, 7, 7, 3 7, 7, 7, 7, 7, 7, 7, 7, 4 7, 7, 7, 7, 7, 7, 1, 1, 5 1, 1, 1, 1, 1, 1, 1, 5/ C DATA SIZES3 / 1 3, 0, 0, 0, 0, 0, 0, 0/ C C VAL=0 SIZE=0 DO 20 I=1,81 J=I IF (OPCODE(I).EQ.OPER) GOTO 100 20 CONTINUE TYPE *, 'OPCODE ERROR AT', LNO RETURN C 100 VAL=VALUE(J) SIZE=SIZES(J) RETURN END