C COPYRIGHT 1978 MOTOROLA INC. C C C ARTICLES, INFORMATION AND DATA ENCLOSED HEREIN C ARE PROPRIETARY TO MOTOROLA AND MAY NOT BE C DISTRIBUTED, REPRODUCED OR DISCLOSED OUTSIDE C BUYER'S ORGANIZATION WITHOUT THE EXPRESS WRITTEN C CONSENT OR APPROVAL OF AN AUTHORIZED MOTOROLA C OFFICER. C C C 1.0 INTRODUCTION C C C SEE SECTION 3.0 FOR INSTALLATIONS PROCEDURES...... C C THIS IS THE M68000 CROSS ASSEMBLER. IT IS WRITTEN IN C ANSI STANDARD FORTRAN-IV, SO IT SHOULD BE POSSIBLE C TO COMPILE AND EXECUTE IT ON ANY COMPUTER WHICH SUPPORTS C ANSI FORTRAN-IV. C C THIS IS A TWO PASS ASSEMBLER. ON THE FIRST PASS IT WILL READ C IN THE SOURCE FILE FROM FORTRAN UNIT 'LUSI' AND BUILD THE C SYMBOL TABLE. ON PASS TWO THE SOURCE FILE IS REWOUND AND A C LISTING IS OUTPUT TO FORTRAN UNIT 'LUOT'. THE OBJECT RECORD C (BINARY OBJECT RECORDS IN MC68000 FORMAT) C ARE OUTPUT TO THE FORTRAN UNIT 'LUOO'. C C SEE THE M68000 CROSS MACRO ASSEMBLER MANUAL FOR INFORMATION C ON THE INSTRUCTION SET. C C 1.1 GENERAL INFORMATION ABOUT THE CROSS ASSEMBLER. C C EACH ROUTINE STARTS WITH COMMENTS DESCRIBING VERSION C NUMBER, DATE, ENTRY, EXIT VALUE OF ARGUMENTS IN CALLS, AND C ITS FUNCTION. ALSO INDICATES IF IT IS COMPUTER DEPENDENT OR C INDEPENDENT ON THE FIRST COMMENT LINE. IF COMPUTER C INDEPENDENT IT SAYS CMP: ALL. IF COMPUTER DEPENDENT IT C SAYS CMP: PDP-11. C TO MODIFY CROSS ASSEMBLER TO RUN ON NON PDP-11 TYPE C COMPUTERS, EACH ROUTINE WITH CMP: PDP-11 MUST BE MODIFIED TO C RUN ON NEW HOST COMPUTER. SOME ROUTINES INDICATE WHY THEY C ARE PDP-11 DEPENDENT, OTHERS ARE SELF EXPLANATORY. EACH C SOURCE STATEMENT IS READ IN USING ALPHA (A1) FORMAT. THE C STATEMENT IS THEN ZERO FILLED(R1 FORMAT) ON THE LEFT. C WHEN ASSEMBLY IS COMPLETED THE SOURCE LINE IS C PRINTED OUT IN A1 FORMAT. GENERATED M68000 HEX INSTRUCTIONS C ARE CONVERTED TO ASCII THEN OUTPUT. C C 1.2 GENERAL OPERATION OF THE CROSS ASSEMBLER. C C DURING PASS ONE THE SOURCE LINE IS BROKEN INTO ELEMENTS C CALLED TOKENS BY ROUTINE 'SCN'. EACH TOKEN IS LOOKED UP C IN THE SYMBOL TABLE BY 'LKP'. IF A LABEL IT IS ENTERED C IN THE TABLE BY 'STF'. IF AN OPERAND IT IS LOCATED IN THE C SYMBOL TABLE AND INFORMATION STORED WITH IT IS USED TO BUILD C THE INSTRUCTION. PART OF THE DATA IS USED TO BRANCH IN C 'BUILD1' TO COMPLETE THE INSTRUCTION. C AT THE END OF PASS 1 THE FILE IS REWOUND AND EACH SOURCE C LINE IS READ IN AGAIN. OPERANDS ARE FOUND IN THE SYMBOL C TABLE AND DATA FOUND WITH THEM IS USED IN 'BUILD2'. C ROUTINE 'OUTPUT' PRINTS OUT THE SOURCE LINE AND THE C GENERATED INSTRUCTIONS. C ROUTINE 'PAR' WEAVES ITS WAY THROUGH THE PARSE NET TABLE C AND CALLING 'ACT1' IN PASS 1 AND 'ACT2' IN PASS 2 IT C BREAKS EACH SOURCE LINE DOWN, BUILDING THE INSTRUCTION FOR C FINAL ASSEMBLY IN 'BUILD1' OR 'BUILD2'. MACROS ARE C STORED IN THE SYMBOL TABLE AND ARE PULLED OUT DURING C EXPANSION IN EACH PASS. PASS ONE MUST EXAMINE A C MACRO TO SEE HOW MANY BYTES ARE REQUIRED FOR AN INSTRUCTION C IN ORDER TO KEEP IN PHASE WITH PASS TWO. C A MODIFICATION IN 'ACT1' OR 'BUILD1' CHANGING THE NUMBER C OF BYTES GENERATED WILL HAVE TO BE MADE IN 'ACT2' OR 'BUILD2' C TO AVOID PHASE ERRORS. THE REVERSE IS ALSO TRUE. C C 2.0 INTRODUCTION C C THIS SECTION DEFINES DEVICE NUMBERS, COMMON, C HOW TO MODIFY THE SYMBOL TABLE SIZE, AND HOW TO CHANGE C DEVICE NUMBERS AND SPECIAL COMPUTER DEPENDENT VARIABLES. C C 2.1 DEVICE NUMBERS. SEE SUBROUTINE 'COMDEP' TO CHANGE. C C LUSI = 2 (SOURCE INPUT) C LUOT = 6 (ASSEMBLY LISTING AND ERROR MESSAGES TO A PRINTER) C LUOT = 5 (ASSEMBLY LISTING AND ERROR MESSAGES TO CONSOLE) C LULT = 5 (OUTPUT TO CONSOLE) C LUCI = 5 (INPUT FROM CONSOLE) C LUOO = 1 (ASSEMBLED OBJECT OUTPUT) C C 2.2 COMMON C C ALL COMMON IS LABELED /A/. THE DICTIONARY, PARSENET TABLE, AND C HASH TABLE ARE INITIALIZED IN BLOCK DATA. C C ISYM - SYMBOL TABLE, THE DICTIONARY IS IN THE FIRST 900 C WORDS. SEE BLOCK DATA WHERE THE DICTIONARY IS C INITIALIZED. C AN ENTRY IN THE SYMBOL TABLE IS AS FOLLOWS: C ISYM(1)->M.S.WORD OF SYMBOL'S VALUE. C (2)->M.S.BYTE = NUMBER CHARACTERS IN SYMBOL NAME TIMES 2. C 1 = 1-2 CHARS, 2=3-4 CHARS ETC. C (2)->L.S.BYTE=TYPE: 255=OPCODE 1=LABEL C (3)->LINK TO NEXT SYMBOL IN TABLE C (4)-(4+S)-> S=(SIZE-1)/2 2 CHARACTERS/WORD C (4+S+1)->ADDRESS TYPE, SEE RR-TTT-MMM BELOW. C IN LEAST SIGNIFICANT BYTE(L.S.B). C (4+S+2)-> 2 L.S.B OF SYMBOL'S ADDRESS. C JSUC POINTS TO ISYM(I) ON RETURN FROM 'LKP'. C JPTR & LPTR POINT TO ISYM(4+S+1) ON RETURN FROM 'LKP'. C C 1 - SYMBOL TABLE: C LOW BYTE BITS DEFINED AS RR-TTT-MMM WHERE: C RR = 00 - UNDEFINED SYMBOL C 01 - DEFINED IN PASS ONE C 10 - DEFINED IN PASS TWO C 11 - MULTIPLY DEFINED SYMBOL C TTT = 0 - ABSOLUTE SYMBOL C 1 - RELATIVE SYMBOL C 2 - REGISTER C 3 - KEYWORD C MMM = RESERVED FOR MODE (ASCII,BIN,ETC) C 2 - ADDRESS OF THE SYMBOL C C KARD1 - INPUT SOURCE IMAGE GOES HERE. C C KARD2 - MACRO PARAMETER SAVE AREA IN R1 FORMAT C MFLD - POINTERS TO EACH SUBFIELD IN KARD2 C MDEP - DEPTH OF MACRO NESTING, MAX = 3 C MPTR - POINTER TO MACRO DEFINITION OR ELSE = 0 C C ITOKEN - SYMBOL IS BROKEN DOWN FROM 'KARD1' TO HERE AND C IS TAKEN FROM HERE AND PUT IN SYMBOL TABLE. C C TKNSIZ - NUMBER OF CHARACTERS IN 'ITOKEN'. C C TKNTYP - TYPE OF TOKEN IN 'ITOKEN'. C 24 = VARIABLE C 25 = NUMBER C 27 = 'STRING' OVER 4 BYTES LONG C 28 = REGISTER C 29 = STATEMENT LABEL C C TKNVAL - VALUE OF 'ITOKEN'. C TKNVA2 - HOLDS OVERFLOW FROM 'TKNVAL', SET IN 'SCN'. C C SYMTYP - MODE OF THE CURRENT SYMBOL C 0 = ABSOLUTE C 1 = RELATIVE C C JSUC - FLAG SET BY SYMBOL LOOKUP ROUTINE 'LKP'. C C JPTR - SET TO POINT AT SYMBOL TABLE ENTRY OF SYMBOL. C C NXSYM - POINTS TO NEXT AVAILABLE ADDRESS IN SYMBOL TABLE. C NXSYM1 - SAVE START OF LABELS IN SYMBOL TABLE,END OF DICT. C C KOLUMN - POSITION OF SCAN IN 'KARD1'. C C KD1BCT - END OF INPUT BUFFER(KARD1). C C KD1LNO - SOURCE LINE NUMBER. C C PASS,IPASS - PASS NUMBER FLAG ASSEMBLER IS CURRENTLY ON C -1 = PASS ONE C 0 = PASS TWO C C IPC - CURRENT P-COUNT. C IPC2 - M.S.B. OF CURRENT P-COUNT(3RD BYTE) C C IOPC - OPCODE CLASS C C INS - ARRAY INSTRUCTION IS BUILT IN AND OUTPUT FROM. C C ISIZ - SIZE (B,W,L) FOR CURRENT INSTRUCTION C B = BYTE = 1 C W = WORD = 2 C L = LONG WORD = 4 C C INSL - NUMBER OF BYTES REQUIRED FOR CURRENT INSTRUCTION. C C IADM - ADDRESS MODE FOR FIELD-1 AND FIELD-2 OF C THE OPERAND. C IADM(1,2): C ADDESS MODE ASSEMBLER FORMAT C 00 = DATA REG DIRECT D1 C 08 = ADDR REG DIRECT A1 C 16 = ADDR REG INDIRECT (A1) C 24 = POST INCREMENT (A1)+ C 32 = PRE DECREMENT -(A1) C 40 = INDIRECT & DISPL'MT 3(A1) C 48 = DISPL'MT & IND & X 3(A1,A2) C 56 = ABSOLUTE SHORT $1234 C 57 = ABSOLUTE LONG $123456 C 58 = PC + DISPL'MT REL C 59 = PC + X + DISPL'MT REL(A1) C 60 = IMMEDIATE SHORT #$1234 C IMMEDIATE LONG #$123456 C 64 = STATUS REGISTER SR,CCR C C 2 - REGISTER # C C X IADM(X,1) IADM(X,2) C - --------- -------- C 3 ... NO. BYTES IN INS(5) C 4 SYMTYP(1) SYMTYP(2) C 0 = RELATIVE 0 = ABSOLUTE C 1 = RELATIVE 1 = RELATIVE C 5 FORWARD REFERENCE? ... C 0 = BACKWARDS ... C 1 = FORWARD ... C 6 A0-D7 BIT MASK D0-A7 BIT MASK C 7 CURRENT IPC MODE ... C 0 = ABSOLUTE 0 = 2 BYTE ADDRESSING C 1 = RELATIVE 1 = 3 BYTE ADDRESSING: > 65535 C C LENSYM - LENGTH OF SYMBOL TABLE, EQUALS NUMBER OF C DIMENSIONS OF 'ISYM'. C C KASH - HASH TABLE FOR SYMBOL LOOKUP. C C KCLAS - TOKEN CLASS. C C NET1 -> NET5 - PARSENET TABLE. C C NBPW - NUMBER OF BYTES IN HOST COMPUTER'S WORD. C C IEOT - END OF LINE = 4. C C LSP - ASCII BLANK RIGHT JUSTIFIED. C C IHB480 - HEX CONSTANT SET IN 'COMDEP' C C IHEX9K - HEX CONSTANT SET IN 'COMDEP' C C IA1SHF - SHIFT CONSTANT SET IN 'COMDEP' C C KCFF - HEX CONSTANT $FF SET IN 'COMDEP' C C LIST - LIST, NOLIST OPTION FLAG. C 1 = LIST ASSEMBLY (DEFAULT) C 0 = DON'T LIST ASSEMBLY C C IOBJ - OBJECT OUTPUT, NO OBJECT OUTPUT FLAG C 1 = OBJECT OUTPUT REQUESTED - DEFAULT C 0 = NO OBJECT OUTPUT REQUESTED C C IPLEN - NUMBER OF LINES PER PAGE C INITIALIZED TO 65 C C LLEN - NUMBER CHARACTERS PER LINE C DEFAULT = 80 C MIN = 26 C MAX = 120 C MAX NUMBER CHARACTERS INPUT ON SOURCE LINE = 95 C C LLENSW - FLAG INDICATING COMMAND 'LLEN' HAS BEEN USED. C 1 = 'LLEN' IN EFFECT, ADJUST OUTPUT LINE TO C PARTICULAR COLUMN C 0 = DEFAULT = 'LLEN' NOT IN EFFECT. C NOTE: A SOURCE LINE IS NOT COLUMN ADJUSTED ON C OUTPUT UNLESS 'LLEN' IS USED. C C ICOL - USED TO FLAG IFXX IN PROCESS, AND MACRO FLAG. C C NEST - IFXX-ENDC NEST COUNT. C C 2.3 MODIFYING SYMBOL TABLE SIZE. C C CHANGE EACH OCCURRANCE OF ISYM(N) IN COMMON /A/ FROM ITS C CURRENT VALUE TO DESIRED VALUE. CHANGE VARIABLE 'LENSYM' C IN BLOCK DATA TO EQUAL VALUE OF 'N' IN COMMON /A/ ISYM(N). C C 2.4 ERROR MESSAGES C C ERROR # DESCRIPTION C ------- ---------- C 0201 ILLEGAL CHARACTER C 0202 SYMBOL TOO LONG C 0203 IMPROPER TERMINATION OF OPERAND FIELD C 0204 SYNTAX ERROR C 0205 SIZE SUBFIELD NOT ALLOWED FOR THIS OPCODE C 0206 REDEFINED SYMBOL C 0207 UNDEFINED SYMBOL C 0208 DISPLACEMENT RANGE (SIZE) ERROR C 0209 ILLEGAL ADDRESS MODE FOR THIS INSTRUCTION C 0210 VALUE TOO LARGE C 0211 UNDEFINED SYMBOL C 0212 DATA SIZE IS INVALID C 0213 REGISTER MUST BE ADDRESS REGISTER C 0214 INVALID SIZE SPECIFIED FOR INDEX REGISTER (MUST BE .L) C 0215 REGISTER MUST BE DATA REGISTER C 0216 NEGATIVE NOT ALLOWED C 0217 BYTE MODE NOT ALLOWED C 0218 DESTINATION MUST BE ALTERABLE C 0219 TOO MANY OPERANDS FOR THIS INSTRUCTION C 0220 PHASING ERROR BETWEEN PASS ONE AND PASS TWO. C 0221 SYMBOL TABLE OVERFLOW C 0222 INTERNAL ERROR - PARSE STACK OVERFLOW C 0223 INTERNAL ERROR - UNDEFINED ACTION C 0224 ILLEGAL MACRO PARAMETER C 0225 MISPLACED 'MACRO' OR 'ENDM' C 0226 MACRO CALLS NESTED TOO DEEP C 0227 MULTIPLE REGISTERS ALLOWED ONLY FOR MOVEM(LDM,STM) C 0228 INTERNAL ERROR - SYMBOL LOST C 0229 LABEL REQUIRED ON THIS STATEMENT C 0230 INSTRUCTION ADDRESS HAS FALLEN ON AN ODD BOUNDARY C 0231 SYMBOL/EXPRESSION MUST BE ABSOLUTE C 0232 AND/OR/EOR TO CCR OR SR MUST HAVE IMMEDIATE SOURCE C 0233 ILLEGAL REGISTER FOR THIS INSTRUCTION C 0234 INVALID SYNTAX FOR THIS INSTRUCTION C 0235 FORWARD REFERENCED ADDRESS CANNOT BE LONG ABSOLUTE MODE C 0236 MEMORY SHIFTS MAY ONLY BE SINGLE BIT C 0237 ILLEGAL OPERATION ON A RELATIVE SYMBOL C 0238 INVALID BYTE SIZE FOR THIS INSTRUCTION C 0239 'END' DOES NOT TERMINATE SOURCE PROGRAM AS IT SHOULD C 0240 ILLEGAL FORWARD REFERENCE C C 3.0 INSTALLATION OF THE M68000 CROSS ASSEMBLER ON A PDP-11 SYSTEM C TYPE SYSTEM. C C THE CROSS ASSEMBLER COMES ON A TAPE IN ONE FILE. C EACH SUBPROGRAM MUST BE SEPARATED FROM THIS FILE AND COMPILED C SEPARATELY IN ORDER TO LINK THE ENTIRE PROGRAM INTO A LOAD MODULE. C ALL BUT 4 SUBPROGRAMS ARE WRITTEN IN FORTRAN. ALL PROGRAMS MUST BE C COMPILED WITH THE /ON AND /SU FORTRAN OPTIONS TO GET THE LOAD C MODULE SMALL ENOUGH TO FIT IN 28K OF MEMORY ON A DOS SYSTEM. C USE /NOVA/NOSN ON AN RSX-M SYSTEM. C IT SHOULD BE POSSIBLE TO OVERLAY THIS PROGRAM TO C GET MORE MEMORY AVAILABLE FOR SYMBOL TABLE SPACE. ALL ROUTINES C EXCEPT 'ACT1', 'BUILD1', 'ACT2', 'BUILD2', AND 'PRSYM' MUST C BE IN MEMORY, OR MUST BE IN THE MAIN OVERLAY. ACT1 CALLS C BUILD1 AND BOTH ARE USED IN PASS 1 ONLY. THEREFORE THESE TWO C SUBPROGRAMS CAN BE CONCATENATED AS ONE OVERLAY. ACT2, BUILD2 DO C NOT CALL EACH OTHER AND MAY EACH BE THE SAME LEVEL OVERLAY C AS ACT1 SINCE THEY ARE USED ONLY IN PASS 2 . PRSYM PRINTS OUT THE C SYMBOL TABLE WHEN PASS 2 IS DONE SO IT CAN BE AT THE SAME C LEVEL AS ACT1, ACT2, AND BUILD2. C SEVERAL PAGES OF NOTES ON ASSEMBLER CONSTRUCTION, VARIABLE C NAMES, COMMON, AND A DESCRIPTION OF THE VARIABLE NAMES IS C INCLUDED. THIS IS FOR INFORMATION ONLY AND IS NOT PART OF THE C OVERALL SOURCE PROGRAM. C C THE MAIN PROGRAM IS 'MACS'. SEVERAL SUBPROGRAMS FOLLOW 'MACS' C ALL IN FORTRAN. FOUR MORE IN ASSEMBLY FOLLOW. C THE ASSEMBLY LANGUAGE PROGRAMS ARE: ADD,MUL,SUB,DIV. C C PART OF THE INFORMATION ON THE TAPE IS AN M68000 C INSTRUCTION SET TEST PROGRAM. INSTRUCTIONS C ON THE TEST PROGRAM ARE CONTAINED IN THE FIRST PART OF THE C PROGRAM. OUTPUT OF THE TEST PROGRAM IS ALSO INCLUDED SO C AN INSTRUCTION BY INSTRUCTION CHECK CAN BE MADE BETWEEN C MOTOROLA'S TEST RUN AND THE ONE BEING BROUGHT UP. C THESE TWO PROGRAMS MUST BE SEPARATED FROM THE SOURCE C PROGRAM BEFORE COMPILING AND ASSEMBLING. C C ONCE THE LOAD MODULE IS UP AND RUNNING, IT CAN C BE EXECUTED FROM THE CONSOLE OR BATCH. SIMPLY ASSIGN THE I/O DEVICES C IN EITHER CASE AND LET IT GO. C I/O DEVICE ASSIGNMENTS FOR DOS ARE AS FOLLOWS: C $AS SI,2 ASSIGN INPUT SOURCE FILE TO 2. C $AS OBJ,1 ASSIGN OUTPUT OBJECT TO FILE 1. ELIMINATE C THIS ASSIGNMENT IF USING 'NOOBJ'.5 C $RUN MACS 'MACS' IS THE LOAD MODULE NAME IN THIS EXAMPLE4 C CREATED FROM ALL THE XASM SOURCE PROGRAMS. C C RSX-M SYSTEM. C ROUTINE 'FILEOP' HAS 'CALL ASSIGN' IN IT FOR THE RSX=M SYSTEM. C THIS ROUTINE MUST BE CHANGED IF THE USER DOES NOT WANT C TO USE THIS METHOD OF ACCESSING FILES. 'FILEOP' ALSO C REQUESTS THE FILENAME FOR THE OUTPUT LISTING. IF SPOOLING C ALLOWS DIRECT OUTPUT TO THE LINE PRINTER THIS MUST BE C CHANGED ACCORDINGLY. THE 'CALL FILEOP(6)' IN 'MACS' C MUST ALSO BE DELETED, UNLESS THE COMPLETE CHANGE IS MADE C IN 'FILEOP'. THE REQUEST FOR PRINTING PASS 1 IN 'MACS' C MAY ALSO BE REMOVED IF DESIRED. THIS IS A DEBUGGING C AID. C NAMES FOR ALL FILES ARE REQUESTED FROM 'FILEOP'. C C C C C *** END OF THIS ARTICLE *** C C C C C+ NAM: MACS VER: 1.0 DAT: DEC 8, 1978 CMP: PDP-11 C C SYS: MACS C C FNC: THIS IS THE MAIN PROGRAM FOR THE M68000 CROSS ASSEMBLER. C IT INITIALIZES SEVERAL VARIABLES, AND C CALLS ROUTINES FOR PASS1 AND PASS 2. C C ****************************************************** C *** *** C *** COPYRIGHT 1978 BY MOTOROLA INC *** C *** *** C ****************************************************** C C *********************************************************** C *** *** C *** THIS IS A PRELIMINARY RELEASE OF THE MC68000 *** C *** CROSS ASSEMBLER. AS SUCH IT IS POSSIBLE THE *** C *** INSTRUCTION SET FOR THE MC68000 MAY CHANGE *** C *** CAUSING CHANGES IN THIS CROSS ASSEMBLER. *** C *** MOTOROLA RESERVES THE RIGHT TO MAKE CHANGES *** C *** WITHOUT NOTICE. *** C *** *** C *********************************************************** C C REV: N/A C CALLS COMDEP-FILEOP-PNCH-ERR-PRSYM-PAGE C C* IMPLICIT INTEGER (A-Z) COMMON /A/ ISYM(3000),KARD1(96),ITOKEN(70),TKNSIZ,TKNTYP, & TKNVAL,TKNVA2,JSUC,JPTR,LPTR,NXSYM,KOLUMN,KD1BCT,KD1LNO,JERR, & MNUM,IPASS,IPC2,IPC,IOPC,INS(5),INSL,ISIZ,IADM(7,2),LUOT COMMON /A/ KASH(64),KPAC(15),KPWCT,LENSYM,KCLAS(64) COMMON /A/ NET1(64),NET2(64),NET3(64),NET4(64),NET5(64) COMMON /A/ NBPW,KSYS,IEOT,LSP,JBUF(83),KARD2(80,3),IHB480,IHEX9K COMMON /A/ IA1SHF,KCFF,LUSI,LUDI,LUOO,LLEN,IPLEN COMMON /A/ LIST,ICOL,NEST,LUCI,LULT,MFLD(11,3),IOBJ,LLENSW,NOP COMMON /A/ NXSYM1 DIMENSION KCLAS2(64) DATA KCLAS2/8,9,9,9,3,9,9,5,9,9,9,9,9,9,9,9, & 7,7,7,7,7,7,7,7,7,7,9,9,9,9,9,9, & 6,4,4,4,4,4,4,6,6,6,6,6,6,6,6,6, & 6,6,6,6,6,6,6,6,6,6,6,9,2,9,2,9/ DATA IYES/'Y'/ C C*** INITIALIZE VARIABLES, IO DEVICES CALL COMDEP 9960 FORMAT(' PRINT PASS 1? (Y/N)'/) 9961 FORMAT(A1) WRITE(LULT,9960) READ(LUCI,9961) JJJ IF(JJJ.EQ.IYES) CALL DEBUG(1) C C+++ THIS FILE OUTPUT OF SOURCE IS TO GET AROUND C+++ THE SPOOLING TO PRINTER ON THE SYSTEM. C+++ REMOVE THE 'CALL FILEOP(6)' TO GO DIRECTLY TO PRINTER C C+++ ALSO REMOVE TEST AT END OF THIS PROGRAM FOR CLOSING FILE 3 CALL FILEOP(6) C C+++ END C DO 40 I=1,11 DO 40 J=1,3 40 MFLD(I,J)=0 C*** SET UP COMMON /A/ARRAY 'KCLAS' DO 70 I=1,64 70 KCLAS(I)=KCLAS2(I) C*** PAGE SWITCH DEFAULT ON NOP=1 C*** FLAG NOT TO PRINT EXPANDED LITERALS LUDI=0 C*** IOBJ=1=OBJECT OUT - IOBJ=0=NO OBJECT OUT IOBJ=1 C C*** LIST=0 NOLIST - LIST=1 LIST(DEFAULT). LIST= 1 C*** SET DEFAULT LINE LENGTH LLEN=80 C*** SET DO NOT ADJUST OUTPUT LINE SWITCH LLENSW=0 C*** SET DEFAULT PAGE COUNT TO 65 LINES/PAGE IPLEN=65 ICOL=0 NEST=0 MNUM=0 C*** ASCII BLANK, RIGHT JUSTIFIED, ZERO FILLED. LSP=32 C*** LEAVE SYMBOL TABLE SIZE LESS THAN MAX IN ORDER TO HANDLE C*** SYMBOL TABLE OVERFLOW. LENSYM=2990 IEOT=4 JERR=0 IPC2=0 IPC=0 IADM(7,2)=0 IADM(7,1)=1 C*** INIT MACRO @000 VALUE KARD2(1,1)=64 KARD2(2,1)=48 KARD2(3,1)=48 KARD2(4,1)=48 KARD2(5,1)=0 C*** PRINT THIS HEADER TO CONSOLE CALL PAGE(81) C*** OUTPUT HEADER CALL PAGE(82) C C C*** GET SI FN OPENED C CALL FILEOP(1) C C*** PERFORM PASS ONE C 750 CONTINUE IPASS=-1 C*** SAVE FOR SYMBOL TABLE PRINT OUT. 900 NXSYM1=NXSYM 1000 CALL PAR IF(IPASS.LT.0) GO TO 1000 C C*** PERFORM PASS TWO C C*** IS OBJECT OUTPUT DESIRED? IF(IOBJ.EQ.0) GO TO 1100 C*** OPEN OBJ FILE CALL FILEOP(5) CALL PNCH(1,IPC) CALL PNCH(3,IPC) 1100 CONTINUE C C*** IN CASE IFXX - ENDC NOT EQUAL RESET C NEST=0 C C C*** RESET MACRO @ COUNTER KARD2(1,1)=64 KARD2(2,1)=48 KARD2(3,1)=48 KARD2(4,1)=48 KARD2(5,1)=0 C 2000 CALL PAR IF(IPASS.EQ.0) GO TO 2000 C*** END OF PASS 2 C*** PRINT FINAL ERROR COUNT CALL ERR(-1) C*** PRINT SYMBOL TABLE CALL PRSYM C*** PUT OUT TRAILING RECORD IF OBJECT OUT REQ. IF(IOBJ.EQ.0) GO TO 3000 CALL PNCH(2,IPC) C*** CLOSE OBJECT OUTPUT FILE 2900 CALL FILEOP(4) C C+++ IF LIST IS TO FILE, CLOSE IT C 3000 CONTINUE IF(LUOT.EQ.3) CALL CLOSE(3) END BLOCK DATA C C* IMPLICIT INTEGER (A-Z) COMMON /A/ ISYM(3000),KARD1(96),ITOKEN(70),TKNSIZ,TKNTYP, & TKNVAL,TKNVA2,JSUC,JPTR,LPTR,NXSYM,KOLUMN,KD1BCT,KD1LNO,JERR, & MNUM,IPASS,IPC2,IPC,IOPC,INS(5),INSL,ISIZ,IADM(7,2),LUOT COMMON /A/ KASH(64),KPAC(15),KPWCT,LENSYM,KCLAS(64) COMMON /A/ NET1(64),NET2(64),NET3(64),NET4(64),NET5(64) COMMON /A/ NBPW,KSYS,IEOT,LSP,JBUF(83),KARD2(80,3),IHB480,IHEX9K COMMON /A/ IA1SHF,KCFF,LUSI,LUDI,LUOO,LLEN,IPLEN COMMON /A/ LIST,ICOL,NEST C C*** THE C>>> MUST NOT BE MOVED, PARNET USES IT C>>> DATA NXSYM/1171/ DATA ISYM( 1)/O 0/,ISYM( 2)/O 1777/,ISYM( 3)/O 141/ DATA ISYM( 4)/O 46501/,ISYM( 5)/O 41522/,ISYM( 6)/O 47400/ DATA ISYM( 7)/O177777/,ISYM( 8)/O 0/,ISYM( 9)/O 0/ DATA ISYM( 10)/O 1377/,ISYM( 11)/O 661/,ISYM( 12)/O 42516/ DATA ISYM( 13)/O 42115/,ISYM( 14)/O177777/,ISYM( 15)/O 1/ DATA ISYM( 16)/O 0/,ISYM( 17)/O 1777/,ISYM( 18)/O 150/ DATA ISYM( 19)/O 46505/,ISYM( 20)/O 54111/,ISYM( 21)/O 52000/ DATA ISYM( 22)/O177777/,ISYM( 23)/O 2/,ISYM( 24)/O 0/ DATA ISYM( 25)/O 1377/,ISYM( 26)/O 275/,ISYM( 27)/O 42516/ DATA ISYM( 28)/O 42000/,ISYM( 29)/O 1/,ISYM( 30)/O 1/ DATA ISYM( 31)/O 0/,ISYM( 32)/O 1377/,ISYM( 33)/O 402/ DATA ISYM( 34)/O 42516/,ISYM( 35)/O 42103/,ISYM( 36)/O 1/ DATA ISYM( 37)/O 2/,ISYM( 38)/O 0/,ISYM( 39)/O 1377/ DATA ISYM( 40)/O 616/,ISYM( 41)/O 50101/,ISYM( 42)/O 43505/ DATA ISYM( 43)/O 1/,ISYM( 44)/O 3/,ISYM( 45)/O 0/ DATA ISYM( 46)/O 1377/,ISYM( 47)/O 742/,ISYM( 48)/O 46111/ DATA ISYM( 49)/O 51524/,ISYM( 50)/O 1/,ISYM( 51)/O 4/ DATA ISYM( 52)/O 0/,ISYM( 53)/O 1777/,ISYM( 54)/O 677/ DATA ISYM( 55)/O 47117/,ISYM( 56)/O 46111/,ISYM( 57)/O 51524/ DATA ISYM( 58)/O 1/,ISYM( 59)/O 5/,ISYM( 60)/O 0/ DATA ISYM( 61)/O 1377/,ISYM( 62)/O 706/,ISYM( 63)/O 47117/ DATA ISYM( 64)/O 46000/,ISYM( 65)/O 1/,ISYM( 66)/O 5/ DATA ISYM( 67)/O 0/,ISYM( 68)/O 1377/,ISYM( 69)/O 1756/ DATA ISYM( 70)/O 52124/,ISYM( 71)/O 46000/,ISYM( 72)/O 1/ DATA ISYM( 73)/O 6/,ISYM( 74)/O 0/,ISYM( 75)/O 1777/ DATA ISYM( 76)/O 303/,ISYM( 77)/O 47117/,ISYM( 78)/O 50101/ DATA ISYM( 79)/O 43505/,ISYM( 80)/O 1/,ISYM( 81)/O 7/ DATA ISYM( 82)/O 0/,ISYM( 83)/O 1777/,ISYM( 84)/O 175/ DATA ISYM( 85)/O 47117/,ISYM( 86)/O 47502/,ISYM( 87)/O 45000/ DATA ISYM( 88)/O 1/,ISYM( 89)/O 10/,ISYM( 90)/O 0/ DATA ISYM( 91)/O 1377/,ISYM( 92)/O 266/,ISYM( 93)/O 41515/ DATA ISYM( 94)/O 50114/,ISYM( 95)/O 1/,ISYM( 96)/O 11/ DATA ISYM( 97)/O 0/,ISYM( 98)/O 1377/,ISYM( 99)/O 634/ DATA ISYM( 100)/O 41515/,ISYM( 101)/O 50122/,ISYM( 102)/O 1/ DATA ISYM( 103)/O 12/,ISYM( 104)/O 0/,ISYM( 105)/O 777/ DATA ISYM( 106)/O 242/,ISYM( 107)/O 43400/,ISYM( 108)/O 1/ DATA ISYM( 109)/O 13/,ISYM( 110)/O 0/,ISYM( 111)/O 1777/ DATA ISYM( 112)/O 562/,ISYM( 113)/O 46501/,ISYM( 114)/O 51513/ DATA ISYM( 115)/O 31000/,ISYM( 116)/O 1/,ISYM( 117)/O 14/ DATA ISYM( 118)/O 0/,ISYM( 119)/O 1377/,ISYM( 120)/O 257/ DATA ISYM( 121)/O 51124/,ISYM( 122)/O 42400/,ISYM( 123)/O 2/ DATA ISYM( 124)/O 47163/,ISYM( 125)/O 0/,ISYM( 126)/O 1377/ DATA ISYM( 127)/O 1104/,ISYM( 128)/O 51124/,ISYM( 129)/O 51000/ DATA ISYM( 130)/O 2/,ISYM( 131)/O 47167/,ISYM( 132)/O 0/ DATA ISYM( 133)/O 1377/,ISYM( 134)/O 2067/,ISYM( 135)/O 51124/ DATA ISYM( 136)/O 51400/,ISYM( 137)/O 2/,ISYM( 138)/O 47165/ DATA ISYM( 139)/O 0/,ISYM( 140)/O 1777/,ISYM( 141)/O 1066/ DATA ISYM( 142)/O 51105/,ISYM( 143)/O 51505/,ISYM( 144)/O 52000/ DATA ISYM( 145)/O 2/,ISYM( 146)/O 47160/,ISYM( 147)/O 0/ DATA ISYM( 148)/O 1777/,ISYM( 149)/O 0/,ISYM( 150)/O 52122/ DATA ISYM( 151)/O 40520/,ISYM( 152)/O 53000/,ISYM( 153)/O 2/ DATA ISYM( 154)/O 47166/,ISYM( 155)/O 0/,ISYM( 156)/O 1377/ DATA ISYM( 157)/O 1326/,ISYM( 158)/O 47117/,ISYM( 159)/O 50000/ DATA ISYM( 160)/O 2/,ISYM( 161)/O 47161/,ISYM( 162)/O 0/ DATA ISYM( 163)/O 777/,ISYM( 164)/O 1371/,ISYM( 165)/O 42103/ DATA ISYM( 166)/O 4/,ISYM( 167)/O 0/,ISYM( 168)/O 0/ DATA ISYM( 169)/O 1377/,ISYM( 170)/O 652/,ISYM( 171)/O 47522/ DATA ISYM( 172)/O 43400/,ISYM( 173)/O 5/,ISYM( 174)/O 1/ DATA ISYM( 175)/O 0/,ISYM( 176)/O 1377/,ISYM( 177)/O 553/ DATA ISYM( 178)/O 42521/,ISYM( 179)/O 52400/,ISYM( 180)/O 5/ DATA ISYM( 181)/O 2/,ISYM( 182)/O 0/,ISYM( 183)/O 1377/ DATA ISYM( 184)/O 733/,ISYM( 185)/O 51505/,ISYM( 186)/O 52000/ DATA ISYM( 187)/O 5/,ISYM( 188)/O 3/,ISYM( 189)/O 0/ DATA ISYM( 190)/O 777/,ISYM( 191)/O 420/,ISYM( 192)/O 42123/ DATA ISYM( 193)/O 5/,ISYM( 194)/O 4/,ISYM( 195)/O 0/ DATA ISYM( 196)/O 1377/,ISYM( 197)/O 337/,ISYM( 198)/O 51117/ DATA ISYM( 199)/O 51107/,ISYM( 200)/O 5/,ISYM( 201)/O 5/ DATA ISYM( 202)/O 0/,ISYM( 203)/O 1377/,ISYM( 204)/O 1221/ DATA ISYM( 205)/O 43101/,ISYM( 206)/O 44514/,ISYM( 207)/O 5/ DATA ISYM( 208)/O 6/,ISYM( 209)/O 0/,ISYM( 210)/O 1377/ DATA ISYM( 211)/O 715/,ISYM( 212)/O 51520/,ISYM( 213)/O 41400/ DATA ISYM( 214)/O 5/,ISYM( 215)/O 7/,ISYM( 216)/O 0/ DATA ISYM( 217)/O 1377/,ISYM( 218)/O 1005/,ISYM( 219)/O 46111/ DATA ISYM( 220)/O 47113/,ISYM( 221)/O 6/,ISYM( 222)/O 47120/ DATA ISYM( 223)/O 0/,ISYM( 224)/O 1377/,ISYM( 225)/O 1670/ DATA ISYM( 226)/O 52516/,ISYM( 227)/O 46113/,ISYM( 228)/O 6/ DATA ISYM( 229)/O 47130/,ISYM( 230)/O 0/,ISYM( 231)/O 1377/ DATA ISYM( 232)/O 364/,ISYM( 233)/O 51527/,ISYM( 234)/O 40520/ DATA ISYM( 235)/O 7/,ISYM( 236)/O 44100/,ISYM( 237)/O 0/ DATA ISYM( 238)/O 1377/,ISYM( 239)/O 1720/,ISYM( 240)/O 52122/ DATA ISYM( 241)/O 40520/,ISYM( 242)/O 10/,ISYM( 243)/O 47100/ DATA ISYM( 244)/O 0/,ISYM( 245)/O 1377/,ISYM( 246)/O 1174/ DATA ISYM( 247)/O 52123/,ISYM( 248)/O 52000/,ISYM( 249)/O 11/ DATA ISYM( 250)/O 45000/,ISYM( 251)/O 0/,ISYM( 252)/O 1377/ DATA ISYM( 253)/O 501/,ISYM( 254)/O 41514/,ISYM( 255)/O 51000/ DATA ISYM( 256)/O 11/,ISYM( 257)/O 41000/,ISYM( 258)/O 0/ DATA ISYM( 259)/O 1377/,ISYM( 260)/O 1147/,ISYM( 261)/O 47105/ DATA ISYM( 262)/O 43400/,ISYM( 263)/O 11/,ISYM( 264)/O 42000/ DATA ISYM( 265)/O 0/,ISYM( 266)/O 1377/,ISYM( 267)/O 643/ DATA ISYM( 268)/O 47117/,ISYM( 269)/O 52000/,ISYM( 270)/O 11/ DATA ISYM( 271)/O 43000/,ISYM( 272)/O 0/,ISYM( 273)/O 1377/ DATA ISYM( 274)/O 1417/,ISYM( 275)/O 47102/,ISYM( 276)/O 41504/ DATA ISYM( 277)/O 12/,ISYM( 278)/O 44000/,ISYM( 279)/O 0/ DATA ISYM( 280)/O 1377/,ISYM( 281)/O 1317/,ISYM( 282)/O 50105/ DATA ISYM( 283)/O 40400/,ISYM( 284)/O 13/,ISYM( 285)/O 44100/ DATA ISYM( 286)/O 0/,ISYM( 287)/O 1377/,ISYM( 288)/O 751/ DATA ISYM( 289)/O 45123/,ISYM( 290)/O 51000/,ISYM( 291)/O 14/ DATA ISYM( 292)/O 47200/,ISYM( 293)/O 0/,ISYM( 294)/O 1377/ DATA ISYM( 295)/O 463/,ISYM( 296)/O 45115/,ISYM( 297)/O 50000/ DATA ISYM( 298)/O 14/,ISYM( 299)/O 47300/,ISYM( 300)/O 0/ DATA ISYM( 301)/O 1377/,ISYM( 302)/O 526/,ISYM( 303)/O 41122/ DATA ISYM( 304)/O 40400/,ISYM( 305)/O 15/,ISYM( 306)/O 60000/ DATA ISYM( 307)/O 0/,ISYM( 308)/O 1377/,ISYM( 309)/O 0/ DATA ISYM( 310)/O 41123/,ISYM( 311)/O 51000/,ISYM( 312)/O 15/ DATA ISYM( 313)/O 60400/,ISYM( 314)/O 0/,ISYM( 315)/O 1377/ DATA ISYM( 316)/O 625/,ISYM( 317)/O 41110/,ISYM( 318)/O 44400/ DATA ISYM( 319)/O 15/,ISYM( 320)/O 61000/,ISYM( 321)/O 0/ DATA ISYM( 322)/O 1377/,ISYM( 323)/O 1237/,ISYM( 324)/O 41114/ DATA ISYM( 325)/O 51400/,ISYM( 326)/O 15/,ISYM( 327)/O 61400/ DATA ISYM( 328)/O 0/,ISYM( 329)/O 1377/,ISYM( 330)/O 1737/ DATA ISYM( 331)/O 41103/,ISYM( 332)/O 41400/,ISYM( 333)/O 15/ DATA ISYM( 334)/O 62000/,ISYM( 335)/O 0/,ISYM( 336)/O 1377/ DATA ISYM( 337)/O 535/,ISYM( 338)/O 41103/,ISYM( 339)/O 51400/ DATA ISYM( 340)/O 15/,ISYM( 341)/O 62400/,ISYM( 342)/O 0/ DATA ISYM( 343)/O 1377/,ISYM( 344)/O 0/,ISYM( 345)/O 41116/ DATA ISYM( 346)/O 42400/,ISYM( 347)/O 15/,ISYM( 348)/O 63000/ DATA ISYM( 349)/O 0/,ISYM( 350)/O 1377/,ISYM( 351)/O 571/ DATA ISYM( 352)/O 41105/,ISYM( 353)/O 50400/,ISYM( 354)/O 15/ DATA ISYM( 355)/O 63400/,ISYM( 356)/O 0/,ISYM( 357)/O 1377/ DATA ISYM( 358)/O 0/,ISYM( 359)/O 41126/,ISYM( 360)/O 41400/ DATA ISYM( 361)/O 15/,ISYM( 362)/O 64000/,ISYM( 363)/O 0/ DATA ISYM( 364)/O 1377/,ISYM( 365)/O 1041/,ISYM( 366)/O 41126/ DATA ISYM( 367)/O 51400/,ISYM( 368)/O 15/,ISYM( 369)/O 64400/ DATA ISYM( 370)/O 0/,ISYM( 371)/O 1377/,ISYM( 372)/O 0/ DATA ISYM( 373)/O 41120/,ISYM( 374)/O 46000/,ISYM( 375)/O 15/ DATA ISYM( 376)/O 65000/,ISYM( 377)/O 0/,ISYM( 378)/O 1377/ DATA ISYM( 379)/O 2206/,ISYM( 380)/O 41115/,ISYM( 381)/O 44400/ DATA ISYM( 382)/O 15/,ISYM( 383)/O 65400/,ISYM( 384)/O 0/ DATA ISYM( 385)/O 1377/,ISYM( 386)/O 0/,ISYM( 387)/O 41107/ DATA ISYM( 388)/O 42400/,ISYM( 389)/O 15/,ISYM( 390)/O 66000/ DATA ISYM( 391)/O 0/,ISYM( 392)/O 1377/,ISYM( 393)/O 1032/ DATA ISYM( 394)/O 41114/,ISYM( 395)/O 52000/,ISYM( 396)/O 15/ DATA ISYM( 397)/O 66400/,ISYM( 398)/O 0/,ISYM( 399)/O 1377/ DATA ISYM( 400)/O 1747/,ISYM( 401)/O 41107/,ISYM( 402)/O 52000/ DATA ISYM( 403)/O 15/,ISYM( 404)/O 67000/,ISYM( 405)/O 0/ DATA ISYM( 406)/O 1377/,ISYM( 407)/O 1212/,ISYM( 408)/O 41114/ DATA ISYM( 409)/O 42400/,ISYM( 410)/O 15/,ISYM( 411)/O 67400/ DATA ISYM( 412)/O 0/,ISYM( 413)/O 1377/,ISYM( 414)/O 670/ DATA ISYM( 415)/O 47105/,ISYM( 416)/O 43530/,ISYM( 417)/O 16/ DATA ISYM( 418)/O 40000/,ISYM( 419)/O 0/,ISYM( 420)/O 1377/ DATA ISYM( 421)/O 1615/,ISYM( 422)/O 42530/,ISYM( 423)/O 52000/ DATA ISYM( 424)/O 17/,ISYM( 425)/O 44200/,ISYM( 426)/O 0/ DATA ISYM( 427)/O 1377/,ISYM( 428)/O 0/,ISYM( 429)/O 52101/ DATA ISYM( 430)/O 51400/,ISYM( 431)/O 20/,ISYM( 432)/O 45300/ DATA ISYM( 433)/O 0/,ISYM( 434)/O 1377/,ISYM( 435)/O 1014/ DATA ISYM( 436)/O 51510/,ISYM( 437)/O 44400/,ISYM( 438)/O 21/ DATA ISYM( 439)/O 51300/,ISYM( 440)/O 0/,ISYM( 441)/O 1377/ DATA ISYM( 442)/O 2117/,ISYM( 443)/O 51514/,ISYM( 444)/O 51400/ DATA ISYM( 445)/O 21/,ISYM( 446)/O 51700/,ISYM( 447)/O 0/ DATA ISYM( 448)/O 1377/,ISYM( 449)/O 1401/,ISYM( 450)/O 51503/ DATA ISYM( 451)/O 41400/,ISYM( 452)/O 21/,ISYM( 453)/O 52300/ DATA ISYM( 454)/O 0/,ISYM( 455)/O 1377/,ISYM( 456)/O 724/ DATA ISYM( 457)/O 51503/,ISYM( 458)/O 51400/,ISYM( 459)/O 21/ DATA ISYM( 460)/O 52700/,ISYM( 461)/O 0/,ISYM( 462)/O 1377/ DATA ISYM( 463)/O 1245/,ISYM( 464)/O 51516/,ISYM( 465)/O 42400/ DATA ISYM( 466)/O 21/,ISYM( 467)/O 53300/,ISYM( 468)/O 0/ DATA ISYM( 469)/O 1377/,ISYM( 470)/O 760/,ISYM( 471)/O 51505/ DATA ISYM( 472)/O 50400/,ISYM( 473)/O 21/,ISYM( 474)/O 53700/ DATA ISYM( 475)/O 0/,ISYM( 476)/O 1377/,ISYM( 477)/O 0/ DATA ISYM( 478)/O 51526/,ISYM( 479)/O 41400/,ISYM( 480)/O 21/ DATA ISYM( 481)/O 54300/,ISYM( 482)/O 0/,ISYM( 483)/O 1377/ DATA ISYM( 484)/O 0/,ISYM( 485)/O 51526/,ISYM( 486)/O 51400/ DATA ISYM( 487)/O 21/,ISYM( 488)/O 54700/,ISYM( 489)/O 0/ DATA ISYM( 490)/O 1377/,ISYM( 491)/O 1050/,ISYM( 492)/O 51520/ DATA ISYM( 493)/O 46000/,ISYM( 494)/O 21/,ISYM( 495)/O 55300/ DATA ISYM( 496)/O 0/,ISYM( 497)/O 1377/,ISYM( 498)/O 1301/ DATA ISYM( 499)/O 51515/,ISYM( 500)/O 44400/,ISYM( 501)/O 21/ DATA ISYM( 502)/O 55700/,ISYM( 503)/O 0/,ISYM( 504)/O 1377/ DATA ISYM( 505)/O 1471/,ISYM( 506)/O 51507/,ISYM( 507)/O 42400/ DATA ISYM( 508)/O 21/,ISYM( 509)/O 56300/,ISYM( 510)/O 0/ DATA ISYM( 511)/O 1377/,ISYM( 512)/O 1156/,ISYM( 513)/O 51514/ DATA ISYM( 514)/O 52000/,ISYM( 515)/O 21/,ISYM( 516)/O 56700/ DATA ISYM( 517)/O 0/,ISYM( 518)/O 1377/,ISYM( 519)/O 1642/ DATA ISYM( 520)/O 51507/,ISYM( 521)/O 52000/,ISYM( 522)/O 21/ DATA ISYM( 523)/O 57300/,ISYM( 524)/O 0/,ISYM( 525)/O 1377/ DATA ISYM( 526)/O 1310/,ISYM( 527)/O 51514/,ISYM( 528)/O 42400/ DATA ISYM( 529)/O 21/,ISYM( 530)/O 57700/,ISYM( 531)/O 0/ DATA ISYM( 532)/O 1377/,ISYM( 533)/O 1426/,ISYM( 534)/O 44506/ DATA ISYM( 535)/O 42521/,ISYM( 536)/O 22/,ISYM( 537)/O 1/ DATA ISYM( 538)/O 0/,ISYM( 539)/O 1377/,ISYM( 540)/O 1507/ DATA ISYM( 541)/O 44506/,ISYM( 542)/O 47105/,ISYM( 543)/O 22/ DATA ISYM( 544)/O 2/,ISYM( 545)/O 0/,ISYM( 546)/O 1377/ DATA ISYM( 547)/O 1165/,ISYM( 548)/O 46114/,ISYM( 549)/O 42516/ DATA ISYM( 550)/O 23/,ISYM( 551)/O 1/,ISYM( 552)/O 0/ DATA ISYM( 553)/O 1377/,ISYM( 554)/O 1254/,ISYM( 555)/O 50114/ DATA ISYM( 556)/O 42516/,ISYM( 557)/O 23/,ISYM( 558)/O 2/ DATA ISYM( 559)/O 0/,ISYM( 560)/O 1377/,ISYM( 561)/O 0/ DATA ISYM( 562)/O 51524/,ISYM( 563)/O 47520/,ISYM( 564)/O 23/ DATA ISYM( 565)/O 47162/,ISYM( 566)/O 0/,ISYM( 567)/O 1377/ DATA ISYM( 568)/O 0/,ISYM( 569)/O 46525/,ISYM( 570)/O 46125/ DATA ISYM( 571)/O 24/,ISYM( 572)/O140300/,ISYM( 573)/O 0/ DATA ISYM( 574)/O 1377/,ISYM( 575)/O 0/,ISYM( 576)/O 46525/ DATA ISYM( 577)/O 46123/,ISYM( 578)/O 24/,ISYM( 579)/O140700/ DATA ISYM( 580)/O 0/,ISYM( 581)/O 1377/,ISYM( 582)/O 1727/ DATA ISYM( 583)/O 42111/,ISYM( 584)/O 53125/,ISYM( 585)/O 24/ DATA ISYM( 586)/O100300/,ISYM( 587)/O 0/,ISYM( 588)/O 1377/ DATA ISYM( 589)/O 2045/,ISYM( 590)/O 42111/,ISYM( 591)/O 53123/ DATA ISYM( 592)/O 24/,ISYM( 593)/O100700/,ISYM( 594)/O 0/ DATA ISYM( 595)/O 1377/,ISYM( 596)/O 0/,ISYM( 597)/O 40504/ DATA ISYM( 598)/O 42000/,ISYM( 599)/O 25/,ISYM( 600)/O150000/ DATA ISYM( 601)/O 0/,ISYM( 602)/O 1377/,ISYM( 603)/O 1525/ DATA ISYM( 604)/O 40504/,ISYM( 605)/O 42111/,ISYM( 606)/O 25/ DATA ISYM( 607)/O150001/,ISYM( 608)/O 0/,ISYM( 609)/O 1377/ DATA ISYM( 610)/O 1353/,ISYM( 611)/O 40504/,ISYM( 612)/O 42101/ DATA ISYM( 613)/O 25/,ISYM( 614)/O150002/,ISYM( 615)/O 0/ DATA ISYM( 616)/O 1377/,ISYM( 617)/O 1410/,ISYM( 618)/O 40504/ DATA ISYM( 619)/O 42121/,ISYM( 620)/O 25/,ISYM( 621)/O 50000/ DATA ISYM( 622)/O 0/,ISYM( 623)/O 1377/,ISYM( 624)/O 2004/ DATA ISYM( 625)/O 51525/,ISYM( 626)/O 41111/,ISYM( 627)/O 25/ DATA ISYM( 628)/O110001/,ISYM( 629)/O 0/,ISYM( 630)/O 1377/ DATA ISYM( 631)/O 1606/,ISYM( 632)/O 51525/,ISYM( 633)/O 41101/ DATA ISYM( 634)/O 25/,ISYM( 635)/O110002/,ISYM( 636)/O 0/ DATA ISYM( 637)/O 1377/,ISYM( 638)/O 2103/,ISYM( 639)/O 51525/ DATA ISYM( 640)/O 41121/,ISYM( 641)/O 25/,ISYM( 642)/O 50400/ DATA ISYM( 643)/O 0/,ISYM( 644)/O 1377/,ISYM( 645)/O 1230/ DATA ISYM( 646)/O 51525/,ISYM( 647)/O 41000/,ISYM( 648)/O 25/ DATA ISYM( 649)/O110000/,ISYM( 650)/O 0/,ISYM( 651)/O 1377/ DATA ISYM( 652)/O 0/,ISYM( 653)/O 40516/,ISYM( 654)/O 42000/ DATA ISYM( 655)/O 26/,ISYM( 656)/O140000/,ISYM( 657)/O 0/ DATA ISYM( 658)/O 1377/,ISYM( 659)/O 1362/,ISYM( 660)/O 40516/ DATA ISYM( 661)/O 42111/,ISYM( 662)/O 26/,ISYM( 663)/O140000/ DATA ISYM( 664)/O 0/,ISYM( 665)/O 1377/,ISYM( 666)/O 0/ DATA ISYM( 667)/O 47522/,ISYM( 668)/O 44400/,ISYM( 669)/O 26/ DATA ISYM( 670)/O 0/,ISYM( 671)/O 0/,ISYM( 672)/O 777/ DATA ISYM( 673)/O 1272/,ISYM( 674)/O 47522/,ISYM( 675)/O 26/ DATA ISYM( 676)/O100000/,ISYM( 677)/O 0/,ISYM( 678)/O 1377/ DATA ISYM( 679)/O 1534/,ISYM( 680)/O 42517/,ISYM( 681)/O 51000/ DATA ISYM( 682)/O 27/,ISYM( 683)/O130400/,ISYM( 684)/O 0/ DATA ISYM( 685)/O 1377/,ISYM( 686)/O 1500/,ISYM( 687)/O 42517/ DATA ISYM( 688)/O 51111/,ISYM( 689)/O 27/,ISYM( 690)/O130400/ DATA ISYM( 691)/O 0/,ISYM( 692)/O 1377/,ISYM( 693)/O 1570/ DATA ISYM( 694)/O 41515/,ISYM( 695)/O 50000/,ISYM( 696)/O 30/ DATA ISYM( 697)/O130000/,ISYM( 698)/O 0/,ISYM( 699)/O 1377/ DATA ISYM( 700)/O 1335/,ISYM( 701)/O 41515/,ISYM( 702)/O 50101/ DATA ISYM( 703)/O 30/,ISYM( 704)/O130001/,ISYM( 705)/O 0/ DATA ISYM( 706)/O 1377/,ISYM( 707)/O 0/,ISYM( 708)/O 41515/ DATA ISYM( 709)/O 50111/,ISYM( 710)/O 30/,ISYM( 711)/O 6000/ DATA ISYM( 712)/O 0/,ISYM( 713)/O 1377/,ISYM( 714)/O 0/ DATA ISYM( 715)/O 42530/,ISYM( 716)/O 43400/,ISYM( 717)/O 31/ DATA ISYM( 718)/O140500/,ISYM( 719)/O 0/,ISYM( 720)/O 1377/ DATA ISYM( 721)/O 0/,ISYM( 722)/O 41510/,ISYM( 723)/O 45400/ DATA ISYM( 724)/O 32/,ISYM( 725)/O 40600/,ISYM( 726)/O 0/ DATA ISYM( 727)/O 1377/,ISYM( 728)/O 1775/,ISYM( 729)/O 41515/ DATA ISYM( 730)/O 50115/,ISYM( 731)/O 33/,ISYM( 732)/O130410/ DATA ISYM( 733)/O 0/,ISYM( 734)/O 1377/,ISYM( 735)/O 1543/ DATA ISYM( 736)/O 40504/,ISYM( 737)/O 42130/,ISYM( 738)/O 34/ DATA ISYM( 739)/O150400/,ISYM( 740)/O 0/,ISYM( 741)/O 1377/ DATA ISYM( 742)/O 0/,ISYM( 743)/O 51525/,ISYM( 744)/O 41130/ DATA ISYM( 745)/O 34/,ISYM( 746)/O110400/,ISYM( 747)/O 0/ DATA ISYM( 748)/O 1377/,ISYM( 749)/O 0/,ISYM( 750)/O 40502/ DATA ISYM( 751)/O 41504/,ISYM( 752)/O 35/,ISYM( 753)/O140400/ DATA ISYM( 754)/O 0/,ISYM( 755)/O 1377/,ISYM( 756)/O 1444/ DATA ISYM( 757)/O 51502/,ISYM( 758)/O 41504/,ISYM( 759)/O 35/ DATA ISYM( 760)/O100400/,ISYM( 761)/O 0/,ISYM( 762)/O 1777/ DATA ISYM( 763)/O 0/,ISYM( 764)/O 46517/,ISYM( 765)/O 53105/ DATA ISYM( 766)/O 50000/,ISYM( 767)/O 36/,ISYM( 768)/O 400/ DATA ISYM( 769)/O 0/,ISYM( 770)/O 1377/,ISYM( 771)/O 1453/ DATA ISYM( 772)/O 42102/,ISYM( 773)/O 51101/,ISYM( 774)/O 40/ DATA ISYM( 775)/O 50710/,ISYM( 776)/O 0/,ISYM( 777)/O 1377/ DATA ISYM( 778)/O 0/,ISYM( 779)/O 42102/,ISYM( 780)/O 52000/ DATA ISYM( 781)/O 40/,ISYM( 782)/O 50310/,ISYM( 783)/O 0/ DATA ISYM( 784)/O 1377/,ISYM( 785)/O 1552/,ISYM( 786)/O 42102/ DATA ISYM( 787)/O 44111/,ISYM( 788)/O 40/,ISYM( 789)/O 51310/ DATA ISYM( 790)/O 0/,ISYM( 791)/O 1377/,ISYM( 792)/O 2215/ DATA ISYM( 793)/O 42102/,ISYM( 794)/O 46123/,ISYM( 795)/O 40/ DATA ISYM( 796)/O 51710/,ISYM( 797)/O 0/,ISYM( 798)/O 1377/ DATA ISYM( 799)/O 0/,ISYM( 800)/O 42102/,ISYM( 801)/O 41503/ DATA ISYM( 802)/O 40/,ISYM( 803)/O 52310/,ISYM( 804)/O 0/ DATA ISYM( 805)/O 1377/,ISYM( 806)/O 1462/,ISYM( 807)/O 42102/ DATA ISYM( 808)/O 41523/,ISYM( 809)/O 40/,ISYM( 810)/O 52710/ DATA ISYM( 811)/O 0/,ISYM( 812)/O 1377/,ISYM( 813)/O 0/ DATA ISYM( 814)/O 42102/,ISYM( 815)/O 47105/,ISYM( 816)/O 40/ DATA ISYM( 817)/O 53310/,ISYM( 818)/O 0/,ISYM( 819)/O 1377/ DATA ISYM( 820)/O 1516/,ISYM( 821)/O 42102/,ISYM( 822)/O 42521/ DATA ISYM( 823)/O 40/,ISYM( 824)/O 53710/,ISYM( 825)/O 0/ DATA ISYM( 826)/O 1377/,ISYM( 827)/O 0/,ISYM( 828)/O 42102/ DATA ISYM( 829)/O 53103/,ISYM( 830)/O 40/,ISYM( 831)/O 54310/ DATA ISYM( 832)/O 0/,ISYM( 833)/O 1377/,ISYM( 834)/O 0/ DATA ISYM( 835)/O 42102/,ISYM( 836)/O 53123/,ISYM( 837)/O 40/ DATA ISYM( 838)/O 54710/,ISYM( 839)/O 0/,ISYM( 840)/O 1377/ DATA ISYM( 841)/O 0/,ISYM( 842)/O 42102/,ISYM( 843)/O 50114/ DATA ISYM( 844)/O 40/,ISYM( 845)/O 55310/,ISYM( 846)/O 0/ DATA ISYM( 847)/O 1377/,ISYM( 848)/O 0/,ISYM( 849)/O 42102/ DATA ISYM( 850)/O 46511/,ISYM( 851)/O 40/,ISYM( 852)/O 55710/ DATA ISYM( 853)/O 0/,ISYM( 854)/O 1377/,ISYM( 855)/O 1561/ DATA ISYM( 856)/O 42102/,ISYM( 857)/O 43505/,ISYM( 858)/O 40/ DATA ISYM( 859)/O 56310/,ISYM( 860)/O 0/,ISYM( 861)/O 1377/ DATA ISYM( 862)/O 1577/,ISYM( 863)/O 42102/,ISYM( 864)/O 46124/ DATA ISYM( 865)/O 40/,ISYM( 866)/O 56710/,ISYM( 867)/O 0/ DATA ISYM( 868)/O 1377/,ISYM( 869)/O 0/,ISYM( 870)/O 42102/ DATA ISYM( 871)/O 43524/,ISYM( 872)/O 40/,ISYM( 873)/O 57310/ DATA ISYM( 874)/O 0/,ISYM( 875)/O 1377/,ISYM( 876)/O 0/ DATA ISYM( 877)/O 42102/,ISYM( 878)/O 46105/,ISYM( 879)/O 40/ DATA ISYM( 880)/O 57710/,ISYM( 881)/O 0/,ISYM( 882)/O 1377/ DATA ISYM( 883)/O 0/,ISYM( 884)/O 46105/,ISYM( 885)/O 40400/ DATA ISYM( 886)/O 42/,ISYM( 887)/O 40700/,ISYM( 888)/O 0/ DATA ISYM( 889)/O 1377/,ISYM( 890)/O 0/,ISYM( 891)/O 40523/ DATA ISYM( 892)/O 46000/,ISYM( 893)/O 43/,ISYM( 894)/O160400/ DATA ISYM( 895)/O 0/,ISYM( 896)/O 1377/,ISYM( 897)/O 0/ DATA ISYM( 898)/O 40523/,ISYM( 899)/O 51000/,ISYM( 900)/O 43/ DATA ISYM( 901)/O160000/,ISYM( 902)/O 0/,ISYM( 903)/O 1377/ DATA ISYM( 904)/O 1660/,ISYM( 905)/O 46123/,ISYM( 906)/O 46000/ DATA ISYM( 907)/O 43/,ISYM( 908)/O160410/,ISYM( 909)/O 0/ DATA ISYM( 910)/O 1377/,ISYM( 911)/O 2111/,ISYM( 912)/O 46123/ DATA ISYM( 913)/O 51000/,ISYM( 914)/O 43/,ISYM( 915)/O160010/ DATA ISYM( 916)/O 0/,ISYM( 917)/O 1377/,ISYM( 918)/O 1710/ DATA ISYM( 919)/O 41103/,ISYM( 920)/O 44107/,ISYM( 921)/O 44/ DATA ISYM( 922)/O 500/,ISYM( 923)/O 0/,ISYM( 924)/O 1377/ DATA ISYM( 925)/O 2171/,ISYM( 926)/O 41103/,ISYM( 927)/O 46122/ DATA ISYM( 928)/O 44/,ISYM( 929)/O 600/,ISYM( 930)/O 0/ DATA ISYM( 931)/O 1377/,ISYM( 932)/O 0/,ISYM( 933)/O 41123/ DATA ISYM( 934)/O 42524/,ISYM( 935)/O 44/,ISYM( 936)/O 700/ DATA ISYM( 937)/O 0/,ISYM( 938)/O 1377/,ISYM( 939)/O 0/ DATA ISYM( 940)/O 41124/,ISYM( 941)/O 51524/,ISYM( 942)/O 44/ DATA ISYM( 943)/O 400/,ISYM( 944)/O 0/,ISYM( 945)/O 1777/ DATA ISYM( 946)/O 0/,ISYM( 947)/O 41103/,ISYM( 948)/O 44107/ DATA ISYM( 949)/O 53400/,ISYM( 950)/O 47/,ISYM( 951)/O 500/ DATA ISYM( 952)/O 0/,ISYM( 953)/O 1777/,ISYM( 954)/O 2075/ DATA ISYM( 955)/O 41103/,ISYM( 956)/O 46122/,ISYM( 957)/O 53400/ DATA ISYM( 958)/O 47/,ISYM( 959)/O 600/,ISYM( 960)/O 0/ DATA ISYM( 961)/O 1777/,ISYM( 962)/O 2013/,ISYM( 963)/O 41123/ DATA ISYM( 964)/O 42524/,ISYM( 965)/O 53400/,ISYM( 966)/O 47/ DATA ISYM( 967)/O 700/,ISYM( 968)/O 0/,ISYM( 969)/O 1777/ DATA ISYM( 970)/O 0/,ISYM( 971)/O 41124/,ISYM( 972)/O 51524/ DATA ISYM( 973)/O 53400/,ISYM( 974)/O 47/,ISYM( 975)/O 400/ DATA ISYM( 976)/O 0/,ISYM( 977)/O 1377/,ISYM( 978)/O 2053/ DATA ISYM( 979)/O 46517/,ISYM( 980)/O 53105/,ISYM( 981)/O 45/ DATA ISYM( 982)/O 0/,ISYM( 983)/O 0/,ISYM( 984)/O 1777/ DATA ISYM( 985)/O 2061/,ISYM( 986)/O 46517/,ISYM( 987)/O 53105/ DATA ISYM( 988)/O 40400/,ISYM( 989)/O 45/,ISYM( 990)/O 0/ DATA ISYM( 991)/O 0/,ISYM( 992)/O 1777/,ISYM( 993)/O 0/ DATA ISYM( 994)/O 46517/,ISYM( 995)/O 53105/,ISYM( 996)/O 50400/ DATA ISYM( 997)/O 45/,ISYM( 998)/O 70000/,ISYM( 999)/O 0/ DATA ISYM(1000)/O 1377/,ISYM(1001)/O 0/,ISYM(1002)/O 46104/ DATA ISYM(1003)/O 46400/,ISYM(1004)/O 46/,ISYM(1005)/O 46000/ DATA ISYM(1006)/O 0/,ISYM(1007)/O 1377/,ISYM(1008)/O 2031/ DATA ISYM(1009)/O 51524/,ISYM(1010)/O 46400/,ISYM(1011)/O 46/ DATA ISYM(1012)/O 44200/,ISYM(1013)/O 0/,ISYM(1014)/O 1777/ DATA ISYM(1015)/O 0/,ISYM(1016)/O 46517/,ISYM(1017)/O 53105/ DATA ISYM(1018)/O 46400/,ISYM(1019)/O 46/,ISYM(1020)/O 44200/ DATA ISYM(1021)/O 0/,ISYM(1022)/O 1377/,ISYM(1023)/O 0/ DATA ISYM(1024)/O 51117/,ISYM(1025)/O 46000/,ISYM(1026)/O 43/ DATA ISYM(1027)/O160430/,ISYM(1028)/O 0/,ISYM(1029)/O 1377/ DATA ISYM(1030)/O 2125/,ISYM(1031)/O 51117/,ISYM(1032)/O 51000/ DATA ISYM(1033)/O 43/,ISYM(1034)/O160030/,ISYM(1035)/O 0/ DATA ISYM(1036)/O 1377/,ISYM(1037)/O 0/,ISYM(1038)/O 51117/ DATA ISYM(1039)/O 54114/,ISYM(1040)/O 43/,ISYM(1041)/O160420/ DATA ISYM(1042)/O 0/,ISYM(1043)/O 1377/,ISYM(1044)/O 0/ DATA ISYM(1045)/O 51117/,ISYM(1046)/O 54122/,ISYM(1047)/O 43/ DATA ISYM(1048)/O160020/,ISYM(1049)/O 0/,ISYM(1050)/O 401/ DATA ISYM(1051)/O 2133/,ISYM(1052)/O 42060/,ISYM(1053)/O 2/ DATA ISYM(1054)/O 0/,ISYM(1055)/O 0/,ISYM(1056)/O 401/ DATA ISYM(1057)/O 2141/,ISYM(1058)/O 42061/,ISYM(1059)/O 2/ DATA ISYM(1060)/O 1/,ISYM(1061)/O 0/,ISYM(1062)/O 401/ DATA ISYM(1063)/O 2147/,ISYM(1064)/O 42062/,ISYM(1065)/O 2/ DATA ISYM(1066)/O 2/,ISYM(1067)/O 0/,ISYM(1068)/O 401/ DATA ISYM(1069)/O 2155/,ISYM(1070)/O 42063/,ISYM(1071)/O 2/ DATA ISYM(1072)/O 3/,ISYM(1073)/O 0/,ISYM(1074)/O 401/ DATA ISYM(1075)/O 2163/,ISYM(1076)/O 42064/,ISYM(1077)/O 2/ DATA ISYM(1078)/O 4/,ISYM(1079)/O 0/,ISYM(1080)/O 401/ DATA ISYM(1081)/O 0/,ISYM(1082)/O 42065/,ISYM(1083)/O 2/ DATA ISYM(1084)/O 5/,ISYM(1085)/O 0/,ISYM(1086)/O 401/ DATA ISYM(1087)/O 0/,ISYM(1088)/O 42066/,ISYM(1089)/O 2/ DATA ISYM(1090)/O 6/,ISYM(1091)/O 0/,ISYM(1092)/O 401/ DATA ISYM(1093)/O 0/,ISYM(1094)/O 42067/,ISYM(1095)/O 2/ DATA ISYM(1096)/O 7/,ISYM(1097)/O 0/,ISYM(1098)/O 401/ DATA ISYM(1099)/O 0/,ISYM(1100)/O 40460/,ISYM(1101)/O 2/ DATA ISYM(1102)/O 10/,ISYM(1103)/O 0/,ISYM(1104)/O 401/ DATA ISYM(1105)/O 0/,ISYM(1106)/O 40461/,ISYM(1107)/O 2/ DATA ISYM(1108)/O 11/,ISYM(1109)/O 0/,ISYM(1110)/O 401/ DATA ISYM(1111)/O 0/,ISYM(1112)/O 40462/,ISYM(1113)/O 2/ DATA ISYM(1114)/O 12/,ISYM(1115)/O 0/,ISYM(1116)/O 401/ DATA ISYM(1117)/O 0/,ISYM(1118)/O 40463/,ISYM(1119)/O 2/ DATA ISYM(1120)/O 13/,ISYM(1121)/O 0/,ISYM(1122)/O 401/ DATA ISYM(1123)/O 0/,ISYM(1124)/O 40464/,ISYM(1125)/O 2/ DATA ISYM(1126)/O 14/,ISYM(1127)/O 0/,ISYM(1128)/O 401/ DATA ISYM(1129)/O 0/,ISYM(1130)/O 40465/,ISYM(1131)/O 2/ DATA ISYM(1132)/O 15/,ISYM(1133)/O 0/,ISYM(1134)/O 401/ DATA ISYM(1135)/O 0/,ISYM(1136)/O 40466/,ISYM(1137)/O 2/ DATA ISYM(1138)/O 16/,ISYM(1139)/O 0/,ISYM(1140)/O 401/ DATA ISYM(1141)/O 2177/,ISYM(1142)/O 40467/,ISYM(1143)/O 2/ DATA ISYM(1144)/O 17/,ISYM(1145)/O 0/,ISYM(1146)/O 401/ DATA ISYM(1147)/O 0/,ISYM(1148)/O 51520/,ISYM(1149)/O 2/ DATA ISYM(1150)/O 17/,ISYM(1151)/O 0/,ISYM(1152)/O 1001/ DATA ISYM(1153)/O 0/,ISYM(1154)/O 52523/,ISYM(1155)/O 50000/ DATA ISYM(1156)/O 2/,ISYM(1157)/O 20/,ISYM(1158)/O 0/ DATA ISYM(1159)/O 1001/,ISYM(1160)/O 0/,ISYM(1161)/O 41503/ DATA ISYM(1162)/O 51000/,ISYM(1163)/O 2/,ISYM(1164)/O 74/ DATA ISYM(1165)/O 0/,ISYM(1166)/O 401/,ISYM(1167)/O 0/ DATA ISYM(1168)/O 51522/,ISYM(1169)/O 2/,ISYM(1170)/O 174/ DATA ISYM(1171)/O 0/,ISYM(1172)/O 0/,ISYM(1173)/O 0/ DATA NET1( 1)/ 29/,NET2( 1)/ 0/,NET3( 1)/ 2/, & NET4( 1)/ 2/,NET5( 1)/ 1/ DATA NET1( 2)/ 30/,NET2( 2)/ 0/,NET3( 2)/ 0/, & NET4( 2)/ 3/,NET5( 2)/ 2/ DATA NET1( 3)/ 46/,NET2( 3)/ 0/,NET3( 3)/ 5/, & NET4( 3)/ 4/,NET5( 3)/ 0/ DATA NET1( 4)/ 24/,NET2( 4)/ 0/,NET3( 4)/ 0/, & NET4( 4)/ 5/,NET5( 4)/ 3/ DATA NET1( 5)/ 0/,NET2( 5)/ 8/,NET3( 5)/ 0/, & NET4( 5)/ 6/,NET5( 5)/ 0/ DATA NET1( 6)/ 44/,NET2( 6)/ 0/,NET3( 6)/ -1/, & NET4( 6)/ 5/,NET5( 6)/ 4/ DATA NET1( 7)/ 0/,NET2( 7)/ 0/,NET3( 7)/ 0/, & NET4( 7)/ 0/,NET5( 7)/ 0/ DATA NET1( 8)/ 28/,NET2( 8)/ 0/,NET3( 8)/ 12/, & NET4( 8)/ 9/,NET5( 8)/ 5/ DATA NET1( 9)/ 45/,NET2( 9)/ 0/,NET3( 9)/ 11/, & NET4( 9)/ 10/,NET5( 9)/ 0/ DATA NET1(10)/ 28/,NET2(10)/ 0/,NET3(10)/ 0/, & NET4(10)/ 11/,NET5(10)/ 15/ DATA NET1(11)/ 47/,NET2(11)/ 0/,NET3(11)/ -1/, & NET4(11)/ 8/,NET5(11)/ 0/ DATA NET1(12)/ 40/,NET2(12)/ 0/,NET3(12)/ 16/, & NET4(12)/ 13/,NET5(12)/ 34/ DATA NET1(13)/ 28/,NET2(13)/ 0/,NET3(13)/ 24/, & NET4(13)/ 14/,NET5(13)/ 6/ DATA NET1(14)/ 41/,NET2(14)/ 0/,NET3(14)/ 0/, & NET4(14)/ 15/,NET5(14)/ 0/ DATA NET1(15)/ 43/,NET2(15)/ 0/,NET3(15)/ -1/, & NET4(15)/ -1/,NET5(15)/ 7/ DATA NET1(16)/ 45/,NET2(16)/ 0/,NET3(16)/ 20/, & NET4(16)/ 17/,NET5(16)/ 24/ DATA NET1(17)/ 40/,NET2(17)/ 0/,NET3(17)/ 23/, & NET4(17)/ 18/,NET5(17)/ 34/ DATA NET1(18)/ 28/,NET2(18)/ 0/,NET3(18)/ 24/, & NET4(18)/ 19/,NET5(18)/ 8/ DATA NET1(19)/ 41/,NET2(19)/ 0/,NET3(19)/ 0/, & NET4(19)/ -1/,NET5(19)/ 0/ DATA NET1(20)/ 35/,NET2(20)/ 0/,NET3(20)/ 22/, & NET4(20)/ 21/,NET5(20)/ 0/ DATA NET1(21)/ 0/,NET2(21)/ 36/,NET3(21)/ 0/, & NET4(21)/ -1/,NET5(21)/ 10/ DATA NET1(22)/ 27/,NET2(22)/ 0/,NET3(22)/ 25/, & NET4(22)/ -1/,NET5(22)/ 16/ DATA NET1(23)/ 0/,NET2(23)/ 40/,NET3(23)/ 0/, & NET4(23)/ 26/,NET5(23)/ 11/ DATA NET1(24)/ 0/,NET2(24)/ 38/,NET3(24)/ 0/, & NET4(24)/ 26/,NET5(24)/ 11/ DATA NET1(25)/ 0/,NET2(25)/ 36/,NET3(25)/ 0/, & NET4(25)/ 26/,NET5(25)/ 11/ DATA NET1(26)/ 40/,NET2(26)/ 0/,NET3(26)/ -1/, & NET4(26)/ 27/,NET5(26)/ 0/ DATA NET1(27)/ 28/,NET2(27)/ 0/,NET3(27)/ 0/, & NET4(27)/ 28/,NET5(27)/ 12/ DATA NET1(28)/ 46/,NET2(28)/ 0/,NET3(28)/ 31/, & NET4(28)/ 29/,NET5(28)/ 0/ DATA NET1(29)/ 24/,NET2(29)/ 0/,NET3(29)/ 0/, & NET4(29)/ 30/,NET5(29)/ 13/ DATA NET1(30)/ 41/,NET2(30)/ 0/,NET3(30)/ 0/, & NET4(30)/ -1/,NET5(30)/ 0/ DATA NET1(31)/ 44/,NET2(31)/ 0/,NET3(31)/ 35/, & NET4(31)/ 32/,NET5(31)/ 0/ DATA NET1(32)/ 28/,NET2(32)/ 0/,NET3(32)/ 0/, & NET4(32)/ 33/,NET5(32)/ 14/ DATA NET1(33)/ 46/,NET2(33)/ 0/,NET3(33)/ 35/, & NET4(33)/ 34/,NET5(33)/ 0/ DATA NET1(34)/ 24/,NET2(34)/ 0/,NET3(34)/ 0/, & NET4(34)/ 35/,NET5(34)/ 13/ DATA NET1(35)/ 41/,NET2(35)/ 0/,NET3(35)/ 0/, & NET4(35)/ -1/,NET5(35)/ 0/ DATA NET1(36)/ 45/,NET2(36)/ 0/,NET3(36)/ 37/, & NET4(36)/ 37/,NET5(36)/ 24/ DATA NET1(37)/ 40/,NET2(37)/ 0/,NET3(37)/ 40/, & NET4(37)/ 38/,NET5(37)/ 34/ DATA NET1(38)/ 0/,NET2(38)/ 36/,NET3(38)/ 0/, & NET4(38)/ 39/,NET5(38)/ 0/ DATA NET1(39)/ 41/,NET2(39)/ 0/,NET3(39)/ 0/, & NET4(39)/ 43/,NET5(39)/ 35/ DATA NET1(40)/ 24/,NET2(40)/ 0/,NET3(40)/ 41/, & NET4(40)/ 43/,NET5(40)/ 17/ DATA NET1(41)/ 25/,NET2(41)/ 0/,NET3(41)/ 42/, & NET4(41)/ 43/,NET5(41)/ 17/ DATA NET1(42)/ 42/,NET2(42)/ 0/,NET3(42)/ 0/, & NET4(42)/ 43/,NET5(42)/ 17/ DATA NET1(43)/ 62/,NET2(43)/ 0/,NET3(43)/ 45/, & NET4(43)/ 44/,NET5(43)/ 25/ DATA NET1(44)/ 62/,NET2(44)/ 0/,NET3(44)/ 0/, & NET4(44)/ 37/,NET5(44)/ 0/ DATA NET1(45)/ 60/,NET2(45)/ 0/,NET3(45)/ 47/, & NET4(45)/ 46/,NET5(45)/ 26/ DATA NET1(46)/ 60/,NET2(46)/ 0/,NET3(46)/ 0/, & NET4(46)/ 37/,NET5(46)/ 0/ DATA NET1(47)/ 38/,NET2(47)/ 0/,NET3(47)/ 48/, & NET4(47)/ 36/,NET5(47)/ 27/ DATA NET1(48)/ 33/,NET2(48)/ 0/,NET3(48)/ 50/, & NET4(48)/ 36/,NET5(48)/ 28/ DATA NET1(49)/ 37/,NET2(49)/ 0/,NET3(49)/ 50/, & NET4(49)/ 36/,NET5(49)/ 29/ DATA NET1(50)/ 42/,NET2(50)/ 0/,NET3(50)/ 51/, & NET4(50)/ 36/,NET5(50)/ 30/ DATA NET1(51)/ 47/,NET2(51)/ 0/,NET3(51)/ 52/, & NET4(51)/ 36/,NET5(51)/ 31/ DATA NET1(52)/ 43/,NET2(52)/ 0/,NET3(52)/ 53/, & NET4(52)/ 36/,NET5(52)/ 32/ DATA NET1(53)/ 45/,NET2(53)/ 0/,NET3(53)/ -1/, & NET4(53)/ 36/,NET5(53)/ 33/ DATA KASH( 1)/ 0/,KASH( 2)/ 573/,KASH( 3)/ 740/,KASH( 4)/ 139/ DATA KASH( 5)/1013/,KASH( 6)/ 960/,KASH( 7)/ 559/,KASH( 8)/ 16/ DATA KASH( 9)/ 328/,KASH(10)/ 594/,KASH(11)/ 608/,KASH(12)/1042/ DATA KASH(13)/ 797/,KASH(14)/ 147/,KASH(15)/ 384/,KASH(16)/ 0/ DATA KASH(17)/ 0/,KASH(18)/ 0/,KASH(19)/ 601/,KASH(20)/ 314/ DATA KASH(21)/ 916/,KASH(22)/ 300/,KASH(23)/ 279/,KASH(24)/ 24/ DATA KASH(25)/ 335/,KASH(26)/ 52/,KASH(27)/ 31/,KASH(28)/ 356/ DATA KASH(29)/ 202/,KASH(30)/ 38/,KASH(31)/ 110/,KASH(32)/ 503/ DATA KASH(33)/ 691/,KASH(34)/ 251/,KASH(35)/ 391/,KASH(36)/ 923/ DATA KASH(37)/ 9/,KASH(38)/ 531/,KASH(39)/ 209/,KASH(40)/ 293/ DATA KASH(41)/ 168/,KASH(42)/ 60/,KASH(43)/ 643/,KASH(44)/ 118/ DATA KASH(45)/ 90/,KASH(46)/ 155/,KASH(47)/ 216/,KASH(48)/ 286/ DATA KASH(49)/ 0/,KASH(50)/ 265/,KASH(51)/ 1/,KASH(52)/ 510/ DATA KASH(53)/ 67/,KASH(54)/1055/,KASH(55)/ 587/,KASH(56)/ 237/ DATA KASH(57)/ 82/,KASH(58)/ 132/,KASH(59)/ 74/,KASH(60)/ 230/ DATA KASH(61)/ 45/,KASH(62)/ 937/,KASH(63)/ 0/,KASH(64)/ 0/ END SUBROUTINE ERR(JERNO) C+ NAM: ERR VER: 1.0 DAT: 12/08/78 CMP: ALL C C SYS: MACS C C ENT: JERNO > 0 - ERROR NUMBER C = 0 - OUTPUT TOTAL # OF ERRORS FOR CURRENT INSTRUCTION C = -1 - OUTPUT TOTAL # OF ERRORS FOR PROGRAM C C RTN: JERNO - N/C C C FNC: THIS ROUTINE TABLES ERROR #'S FOR EACH SOURCE STATEMENT C AND AT THE END OF SCAN OUTPUTS ALL ERRORS FOR IT. C IT OUTPUTS TOTAL # ERRORS FOR THE PROGRAM AT THE END. C C REV: N/A C CALLS PAGE C C* IMPLICIT INTEGER (A-Z) COMMON /A/ ISYM(3000),KARD1(96),ITOKEN(70),TKNSIZ,TKNTYP, & TKNVAL,TKNVA2,JSUC,JPTR,LPTR,NXSYM,KOLUMN,KD1BCT,KD1LNO,JERR, & MNUM,IPASS,IPC2,IPC,IOPC,INS(5),INSL,ISIZ,IADM(7,2),LUOT COMMON /A/ KASH(64),KPAC(15),KPWCT,LENSYM,KCLAS(64) COMMON /A/ NET1(64),NET2(64),NET3(64),NET4(64),NET5(64) COMMON /A/ NBPW,KSYS,IEOT,LSP,JBUF(83),KARD2(80,3),IHB480,IHEX9K COMMON /A/ IA1SHF,KCFF,LUSI,LUDI,LUOO,LLEN,IPLEN COMMON /A/ LIST,ICOL,NEST,LUCI,LULT C DIMENSION NERR(2,10) DATA KD1LN2/0/ DATA ITOTER/0/,LASK/42/ C*** TABLE THE ERROR FOR THIS SOURCE LINE? IF(JERNO.LE.0) GO TO 100 IF(JERR.EQ.10) RETURN JERR=JERR+1 NERR(1,JERR)=JERNO NERR(2,JERR)=KOLUMN RETURN C*** PRINT THE ERRORS IF ANY, 0=NONE, LESS THAN 0= PRINT TOTAL 100 IF(JERNO.LT.0) GO TO 300 IF(JERR.EQ.0) RETURN C*** PRINT EACH ERROR FOR THIS SOURCE LINE. DO 200 K=1,JERR KK=NERR(2,K) DO 130 J=1,41 130 JBUF(J)=LSP C*** NAX # CHARS TO PRINT. IF(KK.GT.41) KK=41 IF(KK.GT.0) JBUF(KK)=LASK C C*** IF "NOLIST" PRINT THE SOURCE LINE HERE C*** KD1LN2= LAST LINE # ENCOUNTERED WITH AN ERROR. JBUF(51)=KD1LN2 IF(LIST.EQ.1) GO TO 140 IF(KARD1(1).EQ.0) GO TO 140 IF(KD1BCT.GT.41) KD1BCT=41 WRITE(LUOT,9900) KD1LNO,(KARD1(J),J=1,KD1BCT) CALL PAGE(1) 9900 FORMAT(I4,21X,80A1) KARD1(1)=0 140 CONTINUE WRITE(LUOT,9980) NERR(1,K),KD1LN2,(JBUF(J),J=1,KK) 9980 FORMAT('****** ERROR ',I4,'--',I4,41A1) CALL PAGE(1) 200 CONTINUE C*** KEEP LINE # OF THIS ERROR. KD1LN2=KD1LNO ITOTER=ITOTER+JERR JERR=0 RETURN C*** FINAL ERROR COUNT PRINT 300 WRITE(LUOT,9970) ITOTER,KD1LN2 9970 FORMAT(/' ****** TOTAL ERRORS ',I3,'--',I4) CALL PAGE(2) C*** IF SOURCE GOES TO FILE, PRINT TOTAL ERRORS AT CONSOLE IF(LUOT.NE.LULT) WRITE(LULT,9970) ITOTER,KD1LN2 RETURN END SUBROUTINE COMDEP C+ NAM: COMDEP VER: 1.0 DAT: 12/08/78 CMP: PDP-11 C C SYS: MACS C C ENT: N/A C C RTN: N/A C C FNC: THIS ROUTINE SETS VARIABLES IN COMMON TO WHAT THE C COMPUTER IT IS CURRENTLY RUNNING ON REQUIRES. C IT ALSO SETS I/O DEVICE NUMBERS TO 6800 DEVICES. C DEVICE NUMBER VARIABLE NAME C 2 LUSI - SOURCE INPUT C 20 LUOT - ASSEMBLY LISTING(TO A FILE) C 6 LUOT - ASSEMBLY LISTING( TO CONSOLE) C 5 LULT - OUTPUT TO CONSOLE. C 5 LUCI - INPUT FROM CONSOLE. C 1 LUOO - ASSEMBLED OBJECT OUTPUT. C C C REV: N/A C C* IMPLICIT INTEGER (A-Z) COMMON /A/ ISYM(3000),KARD1(96),ITOKEN(70),TKNSIZ,TKNTYP, & TKNVAL,TKNVA2,JSUC,JPTR,LPTR,NXSYM,KOLUMN,KD1BCT,KD1LNO,JERR, & MNUM,IPASS,IPC2,IPC,IOPC,INS(5),INSL,ISIZ,IADM(7,2),LUOT COMMON /A/ KASH(64),KPAC(15),KPWCT,LENSYM,KCLAS(64) COMMON /A/ NET1(64),NET2(64),NET3(64),NET4(64),NET5(64) COMMON /A/ NBPW,KSYS,IEOT,LSP,JBUF(83),KARD2(80,3),IHB480,IHEX9K COMMON /A/ IA1SHF,KCFF,LUSI,LUDI,LUOO,LLEN,IPLEN COMMON /A/ LIST,ICOL,NEST,LUCI,LULT C C C C*** IHB480 CHANGED TO HEX B180 FROM B480 DATA IB480/O130600/,IHX9K/O110000/ C*** IHB480 = $B180 HEX IHB480 = IB480 C*** IHEX9K = 9000 HEX IHEX9K=IHX9K C*** # OF BYTES PER COMPUTER WORD NBPW=2 C C*** DEFAULT SOURCE OUTPUT DEVICE NUMBER C LUOT=6 C C*** SOURCE INPUT DEVICE NUMBER C LUSI=2 C C*** CONSOLE INPUT C LUCI=5 C C*** CONSOLE OUTPUT C LULT=5 C C*** OBJECT OUTPUT(S RECORDS) DEVICE # LUOO=1 C*** POWER OF 2 SHIFT C*** 'AND' MASK KCFF=255 C*** LINE COUNT KD1LNO=0 C*** END OF RECORD POINTER KD1BCT=0 RETURN END SUBROUTINE SOUCIN(I) C+ NAM: SOUCIN VER: 1.0 DAT: 12/08/78 CMP: PDP-11 C C SYS: MC68000 ASM C C ENT: N/A C C RTN: I=0=END OF FILE - I=1=END OF FILE NOT FOUND C C FNC: READ A SOURCE RECORD DEPENDING ON COMPUTER TYPE C CALLS MPUCVC C C* IMPLICIT INTEGER (A-Z) COMMON /A/ ISYM(3000),KARD1(96),ITOKEN(70),TKNSIZ,TKNTYP, & TKNVAL,TKNVA2,JSUC,JPTR,LPTR,NXSYM,KOLUMN,KD1BCT,KD1LNO,JERR, & MNUM,IPASS,IPC2,IPC,IOPC,INS(5),INSL,ISIZ,IADM(7,2),LUOT COMMON /A/ KASH(64),KPAC(15),KPWCT,LENSYM,KCLAS(64) COMMON /A/ NET1(64),NET2(64),NET3(64),NET4(64),NET5(64) COMMON /A/ NBPW,KSYS,IEOT,LSP,JBUF(83),KARD2(80,3),IHB480,IHEX9K COMMON /A/ IA1SHF,KCFF,LUSI,LUDI,LUOO,LLEN,IPLEN DATA IO377/O377/ 9920 FORMAT(100A1) I=1 GO TO 200 135 I=0 C*** RESET LINE COUNTER AND BUFFER POINTER KD1BCT=0 KD1LNO=0 RETURN 200 CONTINUE READ(LUSI,9920,END=135) KARD1 C*** UPDATE LINE COUNT KD1LNO=KD1LNO+1 CC*** REMOVE BLANK FROM UPPER BYTE C DO 300J=1,95 C KARD1(J)=MPUAND(KARD1(J),IO377) C300 CONTINUE CALL CLEAN(KARD1) !A DO IN MACRO-11 C*** SET END OF LINE KD1BCT=95 KARD1(96)=IEOT RETURN END SUBROUTINE FILEOP(IOP) C+ NAM: FILEOP VER: 1.0 DAT 12/08/78 CMP: PDP-11 C C SYS: MACS C C ENT: IOP - 1 = OPEN SI FILE C - 2 = CLOSE SI FILE C - 3 = REWIND SOURCE INPUT FILE FOR SECOND PASS. C - 4 = CLOSE OBJ FILE C - 5 = OPEN OBJ FILE C - 6 = OPEN FILE FOR LIST TO GO TO. C C RTN: N/C C C FNC: THIS ROUTINE IS FOR FILE OPERATIONS ON DIFFERENT C COMPUTERS, SUCH AS OPENING AND CLOSING FILES ETC. C C REV: N/A C CALLS ASSIGN C C* IMPLICIT INTEGER (A-Z) COMMON /A/ ISYM(3000),KARD1(96),ITOKEN(70),TKNSIZ,TKNTYP, & TKNVAL,TKNVA2,JSUC,JPTR,LPTR,NXSYM,KOLUMN,KD1BCT,KD1LNO,JERR, & MNUM,IPASS,IPC2,IPC,IOPC,INS(5),INSL,ISIZ,IADM(7,2),LUOT COMMON /A/ KASH(64),KPAC(15),KPWCT,LENSYM,KCLAS(64) COMMON /A/ NET1(64),NET2(64),NET3(64),NET4(64),NET5(64) COMMON /A/ NBPW,KSYS,IEOT,LSP,JBUF(83),KARD2(80,3),IHB480,IHEX9K COMMON /A/ IA1SHF,KCFF,LUSI,LUDI,LUOO,LLEN,IPLEN COMMON /A/ LIST,ICOL,NEST,LUCI,LULT GO TO (100,200,300,400,500,600),IOP 9910 FORMAT(100A2) 100 CONTINUE WRITE(LULT,9900) 9900 FORMAT(' ENTER SI FILENAME') READ(LUCI,9910) JBUF CALL ASSIGN(LUSI,JBUF,0) RETURN 200 CONTINUE CALL CLOSE(LUSI) RETURN 300 CONTINUE REWIND LUSI RETURN 400 CONTINUE CALL CLOSE(LUOO) RETURN 500 CONTINUE WRITE(LULT,9930) 9930 FORMAT(' ENTER OBJ FILENAME') READ(LUCI,9910) JBUF CALL ASSIGN(LUOO,JBUF,0) RETURN C C*** OPEN FILE FOR LISTING C 600 CONTINUE WRITE(LULT,9950) 9950 FORMAT(' ENTER LISTING FILENAME') READ(LUCI,9910) JBUF LUOT=3 CALL ASSIGN(LUOT,JBUF,0) RETURN END SUBROUTINE REREAD C+ NAM: REREAD VER: 1.0 DAT: 12/08/78 CMP: ALL C C SYS: MC68000 ASM C C ENT: ALL VARIABLES USED ARE IN COMMON C C RTN: N/A C C FNC: THIS ROUTINE INCREMENTS THE @NNN NUMBER IN A MACRO. C C REV: N/A C CALLS NONE. C C* IMPLICIT INTEGER (A-Z) COMMON /A/ ISYM(3000),KARD1(96),ITOKEN(70),TKNSIZ,TKNTYP, & TKNVAL,TKNVA2,JSUC,JPTR,LPTR,NXSYM,KOLUMN,KD1BCT,KD1LNO,JERR, & MNUM,IPASS,IPC2,IPC,IOPC,INS(5),INSL,ISIZ,IADM(7,2),LUOT COMMON /A/ KASH(64),KPAC(15),KPWCT,LENSYM,KCLAS(64) COMMON /A/ NET1(64),NET2(64),NET3(64),NET4(64),NET5(64) COMMON /A/ NBPW,KSYS,IEOT,LSP,JBUF(83),KARD2(80,3),IHB480,IHEX9K COMMON /A/ IA1SHF,KCFF,LUSI,LUDI,LUOO,LLEN,IPLEN C*** 57 = ASCII 39 = 9 C*** IS THE COUNT > 9? IF(KARD2(4,1).EQ.57) GO TO 100 KARD2(4,1)=KARD2(4,1)+1 RETURN 100 KARD2(4,1)=48 IF(KARD2(3,1).EQ.57) GO TO 200 KARD2(3,1)=KARD2(3,1)+1 RETURN 200 KARD2(3,1)=48 KARD2(2,1)=KARD2(2,1)+1 RETURN END SUBROUTINE DEBUG(II) C THIS SUBROUTINE IS FOR DEBUGGING ONLY C IT IS CALLED FROM 'PAGE' AND 'OUTPUT' C DATA I1STP/0/ GO TO (10,100),II 10 CONTINUE I1STP=1 RETURN 100 CONTINUE IF(I1STP.EQ.1) II=1 RETURN END SUBROUTINE PAR C+ NAM: PAR VER: 1.0 DAT: 12/08/78 CMP: ALL C PGM: PARSE ROUITNE C C SYS: MC68000 ASM C C ENT: N/A C RTN: N/A C C FNC: CHECK THE PARSE NET FOR THE TOKEN TYPE AND WHEN FOUND C DOES ITS ACTIONS. C C REV: N/A C CALLS SCN-ACT1-ACT2-ERR C C ERROR NUMBERS CALLED: 203,204,222 C C* IMPLICIT INTEGER (A-Z) COMMON /A/ ISYM(3000),KARD1(96),ITOKEN(70),TKNSIZ,TKNTYP, & TKNVAL,TKNVA2,JSUC,JPTR,LPTR,NXSYM,KOLUMN,KD1BCT,KD1LNO,JERR, & MNUM,IPASS,IPC2,IPC,IOPC,INS(5),INSL,ISIZ,IADM(7,2),LUOT COMMON /A/ KASH(64),KPAC(15),KPWCT,LENSYM,KCLAS(64) C TKNTYP DEFINED ALTERNATE SUCCESSOR ACTION COMMON /A/ NET1(64),NET2(64),NET3(64),NET4(64),NET5(64) COMMON /A/ NBPW,KSYS,IEOT,LSP,JBUF(83),KARD2(80,3),IHB480,IHEX9K COMMON /A/ IA1SHF,KCFF,LUSI,LUDI,LUOO,LLEN,IPLEN C DIMENSION JSTACK(20) C*** SPECIAL ALT,SUC CODE *** DATA NONE/0/ 100 KOLUMN=0 105 CALL SCN 110 JG=1 NPTR=1 LPTR=0 C*** HAVE WE CAME TO END OF FILE? IF(TKNTYP.EQ.0) RETURN 130 CONTINUE IF(NET2(JG).EQ.NONE) GO TO 140 C... *** DEFINED LOWER, PUSH ENTRY INTO STACK JSTACK(NPTR)=JG NPTR=NPTR+1 IF(NPTR.NE.20) GO TO 135 C... *** ERROR - PARSE NET STACK OVERFLOW CALL ERR(222) RETURN 135 CONTINUE JG=NET2(JG) GO TO 130 140 CONTINUE IF(NET1(JG).EQ.TKNTYP) GO TO 170 C--- DEBUG... C IF(IPASS.EQ.0) WRITE(LUOT,881) JG 881 FORMAT('PAR-TST,JG=',I4) 150 CONTINUE JG=NET3(JG) IF(JG) 200,160,130 C*** "NONE" FOUND, GET THE LAST ENTRY ON THE STACK 160 NPTR=NPTR-1 IF(NPTR.NE.0) GO TO 165 C... *** ERROR - SYNTAX ERROR IF(IPASS.GE.0) CALL ERR(204) IOPC=0 RETURN 165 JG=JSTACK(NPTR) GO TO 150 C*** TOKEN TYPE FOUND 170 J5=NET5(JG) IF(J5.EQ.NONE) GO TO 180 IF(IPASS.GE.0) GO TO 175 CALL ACT1(J5) GO TO 180 175 CONTINUE CALL ACT2(J5) 180 IF(KOLUMN.LE.0) GO TO 105 TKNTYP=-1 190 JG=NET4(JG) IF(JG.LT.0) GO TO 200 IF(TKNTYP.LT.0) CALL SCN GO TO 130 C*** "EXIT" FOUND 200 NPTR=NPTR-1 IF(NPTR.NE.0) GO TO 210 C... *** ASSURE PROPER TERMINATION OF OPERAND IF(TKNTYP.EQ.0) RETURN IF(KARD1(KOLUMN).EQ.LSP) RETURN IF(IPASS.GE.0) CALL ERR(203) RETURN 210 JG=JSTACK(NPTR) J5=NET5(JG) IF(J5.EQ.NONE) GO TO 190 IF(IPASS.GE.0) GO TO 220 CALL ACT1(J5) GO TO 190 220 CONTINUE CALL ACT2(J5) GO TO 190 END SUBROUTINE SCN C+ NAM: SCN VER: 1.0 DAT: 12/08/78 CMP: PDP-11 C C SYS: MACS C C ENT: N/A C C RTN: N/A C C FNC: ISSUES READ TO 'SOUCIN' TO GET NEXT SOURCE LINE. C BREAKS IT INTO 'TOKENS'. STACKS MACROS INTO ARRAYS C 'KARD2' AND 'MFLD' FOR PROCESSING. C C NOTE: THIS ROUTINE IS 16-BIT MACHINE DEPENDENT DUE TO BIT C HANDLING IN 'TKNVA2'. IT HOLDS THE 2 MOST SIGNIFICANT C BYTES OF A 32-BIT NUMBER. C C REV: N/A C CALLS OUTPUT-MPUGTC-ERR-SOUCIN-LKP-REREAD-MPUPTC-KLAS-ASCBIN C C ERROR NUMBERS CALLED: 201,202,226 C C* IMPLICIT INTEGER (A-Z) COMMON /A/ ISYM(3000),KARD1(96),ITOKEN(70),TKNSIZ,TKNTYP, & TKNVAL,TKNVA2,JSUC,JPTR,LPTR,NXSYM,KOLUMN,KD1BCT,KD1LNO,JERR, & MNUM,IPASS,IPC2,IPC,IOPC,INS(5),INSL,ISIZ,IADM(7,2),LUOT COMMON /A/ KASH(64),KPAC(15),KPWCT,LENSYM,KCLAS(64) COMMON /A/ NET1(64),NET2(64),NET3(64),NET4(64),NET5(64) COMMON /A/ NBPW,KSYS,IEOT,LSP,JBUF(83),KARD2(80,3),IHB480,IHEX9K COMMON /A/ IA1SHF,KCFF,LUSI,LUDI,LUOO,LLEN,IPLEN C COMMON /A/LIST,ICOL,NEST,LUCI,LULT,MFLD(11,3) C DIMENSION KCTB(140) EQUIVALENCE (MFLD(11,1),MPTR) DATA MDEP/0/ C*** MULTIPLE CHARACTER ACTION ARRAY DATA KCTB/1,2,2,2,2,2,2,2,1,2, & 0,-1,25,24,27,24,25,-1,-1,-1, & 1,2,2,2,3,2,2,3,1,1, & 5,2,4,2,6,2,3,1,1,1, & 1,6,6,6,1,6,6,6,1,1, & 1,2,1,1,2,1,1,6,1,1, & 1,2,1,1,2,1,1,6,1,1, & 1,2,2,2,2,2,1,6,1,1, & 1,2,1,1,7,1,1,6,1,1, & 1,2,1,2,2,2,1,6,1,1, & 1,2,2,2,2,2,2,6,1,1, & 1,6,6,6,2,6,6,3,1,1, & 1,2,6,6,2,6,6,6,1,1, & 1,1,1,1,2,1,1,6,1,1/ DATA LASK/42/,L0/48/ DATA LBS/92/,LAT/64/,LLB/60/,LRB/62/,LCM/44/,LPD/46/ C JCC=0 IF(ICOL.NE.-2) ICOL=KOLUMN IF(KOLUMN.GT.0) GO TO 150 C C*** READ IN THE NEXT SOURCE RECORD C 100 CONTINUE 101 CONTINUE IF(KD1BCT.NE.0) CALL OUTPUT IF(MPTR.EQ.0) GO TO 130 C C*** MACRO EXPANSION N1=1 C*** BLANK BUFFER TO REMOVE LAST INSTRCUTION KD1BCT=1 DO 50 I=1,95 50 KARD1(I)=LSP 102 CONTINUE CALL MPUGTC(KK,ISYM(MPTR),N1) IF(KK.GT.1) GO TO 107 IF(KK.EQ.0) GO TO 1020 C*** MEXIT, ARE WE IN IFXX-ENDC? IF(ICOL.GE.0) GO TO 1020 MPTR=MPTR+1 GO TO 102 C... *** END OF MACRO 1020 MPTR=0 MDEP=MDEP-1 IF(MDEP.EQ.0) GO TO 130 DO 103 J=1,11 MFLD(J,1)=MFLD(J,2) 103 MFLD(J,2)=MFLD(J,3) DO 104 J=1,80 KARD2(J,1)=KARD2(J,2) 104 KARD2(J,2)=KARD2(J,3) GO TO 102 107 N1=N1+1 IF(KK.EQ.LBS) GO TO 108 KARD1(KD1BCT)=KK KD1BCT=KD1BCT+1 IF(KK.NE.IEOT) GO TO 102 C... *** END OF CARD MPTR=MPTR + (N1 + NBPW - 2) / NBPW KD1BCT=KD1BCT - 2 GO TO 140 C... *** INSERT ACTUAL PARAMETER 108 CONTINUE CALL MPUGTC(KK,ISYM(MPTR),N1) N1=N1+1 IF(KK.NE.LAT) GO TO 110 C... *** USE GENERATED LABEL N=1 GO TO 116 110 KK=KK-L0 IF(KK.LT.0) GO TO 112 IF(KK.LE.9) GO TO 114 C... *** ERROR - ILLEGAL MACRO PARAMETER 112 CALL ERR(224) GO TO 102 114 N=MFLD(KK+1,1) IF(N.NE.0) GO TO 116 IF(KK.NE.0) GO TO 102 IF(KARD1(KD1BCT-1).NE.LPD) GO TO 102 KD1BCT=KD1BCT-1 GO TO 102 116 KK=KARD2(N,1) N=N+1 IF(KK.EQ.0) GO TO 102 KARD1(KD1BCT)=KK KD1BCT=KD1BCT+1 GO TO 116 C 130 CALL SOUCIN(I) C*** I = 0 = EOF IF(I.EQ.0) GO TO 295 C... *** COMMENT CARD? IF(KARD1(1).NE.LASK) GO TO 140 135 IOPC=0 CALL OUTPUT GO TO 130 C C*** INITIALIZE FOR A NEW CARD 140 KOLUMN=1 C+++ 16-BIT - TKNVA2 = 1ST 2 BYTES IF MORE THAN 2 IN CONSTANT TKNVA2=0 FLDN=0 DO 145 I=2,5 145 INS(I)=0 JCC=-1 ITOKEN(69)=0 C*** SETUP THE 1ST CHAR OF THE TOKEN 150 TKNSIZ=0 JC=KARD1(KOLUMN) IF(JC.NE.LSP) GO TO 170 C... *** BLANK DELIMITER(S) FLDN=FLDN+1 C@@@ CHECK FOR END OF OPERAND FIELD IF(FLDN.EQ.3) GO TO 295 160 KOLUMN=KOLUMN+1 JC=KARD1(KOLUMN) IF(JC.EQ.LSP) GO TO 160 C*** IS THIS A NULL LINE? IF SO GO PRINT IT. IF(JCC.EQ.-1.AND.JC.EQ.4.AND.FLDN.EQ.1) GO TO 135 C*** GET CHAR CLASS 170 JCC=KLAS(JC) C*** SET THE TOKEN'S TYPE TKNTYP=KCTB(JCC+10) IF(TKNTYP.LT.0) TKNTYP=JC 180 J=KCTB(JCC) GO TO (270,190),J C*** 1ST CHAR OF A MULTIPLE CHARACTER TOKEN 190 J=KCTB(JCC+20) GO TO (220,250,200,260,270,280),J C*** DISCARD CHARACTER AND CONTINUE 200 KOLUMN=KOLUMN+1 C*** CHARACTER ACTION FOR NEXT CHARACTER OF MULTI-CHAR TOKEN JC=KARD1(KOLUMN) JCX=KLAS(JC)*10+30+JCC J=KCTB(JCX) GO TO (220,250,200,260,270,280,230),J C*** CHARACTER ACTION ROUTINE. C*** ERROR '201' ILLEGAL CHARACTER SCANNED 220 IF(IPASS.GE.0) CALL ERR(201) GO TO 295 C*** ' SCANNED, INCLUDE IT IF THERE ARE 2 230 IF(JC.NE.KARD1(KOLUMN+1)) GO TO 270 C*** SKIP THE NEXT CHAR IN THE RECORD (@ OR ') KOLUMN=KOLUMN+1 C*** ADD CHARACTER TO TOKEN AND CONTINUE. 250 TKNSIZ=TKNSIZ+1 IF(TKNSIZ.LE.68) GO TO 255 C... *** ERROR '202' TOKEN OVERFLOW (OVER 70 CHARACTERS LONG) IF(IPASS.GE.0) CALL ERR(202) GO TO 295 255 ITOKEN(TKNSIZ)=JC GO TO 200 C*** ADD CHARACTERS TO TOKEN AND STOP. 260 TKNSIZ=TKNSIZ+1 ITOKEN(TKNSIZ)=JC C*** DISCARD CHARACTER AND STOP 270 KOLUMN=KOLUMN+1 C*** LEAVE CHARACTER IN STRING AND STOP 280 CONTINUE C*** LAST CHARACTER OF A TOKEN, DO ITS ACTION 290 J=KCTB(JCC+30) GO TO (900,300,700,800,295,600),J C*** END OF CARD RETURN 295 TKNTYP=0 RETURN C C*** TOKEN ACTION ROUTINES C C*** VARIABLE NAME FOUND *** C... *** STATEMENT LABEL? 300 IF(KARD1(KOLUMN).NE.58) GO TO 305 C*** LABEL: KOLUMN=KOLUMN + 1 FLDN=0 305 IF(FLDN.NE.0) GO TO 310 C... *** INSIDE A MACRO DEFINITION? IF(ICOL.LT.0) GO TO 150 TKNTYP=29 GO TO 900 C... *** OPCODE FIELD? 310 IF(FLDN.NE.1) GO TO 390 C... *** OPCODE FIELD - LOOKUP THE OPCODE *** CALL LKP(-1,JSUC,JPTR) IF(JSUC.GT.0) GO TO 320 C... *** UNDEFINED OP CODE IF(ICOL.EQ.-2) GO TO 100 GO TO 900 320 IOPC=ISYM(JPTR) INS(1)=ISYM(JPTR+1) C... *** LOOKING FOR ENDC? IF(ICOL.NE.-2) GO TO 330 INSL=0 IF(IOPC.EQ.18) NEST=NEST+1 IF(IOPC.NE.1) GO TO 100 IF(INS(1).NE.2) GO TO 100 NEST=NEST-1 IF(NEST.GE.0) GO TO 100 ICOL=0 NEST=0 GO TO 100 330 TKNTYP=30 C... *** TEST FOR MACRO CALL IF(IOPC.NE.0) GO TO 900 C... *** INSIDE A MACRO DEFINITION? IF(ICOL.LT.0) GO TO 900 C C... *** MACRO CALL *** - ASSURE NOT TOO DEEP IF(MDEP.EQ.0) GO TO 351 IF(MDEP.NE.3) GO TO 340 C... *** ERROR - NESTED TOO DEEP CALL ERR(226) GO TO 900 340 DO 342 J=1,11 MFLD(J,3)=MFLD(J,2) 342 MFLD(J,2)=MFLD(J,1) DO 344 J=1,80 KARD2(J,3)=KARD2(J,2) 344 KARD2(J,2)=KARD2(J,1) 351 MDEP=MDEP+1 IP=0 MPTR=JPTR+1 C... *** INCREASE THE GENERATED MACRO NUMBER MNUM=MNUM+1 CALL REREAD C*** INITIALIZE THE FIELD POINTERS DO 352 NF=1,10 352 MFLD(NF,1)=0 N2=6 NF=1 C... *** LOOK FOR OPCODE.SIZE IF(KARD1(KOLUMN).NE.LPD) GO TO 354 MFLD(1,1)=N2 KOLUMN=KOLUMN+1 353 KK=KARD1(KOLUMN) KOLUMN=KOLUMN+1 IF(KK.EQ.LSP) KK=0 KARD2(N2,1)=KK N2=N2+1 IF(KK.EQ.IEOT) GO TO 380 IF(KK.NE.0) GO TO 353 C... *** SKIP TO THE START OF THE OPERAND FIELD 354 DO 355 KOLUMN=KOLUMN,KD1BCT IF(KARD1(KOLUMN).NE.LSP) GO TO 358 355 CONTINUE RETURN C*** MOVE THE OPERAND TO KARD2 AND LOOK FOR COMMAS 358 NF=NF+1 IF(NF.EQ.11) GO TO 101 MFLD(NF,1)=N2 360 KK=KARD1(KOLUMN) KOLUMN=KOLUMN+1 IF(IP.EQ.0) GO TO 365 IF(KK.NE.LRB) GO TO 370 IP=IP-1 GO TO 360 C... ** IP EQ 0 365 IF(KK.EQ.LSP) KK=IEOT IF(KK.EQ.LCM) KK=0 IF(KK.NE.LLB) GO TO 370 IP=IP+1 GO TO 360 C... ** NOT < OR > 370 KARD2(N2,1)=KK N2=N2+1 IF(KK.EQ.0) GO TO 358 IF(KK.NE.4) GO TO 360 C... *** END OF CARD 380 KARD2(N2-1,1)=0 GO TO 101 C C... *** REGISTER NAME? 390 CALL LKP(1,JSUC,JPTR) IF(JSUC.LE.0) GO TO 900 IF(ISYM(JPTR).NE.2) GO TO 900 TKNTYP=28 GO TO 900 C C*** CONSECUTIVE ', PUT IN A BLANK 600 IF(TKNSIZ.GT.0) GO TO 605 TKNSIZ=1 ITOKEN(1)=32 605 CONTINUE IF(IOPC.EQ.4) GO TO 625 J=2 IF(IPASS.EQ.0) J=64 I=ISIZ C... *** LEAVE AS A STRING FOR DC.B IF(IOPC.NE.5) GO TO 610 C... *** DC - LEAVE AS STRING IF DC.B IF(TKNSIZ.EQ.1) GO TO 610 IF(ISIZ.LE.1) RETURN 610 CONTINUE IF(I.EQ.0.AND.TKNSIZ.NE.1) I=J IF(I.EQ.J.AND.TKNSIZ.GT.2) I=I+J TKNVAL=0 NB=5-I/J*2 IF(NB.EQ.5) NB=4 DO 620 J=1,TKNSIZ CALL MPUPTC(ITOKEN(J),TKNVAL,NB) 620 NB=NB+1 TKNTYP=25 C*** TKNVAL & TKNVA2 ARE REVERSED IN MEMORY HERE AS COMPARED TO 6800 C*** REVERSE THEM. J=TKNVAL TKNVAL=TKNVA2 TKNVA2=J GO TO 900 625 IADM(1,1)= -1 RETURN C*** BINARY CONVERSION FROM CHARACTER STRING 700 CONTINUE TKNVAL=0 CALL ASCBIN GO TO 900 C C*** HEXADECIMAL CONVERSION FROM CHARACTER STRING 800 TKNVAL=0 DO 850 J=2,TKNSIZ JC=ITOKEN(J) I=JC-L0 IF (I.GT.9) I=I-7 C+++ 16-BIT - PUT MORE THAN 2 BYTES IN TKNVA2 IF(J.LT.6) GO TO 840 TKNVA2=ISHFT(TKNVA2,4) TKNVA2=TKNVA2 + ISHFT(TKNVAL,-12) 840 CONTINUE TKNVAL=ISHFT(TKNVAL,4) + I C C*** EXIT FROM THE SCAN SUBROUTINE... 850 CONTINUE 900 CONTINUE RETURN END FUNCTION KLAS(KL) C+ NAM: KLAS VER: 1.0 DAT: 12/08/78 CMP: ALL C C SYS: MACS C C ENT: KL - CHARACTER FROM INPUT BUFFER 'KARD1'. C C RTN: KL - N/C C KLAS - SET TO CLASS C C FNC: DETERMINE THE CLASS OF A CHARACTER FROM THE INPUT C BUFFER AND RETURN IT. C C REV: N/A C* IMPLICIT INTEGER (A-Z) COMMON /A/ ISYM(3000),KARD1(96),ITOKEN(70),TKNSIZ,TKNTYP, & TKNVAL,TKNVA2,JSUC,JPTR,LPTR,NXSYM,KOLUMN,KD1BCT,KD1LNO,JERR, & MNUM,IPASS,IPC2,IPC,IOPC,INS(5),INSL,ISIZ,IADM(7,2),LUOT COMMON /A/ KASH(64),KPAC(15),KPWCT,LENSYM,KCLAS(64) COMMON /A/ NET1(64),NET2(64),NET3(64),NET4(64),NET5(64) COMMON /A/ NBPW,KSYS,IEOT,LSP,JBUF(83),KARD2(80,3),IHB480,IHEX9K COMMON /A/ IA1SHF,KCFF,LUSI,LUDI,LUOO,LLEN,IPLEN C*** CHARACTER SET BASE OFFSET DATA JCOFS/31/ JL=KL-JCOFS C*** 00-1F ARE EOT'S IF(JL.GT.0) GO TO 925 KLAS=1 RETURN C*** SPECIAL CHARACTERS 925 IF(JL.LE.64) GO TO 950 KLAS=9 RETURN 950 KLAS=KCLAS(JL) RETURN END SUBROUTINE LKP(NTYP,NSUC,NPTR) C+ NAM: LKP VER: 1.0 DAT: 12/08/78 CMP: ALL C C SYS: MC68000 ASM C C ENT: NTYP - TOKEN TYPE (-1, 0 OR 1 SEE STF) C NSUC - N/A C NPTR - N/A C C RTN: NTYP - N/C C NSUC - -1=> NO ENTRY IN THE HASH TABLE C - 0=> ENTRY IN HASH, BUT NO SYMBOL IN THE TABLE C - >0=> ENTRY FOUND, INDEX TO SYMBOL ENTRY IN SYM C NPTR - NSUC= -1=> INDEX TO HASH TABLE C - NSUC= 0=> POINTER TO THE PREVIOUS LINK IN SYM C - NSUC= >0=> INDEX TO THE DATA ENTRY OF THE SYMBOL C C FNC: PACK THE TOKEN INTO COMPUTER WORDS AND SEARCH THE HASH C AND SYMBOL TABLE FOR THE SYMBOL. C C REV: N/A C CALLS MPUPTC-MPUAND C C* IMPLICIT INTEGER (A-Z) COMMON /A/ ISYM(3000),KARD1(96),ITOKEN(70),TKNSIZ,TKNTYP, & TKNVAL,TKNVA2,JSUC,JPTR,LPTR,NXSYM,KOLUMN,KD1BCT,KD1LNO,JERR, & MNUM,IPASS,IPC2,IPC,IOPC,INS(5),INSL,ISIZ,IADM(7,2),LUOT COMMON /A/ KASH(64),KPAC(15),KPWCT,LENSYM,KCLAS(64) COMMON /A/ NET1(64),NET2(64),NET3(64),NET4(64),NET5(64) COMMON /A/ NBPW,KSYS,IEOT,LSP,JBUF(83),KARD2(80,3),IHB480,IHEX9K COMMON /A/ IA1SHF,KCFF,LUSI,LUDI,LUOO,LLEN,IPLEN C EQUIVALENCE(ITOKEN(70),ITYP1) C*** TKNSIZ//(NUMBER BYTES PER WORD *** KPWCT=(TKNSIZ+NBPW-1) / NBPW KPAC(KPWCT)=0 NTYP1=MPUAND(NTYP,255)+ISHFT(KPWCT,8) NPTR=0 NSUC=-1 DO 100 J=1,TKNSIZ NPTR=NPTR+ITOKEN(J) J1=J 100 CALL MPUPTC(ITOKEN(J),KPAC,J1) NPTR=MPUAND(NPTR,63)+1 JP=KASH(NPTR) 110 IF(JP.EQ.0) RETURN IF(ISYM(JP+1).EQ.NTYP1) GO TO 130 120 NSUC=0 NPTR=JP JP=ISYM(JP+2) GO TO 110 130 JPP = JP + 2 DO 140 J=1,KPWCT JPP=JPP + 1 IF(ISYM(JPP).NE.KPAC(J)) GO TO 120 140 CONTINUE NSUC=JP NPTR=JP+KPWCT+3 RETURN END SUBROUTINE STF(KSUC,KPTR,KSIZ,KTYP) C NAM: STF VER: 1.0 DAT: 12/08/78 CMP: ALL C C SYS: MC68000 ASM C C ENT: KSUC - -1=> NO ENTRY IN HASH TABLE C - 0=> ENTRY IN HASH, BUT CANNOT FIND THE SYMBOL C - >0=> SYMBOL FOUND, INDEX TO THE SYMBOL ENTRY C KPTR - KSUC= -1=> INDEX TO THE HASH TABLE C - KSUC= 0=> POINTER TO THE PREVIOUS LINK C - KSUC= >0=> INDEX TO THE DATA ENTRY OF THE SYMBOL C KSIZ - REQUIRED SIZE OF THE DATA ENTRY C KTYP - -1=> DICTIONARY SYMBOL C - 0=> CONSTANT SYMBOL C - 1=> VARIABLE SYMBOL C C RTN: KSUC - INDEX TO THE SYMBOL ENTRY C KPTR - INDEX TO THE SYMBOL'S DATA ENTRY C KSIZ - N/C C KTYP - N/C C C FNC: STORE THE SYMBOL IN 'KPAC' INTO THE SYMBOL TABLE. C C REV: N/A C CALLS ERR C C ERROR NUMBERS CALLED: 221 C* IMPLICIT INTEGER (A-Z) COMMON /A/ ISYM(3000),KARD1(96),ITOKEN(70),TKNSIZ,TKNTYP, & TKNVAL,TKNVA2,JSUC,JPTR,LPTR,NXSYM,KOLUMN,KD1BCT,KD1LNO,JERR, & MNUM,IPASS,IPC2,IPC,IOPC,INS(5),INSL,ISIZ,IADM(7,2),LUOT COMMON /A/ KASH(64),KPAC(15),KPWCT,LENSYM,KCLAS(64) COMMON /A/ NET1(64),NET2(64),NET3(64),NET4(64),NET5(64) COMMON /A/ NBPW,KSYS,IEOT,LSP,JBUF(83),KARD2(80,3),IHB480,IHEX9K COMMON /A/ IA1SHF,KCFF,LUSI,LUDI,LUOO,LLEN,IPLEN C EQUIVALENCE(ITOKEN(70),KTYP1) K = 0 IF (KSUC .LE. 0) K = KPWCT + 3 260 IF (KSUC) 200,210,250 200 KASH(KPTR)=NXSYM GO TO 220 210 ISYM(KPTR+2)=NXSYM 220 ISYM(NXSYM)=0 ISYM(NXSYM+1)=MPUAND(KTYP,255)+ISHFT(KPWCT,8) ISYM(NXSYM+2)=0 JCX = NXSYM + 2 DO 230 J=1,KPWCT JCX= JCX + 1 230 ISYM(JCX)=KPAC(J) KSUC=NXSYM IF (NXSYM + K + KSIZ - 1 .LE. LENSYM) GO TO 250 CALL ERR(221) C*** SET POINTERS TO USE SCRATCH AREA KPTR=NXSYM+K RETURN 250 KPTR=NXSYM+ K NXSYM=KPTR+KSIZ RETURN END SUBROUTINE ACT1(KMD) C+ NAM: ACT1 VER: 1.0 DAT: 12/08/78 CMP: 16-BIT C C SYS: MACS C C ENT: KMD - EQUALS ACTION TO BE TAKEN UPON ENTRY AS DETERMINED C FROM PARSE TABLE. C C RTN: KMD - N/C C C FNC: P A S S O N E A C T I O N S C ------------------------------ C PERFORM THE ACTIONS FOR THE DIFFERENT "TOKENS" C ENCOUNTERED DURING THE STATEMENT SCAN. C IT SETS ADDRESS MODE IN 'IADM' TABLE, ENTERS EXPRESSION C IN EXPRESSION TABLE, ENTERS NEW SYMBOL IN SYMBOL TABLE. C --------------------------------------------- C THIS SUBROUTINE IS A MODIFICATION OF "ACT2" C THERE MUST NOT BE ANY DIFFERENCE BETWEEN ACT1 C AND ACT2 THAT COULD AFFECT THE ASSUMED SIZE OF C THE INSTRUCTIONS. C ---------------------------------------------- C C THIS ROUTINE IS 16-BIT DEPENDENT DUE TO THE CHECK ON C 'TKNVA2' FOR THE 2 MOST SIGNIFICANT BYTES OF A 32-BIT #. C INTEGER CONSTANT 192=$C0, 128=$80($=HEX). C NOTE ALSO INTEGER CONSTANTS 192 & 64 ARE SPECIAL HEX C VALUES $C0 AND $40. C C REV: N/A C C ERROR NUMBERS CALLED: 221,225 C CALLS ERR-LKP-STF-SCN-MPUPTC-BUILD1-EXP C C* IMPLICIT INTEGER (A-Z) COMMON /A/ ISYM(3000),KARD1(96),ITOKEN(70),TKNSIZ,TKNTYP, & TKNVAL,TKNVA2,JSUC,JPTR,LPTR,NXSYM,KOLUMN,KD1BCT,KD1LNO,JERR, & MNUM,IPASS,IPC2,IPC,IOPC,INS(5),INSL,ISIZ,IADM(7,2),LUOT COMMON /A/ KASH(64),KPAC(15),KPWCT,LENSYM,KCLAS(64) COMMON /A/ NET1(64),NET2(64),NET3(64),NET4(64),NET5(64) COMMON /A/ NBPW,KSYS,IEOT,LSP,JBUF(83),KARD2(80,3),IHB480,IHEX9K COMMON /A/ IA1SHF,KCFF,LUSI,LUDI,LUOO,LLEN,IPLEN COMMON /A/ LIST,ICOL,NEST DIMENSION NSZ(40),MREL(40) EQUIVALENCE (IADM(4,1),SYMTYP),(IADM(5,1),LFRF) DATA LB/66/,LW/87/,LL/76/,LAP/39/ DATA LS/83/ DATA Z8000/O100000/ C*** OPCODE SIZES 01 02 03 04 05 06 07 08 09 10 C*** 01-10 DATA NSZ/ 0, 2, 0,-1,-1, 2, 2, 2,-1,-1, & -1,-1,-1,-1, 2,-1,-1,-1, 0,-1, & -1,-1,-1,-1, 2,-1, 2, 2, 2,-1, & 0, 2, 2,-1,-1,-1,-1,-1,-1, 0/ C C*** USE PC REL? 01 02 03 04 05 06 07 08 09 10 C*** 01-10 DATA MREL/ 0, 0, 0, 0,-1, 0, 0, 0, 1, 1, & 1, 1,-1, 1, 1, 1, 1, 0, 0, 1, & 1, 1, 1, 1, 0, 0, 0, 0, 0, 1, & 0,-1, 0, 1, 0, 1, 1, 1, 1, 0/ GO TO(100,200,300,400,500,600,700,800,800, & 1000,1100,1200,1300,1400,1500,1600,1700),KMD C*** EXPRESSION ACTION CALL EXP(KMD) RETURN C C*** STATEMENT LABEL C 100 CALL LKP(1,LSUC,LPTR) IF(LSUC.LE.0) GO TO 105 IF(ISYM(LPTR).EQ.0) GO TO 110 C*** ERROR - MULTIPLE DEFINED SYMBOL ISYM(LPTR)=IADM(7,1) + 192 GO TO 120 105 CALL STF(LSUC,LPTR,2,1) C*** *** FORWARD REFERENCE 110 ISYM(LPTR)=IADM(7,1) + 64 ISYM(LPTR+1)=IPC C+++ 16-BIT - PUT M.S.B. OF P-COUNT IN SYM TABLE. ISYM(LSUC)=IPC2 C*** SAVE FOR BUILD1 120 ITOKEN(69)=LSUC RETURN C C*** OPCODE C 200 KSYS=1 IF(JSUC.GT.0) GO TO 210 C*** ERROR - UNDEFINED OP-CODE KOLUMN=0 RETURN C*** *** MACRO DEFINITION? 210 IF(IOPC.GE.0) GO TO 260 IQ=0 C*** ASSURE OPCODE IS MACRO IF(INS(1).NE.0) CALL ERR(225) C*** TABLE THE MACRO DEFINITION ISYM(LPTR)=0 C*** MAKE FIRST WORD NON-ZERO FOR SYM TABLE ROUTINE 'PRSYM' ISYM(LSUC)=1 C*** MAKE TYPE 255 & KEEP # OF WORDS IN NAME ISYM(LSUC+1)=ISYM(LSUC+1)+254 C*** *** CALL FOR OPCODE FIELD 230 KOLUMN=-1 CALL SCN C*** *** FIND # FIELDS AND CHECK FOR ENDM NF=3 IF(TKNTYP.NE.30) GO TO 234 IF(IOPC.GT.0) GO TO 232 IF(IOPC.EQ.0) GO TO 234 IF(INS(1).EQ.0) CALL ERR(225) IF(INS(1).NE.1) GO TO 231 C*** ENDM ISYM(LPTR+1)=0 KOLUMN=0 RETURN C C*** MEXIT 231 LPTR=LPTR+1 CALL MPUPTC(1,ISYM(LPTR),1) GO TO 230 232 IF(IOPC.LT.4) NF=2 C*** *** PACK THE CARD INTO SYM 234 N1=1 N2=1 236 KK=KARD1(N1) N1=N1+1 238 CALL MPUPTC(KK,ISYM(LPTR+1),N2) N2=N2+1 IF(KK.NE.LAP) GO TO 240 C*** *** QUOTE FOUND IQ=IQ+1 IF(IQ.EQ.2) IQ=0 240 IF(IQ.NE.0) GO TO 244 IF(KK.NE.LSP) GO TO 244 NF=NF-1 IF(NF.NE.0) GO TO 242 KK=4 GO TO 238 242 KK=KARD1(N1) IF(KK.NE.LSP) GO TO 244 N1=N1+1 GO TO 242 244 IF(KK.NE.4) GO TO 236 C*** *** END OF CARD NW=(N2 + NBPW -2) / NBPW LPTR=LPTR+NW NXSYM=NXSYM+NW IF(NXSYM.LE.LENSYM-100) GO TO 230 C*** *** SYMBOL TABLE OVERFLOW CALL ERR(221) RETURN C*** *** LOOKUP TENTATIVE INST. LENGTH 260 IF(IOPC.LE.0) RETURN INSL=NSZ(IOPC) ISIZ=2 IADM(5,2)=0 LFRF=0 IADM(1,1)=0 IF(INSL.GE.0) GO TO 265 C*** *** VARIABLE SIZE CALL EXP(21) RETURN C*** *** FIXED SIZE 265 KOLUMN=0 RETURN C C*** DATA SIZE C 300 IF(ITOKEN(1).EQ.LB) ISIZ=0 IF(ITOKEN(1).EQ.LL) ISIZ=4 IF(ITOKEN(1).EQ.LS) ISIZ=0 RETURN C C*** COMMA STARTING FIELD-2 OPERAND *** C C 400 CALL EXP(21) IF(IOPC.NE.4) GO TO 410 C*** DC - FORCE DATA OUT CALL BUILD1 RETURN 410 IF(IOPC.GE.19) GO TO 420 C*** *** OPCODE REQUIRES ONLY ONE OPERAND KOLUMN=0 RETURN 420 IF(KSYS.EQ.2) KOLUMN=0 KSYS=2 TKNVA2=0 RETURN C C*** OPERAND - REGISTER C 500 IADM(1,KSYS)=0 C*** *** ADDR REGISTER? IF(ISYM(JPTR+1).GT.7) IADM(1,KSYS)=8 RETURN C C*** REGISTER INDIRECT MODE *** C 600 CONTINUE IADM(1,KSYS)=16 RETURN C C*** POST INCREMENT *** C 700 CONTINUE IADM(1,KSYS)=24 RETURN C C*** PRE DECREMENT *** C 800 CONTINUE IADM(1,KSYS)=32 RETURN C C*** IMMEDIATE OPERAND *** C C 1000 CALL EXP(37) KK=ISIZ IF(KK.EQ.0) KK=2 IADM(1,KSYS)=60 IF(INSL.GT.0) GO TO 1010 C*** *** FIRST FIELD INSL=2 1010 INS(3)=TKNVAL C+++ 16-BIT - MOST SIGNIFICANT BYTE OF P-COUNT INS(2)=TKNVA2 INSL=INSL + KK RETURN C C*** DISPLACEMENT *** C 1100 IADM(1,KSYS)=56 CALL EXP(37) C K=2 IF(IADM(5,KSYS).EQ.0) GO TO 1105 C*** DEFAULT FORWARD REFERENCES TO 2 OR 4 BYTES IF(IADM(7,2).EQ.1) K=4 GO TO 1110 C+++ 16-BIT 1105 IF(TKNVA2.EQ.-1) GO TO 1110 IF(TKNVA2.NE.0) K=4 C*** ADDR >$7FFF IS LONG ADDR. IF(MPUAND(TKNVAL,Z8000).NE.0.AND.TKNVA2.EQ.0) K=4 1110 IF(INSL.LT.0) GO TO 1120 C*** *** SECOND FIELD INSL=INSL + K 1115 IF(K.EQ.4) IADM(1,KSYS)=57 RETURN C*** *** FIRST FIELD 1120 INSL=K + 2 INS(3)=TKNVAL C+++ 16-BIT - MOST SIGNIFICANT BYTE OF P-COUNT INS(2)=TKNVA2 GO TO 1115 C C*** REGISTER FOR 3(A1) ADDRESSING MODE *** C 1200 CONTINUE C*** TEST FOR ORG.L ALREADY SET ADDR MODE IF(IADM(1,KSYS).EQ.57) INSL=INSL-2 RETURN C C*** .L FOR 3(A1.L) ADDRESSING MODE *** C 1300 RETURN C C*** SECOND REGISTER FOR 3(A1,A2) ADDRESSING MODE *** C 1400 RETURN C C*** SECOND REGISTER OF R1-R2 FOR LDM,STM C 1500 RETURN C C*** 'STRING' GT 4 BYTES (DC ONLY) C 1600 INS(3)=TKNSIZ IADM(1,1)=-1 RETURN C C*** CONSTANT OR VARIABLE OPERAND *** C 1700 CONTINUE IADM(4,KSYS)=0 C IF(TKNTYP.EQ.24) GO TO 1710 C*** CONSTANT OPERAND IF(TKNTYP.NE.42) GO TO 1730 C*** ASTERISK IADM(4,KSYS)=IADM(7,1) TKNVAL=IPC TKNVA2=IPC2 GO TO 1730 C*** DEFINED PREVIOUSLY? 1710 IF(JSUC.GT.0) GO TO 1720 C*** NEW DEFINITION, PUT IN SY. CALL STF(JSUC,JPTR,2,1) ISYM(JPTR)=0 ISYM(JPTR+1)= 0 1720 IF(MPUAND(ISYM(JPTR),192).EQ.0) IADM(5,KSYS)=1 TKNVAL=ISYM(JPTR+1) TKNVA2=ISYM(JSUC) C*** *** GIVE OPERAND TO EXP 1730 CALL EXP(22) RETURN END SUBROUTINE BUILD1 C+ NAM: BUILD1 VER: 10.0 DAT: 12/08/78 CMP: 16-BIT C C SYS: MACS C C ENT: N/A C C RTN: N/A C C FNC: BUILD THE INSTRUCTION FOR PASS ONE C USES INFORMATION IN TABLE 'IADM', AND 'INS' ARRAY. C C REV: N/A C CALLS MPUAND-ERR-MOD2-IABS-PAGE C C ERROR NUMBERS CALLED: 223,229,239 C* IMPLICIT INTEGER (A-Z) COMMON /A/ ISYM(3000),KARD1(96),ITOKEN(70),TKNSIZ,TKNTYP, & TKNVAL,TKNVA2,JSUC,JPTR,LPTR,NXSYM,KOLUMN,KD1BCT,KD1LNO,JERR, & MNUM,IPASS,IPC2,IPC,IOPC,INS(5),INSL,ISIZ,IADM(7,2),LUOT COMMON /A/ KASH(64),KPAC(15),KPWCT,LENSYM,KCLAS(64) COMMON /A/ NET1(64),NET2(64),NET3(64),NET4(64),NET5(64) COMMON /A/ NBPW,KSYS,IEOT,LSP,JBUF(83),KARD2(80,3),IHB480,IHEX9K COMMON /A/ IA1SHF,KCFF,LUSI,LUDI,LUOO,LLEN,PLEN COMMON /A/ LIST,ICOL,NEST,LUCI,LULT,MFLD(11,3),IOBJ,LLENSW,NOP COMMON /A/ NXSYM1 DIMENSION IMCD(6),NIMM(40) EQUIVALENCE (IADM(4,1),SYMTYP) DATA MASK2/0/,Z7000/O70000/,Z8000/O100000/,Z7100/O70400/ DATA ZB001/O130001/,ZD001/O150001/,ZD002/O150002/ DATA Z9001/O110001/,Z9002/O110002/,ZF000/O170000/ C ORI SUBI EORI CMPI ANDI ADDI DATA IMCD/ 0000, 1024, 2560, 3072, 512, 1536/ DATA NIMM/ & 0,0,0,0,0,1,1,1,1,1,0,0,0,1,1,0,0,0,0,1, & 1,1,1,0,0,0,0,1,1,1,1,1,0,1,1,1,1,1,1,0/ C IF(ISIZ.EQ.0) ISIZ=1 C C*** PERFORM ACTIONS FOR THE OPCODE CLASS IF(IOPC.GT.0) GO TO 1620 INSL=0 RETURN 1620 IF(INSL.LT.0) INSL=2 GO TO(100, 200,9223,400,500, 600, 700, 800, 900, 1000, & 1100,1200,1300,1400,1500,1600,1700,1800,1900),IOPC J=IOPC-19 GO TO(2000,2100,2200,2300,2400,2500,2600,2700,2800,2900,3000, & 9223,3200,9223,3400,3500,3600,3700,3800),J J=J-19 GO TO(3900),J GO TO 9223 C C*** PSEUDO OPS WITHOUT OPERANDS 100 INS1=INS(1) GO TO(110,120,120,130,140,150,170,180,120,120,120,197),INS1 C... *** END 110 IPASS=0 IPC2=0 IPC=0 MNUM=0 C*** SLEW & PRINT HEADER IF PASS 1 ERRORS CALL PAGE(82) KD1LNO=0 REWIND LUSI C*** RESET TO START OF PASS 1 LIST=1 RETURN 120 RETURN C*** LIST *** 130 LIST=1 RETURN C C*** NOLIST *** 140 LIST=0 RETURN C*** TTL 150 CONTINUE RETURN C*** NOPAGE 170 CONTINUE NOP=0 RETURN C C*** NOOBJ - NO OBJECT OUTPUT C 180 CONTINUE IOBJ=0 RETURN 197 CONTINUE C*** MASK2 DIRECTIVE MASK2=1 TKNSIZ=4 C*** FIND ROOM FOR 'DCNT' ITOKEN(1)=68 ITOKEN(2)=67 ITOKEN(3)=78 ITOKEN(4)=84 CALL LKP(-1,LSUC,LPTR) C*** PUT 'DCNT' IN SYMM TABLE CALL STF(LSUC,LPTR,2,-1) ISYM(LPTR)=32 C*** SET OPCODE ISYM(LPTR+1)=Z7100 NXSYM1=NXSYM C*** FIND 'DBRA' ITOKEN(1)=68 ITOKEN(2)=66 ITOKEN(3)=82 ITOKEN(4)=65 CALL LKP(-1,LSUC,LPTR) IF(LSUC.LE.0) GO TO 199 DO 198 I=1,16 ISYM(LSUC+3)=LSP LSUC=LSUC+ISHFT(ISYM(LSUC+1),-8)+5 198 CONTINUE C*** CHANGE OPCODE OF 'STOP' TO 2 ITOKEN(1)=83 ITOKEN(2)=84 ITOKEN(3)=79 ITOKEN(4)=80 CALL LKP(-1,LSUC,LPTR) IF(LSUC.LE.0) GO TO 199 ISYM(LPTR)=2 RETURN 9900 FORMAT(' SYMBOL DBRA NOT FOUND') 199 WRITE(LULT,9900) RETURN C C C*** OP CODES WITHOUT OPERANDS 200 RETURN C 400 INSL=0 C C*** DC IF(IADM(1,1).GE.0) GO TO 410 C*** 'STRING' KK=INS(3) I=MOD(INS(3),ISIZ) IF(I.NE.0) KK=KK-I+ISIZ GO TO 545 410 KK=ISIZ GO TO 545 C C*** PSEUDO OPS WITH OPERANDS 500 INSL=0 INS1=INS(1) GO TO(510,520,520,540,550,560,570),INS1 GO TO 9223 C... *** ORG 510 IPC=INS(3) C+++ 16-BIT - GET MOST SIGNIFICANT BYTE IPC2=INS(2) IADM(7,1)=0 IADM(7,2)=0 IF(ISIZ.EQ.4) IADM(7,2)=1 C*** FORWARD REF ILLEGAL IF(IADM(5,1).EQ.1) GO TO 9240 RETURN C... *** EQU 520 IF(LPTR.GT.0) GO TO 522 C... *** ERROR - NO LABEL ON STATEMENT CALL ERR(229) RETURN 522 ISYM(LPTR)=MPUAND(ISYM(LPTR),192) + SYMTYP ISYM(LPTR+1)=INS(3) IF(INS(1).EQ.2) GO TO 525 C... *** 'SET' DIRECTIVE, ALLOW REDEFINITION ISYM(LPTR)= SYMTYP + 64 C+++ 16 BIT PUT M.S.B. OF ADDRESS IN SYM TABLE. C*** LSUC HAS BEEN SAVE IN 'ACT1' 525 KK=ITOKEN(69) ISYM(KK)=INS(2) RETURN C C*** DS C 540 KK=INS(3)*ISIZ C*** CHECK FOR A FORWARD REFERERENCE WHICH IS ILLEGAL IF(IADM(5,1).EQ.1) GO TO 9240 545 LPTR=0 C*** IPC=IPC + KK CALL ADD(IPC2,IPC,0,KK) IF(ISIZ.NE.1) CALL MOD2 RETURN C C*** RORG C 550 IPC=INS(3) C+++ 16-BIT - GET MOST SIGNIFICANT BYTE IPC2=INS(2) IADM(7,1)=1 IADM(7,2)=0 RETURN C C*** FAIL C 560 RETURN C C*** SPC *** C 570 CONTINUE RETURN C C*** LINK/UNLK - ADDRESS REGISTER TO BITS 2-0 C 600 CONTINUE C*** CHECK FOR LINK - 20048 = $4E50 = LINK IF(INS(1).EQ.20048) INSL=4 RETURN C C*** SWAP - DATA REGISTER TO BITS 2-0 C 700 RETURN C C*** TRAP - ESTABLISH DISPLACEMENT IN BITS 3-0 C 800 RETURN C C*** ABS/CLR/NEG/NOT/TST - BUILD EA C 900 RETURN C C*** NBCD C 1000 RETURN C C*** PEA C 1100 RETURN C C*** JSR,JMP C 1200 CONTINUE RETURN C C*** BCC C 1300 CONTINUE IF(INSL.EQ.6) INSL=4 IF(ISIZ.NE.1) GO TO 1310 C*** FORCE SHORT FORM INSL=2 RETURN 1310 IF(INS(3).EQ.-1) RETURN C*** IS IT A FORWARD REFERENCE? IF(IADM(5,1).EQ.1) RETURN C... *** BACKWARD REFERENCE IOFS=INS(3)-IPC-2 IF(IABS(IOFS).LE.127) INSL=2 RETURN C C*** NEGX C 1400 RETURN C C*** EXT C 1500 RETURN C C*** TAS C 1600 RETURN C C*** SCC 1700 RETURN C C*** CONDITIONAL ASSEMBLY C 1800 INSL=0 INS1=INS(1) GO TO(1810,1820),INS1 C... *** EQ C 1810 IF(INS(3).NE.0) GO TO 1890 RETURN C... *** NE 1820 IF(INS(3).EQ.0) GO TO 1890 RETURN C... *** SKIP TO ENDC 1890 ICOL=-2 RETURN C C*** PAGE LENGTH(PLEN) - LINE LENGTH(LLEN) C 1900 CONTINUE IF(INS(1).GT.2) INSL=4 RETURN C C*** MULTIPLY,DIVIDE C 2000 RETURN C C*** ADD/SUB PROCESSING C 2100 CONTINUE IF(IADM(1,2).EQ.8.AND.ISIZ.EQ.1) RETURN C*** ADD1/SUBQ? IF SO FORCE QUICK C*** 20480=$5000 - 20736 = $ 5100 IF(INS(1).EQ.20480.OR.INS(1).EQ.20736) GO TO 2120 IF(INS(3).LE.0) RETURN IF(INS(3).GT.8) RETURN C*** TEST FOR IMMEDIATE SOURCE IF(IADM(1,1).NE.60) RETURN C*** ADD1/SUBI? IF SO FORCE IT IF(INS(1).EQ.ZD001.OR.INS(1).EQ.Z9001) RETURN C*** ADDA/SUBA? IF(INS(1).EQ.ZD002.OR.INS(1).EQ.Z9002) RETURN C... *** QUICK MODE 2120 INSL=INSL - 2 IF(ISIZ.EQ.4) INSL= INSL - 2 RETURN C C*** AND,OR C 2200 RETURN C C*** EOR 2300 RETURN C C*** CMP C 2400 RETURN C C*** EXG C 2500 RETURN C C*** CHK C 2600 RETURN C C*** CMPM C 2700 RETURN C C*** ADDX,SUBX C 2800 RETURN C C*** ABCD,SBCD C 2900 RETURN C C*** MOVEP C 3000 RETURN C C*** DCNT C 3200 IF(MASK2.EQ.0) INSL=4 RETURN C C*** LEA C 3400 RETURN C C*** SHIFTS C 3500 CONTINUE IF(IADM(1,1).EQ.60.AND.ISIZ.EQ.4) INSL=INSL-2 C*** ALLOW #BIT NUMBER ALSO IF(IADM(1,1).EQ.60) IADM(1,1)=56 IF(IADM(1,1).EQ.56) INSL=INSL-2 RETURN C C*** BIT INSTRUCTIONS C 3600 CONTINUE IF(MASK2.NE.1) RETURN I=MPUAND(INS(5),1) IF(I.EQ.0) RETURN GO TO 3930 3900 IF(MASK2.NE.0) RETURN IF(INS(3).GT.7) RETURN 3930 CONTINUE IF(IADM(1,2).NE.16) RETURN INSL=INSL+2 IADM(1,2)=40 IADM(3,2)=1 RETURN C C*** MOVE INSTRUCTION C*-* TEST FOR IMMEDIATE SOURCE AND D SINK 3700 CONTINUE C*** MOVEQ? IF(INS(1).EQ.Z7000) GO TO 3705 IF(IADM(1,1).NE.60) RETURN IF(IADM(1,2).NE.0) RETURN C *-* MOVE #,D - CAN W USE LDQ? C IF(ISIZ.NE.4) GO TO 3710 C*** FORWARD REFERENCE? IF(IADM(5,1).EQ.1) RETURN IF(INS(3).LT. -127) RETURN IF(INS(3).GT.127) RETURN C*** IS VALUE TO BIG FOR MOVEQ DEFAULT? IF(INS(2).NE.0.AND.INS(2).NE.-1) RETURN C*** DON'T DEFAULT TO MOVEQ FOR VALID 16 BIT POSITIVE # IF(INS(2).EQ.0.AND.MPUAND(TKNVAL,Z8000).NE.0) RETURN C * -* USE LDQ 3705 INSL=2 RETURN C C*** USE 4 BYTES FOR MOVE #,REG 3710 CONTINUE INSL=4 RETURN C C*** LDM,STM C 3800 INSL=INSL+2 RETURN C C*** ERROR RETURNS C C... *** UNDEFINED ACTION (INTERNAL ERROR) C 9223 CALL ERR(223) RETURN C C*** ILLEGAL FORWARD REFERENCE C 9240 CONTINUE CALL ERR(240) RETURN END SUBROUTINE EXP(NACT) C C+ NAM: EXP VER:1.00 DATE: 12/11/78 CMP: ALL C SYS: MACS C C ENT: NACT - 1 = INITIALIZE C 2 = OPERAND (VALUE IN TKNVAL) C 3 = RESERVED C 4 = OPERATOR: UNARY MINUS C 5 = >> (SHIFT RIGHT) C 6 = << (SHIFT LEFT) C 7 = & (AND) C 8 = @ (OR) C 9 = % (EOR) C 10 = * (MPY) C 11 = YMTYP/IADM(4,K (DIV) C 12 = + (ADD) C 13 = - (SUB) C 14 = ( (OPEN PREN) C 15 = ) (CLOSE PAREN) C 16 = I- (BGN EXPR) C 17 = -I (END EXPR) C C RTN: TKNVAL = VALUE OF THE EXPRESSION C IADM(4,KSYS) = MODE OF THE RESULT C 0 = ABSOLUTE C 1 = RELATIVE C KSYS=1=1ST OPERAND C KSYS=2=2ND OPERAND C C FNC: PERFORMST EXPRESSION RECOGNIZE BY BOTTOM UP OPERATOR C PRECEDENT. C C REV: NYMTYP/IADM(4,KA C CALLS MPUIOR-ERR-ISHFT-MPUAND C C ERROR NUMBERS CALLED: 223,237 C C* IMPLICIT INTEGER (A-Z) COMMON /A/ ISYM(3000),KARD1(96),ITOKEN(70),TKNSIZ,TKNTYP, & TKNVAL,TKNVA2,JSUC,JPTR,LPTR,NXSYM,KOLUMN,KD1BCT,KD1LNO,JERR, & MNUM,IPASS,IPC2,IPC,IOPC,INS(5),INSL,ISIZ,IADM(7,2),LUOT COMMON /A/ KASH(64),KPAC(15),KPWCT,LENSYM,KCLAS(64) COMMON /A/ NET1(64),NET2(64),NET3(64),NET4(64),NET5(64) COMMON /A/ NBPW,KSYS,IEOT,LSP,JBUF(83),KARD2(80,3),IHB480,IHEX9K COMMON /A/ IA1SHF,KCFF,LUSI,LUDI,LUOO,LLEN,IPLEN C DIMENSION STK1(20),STK2(20),FVTAB(17),ACTAB(17) DIMENSION STK11(20) C C - > < & @ % * / + - ( ) 4 5 DATA FVTAB/0,0,0,7,6,6,5,5,5,4,4,3,3,2,2,1,1/ DATA ACTAB/0,0,0,3,4,4,4,4,4,4,4,4,4,2,2,1,1/ C KACT=NACT-20 C 1 2 3 4 5 6 7 8 9 10 GO TO ( 10, 20,999,200,200,200,200,200,200,200, & 200,200,200,240,200,999,200),KACT C C*** INITIALIZE C 10 NDX=1 LOP=16 STK1(1)=LOP RETURN C C*** OPERAND C 20 NDX=NDX+1 STK1(NDX)=TKNVAL STK2(NDX)=IADM(4,KSYS) C*** SAVE UPPER 2 BYTES STK11(NDX)=TKNVA2 TKNVA2=0 RETURN C C*** OPERATORS C 200 FVOP1=FVTAB(KACT) 205 IF(FVOP1.LE.FVTAB(LOP)) GO TO 1000 240 LOP=KACT NDX=NDX +1 STK1(NDX)=KACT RETURN C C*** UNSTACK THE OPERATION C 1000 J=ACTAB(LOP) GO TO (1010,1020,1030,1040),J C C*** BEGIN EXPRESSION - END EXPRESSION C 1010 TKNVAL=STK1(2) IADM(4,KSYS)=STK2(2) C*** SET POSSIBLE NUMBER >$FFFF TKNVA2=STK11(2) RETURN C C*** LEFT PAREN - RIGHT PAREN C 1020 NDX=NDX-1 STK1(NDX)=STK1(NDX+1) STK11(NDX)=STK11(NDX+1) STK2(NDX)=STK2(NDX+1) LOP=STK1(NDX-1) RETURN C C*** UNARY MINUS C 1030 KK= -STK1(NDX) S1= STK2(NDX) S2= 0 KK1= -1 NDX=NDX-1 GO TO 3000 C C** ARITHMETIC OPERATOR C 1040 NDX=NDX-2 A= STK1(NDX) A1=STK11(NDX) S1=STK2(NDX) B= STK1(NDX+2) B1=STK11(NDX+2) S2=STK2(NDX+2) C C*** PERFORM THE OPERATION C GO TO ( 999, 999, 999, 999,2050,2060,2070,2080, 999, & 2100,2110,2120,2130),LOP C C*** SHIFT RIGHT 2050 B= -B C C*** C 2060 KK=ISHFT(A,B) GO TO 3000 C C*** AND C 2070 KK=MPUAND(A,B) GO TO 3000 C C*** OR C 2080 KK=MPUIOR(A,B) GO TO 3000 C C*** MPY C 2100 CONTINUE C*** USE REG MPY IF NEG #'S IF(B1.EQ.-1.AND.A1.EQ.-1) GO TO 2108 C*** GO MPY 2102 CALL MUL(A1,A,B1,B) KK=A KK1=A1 GO TO 3000 2108 A1=0 B1=0 GO TO 2102 C C*** DIV C 2110 CONTINUE IF(A1.EQ.-1.AND.B1.EQ.-1) GO TO 2118 C*** IS IT DIV BY ZERO? IF(B.EQ.0.AND.B1.EQ.0) GO TO 2900 CALL DIV(A1,A,B1,B) KK=A KK1=A1 GO TO 3000 2118 KK=A/B GO TO 3000 C C*** ADD C 2120 CALL ADD(A1,A,B1,B) KK=A KK1=A1 GO TO 3100 C C*** SUB C 2130 CALL SUB(A1,A,B1,B) KK=A KK1=A1 IF(S1.EQ.S2) S1 =0 GO TO 3200 2900 KK=0 KK1=0 C C*** ASSURE VALID OPERATION FOR OPERAND MODES C C... *** DISALLOW REL,XXX 3000 IF(S1.EQ.0) GO TO 3100 IF(IPASS.GE.0) CALL ERR(237) C... *** DISALLOW XXX,REL 3100 IF(S2.EQ.0) GO TO 3200 IF(IPASS.GE.0) CALL ERR(237) C C... *** ALLOW ANY MODE C 3200 STK1(NDX)=KK STK2(NDX)=S1 STK11(NDX)=KK1 LOP=STK1(NDX-1) GO TO 205 C C*** ERROR EXIT C 999 CALL ERR(223) RETURN END SUBROUTINE RANGE(KK) C+ NAM: RANGE VER: 1.0 DAT: 12/08/78 CMP: 16-BIT C C SYS: MACS C C ENT: KK - NUMERIC VALUE TO BE CHECKED FOR SIZE C C RTN: KK - N/C C C FNC: VALIDATE NUMERIC RANGE VALUES IN #N TYPE STATEMENTS C C REL: N/A C CALLS ERR-ISHFT C C ERROR NUMBERS CALLED: 210 C C* IMPLICIT INTEGER (A-Z) COMMON /A/ ISYM(3000),KARD1(96),ITOKEN(70),TKNSIZ,TKNTYP, & TKNVAL,TKNVA2,JSUC,JPTR,LPTR,NXSYM,KOLUMN,KD1BCT,KD1LNO,JERR, & MNUM,IPASS,IPC2,IPC,IOPC,INS(5),INSL,ISIZ,IADM(7,2),LUOT COMMON /A/ KASH(64),KPAC(15),KPWCT,LENSYM,KCLAS(64) COMMON /A/ NET1(64),NET2(64),NET3(64),NET4(64),NET5(64) COMMON /A/ NBPW,KSYS,IEOT,LSP,JBUF(83),KARD2(80,3),IHB480,IHEX9K COMMON /A/ IA1SHF,KCFF,LUSI,LUDI,LUOO,LLEN,IPLEN KKK=KK IF(ISIZ.EQ.128) RETURN C*** WORD OR BYTE? IF(ISIZ.EQ.0) GO TO 100 C*** CHECK UPPER 2 BYTES IF(TKNVA2.EQ.0) RETURN IF(TKNVA2.NE.-1) GO TO 210 RETURN 100 CONTINUE C IF(TKNVA2.GT.0) GO TO 210 JJ=ISHFT(KKK,-8) IF(JJ.EQ.0) RETURN IF(JJ.EQ.255) RETURN 210 CALL ERR(210) RETURN END SUBROUTINE ACT2(KMD) C+ NAM: ACT2 VER: 1.0 DAT: 12/08/78 CMP: 16-BIT C C SYS: MACS C C ENT: KMD - EQUALS ACTION TO BE TAKEN AS FOUND C IN THE PARSE TABLE. C C RTN: N/C C C FNC: P A S S T W O A C T I O N S C ------------------------------ C PERFORM THE ACTIONS FOR THE DIFFERENT "TOKENS" C ENCOUNTERED DURING THE STATEMENT SCAN. C SETS UP 'IADM' TABLE, ENTERS EXP IN EXP TABLE. C C THIS ROUTINE IS 16-BIT DEPENDENT DUE TO THE CHECK ON C 'TKNVA2' FOR THE 2 MOST SIGNIFICANT BYTES OF A 32-BIT #. C INTEGER CONSTANT 192=$C0, 128=$80($=HEX). C C REV: N/A C CALLS ERR-LKP-SCN-OUTPUT-RANGE-MASK-EXP-MPUGTC C IABS-ISHFT-MPUAND-MPUIOR C C ERROR NUMBERS CALLED: 205,206,207,208,209,212,213,214,219,227 C 228,231,234,235 C* IMPLICIT INTEGER (A-Z) COMMON /A/ ISYM(3000),KARD1(96),ITOKEN(70),TKNSIZ,TKNTYP, & TKNVAL,TKNVA2,JSUC,JPTR,LPTR,NXSYM,KOLUMN,KD1BCT,KD1LNO,JERR, & MNUM,IPASS,IPC2,IPC,IOPC,INS(5),INSL,ISIZ,IADM(7,2),LUOT COMMON /A/ KASH(64),KPAC(15),KPWCT,LENSYM,KCLAS(64) COMMON /A/ NET1(64),NET2(64),NET3(64),NET4(64),NET5(64) COMMON /A/ NBPW,KSYS,IEOT,LSP,JBUF(83),KARD2(80,3),IHB480,IHEX9K COMMON /A/ IA1SHF,KCFF,LUSI,LUDI,LUOO,LLEN,IPLEN COMMON /A/LIST,ICOL,NEST DIMENSION NSZF(40),NSZ(40),MREL(40) EQUIVALENCE(IADM(4,1),SYMTYP),(IADM(5,1),LFRF) DATA LB/66/,LW/87/,LL/76/,LAP/39/ DATA LS/83/ C*** 0 = UNSIZED INSTRUCTION C*** 1 = B,W,L ALLOWED C*** 2 = B ONLY C*** 66 = W ONLY C*** 130 = L ONLY C*** SIZE SUBFIELD ALLOWED? *** DATA NSZF/ & 0,0,0,1,1,0,66,0,1,2,130,0,-1,1,1,2,0,0,0,66, & 1,1,1,1,130,66,1,1,2,1,0,0,1,130,1,1,1,1,1,0/ C OPCODE SIZES 01 02 03 04 05 06 07 08 09 10 C*** 01-10 DATA NSZ/ 0, 2, 0,-1,-1,-1, 2,-1,-1,-1, & -1,-1,-1,-1, 2,-1,-1, 0, 0,-1, & -1,-1,-1,-1, 2,-1, 2, 2, 2,-1, & 0,-1, 2,-1,-1,-1,-1,-1,-1, 0/ C USE PC REL? 01 02 03 04 05 06 07 08 09 10 C*** 01-10 DATA MREL/ 0, 0, 0, 0,-1, 0, 0, 0, 1, 1, & 1, 1,-1, 1, 1, 1, 1, 0, 0, 1, & 1, 1, 1, 1, 0, 0, 0, 0, 0, 1, & 0,-1, 0, 1, 0, 1, 1, 1, 1, 0/ DATA Z8000/O100000/ C GO TO(100,200,300,400,500,600,700,800,800, & 1000,1100,1200,1300,1400,1500,1600,1700),KMD C*** EXPRESSION ACTION CALL EXP(KMD) RETURN C C*** STATEMENT LABEL C 100 CALL LKP(1,LSUC,LPTR) IF(LSUC.LE.0) RETURN IR=ISYM(LPTR) KR=MPUAND(IR,192) C C*** SAVE FOR BUILD2 ITOKEN(69)=LSUC IF(KR.NE.192) GO TO 110 C*** REDEFINED SYMBOL CALL ERR(206) RETURN C C*** DEFINE FOR PASS TWO 110 ISYM(LPTR)= MPUAND(IR,63) + 128 + ISHFT(IPC2,8) C RETURN C C*** OPCODE C 200 KSYS=1 IF(JSUC.GT.0) GO TO 210 C*** ERROR 207 - UNDEFINED OP-CODE CALL ERR(207) KOLUMN=0 RETURN C *** MACRO DEFINITION? 210 IF(IOPC.GT.0) GO TO 260 IF(IOPC.EQ.0) GO TO 265 C *** LOOK FOR ENDM 230 KOLUMN=-1 LPTR=0 IOPC=0 CALL SCN IF(TKNTYP.NE.30) GO TO 230 IF(IOPC.GE.0) GO TO 230 C*** ASSURE NOT MEXIT IF(INS(1).EQ.2) GO TO 230 KOLUMN=0 RETURN C *** NEED OPERAND FIELD? 260 CONTINUE INSL=NSZ(IOPC) JNSL=INSL IF(IOPC.GE.4) GO TO 270 C *** OPERAND FIELD NOT NEEDED 265 KOLUMN=0 RETURN 270 IADM(1,1)=-1 IADM(3,2)=0 IADM(1,2)=-1 IADM(6,1)=0 IADM(6,2)=0 ISIZ=64 C*** ALLOW .B ONLY FOR BIT INSTRUCTIONS IF(IOPC.EQ.36) ISIZ=0 IADM(4,1)=0 IADM(4,2)=0 IADM(5,2)=0 LFRF=0 CALL EXP(21) RETURN C C*** DATA SIZE C C 300 KK=NSZF(IOPC) C IF(KK.GT.0) GO TO 310 C C*** IS "S" ALLOWED? IF(KK.EQ.0) GO TO 305 C IF(ITOKEN(1).NE.LS) GO TO 390 C*** ALLOW "S" ISIZ=0 RETURN C C *** ERROR - SIZE SUBFIELD NOT ALLOWED FOR THIS OPCODE 305 CALL ERR(205) RETURN 310 IF(TKNSIZ.NE.1) GO TO 390 IF(ITOKEN(1).NE.LB) GO TO 320 ISIZ=0 GO TO 395 320 IF(ITOKEN(1).NE.LL) GO TO 330 ISIZ=128 GO TO 395 330 IF(ITOKEN(1).EQ.LW) GO TO 392 C *** ERROR - UNKNOWN DATA SIZE SPECIFIED 390 CALL ERR(212) RETURN 392 ISIZ=64 395 CONTINUE C*** IF ALL 3 SIZES ALLOWED, SKIP IF(KK.EQ.1) RETURN IF(ISIZ.NE.KK-2) CALL ERR(238) RETURN C C*** COMMA STARTING FIELD-2 OPERAND *** C C 400 CALL EXP(21) IF(IOPC.NE.4) GO TO 410 C*** DC - FORCE OUT CALL OUTPUT INSL=-1 RETURN C 410 CONTINUE IF(KSYS.EQ.2) GO TO 420 C*** CHECK FOR 'LINK' - 20048 = $4E50 = LINK IF(IOPC.EQ.6.AND.INS(1).EQ.20048) GO TO 430 IF(IOPC.GE.19) GO TO 430 C *** OPCODE REQUIRES ONLY ONE OPERAND 420 CALL ERR(219) KOLUMN=0 RETURN C+++ MOVE REG,MODE TO SS 2 430 KSYS=2 TKNVA2=0 RETURN C C*** OPERAND - REGISTER C 500 IADM(1,KSYS)=0 JR=ISYM(JPTR+1) IADM(2,KSYS)=JR C C *** STATUS REGISTER? IF(JR.LE.15) GO TO 510 C *** DEFINE AS STATUS REGISTER IADM(1,KSYS)=64 RETURN C *** ADDR REGISTER? 510 IF(JR.GT.7) IADM(1,KSYS)=8 IF(IOPC.EQ.38) CALL MASK(JR) RETURN C C*** REGISTER INDIRECT MODE *** C 600 IADM(1,KSYS)=16 GO TO 900 C C*** POST INCREMENT *** C 700 IADM(1,KSYS)=24 RETURN C C*** PRE DECREMENT *** C 800 IADM(1,KSYS)=32 C C*** REGISTER OF (A1) ADDRESSING MODE *** C 900 JR=ISYM(JPTR+1) 910 IF(JR.GT.7) GO TO 920 C *** ERROR - REGISTER INDIRECT SPECIFIES DATA REGISTER. CALL ERR(213) RETURN 920 IADM(2,KSYS)=JR RETURN C C*** IMMEDIATE OPERAND *** C 1000 IADM(1,KSYS)=60 CALL EXP(37) C CALL RANGE(TKNVAL) 1006 IF(INSL.GT.0) GO TO 1010 C *** DETERMINE OPERAND SIZE INSL=4 IF(ISIZ.NE.128) GO TO 1008 INSL=6 C+++ 16-BIT - GET NEXT 2 BYTES INS(2)=TKNVA2 1008 INS(3)=TKNVAL RETURN C *** SECOND OPERAND FIELD 1010 IF(JNSL.GE.0) GO TO 1190 IADM(3,2)=2 IF(ISIZ.EQ.128) IADM(3,2)=4 INSL=INSL+ IADM(3,2) C+++ IN CASE 16-BITS GET REST OF # INS(4)=TKNVA2 INS(5)=TKNVAL RETURN C C*** DISPLACEMENT *** C C 1100 CALL EXP(37) KM=56 KL=2 C*** RELOCATABLE SYMBOL RTYP=MREL(IOPC) C IF(RTYP.LE.0) GO TO 1110 C *** IS EXPRESSION ABSOLUTE? IF(IADM(4,KSYS).EQ.0) GO TO 1110 C IF(IADM(7,2).EQ.1.AND.IADM(5,KSYS).GT.0) CALL ERR(231) K=INSL IF(K.LT.0) K=2 C*** TKNVAL=TKNVAL - IPC - K C*** SUBTRACT IPC FROM TKNVAL CALL SUB(TKNVA2,TKNVAL,IPC2,IPC) C*** NOW SUBTRACT K CALL SUB(TKNVA2,TKNVAL,0,K) KM=58 C*** TEST FOR VALID NEG# IF(TKNVA2.EQ.-1) GO TO 1120 C C*** TEST FOR GREATER THAN 2 BYTES INSTEAD OF ONE(32767 NOT 127) IF(TKNVA2.NE.0) CALL ERR(208) GO TO 1120 C*** ABSOLUTE SYMBOL, FIND ITS SIZE 1110 CONTINUE C*** BACK OR FORWARD REF? IF(IADM(5,KSYS).EQ.0) GO TO 1112 C*** IS LONG OR SHORT FWD REF IN USE - ORG.L? IF(IADM(7,2).EQ.1) GO TO 1115 C*:: NOT ORG.L, CHECK SIZE OF FORWARD ADDRESS IF(TKNVA2.EQ.0) GO TO 1120 C*** DON'T GIVE ERROR FOR BCC, IT WILL BE CAUGHT LATER IF VALID ERR. IF(IOPC.EQ.13) GO TO 1120 C*** VALID NEGATIVE #? IF(TKNVA2.EQ.-1) GO TO 1120 C*** DC? IF(IOPC.EQ.4) GO TO 1120 C*** ERROR - FORWARD REFERENCE IS LONG ABSOLUTE CALL ERR(210) GO TO 1120 C*** BAKWARDS REF, CHECK SIZE OF VALUE C*** VALID NEG #? 1112 IF(TKNVA2.EQ.-1) GO TO 1120 IF(TKNVA2.NE.0) GO TO 1115 C*** ADDRESS >$7FFF IS LONG IF(MPUAND(TKNVAL,Z8000).EQ.0) GO TO 1120 1115 KM=57 KL=4 C *** SAVE ADDRESS MODE AND VALUE 1120 IADM(1,KSYS)=KM IF(INSL.GT.0) GO TO 1130 C *** FIRST FIELD INSL=KL + 2 C+++ 16-BIT - TKNVA2 IS ALWAYS ZEROED AT START OF SOURCE LINE C IN CASE CURRENT # IS NOT BIG ENOUGH TOGO THERE INS(2)=TKNVA2 C INS(3)=TKNVAL KOPN=3 RETURN C C C *** SECOND FIELD 1130 IF(JNSL.GE.0) GO TO 1190 C INSL=INSL + KL IADM(3,2)=KL INS(4)=TKNVA2 C INS(5)=TKNVAL KOPN=5 RETURN C C*** ERROR - INSTRUCTION DOESN'T ALLOW THIS MODE 1190 CALL ERR(234) C RETURN C C C C*** REGISTER FOR 3(A1) ADDRESSING MODE *** C 1200 JR=ISYM(JPTR+1) C C*** IN CASE UJNDEFINEDS ARE PRESENT COUNT MAY BE OFF IF(INSL.EQ.10.AND.IADM(7,2).EQ.0) INSL=8 C*** SWITCH VALUE TO PRINT IF ORG.L IN SOME CASES IF(IADM(3,2).EQ.4) IADM(3,2)=2 C*** HAS LONG FORWARD REF BEEN SET? IF(IADM(1,KSYS).EQ.57) INSL=INSL-2 IF(IADM(1,KSYS).EQ.58) GO TO 1220 C*** ABSOLUTE SYMBOL IF(TKNVA2.EQ.0) GO TO 1210 C*** VALID NEG #? IF(TKNVA2.EQ.-1) GO TO 1210 C *** ERROR - 32 BIT DISPLACEMENT CALL ERR(208) C*** RESET TO SHORT ADDRESS IADM(1,KSYS)=56 RETURN 1210 IADM(1,KSYS)=40 GO TO 910 C *** (PC) RELATIVE ADDRESS MODE - USE (PC)+X+D 1220 IADM(1,KSYS)=59 GO TO 1410 C C*** .L FOR 3(A1.L) ADDRESSING MODE *** C 1300 IF(TKNSIZ.NE.1) GO TO 1310 IF(ITOKEN(1).EQ.LL) GO TO 1310 C *** ERROR - SIZE FOR TAG(A1.L) IS NOT L CALL ERR(214) RETURN 1310 IF(IADM(1,KSYS).EQ.48) GO TO 1320 IF(IADM(1,KSYS).EQ.59) GO TO 1320 C *** ERROR - ILLEGAL ADDRESS MODE CALL ERR(209) RETURN 1320 INS(KOPN)=INS(KOPN) + 2048 RETURN C C*** SECOND REGISTER FOR 3(A1,A2) ADDRESSING MODE *** C 1400 JR=ISYM(JPTR+1) IF(IADM(4,KSYS).NE.0) CALL ERR(231) IADM(1,KSYS)=48 1410 IF(IABS(TKNVAL).GT.128) CALL ERR(208) INS(KOPN)=ISHFT(JR,12) + MPUAND(TKNVAL,255) RETURN C C*** SECOND REGISTER OF R1-R2 FOR LDM,STM C 1500 IF(IOPC.EQ.38) GO TO 1510 C *** ERROR - NOT LDM,STM CALL ERR(227) RETURN 1510 KR=ISYM(JPTR+1) IF(JR.GT.KR) GO TO 1530 DO 1520 J=JR,KR JJ=J 1520 CALL MASK(JJ) RETURN 1530 DO 1540 J=KR,JR JJ=J 1540 CALL MASK(JJ) RETURN C C*** 'STRING' OVER 4 BYTES LONG C 1600 INS(3)=TKNSIZ RETURN C C*** CONSTANT OR VARIABLE OPERAND *** C 1700 CONTINUE IADM(4,KSYS)=0 IF(TKNTYP.EQ.24) GO TO 1710 C *** CONSTANT OPERAND C IF(TKNTYP.NE.42) GO TO 1730 C*** ASTERISKS TKNVAL=IPC C+++ 16-BIT - UPPER BYTE. TKNVA2=IPC2 IADM(4,KSYS)=IADM(7,1) GO TO 1730 C *** DEFINED PREVIOUSLY? 1710 IF(JSUC.GT.0) GO TO 1720 C *** INTERNAL ERROR - MISSING SYMBOL CALL ERR(228) GO TO 1730 1720 TKNVAL=ISYM(JPTR+1) KK=ISYM(JPTR) C+++ 16-BIT - GET M.S.B. TKNVA2=ISYM(JSUC) C C*** IS SYMBOL RELOCATABLE? IF(MPUAND(KK,7).EQ.1) IADM(4,KSYS)=1 KK=MPUAND(KK,192) C C*** UNDEFINED SYMBOL? IF(KK.NE.0) GO TO 1725 CALL ERR(207) C*** FORCE LONG ADDR FOR UNDEF A DISPLACEMENT CALC TO AVOID PHASE PROB KK=64 C*** SET UNDEFINED FLAG IADM(5,KSYS)=2 1725 CONTINUE C*** REDEFINED SYMBOL? IF(KK.EQ.192) CALL ERR(206) C*** FORWARD REFERENCE? IF(KK.EQ.64) IADM(5,KSYS)=MPUIOR(IADM(5,KSYS),1) C*** GIVE OPERAND TO EXP 1730 CALL EXP(22) RETURN END SUBROUTINE MASK(JR) C+ NAM: MASK VER: 1.0 DAT: 12/08/78 CMP: ALL C C SYS: MACS C C ENT: JR - MASK TO BE SHIFTED C C RTN: JR - N/C C C FNC: FORMAT REGISTER BIT MASK FOR LDM,STM C C REV: N/A C CALLS ISHFT-MPUIOR C C* IMPLICIT INTEGER (A-Z) COMMON /A/ ISYM(3000),KARD1(96),ITOKEN(70),TKNSIZ,TKNTYP, & TKNVAL,TKNVA2,JSUC,JPTR,LPTR,NXSYM,KOLUMN,KD1BCT,KD1LNO,JERR, & MNUM,IPASS,IPC2,IPC,IOPC,INS(5),INSL,ISIZ,IADM(7,2),LUOT COMMON /A/ KASH(64),KPAC(15),KPWCT,LENSYM,KCLAS(64) COMMON /A/ NET1(64),NET2(64),NET3(64),NET4(64),NET5(64) COMMON /A/ NBPW,KSYS,IEOT,LSP,JBUF(83),KARD2(80,3),IHB480,IHEX9K COMMON /A/ IA1SHF,KCFF,LUSI,LUDI,LUOO,LLEN,IPLEN C IB=ISHFT(1,JR) IADM(6,1)=MPUIOR(IADM(6,1),IB) C KR=15 -JR IB=ISHFT(1,KR) IADM(6,2)=MPUIOR(IADM(6,2),IB) RETURN END SUBROUTINE MOD2 C+ NAM: MOD2 VER: 1.0 DAT: 12/08/78 CMP: ALL C C SYS: MACS C C ENT: N/A C C RTN: N/A C C FNC: FORCE TO AN EVEN WORD BOUNDARY C C REV: N/A C CALLS MPUAND-ADD C C* IMPLICIT INTEGER (A-Z) COMMON /A/ ISYM(3000),KARD1(96),ITOKEN(70),TKNSIZ,TKNTYP, & TKNVAL,TKNVA2,JSUC,JPTR,LPTR,NXSYM,KOLUMN,KD1BCT,KD1LNO,JERR, & MNUM,IPASS,IPC2,IPC,IOPC,INS(5),INSL,ISIZ,IADM(7,2),LUOT C IF(MPUAND(IPC,1).EQ.0) RETURN C*** IPC=IPC+1 - ADD ALL 24 BITS CALL ADD(IPC2,IPC,0,1) IF(LPTR.EQ.0) RETURN ISYM(LPTR+1)=IPC I=ITOKEN(69) ISYM(I)=IPC2 RETURN END SUBROUTINE OUTPUT C+ NAM: OUTPUT VER: 1.0 DAT: 12/08/78 CMP: PDP-11 C C SYS: MACS C C ENT: N/A C C RTN: N/C C C FNC: OUTPUT THE CURRENT INSTRUCTION. C C REV: N/A C CALLS BUILD1-BUILD2-PAGE-PCOUNT-OBJ-MPUCA1-MPUAND-ERR-MOD2 C HEXASC C C ERROR NUMBERS CALLED: 230 C C* IMPLICIT INTEGER (A-Z) COMMON /A/ ISYM(3000),KARD1(96),ITOKEN(70),TKNSIZ,TKNTYP, & TKNVAL,TKNVA2,JSUC,JPTR,LPTR,NXSYM,KOLUMN,KD1BCT,KD1LNO,JERR, & MNUM,IPASS,IPC2,IPC,IOPC,INS(5),INSL,ISIZ,IADM(7,2),LUOT COMMON /A/ KASH(64),KPAC(15),KPWCT,LENSYM,KCLAS(64) COMMON /A/ NET1(64),NET2(64),NET3(64),NET4(64),NET5(64) COMMON /A/ NBPW,KSYS,IEOT,LSP,JBUF(83),KARD2(80,3),IHB480,IHEX9K COMMON /A/ IA1SHF,KCFF,LUSI,LUDI,LUOO,LLEN,IPLEN COMMON /A/ LIST,ICOL,NEST,LUCI,LULT,MFLD(11,3),IOBJ,LLENSW EQUIVALENCE(INS(1),INS1) DIMENSION KRDOUT(95) DIMENSION INS1A(4),INS2(4),INS3(4),INS4(4),INS5(4),IPC22(2), & IPC1(4) DATA LSPHEX/' ' / C*** PUT OUT INSTRUCTION OR SPECIAL PRINT. C*** REGULAR INSTRUCTION 1 CONTINUE C C*** ARE WE IN A MACRO DEFINITION? IF(ICOL.EQ. -1) INSL=0 C... *** FINISH BUILDING THE INSTRUCTION. IF(IPASS.GE.0) GO TO 3 C*** ARE WE IN IFXX? IF(ICOL.LT.0) GO TO 17 CALL BUILD1 17 CONTINUE C C*** DEBUG C I=2 CALL DEBUG(I) IF(I.EQ.1) GO TO 5 C*** END DEBUG 18 IF(JERR.GT.0) GO TO 5 GO TO 900 3 CONTINUE C*** ARE WE IN IFXX? IF(ICOL.LT.0) GO TO 5 CALL BUILD2 CALL OBJ 5 II=1 C*** HAS THE LINE ALREADY BEEN PRINTED? IF(KARD1(1).EQ.0) GO TO 1000 KD1BCT=LLEN-25 C*** NOLIST ON? 6 IF(LIST.EQ.0) GO TO 500 C*** SKIP ADJUSTMENT IF REMARK IF(KARD1(1).EQ.42) GO TO 8000 C*** SHOULD OUTPUT BE PRETTILY ADJUSTED?? IF(LLENSW.EQ.0) GO TO 8000 C*** ADJUST OUTPUT TO SPECIFIC COLUMNS C*** IS THERE A LABEL? DO 7000 I=1,KD1BCT 7000 KRDOUT(I)=LSP I=1 IPOS=1 IF(KARD1(1).EQ.LSP) GO TO 7050 DO 7010 I=1,31 KRDOUT(I)=KARD1(I) IPOS=I+1 IF(KARD1(I).EQ.LSP) GO TO 7050 7010 CONTINUE C*** IF HERE 31ST CHAR NOT BLANK KRDOUT(32)=LSP C*** FIND END OF LABEL J=I DO 7020 I=J,KD1BCT IF(KARD1(I).EQ.LSP) GO TO 7050 7020 CONTINUE GO TO 8100 7050 CONTINUE C*** FIND MNEMONIC J=I+1 DO 7100 I=J,KD1BCT IF(KARD1(I).NE.LSP) GO TO 7150 7100 CONTINUE GO TO 8100 C*** MNEMONIC 7150 CONTINUE IF(IPOS.LT.10) IPOS=10 DO 7200 K=IPOS,KD1BCT KRDOUT(K)=KARD1(I) IF(KARD1(I).EQ.LSP) GO TO 7250 I=I+1 7200 CONTINUE GO TO 8100 7250 CONTINUE IPOS=K+1 C*** OPCODE C*** REMOVE ANY EXCESS BLANKS BETWEEN MNEMONIC & OPERAND. DO 7260 K=I,KD1BCT IF(KARD1(K).NE.LSP) GO TO 7280 7260 CONTINUE GO TO 8100 7280 I=K J=0 IF(IPOS.LT.18) IPOS=18 DO 7300 K=IPOS,KD1BCT IF(KARD1(I).EQ.IEOT) GO TO 8100 C*** CHECK FOR ' ' IF(KARD1(I).EQ.39) J=J+1 C*** IS IT 1ST '? IF(MOD(J,2).NE.0) GO TO 7290 IF(KARD1(I).EQ.LSP) GO TO 7350 7290 KRDOUT(K)=KARD1(I) I=I+1 7300 CONTINUE GO TO 8100 7350 CONTINUE C*** REMARKS C*** REMOVE ANY EXCESS BLANKS BETWEEN OPERAND AND REMARKS. DO 7360 J=I,KD1BCT IF(KARD1(J).NE.LSP) GO TO 7380 7360 CONTINUE GO TO 8100 7380 CONTINUE I=J IF(J.LT.40) J=40 IF(K.GT.40) J=K+1 DO 7400 K=J,KD1BCT IF(KARD1(I).EQ.IEOT) GO TO 8100 KRDOUT(K)=KARD1(I) I=I+1 7400 CONTINUE GO TO 8100 8000 DO 8 J=1,KD1BCT 8 KRDOUT(J)=KARD1(J) 8100 CONTINUE C WRITE(LUOT,9999) INSL,(INS(I),I=1,5) 9999 FORMAT(' OUTPUT-INSL,INS=',I3,5O8) CALL HEXASC(INS(1),INS1A,4,1) CALL HEXASC(INS(2),INS2,4,1) CALL HEXASC(INS(3),INS3,4,1) CALL HEXASC(INS(4),INS4,4,1) CALL HEXASC(INS(5),INS5,4,1) CALL HEXASC(IPC2,IPC22,2,1) CALL HEXASC(IPC,IPC1,4,1) IF(INSL.EQ.0) GO TO 10 IF(INSL.LT.0) GO TO 20 C*** 20 = SPC IF(INSL.EQ.20) GO TO 950 GO TO(100,200,200,400,400,600,600,880,80),INSL C*** 5 WORD INSTRUCTION WRITE(LUOT,999) KD1LNO,IPC22,IPC1,INS1A,INS2,INS3,INS4,INS5 & , (KRDOUT(J),J=1,KD1BCT) GO TO 690 C*** FOUR WORD INSTRUCTION 880 IF(IADM(3,2).EQ.2) GO TO 770 C... *** LONG INTEGER IN INS(5) WRITE(LUOT,2999) KD1LNO,IPC22,IPC1,INS1A,INS3,INS4,INS5, & (KRDOUT(J),J=1,KD1BCT) GO TO 690 C.. *** SHORT INTEGER IN INS(5) 770 WRITE(LUOT,1999) KD1LNO,IPC22,IPC1,INS1A,INS2,INS3,INS5, & (KRDOUT(J),J=1,KD1BCT) GO TO 690 C*** THREE WORD INSTRUCTION 600 IF(IADM(3,2).EQ.0) GO TO 660 C... *** SHORT INTEGER IN INS(5) WRITE(LUOT,1998) KD1LNO,IPC22,IPC1,INS1A,INS3,INS5, & (KRDOUT(J),J=1,KD1BCT) GO TO 700 C... *** NO INTEGER IN INS(5) - INS(3) ONLY 660 WRITE(LUOT,998) KD1LNO,IPC22,IPC1,INS1A,INS2,INS3, & (KRDOUT(J),J=1,KD1BCT) GO TO 700 C 500 CONTINUE IF(INSL.EQ.0) GO TO 800 IF(INSL.LT.0) GO TO 540 GO TO (800,700,700,700,700,700,700,700,78),INSL GO TO 700 540 IF(INSL.NE.-1) GO TO 35 GO TO 800 C*** TWO WORD INSTRUCTION 400 WRITE(LUOT,997) KD1LNO,IPC22,IPC1,INS1A,INS3, & (KRDOUT(J),J=1,KD1BCT) GO TO 700 C*** ONE WORD INSTRUCTION 200 WRITE(LUOT,996) KD1LNO,IPC22,IPC1,INS1A,(KRDOUT(J),J=1,KD1BCT) GO TO 700 C*** ONE BYTE VALUE 100 WRITE(LUOT,995) KD1LNO,IPC22,IPC1,INS3(3),INS3(4), & (KRDOUT(J),J=1,KD1BCT) GO TO 800 80 CONTINUE C*** CONVERT VALUE TO ASCII CALL HEXASC(ITOKEN(1),INS2,2,1) WRITE(LUOT,995) KD1LNO,IPC22,IPC1,INS2(1),INS2(2), & (KRDOUT(J),J=1,KD1BCT) CALL PAGE(1) 78 INSL=1 IF(INS1.EQ.1) GO TO 75 DO 70 J=2,INS1 CALL PCOUNT IF(LIST.EQ.0) GO TO 70 C*** IS OPTION G- OR G? IF(LUDI.EQ.0) GO TO 70 C*** CONVERT HEX TO ASCII CALL HEXASC(IPC,IPC1,4,1) CALL HEXASC(IPC2,IPC22,2,1) CALL HEXASC(ITOKEN(J),KRDOUT,2,1) WRITE(LUOT,991) IPC22,IPC1,KRDOUT(1),KRDOUT(2) CALL PAGE(1) 70 CONTINUE 75 CALL PCOUNT C*** DON'T 0 MOD 2 IF DC.B LPTR=0 IF(ISIZ.EQ.0) GO TO 72 I=2 IF(ISIZ.EQ.128) I=4 C*** IF NOT 0 MOD 2 FOR .W OR 0 MOD 4 FOR .L PUT OUT FIILER OF 0 IF(INS1.LT.5) INS1=INS1+4 J=MOD(INS1,I) IF(J.EQ.0) GO TO 72 I=I-J DO 71 J=1,I CALL PNCH(4,0) IF(LIST.EQ.0) GO TO 71 C*** IS OPTION G- OR G? IF(LUDI.EQ.0) GO TO 71 C*** 'LPTR' MUST = 0 CALL HEXASC(IPC,IPC1,4,1) CALL HEXASC(IPC2,IPC22,2,1) CALL HEXASC(LPTR,KRDOUT,2,1) WRITE(LUOT,991) IPC22,IPC1,KRDOUT(1),KRDOUT(2) CALL PAGE(1) 71 CALL PCOUNT 72 KARD1(1)=0 INSL=0 GO TO 800 C*** PSUEDO OP 10 WRITE(LUOT,994) KD1LNO,(KRDOUT(J),J=1,KD1BCT) GO TO 800 C*** PSEUDO OP WITH A VALUE 20 IF(INSL.NE.-1) GO TO 30 C... *** PRINT W/O PC WRITE(LUOT,993) KD1LNO,INS2,INS3,(KRDOUT(J),J=1,KD1BCT) GO TO 800 C... *** DS - PRINT WITH PC 30 WRITE(LUOT,996) KD1LNO,IPC22,IPC1,INS3,(KRDOUT(J),J=1,KD1BCT) 35 INSL=INS(3) GO TO 800 999 FORMAT(I4,1X,2A1,4A1,1X,12A1/16X,8A1,1X,100A1) 1999 FORMAT(I4,1X,6A1,1X,12A1/16X,4A1,5X,100A1) 2999 FORMAT(I4,1X,6A1,1X,8A1/16X,8A1,1X,100A1) 1998 FORMAT(I4,1X,6A1,1X,12A1,1X,100A1) 998 FORMAT(I4,1X,6A1,1X,12A1,1X,100A1) 997 FORMAT(I4,1X,6A1,1X,8A1,5X,100A1) 996 FORMAT(I4,1X,6A1,1X,4A1,9X,100A1) 995 FORMAT(I4,1X,6A1,1X,2A1,11X,100A1) 994 FORMAT(I4,21X,100A1) 993 FORMAT(I4,8X,8A1,5X,100A1) 991 FORMAT(5X,6A1,1X,2A1) 9920 FORMAT(A1) C*** INCREMENT LINE COUNT BY 2 690 II=2 C*** ASSURE EVEN BOUNDARY 700 IF(MPUAND(IPC,1).EQ.0) GO TO 800 CALL ERR(230) CALL PNCH(4,0) CALL MOD2 C*** PRINT THE ERRORS IF ANY 800 CALL ERR(0) IF(KARD1(1).NE.0) CALL PAGE(II) C*** COMPUTE NEW PC ADDRESS C 900 KARD1(1)=0 IF(INSL.LE.0) RETURN C*** INCREMENT THE P-COUNTER. CALL PCOUNT RETURN C*** SPC *** 950 CONTINUE I=INS(3) C DO 960 J=1,I CALL PAGE(1) 960 WRITE(LUOT,9920) LSPHEX C KARD1(1)=0 INSL=0 GO TO 800 1000 CONTINUE C*** IF DC FINISH OUTPUT IF REQUIRED & INCREMENT THE PCOUNT IF(IOPC.NE.4) GO TO 800 KARD1(1)=LSP KD1BCT=1 GO TO 6 END SUBROUTINE BUILD2 C+ NAM: BUILD2 VER: 1.0 DAT: 12/08/78 CMP: 16-BIT C C SYS: MACS C C ENT: N/A C C RTN: N/A C C FNC: BUILD THE INSTRUCTION FOR PASS TWO C C THIS ROUTINE IS 16-BIT DEPENDENT DUE TO THE C 24-BIT ADDRESS WHICH MUST BE MANIPULATED. C C REV: N/A C CALLS ERR-MOD2-ISHFT-MPUAND-MPUIOR-PAGE C C ERROR NUMBERS CALLED: 205,208,209,210,212,213,215,216,217,218 C 220,223,229,232,233,234,236,238 C* IMPLICIT INTEGER (A-Z) COMMON /A/ ISYM(3000),KARD1(96),ITOKEN(70),TKNSIZ,TKNTYP, & TKNVAL,TKNVA2,JSUC,JPTR,LPTR,NXSYM,KOLUMN,KD1BCT,KD1LNO,JERR, & MNUM,IPASS,IPC2,IPC,IOPC,INS(5),INSL,ISIZ,IADM(7,2),LUOT COMMON /A/ KASH(64),KPAC(15),KPWCT,LENSYM,KCLAS(64) COMMON /A/ NET1(64),NET2(64),NET3(64),NET4(64),NET5(64) COMMON /A/ NBPW,KSYS,IEOT,LSP,JBUF(83),KARD2(80,3),IHB480,IHEX9K COMMON /A/ IA1SHF,KCFF,LUSI,LUDI,LUOO,LLEN,IPLEN COMMON /A/ LIST,ICOL,NEST,LUCI,LULT,MFLD(11,3),IOBJ,LLENSW,NOP COMMON /A/ NXSYM1,LIST1,MASK2 DIMENSION IMCD(6),NIMM(40) EQUIVALENCE(IADM(4,1),SYMTYP),(IADM(5,1),LFRF) EQUIVALENCE (INS(1),INS1) C ORI SUBI EORI CMPI ANDI ADDI DATA IMCD/ 0000, 1024, 2560, 3072, 512, 1536/ C C*** THE FOLLOWING DATA STATEMENTS DEFINE HEX CONSTANTS C*** LOCAL TO THIS ROUTINE. C DATA IH4E60/O47140/,IH40C0/O40300/ DATA IH44C0/O42300/,IH46C0/O43300/ DATA IH48C0/O44300/ C C*** END HEX DATA CONSTANTS. C C*** 01-20 NO IMM - 2ND ROW IS 21 04 DATA NIMM/ & 0,0,0,0,0,1,1,1,1,1,0,0,0,1,1,0,0,0,0,1, & 1,1,1,0,0,0,0,1,1,1,1,1,0,1,1,1,1,1,1,0/ C C*** HEX 7000 DATA I7KH/O70000/ DATA IHA0C0/O120300/ DATA IH5K/O50000/,IH5100/O50400/ DATA IH4100/O40400/ DATA ZB001/O130001/,ZD001/O150001/,ZD002/O150002/,Z9001/O110001/ DATA Z9002/O110002/,ZF000/O170000/,Z8000/O100000/ DATA ZB140/O130500/ DATA CMP/0/,MASK2/0/ C*** ERROR 220 ??? C*** IF(IOPC.EQ.0) GO TO 45 C*** CHECK FOR DC WITH A LABEL, IS SO SKIP ERR 220 CHECK IF(IOPC.EQ.4) GO TO 50 IF(IOPC.EQ.5) GO TO 50 C... *** NOT SET,EQU ASSURE NO PHASE ERROR IF(LPTR.EQ.0) GO TO 40 IF(ISYM(LPTR+1).NE.IPC) CALL ERR(220) C*** PERFORM ACTIONS FOR THE OPCODE CLASS 40 IF(IOPC.GT.0) GO TO 50 45 INSL=0 RETURN 50 IF(INSL.LT.0) INSL=2 GO TO(100, 200,9223,400,500, 600, 700, 800, 900, 1000, & 1100,1200,1300,1400,1500,1600,1700,1800,1900),IOPC J=IOPC-19 GO TO(2000,2100,2200,2300,2400,2500,2600,2700,2800,2900,3000, & 9223,3200,9223,3400,3500,3600,3700,3800),J J=J-19 GO TO(3900),J GO TO 9223 C C*** PSEUDO OPS WITHOUT OPERANDS 100 CONTINUE GO TO(110,120,130,140,150,160,170,180,190,195,196,197),INS1 C... *** END 110 IPASS=1 120 RETURN C*** PAGE 130 CONTINUE CALL PAGE(84) RETURN C C*** LIST 140 LIST=1 145 KARD1(1)=0 RETURN C C*** NOLIST *** 150 LIST=0 RETURN C*** TTL 160 CALL PAGE(80) GO TO 145 C*** NO PAGE(NOP) 170 CONTINUE NOP=0 RETURN C C*** NOOBJ -NO OBJECT OUTPUT, SET IN PASS 1 C 180 RETURN C C*** CMPL - CMP DESTINATION,SOURCE C 190 CMP=1 RETURN C C*** CMPR - CMP S,D C 195 CMP=0 RETURN C C*** 'G' DIRECTIVE C 196 LUDI=1 RETURN C C*** 'MASK2' DIRECTIVE C 197 MASK2=1 RETURN C C*** OP CODES WITHOUT OPERANDS 200 RETURN C C*** DC 400 GO TO 540 C C*** PSEUDO OPS WITH OPERANDS 500 IF(IADM(1,1).EQ.56) GO TO 505 IF(IADM(1,1).NE.57) CALL ERR(234) 505 INSL=-1 GO TO(510,520,520,540,508,560,570),INS1 GO TO 9223 C*** RORG 508 IADM(7,1)=1 GO TO 512 C... *** ORG AND RORG 510 IADM(7,1)=0 512 IPC=INS(3) C+++ 16-BIT - GET MOST SIGNIFICANT BYTE IPC2=INS(2) IADM(7,2)=0 IF(ISIZ.EQ.128) IADM(7,2)=1 CALL PNCH(3,IPC) RETURN C... *** EQU 520 IF(LPTR.GT.0) GO TO 522 C... *** ERROR - NO LABEL ON STATEMENT CALL ERR(229) RETURN 522 ISYM(LPTR)=MPUAND(ISYM(LPTR),192) + SYMTYP ISYM(LPTR+1)=INS(3) C C*** IS THIS "SET"? IF(INS(1).NE.2) & ISYM(LPTR)=128 C*** SAVED IN 'ACT2' KK=ITOKEN(69) IF(KK.EQ.0) RETURN ISYM(KK)=INS(2) RETURN C... *** DC AND DS 540 INSL=1 IF(ISIZ.EQ.0) GO TO 545 C*** IF PCOUNT ODD, PUT OUT FILL BYTE(A ZERO) IN 'S' RECORD IF(MPUAND(IPC,1).NE.0) CALL PNCH(4,0) CALL MOD2 INSL=2 IF(ISIZ.EQ.128) INSL=4 545 IF(IOPC.NE.4) GO TO 550 C... *** DC C INS1=INS(3) IF(IADM(1,1).GE.0) GO TO 547 C*** INSL=9 TELLS OUTPUT TO PRINT STRING BYTE AT A TIME INSL=9 C... *** 'STRING' OVER 4 BYTES C DO 546 J=1,INS1 CALL PNCH(4,ITOKEN(J)) 546 CONTINUE RETURN C*** NUMERIC TYTE,WORD, OR LONG DC CONSTANT 547 IF(INSL.EQ.4) GO TO 548 C... *** BYTE OR WORD - ASSURE NOT TOO BIG C CALL RANGE(INS(3)) RETURN C C+++ 16-BIT - GET 1ST 2 BYTES 548 INS(1)=TKNVA2 RETURN C... *** DS 550 INS(3)=INS(3)*INSL 555 INSL=-2 C*** IPC=IPC+INS(3) CALL PNCH(5,INS(3)) RETURN C C*** FAIL 560 CALL ERR(INS(3)) RETURN C*** SPC *** 570 CONTINUE INSL=20 RETURN C C*** LINK/UNLK - ADDRESS REGISTER TO BITS 2-0 600 IF(IADM(1,1).NE.8) GO TO 9213 C*** 2 BYTE LINK INSTRUCTION ILLEGAL IF(INSL.EQ.2.AND.INS(1).EQ.20048) GO TO 12340 C*** CHECK FOR UNLK - 20056 = $4E58 IF(INS(1).EQ.20056) INSL=2 INS(1)=INS(1)+IADM(2,1)-8 RETURN C C*** SWAP - DATA REGISTER TO BITS 2-0 700 IF(IADM(1,1).NE.0) GO TO 9215 INS(1)=INS(1)+IADM(2,1) RETURN C C*** TRAP - ESTABLISH DISPLACEMENT IN BITS 3-0 800 INSL=2 IF(IADM(1,1).NE.56) GO TO 9209 IF(INS(3).GT.15) GO TO 9210 IF(INS(3).LT.0) GO TO 9216 INS(1)=INS(1)+INS(3) RETURN C C*** ABS/CLR/NEG/NOT/TST - BUILD EA 900 INS(1)=INS(1)+ISIZ C*** PC REL INVALID IF(SYMTYP.EQ.1) CALL ERR(237) C*** CHECK FOR ADDRESS REG IF(IADM(1,1).EQ.8) GO TO 9215 C*** *** ERROR IF IMMEDIATE MODE IF(IADM(1,1).EQ.60) GO TO 9218 GO TO 8300 C C*** NBCD 1000 GO TO 8300 C C*** PEA 1100 CONTINUE C*** PEA (AN)+ AND PEA -(AN) ILLEGAL, CHECK FOR THEM IF(IADM(1,1).EQ.24.OR.IADM(1,1).EQ.32) GO TO 9209 GO TO 8300 C C*** JSR,JMP 1200 GO TO 8300 C C*** BCC C 1300 IOFS=INS(3) - IPC - 2 C MAG=IABS(IOFS) C*** ALLOW ABSOLUTE ADDRESS ONLY IF(IADM(1,1).LT.56) CALL ERR(234) C*** IN CASE BIT 16 SET INSTRUCTION TO LONG, RESET IF(INSL.EQ.6) INSL=4 C IF(ISIZ.NE.0) GO TO 1310 C*** FORCE SHORT FORM IF(MAG.GT.127) CALL ERR(208) GO TO 1320 1310 IF(LFRF.NE.0) GO TO 1330 C... *** BACKWARD REFERENCE IF(MAG.GT.127) GO TO 1330 C... *** USE SHORT FORM 1320 INS(1)=INS(1) + MPUAND(IOFS,255) INSL=2 C*** IF OFFSET IS ZERO IT WILL CAUSE HARDWARE TO EXPECT LONG BRANCH AND C*** USE NEXT 2 BYTES FOR OFFSET SO FLAG AS ERROR. THIS IS CAUSED BY C*** A BRA TO NEXT INSTRUCTION. IF(IOFS.EQ.0) GO TO 9208 RETURN C... *** USE LONG FORMAT 1330 IF(MAG.GT.32767) CALL ERR(208) INS(3)=IOFS RETURN C C*** NEGX 1400 GO TO 900 C C*** EXT 1500 IF(ISIZ.EQ.0) GO TO 9217 C IF(ISIZ.EQ.128) INS(1)=IH48C0 INS(1)=MPUIOR(INS(1),IADM(2,1)) IF(IADM(1,1).EQ.8) CALL ERR(215) RETURN C C*** TAS 1600 GO TO 8300 C C*** SCC 1700 GO TO 8300 C C*** CONDITIONAL ASSEMBLY 1800 INSL=0 INS1=INS(1) GO TO(1810,1820),INS1 C... *** EQ 1810 IF(INS(3).NE.0) GO TO 1890 RETURN C... *** NE 1820 IF(INS(3).EQ.0) GO TO 1890 RETURN C... *** SKIP TO ENDC 1890 ICOL=-2 RETURN C C*** PAGE LENGTH(PLEN) - LINE LENGTH(LLEN) C 1900 CONTINUE C*** IS IT PLEN? IF(INS1.EQ.2) GO TO 1980 C*** CHECK FOR NEW MASK SET - STOP IF(INS1.EQ.1) GO TO 1910 INSL=4 IF(IADM(1,1).NE.60) CALL ERR(232) RETURN 1910 CONTINUE C*** LLEN LLENSW=1 LLEN=INS(3) IF(LLEN.GT.120) LLEN=120 IF(LLEN.LT.26) LLEN=26 INSL=0 RETURN C*** PLEN 1980 IPLEN=INS(3) RETURN C*** MULTIPLY,DIVIDE 2000 ISIZ=0 GO TO 8110 C C*** ADD/SUB PROCESSING C C... *** TEST FOR IMMEDIATE SOURCE 2100 CONTINUE C*** BYTE ADD ON AN ILLEGAL IF(IADM(1,2).EQ.8.AND.ISIZ.EQ.0) GO TO 9217 C*** ADD.B AN,DN ILLEGAL IF(IADM(1,1).EQ.8.AND.ISIZ.EQ.0) GO TO 9217 C*** DESINATION PC REL & PC REL + INDEX ILLEGAL IF(IADM(1,2).GT.57.AND.IADM(1,2).LT.61) CALL ERR(231) C*** CHECK FOR ADDI/SUBI - IF SO SKIP QUICK IF(INS(1).EQ.ZD001.OR.INS(1).EQ.Z9001) GO TO 6980 C*** IF ADDQ/SUBQ FORCE IT IF(INS(1).EQ.IH5K.OR.INS(1).EQ.IH5100) GO TO 2108 C*** ADDA/SUBA? IF(INS(1).EQ.ZD002.OR.INS(1).EQ.Z9002) GO TO 2125 IF(IADM(1,1).NE.60) GO TO 2120 C... *** POSSIBLE QUICK MODE? IF(INS(3).LE.0) GO TO 2110 IF(INS(3).GT.8) GO TO 2110 C*** CHECK FORWARD REF CANNOT BE 'Q' IF(LFRF.GT.0.AND.IADM(5,2).GT.0) GO TO 2110 IF(LFRF.GT.0.AND.IADM(1,2).LT.56) GO TO 2110 C... *** QUICK MODE 2105 INSL=INSL - 2 IF(ISIZ.EQ.128) INSL=INSL - 2 IF(INS(3).GT.8) GO TO 9210 KK=IH5K C*** IH5100=$5100 IF(INS(1).EQ.IHEX9K.OR.INS(1).EQ.IH5100) KK=IH5100 C INS(1)=ISHFT(INS(3),9) + ISIZ INS(1)=MPUIOR(INS(1),KK) IADM(3,2)=0 INS(3)=INS(5) C*** INCASE LONG WORD INS(2)=INS(4) GO TO 8600 C*** ADDQ/SUBQ MUST BE IMM 2108 IF(IADM(1,1).NE.60) CALL ERR(234) GO TO 2105 C... *** USE IMMEDIATE OP-CODE? 2110 IF(IADM(1,2).NE.8) GO TO 7000 C... *** CREATE MODE FIELD 2120 IF(IADM(1,2).EQ.0) GO TO 8110 IF(IADM(1,2).NE.8) GO TO 2130 C... *** SINK IS A REGISTER - ASSURE NOT BYTE IF(ISIZ.EQ.0) GO TO 9217 2125 ISIZ=ISIZ*2 C*** ADDA/SUBA INST. INS(1)=MPUAND(INS(1),ZF000) C*** INS(1)=INS(1) + MPUIOR(ISIZ,192) GO TO 8210 C... *** SINK TO MEMORY - ASSURE SOURCE IS D REGISTER 2130 ISIZ=ISIZ+256 GO TO 8400 C C*** AND,OR C C 2200 IF(IADM(1,1).EQ.8) GO TO 9215 IF(IADM(1,1).NE.0) GO TO 2310 C*** POSSIBLE D->EA IF(IADM(1,2).EQ.0) GO TO 8100 IF(IADM(1,2).EQ.8) GO TO 9215 ISIZ=MPUIOR(ISIZ,256) GO TO 8400 C C*** EOR C*** 8192 = $2000 2300 IF(IADM(1,1).NE.60) GO TO 8400 C*** IMMEDIATE MODE INS(1)=8192 C... *** TEST FOR CCR/SR DESTINATION 2310 IF(IADM(1,2).EQ.64) GO TO 2320 C... *** NOT CCR/SR - TRY IMM MODE IF(IADM(1,1).EQ.60) GO TO 7000 GO TO 8100 C... *** CCR/SR DESTINATION - ASSURE IMMEDIATE 2320 IF(IADM(1,1).NE.60) CALL ERR(232) C... ***CREATE IMM BIT PATTERM KK=ISHFT(INS(1),-12) KK=MPUAND(KK,7) INS(1)=IMCD(KK+1) + IADM(2,2) RETURN C C*** CMP C*** SWITCH INFO ON CMP 2380 KK=IADM(1,1) IADM(1,1)=IADM(1,2) IADM(1,2)=KK KK=IADM(2,1) IADM(2,1)=IADM(2,2) IADM(2,2)=KK C*** IF 6 OR MORE BYTE INST, SWITCH 'INS' ALSO IF(INSL.LT.6) GO TO 2390 IF(IADM(1,1).LT.40) GO TO 2390 KK=INS(2) INS(2)=INS(4) INS(4)=KK KK=INS(3) INS(3)=INS(5) INS(5)=KK 2390 GO TO (2406,2620,2720),I C... *** IS COMPARE WITH A REGISTER? 2400 CONTINUE C*** IS IT CMP S,D? I=1 IF(CMP.EQ.0) GO TO 2380 C*** CMPA? 2406 IF(INS(1).EQ.ZB001.AND.IADM(1,1).NE.8) GO TO 9213 IF(IADM(1,1).NE.8) GO TO 2410 C*** *** YES, USE CMPA(BYTE MODE ILLEGAL) IF(ISIZ.EQ.0) GO TO 9217 ISIZ=ISIZ*2 INS(1)=MPUIOR(IHA0C0,ISIZ) GO TO 8510 C... *** CAN WE USE CMPI? 2410 IF(IADM(1,2).NE.60) GO TO 8400 INS(1)=3072 + ISIZ IF(IADM(1,1).LT.40) GO TO 8300 C... *** MEMORY MODE KK=INS(3) INS(3)= INS(5) INS(5)=KK C+++ 16-BIT KK=INS(2) INS(2)= INS(4) INS(4)=KK IADM(3,2)=2 IF(IADM(1,1).EQ.57) IADM(3,2)=4 C*** 3=UNDEFINED SYMBOL/LABEL IF(IADM(5,2).EQ.3) IADM(3,2)=3 GO TO 8300 C C*** EXG 2500 CONTINUE C*** EXG DN,DM IF(IADM(1,1).EQ.0.AND.IADM(1,2).EQ.0) GO TO 2530 C*** EXG AN,DM IF(IADM(1,1).EQ.8.AND.IADM(1,2).EQ.0) GO TO 2505 C*** EXG DN,AM IF(IADM(1,1).EQ.0.AND.IADM(1,2).EQ.8) GO TO 2510 C*** EXG AN,AM IF(IADM(1,1).EQ.8.AND.IADM(1,2).EQ.8) GO TO 2520 GO TO 9209 2505 CONTINUE C*** EXG AN,DM I=IADM(2,1) IADM(2,1)=IADM(2,2) IADM(2,2)=I 2510 CONTINUE C*** DN,AM - 64=$40 INS(1)=INS(1)+64 GO TO 2530 C*** AN,AM 2520 CONTINUE INS(1)=ZB140 2530 INS(1)=INS(1)+ISHFT(IADM(2,1),9)+IADM(2,2) RETURN C C*** CHK 2600 I=2 C*** IS IT CHK S,D? IF(CMP.EQ.0) GO TO 2380 2620 GO TO 8500 C C*** CMPM 2700 I=3 C*** IS IT CMPM D,S? IF(CMP.EQ.1) GO TO 2380 2720 IF(IADM(1,1).NE.24) GO TO 9209 IF(IADM(1,2).NE.24) GO TO 9209 GO TO 7100 C C*** ADDX,SUBX 2800 GO TO 2910 C C*** ABCD,SBCD 2900 ISIZ=0 2910 IF(IADM(1,1).NE.0) GO TO 2920 IF(IADM(1,2).NE.0) GO TO 9209 GO TO 7100 C... *** -(A1),-(A1) MODE 2920 IF(IADM(1,1).NE.32) GO TO 9209 IF(IADM(1,2).NE.32) GO TO 9209 IADM(2,2)=IADM(2,2)-8 GO TO 7100 C C*** MOVEP C 3000 CONTINUE C*** CHECK FOR CORRECT BYTE SIZE - .B ILLEGAL IF(ISIZ.EQ.0) GO TO 9205 C*** ENTER LONG WORD FLAG? IF(ISIZ.EQ.128) INS(1)=INS(1) + 64 C*** FIND ADDRESS MODE IF(IADM(1,1).EQ.40) GO TO 3020 C*** REG TO MEMORY INSTRUCTION IF(IADM(1,2).NE.40) GO TO 9209 C*** RESET ADDRESS MODE FLAG TO ADD IN A FLAG LATER IADM(1,2)=8 C*** SET REG -> MEMORY FLAG - 128=$80 INS(1)=MPUIOR(INS(1),128) GO TO 8500 C*** MEMORY -> REG INSTRUCTION 3020 IADM(1,1)=8 GO TO 8200 C C*** DCNT C 3200 INSL=2 IF(IADM(1,2).EQ.57) IADM(1,2)=56 IF(IADM(1,1).NE.0) GO TO 9215 IF(IADM(1,2).NE.56) GO TO 9209 IOFS=INS(3) - IPC -2 IF(MASK2.EQ.0) GO TO 3201 IF(IOFS.GE.0.OR.IOFS.LT.-128) CALL ERR(208) INS(1)=INS(1) + ISHFT(IADM(2,1),9) + MPUAND(IOFS,255) RETURN C*** DBCC 3201 CONTINUE INS(1)=INS(1)+IADM(2,1) INSL=4 INS(3)=IOFS RETURN C C*** LEA C 3400 CONTINUE C*** DESTINATION MUST BE ADDRESS ONLY IF(IADM(1,2).NE.8) GO TO 9213 IADM(2,2)=MPUAND(IADM(2,2),7) C*** CHECK FOR VALID MODES IF(IADM(1,1).EQ.16) GO TO 8210 IF(IADM(1,1).LT.40) GO TO 9213 C*** IMM INVALID IF(IADM(1,1).EQ.60) GO TO 9234 GO TO 8210 C C*** SHIFTS 3500 CONTINUE IF(IADM(1,1).EQ.60.AND.ISIZ.EQ.128) INSL=INSL-2 C*** MAKE #BITNO LOOK LIKE BITNO IF(IADM(1,1).EQ.60) IADM(1,1)=56 IF(IADM(1,1).EQ.56) INSL=INSL-2 C*** ADDRESS REG IS ILLEGAL IF(IADM(1,2).EQ.8) GO TO 9215 IF(IADM(1,2).NE.0) GO TO 3520 C... *** REGISTER SHIFT IF(IADM(1,1).EQ.0) GO TO 3510 C... *** STATIC SHIFT IF(IADM(1,1).NE.56) GO TO 9209 IF(INS(3).LT.1) GO TO 9216 IF(INS(3).GT.8) GO TO 9208 IF(INS(3).EQ.8) INS(3)=0 INS(1)=INS(1)+ISHFT(INS(3),9)+ISIZ+IADM(2,2) RETURN C... *** DYNAMIC SHIFT 3510 ISIZ=ISIZ + LSP GO TO 8400 C... *** MEMORY SHIFT 3520 KK=MPUAND(INS(1),24) INS(1)=INS(1) - KK + 192 + ISHFT(KK,6) C*** 192 = $C0 C C*** ALLOW SHIFT 1,MEMORY IF(IADM(1,1).NE.56) GO TO 9209 IF(INS(3).NE.1) CALL ERR(236) C*** WORD SIZE ONLY ALLOWED. IF(ISIZ.NE.64) CALL ERR(238) INS(3)=INS(5) IF(IADM(7,2).EQ.0) GO TO 8600 IF(LFRF.GT.0.OR.TKNVA2.NE.0) INS(3)=INS(4) GO TO 8600 C C*** BIT INSTRUCTIONS 3600 CONTINUE J=8 C*** AN DESTINATION ILLEGAL IF(IADM(1,2).EQ.8) GO TO 9209 C*** IMM DESTINATION ILLEGAL IF(IADM(1,2).EQ.60) GO TO 9209 C*** WORD ILLEGAL IN THIS CASE, MASK 3 IF(ISIZ.EQ.64.AND.MASK2.LT.2) CALL ERR(238) C*** IF MASK 2 AND BX GO ADJUST IT IF(MASK2.EQ.1) GO TO 3920 3605 IF(IADM(1,1).NE.0) GO TO 3610 C*** DYNAMIC - IS IT BTST? IF(INS(1).EQ.256) GO TO 8510 C*** PC REL & PC REL + INDEX ILLEGAL FOR OTHERS IF(IADM(1,2).GT.57.AND.IADM(1,2).LT.61) CALL ERR(231) GO TO 8510 C*** STATIC 3610 IF(IADM(1,1).EQ.56.OR.IADM(1,1).EQ.60) GO TO 3620 GO TO 9209 C*** 1792=$700 3620 INS(1)=INS(1)+1792 IF(IADM(1,2).EQ.0) J=32 INS(3)=MOD(INS(3),J) GO TO 3680 3640 INS(3)=INS(3)-8 GO TO 3680 C*** MASK2=1 - AND WE HAVE BX.BB - ADJUST FOR MASK 2 3660 CONTINUE C*** ODD ADDRESS? I=MPUAND(INS(5),1) IF(I.EQ.0) GO TO 3670 INS(5)=INS(5)-1 GO TO 3930 3670 INS(3)=INS(3)+8 C*** TEST PC REL - PC REL + INDEX - VALID FOR BTST ONLY 3680 CONTINUE C*** BTST+$700 AT THIS POINT IF(INS(1).EQ.2048) GO TO 8600 IF(IADM(1,2).GT.57.AND.IADM(1,2).LT.61) CALL ERR(231) GO TO 8600 3900 IF(IADM(1,2).EQ.8) GO TO 9209 IF(IADM(1,2).EQ.60) GO TO 9209 J=16 IF(MASK2.NE.0) GO TO 3605 3920 IF(IADM(1,1).EQ.0.AND.IADM(1,2).EQ.0) GO TO 8510 IF(IADM(1,1).EQ.0) GO TO 9209 C*** (AN)+ -(AN) IF(IADM(1,2).EQ.24.OR.IADM(1,2).EQ.32) GO TO 9209 IF(IADM(1,2).EQ.0) J=32 INS(1)=INS(1)+1792 INS(3)=MOD(INS(3),J) IF(IADM(1,2).EQ.0) GO TO 3680 IF(IOPC.EQ.36) GO TO 3660 IF(INS(3).GT.7) GO TO 3640 C*** ADJ ADDR BY INS(5)=INS(5)+1 C*** IF (AN) SET UP DISPLACEMENT OF 1 3930 IF(IADM(1,2).NE.16) GO TO 3680 INSL=INSL+2 IADM(3,2)=1 IADM(1,2)=40 GO TO 3680 C C*** MOVE INSTRUCTION C... *** TEST FOR IMMEDIATE SOURCE AND D SINK 3700 CONTINUE C*** CHECK FOR 2ND OPERAND PRESENT IF(IADM(1,2).EQ.-1) GO TO 9209 C*** MOVE S,PC REL OR PC REL+INDEX ILLEGAL IF(IADM(1,2).GT.57.AND.IADM(1,2).LT.61) CALL ERR(231) C*** MOVEQ? IF(INS(1).EQ.I7KH) GO TO 3705 IF(IADM(1,1).NE.60) GO TO 3710 C*** IMM PC REL INVALID IF(SYMTYP.EQ.1) CALL ERR(231) IF(IADM(1,2).NE.0) GO TO 3710 C... *** MOVE #,0 - CAN WE USE LDQ? C*** 128 = $80 IF(ISIZ.NE.128) GO TO 3710 C*** FORWARD REFERENCE? IF(IADM(5,1).GT.0) GO TO 3710 IF(INS(3).LT. -127) GO TO 3710 IF(INS(3).GT.127) GO TO 3710 IF(INS(2).NE.0.AND.INS(2).NE.-1) GO TO 3710 IF(INS(2).EQ.0.AND.MPUAND(TKNVAL,Z8000).NE.0) GO TO 3710 C... *** USE LDQ 3705 INS(1)= I7KH + ISHFT(IADM(2,2),9) + MPUAND(INS(3),255) INSL=2 RETURN 3710 IF(ISIZ.NE.0) GO TO 3720 C... *** BYTE MODE IF(IADM(1,1).EQ.8) GO TO 9217 IF(IADM(1,2).EQ.8) GO TO 9217 3720 INS(1)=ISHFT(ISIZ,6)+4096 C*** MOVE.W= OPCODE 3 - MOVE.L = OPCODE 2 C*** 12288=$3000 - 8192=$2000 IF(ISIZ.EQ.0) GO TO 3726 IF(INS(1).EQ.12288) GO TO 3722 INS(1)=12288 GO TO 3726 3722 INS(1)=8192 3726 CONTINUE KM=MPUAND(IADM(1,2),56) IF(KM.EQ.56) GO TO 3730 C... *** REGISTER MODE (00-60) KR=MPUAND(IADM(2,2),7) GO TO 3740 C... *** MEMORY MODE (7X) 3730 KR=MPUAND(IADM(1,2),7) C... *** FORM FIELD-1 REG,MODE 3740 INS(1)=INS(1)+ISHFT(KR,9)+ISHFT(KM,3) C... *** FORM FIELD-2 EA C C... *** TEST FOR CONTROL REGISTER SOURCE IF(IADM(1,1).NE.64) GO TO 3760 C... *** SOURCE IS CONTROL REGISTER - ASSURE USP -> A IF(IADM(2,1).NE.16) GO TO 3750 IF(IADM(1,2).NE.8) GO TO 9213 C INS(1)=IH4E60 + IADM(2,2) RETURN C C... *** MOVE SR,EA? 3750 IF(IADM(2,1).NE.124) GO TO 9233 C... *** 124 = $7C INS(1)=IH40C0 GO TO 8600 C... *** TEST FOR CONTROL REGISTER DESTINATION 3760 IF(IADM(1,2).NE.64) GO TO 8300 C... *** DESTINATION IS CONTROL REGISTER A-> USP? IF(IADM(2,2).NE.16) GO TO 3770 C IF(IADM(1,1).NE.8) GO TO 9213 INS(1)=(IH4E60 - 8) + IADM(2,1) RETURN C... *** ASSUME EA -> CC/SR 3770 INS(1)=IH44C0 IF(IADM(2,2).EQ.124) INS(1)=IH46C0 GO TO 8300 C C*** LDM,STM - MOVEM C*** 19456 = $4C00 3800 INSL=INSL+2 C C*** CHECK FOR ILLEGAL LDM IF(IADM(1,1).LT.9.AND.INS(1).EQ.19456) GO TO 9209 INS(5)=INS(3) KM=2 KK=1 C*** IS IT STM PART OF MOVEM? IF(IADM(1,1).LT.9) GO TO 3810 INS(1)=19456 C*** LDM - ASSURE NOT -1(A) IF(IADM(1,1).EQ.32) GO TO 9209 C*** PUT IN BIT 7 FOR LDM INS(1)=INS(1) + 128 C*** SET THE MASK A0-D7 IN INS(3)=IADM(6,1) GO TO 3820 C*** STM - ASSURE NOT (A)+ OR PC RELATIVE 3810 CONTINUE KK=2 KM=1 C*** SET IN D0-A7 BIT MASK INS(3)=IADM(6,2) IF(IADM(1,2).EQ.24) GO TO 9209 IF(IADM(1,2).GE.58) GO TO 9208 C*** ASSURE NOT BYTE MODE 3820 IF(ISIZ.EQ.0) GO TO 9217 ISIZ=ISIZ-64 C C*** DISALLOW REGISTER DIRECT MODES IF(IADM(1,KK).LE.8) GO TO 9209 C*** ASSURE MASK IS FIRST FIELD IF(IADM(1,KM).GT.8) GO TO 9209 IF(INSL.EQ.6) IADM(3,2)=2 IF(INSL.EQ.8) IADM(3,2)=4 INS(1)=INS(1) + ISIZ C*** IF CONTROL MODE (AN), MASK MUST APPEAR SAME AS LDM MASK FOR (AN). IF(IADM(1,2).EQ.16.OR.IADM(1,2).EQ.40) INS(3)=IADM(6,1) IF(IADM(1,2).EQ.56.OR.IADM(1,2).EQ.57) INS(3)=IADM(6,1) IF(IADM(1,2).EQ.48) INS(3)=IADM(6,1) C*** LDM STM GO TO (8300,8600),KK C C*** --- STANDARD ACTIONS -- C C*** IMMEDIATE OPCODE C*** ADDI/SUBI TO AN ILLEGAL 6980 IF(IADM(1,2).EQ.8) GO TO 9209 C*** MUST BE IMM IF(IADM(1,1).NE.60) GO TO 9209 7000 IF(IADM(1,2).EQ.60) GO TO 9209 KK=ISHFT(INS(1),-12) KK=MPUAND(KK,7) INS(1)=IMCD(KK+1)+ISIZ IF(IADM(1,2).EQ.8) GO TO 9215 GO TO 8610 C C*** REGISTER-REGISTER OPCODES 7100 KK=ISHFT(IADM(2,2),9) INS(1)=MPUIOR(INS(1),KK)+ISIZ INS(1)=MPUIOR(INS(1),IADM(2,1)) RETURN C C -------- FIELD 1 --> FIELD 2 ------- C C*** ESTABLISH SIZE IN BITS 7-6 C... *** IS IMMEDIATE EA ALLOWED? 8100 IF(IADM(1,1).NE.60) GO TO 8110 IF(NIMM(IOPC).NE.0) GO TO 9218 8110 INS(1)=INS(1)+ISIZ C C*** ESTABLISH REGISTER(2) IN BITS 11-9 8200 IF(IADM(1,2).NE.0) GO TO 9215 8210 KK=ISHFT(IADM(2,2),9) INS(1)=MPUIOR(INS(1),KK) C C*** ESTABLISH EA(1) IN BITS 5-0 8300 IF(IADM(1,1).LT.0) GO TO 9209 INS(1)=INS(1)+IADM(1,1) IF(IADM(1,1).NE.0) GO TO 8320 C... *** DATA REGISTER MODE INS(1)=INS(1)+IADM(2,1) RETURN 8320 IF(IADM(1,1).LT.56) INS(1)=INS(1)+IADM(2,1)-8 C... *** ASSURE NOT SR DESTINATION IF(IADM(1,1).EQ.64) GO TO 9233 RETURN C C -------- FIELD 2 --> FIELD 1 ------- C*** ESTABLISH SIZE IN BITS 7-6 8400 INS(1)=INS(1)+ISIZ C C*** ESTABLISH DATA REGISTER(1) IN BITS 11-9 8500 IF(IADM(1,1).NE.0) GO TO 9215 8510 INS(1)=INS(1)+ISHFT(IADM(2,1),9) C C*** ESTABLISH EA(2) IN BITS 5-0 C... *** IS IMMEDIATE EA ALLOWED? 8600 IF(IADM(1,2).NE.60) GO TO 8610 IF(NIMM(IOPC).NE.0) GO TO 9218 8610 IF(IADM(1,2).LT.0) GO TO 9209 INS(1)=INS(1)+IADM(1,2) IF(IADM(1,2).NE.0) GO TO 8620 C... *** DATA REGISTER MODE INS(1)=INS(1)+IADM(2,2) RETURN 8620 IF(IADM(1,2).LT.56) INS(1)=INS(1)+IADM(2,2)-8 C... *** ASSURE NOT SR DESTINATION IF(IADM(1,2).EQ.64) GO TO 9233 RETURN C C*** ERROR STOPS C C*** BYTE SIZE ERROR 9205 CALL ERR(205) RETURN C... *** RANGE ERROR 9208 CALL ERR(208) RETURN C... *** ILLEGAL ADDRESS MODE 9209 CALL ERR(209) RETURN C*** VALUE TO BIG 9210 CALL ERR(210) RETURN C*** DATA SIZE INVALID 9212 CALL ERR(212) RETURN C... *** REGISTER MUST BE ADDRESS REGISTER 9213 CALL ERR(213) RETURN C... *** REGISTER MUST BE DATA REGISTER 9215 CALL ERR(215) RETURN C... *** NEGATIVE NOT ALLOWED 9216 CALL ERR(216) RETURN C... *** BYTE MODE NOT ALLOWED 9217 CALL ERR(217) RETURN C... *** DESTINATION MUST BE ALTERABLE 9218 CALL ERR(218) RETURN C... *** UNDEFINED ACTION (INTERNAL ERROR) 9223 CALL ERR(223) RETURN C... *** ILLEGAL REGISTER FOR THIS INSTRUCTION 9233 CALL ERR(233) RETURN 12340 INSL=4 9234 CALL ERR(234) RETURN END SUBROUTINE OBJ C+ NAM: OBJ VER: 1.0 DAT: 12/08/78 CMP: 16-BIT C C SYS: MACS C C ENT: N/A C C RTN: N/A C C FNC: CREATE THE OBJECT FILE OUTPUT C STUFFS EACH BYTE INTO A BUFFER, CALCULATES CHECKSUM. C C REV: N/A C CALLS PNCH C C* IMPLICIT INTEGER (A-Z) COMMON /A/ ISYM(3000),KARD1(96),ITOKEN(70),TKNSIZ,TKNTYP, & TKNVAL,TKNVA2,JSUC,JPTR,LPTR,NXSYM,KOLUMN,KD1BCT,KD1LNO,JERR, & MNUM,IPASS,IPC2,IPC,IOPC,INS(5),INSL,ISIZ,IADM(7,2),LUOT COMMON /A/ KASH(64),KPAC(15),KPWCT,LENSYM,KCLAS(64) COMMON /A/ NET1(64),NET2(64),NET3(64),NET4(64),NET5(64) COMMON /A/ NBPW,KSYS,IEOT,LSP,JBUF(83),KARD2(80,3),IHB480,IHEX9K COMMON /A/ IA1SHF,KCFF,LUSI,LUDI,LUOO,LLEN,IPLEN COMMON /A/ LIST,ICOL,NEST,LUCI,LULT,MFLD(11,3),IOBJ C C*** RETURN IF NO PUNCH OUTPUT DESIRED IF(IOBJ.EQ.0) RETURN IF(INSL.LE.0) RETURN C*** IF LONG 'STRING' DO NOT PUT OUT AGAIN IF(INSL.EQ.9) RETURN C*** SPC? IF(INSL.EQ.20) RETURN IF(INSL.NE.1) CALL PNCH(4,ISHFT(INS(1),-8)) CALL PNCH(4,INS(1)) GO TO (100,100,200,200,300,300,400,400,500,500),INSL C... *** ONE WORD 100 RETURN C... *** THREE WORD OR LARGER C 300 IF(IADM(3,2).EQ.0) GO TO 500 GO TO 200 400 IF(IADM(3,2).NE.2) GO TO 200 C... *** PUNCH INS(2) 500 CALL PNCH(4,ISHFT(INS(2),-8)) CALL PNCH(4,INS(2)) C... *** TWO WORD 200 CALL PNCH(4,ISHFT(INS(3),-8)) CALL PNCH(4,INS(3)) IF(INSL.LT.6) RETURN IF(IADM(3,2).EQ.0) RETURN C... *** FOUR/FIVE WORD C IF(IADM(3,2).NE.4) GO TO 1000 C... *** PUNCH INS(4) CALL PNCH(4,ISHFT(INS(4),-8)) CALL PNCH(4,INS(4)) C... *** FIVE WORD 1000 CALL PNCH(4,ISHFT(INS(5),-8)) CALL PNCH(4,INS(5)) RETURN END SUBROUTINE PNCH(JTYP,JVAL) C+ NAM: PNCH VER: 1.0 DAT: 02/19/79 CMP: PDP-11 C C SYS: MACS C C ENT: JTYP - FUNCTION TYPE C 1 - OUTPUT HEADER C 2 - OUTPUT TRAILER C 3 - NEW ORIGIN C 4 - NEXT BYTE IN SEQUENCE C 5 - ADJUST COUNT FOR A 'DS' C JVAL - DATA BYTE C C RTN: JTYP - N/C C JVAL - N/C C C FNC: WRITE THE OBJECT RECORDS TO DEVICE 'LUOO' C IF NO OUTPUT DESIRED(IOBJ=0) IT RETURNS. C S1 RECORD = 2 BYTE ADDRESS C S2 RECORD = 3 BYTE ADDRESS C CALLS MPUAND-HEXASC-ISHFT-ADD C C* IMPLICIT INTEGER (A-Z) COMMON /A/ ISYM(3000),KARD1(96),ITOKEN(70),TKNSIZ,TKNTYP, & TKNVAL,TKNVA2,JSUC,JPTR,LPTR,NXSYM,KOLUMN,KD1BCT,KD1LNO,JERR, & MNUM,IPASS,IPC2,IPC,IOPC,INS(5),INSL,ISIZ,IADM(7,2),LUOT COMMON /A/ KASH(64),KPAC(15),KPWCT,LENSYM,KCLAS(64) COMMON /A/ NET1(64),NET2(64),NET3(64),NET4(64),NET5(64) COMMON /A/ NBPW,KSYS,IEOT,LSP,JBUF(83),KARD2(80,3),IHB480,IHEX9K COMMON /A/ IA1SHF,KCFF,LUSI,LUDI,LUOO,LLEN,IPLEN COMMON /A/ LIST,ICOL,NEST,LUCI,LULT,MFLD(11,3),IOBJ,LLENSW,NOP DIMENSION LIN(17) DIMENSION LIN2(50) DATA JX/0/ DATA CKSM/0/ DATA JPC/0/,JPC1/0/ DATA ISREC/1/ 9900 FORMAT('S',I1,50A1) C*** CHECK FOR NO OBJECT OUT IF(IOBJ.EQ.0) RETURN JVAL1=JVAL GO TO(100,200,300,400,250),JTYP C C*** OUTPUT HEADER 100 WRITE(LUOO,110) 110 FORMAT('S00600004844521B') RETURN C 200 CONTINUE C*** OUTPUT TRAILER C*** ASSURE LAST RECORD IS OUT IF(JX.NE.0) GO TO 410 220 WRITE(LUOO,210) 210 FORMAT('S9030000FC') RETURN C*** INCREMENT FOR A 'DS' 250 NPC1=IPC2 NPC=IPC CALL ADD(NPC1,NPC,0,JVAL1) GO TO 320 C C*** NEW ORIGIN 300 NPC=JVAL1 NPC1=IPC2 320 IF(JX.NE.0) GO TO 410 GO TO 430 C C*** NEXT BYTE IN SEQUENCE 400 CONTINUE JX=JX+1 LIN(JX)=JVAL1 C*** IS THIS FIRST TIME THRU? IF(CKSM.NE.0) GO TO 405 C*** ADD 2 BYTE ADDRESS TO COUNT J=ISHFT(JPC,-8) CKSM=IPC2 + J + MPUAND(JPC,KCFF) 405 CKSM=CKSM+JVAL1 IF(JX.NE.16) RETURN C*** OUTPUT THE FULL LINE C*** NPC=NPC+JX - USE 'ADD' TO GET 32 BITS. CALL ADD(NPC1,NPC,0,JX) 410 JX=JX+1 C*** JXX= # BYTES IN RECORD INCLUDING CHECK SUM JXX=JX + 2 + ISREC - 1 J=CKSM + JXX C*** CALCULATE THE CHECK SUM. CKSM=KCFF - MPUAND(J,KCFF) LIN(JX) = CKSM C*** CONVERT THE WHOLE MESS TO ASCII CALL HEXASC(JXX,LIN2,2,1) CALL HEXASC(JPC,LIN2,4,5) J=7 DO 415 I=1,JX J=J+2 CALL HEXASC(LIN(I),LIN2,2,J) 415 CONTINUE J=J+1 C*** IS IT 16 OR 24 BIT ADDRESS? IF(ISREC.EQ.1) GO TO 425 CALL HEXASC(JPC1,LIN2,2,3) WRITE(LUOO,9900) ISREC,(LIN2(I),I=1,J) GO TO 430 C*** 2 BYTE ADDRESS. 425 WRITE(LUOO,9900) ISREC,LIN2(1),LIN2(2),(LIN2(I),I=5,J) 430 JX=0 C*** OUTPUT TRAILER? IF(JTYP.EQ.2) GO TO 220 CKSM = 0 C*** INCREMENT THE P-COUNT JPC=NPC JPC1=NPC1 IF(JPC1.NE.0) ISREC=2 IF(JPC1.EQ.0) ISREC=1 RETURN END SUBROUTINE PRSYM C+ NAM: PRSYM VER: 1.0 DAT: 01/31/79 CMP: PDP-11 C C SYS:MACS C C ENT: N/A C C RTN: N/A C C FNC: FIND SYMBOL NAME AND ADDRESS IN SYMBOL TABLE, C STUFF IN LOW 'ISYM', SORT, THEN OUTPUT TO 'LUOT'. C CALLS MPUGTC-MPUPTC-MPUAND-PAGE-ISHFT C C* IMPLICIT INTEGER (A-Z) COMMON /A/ ISYM(3000),KARD1(96),ITOKEN(70),TKNSIZ,TKNTYP, & TKNVAL,TKNVA2,JSUC,JPTR,LPTR,NXSYM,KOLUMN,KD1BCT,KD1LNO,JERR, & MNUM,IPASS,IPC2,IPC,IOPC,INS(5),INSL,ISIZ,IADM(7,2),LUOT COMMON /A/ KASH(64),KPAC(15),KPWCT,LENSYM,KCLAS(64) COMMON /A/ NET1(64),NET2(64),NET3(64),NET4(64),NET5(64) COMMON /A/ NBPW,KSYS,IEOT,LSP,JBUF(83),KARD2(80,3),IHB480,IHEX9K COMMON /A/ IA1SHF,KCFF,LUSI,LUDI,LUOO,LLEN,IPLEN COMMON /A/ LIST,ICOL,NEST,LUCI,LULT,MFLD(11,3),IOBJ,LLENSW,NOP COMMON /A/ NXSYM1 DATA LSN/1/ DATA LSPP/' '/ C*** SHOULD TABLE BE LISTED? IF(LIST.EQ.0) RETURN 9900 FORMAT(//' SYMBOL TABLE'/) WRITE(LUOT,9900) CALL PAGE(4) NX=NXSYM1 10 ISIZ=ISHFT(ISYM(NX+1),-8) ITYP=MPUAND(ISYM(NX+1),255) C*** CHECK FOR MACRO IF(ITYP.EQ.255) GO TO 1000 IF(ITYP.NE.1) GO TO 850 C*** SYMBOL IS A LABEL JPTR=NX+ISIZ+3 ITYP=MPUAND(ISYM(JPTR),7) IF(ITYP.GT.1) GO TO 850 C*** GET CHAR SYMBOL 2 BY 2 I=ISIZ*2 CALL MPUGTC(J,ISYM(NX+3),I) C*** IF LAST CHAR IS BINARY ZERO, REPLACE WITH ASCII BLANK IF(J.EQ.0) CALL MPUPTC(LSP,ISYM(NX+3),I) I=ISYM(NX+3) J=LSPP IF(ISIZ.GT.1) J=ISYM(NX+4) K=LSPP IF(ISIZ.GT.2) K=ISYM(NX+5) L=LSPP IF(ISIZ.GT.3) L=ISYM(NX+6) JJ=LSN IF(LSN.EQ.1) GO TO 800 70 II=LSN/6 C*** NEGATIVE DO LOOP VALUE M= -1 C*** FIND WHERE THIS SYMBOL GOES ALPHABETICALLY & INSERT C*** NEXT HIGH LOCATION IN TABLE KK=1 IF(II.EQ.2) KK=7 IF(II.LT.3) GO TO 100 II=(II+1)/2 KK=LSN - II*6 C*** UPPER HALF OF ARRAY? 100 CONTINUE KKK=KK IF(ISYM(KK).LT.I) GO TO 200 C*** LOWER HALF? IF(ISYM(KK).GT.I) GO TO 400 IF(ISYM(KK+1).LT.J) GO TO 200 IF(ISYM(KK+1).GT.J) GO TO 400 IF(ISYM(KK+2).LT.K) GO TO 200 IF(ISYM(KK+2).GT.K) GO TO 400 IF(ISYM(KK+3).LT.L) GO TO 200 IF(ISYM(KK+3).GT.L) GO TO 400 C*** UPPER HALF OF ARRAY, FIND WHICH HALF OF THIS HALF SYMBOL FALLS IN C*** ARE WE DONE? 200 IF(II.EQ.1) GO TO 500 C*** NOT DONE, CUT IN HALF AGAIN KK=KK + (II/2)*6 II=(II+1)/2 C*** ARE WE AT TOP OF TABLE? IF(KK.GE.LSN) GO TO 800 GO TO 100 C*** LOWER HALF, CUT IT IN HALF 400 IF(II.EQ.1) GO TO 450 KK=KK - (II/2)*6 II=(II+1)/2 GO TO 100 C*** CHECK FOR POSSIBILITY CURRENT VALUE IS LESS THAN C*** NEXT LOWEST ONE BEING POINTED AT. 450 IF(KK.EQ.1) GO TO 550 C*** CHECK NEXT LOWER VALUE. KK=KK-6 GO TO 100 500 KKK=KKK+6 550 CONTINUE C*** MOVE SYMBOLS UP IN TABLE JJ=LSN 600 ISYM(JJ+6)=ISYM(JJ) C*** IS LOOP DONE? IF(JJ.EQ.KKK) GO TO 800 JJ=JJ-1 GO TO 600 C*** INSERT CURRENT SYMBOL C*** SET NEXT SYMBOL IN ALPHABETICAL ORDER 800 ISYM(JJ)=I ISYM(JJ+1)=J ISYM(JJ+2)=K ISYM(JJ+3)=L C*** INSERT ADDRESS OF SYMBOL. ISYM(JJ+4)=ISYM(NX) ISYM(JJ+5)=ISYM(JPTR+1) C*** FIND BYTE POSITION TO CHECK FOR ZERO IF ODD # OF CHAR IN NAME. LSN=LSN+6 C*** ADVANCE TOTHE NEXT SYMBOL 850 NX=NX+ISIZ+5 IF(NX.LT.NXSYM) GO TO 10 C*** IF NO ENTRIES DON'T OUTPUT. 870 IF(LSN.EQ.1) GO TO 900 LSN=LSN-1 C*** PRINT SYMBOL TABLE DO 300I=1,LSN,24 NX=I+23 IF(NX.GT.LSN) NX=LSN II=1 DO 250 J=I,NX,6 JBUF(II)=ISHFT(ISYM(J),8)+ISHFT(ISYM(J),-8) JBUF(II+1)=ISHFT(ISYM(J+1),8)+ISHFT(ISYM(J+1),-8) JBUF(II+2)=ISHFT(ISYM(J+2),8)+ISHFT(ISYM(J+2),-8) JBUF(II+3)=ISHFT(ISYM(J+3),8)+ISHFT(ISYM(J+3),-8) C*** CONVERT HEX TO ASCII CALL HEXASC(ISYM(J+4),JBUF,2,II+4) CALL HEXASC(ISYM(J+5),JBUF,4,II+6) II=II+10 250 CONTINUE II=II-1 WRITE(LUOT,998) (JBUF(J),J=1,II) CALL PAGE(1) 300 CONTINUE 998 FORMAT(4(1X,4A2,3X,6A1)) 900 CONTINUE RETURN C*** FIND END OF MACRO AND START WITH SYMBOL FOLLOWING IT. 1000 CONTINUE NX=NX+ISIZ+5 1040 K=1 IF(NX.GE.NXSYM) GO TO 870 1050 CALL MPUGTC(I,ISYM(NX),K) K=K+1 C*** END OF MACRO DEFINITION IS A 04 FOLLOWED BY WORD OF ZEROS IF(I.NE.4) GO TO 1050 NX=NX+(K+2)/2-1 IF(ISYM(NX).NE.0) GO TO 1040 NX=NX+1 GO TO 10 END SUBROUTINE PAGE(LCNT) C+ NAM: PAGE VER: 1.0 DAT: 02/02/79 CMP: PDP-11 C C SYS: MC6800 ASM C C ENT: LCNT - NUMBER OF LINES JUST OUTPUT, OR IF > 79 THEN C - 80 = SET TTL IN BUFFER C - 81 = OUTPUT HEADER TO DEVICE 'LULT' C - 82 = OUTPUT HEADER TO DEVICE 'LUOT' C - 83 = SAME AS 82 FOR PDP-11 C - 84 = 'PAGE', SLEW TO TOP OF PAGE IF 'LUOT'=PRINTER C - 85 = SKIP TO BOTTOM OF PAGE, DONOT PRINT HEADER C C RTN: N/C C C FNC: THIS ROUTINE INCREMENTS THE LINE COUNTER AND OUTPUTS A C TOP OF PAGE HEADER AT PROPER TIME. IT PUTS C HEADER INTO OUTPUT BUFFER WHEN ENCOUNTERING THE 'TTL' C COMMAND. PAGING IS EFFECTIVE FOR PRINTER OUTPUT ONLY. C THIS ROUTINE CONTAINS THE RELEASE # AND COPYRIGHT C MESSAGE IN A DATA STATEMENT, THE ONLY PLACE IT APPEARS C IN THE PROGRAM. C CALLS MPUPTC C C* IMPLICIT INTEGER (A-Z) COMMON /A/ISYM(3000),KARD1(96),ITOKEN(70),TKNSIZ,TKNTYP, & TKNVAL,TKNVA2,JSUC,JPTR,LPTR,NXSYM,KOLUMN,KD1BCT,KD1LNO,JERR, & MNUM,IPASS,IPC2,IPC,IOPC,INS(5),INSL,ISIZ,IADM(7,2),LUOT COMMON /A/ KASH(64),KPAC(15),KPWCT,LENSYM,KCLAS(64) COMMON /A/ NET1(64),NET2(64),NET3(64),NET4(64),NET5(64) COMMON /A/ NBPW,KSYS,IEOT,LSP,JBUF(83),KARD2(80,3),IHB480,IHEX9K COMMON /A/ IA1SHF,KCFF,LUSI,LUDI,LUOO,LLEN,IPLEN COMMON /A/ LIST,ICOL,NEST,LUCI,LULT,MFLD(11,3),IOBJ,LLENSW,NOP DIMENSION ITTL(30) C*** RELEASE AND COPYRIGHT MESSAGE.. DATA ITTL/'MC','68','00','0 ','AS','M ','RE' & ,'V=',' 1','.3',' -',' C','OP','YR','IG','HT' & ,' B','Y ','MO','TO','RO','LA',' 1','97','8 ',' ', & ' ',' ',' ',' '/ DATA IPAGE/1/,LINENO/0/ DATA ITTLSZ/30/ C*** ITTLSZ IS SIZE OF 'ITTL' DATA ISW/0/ 998 FORMAT(2X,30A2,' PAGE',I3//) 9900 FORMAT(80A1) 9910 FORMAT(5X,40A2) 9920 FORMAT(1X,30A2) 9930 FORMAT(2X,30A2) C** IS LISTING REQUIRED? IF(LIST.EQ.0) RETURN C*** IS PAGING REQUIRED? IF(NOP.EQ.0) RETURN LCN=LCNT IF(LCN.GT.79) GO TO 500 C*** INCREMENT LINE COUNT LINENO=LINENO+LCN IF(LINENO.LT.IPLEN-6) RETURN C*** PAGE IT GO TO 8400 500 CONTINUE LCN=LCN-79 GO TO(8000,8100,8200,8300,8400,8400),LCN RETURN C*** PUT TTL IN BUFFER 8000 CONTINUE DO 8020 I=1,30 8020 ITTL(I)=' ' J=1 C*** FIND 'TTL' IN BUFFER DO 8030 I=LCN,72 C*** LOOK FOR 'L' IN 'TTL' IF(KARD1(I).EQ.76) GO TO 8040 8030 CONTINUE 8040 LCN= I+1 C*** INSERT THE TITLE. DO 8050 I=LCN,64 CALL MPUPTC(KARD1(I),ITTL,J) J=J+1 8050 CONTINUE C*** REVERSE THE LETTERS IN TITLE DO 8060 I=1,30 ITTL(I)=ISHFT(ITTL(I),8) + ISHFT(ITTL(I),-8) 8060 CONTINUE RETURN C*** OUTPUT TO 'LULT' 8100 WRITE(LULT,9920) (ITTL(I),I=1,ITTLSZ) RETURN C*** OUTPUT TO LUOT 8200 CONTINUE C*** IF ERRORS IN PASS1 SLEW TO TOP OF PAGE FOR PASS2 IF(LINENO.EQ.3) RETURN IF(LINENO.EQ.0) GO TO 8220 GO TO 8400 8220 IF(LUOT.NE.LULT) WRITE(LUOT,998) (ITTL(I),I=1,ITTLSZ),IPAGE IPAGE=IPAGE+1 LINENO=3 RETURN 8300 CONTINUE GO TO 8200 8400 CONTINUE C*** SKIP TO TOP OF PAGE IF(LUOT.EQ.LULT) RETURN DO 8450 I=LINENO,IPLEN WRITE(LUOT,9900) LSP 8450 CONTINUE LINENO=3 IF(LCN.EQ.6) RETURN GO TO 8220 9000 RETURN END SUBROUTINE PCOUNT C+ NAM: PCOUNT VER: 1.0 DAT: 01/29/79 CMP: PDP-11 C C SYS: MACS C C ENT: 'IPC' CONTAINS 2 LEAST SIGNIFICANT BYTES OF P-COUNT. C 'IPC2' = MOST SIGNIFICANT BYTE OF P-COUNTER. C 'INSL' = AMOUNT TO INCREMENT P-COUNT BY. C C RTN: 'IPC' AND 'IPC2' HAVE NEXT P-COUNT. C C FNC: THE CURRENT INSTRUCTION LENGTH IN 'INSL' IS ADDED C TO 'IPC' & 'IPC2' TO GIVE NEXT INSTRUCTION ADDRESS. C C REV: N/A C C* IMPLICIT INTEGER (A-Z) COMMON /A/ ISYM(3000),KARD1(96),ITOKEN(70),TKNSIZ,TKNTYP, & TKNVAL,TKNVA2,JSUC,JPTR,LPTR,NXSYM,KOLUMN,KD1BCT,KD1LNO,JERR, & MNUM,IPASS,IPC2,IPC,IOPC,INS(5),INSL,ISIZ,IADM(7,2),LUOT COMMON /A/ KASH(64),KPAC(15),KPWCT,LENSYM,KCLAS(64) COMMON /A/ NET1(64),NET2(64),NET3(64),NET4(64),NET5(64) COMMON /A/ NBPW,KSYS,IEOT,LSP,JBUF(83),KARD2(80,3),IHB480,IHEX9K COMMON /A/ IA1SHF,KCFF,LUSI,LUDI,LUOO,LLEN,IPLEN COMMON /A/ LIST,ICOL,NEST DATA IO1/O100000/,IO7/O77777/ C*** SAVE M.S. BIT K=IPC .AND. IO1 C*** REMOVE M.S. BIT SO CARRY ON ADD CAN BE DETECTED IPC=IPC .AND. IO7 IPC=IPC + INSL C*** DID ADD PUT A BIT IN 16TH POSITION? J=IPC .AND. IO1 IF(J.NE.0) GO TO220 C*** NO CARRY ON ADD, PUT 16TH BIT BACK IN CASE IT IS 1. IPC=IPC .OR. K GO TO 240 220 CONTINUE C*** ADD HAD CARRY, INCREMENT 2ND WORD IF PREVIOUS UPPER BIT NOT ZERO. IF(K.NE.0) K=1 IPC2=IPC2+K C*** J NE 0 AND K NE 0 THERE IS ROLL OVER AND 16TH BIT MUST BE ZERO. IF(K.EQ.1) IPC=IPC .AND. IO7 240 CONTINUE RETURN END SUBROUTINE HEXASC(IHEX,IB,KNT,IPOS) C+ NAM: HEXASC VER: 1.0 DATE: 05/18/19 CMP: PDP-11 C C SYS: MACS C C ENT: IHEX - CONTAINS HEX CHARACTERS TO CONVERT C IB - N/A C KNT - NUMBER OF HEX CHAR TO CONVERT C MAX OF 4 HEX CHARS, ONE WORD, CAN BE CONVERTED AT A TIME C IPOS - POSITION IN 'IB' TO PUT THE CONVERTED CHARS. C C RTN: IHEX - N/C C IB - CONTAINS THE HEX CHARS IN ASCII, 1 PER WORD C KNT - N/C C IPOS - N/C C C REV: N/A C C C FNC: CHANGE HEX VALUES TO ASCII AND STORE ONE CONVERTED HEX VALUE C PER ARRAY WORD. C CALLS MPUAND-ISHFT C* IMPLICIT INTEGER (A-Z) COMMON /A/ ISYM(3000),KARD1(96),ITOKEN(70),TKNSIZ,TKNTYP, & TKNVAL,TKNVA2,JSUC,JPTR,LPTR,NXSYM,KOLUMN,KD1BCT,KD1LNO,JERR, & MNUM,IPASS,IPC2,IPC,IOPC,INS(5),INSL,ISIZ,IADM(7,2),LUOT COMMON /A/ KASH(64),KPAC(15),KPWCT,LENSYM,KCLAS(64) COMMON /A/ NET1(64),NET2(64),NET3(64),NET4(64),NET5(64) COMMON /A/ NBPW,KSYS,IEOT,LSP,JBUF(83),KARD2(80,3),IHB480,IHEX9K COMMON /A/ IA1SHF,KCFF,LUSI,LUDI,LUOO,LLEN,IPLEN COMMON /A/ LIST,ICOL,NEST DIMENSION IB(120) IPOS2=IPOS+KNT-1 K=IHEX DO 100 I=1,KNT C*** GET 1ST 4 BITS J=MPUAND(K,15) C*** CHECK 0-9 & A-F IF(J.GT.9) GO TO 50 C*** 0-9 IB(IPOS2)=J+48 GO TO 80 C*** A-F 50 CONTINUE IB(IPOS2)=J + 55 80 IPOS2=IPOS2-1 C*** GET THE NEXT 4 BITS TO THE RIGHT, LEAST SIGNIFICANT. K=ISHFT(K,-4) 100 CONTINUE RETURN END FUNCTION MPUAND (JA,JB) C+ NAM: MPUAND VER: 1.0 DATE: 04/16/79 CMP: PDP-11 C C SYS: MACS C C ENT: JA - VALUE TO BE ANDED C JB - VALUE TO AND WITH C C RTN: JA - N/C C JB - N/C C C FNC: 'AND' JA WITH JB C C REV: N/A C* MPUAND=JA .AND. JB RETURN END FUNCTION MPUIOR (JA,JB) C+ NAM: MPUIOR VER: 1.0 DATE: 04/16/79 CMP:PDP-11 C C SYS: MACS C C ENT: JA - VALUE TO BE 'ORED' C JB - VALUE TO USE IN THE 'OR' C C RTN: JA - N/C C JB - N/C C C FNC: THE VALUE OF JB IS 'ORED' INTO JA C C REV: N/A C C* MPUIOR= JA .OR. JB RETURN END FUNCTION ISHFT(K1,K2) C+ NAM: ISHFT VER: 1.0 DATE: 04/16/79 CMP: PDP-11 C C SYS: MACS C C ENT: K1 - VALUE TO BE SHIFTED C K2 - AMOUNT TO SHIFT K1 C = MINUS VALUE, SHIFT RIGHT TO LSB. C = POSITIVE VALUE, SHIFT LEFT, HIGH ORDER BIT. C C RTN: K1 - N/C C K2 - N/C C C FNC: SHIFT A 16-BIT WORD RIGHT OR LEFT. C C REV: N/A C CALLS IABS DATA IO7/O37777/ DATA IO57S/O77777/ DATA IO4/O40000/ DATA IO1/O100000/ K=K1 C*** C*** ASSEMBLY ROUTINE SHIFT MAY NOT BE RETURNING RIGHT C** C*** USE MULT AND DIVIDE FOR NOW C KK=K2 50 CONTINUE C*** IF SHIFT VALUE IS ZERO, RETURN IF(KK.EQ.0) GO TO 300 IF(KK.LT.0) GO TO 100 DO 80 I=1,KK C*** SAVE 15TH BIT IN CASE ON. IF SO IT CAUSES A RUNTIME C*** MULTIPLY ERROR. IF ON IT MUST BE OR'ED IN LATER SO IT ISN'T LOST KKK=K .AND. IO4 K=K .AND. IO7 80 K=K*2 C*** IF THE 15TH BIT WAS ON BEFORE LAST SHIFT, OR IT IN HERE, IT IS C*** THE 16TH BIT. IF(KKK.NE.0) K=K .OR. IO1 ISHFT=K RETURN 100 KK=IABS(KK) C*** STATEMENT: KK= -KK APEARS TO CAUSE F342 ERROR, SO USED IABS DO 250 I=1,KK C*** KEEP UPPER BIT IN CASE ON. IF IT IS ON IT MUST BE OR'ED C*** IN. IF LEFT ON # IS MINUS AND DIVIDE WILL NOT WORK FOR SHIFTING C*** DATA. KKK=K .AND. IO1 K=K .AND. IO57S K=K/2 C*** IF 16TH BIT WAS ON PUT IT IN 15TH POSITION . IF(KKK.NE.0) K=K .OR. IO4 250 CONTINUE 300 CONTINUE ISHFT=K RETURN END SUBROUTINE MPUPTC(JBYT,JBUF,JBIX) C+ NAM: MPUPTC VER: 1.0 DATE: 04/19/79 CMP: 16-BIT C C SYS: MACS C C ENT: JBYT - BYTE IN THE RIGHT 8 BITS OF THE WORD(LOW ORDER BITS) C JBUF - N/A C JBIX - BYTE INDEX LOCATION TO PLACE JBYT IN JBUF, LEFT BYTE C IS BYTE 1 ETC. C C RTN: JBYT - N/C C JBUF - CONTAINS BYTE FROM JBYT IN THE JBIX POSITION C JBIX - N/C C C FNC: TAKE THE RIGHT JUSTIFIED, ZERO FILLED BYTE FROM C JBYT AND PLACE IT IN THE JBIX POSITION OF JBUF. C C REV: N/A C CALLS MPUAND-ISHFT-MOD C C* DIMENSION JBUF(10) DATA IOV1/O177400/ K1=JBIX J1=JBYT KK=MOD(K1,2) IF(KK.EQ.0) GO TO 500 C*** M.S. BYTE - UPPER BYTE OF WORD K1=K1/2+1 KK=JBUF(K1) JBUF(K1)=MPUAND(KK,255) + ISHFT(J1,8) RETURN C*** L.S. BYTE - LOWER BYTE OF WORD 500 CONTINUE K1=K1/2 KK=JBUF(K1) JBUF(K1)=MPUAND(KK,IOV1) + J1 RETURN END SUBROUTINE MPUGTC(JBYT,JBUF,JBIX) C+ NAM: MGUPTC VER: 1.0 DATE: 04/19/79 CMP: 16-BIT C C SYS: MACS C C ENT: JBYT - N/A C JBUF - WORD OR ARRAY CONTAINING DESIRED BYTE(CHAR) C JBIX - INDEX, POSITION IN JBUF TO GET BYTE(CHAR) FROM C C RTN: JBYT - BYTE(CHAR) FROM JBUF, RIGHT JUSTIFIED, ZERO FILLED C JBUF - N/C C JBIX - N/C C C FNC: TAKE THE JBIX BYTE(CHAR) FROM JBUF AND STORE IT C RIGHT JUSTIFIED, ZERO FILLED IN JBYT, THE LOWER 8 BITS. C C REV: N/A C CALLS MPUAND-ISHFT-MOD C C* DIMENSION JBUF(1) K1=JBIX KK=MOD(K1,2) IF(KK.EQ.0) GO TO 500 C*** M.S. BYTE - UPPER BYTE OF WORD K1=K1/2+1 KK=JBUF(K1) JBYT=ISHFT(KK,-8) RETURN C*** L.S. BYTE - LOWER BYTE OF WORD 500 CONTINUE K1=K1/2 KK=JBUF(K1) JBYT=MPUAND(KK,255) RETURN END SUBROUTINE ASCBIN C+ NAM: ASCBIN VER: 1.0 DATA@E: 04-23/79 CMP: PDP-11 C C SYS: MACS C C ENT: 'ITOKEN' = THE ARRAY WHICH CONTAINS THE RIGHT JUSTIFIED C ZERO FILLED ASCII NUMBER. C 'TKNSIZ' = NUMBER OF CHARACTERS IN 'ITOKEN' C 'TKNVAL AND 'TKNVA2'= 0 C C RTN: 'TKNVAL' = 2 LEAST SIGNIFICANT BYTES. C 'TKNVA2' = 2 M.S.B. C C FNC: THIS ROUTINE TAKES A RIGHT JUSTIFIED, ZERO FILLED ASCII C ARRAY AND CONVERTS IT TO A BINARY # UP TO 4 BYTES LONG. C C REV: N/A C CALLS ISHFT C C* C* IMPLICIT INTEGER (A-Z) COMMON /A/ ISYM(3000),KARD1(96),ITOKEN(70),TKNSIZ,TKNTYP, & TKNVAL,TKNVA2,JSUC,JPTR,LPTR,NXSYM,KOLUMN,KD1BCT,KD1LNO,JERR, & MNUM,IPASS,IPC2,IPC,IOPC,INS(5),INSL,ISIZ,IADM(7,2),LUOT COMMON /A/ KASH(64),KPAC(15),KPWCT,LENSYM,KCLAS(64) COMMON /A/ NET1(64),NET2(64),NET3(64),NET4(64),NET5(64) COMMON /A/ NBPW,KSYS,IEOT,LSP,JBUF(83),KARD2(80,3),IHB480,IHEX9K COMMON /A/ IA1SHF,KCFF,LUSI,LUDI,LUOO,LLEN,IPLEN COMMON /A/ LIST,ICOL,NEST C*** DATA IO1/O100000/ DATA IO7/O77777/ DO 600 I=1,TKNSIZ C*** REMOVE ASCII BITS ITOKEN(I)=ITOKEN(I) - 48 C*** SAVE FOR LATER TKNVA3=TKNVAL TKNVA4=TKNVA2 C*** SHIFT TWICE DO 100 J=1,2 C*** IS M.S. BIT ON? K=TKNVAL .AND. IO1 C*** SHOULD M.S. BIT BE MOVED INTO 2ND WORD, 1ST BIT. IF(K.NE.0) K=1 TKNVA2=ISHFT(TKNVA2,1)+K 50 TKNVAL=ISHFT(TKNVAL,1) 100 CONTINUE C*** ADD IN THE # WE HAD BEFORE SHIFTING STARTED C C*** SAVE M.S. BIT K=TKNVAL .AND. IO1 C*** REMOVE M.S. BITSO CARRY ON ADD CAN BE DETECTED TKNVAL=TKNVAL .AND. IO7 200 TKNVAL=TKNVAL+TKNVA3 C*** DID ADD PUT A BIT IN 16TH POSITION? J=TKNVAL .AND.IO1 C*** NO CARRY ON ADD, PUT 16TH BIT BACK IN CASE IT IS 1 IF(J.EQ.0) 1 TKNVAL=TKNVAL .OR. K 220 CONTINUE C*** ADD HAD CARRY, INCREMENT 2ND WORD IF PREVIOUS UPPER BIT NOT ZERO. IF(K.NE.0) K=1 IF(J.EQ.0) K=0 TKNVA2=TKNVA2+K+TKNVA4 C*** IF J NE 0 AND K NE 0 THERE IS ROLL OVER & 16TH BIT MUST BE ZERO IF(K.EQ.1) TKNVAL=TKNVAL .AND. IO7 240 CONTINUE C*** SHIFT LEFT ONE MORE BIT K=TKNVAL .AND. IO1 IF(K.NE.0) K=1 TKNVA2=ISHFT(TKNVA2,1)+K 250 TKNVAL=ISHFT(TKNVAL,1) C*** SAVE M.S. BIT K=TKNVAL .AND. IO1 C*** REMOVE M.S. BIT SO CARRY ON ADD CAN BE DETECTED TKNVAL=TKNVAL .AND. IO7 C*** ADD IN THE NEW #. TKNVAL=TKNVAL+ITOKEN(I) C*** DID ADD PUT A BIT IN 16TH POSITION? J=TKNVAL .AND. IO1 IF(J.NE.0) GO TO 300 C*** NO CARRY ON ADD, PUT 16TH BIT BACK IN CASE IT IS 1 TKNVAL=TKNVAL .OR. K GO TO 400 300 CONTINUE C*** ADD HAD CARRY, INCREMENT 2ND WORD IF PREVIOUS UPPER BIT NOT ZERO. IF(K.NE.0) K=1 TKNVA2=TKNVA2+K C*** IF J NE 0 & K NE 0 THERE IS CARRY OVER, ZERO 16TH BIT. IF(K.EQ.1) TKNVAL=TKNVAL .AND. IO7 400 CONTINUE 600 CONTINUE RETURN END