|
DataMuseum.dkPresents historical artifacts from the history of: RC4000/8000/9000 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about RC4000/8000/9000 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 176640 (0x2b200)
Types: TextFile
Names: »mftn«
└─⟦667bb35d6⟧ Bits:30007480 RC8000 Dump tape fra HCØ.
└─⟦4334b4c0b⟧
└─⟦this⟧ »mftn«
CC COPYRIGHT 1978 MOTOROLA INC.
CC
CC
CC ARTICLES, INFORMATION AND DATA ENCLOSED HEREIN
CC ARE PROPRIETARY TO MOTOROLA AND MAY NOT BE
CC DISTRIBUTED, REPRODUCED OR DISCLOSED OUTSIDE
CC BUYER'S ORGANIZATION WITHOUT THE EXPRESS WRITTEN
CC CONSENT OR APPROVAL OF AN AUTHORIZED MOTOROLA
CC OFFICER.
CC
CC
CC1.0 INTRODUCTION
CC
CC
CC SEE SECTION 3.0 FOR INSTALLATIONS PROCEDURES......
CC
CC THIS IS THE M68000 CROSS ASSEMBLER. IT IS WRITTEN IN
CC ANSI STANDARD FORTRAN-IV, SO IT SHOULD BE POSSIBLE
CC TO COMPILE AND EXECUTE IT ON ANY COMPUTER WHICH SUPPORTS
CC ANSI FORTRAN-IV.
CC
CC THIS IS A TWO PASS ASSEMBLER. ON THE FIRST PASS IT WILL READ
CC IN THE SOURCE FILE FROM FORTRAN UNIT 'LUSI' AND BUILD THE
CC SYMBOL TABLE. ON PASS TWO THE SOURCE FILE IS REWOUND AND A
CC LISTING IS OUTPUT TO FORTRAN UNIT 'LUOT'. THE OBJECT RECORD
CC (BINARY OBJECT RECORDS IN MC68000 FORMAT)
CC ARE OUTPUT TO THE FORTRAN UNIT 'LUOO'.
CC
CC SEE THE M68000 CROSS MACRO ASSEMBLER MANUAL FOR INFORMATION
CC ON THE INSTRUCTION SET.
CC
CC1.1 GENERAL INFORMATION ABOUT THE CROSS ASSEMBLER.
CC
CC EACH ROUTINE STARTS WITH COMMENTS DESCRIBING VERSION
CC NUMBER, DATE, ENTRY, EXIT VALUE OF ARGUMENTS IN CALLS, AND
CC ITS FUNCTION. ALSO INDICATES IF IT IS COMPUTER DEPENDENT OR
CC INDEPENDENT ON THE FIRST COMMENT LINE. IF COMPUTER
CC INDEPENDENT IT SAYS CMP: ALL. IF COMPUTER DEPENDENT IT
CC SAYS CMP: PDP-11.
CC TO MODIFY CROSS ASSEMBLER TO RUN ON NON PDP-11 TYPE
CC COMPUTERS, EACH ROUTINE WITH CMP: PDP-11 MUST BE MODIFIED TO
CC RUN ON NEW HOST COMPUTER. SOME ROUTINES INDICATE WHY THEY
CC ARE PDP-11 DEPENDENT, OTHERS ARE SELF EXPLANATORY. EACH
CC SOURCE STATEMENT IS READ IN USING ALPHA (A1) FORMAT. THE
CC STATEMENT IS THEN ZERO FILLED(R1 FORMAT) ON THE LEFT.
CC WHEN ASSEMBLY IS COMPLETED THE SOURCE LINE IS
CC PRINTED OUT IN A1 FORMAT. GENERATED M68000 HEX INSTRUCTIONS
CC ARE CONVERTED TO ASCII THEN OUTPUT.
CC
CC1.2 GENERAL OPERATION OF THE CROSS ASSEMBLER.
CC
CC DURING PASS ONE THE SOURCE LINE IS BROKEN INTO ELEMENTS
CC CALLED TOKENS BY ROUTINE 'SCN'. EACH TOKEN IS LOOKED UP
CC IN THE SYMBOL TABLE BY 'LKP'. IF A LABEL IT IS ENTERED
CC IN THE TABLE BY 'STF'. IF AN OPERAND IT IS LOCATED IN THE
CC SYMBOL TABLE AND INFORMATION STORED WITH IT IS USED TO BUILD
CC THE INSTRUCTION. PART OF THE DATA IS USED TO BRANCH IN
CC 'BUILD1' TO COMPLETE THE INSTRUCTION.
CC AT THE END OF PASS 1 THE FILE IS REWOUND AND EACH SOURCE
CC LINE IS READ IN AGAIN. OPERANDS ARE FOUND IN THE SYMBOL
CC TABLE AND DATA FOUND WITH THEM IS USED IN 'BUILD2'.
CC ROUTINE 'OUTPUT' PRINTS OUT THE SOURCE LINE AND THE
CC GENERATED INSTRUCTIONS.
CC ROUTINE 'PAR' WEAVES ITS WAY THROUGH THE PARSE NET TABLE
CC AND CALLING 'ACT1' IN PASS 1 AND 'ACT2' IN PASS 2 IT
CC BREAKS EACH SOURCE LINE DOWN, BUILDING THE INSTRUCTION FOR
CC FINAL ASSEMBLY IN 'BUILD1' OR 'BUILD2'. MACROS ARE
CC STORED IN THE SYMBOL TABLE AND ARE PULLED OUT DURING
CC EXPANSION IN EACH PASS. PASS ONE MUST EXAMINE A
CC MACRO TO SEE HOW MANY BYTES ARE REQUIRED FOR AN INSTRUCTION
CC IN ORDER TO KEEP IN PHASE WITH PASS TWO.
CC A MODIFICATION IN 'ACT1' OR 'BUILD1' CHANGING THE NUMBER
CC OF BYTES GENERATED WILL HAVE TO BE MADE IN 'ACT2' OR 'BUILD2'
CC TO AVOID PHASE ERRORS. THE REVERSE IS ALSO TRUE.
CC
CC2.0 INTRODUCTION
CC
CC THIS SECTION DEFINES DEVICE NUMBERS, COMMON,
CC HOW TO MODIFY THE SYMBOL TABLE SIZE, AND HOW TO CHANGE
CC DEVICE NUMBERS AND SPECIAL COMPUTER DEPENDENT VARIABLES.
CC
CC2.1 DEVICE NUMBERS. SEE SUBROUTINE 'COMDEP' TO CHANGE.
CC
CC LUSI = 2 (SOURCE INPUT)
CC LUOT = 6 (ASSEMBLY LISTING AND ERROR MESSAGES TO A PRINTER
CC LUOT = 3 (ASSEMBLY LISTING AND ERROR MESSAGES TO FILE)
CC LUOT = 5 (ASSEMBLY LISTING AND ERROR MESSAGES TO CONSOLE)
CC LULT = 5 (OUTPUT TO CONSOLE)
CC LUOT = 3 RSX-11M SETTING TO SPOOL OUTPUT INSTEAD
CC OF GOING DIRECTLY TO PRINTER. SEE 'COMDEP'.
CC LUCI = 5 (INPUT FROM CONSOLE)
CC LUOO = 1 (ASSEMBLED OBJECT OUTPUT)
CC
CC2.2 COMMON
CC
CC ALL COMMON IS LABELED /A/. THE DICTIONARY, PARSENET TABLE, AND
CC HASH TABLE ARE INITIALIZED IN BLOCK DATA.
CC
CC ISYM - SYMBOL TABLE, THE DICTIONARY IS IN THE FIRST 1200
CC WORDS. SEE BLOCK DATA WHERE THE DICTIONARY IS
CC INITIALIZED.
CC AN ENTRY IN THE SYMBOL TABLE IS AS FOLLOWS:
CC ISYM(1)->M.S.WORD OF SYMBOL'S VALUE.
CC (2)->M.S.BYTE = NUMBER CHARACTERS IN SYMBOL NAME TIMES 2.
CC 1 = 1-2 CHARS, 2=3-4 CHARS ETC.
CC (2)->L.S.BYTE=TYPE: 255=OPCODE 1=LABEL
CC (3)->LINK TO NEXT SYMBOL IN TABLE
CC (4)-(4+S)-> S=(SIZE-1)/2 2 CHARACTERS/WORD
CC (4+S+1)->ADDRESS TYPE, SEE RR-MMM-TTT BELOW.
CC IN LEAST SIGNIFICANT BYTE(L.S.B).
CC (4+S+2)-> 2 L.S.B OF SYMBOL'S ADDRESS.
CC JSUC POINTS TO ISYM(1) ON RETURN FROM 'LKP'.
CC JPTR & LPTR POINT TO ISYM(4+S+1) ON RETURN FROM 'LKP'.
CC
CC 1 - SYMBOL TABLE:
CC LOW BYTE BITS DEFINED AS RR-MMM-TTT WHERE:
CC RR = 00 - UNDEFINED SYMBOL
CC 01 - DEFINED IN PASS ONE
CC 10 - DEFINED IN PASS TWO
CC 11 - MULTIPLY DEFINED SYMBOL
CC MMM = RESERVED FOR MODE (ASCII,BIN,ETC)
CC TTT = 0 - ABSOLUTE SYMBOL
CC 1 - RELATIVE SYMBOL
CC 2 - REGISTER
CC 3 - KEYWORD
CC 2 - ADDRESS OF THE SYMBOL
CC
CC KARD1 - INPUT SOURCE IMAGE GOES HERE.
CC
CC KARD2 - MACRO PARAMETER SAVE AREA IN R1 FORMAT
CC MFLD - POINTERS TO EACH SUBFIELD IN KARD2
CC MDEP - DEPTH OF MACRO NESTING, MAX = 3
CC MPTR - POINTER TO MACRO DEFINITION OR ELSE = 0
CC
CC ITOKEN - SYMBOL IS BROKEN DOWN FROM 'KARD1' TO HERE AND
CC IS TAKEN FROM HERE AND PUT IN SYMBOL TABLE.
CC
CC TKNSIZ - NUMBER OF CHARACTERS IN 'ITOKEN'.
CC
CC TKNTYP - TYPE OF TOKEN IN 'ITOKEN'.
CC 24 = VARIABLE
CC 25 = NUMBER
CC 27 = 'STRING' OVER 4 BYTES LONG
CC 28 = REGISTER
CC 29 = STATEMENT LABEL
CC 30 = MNEMONIC
CC
CC TKNVAL - VALUE OF 'ITOKEN'.
CC TKNVA2 - HOLDS OVERFLOW FROM 'TKNVAL', SET IN 'SCN'.
CC
CC SYMTYP - MODE OF THE FIRST OPERAND
CC 0 = ABSOLUTE
CC 1 = RELATIVE
CC
CC JSUC - FLAG SET BY SYMBOL LOOKUP ROUTINE 'LKP'.
CC
CC JPTR - SET TO POINT AT SYMBOL TABLE ENTRY OF SYMBOL.
CC
CC NXSYM - POINTS TO NEXT AVAILABLE ADDRESS IN SYMBOL TABLE.
CC NXSYM1 - SAVE START OF LABELS IN SYMBOL TABLE,END OF DICT.
CC
CC KOLUMN - POSITION OF SCAN IN 'KARD1'.
CC
CC KD1BCT - END OF INPUT BUFFER(KARD1)
CC
CC KD1LNO - SOURCE LINE NUMBER.
CC
CC PASS,IPASS - PASS NUMBER FLAG ASSEMBLER IS CURRENTLY ON
CC -1 = PASS ONE
CC 0 = PASS TWO
CC
CC IPCC - CURRENT P-COUNT.
CC IPC2 - M.S.B. OF CURRENT P-COUNT(3RD BYTE)
CC
CC IOPC - OPCODE CLASS
CC
CC INS - ARRAY INSTRUCTION IS BUILT IN AND OUTPUT FROM.
CC
CC ISIZ - SIZE (B,W,L) FOR CURRENT INSTRUCTION
CC PASS 1 PASS 2
CC B = BYTE = 1 0
CC W = WORD = 2 64
CC L = LONG WORD = 4 128
CC
CC INSL - NUMBER OF BYTES REQUIRED FOR CURRENT INSTRUCTION.
CC
CC IADM - ADDRESS MODE FOR FIELD-1 AND FIELD-2 OF
CC THE OPERAND.
CC IADM(1,2):
CC ADDESS MODE ASSEMBLER FORMAT
CC 00 = DATA REG DIRECT D1
CC 08 = ADDR REG DIRECT A1
CC 16 = ADDR REG INDIRECT (A1)
CC 24 = POST INCREMENT (A1)+
CC 32 = PRE DECREMENT -(A1)
CC 40 = INDIRECT & DISPL'MT 3(A1)
CC 48 = DISPL'MT & IND & X 3(A1,A2)
CC 56 = ABSOLUTE SHORT $1234
CC 57 = ABSOLUTE LONG $123456
CC 58 = PC + DISPL'MT REL
CC 59 = PC + X + DISPL'MT REL(A1)
CC 60 = IMMEDIATE SHORT #$1234
CC IMMEDIATE LONG #$123456
CC 64 = STATUS REGISTER SR,CCR
CC
CC 2 - REGISTER #
CC
CC X IADM(X,1) IADM(X,2)
CC - --------- --------
CC 3 ... NO. BYTES IN INS(5)
CC 4 SYMTYP(1) SYMTYP(2)
CC 0 = ABSOLUTE 0 = ABSOLUTE
CC 1 = RELATIVE 1 = RELATIVE
CC 5 FORWARD REFERENCE?
CC 0 = BACKWARDS 0 = BACKWARD
CC 1 = FORWARD 1 = FORWARD
CC 6 A0-D7 BIT MASK D0-A7 BIT MASK
CC 7 CURRENT IPC MODE ...
CC 0 = ABSOLUTE 0 = 2 BYTE ADDRESSING
CC 1 = RELATIVE 1 = 3 BYTE ADDRESSING: > 65535
CC
CC LENSYM - LENGTH OF SYMBOL TABLE, EQUALS NUMBER OF
CC DIMENSIONS OF 'ISYM-10'.
CC
CC KASH - HASH TABLE FOR SYMBOL LOOKUP.
CC
CC KCLAS - TOKEN CLASS.
CC
CC NET1 -> NET5 - PARSENET TABLE.
CC
CC NBPW - NUMBER OF BYTES IN HOST COMPUTER'S WORD.
CC
CC IEOT - END OF LINE = 4.
CC
CC LSP - ASCII BLANK RIGHT JUSTIFIED.
CC
CC IHB480 - HEX CONSTANT SET IN 'COMDEP'
CC
CC IHEX9K - HEX CONSTANT SET IN 'COMDEP'
CC
CC
CC KCFF - HEX CONSTANT $FF SET IN 'COMDEP'
CC
CC LIST - LIST, NOLIST OPTION FLAG.
CC 1 = LIST ASSEMBLY (DEFAULT)
CC 0 = DON'T LIST ASSEMBLY
CC
CC IOBJ - OBJECT OUTPUT, NO OBJECT OUTPUT FLAG
CC 1 = OBJECT OUTPUT REQUESTED - DEFAULT
CC 0 = NO OBJECT OUTPUT REQUESTED
CC
CC IPLEN - NUMBER OF LINES PER PAGE
CC INITIALIZED TO 65
CC
CC LLEN - NUMBER CHARACTERS PER LINE
CC DEFAULT = 80
CC MIN = 26
CC MAX = 120
CC MAX NUMBER CHARACTERS INPUT ON SOURCE LINE = 95
CC
CC LLENSW - FLAG INDICATING COMMAND 'LLEN' HAS BEEN USED.
CC 1 = 'LLEN' IN EFFECT, ADJUST OUTPUT LINE TO
CC PARTICULAR COLUMN
CC 0 = DEFAULT = 'LLEN' NOT IN EFFECT.
CC NOTE: A SOURCE LINE IS NOT COLUMN ADJUSTED ON
CC OUTPUT UNLESS 'LLEN' IS USED.
CC
CC ICOL - USED TO FLAG IFXX IN PROCESS, AND MACRO FLAG.
CC
CC NEST - IFXX-ENDC NEST COUNT.
CC
CC2.3 MODIFYING SYMBOL TABLE SIZE.
CC
CC CHANGE EACH OCCURRANCE OF ISYM(N) IN COMMON /A/ FROM ITS
CC CURRENT VALUE TO DESIRED VALUE. CHANGE VARIABLE 'LENSYM'
CC IN BLOCK DATA TO EQUAL VALUE OF 'N-10' IN COMMON /A/ ISYM(N).
CC
CC2.4 ERROR MESSAGES
CC
CC ERROR # DESCRIPTION
CC ------- ----------
CC 0201 ILLEGAL CHARACTER
CC 0202 SYMBOL TOO LONG
CC 0203 IMPROPER TERMINATION OF OPERAND FIELD
CC 0204 SYNTAX ERROR
CC 0205 SIZE SUBFIELD NOT ALLOWED FOR THIS OPCODE
CC 0206 REDEFINED SYMBOL
CC 0207 UNDEFINED SYMBOL
CC 0208 DISPLACEMENT RANGE (SIZE) ERROR
CC 0209 ILLEGAL ADDRESS MODE FOR THIS INSTRUCTION
CC 0210 VALUE TOO LARGE
CC 0211 UNDEFINED SYMBOL
CC 0212 DATA SIZE IS INVALID
CC 0213 REGISTER MUST BE ADDRESS REGISTER
CC 0214 INVALID SIZE SPECIFIED FOR INDEX REGISTER (MUST BE .L)
CC 0215 REGISTER MUST BE DATA REGISTER
CC 0216 NEGATIVE NOT ALLOWED
CC 0217 BYTE MODE NOT ALLOWED
CC 0218 DESTINATION MUST BE ALTERABLE
CC 0219 TOO MANY OPERANDS FOR THIS INSTRUCTION
CC 0220 PHASING ERROR BETWEEN PASS ONE AND PASS TWO.
CC 0221 SYMBOL TABLE OVERFLOW
CC 0222 INTERNAL ERROR - PARSE STACK OVERFLOW
CC 0223 INTERNAL ERROR - UNDEFINED ACTION
CC 0224 ILLEGAL MACRO PARAMETER
CC 0225 MISPLACED 'MACRO' OR 'ENDM'
CC 0226 MACRO CALLS NESTED TOO DEEP
CC 0227 MULTIPLE REGISTERS ALLOWED ONLY FOR MOVEM(LDM,STM)
CC 0228 INTERNAL ERROR - SYMBOL LOST
CC 0229 LABEL REQUIRED ON THIS STATEMENT
CC 0230 INSTRUCTION ADDRESS HAS FALLEN ON AN ODD BOUNDARY
CC 0231 SYMBOL/EXPRESSION MUST BE ABSOLUTE
CC 0232 AND/OR/EOR TO CCR OR SR MUST HAVE IMMEDIATE SOURCE
CC 0233 ILLEGAL REGISTER FOR THIS INSTRUCTION
CC 0234 INVALID SYNTAX FOR THIS INSTRUCTION
CC 0235 FORWARD REFERENCED ADDRESS CANNOT BE LONG ABSOLUTE MODE
CC 0236 MEMORY SHIFTS MAY ONLY BE SINGLE BIT
CC 0237 ILLEGAL OPERATION ON A RELATIVE SYMBOL
CC 0238 INVALID BYTE SIZE FOR THIS INSTRUCTION
CC 0239 'END' DOES NOT TERMINATE SOURCE PROGRAM AS IT SHOULD
CC 0240 ILLEGAL FORWARD REFERENCE
CC
CC3.0 INSTALLATION OF THE M68000 CROSS ASSEMBLER ON A PDP-11 SYSTEM
CC TYPE SYSTEM.
CC
CC THE CROSS ASSEMBLER COMES ON A TAPE IN ONE FILE.
CC EACH SUBPROGRAM MUST BE SEPARATED FROM THIS FILE AND COMPILED
CC SEPARATELY IN ORDER TO LINK THE ENTIRE PROGRAM INTO A TASK.
CC ALL BUT 5 SUBPROGRAMS ARE WRITTEN IN FORTRAN. PROGRAMS MUST BE
CC COMPILED WITH THE /ON AND /SU FORTRAN OPTIONS TO GET THE LOAD
CC MODULE SMALL ENOUGH TO FIT IN 28K OF MEMORY ON A DOS SYSTEM.
CC USE /NOVA/NOSN ON AN RSX-M SYSTEM.
CC NOVA=NO 32 BIT INTEGERS
CC NOSN=NO INTERNAL STATEMENT #'S GEN'D BY COMPILER
CC THE FOLLOWING SWITCHES ARE USED WITH FORTRAN IV-PLUS, V02-51
CC /NOTR NO TRACE
CC /NOCK NO SUBCRIPT CHECKING
CC
CC IT SHOULD BE POSSIBLE TO OVERLAY THIS PROGRAM TO
CC GET MORE MEMORY AVAILABLE FOR SYMBOL TABLE SPACE. ALL ROUTINES
CC EXCEPT 'ACT1', 'BUILD1', 'ACT2', 'BUILD2', AND 'PRSYM' MUST
CC BE IN MEMORY, OR MUST BE IN THE MAIN OVERLAY. ACT1 CALLS
CC BUILD1 AND BOTH ARE USED IN PASS 1 ONLY. THEREFORE THESE TWO
CC SUBPROGRAMS CAN BE CONCATENATED AS ONE OVERLAY. ACT2, BUILD2
CC DO NOT CALL EACH OTHER AND MAY EACH BE THE SAME LEVEL OVERLAY
CC AS ACT1 SINCE THEY ARE USED ONLY IN PASS 2 . PRSYM PRINTS OUT
CC SYMBOL TABLE WHEN PASS 2 IS DONE SO IT CAN BE AT THE SAME
CC LEVEL AS ACT1, ACT2, AND BUILD2.
CC
CC SEVERAL PAGES OF NOTES ON ASSEMBLER CONSTRUCTION, VARIABLE
CC NAMES, COMMON, AND A DESCRIPTION OF THE VARIABLE NAMES IS
CC INCLUDED. THIS IS FOR INFORMATION ONLY AND IS NOT PART OF THE
CC OVERALL SOURCE PROGRAM.
CC
CC THE MAIN PROGRAM IS 'MACS'. SEVERAL SUBPROGRAMS FOLLOW 'MACS'
CC ALL IN FORTRAN. FIVE MORE IN PDP-11 ASSEMBLY LANGUAGE FOLLOW.
CC THE ASSEMBLY LANGUAGE PROGRAMS ARE: ADD,MUL,SUB,DIV,NEGATE.
CC SEPARATE THE FORTRAN PROGRAMS AND COMPILE EACH ONE. THEN
CC SEPARATE THE ASSEMBLY PROGRAMS AND ASSEMBLE EACH ONE.
CC LINK ALL OF THE RESULTANT .OBJ FILES IN TO A TASK(LOAD
CC MODULE). WHEN THIS IS DONE IT IS READY FOR EXECUTION.
CC
CC AS A TEST OF THE INSTALLATION OF THE CROSS ASSEMBLER IT
CC IS SUGGESTED THE SORT PROGRAM FOUND IN APPENDIX E OF THE
CC CROSS MACRO ASSEMBLER REFERENCE MANUAL, M68KXASM(D3), BE
CC USED. THIS PROGRAM SHOULD EXECUTE IN EITHER THE HARDWARE
CC OR A SIMULATOR SUCCESSFULLY.
CC
CC ONCE THE LOAD MODULE IS UP AND RUNNING, IT IS READY
CC FOR EXECUTION.
CC
CC RSX-11M SYSTEM.
CC ROUTINE 'FILEOP' HAS 'CALL ASSIGN' IN IT FOR THE RSX-11M
CC SYSTEM. THIS ROUTINE MUST BE CHANGED IF THE USER DOES NOT
CC WANT TO USE THIS METHOD OF ACCESSING FILES. 'FILEOP' ALSO
CC REQUESTS THE FILENAME FOR THE OUTPUT LISTING. IF THE SYSTEM
CC ALLOWS DIRECT OUTPUT TO THE LINE PRINTER THIS MAY BE
CC CHANGED ACCORDINGLY. THE 'CALL FILEOP(6)' IN 'MACS'
CC MUST ALSO BE DELETED IN THIS CASE, UNLESS THE COMPLETE
CC IN CHANGE IS MADE IN 'FILEOP'. THE REQUEST FOR PRINTING
CC PASS 1 IN 'MACS' MAY ALSO BE REMOVED IF DESIRED. THIS IS A
CC DEBUGGING AID.
CC NAMES FOR ALL FILES ARE REQUESTED FROM 'FILEOP'.
CC
CC THIS SOFTWARE HAS BEEN CHECKED OUT ON AN RSX-11M VERSION 3.2
CC SYSTEM. IT HAS NOT BEEN RAN ON AN RSTS OR UNIX SYSTEM. THE
CC SOFTWARE IS SENT OUT ON AN 800 BPI UN-LABELED 9-TRACK TAPE.
CC IT IS IN ASCII, 80 BYTES PER RECORD AND BLOCK. THE USER
CC MUST BE ABLE TO READ THIS TYPE OF TAPE.
CC A FORTRAN PROGRAM USING CALLS TO 'QIO' IS AVAILABLE FROM
CC MOTOROLA TO DO THIS READ. IT IS PLANNED TO PUT A COPY
CC OF THIS PROGRAM IN THE NEXT UPDATE OF THE REFERENCE MANUAL.
CC RELEASES PREVIOUS TO 1.4 WERE CHECKED OUT ON RSX-11M, FORTRAN
CC V02.2-1. RELEASE 1.4 WAS CHECKED OUT ON FORTRAN IV-PLUS
CC V02-51. A CHANGE HAD TO BE MADE IN THE CALL TO 'ASSIGN' TO
CC BE DOWNWARD COMPATIBLE WITH DEC'S CHANGE IN 'ASSIGN' REQUIRING
CC THE FIRST CHARACTER AT THE END OF THE FILENAME TO BE A NULL.
CC
CC AFTER READING THE TAPE IN TO A DISC FILE IT IS BEST TO WRITE A
CC FORTRAN PROGRAM THAT READ IN THAT FILE AND SPLIT IT INTO THE
CC SEPARATE SUBPROGRAMS.
CC
CC *** END OF THIS ARTICLE ***
CC
CC
CC
CC
CC NAM: MACS VER: 1.0 DAT: DEC 8, 1978 CMP: PDP-11
CC
CC SYS: MACS
CC
CC FNC: THIS IS THE MAIN PROGRAM FOR THE M68000 CROSS ASSEMBLER.
CC IT INITIALIZES SEVERAL VARIABLES, AND
CC CALLS ROUTINES FOR PASS1 AND PASS 2.
CC
CC ******************************************************
CC *** ***
CC *** COPYRIGHT 1978 BY MOTOROLA INCC ***
CC *** ***
CC ******************************************************
CC
CC ***********************************************************
CC *** ***
CC *** THIS IS A PRELIMINARY RELEASE OF THE MC68000 ***
CC *** CROSS ASSEMBLER. AS SUCH IT IS POSSIBLE THE ***
CC *** INSTRUCTION SET FOR THE MC68000 MAY CHANGE ***
CC *** CAUSING CHANGES IN THIS CROSS ASSEMBLER. ***
CC *** MOTOROLA RESERVES THE RIGHT TO MAKE CHANGES ***
CC *** WITHOUT NOTICE. ***
CC *** ***
CC ***********************************************************
CC
CC REV: N/A
CC
CCALLS COMDEP-FILEOP-PNCH-ERR-PRSYM-PAGE
CC
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,6,6/
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
C
C*** GET SI FN OPENED
C
CALL FILEOP(1)
C*** OUTPUT HEADER
CALL PAGE(82)
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
CC NAM: BLOCK DATA VER: 1.0 DAT: DEC 8, 1978 CMP: PDP-11
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)
CC NAM: ERR VER: 1.0 DAT: 12/08/78 CMP: ALL
CC
CC SYS: MACS
CC
CC ENT: JERNO > 0 - ERROR NUMBER
CC = 0 - OUTPUT TOTAL # OF ERRORS FOR CURRENT INSTRUCTION
CC = -1 - OUTPUT TOTAL # OF ERRORS FOR PROGRAM
CC
CC RTN: JERNO - N/C
CC
CC FNC: THIS ROUTINE TABLES ERROR #'S FOR EACH SOURCE STATEMENT
CC AND AT THE END OF SCAN OUTPUTS ALL ERRORS FOR IT.
CC IT OUTPUTS TOTAL # ERRORS FOR THE PROGRAM AT THE END.
CC
CC REV: N/A
CC
CCALLS 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
CC NAM: COMDEP VER: 1.0 DAT: 12/08/78 CMP: PDP-11
CC
CC SYS: MACS
CC
CC ENT: N/A
CC
CC RTN: N/A
CC
CC FNC: THIS ROUTINE SETS VARIABLES IN COMMON TO WHAT THE
CC COMPUTER IT IS CURRENTLY RUNNING ON REQUIRES.
CC IT ALSO SETS I/O DEVICE NUMBERS TO 6800 DEVICES.
CC DEVICE NUMBER VARIABLE NAME
CC 2 LUSI - SOURCE INPUT
CC 3 LUOT - ASSEMBLY LISTING(TO A FILE)
CC 6 LUOT - ASSEMBLY LISTING( TO PRINTER)
CC 5 LUOT - ASSEMBLY LISTING( TO CONSOLE)
CC 5 LULT - OUTPUT TO CONSOLE.
CC 5 LUCI - INPUT FROM CONSOLE.
CC 1 LUOO - ASSEMBLED OBJECT OUTPUT.
CC
CC
CC REV: N/A
CC
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)
CC NAM: SOUCIN VER: 1.0 DAT: 12/08/78 CMP: PDP-11
CC
CC SYS: MC68000 ASM
CC
CC ENT: N/A
CC
CC RTN: I=0=END OF FILE - I=1=END OF FILE NOT FOUND
CC
CC FNC: READ A SOURCE RECORD DEPENDING ON COMPUTER TYPE
CC
CCALLS 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
C*** REMOVE BLANK FROM UPPER BYTE
DO 300J=1,95
KARD1(J)=MPUAND(KARD1(J),IO377)
300 CONTINUE
C*** SET END OF LINE
KD1BCT=95
KARD1(96)=IEOT
RETURN
END
SUBROUTINE FILEOP(IOP)
CC NAM: FILEOP VER: 1.0 DAT 12/08/78 CMP: PDP-11
CC
CC SYS: MACS
CC
CC ENT: IOP - 1 = OPEN SI FILE
CC - 2 = CLOSE SI FILE
CC - 3 = REWIND SOURCE INPUT FILE FOR SECOND PASS.
CC - 4 = CLOSE OBJ FILE
CC - 5 = OPEN OBJ FILE
CC - 6 = OPEN FILE FOR LIST TO GO TO.
CC
CC RTN: N/C
CC
CC FNC: THIS ROUTINE IS FOR FILE OPERATIONS ON DIFFERENT
CC COMPUTERS, SUCH AS OPENING AND CLOSING FILES ETC.
CC
CC REV: N/A
CC
CCALLS 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
DATA LSPP/' '/
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
C*** INSERT ZERO AS LAST CHAR
DO 150 I=1,10
IF(JBUF(I).NE.LSPP) J=I
150 CONTINUE
JBUF(J+1)=0
CALL ASSIGN(LUSI,JBUF,0)
GO TO 610
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
C*** INSERT ZERO AS LAST CHAR
DO 550 I=1,10
IF(JBUF(I).NE.LSPP) J=I
550 CONTINUE
JBUF(J+1)=0
CALL ASSIGN(LUOO,JBUF,0)
RETURN
C
C*** OPEN FILE FOR LISTING
C
600 CONTINUE
RETURN
610 CONTINUE
WRITE(LULT,9950)
9950 FORMAT(' ENTER LISTING FILENAME')
READ(LUCI,9910) JBUF
LUOT=3
C*** INSERT ZERO AS LAST CHAR
DO 650 I=1,10
IF(JBUF(I).NE.LSPP) J=I
650 CONTINUE
JBUF(J+1)=0
CALL ASSIGN(LUOT,JBUF,0)
RETURN
END
SUBROUTINE REREAD
CC NAM: REREAD VER: 1.0 DAT: 12/08/78 CMP: ALL
CC
CC SYS: MC68000 ASM
CC
CC ENT: ALL VARIABLES USED ARE IN COMMON
CC
CC RTN: N/A
CC
CC FNC: THIS ROUTINE INCREMENTS THE @NNN NUMBER IN A MACRO.
CC
CC REV: N/A
CC
CCALLS 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
CC NAM: PAR VER: 1.0 DAT: 12/08/78 CMP: ALL
CC PGM: PARSE ROUITNE
CC
CC SYS: MC68000 ASM
CC
CC ENT: N/A
CC RTN: N/A
CC
CC FNC: CHECK THE PARSE NET FOR THE TOKEN TYPE AND WHEN FOUND
CC DOES ITS ACTIONS.
CC
CC REV: N/A
CC
CCALLS SCN-ACT1-ACT2-ERR
CC
CC ERROR NUMBERS CALLED: 203,204,222
CC
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
CC NAM: SCN VER: 1.0 DAT: 12/08/78 CMP: PDP-11
CC
CC SYS: MACS
CC
CC ENT: N/A
CC
CC RTN: N/A
CC
CC FNC: ISSUES READ TO 'SOUCIN' TO GET NEXT SOURCE LINE.
CC BREAKS IT INTO 'TOKENS'. STACKS MACROS INTO ARRAYS
CC 'KARD2' AND 'MFLD' FOR PROCESSING.
CC
CC NOTE: THIS ROUTINE IS 16-BIT MACHINE DEPENDENT DUE TO BIT
CC HANDLING IN 'TKNVA2'. IT HOLDS THE 2 MOST SIGNIFICANT
CC BYTES OF A 32-BIT NUMBER.
CC
CC REV: N/A
CC
CCALLS OUTPUT-MPUGTC-ERR-SOUCIN-LKP-REREAD-MPUPTC-KLAS-ASCBIN
CC
CC ERROR NUMBERS CALLED: 201,202,226
CC
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
C*** IF MORE THAN 4 CHARACTERS USE ONLY 4.
IF(TKNSIZ.LT.5) GO TO 615
TKNSIZ=4
CALL ERR(210)
615 CONTINUE
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
C*** SET 2 MSB ALSO
TKNVA2=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)
CC NAM: KLAS VER: 1.0 DAT: 12/08/78 CMP: ALL
CC
CC SYS: MACS
CC
CC ENT: KL - CHARACTER FROM INPUT BUFFER 'KARD1'.
CC
CC RTN: KL - N/C
CC KLAS - SET TO CLASS
CC
CC FNC: DETERMINE THE CLASS OF A CHARACTER FROM THE INPUT
CC BUFFER AND RETURN IT.
CC
CC 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)
CC NAM: LKP VER: 1.0 DAT: 12/08/78 CMP: ALL
CC
CC SYS: MC68000 ASM
CC
CC ENT: NTYP - TOKEN TYPE (-1, 0 OR 1 SEE STF)
CC NSUC - N/A
CC NPTR - N/A
CC
CC RTN: NTYP - N/C
CC NSUC - -1=> NO ENTRY IN THE HASH TABLE
CC - 0=> ENTRY IN HASH, BUT NO SYMBOL IN THE TABLE
CC - >0=> ENTRY FOUND, INDEX TO SYMBOL ENTRY IN SYM
CC NPTR - NSUC= -1=> INDEX TO HASH TABLE
CC - NSUC= 0=> POINTER TO THE PREVIOUS LINK IN SYM
CC - NSUC= >0=> INDEX TO THE DATA ENTRY OF THE SYMBOL
CC
CC FNC: PACK THE TOKEN INTO COMPUTER WORDS AND SEARCH THE HASH
CC AND SYMBOL TABLE FOR THE SYMBOL.
CC
CC REV: N/A
CC
CCALLS MPUPTC-MPUAND
CC
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)
CC NAM: STF VER: 1.0 DAT: 12/08/78 CMP: ALL
CC
CC SYS: MC68000 ASM
CC
CC ENT: KSUC - -1=> NO ENTRY IN HASH TABLE
CC - 0=> ENTRY IN HASH, BUT CANNOT FIND THE SYMBOL
CC - >0=> SYMBOL FOUND, INDEX TO THE SYMBOL ENTRY
CC KPTR - KSUC= -1=> INDEX TO THE HASH TABLE
CC - KSUC= 0=> POINTER TO THE PREVIOUS LINK
CC - KSUC= >0=> INDEX TO THE DATA ENTRY OF THE SYMBOL
CC KSIZ - REQUIRED SIZE OF THE DATA ENTRY
CC KTYP - -1=> DICTIONARY SYMBOL
CC - 0=> CONSTANT SYMBOL
CC - 1=> VARIABLE SYMBOL
CC
CC RTN: KSUC - INDEX TO THE SYMBOL ENTRY
CC KPTR - INDEX TO THE SYMBOL'S DATA ENTRY
CC KSIZ - N/CC
CC KTYP - N/CC
CC
CC FNC: STORE THE SYMBOL IN 'KPAC' INTO THE SYMBOL TABLE.
CC
CC REV: N/A
CC
CCALLS ERR
CC
CC 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)
CC NAM: ACT1 VER: 1.0 DAT: 12/08/78 CMP: 16-BIT
CC
CC SYS: MACS
CC
CC ENT: KMD - EQUALS ACTION TO BE TAKEN UPON ENTRY AS DETERMINED
CC FROM PARSE TABLE.
CC
CC RTN: KMD - N/C
CC
CC FNC: P A S S O N E A C T I O N S
CC ------------------------------
CC PERFORM THE ACTIONS FOR THE DIFFERENT "TOKENS"
CC ENCOUNTERED DURING THE STATEMENT SCAN.
CC IT SETS ADDRESS MODE IN 'IADM' TABLE, ENTERS EXPRESSION
CC IN EXPRESSION TABLE, ENTERS NEW SYMBOL IN SYMBOL TABLE.
CC ---------------------------------------------
CC THIS SUBROUTINE IS A MODIFICATION OF "ACT2"
CC THERE MUST NOT BE ANY DIFFERENCE BETWEEN ACT1
CC AND ACT2 THAT COULD AFFECT THE ASSUMED SIZE OF
CC THE INSTRUCTIONS.
CC ----------------------------------------------
CC
CC THIS ROUTINE IS 16-BIT DEPENDENT DUE TO THE CHECK ON
CC 'TKNVA2' FOR THE 2 MOST SIGNIFICANT BYTES OF A 32-BIT #.
CC INTEGER CONSTANT 192=$C0, 128=$80($=HEX).
CC NOTE ALSO INTEGER CONSTANTS 192 & 64 ARE SPECIAL HEX
CC VALUES $C0 AND $40.
CC
CC REV: N/A
CC
CC ERROR NUMBERS CALLED: 221,225
CC
CCALLS ERR-LKP-STF-SCN-MPUPTC-BUILD1-EXP
CC
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 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)
C*** SAVE AS FLAG FOR FINDING MULT DEF MACRO
N1=0
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
C*** CHECK FOR SYMBOL ALREADY USED AS MACRO OR LABEL.
105 CALL LKP(-1,N1,N2)
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*** IS SYMBOL ALREADY DEF?
IF(ISYM(LPTR).EQ.192) GO TO 250
C*** CHECK FOR MULT DEF MACRO
IF(N1.LT.NXSYM1) GO TO 220
C*** SET MULT DEF FLAG
ISYM(LPTR)=192
GO TO 230
220 CONTINUE
C*** TABLE THE MACRO DEFINITION
ISYM(LPTR)=0
C*** MAKE FIRST WORD NON-ZERO FOR SYM TABLE ROUTINE 'PRSYM'
225 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*** MULT DEF MACRO AND LABEL-FLUSH OUT MACRO AND LEAVE SYBOL
C*** TABLE DEFINED AS LABEL INSTEAD OF MACRO
250 CONTINUE
KOLUMN= -1
CALL SCN
IF(INS(1).NE.1) GO TO 250
KOLUMN=0
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
C*** PC REL?
IF(IADM(4,KSYS).EQ.1) GO TO 1110
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
C*** CHECK FOR ADDRESS FROM FF8000-FFFFFF
I=MPUAND(TKNVAL,Z8000)
IF(I.EQ.Z8000.AND.TKNVA2.EQ.KCFF) GO TO 1110
IF(TKNVA2.NE.0) K=4
C*** ADDR >$7FFF IS LONG ADDR.
IF(I.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*** PC REL?
IF(MPUAND(ISYM(JPTR),7).EQ.1) IADM(4,KSYS)=1
C*** *** GIVE OPERAND TO EXP
1730 CALL EXP(22)
RETURN
END
SUBROUTINE BUILD1
CC NAM: BUILD1 VER: 10.0 DAT: 12/08/78 CMP: 16-BIT
CC
CC SYS: MACS
CC
CC ENT: N/A
CC
CC RTN: N/A
CC
CC FNC: BUILD THE INSTRUCTION FOR PASS ONE
CC USES INFORMATION IN TABLE 'IADM', AND 'INS' ARRAY.
CC
CC REV: N/A
CC
CCALLS MPUAND-ERR-MOD2-IABS-PAGE
CC
CC ERROR NUMBERS CALLED: 223,229,239,240
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 415
410 KK=ISIZ
415 I=0
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
GO TO 530
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)
C*** FORWARD REF ILLEGAL
530 IF(IADM(5,1).EQ.1) GO TO 9240
RETURN
C
C*** DS
C
C*** KK=INS(3)*ISIZ
540 I=0
KK=ISIZ
CALL MUL(I,KK,INS(2),INS(3))
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,I,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
IF(INS(2).NE.0) GO TO 1890
RETURN
C... *** NE
1820 IF(INS(3).EQ.0.AND.INS(2).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(IADM(1,1).EQ.60.AND.ISIZ.EQ.4) INSL=INSL-2
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)
CC
CC NAM: EXP VER:1.00 DATE: 12/11/78 CMP: PDP-11
CC SYS: MACS
CC
CC ENT: NACT - 1 = INITIALIZE
CC 2 = OPERAND (VALUE IN TKNVAL)
CC 3 = RESERVED
CC 4 = OPERATOR: UNARY MINUS
CC 5 = >> (SHIFT RIGHT)
CC 6 = << (SHIFT LEFT)
CC 7 = & (AND)
CC 8 = ^ (OR)
CC 9 = % (EOR)
CC 10 = * (MPY)
CC 11 = YMTYP/IADM(4,K (DIV)
CC 12 = + (ADD)
CC 13 = - (SUB)
CC 14 = ( (OPEN PREN)
CC 15 = ) (CLOSE PAREN)
CC 16 = I- (BGN EXPR)
CC 17 = -I (END EXPR)
CC
CC RTN: TKNVAL = VALUE OF THE EXPRESSION
CC IADM(4,KSYS) = MODE OF THE RESULT
CC 0 = ABSOLUTE
CC 1 = RELATIVE
CC KSYS=1=1ST OPERAND
CC KSYS=2=2ND OPERAND
CC
CC FNC: PERFORMS EXPRESSION RECOGNIZE BY BOTTOM UP OPERATOR
CC PRECEDENT.
CC
CC REV: NYMTYP/IADM(4,KA
CC
CCALLS MPUIOR-ERR-ISHFT-MPUAND
CC
CC ERROR NUMBERS CALLED: 223,237
CC
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= STK11(NDX)
C*** COMPLEMENT THE #
CALL NEGATE(KK1,KK)
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
KK1=0
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)
CC NAM: RANGE VER: 1.0 DAT: 12/08/78 CMP: 16-BIT
CC
CC SYS: MACS
CC
CC ENT: KK - NUMERIC VALUE TO BE CHECKED FOR SIZE
CC
CC RTN: KK - N/C
CC
CC FNC: VALIDATE NUMERIC RANGE VALUES IN #N TYPE STATEMENTS
CC
CC REL: N/A
CC
CCALLS ERR-ISHFT
CC
CC ERROR NUMBERS CALLED: 210
CC
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)
CC NAM: ACT2 VER: 1.0 DAT: 12/08/78 CMP: 16-BIT
CC
CC SYS: MACS
CC
CC ENT: KMD - EQUALS ACTION TO BE TAKEN AS FOUND
CC IN THE PARSE TABLE.
CC
CC RTN: N/C
CC
CC FNC: P A S S T W O A C T I O N S
CC ------------------------------
CC PERFORM THE ACTIONS FOR THE DIFFERENT "TOKENS"
CC ENCOUNTERED DURING THE STATEMENT SCAN.
CC SETS UP 'IADM' TABLE, ENTERS EXP IN EXP TABLE.
CC
CC THIS ROUTINE IS 16-BIT DEPENDENT DUE TO THE CHECK ON
CC 'TKNVA2' FOR THE 2 MOST SIGNIFICANT BYTES OF A 32-BIT #.
CC INTEGER CONSTANT 192=$C0, 128=$80($=HEX).
CC
CC REV: N/A
CC
CCALLS ERR-LKP-SCN-OUTPUT-RANGE-MASK-EXP-MPUGTC
CC IABS-ISHFT-MPUAND-MPUIOR
CC
CC ERROR NUMBERS CALLED: 205,206,207,208,209,212,213,214,219,227
CC 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
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
C*** CHECK FOR ADDRESS FF8000-FFFFFF
I=MPUAND(TKNVAL,Z8000)
IF(I.EQ.Z8000.AND.TKNVA2.EQ.KCFF) GO TO 1120
IF(TKNVA2.NE.0) GO TO 1115
C*** ADDRESS >$7FFF IS LONG
IF(I.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
C*** ALLOW WORD .W
IF(ITOKEN(1).EQ.LW) RETURN
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)
CC NAM: MASK VER: 1.0 DAT: 12/08/78 CMP: ALL
CC
CC SYS: MACS
CC
CC ENT: JR - MASK TO BE SHIFTED
CC
CC RTN: JR - N/C
CC
CC FNC: FORMAT REGISTER BIT MASK FOR LDM,STM
CC
CC REV: N/A
CC
CCALLS ISHFT-MPUIOR
CC
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
CC NAM: MOD2 VER: 1.0 DAT: 12/08/78 CMP: PDP-11
CC
CC SYS: MACS
CC
CC ENT: N/A
CC
CC RTN: N/A
CC
CC FNC: FORCE TO AN EVEN WORD BOUNDARY
CC
CC REV: N/A
CC
CCALLS MPUAND-ADD
CC
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
C*** FORWARD REF IS ON ODD BYTE
CALL ERR(230)
RETURN
END
SUBROUTINE OUTPUT
CC NAM: OUTPUT VER: 1.0 DAT: 12/08/78 CMP: PDP-11
CC
CC SYS: MACS
CC
CC ENT: N/A
CC
CC RTN: N/C
CC
CC FNC: OUTPUT THE CURRENT INSTRUCTION.
CC
CC REV: N/A
CC
CCALLS BUILD1-BUILD2-PAGE-PCOUNT-OBJ-MPUCA1-MPUAND-ERR-MOD2
CC HEXASC
CC
CC ERROR NUMBERS CALLED: 230
CC
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
C*** CHECK FOR SPC
IF(INSL.EQ.20) GO TO 980
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,997) KD1LNO,IPC22,IPC1,INS2,INS3,(KRDOUT(J),J=1,KD1BCT)
35 CALL ADD(IPC2,IPC,INS(2),INS(3))
INSL=0
GO TO 800
999 FORMAT(I5,1X,2A1,4A1,1X,12A1/16X,8A1,1X,100A1)
1999 FORMAT(I5,1X,6A1,1X,12A1/16X,4A1,5X,100A1)
2999 FORMAT(I5,1X,6A1,1X,8A1/16X,8A1,1X,100A1)
1998 FORMAT(I5,1X,6A1,1X,12A1,1X,100A1)
998 FORMAT(I5,1X,6A1,1X,12A1,1X,100A1)
997 FORMAT(I5,1X,6A1,1X,8A1,5X,100A1)
996 FORMAT(I5,1X,6A1,1X,4A1,9X,100A1)
995 FORMAT(I5,1X,6A1,1X,2A1,11X,100A1)
994 FORMAT(I5,21X,100A1)
993 FORMAT(I5,8X,8A1,5X,100A1)
991 FORMAT(6X,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
980 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
IF(INSL.EQ.9.AND.LUDI.EQ.0) GO TO 78
IF(LUDI.EQ.0) GO TO 800
KARD1(1)=LSP
KD1BCT=1
GO TO 6
END
SUBROUTINE BUILD2
CC NAM: BUILD2 VER: 1.0 DAT: 12/08/78 CMP: 16-BIT
CC
CC SYS: MACS
CC
CC ENT: N/A
CC
CC RTN: N/A
CC
CC FNC: BUILD THE INSTRUCTION FOR PASS TWO
CC
CC THIS ROUTINE IS 16-BIT DEPENDENT DUE TO THE
CC 24-BIT ADDRESS WHICH MUST BE MANIPULATED.
CC
CC REV: N/A
CC
CCALLS ERR-MOD2-ISHFT-MPUAND-MPUIOR-PAGE
CC
CC ERROR NUMBERS CALLED: 205,208,209,210,212,213,215,216,217,218
CC 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, 950,
& 1100,1100,1300,1400,1500, 950, 950,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
C*** INS(3)=INS(3)*INSL
550 CONTINUE
CALL MUL(INS(2),INS(3),0,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).EQ.60) IADM(1,1)=56
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
C
900 INS(1)=INS(1)+ISIZ
C*** CHECK FOR ADDRESS REG
950 IF(IADM(1,1).EQ.8) GO TO 9215
C*** *** ERROR IF IMMEDIATE MODE
IF(IADM(1,1).GT.57.AND.IADM(1,1).LT.61) GO TO 9209
GO TO 8300
C
C*** PEA-JSR-JMP
C
1100 CONTINUE
C*** PEA (AN)+ AND PEA -(AN) ILLEGAL, CHECK FOR THEM
IF(IADM(1,1).EQ.16) GO TO 8300
IF(IADM(1,1).LT.40) GO TO 9209
IF(IADM(1,1).EQ.60) GO TO 9209
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*** CONDITIONAL ASSEMBLY
1800 INSL=0
INS1=INS(1)
GO TO(1810,1820),INS1
C... *** EQ
1810 IF(INS(3).NE.0) GO TO 1890
IF(INS(2).NE.0) GO TO 1890
RETURN
C... *** NE
1820 IF(INS(3).EQ.0.AND.INS(2).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*** DN AS DEST INVALID
IF(IADM(1,2).EQ.0) GO TO 9213
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
IF(IADM(1,1).EQ.60.AND.ISIZ.EQ.128) INSL=INSL-2
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
IF(IADM(1,1).EQ.60.AND.ISIZ.EQ.128) INSL=INSL-2
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
C*** ONLY DN DEST ALLOWED
IF(IADM(1,2).NE.0) GO TO 9209
IF(IABS(INS(3)).GT.KCFF) GO TO 9210
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)
INS(4)=INS(2)
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
CC NAM: OBJ VER: 1.0 DAT: 12/08/78 CMP: 16-BIT
CC
CC SYS: MACS
CC
CC ENT: N/A
CC
CC RTN: N/A
CC
CC FNC: CREATE THE OBJECT FILE OUTPUT
CC STUFFS EACH BYTE INTO A BUFFER, CALCULATES CHECKSUM.
CC
CC REV: N/A
CC
CCALLS PNCH
CC
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)
CC NAM: PNCH VER: 1.0 DAT: 02/19/79 CMP: PDP-11
CC
CC SYS: MACS
CC
CC ENT: JTYP - FUNCTION TYPE
CC 1 - OUTPUT HEADER
CC 2 - OUTPUT TRAILER
CC 3 - NEW ORIGIN
CC 4 - NEXT BYTE IN SEQUENCE
CC 5 - ADJUST COUNT FOR A 'DS'
CC JVAL - DATA BYTE
CC
CC RTN: JTYP - N/C
CC JVAL - N/C
CC
CC FNC: WRITE THE OBJECT RECORDS TO DEVICE 'LUOO'
CC IF NO OUTPUT DESIRED(IOBJ=0) IT RETURNS.
CC S1 RECORD = 2 BYTE ADDRESS
CC S2 RECORD = 3 BYTE ADDRESS
CC
CCALLS MPUAND-HEXASC-ISHFT-ADD
CC
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,INS(2),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
CC NAM: PRSYM VER: 1.0 DAT: 01/31/79 CMP: PDP-11
CC
CC SYS:MACS
CC
CC ENT: N/A
CC
CC RTN: N/A
CC
CC FNC: FIND SYMBOL NAME AND ADDRESS IN SYMBOL TABLE,
CC STUFF IN LOW 'ISYM', SORT, THEN OUTPUT TO 'LUOT'.
CC
CCALLS MPUGTC-MPUPTC-MPUAND-PAGE-ISHFT
CC
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 - APPROX',I5,' SYMBOL ENTRIES LEFT'/)
NX=(LENSYM-NXSYM)/9
WRITE(LUOT,9900) NX
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)
CC NAM: PAGE VER: 1.0 DAT: 02/02/79 CMP: PDP-11
CC
CC SYS: MC6800 ASM
CC
CC ENT: LCNT - NUMBER OF LINES JUST OUTPUT, OR IF > 79 THEN
CC - 80 = SET TTL IN BUFFER
CC - 81 = OUTPUT HEADER TO DEVICE 'LULT'
CC - 82 = OUTPUT HEADER TO DEVICE 'LUOT'
CC - 83 = SAME AS 82 FOR PDP-11
CC - 84 = 'PAGE', SLEW TO TOP OF PAGE IF 'LUOT'=PRINTER
CC - 85 = SKIP TO BOTTOM OF PAGE, DONOT PRINT HEADER
CC
CC RTN: N/C
CC
CC FNC: THIS ROUTINE INCREMENTS THE LINE COUNTER AND OUTPUTS A
CC TOP OF PAGE HEADER AT PROPER TIME. IT PUTS
CC HEADER INTO OUTPUT BUFFER WHEN ENCOUNTERING THE 'TTL'
CC COMMAND. PAGING IS EFFECTIVE FOR PRINTER OUTPUT ONLY.
CC THIS ROUTINE CONTAINS THE RELEASE # AND COPYRIGHT
CC MESSAGE IN A DATA STATEMENT, THE ONLY PLACE IT APPEARS
CC IN THE PROGRAM.
CC NOTE: THIS ROUTINE CAN POSSIBLY BE CHANGED TO CALL ADD ROUTINE
CC THIS WOULD HELP DECREASE ASSEMBLE TIME. TRY:
CC CALL ADD(IPC2,IPC,0,INSL)
CC THEN REMOVE ALL OTHER INSTRUCTIONS FROM DATA IO1
CC TO STATEMENT 240.
CC
CCALLS MPUPTC
CC
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','.4',' -',' 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*** ALWAYS SET TTL
IF(LCN.EQ.80) GO TO 500
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
CC NAM: PCOUNT VER: 1.0 DAT: 01/29/79 CMP: PDP-11
CC
CC SYS: MACS
CC
CC ENT: 'IPC' CONTAINS 2 LEAST SIGNIFICANT BYTES OF P-COUNT.
CC 'IPC2' = MOST SIGNIFICANT BYTE OF P-COUNTER.
CC 'INSL' = AMOUNT TO INCREMENT P-COUNT BY.
CC
CC RTN: 'IPC' AND 'IPC2' HAVE NEXT P-COUNT.
CC
CC FNC: THE CURRENT INSTRUCTION LENGTH IN 'INSL' IS ADDED
CC TO 'IPC' & 'IPC2' TO GIVE NEXT INSTRUCTION ADDRESS.
CC
CC REV: N/A
CC
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)
CC NAM: HEXASC VER: 1.0 DATE: 05/18/19 CMP: PDP-11
CC
CC SYS: MACS
CC
CC ENT: IHEX - CONTAINS HEX CHARACTERS TO CONVERT
CC IB - N/A
CC KNT - NUMBER OF HEX CHAR TO CONVERT
CC MAX OF 4 HEX CHARS, ONE WORD, CAN BE CONVERTED AT A TI
CC IPOS - POSITION IN 'IB' TO PUT THE CONVERTED CHARS.
CC
CC RTN: IHEX - N/C
CC IB - CONTAINS THE HEX CHARS IN ASCII, 1 PER WORD
CC KNT - N/C
CC IPOS - N/C
CC
CC REV: N/A
CC
CC
CC FNC: CHANGE HEX VALUES TO ASCII AND STORE ONE CONVERTED HEX VALUE
CC PER ARRAY WORD.
CC
CCALLS 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)
CC NAM: MPUAND VER: 1.0 DATE: 04/16/79 CMP: PDP-11
CC
CC SYS: MACS
CC
CC ENT: JA - VALUE TO BE ANDED
CC JB - VALUE TO AND WITH
CC
CC RTN: JA - N/C
CC JB - N/C
CC
CC FNC: 'AND' JA WITH JB
CC
CC REV: N/A
C*
MPUAND=JA .AND. JB
RETURN
END
FUNCTION MPUIOR (JA,JB)
CC NAM: MPUIOR VER: 1.0 DATE: 04/16/79 CMP:PDP-11
CC
CC SYS: MACS
CC
CC ENT: JA - VALUE TO BE 'ORED'
CC JB - VALUE TO USE IN THE 'OR'
CC
CC RTN: JA - N/C
CC JB - N/C
CC
CC FNC: THE VALUE OF JB IS 'ORED' INTO JA
CC
CC REV: N/A
CC
C*
MPUIOR= JA .OR. JB
RETURN
END
FUNCTION ISHFT(K1,K2)
CC NAM: ISHFT VER: 1.0 DATE: 04/16/79 CMP: PDP-11
CC
CC SYS: MACS
CC
CC ENT: K1 - VALUE TO BE SHIFTED
CC K2 - AMOUNT TO SHIFT K1
CC = MINUS VALUE, SHIFT RIGHT TO LSB.
CC = POSITIVE VALUE, SHIFT LEFT, HIGH ORDER BIT.
CC
CC RTN: K1 - N/C
CC K2 - N/C
CC
CC FNC: SHIFT A 16-BIT WORD RIGHT OR LEFT.
CC
CC REV: N/A
CC
CCALLS 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)
CC NAM: MPUPTC VER: 1.0 DATE: 04/19/79 CMP: 16-BIT
CC
CC SYS: MACS
CC
CC ENT: JBYT - BYTE IN THE RIGHT 8 BITS OF THE WORD(LOW ORDER BITS)
CC JBUF - N/A
CC JBIX - BYTE INDEX LOCATION TO PLACE JBYT IN JBUF, LEFT BYTE
CC IS BYTE 1 ETC.
CC
CC RTN: JBYT - N/C
CC JBUF - CONTAINS BYTE FROM JBYT IN THE JBIX POSITION
CC JBIX - N/C
CC
CC FNC: TAKE THE RIGHT JUSTIFIED, ZERO FILLED BYTE FROM
CC JBYT AND PLACE IT IN THE JBIX POSITION OF JBUF.
CC
CC REV: N/A
CC
CCALLS MPUAND-ISHFT-MOD
CC
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)
CC NAM: MGUPTC VER: 1.0 DATE: 04/19/79 CMP: 16-BIT
CC
CC SYS: MACS
CC
CC ENT: JBYT - N/A
CC JBUF - WORD OR ARRAY CONTAINING DESIRED BYTE(CHAR)
CC JBIX - INDEX, POSITION IN JBUF TO GET BYTE(CHAR) FROM
CC
CC RTN: JBYT - BYTE(CHAR) FROM JBUF, RIGHT JUSTIFIED, ZERO FILLED
CC JBUF - N/C
CC JBIX - N/C
CC
CC FNC: TAKE THE JBIX BYTE(CHAR) FROM JBUF AND STORE IT
CC RIGHT JUSTIFIED, ZERO FILLED IN JBYT, THE LOWER 8 BITS.
CC
CC REV: N/A
CC
CCALLS MPUAND-ISHFT-MOD
CC
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
CC NAM: ASCBIN VER: 1.0 DATA@E: 04-23/79 CMP: PDP-11
CC
CC SYS: MACS
CC
CC ENT: 'ITOKEN' = THE ARRAY WHICH CONTAINS THE RIGHT JUSTIFIED
CC ZERO FILLED ASCII NUMBER.
CC 'TKNSIZ' = NUMBER OF CHARACTERS IN 'ITOKEN'
CC 'TKNVAL AND 'TKNVA2'= 0
CC
CC RTN: 'TKNVAL' = 2 LEAST SIGNIFICANT BYTES.
CC 'TKNVA2' = 2 M.S.B.
CC
CC FNC: THIS ROUTINE TAKES A RIGHT JUSTIFIED, ZERO FILLED ASCII
CC ARRAY AND CONVERTS IT TO A BINARY # UP TO 4 BYTES LONG.
CC
CC REV: N/A
CC
CCALLS ISHFT
CC
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
▶EOF◀