|
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: 211968 (0x33c00)
Types: TextFile
Names: »oftn«
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
└─⟦b2ec5d50f⟧
└─⟦this⟧ »oftn«
1 CC COPYRIGHT 1978 MOTOROLA INC.
2 CC
3 CC
4 CC ARTICLES, INFORMATION AND DATA ENCLOSED HEREIN
5 CC ARE PROPRIETARY TO MOTOROLA AND MAY NOT BE
6 CC DISTRIBUTED, REPRODUCED OR DISCLOSED OUTSIDE
7 CC BUYER'S ORGANIZATION WITHOUT THE EXPRESS WRITTEN
8 CC CONSENT OR APPROVAL OF AN AUTHORIZED MOTOROLA
9 CC OFFICER.
10 CC
11 CC
12 CC1.0 INTRODUCTION
13 CC
14 CC
15 CC SEE SECTION 3.0 FOR INSTALLATIONS PROCEDURES......
16 CC
17 CC THIS IS THE M68000 CROSS ASSEMBLER. IT IS WRITTEN IN
18 CC ANSI STANDARD FORTRAN-IV, SO IT SHOULD BE POSSIBLE
19 CC TO COMPILE AND EXECUTE IT ON ANY COMPUTER WHICH SUPPORTS
20 CC ANSI FORTRAN-IV.
21 CC
22 CC THIS IS A TWO PASS ASSEMBLER. ON THE FIRST PASS IT WILL READ
23 CC IN THE SOURCE FILE FROM FORTRAN UNIT 'LUSI' AND BUILD THE
24 CC SYMBOL TABLE. ON PASS TWO THE SOURCE FILE IS REWOUND AND A
25 CC LISTING IS OUTPUT TO FORTRAN UNIT 'LUOT'. THE OBJECT RECORD
26 CC (BINARY OBJECT RECORDS IN MC68000 FORMAT)
27 CC ARE OUTPUT TO THE FORTRAN UNIT 'LUOO'.
28 CC
29 CC SEE THE M68000 CROSS MACRO ASSEMBLER MANUAL FOR INFORMATION
30 CC ON THE INSTRUCTION SET.
31 CC
32 CC1.1 GENERAL INFORMATION ABOUT THE CROSS ASSEMBLER.
33 CC
34 CC EACH ROUTINE STARTS WITH COMMENTS DESCRIBING VERSION
35 CC NUMBER, DATE, ENTRY, EXIT VALUE OF ARGUMENTS IN CALLS, AND
36 CC ITS FUNCTION. ALSO INDICATES IF IT IS COMPUTER DEPENDENT OR
37 CC INDEPENDENT ON THE FIRST COMMENT LINE. IF COMPUTER
38 CC INDEPENDENT IT SAYS CMP: ALL. IF COMPUTER DEPENDENT IT
39 CC SAYS CMP: PDP-11.
40 CC TO MODIFY CROSS ASSEMBLER TO RUN ON NON PDP-11 TYPE
41 CC COMPUTERS, EACH ROUTINE WITH CMP: PDP-11 MUST BE MODIFIED TO
42 CC RUN ON NEW HOST COMPUTER. SOME ROUTINES INDICATE WHY THEY
43 CC ARE PDP-11 DEPENDENT, OTHERS ARE SELF EXPLANATORY. EACH
44 CC SOURCE STATEMENT IS READ IN USING ALPHA (A1) FORMAT. THE
45 CC STATEMENT IS THEN ZERO FILLED(R1 FORMAT) ON THE LEFT.
46 CC WHEN ASSEMBLY IS COMPLETED THE SOURCE LINE IS
47 CC PRINTED OUT IN A1 FORMAT. GENERATED M68000 HEX INSTRUCTIONS
48 CC ARE CONVERTED TO ASCII THEN OUTPUT.
49 CC
50 CC1.2 GENERAL OPERATION OF THE CROSS ASSEMBLER.
51 CC
52 CC DURING PASS ONE THE SOURCE LINE IS BROKEN INTO ELEMENTS
53 CC CALLED TOKENS BY ROUTINE 'SCN'. EACH TOKEN IS LOOKED UP
54 CC IN THE SYMBOL TABLE BY 'LKP'. IF A LABEL IT IS ENTERED
55 CC IN THE TABLE BY 'STF'. IF AN OPERAND IT IS LOCATED IN THE
56 CC SYMBOL TABLE AND INFORMATION STORED WITH IT IS USED TO BUILD
57 CC THE INSTRUCTION. PART OF THE DATA IS USED TO BRANCH IN
58 CC 'BUILD1' TO COMPLETE THE INSTRUCTION.
59 CC AT THE END OF PASS 1 THE FILE IS REWOUND AND EACH SOURCE
60 CC LINE IS READ IN AGAIN. OPERANDS ARE FOUND IN THE SYMBOL
61 CC TABLE AND DATA FOUND WITH THEM IS USED IN 'BUILD2'.
62 CC ROUTINE 'OUTPUT' PRINTS OUT THE SOURCE LINE AND THE
63 CC GENERATED INSTRUCTIONS.
64 CC ROUTINE 'PAR' WEAVES ITS WAY THROUGH THE PARSE NET TABLE
65 CC AND CALLING 'ACT1' IN PASS 1 AND 'ACT2' IN PASS 2 IT
66 CC BREAKS EACH SOURCE LINE DOWN, BUILDING THE INSTRUCTION FOR
67 CC FINAL ASSEMBLY IN 'BUILD1' OR 'BUILD2'. MACROS ARE
68 CC STORED IN THE SYMBOL TABLE AND ARE PULLED OUT DURING
69 CC EXPANSION IN EACH PASS. PASS ONE MUST EXAMINE A
70 CC MACRO TO SEE HOW MANY BYTES ARE REQUIRED FOR AN INSTRUCTION
71 CC IN ORDER TO KEEP IN PHASE WITH PASS TWO.
72 CC A MODIFICATION IN 'ACT1' OR 'BUILD1' CHANGING THE NUMBER
73 CC OF BYTES GENERATED WILL HAVE TO BE MADE IN 'ACT2' OR 'BUILD2'
74 CC TO AVOID PHASE ERRORS. THE REVERSE IS ALSO TRUE.
75 CC
76 CC2.0 INTRODUCTION
77 CC
78 CC THIS SECTION DEFINES DEVICE NUMBERS, COMMON,
79 CC HOW TO MODIFY THE SYMBOL TABLE SIZE, AND HOW TO CHANGE
80 CC DEVICE NUMBERS AND SPECIAL COMPUTER DEPENDENT VARIABLES.
81 CC
82 CC2.1 DEVICE NUMBERS. SEE SUBROUTINE 'COMDEP' TO CHANGE.
83 CC
84 CC LUSI = 2 (SOURCE INPUT)
85 CC LUOT = 6 (ASSEMBLY LISTING AND ERROR MESSAGES TO A PRINTER
86 CC LUOT = 3 (ASSEMBLY LISTING AND ERROR MESSAGES TO FILE)
87 CC LUOT = 5 (ASSEMBLY LISTING AND ERROR MESSAGES TO CONSOLE)
88 CC LULT = 5 (OUTPUT TO CONSOLE)
89 CC LUOT = 3 RSX-11M SETTING TO SPOOL OUTPUT INSTEAD
90 CC OF GOING DIRECTLY TO PRINTER. SEE 'COMDEP'.
91 CC LUCI = 5 (INPUT FROM CONSOLE)
92 CC LUOO = 1 (ASSEMBLED OBJECT OUTPUT)
93 CC
94 CC2.2 COMMON
95 CC
96 CC ALL COMMON IS LABELED /A/. THE DICTIONARY, PARSENET TABLE, AND
97 CC HASH TABLE ARE INITIALIZED IN BLOCK DATA.
98 CC
99 CC ISYM - SYMBOL TABLE, THE DICTIONARY IS IN THE FIRST 1200
100 CC WORDS. SEE BLOCK DATA WHERE THE DICTIONARY IS
101 CC INITIALIZED.
102 CC AN ENTRY IN THE SYMBOL TABLE IS AS FOLLOWS:
103 CC ISYM(1)->M.S.WORD OF SYMBOL'S VALUE.
104 CC (2)->M.S.BYTE = NUMBER CHARACTERS IN SYMBOL NAME TIMES 2.
105 CC 1 = 1-2 CHARS, 2=3-4 CHARS ETC.
106 CC (2)->L.S.BYTE=TYPE: 255=OPCODE 1=LABEL
107 CC (3)->LINK TO NEXT SYMBOL IN TABLE
108 CC (4)-(4+S)-> S=(SIZE-1)/2 2 CHARACTERS/WORD
109 CC (4+S+1)->ADDRESS TYPE, SEE RR-MMM-TTT BELOW.
110 CC IN LEAST SIGNIFICANT BYTE(L.S.B).
111 CC (4+S+2)-> 2 L.S.B OF SYMBOL'S ADDRESS.
112 CC JSUC POINTS TO ISYM(1) ON RETURN FROM 'LKP'.
113 CC JPTR & LPTR POINT TO ISYM(4+S+1) ON RETURN FROM 'LKP'.
114 CC
115 CC 1 - SYMBOL TABLE:
116 CC LOW BYTE BITS DEFINED AS RR-MMM-TTT WHERE:
117 CC RR = 00 - UNDEFINED SYMBOL
118 CC 01 - DEFINED IN PASS ONE
119 CC 10 - DEFINED IN PASS TWO
120 CC 11 - MULTIPLY DEFINED SYMBOL
121 CC MMM = RESERVED FOR MODE (ASCII,BIN,ETC)
122 CC TTT = 0 - ABSOLUTE SYMBOL
123 CC 1 - RELATIVE SYMBOL
124 CC 2 - REGISTER
125 CC 3 - KEYWORD
126 CC 2 - ADDRESS OF THE SYMBOL
127 CC
128 CC KARD1 - INPUT SOURCE IMAGE GOES HERE.
129 CC
130 CC KARD2 - MACRO PARAMETER SAVE AREA IN R1 FORMAT
131 CC MFLD - POINTERS TO EACH SUBFIELD IN KARD2
132 CC MDEP - DEPTH OF MACRO NESTING, MAX = 3
133 CC MPTR - POINTER TO MACRO DEFINITION OR ELSE = 0
134 CC
135 CC ITOKEN - SYMBOL IS BROKEN DOWN FROM 'KARD1' TO HERE AND
136 CC IS TAKEN FROM HERE AND PUT IN SYMBOL TABLE.
137 CC
138 CC TKNSIZ - NUMBER OF CHARACTERS IN 'ITOKEN'.
139 CC
140 CC TKNTYP - TYPE OF TOKEN IN 'ITOKEN'.
141 CC 24 = VARIABLE
142 CC 25 = NUMBER
143 CC 27 = 'STRING' OVER 4 BYTES LONG
144 CC 28 = REGISTER
145 CC 29 = STATEMENT LABEL
146 CC 30 = MNEMONIC
147 CC
148 CC TKNVAL - VALUE OF 'ITOKEN'.
149 CC TKNVA2 - HOLDS OVERFLOW FROM 'TKNVAL', SET IN 'SCN'.
150 CC
151 CC SYMTYP - MODE OF THE FIRST OPERAND
152 CC 0 = ABSOLUTE
153 CC 1 = RELATIVE
154 CC
155 CC JSUC - FLAG SET BY SYMBOL LOOKUP ROUTINE 'LKP'.
156 CC
157 CC JPTR - SET TO POINT AT SYMBOL TABLE ENTRY OF SYMBOL.
158 CC
159 CC NXSYM - POINTS TO NEXT AVAILABLE ADDRESS IN SYMBOL TABLE.
160 CC NXSYM1 - SAVE START OF LABELS IN SYMBOL TABLE,END OF DICT.
161 CC
162 CC KOLUMN - POSITION OF SCAN IN 'KARD1'.
163 CC
164 CC KD1BCT - END OF INPUT BUFFER(KARD1)
165 CC
166 CC KD1LNO - SOURCE LINE NUMBER.
167 CC
168 CC PASS,IPASS - PASS NUMBER FLAG ASSEMBLER IS CURRENTLY ON
169 CC -1 = PASS ONE
170 CC 0 = PASS TWO
171 CC
172 CC IPCC - CURRENT P-COUNT.
173 CC IPC2 - M.S.B. OF CURRENT P-COUNT(3RD BYTE)
174 CC
175 CC IOPC - OPCODE CLASS
176 CC
177 CC INS - ARRAY INSTRUCTION IS BUILT IN AND OUTPUT FROM.
178 CC
179 CC ISIZ - SIZE (B,W,L) FOR CURRENT INSTRUCTION
180 CC PASS 1 PASS 2
181 CC B = BYTE = 1 0
182 CC W = WORD = 2 64
183 CC L = LONG WORD = 4 128
184 CC
185 CC INSL - NUMBER OF BYTES REQUIRED FOR CURRENT INSTRUCTION.
186 CC
187 CC IADM - ADDRESS MODE FOR FIELD-1 AND FIELD-2 OF
188 CC THE OPERAND.
189 CC IADM(1,2):
190 CC ADDESS MODE ASSEMBLER FORMAT
191 CC 00 = DATA REG DIRECT D1
192 CC 08 = ADDR REG DIRECT A1
193 CC 16 = ADDR REG INDIRECT (A1)
194 CC 24 = POST INCREMENT (A1)+
195 CC 32 = PRE DECREMENT -(A1)
196 CC 40 = INDIRECT & DISPL'MT 3(A1)
197 CC 48 = DISPL'MT & IND & X 3(A1,A2)
198 CC 56 = ABSOLUTE SHORT $1234
199 CC 57 = ABSOLUTE LONG $123456
200 CC 58 = PC + DISPL'MT REL
201 CC 59 = PC + X + DISPL'MT REL(A1)
202 CC 60 = IMMEDIATE SHORT #$1234
203 CC IMMEDIATE LONG #$123456
204 CC 64 = STATUS REGISTER SR,CCR
205 CC
206 CC 2 - REGISTER #
207 CC
208 CC X IADM(X,1) IADM(X,2)
209 CC - --------- --------
210 CC 3 ... NO. BYTES IN INS(5)
211 CC 4 SYMTYP(1) SYMTYP(2)
212 CC 0 = ABSOLUTE 0 = ABSOLUTE
213 CC 1 = RELATIVE 1 = RELATIVE
214 CC 5 FORWARD REFERENCE?
215 CC 0 = BACKWARDS 0 = BACKWARD
216 CC 1 = FORWARD 1 = FORWARD
217 CC 6 A0-D7 BIT MASK D0-A7 BIT MASK
218 CC 7 CURRENT IPC MODE ...
219 CC 0 = ABSOLUTE 0 = 2 BYTE ADDRESSING
220 CC 1 = RELATIVE 1 = 3 BYTE ADDRESSING: > 65535
221 CC
222 CC LENSYM - LENGTH OF SYMBOL TABLE, EQUALS NUMBER OF
223 CC DIMENSIONS OF 'ISYM-10'.
224 CC
225 CC KASH - HASH TABLE FOR SYMBOL LOOKUP.
226 CC
227 CC KCLAS - TOKEN CLASS.
228 CC
229 CC NET1 -> NET5 - PARSENET TABLE.
230 CC
231 CC NBPW - NUMBER OF BYTES IN HOST COMPUTER'S WORD.
232 CC
233 CC IEOT - END OF LINE = 4.
234 CC
235 CC LSP - ASCII BLANK RIGHT JUSTIFIED.
236 CC
237 CC IHB480 - HEX CONSTANT SET IN 'COMDEP'
238 CC
239 CC IHEX9K - HEX CONSTANT SET IN 'COMDEP'
240 CC
241 CC
242 CC KCFF - HEX CONSTANT $FF SET IN 'COMDEP'
243 CC
244 CC LIST - LIST, NOLIST OPTION FLAG.
245 CC 1 = LIST ASSEMBLY (DEFAULT)
246 CC 0 = DON'T LIST ASSEMBLY
247 CC
248 CC IOBJ - OBJECT OUTPUT, NO OBJECT OUTPUT FLAG
249 CC 1 = OBJECT OUTPUT REQUESTED - DEFAULT
250 CC 0 = NO OBJECT OUTPUT REQUESTED
251 CC
252 CC IPLEN - NUMBER OF LINES PER PAGE
253 CC INITIALIZED TO 65
254 CC
255 CC LLEN - NUMBER CHARACTERS PER LINE
256 CC DEFAULT = 80
257 CC MIN = 26
258 CC MAX = 120
259 CC MAX NUMBER CHARACTERS INPUT ON SOURCE LINE = 95
260 CC
261 CC LLENSW - FLAG INDICATING COMMAND 'LLEN' HAS BEEN USED.
262 CC 1 = 'LLEN' IN EFFECT, ADJUST OUTPUT LINE TO
263 CC PARTICULAR COLUMN
264 CC 0 = DEFAULT = 'LLEN' NOT IN EFFECT.
265 CC NOTE: A SOURCE LINE IS NOT COLUMN ADJUSTED ON
266 CC OUTPUT UNLESS 'LLEN' IS USED.
267 CC
268 CC ICOL - USED TO FLAG IFXX IN PROCESS, AND MACRO FLAG.
269 CC
270 CC NEST - IFXX-ENDC NEST COUNT.
271 CC
272 CC2.3 MODIFYING SYMBOL TABLE SIZE.
273 CC
274 CC CHANGE EACH OCCURRANCE OF ISYM(N) IN COMMON /A/ FROM ITS
275 CC CURRENT VALUE TO DESIRED VALUE. CHANGE VARIABLE 'LENSYM'
276 CC IN BLOCK DATA TO EQUAL VALUE OF 'N-10' IN COMMON /A/ ISYM(N).
277 CC
278 CC2.4 ERROR MESSAGES
279 CC
280 CC ERROR # DESCRIPTION
281 CC ------- ----------
282 CC 0201 ILLEGAL CHARACTER
283 CC 0202 SYMBOL TOO LONG
284 CC 0203 IMPROPER TERMINATION OF OPERAND FIELD
285 CC 0204 SYNTAX ERROR
286 CC 0205 SIZE SUBFIELD NOT ALLOWED FOR THIS OPCODE
287 CC 0206 REDEFINED SYMBOL
288 CC 0207 UNDEFINED SYMBOL
289 CC 0208 DISPLACEMENT RANGE (SIZE) ERROR
290 CC 0209 ILLEGAL ADDRESS MODE FOR THIS INSTRUCTION
291 CC 0210 VALUE TOO LARGE
292 CC 0211 UNDEFINED SYMBOL
293 CC 0212 DATA SIZE IS INVALID
294 CC 0213 REGISTER MUST BE ADDRESS REGISTER
295 CC 0214 INVALID SIZE SPECIFIED FOR INDEX REGISTER (MUST BE .L)
296 CC 0215 REGISTER MUST BE DATA REGISTER
297 CC 0216 NEGATIVE NOT ALLOWED
298 CC 0217 BYTE MODE NOT ALLOWED
299 CC 0218 DESTINATION MUST BE ALTERABLE
300 CC 0219 TOO MANY OPERANDS FOR THIS INSTRUCTION
301 CC 0220 PHASING ERROR BETWEEN PASS ONE AND PASS TWO.
302 CC 0221 SYMBOL TABLE OVERFLOW
303 CC 0222 INTERNAL ERROR - PARSE STACK OVERFLOW
304 CC 0223 INTERNAL ERROR - UNDEFINED ACTION
305 CC 0224 ILLEGAL MACRO PARAMETER
306 CC 0225 MISPLACED 'MACRO' OR 'ENDM'
307 CC 0226 MACRO CALLS NESTED TOO DEEP
308 CC 0227 MULTIPLE REGISTERS ALLOWED ONLY FOR MOVEM(LDM,STM)
309 CC 0228 INTERNAL ERROR - SYMBOL LOST
310 CC 0229 LABEL REQUIRED ON THIS STATEMENT
311 CC 0230 INSTRUCTION ADDRESS HAS FALLEN ON AN ODD BOUNDARY
312 CC 0231 SYMBOL/EXPRESSION MUST BE ABSOLUTE
313 CC 0232 AND/OR/EOR TO CCR OR SR MUST HAVE IMMEDIATE SOURCE
314 CC 0233 ILLEGAL REGISTER FOR THIS INSTRUCTION
315 CC 0234 INVALID SYNTAX FOR THIS INSTRUCTION
316 CC 0235 FORWARD REFERENCED ADDRESS CANNOT BE LONG ABSOLUTE MODE
317 CC 0236 MEMORY SHIFTS MAY ONLY BE SINGLE BIT
318 CC 0237 ILLEGAL OPERATION ON A RELATIVE SYMBOL
319 CC 0238 INVALID BYTE SIZE FOR THIS INSTRUCTION
320 CC 0239 'END' DOES NOT TERMINATE SOURCE PROGRAM AS IT SHOULD
321 CC 0240 ILLEGAL FORWARD REFERENCE
322 CC
323 CC3.0 INSTALLATION OF THE M68000 CROSS ASSEMBLER ON A PDP-11 SYSTEM
324 CC TYPE SYSTEM.
325 CC
326 CC THE CROSS ASSEMBLER COMES ON A TAPE IN ONE FILE.
327 CC EACH SUBPROGRAM MUST BE SEPARATED FROM THIS FILE AND COMPILED
328 CC SEPARATELY IN ORDER TO LINK THE ENTIRE PROGRAM INTO A TASK.
329 CC ALL BUT 5 SUBPROGRAMS ARE WRITTEN IN FORTRAN. PROGRAMS MUST BE
330 CC COMPILED WITH THE /ON AND /SU FORTRAN OPTIONS TO GET THE LOAD
331 CC MODULE SMALL ENOUGH TO FIT IN 28K OF MEMORY ON A DOS SYSTEM.
332 CC USE /NOVA/NOSN ON AN RSX-M SYSTEM.
333 CC NOVA=NO 32 BIT INTEGERS
334 CC NOSN=NO INTERNAL STATEMENT #'S GEN'D BY COMPILER
335 CC THE FOLLOWING SWITCHES ARE USED WITH FORTRAN IV-PLUS, V02-51
336 CC /NOTR NO TRACE
337 CC /NOCK NO SUBCRIPT CHECKING
338 CC
339 CC IT SHOULD BE POSSIBLE TO OVERLAY THIS PROGRAM TO
340 CC GET MORE MEMORY AVAILABLE FOR SYMBOL TABLE SPACE. ALL ROUTINES
341 CC EXCEPT 'ACT1', 'BUILD1', 'ACT2', 'BUILD2', AND 'PRSYM' MUST
342 CC BE IN MEMORY, OR MUST BE IN THE MAIN OVERLAY. ACT1 CALLS
343 CC BUILD1 AND BOTH ARE USED IN PASS 1 ONLY. THEREFORE THESE TWO
344 CC SUBPROGRAMS CAN BE CONCATENATED AS ONE OVERLAY. ACT2, BUILD2
345 CC DO NOT CALL EACH OTHER AND MAY EACH BE THE SAME LEVEL OVERLAY
346 CC AS ACT1 SINCE THEY ARE USED ONLY IN PASS 2 . PRSYM PRINTS OUT
347 CC SYMBOL TABLE WHEN PASS 2 IS DONE SO IT CAN BE AT THE SAME
348 CC LEVEL AS ACT1, ACT2, AND BUILD2.
349 CC
350 CC SEVERAL PAGES OF NOTES ON ASSEMBLER CONSTRUCTION, VARIABLE
351 CC NAMES, COMMON, AND A DESCRIPTION OF THE VARIABLE NAMES IS
352 CC INCLUDED. THIS IS FOR INFORMATION ONLY AND IS NOT PART OF THE
353 CC OVERALL SOURCE PROGRAM.
354 CC
355 CC THE MAIN PROGRAM IS 'MACS'. SEVERAL SUBPROGRAMS FOLLOW 'MACS'
356 CC ALL IN FORTRAN. FIVE MORE IN PDP-11 ASSEMBLY LANGUAGE FOLLOW.
357 CC THE ASSEMBLY LANGUAGE PROGRAMS ARE: ADD,MUL,SUB,DIV,NEGATE.
358 CC SEPARATE THE FORTRAN PROGRAMS AND COMPILE EACH ONE. THEN
359 CC SEPARATE THE ASSEMBLY PROGRAMS AND ASSEMBLE EACH ONE.
360 CC LINK ALL OF THE RESULTANT .OBJ FILES IN TO A TASK(LOAD
361 CC MODULE). WHEN THIS IS DONE IT IS READY FOR EXECUTION.
362 CC
363 CC AS A TEST OF THE INSTALLATION OF THE CROSS ASSEMBLER IT
364 CC IS SUGGESTED THE SORT PROGRAM FOUND IN APPENDIX E OF THE
365 CC CROSS MACRO ASSEMBLER REFERENCE MANUAL, M68KXASM(D3), BE
366 CC USED. THIS PROGRAM SHOULD EXECUTE IN EITHER THE HARDWARE
367 CC OR A SIMULATOR SUCCESSFULLY.
368 CC
369 CC ONCE THE LOAD MODULE IS UP AND RUNNING, IT IS READY
370 CC FOR EXECUTION.
371 CC
372 CC RSX-11M SYSTEM.
373 CC ROUTINE 'FILEOP' HAS 'CALL ASSIGN' IN IT FOR THE RSX-11M
374 CC SYSTEM. THIS ROUTINE MUST BE CHANGED IF THE USER DOES NOT
375 CC WANT TO USE THIS METHOD OF ACCESSING FILES. 'FILEOP' ALSO
376 CC REQUESTS THE FILENAME FOR THE OUTPUT LISTING. IF THE SYSTEM
377 CC ALLOWS DIRECT OUTPUT TO THE LINE PRINTER THIS MAY BE
378 CC CHANGED ACCORDINGLY. THE 'CALL FILEOP(6)' IN 'MACS'
379 CC MUST ALSO BE DELETED IN THIS CASE, UNLESS THE COMPLETE
380 CC IN CHANGE IS MADE IN 'FILEOP'. THE REQUEST FOR PRINTING
381 CC PASS 1 IN 'MACS' MAY ALSO BE REMOVED IF DESIRED. THIS IS A
382 CC DEBUGGING AID.
383 CC NAMES FOR ALL FILES ARE REQUESTED FROM 'FILEOP'.
384 CC
385 CC THIS SOFTWARE HAS BEEN CHECKED OUT ON AN RSX-11M VERSION 3.2
386 CC SYSTEM. IT HAS NOT BEEN RAN ON AN RSTS OR UNIX SYSTEM. THE
387 CC SOFTWARE IS SENT OUT ON AN 800 BPI UN-LABELED 9-TRACK TAPE.
388 CC IT IS IN ASCII, 80 BYTES PER RECORD AND BLOCK. THE USER
389 CC MUST BE ABLE TO READ THIS TYPE OF TAPE.
390 CC A FORTRAN PROGRAM USING CALLS TO 'QIO' IS AVAILABLE FROM
391 CC MOTOROLA TO DO THIS READ. IT IS PLANNED TO PUT A COPY
392 CC OF THIS PROGRAM IN THE NEXT UPDATE OF THE REFERENCE MANUAL.
393 CC RELEASES PREVIOUS TO 1.4 WERE CHECKED OUT ON RSX-11M, FORTRAN
394 CC V02.2-1. RELEASE 1.4 WAS CHECKED OUT ON FORTRAN IV-PLUS
395 CC V02-51. A CHANGE HAD TO BE MADE IN THE CALL TO 'ASSIGN' TO
396 CC BE DOWNWARD COMPATIBLE WITH DEC'S CHANGE IN 'ASSIGN' REQUIRING
397 CC THE FIRST CHARACTER AT THE END OF THE FILENAME TO BE A NULL.
398 CC
399 CC AFTER READING THE TAPE IN TO A DISC FILE IT IS BEST TO WRITE A
400 CC FORTRAN PROGRAM THAT READ IN THAT FILE AND SPLIT IT INTO THE
401 CC SEPARATE SUBPROGRAMS.
402 CC
403 CC *** END OF THIS ARTICLE ***
404 CC
405 CC
406 CC
407 CC
408 CC NAM: MACS VER: 1.0 DAT: DEC 8, 1978 CMP: PDP-11
409 CC
410 CC SYS: MACS
411 CC
412 CC FNC: THIS IS THE MAIN PROGRAM FOR THE M68000 CROSS ASSEMBLER.
413 CC IT INITIALIZES SEVERAL VARIABLES, AND
414 CC CALLS ROUTINES FOR PASS1 AND PASS 2.
415 CC
416 CC ******************************************************
417 CC *** ***
418 CC *** COPYRIGHT 1978 BY MOTOROLA INCC ***
419 CC *** ***
420 CC ******************************************************
421 CC
422 CC ***********************************************************
423 CC *** ***
424 CC *** THIS IS A PRELIMINARY RELEASE OF THE MC68000 ***
425 CC *** CROSS ASSEMBLER. AS SUCH IT IS POSSIBLE THE ***
426 CC *** INSTRUCTION SET FOR THE MC68000 MAY CHANGE ***
427 CC *** CAUSING CHANGES IN THIS CROSS ASSEMBLER. ***
428 CC *** MOTOROLA RESERVES THE RIGHT TO MAKE CHANGES ***
429 CC *** WITHOUT NOTICE. ***
430 CC *** ***
431 CC ***********************************************************
432 CC
433 CC REV: N/A
434 CC
435 CCALLS COMDEP-FILEOP-PNCH-ERR-PRSYM-PAGE
436 CC
437 C*
438 IMPLICIT INTEGER (A-Z)
439 COMMON /A/ ISYM(3000),KARD1(96),ITOKEN(70),TKNSIZ,TKNTYP,
440 & TKNVAL,TKNVA2,JSUC,JPTR,LPTR,NXSYM,KOLUMN,KD1BCT,KD1LNO,JERR,
441 & MNUM,IPASS,IPC2,IPC,IOPC,INS(5),INSL,ISIZ,IADM(7,2),LUOT
442 COMMON /A/ KASH(64),KPAC(15),KPWCT,LENSYM,KCLAS(64)
443 COMMON /A/ NET1(64),NET2(64),NET3(64),NET4(64),NET5(64)
444 COMMON /A/ NBPW,KSYS,IEOT,LSP,JBUF(83),KARD2(80,3),IHB480,IHEX9K
445 COMMON /A/ IA1SHF,KCFF,LUSI,LUDI,LUOO,LLEN,IPLEN
446 COMMON /A/ LIST,ICOL,NEST,LUCI,LULT,MFLD(11,3),IOBJ,LLENSW,NOP
447 COMMON /A/ NXSYM1
448 DIMENSION KCLAS2(64)
449 DATA KCLAS2/8,9,9,9,3,9,9,5,9,9,9,9,9,9,9,9,
450 & 7,7,7,7,7,7,7,7,7,7,9,9,9,9,9,9,
451 & 6,4,4,4,4,4,4,6,6,6,6,6,6,6,6,6,
452 & 6,6,6,6,6,6,6,6,6,6,6,9,2,9,6,6/
453 DATA IYES/'Y'/
454 C
455 C*** INITIALIZE VARIABLES, IO DEVICES
456 CALL COMDEP
457 9960 FORMAT(' PRINT PASS 1? (Y/N)'/)
458 9961 FORMAT(A1)
459 WRITE(LULT,9960)
460 READ(LUCI,9961) JJJ
461 IF(JJJ.EQ.IYES) CALL DEBUG(1)
462 C
463 C+++ THIS FILE OUTPUT OF SOURCE IS TO GET AROUND
464 C+++ THE SPOOLING TO PRINTER ON THE SYSTEM.
465 C+++ REMOVE THE 'CALL FILEOP(6)' TO GO DIRECTLY TO PRINTER
466 C
467 C+++ ALSO REMOVE TEST AT END OF THIS PROGRAM FOR CLOSING FILE 3
468 CALL FILEOP(6)
469 C
470 C+++ END
471 C
472 DO 40 I=1,11
473 DO 40 J=1,3
474 40 MFLD(I,J)=0
475 C*** SET UP COMMON /A/ARRAY 'KCLAS'
476 DO 70 I=1,64
477 70 KCLAS(I)=KCLAS2(I)
478 C*** PAGE SWITCH DEFAULT ON
479 NOP=1
480 C*** FLAG NOT TO PRINT EXPANDED LITERALS
481 LUDI=0
482 C*** IOBJ=1=OBJECT OUT - IOBJ=0=NO OBJECT OUT
483 IOBJ=1
484 C
485 C*** LIST=0 NOLIST - LIST=1 LIST(DEFAULT).
486 LIST= 1
487 C*** SET DEFAULT LINE LENGTH
488 LLEN=80
489 C*** SET DO NOT ADJUST OUTPUT LINE SWITCH
490 LLENSW=0
491 C*** SET DEFAULT PAGE COUNT TO 65 LINES/PAGE
492 IPLEN=65
493 ICOL=0
494 NEST=0
495 MNUM=0
496 C*** ASCII BLANK, RIGHT JUSTIFIED, ZERO FILLED.
497 LSP=32
498 C*** LEAVE SYMBOL TABLE SIZE LESS THAN MAX IN ORDER TO HANDLE
499 C*** SYMBOL TABLE OVERFLOW.
500 LENSYM=2990
501 IEOT=4
502 JERR=0
503 IPC2=0
504 IPC=0
505 IADM(7,2)=0
506 IADM(7,1)=1
507 C*** INIT MACRO @000 VALUE
508 KARD2(1,1)=64
509 KARD2(2,1)=48
510 KARD2(3,1)=48
511 KARD2(4,1)=48
512 KARD2(5,1)=0
513 C*** PRINT THIS HEADER TO CONSOLE
514 CALL PAGE(81)
515 C
516 C
517 C*** GET SI FN OPENED
518 C
519 CALL FILEOP(1)
520 C*** OUTPUT HEADER
521 CALL PAGE(82)
522 C
523 C*** PERFORM PASS ONE
524 C
525 750 CONTINUE
526 IPASS=-1
527 C*** SAVE FOR SYMBOL TABLE PRINT OUT.
528 900 NXSYM1=NXSYM
529 1000 CALL PAR
530 IF(IPASS.LT.0) GO TO 1000
531 C
532 C*** PERFORM PASS TWO
533 C
534 C*** IS OBJECT OUTPUT DESIRED?
535 IF(IOBJ.EQ.0) GO TO 1100
536 C*** OPEN OBJ FILE
537 CALL FILEOP(5)
538 CALL PNCH(1,IPC)
539 CALL PNCH(3,IPC)
540 1100 CONTINUE
541 C
542 C*** IN CASE IFXX - ENDC NOT EQUAL RESET
543 C
544 NEST=0
545 C
546 C
547 C*** RESET MACRO @ COUNTER
548 KARD2(1,1)=64
549 KARD2(2,1)=48
550 KARD2(3,1)=48
551 KARD2(4,1)=48
552 KARD2(5,1)=0
553 C
554 2000 CALL PAR
555 IF(IPASS.EQ.0) GO TO 2000
556 C*** END OF PASS 2
557 C*** PRINT FINAL ERROR COUNT
558 CALL ERR(-1)
559 C*** PRINT SYMBOL TABLE
560 CALL PRSYM
561 C*** PUT OUT TRAILING RECORD IF OBJECT OUT REQ.
562 IF(IOBJ.EQ.0) GO TO 3000
563 CALL PNCH(2,IPC)
564 C*** CLOSE OBJECT OUTPUT FILE
565 2900 CALL FILEOP(4)
566 C
567 C+++ IF LIST IS TO FILE, CLOSE IT
568 C
569 3000 CONTINUE
570 IF(LUOT.EQ.3) CALL CLOSE(3)
571 END
572 BLOCK DATA
573 CC NAM: BLOCK DATA VER: 1.0 DAT: DEC 8, 1978 CMP: PDP-11
574 C
575 C*
576 IMPLICIT INTEGER (A-Z)
577 COMMON /A/ ISYM(3000),KARD1(96),ITOKEN(70),TKNSIZ,TKNTYP,
578 & TKNVAL,TKNVA2,JSUC,JPTR,LPTR,NXSYM,KOLUMN,KD1BCT,KD1LNO,JERR,
579 & MNUM,IPASS,IPC2,IPC,IOPC,INS(5),INSL,ISIZ,IADM(7,2),LUOT
580 COMMON /A/ KASH(64),KPAC(15),KPWCT,LENSYM,KCLAS(64)
581 COMMON /A/ NET1(64),NET2(64),NET3(64),NET4(64),NET5(64)
582 COMMON /A/ NBPW,KSYS,IEOT,LSP,JBUF(83),KARD2(80,3),IHB480,IHEX9K
583 COMMON /A/ IA1SHF,KCFF,LUSI,LUDI,LUOO,LLEN,IPLEN
584 COMMON /A/ LIST,ICOL,NEST
585 C
586 C*** THE C>>> MUST NOT BE MOVED, PARNET USES IT
587 C>>>
588 DATA NXSYM/1171/
589 DATA ISYM( 1)/O 0/,ISYM( 2)/O 1777/,ISYM( 3)/O 141/
590 DATA ISYM( 4)/O 46501/,ISYM( 5)/O 41522/,ISYM( 6)/O 47400/
591 DATA ISYM( 7)/O177777/,ISYM( 8)/O 0/,ISYM( 9)/O 0/
592 DATA ISYM( 10)/O 1377/,ISYM( 11)/O 661/,ISYM( 12)/O 42516/
593 DATA ISYM( 13)/O 42115/,ISYM( 14)/O177777/,ISYM( 15)/O 1/
594 DATA ISYM( 16)/O 0/,ISYM( 17)/O 1777/,ISYM( 18)/O 150/
595 DATA ISYM( 19)/O 46505/,ISYM( 20)/O 54111/,ISYM( 21)/O 52000/
596 DATA ISYM( 22)/O177777/,ISYM( 23)/O 2/,ISYM( 24)/O 0/
597 DATA ISYM( 25)/O 1377/,ISYM( 26)/O 275/,ISYM( 27)/O 42516/
598 DATA ISYM( 28)/O 42000/,ISYM( 29)/O 1/,ISYM( 30)/O 1/
599 DATA ISYM( 31)/O 0/,ISYM( 32)/O 1377/,ISYM( 33)/O 402/
600 DATA ISYM( 34)/O 42516/,ISYM( 35)/O 42103/,ISYM( 36)/O 1/
601 DATA ISYM( 37)/O 2/,ISYM( 38)/O 0/,ISYM( 39)/O 1377/
602 DATA ISYM( 40)/O 616/,ISYM( 41)/O 50101/,ISYM( 42)/O 43505/
603 DATA ISYM( 43)/O 1/,ISYM( 44)/O 3/,ISYM( 45)/O 0/
604 DATA ISYM( 46)/O 1377/,ISYM( 47)/O 742/,ISYM( 48)/O 46111/
605 DATA ISYM( 49)/O 51524/,ISYM( 50)/O 1/,ISYM( 51)/O 4/
606 DATA ISYM( 52)/O 0/,ISYM( 53)/O 1777/,ISYM( 54)/O 677/
607 DATA ISYM( 55)/O 47117/,ISYM( 56)/O 46111/,ISYM( 57)/O 51524/
608 DATA ISYM( 58)/O 1/,ISYM( 59)/O 5/,ISYM( 60)/O 0/
609 DATA ISYM( 61)/O 1377/,ISYM( 62)/O 706/,ISYM( 63)/O 47117/
610 DATA ISYM( 64)/O 46000/,ISYM( 65)/O 1/,ISYM( 66)/O 5/
611 DATA ISYM( 67)/O 0/,ISYM( 68)/O 1377/,ISYM( 69)/O 1756/
612 DATA ISYM( 70)/O 52124/,ISYM( 71)/O 46000/,ISYM( 72)/O 1/
613 DATA ISYM( 73)/O 6/,ISYM( 74)/O 0/,ISYM( 75)/O 1777/
614 DATA ISYM( 76)/O 303/,ISYM( 77)/O 47117/,ISYM( 78)/O 50101/
615 DATA ISYM( 79)/O 43505/,ISYM( 80)/O 1/,ISYM( 81)/O 7/
616 DATA ISYM( 82)/O 0/,ISYM( 83)/O 1777/,ISYM( 84)/O 175/
617 DATA ISYM( 85)/O 47117/,ISYM( 86)/O 47502/,ISYM( 87)/O 45000/
618 DATA ISYM( 88)/O 1/,ISYM( 89)/O 10/,ISYM( 90)/O 0/
619 DATA ISYM( 91)/O 1377/,ISYM( 92)/O 266/,ISYM( 93)/O 41515/
620 DATA ISYM( 94)/O 50114/,ISYM( 95)/O 1/,ISYM( 96)/O 11/
621 DATA ISYM( 97)/O 0/,ISYM( 98)/O 1377/,ISYM( 99)/O 634/
622 DATA ISYM( 100)/O 41515/,ISYM( 101)/O 50122/,ISYM( 102)/O 1/
623 DATA ISYM( 103)/O 12/,ISYM( 104)/O 0/,ISYM( 105)/O 777/
624 DATA ISYM( 106)/O 242/,ISYM( 107)/O 43400/,ISYM( 108)/O 1/
625 DATA ISYM( 109)/O 13/,ISYM( 110)/O 0/,ISYM( 111)/O 1777/
626 DATA ISYM( 112)/O 562/,ISYM( 113)/O 46501/,ISYM( 114)/O 51513/
627 DATA ISYM( 115)/O 31000/,ISYM( 116)/O 1/,ISYM( 117)/O 14/
628 DATA ISYM( 118)/O 0/,ISYM( 119)/O 1377/,ISYM( 120)/O 257/
629 DATA ISYM( 121)/O 51124/,ISYM( 122)/O 42400/,ISYM( 123)/O 2/
630 DATA ISYM( 124)/O 47163/,ISYM( 125)/O 0/,ISYM( 126)/O 1377/
631 DATA ISYM( 127)/O 1104/,ISYM( 128)/O 51124/,ISYM( 129)/O 51000/
632 DATA ISYM( 130)/O 2/,ISYM( 131)/O 47167/,ISYM( 132)/O 0/
633 DATA ISYM( 133)/O 1377/,ISYM( 134)/O 2067/,ISYM( 135)/O 51124/
634 DATA ISYM( 136)/O 51400/,ISYM( 137)/O 2/,ISYM( 138)/O 47165/
635 DATA ISYM( 139)/O 0/,ISYM( 140)/O 1777/,ISYM( 141)/O 1066/
636 DATA ISYM( 142)/O 51105/,ISYM( 143)/O 51505/,ISYM( 144)/O 52000/
637 DATA ISYM( 145)/O 2/,ISYM( 146)/O 47160/,ISYM( 147)/O 0/
638 DATA ISYM( 148)/O 1777/,ISYM( 149)/O 0/,ISYM( 150)/O 52122/
639 DATA ISYM( 151)/O 40520/,ISYM( 152)/O 53000/,ISYM( 153)/O 2/
640 DATA ISYM( 154)/O 47166/,ISYM( 155)/O 0/,ISYM( 156)/O 1377/
641 DATA ISYM( 157)/O 1326/,ISYM( 158)/O 47117/,ISYM( 159)/O 50000/
642 DATA ISYM( 160)/O 2/,ISYM( 161)/O 47161/,ISYM( 162)/O 0/
643 DATA ISYM( 163)/O 777/,ISYM( 164)/O 1371/,ISYM( 165)/O 42103/
644 DATA ISYM( 166)/O 4/,ISYM( 167)/O 0/,ISYM( 168)/O 0/
645 DATA ISYM( 169)/O 1377/,ISYM( 170)/O 652/,ISYM( 171)/O 47522/
646 DATA ISYM( 172)/O 43400/,ISYM( 173)/O 5/,ISYM( 174)/O 1/
647 DATA ISYM( 175)/O 0/,ISYM( 176)/O 1377/,ISYM( 177)/O 553/
648 DATA ISYM( 178)/O 42521/,ISYM( 179)/O 52400/,ISYM( 180)/O 5/
649 DATA ISYM( 181)/O 2/,ISYM( 182)/O 0/,ISYM( 183)/O 1377/
650 DATA ISYM( 184)/O 733/,ISYM( 185)/O 51505/,ISYM( 186)/O 52000/
651 DATA ISYM( 187)/O 5/,ISYM( 188)/O 3/,ISYM( 189)/O 0/
652 DATA ISYM( 190)/O 777/,ISYM( 191)/O 420/,ISYM( 192)/O 42123/
653 DATA ISYM( 193)/O 5/,ISYM( 194)/O 4/,ISYM( 195)/O 0/
654 DATA ISYM( 196)/O 1377/,ISYM( 197)/O 337/,ISYM( 198)/O 51117/
655 DATA ISYM( 199)/O 51107/,ISYM( 200)/O 5/,ISYM( 201)/O 5/
656 DATA ISYM( 202)/O 0/,ISYM( 203)/O 1377/,ISYM( 204)/O 1221/
657 DATA ISYM( 205)/O 43101/,ISYM( 206)/O 44514/,ISYM( 207)/O 5/
658 DATA ISYM( 208)/O 6/,ISYM( 209)/O 0/,ISYM( 210)/O 1377/
659 DATA ISYM( 211)/O 715/,ISYM( 212)/O 51520/,ISYM( 213)/O 41400/
660 DATA ISYM( 214)/O 5/,ISYM( 215)/O 7/,ISYM( 216)/O 0/
661 DATA ISYM( 217)/O 1377/,ISYM( 218)/O 1005/,ISYM( 219)/O 46111/
662 DATA ISYM( 220)/O 47113/,ISYM( 221)/O 6/,ISYM( 222)/O 47120/
663 DATA ISYM( 223)/O 0/,ISYM( 224)/O 1377/,ISYM( 225)/O 1670/
664 DATA ISYM( 226)/O 52516/,ISYM( 227)/O 46113/,ISYM( 228)/O 6/
665 DATA ISYM( 229)/O 47130/,ISYM( 230)/O 0/,ISYM( 231)/O 1377/
666 DATA ISYM( 232)/O 364/,ISYM( 233)/O 51527/,ISYM( 234)/O 40520/
667 DATA ISYM( 235)/O 7/,ISYM( 236)/O 44100/,ISYM( 237)/O 0/
668 DATA ISYM( 238)/O 1377/,ISYM( 239)/O 1720/,ISYM( 240)/O 52122/
669 DATA ISYM( 241)/O 40520/,ISYM( 242)/O 10/,ISYM( 243)/O 47100/
670 DATA ISYM( 244)/O 0/,ISYM( 245)/O 1377/,ISYM( 246)/O 1174/
671 DATA ISYM( 247)/O 52123/,ISYM( 248)/O 52000/,ISYM( 249)/O 11/
672 DATA ISYM( 250)/O 45000/,ISYM( 251)/O 0/,ISYM( 252)/O 1377/
673 DATA ISYM( 253)/O 501/,ISYM( 254)/O 41514/,ISYM( 255)/O 51000/
674 DATA ISYM( 256)/O 11/,ISYM( 257)/O 41000/,ISYM( 258)/O 0/
675 DATA ISYM( 259)/O 1377/,ISYM( 260)/O 1147/,ISYM( 261)/O 47105/
676 DATA ISYM( 262)/O 43400/,ISYM( 263)/O 11/,ISYM( 264)/O 42000/
677 DATA ISYM( 265)/O 0/,ISYM( 266)/O 1377/,ISYM( 267)/O 643/
678 DATA ISYM( 268)/O 47117/,ISYM( 269)/O 52000/,ISYM( 270)/O 11/
679 DATA ISYM( 271)/O 43000/,ISYM( 272)/O 0/,ISYM( 273)/O 1377/
680 DATA ISYM( 274)/O 1417/,ISYM( 275)/O 47102/,ISYM( 276)/O 41504/
681 DATA ISYM( 277)/O 12/,ISYM( 278)/O 44000/,ISYM( 279)/O 0/
682 DATA ISYM( 280)/O 1377/,ISYM( 281)/O 1317/,ISYM( 282)/O 50105/
683 DATA ISYM( 283)/O 40400/,ISYM( 284)/O 13/,ISYM( 285)/O 44100/
684 DATA ISYM( 286)/O 0/,ISYM( 287)/O 1377/,ISYM( 288)/O 751/
685 DATA ISYM( 289)/O 45123/,ISYM( 290)/O 51000/,ISYM( 291)/O 14/
686 DATA ISYM( 292)/O 47200/,ISYM( 293)/O 0/,ISYM( 294)/O 1377/
687 DATA ISYM( 295)/O 463/,ISYM( 296)/O 45115/,ISYM( 297)/O 50000/
688 DATA ISYM( 298)/O 14/,ISYM( 299)/O 47300/,ISYM( 300)/O 0/
689 DATA ISYM( 301)/O 1377/,ISYM( 302)/O 526/,ISYM( 303)/O 41122/
690 DATA ISYM( 304)/O 40400/,ISYM( 305)/O 15/,ISYM( 306)/O 60000/
691 DATA ISYM( 307)/O 0/,ISYM( 308)/O 1377/,ISYM( 309)/O 0/
692 DATA ISYM( 310)/O 41123/,ISYM( 311)/O 51000/,ISYM( 312)/O 15/
693 DATA ISYM( 313)/O 60400/,ISYM( 314)/O 0/,ISYM( 315)/O 1377/
694 DATA ISYM( 316)/O 625/,ISYM( 317)/O 41110/,ISYM( 318)/O 44400/
695 DATA ISYM( 319)/O 15/,ISYM( 320)/O 61000/,ISYM( 321)/O 0/
696 DATA ISYM( 322)/O 1377/,ISYM( 323)/O 1237/,ISYM( 324)/O 41114/
697 DATA ISYM( 325)/O 51400/,ISYM( 326)/O 15/,ISYM( 327)/O 61400/
698 DATA ISYM( 328)/O 0/,ISYM( 329)/O 1377/,ISYM( 330)/O 1737/
699 DATA ISYM( 331)/O 41103/,ISYM( 332)/O 41400/,ISYM( 333)/O 15/
700 DATA ISYM( 334)/O 62000/,ISYM( 335)/O 0/,ISYM( 336)/O 1377/
701 DATA ISYM( 337)/O 535/,ISYM( 338)/O 41103/,ISYM( 339)/O 51400/
702 DATA ISYM( 340)/O 15/,ISYM( 341)/O 62400/,ISYM( 342)/O 0/
703 DATA ISYM( 343)/O 1377/,ISYM( 344)/O 0/,ISYM( 345)/O 41116/
704 DATA ISYM( 346)/O 42400/,ISYM( 347)/O 15/,ISYM( 348)/O 63000/
705 DATA ISYM( 349)/O 0/,ISYM( 350)/O 1377/,ISYM( 351)/O 571/
706 DATA ISYM( 352)/O 41105/,ISYM( 353)/O 50400/,ISYM( 354)/O 15/
707 DATA ISYM( 355)/O 63400/,ISYM( 356)/O 0/,ISYM( 357)/O 1377/
708 DATA ISYM( 358)/O 0/,ISYM( 359)/O 41126/,ISYM( 360)/O 41400/
709 DATA ISYM( 361)/O 15/,ISYM( 362)/O 64000/,ISYM( 363)/O 0/
710 DATA ISYM( 364)/O 1377/,ISYM( 365)/O 1041/,ISYM( 366)/O 41126/
711 DATA ISYM( 367)/O 51400/,ISYM( 368)/O 15/,ISYM( 369)/O 64400/
712 DATA ISYM( 370)/O 0/,ISYM( 371)/O 1377/,ISYM( 372)/O 0/
713 DATA ISYM( 373)/O 41120/,ISYM( 374)/O 46000/,ISYM( 375)/O 15/
714 DATA ISYM( 376)/O 65000/,ISYM( 377)/O 0/,ISYM( 378)/O 1377/
715 DATA ISYM( 379)/O 2206/,ISYM( 380)/O 41115/,ISYM( 381)/O 44400/
716 DATA ISYM( 382)/O 15/,ISYM( 383)/O 65400/,ISYM( 384)/O 0/
717 DATA ISYM( 385)/O 1377/,ISYM( 386)/O 0/,ISYM( 387)/O 41107/
718 DATA ISYM( 388)/O 42400/,ISYM( 389)/O 15/,ISYM( 390)/O 66000/
719 DATA ISYM( 391)/O 0/,ISYM( 392)/O 1377/,ISYM( 393)/O 1032/
720 DATA ISYM( 394)/O 41114/,ISYM( 395)/O 52000/,ISYM( 396)/O 15/
721 DATA ISYM( 397)/O 66400/,ISYM( 398)/O 0/,ISYM( 399)/O 1377/
722 DATA ISYM( 400)/O 1747/,ISYM( 401)/O 41107/,ISYM( 402)/O 52000/
723 DATA ISYM( 403)/O 15/,ISYM( 404)/O 67000/,ISYM( 405)/O 0/
724 DATA ISYM( 406)/O 1377/,ISYM( 407)/O 1212/,ISYM( 408)/O 41114/
725 DATA ISYM( 409)/O 42400/,ISYM( 410)/O 15/,ISYM( 411)/O 67400/
726 DATA ISYM( 412)/O 0/,ISYM( 413)/O 1377/,ISYM( 414)/O 670/
727 DATA ISYM( 415)/O 47105/,ISYM( 416)/O 43530/,ISYM( 417)/O 16/
728 DATA ISYM( 418)/O 40000/,ISYM( 419)/O 0/,ISYM( 420)/O 1377/
729 DATA ISYM( 421)/O 1615/,ISYM( 422)/O 42530/,ISYM( 423)/O 52000/
730 DATA ISYM( 424)/O 17/,ISYM( 425)/O 44200/,ISYM( 426)/O 0/
731 DATA ISYM( 427)/O 1377/,ISYM( 428)/O 0/,ISYM( 429)/O 52101/
732 DATA ISYM( 430)/O 51400/,ISYM( 431)/O 20/,ISYM( 432)/O 45300/
733 DATA ISYM( 433)/O 0/,ISYM( 434)/O 1377/,ISYM( 435)/O 1014/
734 DATA ISYM( 436)/O 51510/,ISYM( 437)/O 44400/,ISYM( 438)/O 21/
735 DATA ISYM( 439)/O 51300/,ISYM( 440)/O 0/,ISYM( 441)/O 1377/
736 DATA ISYM( 442)/O 2117/,ISYM( 443)/O 51514/,ISYM( 444)/O 51400/
737 DATA ISYM( 445)/O 21/,ISYM( 446)/O 51700/,ISYM( 447)/O 0/
738 DATA ISYM( 448)/O 1377/,ISYM( 449)/O 1401/,ISYM( 450)/O 51503/
739 DATA ISYM( 451)/O 41400/,ISYM( 452)/O 21/,ISYM( 453)/O 52300/
740 DATA ISYM( 454)/O 0/,ISYM( 455)/O 1377/,ISYM( 456)/O 724/
741 DATA ISYM( 457)/O 51503/,ISYM( 458)/O 51400/,ISYM( 459)/O 21/
742 DATA ISYM( 460)/O 52700/,ISYM( 461)/O 0/,ISYM( 462)/O 1377/
743 DATA ISYM( 463)/O 1245/,ISYM( 464)/O 51516/,ISYM( 465)/O 42400/
744 DATA ISYM( 466)/O 21/,ISYM( 467)/O 53300/,ISYM( 468)/O 0/
745 DATA ISYM( 469)/O 1377/,ISYM( 470)/O 760/,ISYM( 471)/O 51505/
746 DATA ISYM( 472)/O 50400/,ISYM( 473)/O 21/,ISYM( 474)/O 53700/
747 DATA ISYM( 475)/O 0/,ISYM( 476)/O 1377/,ISYM( 477)/O 0/
748 DATA ISYM( 478)/O 51526/,ISYM( 479)/O 41400/,ISYM( 480)/O 21/
749 DATA ISYM( 481)/O 54300/,ISYM( 482)/O 0/,ISYM( 483)/O 1377/
750 DATA ISYM( 484)/O 0/,ISYM( 485)/O 51526/,ISYM( 486)/O 51400/
751 DATA ISYM( 487)/O 21/,ISYM( 488)/O 54700/,ISYM( 489)/O 0/
752 DATA ISYM( 490)/O 1377/,ISYM( 491)/O 1050/,ISYM( 492)/O 51520/
753 DATA ISYM( 493)/O 46000/,ISYM( 494)/O 21/,ISYM( 495)/O 55300/
754 DATA ISYM( 496)/O 0/,ISYM( 497)/O 1377/,ISYM( 498)/O 1301/
755 DATA ISYM( 499)/O 51515/,ISYM( 500)/O 44400/,ISYM( 501)/O 21/
756 DATA ISYM( 502)/O 55700/,ISYM( 503)/O 0/,ISYM( 504)/O 1377/
757 DATA ISYM( 505)/O 1471/,ISYM( 506)/O 51507/,ISYM( 507)/O 42400/
758 DATA ISYM( 508)/O 21/,ISYM( 509)/O 56300/,ISYM( 510)/O 0/
759 DATA ISYM( 511)/O 1377/,ISYM( 512)/O 1156/,ISYM( 513)/O 51514/
760 DATA ISYM( 514)/O 52000/,ISYM( 515)/O 21/,ISYM( 516)/O 56700/
761 DATA ISYM( 517)/O 0/,ISYM( 518)/O 1377/,ISYM( 519)/O 1642/
762 DATA ISYM( 520)/O 51507/,ISYM( 521)/O 52000/,ISYM( 522)/O 21/
763 DATA ISYM( 523)/O 57300/,ISYM( 524)/O 0/,ISYM( 525)/O 1377/
764 DATA ISYM( 526)/O 1310/,ISYM( 527)/O 51514/,ISYM( 528)/O 42400/
765 DATA ISYM( 529)/O 21/,ISYM( 530)/O 57700/,ISYM( 531)/O 0/
766 DATA ISYM( 532)/O 1377/,ISYM( 533)/O 1426/,ISYM( 534)/O 44506/
767 DATA ISYM( 535)/O 42521/,ISYM( 536)/O 22/,ISYM( 537)/O 1/
768 DATA ISYM( 538)/O 0/,ISYM( 539)/O 1377/,ISYM( 540)/O 1507/
769 DATA ISYM( 541)/O 44506/,ISYM( 542)/O 47105/,ISYM( 543)/O 22/
770 DATA ISYM( 544)/O 2/,ISYM( 545)/O 0/,ISYM( 546)/O 1377/
771 DATA ISYM( 547)/O 1165/,ISYM( 548)/O 46114/,ISYM( 549)/O 42516/
772 DATA ISYM( 550)/O 23/,ISYM( 551)/O 1/,ISYM( 552)/O 0/
773 DATA ISYM( 553)/O 1377/,ISYM( 554)/O 1254/,ISYM( 555)/O 50114/
774 DATA ISYM( 556)/O 42516/,ISYM( 557)/O 23/,ISYM( 558)/O 2/
775 DATA ISYM( 559)/O 0/,ISYM( 560)/O 1377/,ISYM( 561)/O 0/
776 DATA ISYM( 562)/O 51524/,ISYM( 563)/O 47520/,ISYM( 564)/O 23/
777 DATA ISYM( 565)/O 47162/,ISYM( 566)/O 0/,ISYM( 567)/O 1377/
778 DATA ISYM( 568)/O 0/,ISYM( 569)/O 46525/,ISYM( 570)/O 46125/
779 DATA ISYM( 571)/O 24/,ISYM( 572)/O140300/,ISYM( 573)/O 0/
780 DATA ISYM( 574)/O 1377/,ISYM( 575)/O 0/,ISYM( 576)/O 46525/
781 DATA ISYM( 577)/O 46123/,ISYM( 578)/O 24/,ISYM( 579)/O140700/
782 DATA ISYM( 580)/O 0/,ISYM( 581)/O 1377/,ISYM( 582)/O 1727/
783 DATA ISYM( 583)/O 42111/,ISYM( 584)/O 53125/,ISYM( 585)/O 24/
784 DATA ISYM( 586)/O100300/,ISYM( 587)/O 0/,ISYM( 588)/O 1377/
785 DATA ISYM( 589)/O 2045/,ISYM( 590)/O 42111/,ISYM( 591)/O 53123/
786 DATA ISYM( 592)/O 24/,ISYM( 593)/O100700/,ISYM( 594)/O 0/
787 DATA ISYM( 595)/O 1377/,ISYM( 596)/O 0/,ISYM( 597)/O 40504/
788 DATA ISYM( 598)/O 42000/,ISYM( 599)/O 25/,ISYM( 600)/O150000/
789 DATA ISYM( 601)/O 0/,ISYM( 602)/O 1377/,ISYM( 603)/O 1525/
790 DATA ISYM( 604)/O 40504/,ISYM( 605)/O 42111/,ISYM( 606)/O 25/
791 DATA ISYM( 607)/O150001/,ISYM( 608)/O 0/,ISYM( 609)/O 1377/
792 DATA ISYM( 610)/O 1353/,ISYM( 611)/O 40504/,ISYM( 612)/O 42101/
793 DATA ISYM( 613)/O 25/,ISYM( 614)/O150002/,ISYM( 615)/O 0/
794 DATA ISYM( 616)/O 1377/,ISYM( 617)/O 1410/,ISYM( 618)/O 40504/
795 DATA ISYM( 619)/O 42121/,ISYM( 620)/O 25/,ISYM( 621)/O 50000/
796 DATA ISYM( 622)/O 0/,ISYM( 623)/O 1377/,ISYM( 624)/O 2004/
797 DATA ISYM( 625)/O 51525/,ISYM( 626)/O 41111/,ISYM( 627)/O 25/
798 DATA ISYM( 628)/O110001/,ISYM( 629)/O 0/,ISYM( 630)/O 1377/
799 DATA ISYM( 631)/O 1606/,ISYM( 632)/O 51525/,ISYM( 633)/O 41101/
800 DATA ISYM( 634)/O 25/,ISYM( 635)/O110002/,ISYM( 636)/O 0/
801 DATA ISYM( 637)/O 1377/,ISYM( 638)/O 2103/,ISYM( 639)/O 51525/
802 DATA ISYM( 640)/O 41121/,ISYM( 641)/O 25/,ISYM( 642)/O 50400/
803 DATA ISYM( 643)/O 0/,ISYM( 644)/O 1377/,ISYM( 645)/O 1230/
804 DATA ISYM( 646)/O 51525/,ISYM( 647)/O 41000/,ISYM( 648)/O 25/
805 DATA ISYM( 649)/O110000/,ISYM( 650)/O 0/,ISYM( 651)/O 1377/
806 DATA ISYM( 652)/O 0/,ISYM( 653)/O 40516/,ISYM( 654)/O 42000/
807 DATA ISYM( 655)/O 26/,ISYM( 656)/O140000/,ISYM( 657)/O 0/
808 DATA ISYM( 658)/O 1377/,ISYM( 659)/O 1362/,ISYM( 660)/O 40516/
809 DATA ISYM( 661)/O 42111/,ISYM( 662)/O 26/,ISYM( 663)/O140000/
810 DATA ISYM( 664)/O 0/,ISYM( 665)/O 1377/,ISYM( 666)/O 0/
811 DATA ISYM( 667)/O 47522/,ISYM( 668)/O 44400/,ISYM( 669)/O 26/
812 DATA ISYM( 670)/O 0/,ISYM( 671)/O 0/,ISYM( 672)/O 777/
813 DATA ISYM( 673)/O 1272/,ISYM( 674)/O 47522/,ISYM( 675)/O 26/
814 DATA ISYM( 676)/O100000/,ISYM( 677)/O 0/,ISYM( 678)/O 1377/
815 DATA ISYM( 679)/O 1534/,ISYM( 680)/O 42517/,ISYM( 681)/O 51000/
816 DATA ISYM( 682)/O 27/,ISYM( 683)/O130400/,ISYM( 684)/O 0/
817 DATA ISYM( 685)/O 1377/,ISYM( 686)/O 1500/,ISYM( 687)/O 42517/
818 DATA ISYM( 688)/O 51111/,ISYM( 689)/O 27/,ISYM( 690)/O130400/
819 DATA ISYM( 691)/O 0/,ISYM( 692)/O 1377/,ISYM( 693)/O 1570/
820 DATA ISYM( 694)/O 41515/,ISYM( 695)/O 50000/,ISYM( 696)/O 30/
821 DATA ISYM( 697)/O130000/,ISYM( 698)/O 0/,ISYM( 699)/O 1377/
822 DATA ISYM( 700)/O 1335/,ISYM( 701)/O 41515/,ISYM( 702)/O 50101/
823 DATA ISYM( 703)/O 30/,ISYM( 704)/O130001/,ISYM( 705)/O 0/
824 DATA ISYM( 706)/O 1377/,ISYM( 707)/O 0/,ISYM( 708)/O 41515/
825 DATA ISYM( 709)/O 50111/,ISYM( 710)/O 30/,ISYM( 711)/O 6000/
826 DATA ISYM( 712)/O 0/,ISYM( 713)/O 1377/,ISYM( 714)/O 0/
827 DATA ISYM( 715)/O 42530/,ISYM( 716)/O 43400/,ISYM( 717)/O 31/
828 DATA ISYM( 718)/O140500/,ISYM( 719)/O 0/,ISYM( 720)/O 1377/
829 DATA ISYM( 721)/O 0/,ISYM( 722)/O 41510/,ISYM( 723)/O 45400/
830 DATA ISYM( 724)/O 32/,ISYM( 725)/O 40600/,ISYM( 726)/O 0/
831 DATA ISYM( 727)/O 1377/,ISYM( 728)/O 1775/,ISYM( 729)/O 41515/
832 DATA ISYM( 730)/O 50115/,ISYM( 731)/O 33/,ISYM( 732)/O130410/
833 DATA ISYM( 733)/O 0/,ISYM( 734)/O 1377/,ISYM( 735)/O 1543/
834 DATA ISYM( 736)/O 40504/,ISYM( 737)/O 42130/,ISYM( 738)/O 34/
835 DATA ISYM( 739)/O150400/,ISYM( 740)/O 0/,ISYM( 741)/O 1377/
836 DATA ISYM( 742)/O 0/,ISYM( 743)/O 51525/,ISYM( 744)/O 41130/
837 DATA ISYM( 745)/O 34/,ISYM( 746)/O110400/,ISYM( 747)/O 0/
838 DATA ISYM( 748)/O 1377/,ISYM( 749)/O 0/,ISYM( 750)/O 40502/
839 DATA ISYM( 751)/O 41504/,ISYM( 752)/O 35/,ISYM( 753)/O140400/
840 DATA ISYM( 754)/O 0/,ISYM( 755)/O 1377/,ISYM( 756)/O 1444/
841 DATA ISYM( 757)/O 51502/,ISYM( 758)/O 41504/,ISYM( 759)/O 35/
842 DATA ISYM( 760)/O100400/,ISYM( 761)/O 0/,ISYM( 762)/O 1777/
843 DATA ISYM( 763)/O 0/,ISYM( 764)/O 46517/,ISYM( 765)/O 53105/
844 DATA ISYM( 766)/O 50000/,ISYM( 767)/O 36/,ISYM( 768)/O 400/
845 DATA ISYM( 769)/O 0/,ISYM( 770)/O 1377/,ISYM( 771)/O 1453/
846 DATA ISYM( 772)/O 42102/,ISYM( 773)/O 51101/,ISYM( 774)/O 40/
847 DATA ISYM( 775)/O 50710/,ISYM( 776)/O 0/,ISYM( 777)/O 1377/
848 DATA ISYM( 778)/O 0/,ISYM( 779)/O 42102/,ISYM( 780)/O 52000/
849 DATA ISYM( 781)/O 40/,ISYM( 782)/O 50310/,ISYM( 783)/O 0/
850 DATA ISYM( 784)/O 1377/,ISYM( 785)/O 1552/,ISYM( 786)/O 42102/
851 DATA ISYM( 787)/O 44111/,ISYM( 788)/O 40/,ISYM( 789)/O 51310/
852 DATA ISYM( 790)/O 0/,ISYM( 791)/O 1377/,ISYM( 792)/O 2215/
853 DATA ISYM( 793)/O 42102/,ISYM( 794)/O 46123/,ISYM( 795)/O 40/
854 DATA ISYM( 796)/O 51710/,ISYM( 797)/O 0/,ISYM( 798)/O 1377/
855 DATA ISYM( 799)/O 0/,ISYM( 800)/O 42102/,ISYM( 801)/O 41503/
856 DATA ISYM( 802)/O 40/,ISYM( 803)/O 52310/,ISYM( 804)/O 0/
857 DATA ISYM( 805)/O 1377/,ISYM( 806)/O 1462/,ISYM( 807)/O 42102/
858 DATA ISYM( 808)/O 41523/,ISYM( 809)/O 40/,ISYM( 810)/O 52710/
859 DATA ISYM( 811)/O 0/,ISYM( 812)/O 1377/,ISYM( 813)/O 0/
860 DATA ISYM( 814)/O 42102/,ISYM( 815)/O 47105/,ISYM( 816)/O 40/
861 DATA ISYM( 817)/O 53310/,ISYM( 818)/O 0/,ISYM( 819)/O 1377/
862 DATA ISYM( 820)/O 1516/,ISYM( 821)/O 42102/,ISYM( 822)/O 42521/
863 DATA ISYM( 823)/O 40/,ISYM( 824)/O 53710/,ISYM( 825)/O 0/
864 DATA ISYM( 826)/O 1377/,ISYM( 827)/O 0/,ISYM( 828)/O 42102/
865 DATA ISYM( 829)/O 53103/,ISYM( 830)/O 40/,ISYM( 831)/O 54310/
866 DATA ISYM( 832)/O 0/,ISYM( 833)/O 1377/,ISYM( 834)/O 0/
867 DATA ISYM( 835)/O 42102/,ISYM( 836)/O 53123/,ISYM( 837)/O 40/
868 DATA ISYM( 838)/O 54710/,ISYM( 839)/O 0/,ISYM( 840)/O 1377/
869 DATA ISYM( 841)/O 0/,ISYM( 842)/O 42102/,ISYM( 843)/O 50114/
870 DATA ISYM( 844)/O 40/,ISYM( 845)/O 55310/,ISYM( 846)/O 0/
871 DATA ISYM( 847)/O 1377/,ISYM( 848)/O 0/,ISYM( 849)/O 42102/
872 DATA ISYM( 850)/O 46511/,ISYM( 851)/O 40/,ISYM( 852)/O 55710/
873 DATA ISYM( 853)/O 0/,ISYM( 854)/O 1377/,ISYM( 855)/O 1561/
874 DATA ISYM( 856)/O 42102/,ISYM( 857)/O 43505/,ISYM( 858)/O 40/
875 DATA ISYM( 859)/O 56310/,ISYM( 860)/O 0/,ISYM( 861)/O 1377/
876 DATA ISYM( 862)/O 1577/,ISYM( 863)/O 42102/,ISYM( 864)/O 46124/
877 DATA ISYM( 865)/O 40/,ISYM( 866)/O 56710/,ISYM( 867)/O 0/
878 DATA ISYM( 868)/O 1377/,ISYM( 869)/O 0/,ISYM( 870)/O 42102/
879 DATA ISYM( 871)/O 43524/,ISYM( 872)/O 40/,ISYM( 873)/O 57310/
880 DATA ISYM( 874)/O 0/,ISYM( 875)/O 1377/,ISYM( 876)/O 0/
881 DATA ISYM( 877)/O 42102/,ISYM( 878)/O 46105/,ISYM( 879)/O 40/
882 DATA ISYM( 880)/O 57710/,ISYM( 881)/O 0/,ISYM( 882)/O 1377/
883 DATA ISYM( 883)/O 0/,ISYM( 884)/O 46105/,ISYM( 885)/O 40400/
884 DATA ISYM( 886)/O 42/,ISYM( 887)/O 40700/,ISYM( 888)/O 0/
885 DATA ISYM( 889)/O 1377/,ISYM( 890)/O 0/,ISYM( 891)/O 40523/
886 DATA ISYM( 892)/O 46000/,ISYM( 893)/O 43/,ISYM( 894)/O160400/
887 DATA ISYM( 895)/O 0/,ISYM( 896)/O 1377/,ISYM( 897)/O 0/
888 DATA ISYM( 898)/O 40523/,ISYM( 899)/O 51000/,ISYM( 900)/O 43/
889 DATA ISYM( 901)/O160000/,ISYM( 902)/O 0/,ISYM( 903)/O 1377/
890 DATA ISYM( 904)/O 1660/,ISYM( 905)/O 46123/,ISYM( 906)/O 46000/
891 DATA ISYM( 907)/O 43/,ISYM( 908)/O160410/,ISYM( 909)/O 0/
892 DATA ISYM( 910)/O 1377/,ISYM( 911)/O 2111/,ISYM( 912)/O 46123/
893 DATA ISYM( 913)/O 51000/,ISYM( 914)/O 43/,ISYM( 915)/O160010/
894 DATA ISYM( 916)/O 0/,ISYM( 917)/O 1377/,ISYM( 918)/O 1710/
895 DATA ISYM( 919)/O 41103/,ISYM( 920)/O 44107/,ISYM( 921)/O 44/
896 DATA ISYM( 922)/O 500/,ISYM( 923)/O 0/,ISYM( 924)/O 1377/
897 DATA ISYM( 925)/O 2171/,ISYM( 926)/O 41103/,ISYM( 927)/O 46122/
898 DATA ISYM( 928)/O 44/,ISYM( 929)/O 600/,ISYM( 930)/O 0/
899 DATA ISYM( 931)/O 1377/,ISYM( 932)/O 0/,ISYM( 933)/O 41123/
900 DATA ISYM( 934)/O 42524/,ISYM( 935)/O 44/,ISYM( 936)/O 700/
901 DATA ISYM( 937)/O 0/,ISYM( 938)/O 1377/,ISYM( 939)/O 0/
902 DATA ISYM( 940)/O 41124/,ISYM( 941)/O 51524/,ISYM( 942)/O 44/
903 DATA ISYM( 943)/O 400/,ISYM( 944)/O 0/,ISYM( 945)/O 1777/
904 DATA ISYM( 946)/O 0/,ISYM( 947)/O 41103/,ISYM( 948)/O 44107/
905 DATA ISYM( 949)/O 53400/,ISYM( 950)/O 47/,ISYM( 951)/O 500/
906 DATA ISYM( 952)/O 0/,ISYM( 953)/O 1777/,ISYM( 954)/O 2075/
907 DATA ISYM( 955)/O 41103/,ISYM( 956)/O 46122/,ISYM( 957)/O 53400/
908 DATA ISYM( 958)/O 47/,ISYM( 959)/O 600/,ISYM( 960)/O 0/
909 DATA ISYM( 961)/O 1777/,ISYM( 962)/O 2013/,ISYM( 963)/O 41123/
910 DATA ISYM( 964)/O 42524/,ISYM( 965)/O 53400/,ISYM( 966)/O 47/
911 DATA ISYM( 967)/O 700/,ISYM( 968)/O 0/,ISYM( 969)/O 1777/
912 DATA ISYM( 970)/O 0/,ISYM( 971)/O 41124/,ISYM( 972)/O 51524/
913 DATA ISYM( 973)/O 53400/,ISYM( 974)/O 47/,ISYM( 975)/O 400/
914 DATA ISYM( 976)/O 0/,ISYM( 977)/O 1377/,ISYM( 978)/O 2053/
915 DATA ISYM( 979)/O 46517/,ISYM( 980)/O 53105/,ISYM( 981)/O 45/
916 DATA ISYM( 982)/O 0/,ISYM( 983)/O 0/,ISYM( 984)/O 1777/
917 DATA ISYM( 985)/O 2061/,ISYM( 986)/O 46517/,ISYM( 987)/O 53105/
918 DATA ISYM( 988)/O 40400/,ISYM( 989)/O 45/,ISYM( 990)/O 0/
919 DATA ISYM( 991)/O 0/,ISYM( 992)/O 1777/,ISYM( 993)/O 0/
920 DATA ISYM( 994)/O 46517/,ISYM( 995)/O 53105/,ISYM( 996)/O 50400/
921 DATA ISYM( 997)/O 45/,ISYM( 998)/O 70000/,ISYM( 999)/O 0/
922 DATA ISYM(1000)/O 1377/,ISYM(1001)/O 0/,ISYM(1002)/O 46104/
923 DATA ISYM(1003)/O 46400/,ISYM(1004)/O 46/,ISYM(1005)/O 46000/
924 DATA ISYM(1006)/O 0/,ISYM(1007)/O 1377/,ISYM(1008)/O 2031/
925 DATA ISYM(1009)/O 51524/,ISYM(1010)/O 46400/,ISYM(1011)/O 46/
926 DATA ISYM(1012)/O 44200/,ISYM(1013)/O 0/,ISYM(1014)/O 1777/
927 DATA ISYM(1015)/O 0/,ISYM(1016)/O 46517/,ISYM(1017)/O 53105/
928 DATA ISYM(1018)/O 46400/,ISYM(1019)/O 46/,ISYM(1020)/O 44200/
929 DATA ISYM(1021)/O 0/,ISYM(1022)/O 1377/,ISYM(1023)/O 0/
930 DATA ISYM(1024)/O 51117/,ISYM(1025)/O 46000/,ISYM(1026)/O 43/
931 DATA ISYM(1027)/O160430/,ISYM(1028)/O 0/,ISYM(1029)/O 1377/
932 DATA ISYM(1030)/O 2125/,ISYM(1031)/O 51117/,ISYM(1032)/O 51000/
933 DATA ISYM(1033)/O 43/,ISYM(1034)/O160030/,ISYM(1035)/O 0/
934 DATA ISYM(1036)/O 1377/,ISYM(1037)/O 0/,ISYM(1038)/O 51117/
935 DATA ISYM(1039)/O 54114/,ISYM(1040)/O 43/,ISYM(1041)/O160420/
936 DATA ISYM(1042)/O 0/,ISYM(1043)/O 1377/,ISYM(1044)/O 0/
937 DATA ISYM(1045)/O 51117/,ISYM(1046)/O 54122/,ISYM(1047)/O 43/
938 DATA ISYM(1048)/O160020/,ISYM(1049)/O 0/,ISYM(1050)/O 401/
939 DATA ISYM(1051)/O 2133/,ISYM(1052)/O 42060/,ISYM(1053)/O 2/
940 DATA ISYM(1054)/O 0/,ISYM(1055)/O 0/,ISYM(1056)/O 401/
941 DATA ISYM(1057)/O 2141/,ISYM(1058)/O 42061/,ISYM(1059)/O 2/
942 DATA ISYM(1060)/O 1/,ISYM(1061)/O 0/,ISYM(1062)/O 401/
943 DATA ISYM(1063)/O 2147/,ISYM(1064)/O 42062/,ISYM(1065)/O 2/
944 DATA ISYM(1066)/O 2/,ISYM(1067)/O 0/,ISYM(1068)/O 401/
945 DATA ISYM(1069)/O 2155/,ISYM(1070)/O 42063/,ISYM(1071)/O 2/
946 DATA ISYM(1072)/O 3/,ISYM(1073)/O 0/,ISYM(1074)/O 401/
947 DATA ISYM(1075)/O 2163/,ISYM(1076)/O 42064/,ISYM(1077)/O 2/
948 DATA ISYM(1078)/O 4/,ISYM(1079)/O 0/,ISYM(1080)/O 401/
949 DATA ISYM(1081)/O 0/,ISYM(1082)/O 42065/,ISYM(1083)/O 2/
950 DATA ISYM(1084)/O 5/,ISYM(1085)/O 0/,ISYM(1086)/O 401/
951 DATA ISYM(1087)/O 0/,ISYM(1088)/O 42066/,ISYM(1089)/O 2/
952 DATA ISYM(1090)/O 6/,ISYM(1091)/O 0/,ISYM(1092)/O 401/
953 DATA ISYM(1093)/O 0/,ISYM(1094)/O 42067/,ISYM(1095)/O 2/
954 DATA ISYM(1096)/O 7/,ISYM(1097)/O 0/,ISYM(1098)/O 401/
955 DATA ISYM(1099)/O 0/,ISYM(1100)/O 40460/,ISYM(1101)/O 2/
956 DATA ISYM(1102)/O 10/,ISYM(1103)/O 0/,ISYM(1104)/O 401/
957 DATA ISYM(1105)/O 0/,ISYM(1106)/O 40461/,ISYM(1107)/O 2/
958 DATA ISYM(1108)/O 11/,ISYM(1109)/O 0/,ISYM(1110)/O 401/
959 DATA ISYM(1111)/O 0/,ISYM(1112)/O 40462/,ISYM(1113)/O 2/
960 DATA ISYM(1114)/O 12/,ISYM(1115)/O 0/,ISYM(1116)/O 401/
961 DATA ISYM(1117)/O 0/,ISYM(1118)/O 40463/,ISYM(1119)/O 2/
962 DATA ISYM(1120)/O 13/,ISYM(1121)/O 0/,ISYM(1122)/O 401/
963 DATA ISYM(1123)/O 0/,ISYM(1124)/O 40464/,ISYM(1125)/O 2/
964 DATA ISYM(1126)/O 14/,ISYM(1127)/O 0/,ISYM(1128)/O 401/
965 DATA ISYM(1129)/O 0/,ISYM(1130)/O 40465/,ISYM(1131)/O 2/
966 DATA ISYM(1132)/O 15/,ISYM(1133)/O 0/,ISYM(1134)/O 401/
967 DATA ISYM(1135)/O 0/,ISYM(1136)/O 40466/,ISYM(1137)/O 2/
968 DATA ISYM(1138)/O 16/,ISYM(1139)/O 0/,ISYM(1140)/O 401/
969 DATA ISYM(1141)/O 2177/,ISYM(1142)/O 40467/,ISYM(1143)/O 2/
970 DATA ISYM(1144)/O 17/,ISYM(1145)/O 0/,ISYM(1146)/O 401/
971 DATA ISYM(1147)/O 0/,ISYM(1148)/O 51520/,ISYM(1149)/O 2/
972 DATA ISYM(1150)/O 17/,ISYM(1151)/O 0/,ISYM(1152)/O 1001/
973 DATA ISYM(1153)/O 0/,ISYM(1154)/O 52523/,ISYM(1155)/O 50000/
974 DATA ISYM(1156)/O 2/,ISYM(1157)/O 20/,ISYM(1158)/O 0/
975 DATA ISYM(1159)/O 1001/,ISYM(1160)/O 0/,ISYM(1161)/O 41503/
976 DATA ISYM(1162)/O 51000/,ISYM(1163)/O 2/,ISYM(1164)/O 74/
977 DATA ISYM(1165)/O 0/,ISYM(1166)/O 401/,ISYM(1167)/O 0/
978 DATA ISYM(1168)/O 51522/,ISYM(1169)/O 2/,ISYM(1170)/O 174/
979 DATA ISYM(1171)/O 0/,ISYM(1172)/O 0/,ISYM(1173)/O 0/
980 DATA NET1( 1)/ 29/,NET2( 1)/ 0/,NET3( 1)/ 2/,
981 & NET4( 1)/ 2/,NET5( 1)/ 1/
982 DATA NET1( 2)/ 30/,NET2( 2)/ 0/,NET3( 2)/ 0/,
983 & NET4( 2)/ 3/,NET5( 2)/ 2/
984 DATA NET1( 3)/ 46/,NET2( 3)/ 0/,NET3( 3)/ 5/,
985 & NET4( 3)/ 4/,NET5( 3)/ 0/
986 DATA NET1( 4)/ 24/,NET2( 4)/ 0/,NET3( 4)/ 0/,
987 & NET4( 4)/ 5/,NET5( 4)/ 3/
988 DATA NET1( 5)/ 0/,NET2( 5)/ 8/,NET3( 5)/ 0/,
989 & NET4( 5)/ 6/,NET5( 5)/ 0/
990 DATA NET1( 6)/ 44/,NET2( 6)/ 0/,NET3( 6)/ -1/,
991 & NET4( 6)/ 5/,NET5( 6)/ 4/
992 DATA NET1( 7)/ 0/,NET2( 7)/ 0/,NET3( 7)/ 0/,
993 & NET4( 7)/ 0/,NET5( 7)/ 0/
994 DATA NET1( 8)/ 28/,NET2( 8)/ 0/,NET3( 8)/ 12/,
995 & NET4( 8)/ 9/,NET5( 8)/ 5/
996 DATA NET1( 9)/ 45/,NET2( 9)/ 0/,NET3( 9)/ 11/,
997 & NET4( 9)/ 10/,NET5( 9)/ 0/
998 DATA NET1(10)/ 28/,NET2(10)/ 0/,NET3(10)/ 0/,
999 & NET4(10)/ 11/,NET5(10)/ 15/
1000 DATA NET1(11)/ 47/,NET2(11)/ 0/,NET3(11)/ -1/,
1001 & NET4(11)/ 8/,NET5(11)/ 0/
1002 DATA NET1(12)/ 40/,NET2(12)/ 0/,NET3(12)/ 16/,
1003 & NET4(12)/ 13/,NET5(12)/ 34/
1004 DATA NET1(13)/ 28/,NET2(13)/ 0/,NET3(13)/ 24/,
1005 & NET4(13)/ 14/,NET5(13)/ 6/
1006 DATA NET1(14)/ 41/,NET2(14)/ 0/,NET3(14)/ 0/,
1007 & NET4(14)/ 15/,NET5(14)/ 0/
1008 DATA NET1(15)/ 43/,NET2(15)/ 0/,NET3(15)/ -1/,
1009 & NET4(15)/ -1/,NET5(15)/ 7/
1010 DATA NET1(16)/ 45/,NET2(16)/ 0/,NET3(16)/ 20/,
1011 & NET4(16)/ 17/,NET5(16)/ 24/
1012 DATA NET1(17)/ 40/,NET2(17)/ 0/,NET3(17)/ 23/,
1013 & NET4(17)/ 18/,NET5(17)/ 34/
1014 DATA NET1(18)/ 28/,NET2(18)/ 0/,NET3(18)/ 24/,
1015 & NET4(18)/ 19/,NET5(18)/ 8/
1016 DATA NET1(19)/ 41/,NET2(19)/ 0/,NET3(19)/ 0/,
1017 & NET4(19)/ -1/,NET5(19)/ 0/
1018 DATA NET1(20)/ 35/,NET2(20)/ 0/,NET3(20)/ 22/,
1019 & NET4(20)/ 21/,NET5(20)/ 0/
1020 DATA NET1(21)/ 0/,NET2(21)/ 36/,NET3(21)/ 0/,
1021 & NET4(21)/ -1/,NET5(21)/ 10/
1022 DATA NET1(22)/ 27/,NET2(22)/ 0/,NET3(22)/ 25/,
1023 & NET4(22)/ -1/,NET5(22)/ 16/
1024 DATA NET1(23)/ 0/,NET2(23)/ 40/,NET3(23)/ 0/,
1025 & NET4(23)/ 26/,NET5(23)/ 11/
1026 DATA NET1(24)/ 0/,NET2(24)/ 38/,NET3(24)/ 0/,
1027 & NET4(24)/ 26/,NET5(24)/ 11/
1028 DATA NET1(25)/ 0/,NET2(25)/ 36/,NET3(25)/ 0/,
1029 & NET4(25)/ 26/,NET5(25)/ 11/
1030 DATA NET1(26)/ 40/,NET2(26)/ 0/,NET3(26)/ -1/,
1031 & NET4(26)/ 27/,NET5(26)/ 0/
1032 DATA NET1(27)/ 28/,NET2(27)/ 0/,NET3(27)/ 0/,
1033 & NET4(27)/ 28/,NET5(27)/ 12/
1034 DATA NET1(28)/ 46/,NET2(28)/ 0/,NET3(28)/ 31/,
1035 & NET4(28)/ 29/,NET5(28)/ 0/
1036 DATA NET1(29)/ 24/,NET2(29)/ 0/,NET3(29)/ 0/,
1037 & NET4(29)/ 30/,NET5(29)/ 13/
1038 DATA NET1(30)/ 41/,NET2(30)/ 0/,NET3(30)/ 0/,
1039 & NET4(30)/ -1/,NET5(30)/ 0/
1040 DATA NET1(31)/ 44/,NET2(31)/ 0/,NET3(31)/ 35/,
1041 & NET4(31)/ 32/,NET5(31)/ 0/
1042 DATA NET1(32)/ 28/,NET2(32)/ 0/,NET3(32)/ 0/,
1043 & NET4(32)/ 33/,NET5(32)/ 14/
1044 DATA NET1(33)/ 46/,NET2(33)/ 0/,NET3(33)/ 35/,
1045 & NET4(33)/ 34/,NET5(33)/ 0/
1046 DATA NET1(34)/ 24/,NET2(34)/ 0/,NET3(34)/ 0/,
1047 & NET4(34)/ 35/,NET5(34)/ 13/
1048 DATA NET1(35)/ 41/,NET2(35)/ 0/,NET3(35)/ 0/,
1049 & NET4(35)/ -1/,NET5(35)/ 0/
1050 DATA NET1(36)/ 45/,NET2(36)/ 0/,NET3(36)/ 37/,
1051 & NET4(36)/ 37/,NET5(36)/ 24/
1052 DATA NET1(37)/ 40/,NET2(37)/ 0/,NET3(37)/ 40/,
1053 & NET4(37)/ 38/,NET5(37)/ 34/
1054 DATA NET1(38)/ 0/,NET2(38)/ 36/,NET3(38)/ 0/,
1055 & NET4(38)/ 39/,NET5(38)/ 0/
1056 DATA NET1(39)/ 41/,NET2(39)/ 0/,NET3(39)/ 0/,
1057 & NET4(39)/ 43/,NET5(39)/ 35/
1058 DATA NET1(40)/ 24/,NET2(40)/ 0/,NET3(40)/ 41/,
1059 & NET4(40)/ 43/,NET5(40)/ 17/
1060 DATA NET1(41)/ 25/,NET2(41)/ 0/,NET3(41)/ 42/,
1061 & NET4(41)/ 43/,NET5(41)/ 17/
1062 DATA NET1(42)/ 42/,NET2(42)/ 0/,NET3(42)/ 0/,
1063 & NET4(42)/ 43/,NET5(42)/ 17/
1064 DATA NET1(43)/ 62/,NET2(43)/ 0/,NET3(43)/ 45/,
1065 & NET4(43)/ 44/,NET5(43)/ 25/
1066 DATA NET1(44)/ 62/,NET2(44)/ 0/,NET3(44)/ 0/,
1067 & NET4(44)/ 37/,NET5(44)/ 0/
1068 DATA NET1(45)/ 60/,NET2(45)/ 0/,NET3(45)/ 47/,
1069 & NET4(45)/ 46/,NET5(45)/ 26/
1070 DATA NET1(46)/ 60/,NET2(46)/ 0/,NET3(46)/ 0/,
1071 & NET4(46)/ 37/,NET5(46)/ 0/
1072 DATA NET1(47)/ 38/,NET2(47)/ 0/,NET3(47)/ 48/,
1073 & NET4(47)/ 36/,NET5(47)/ 27/
1074 DATA NET1(48)/ 33/,NET2(48)/ 0/,NET3(48)/ 50/,
1075 & NET4(48)/ 36/,NET5(48)/ 28/
1076 DATA NET1(49)/ 37/,NET2(49)/ 0/,NET3(49)/ 50/,
1077 & NET4(49)/ 36/,NET5(49)/ 29/
1078 DATA NET1(50)/ 42/,NET2(50)/ 0/,NET3(50)/ 51/,
1079 & NET4(50)/ 36/,NET5(50)/ 30/
1080 DATA NET1(51)/ 47/,NET2(51)/ 0/,NET3(51)/ 52/,
1081 & NET4(51)/ 36/,NET5(51)/ 31/
1082 DATA NET1(52)/ 43/,NET2(52)/ 0/,NET3(52)/ 53/,
1083 & NET4(52)/ 36/,NET5(52)/ 32/
1084 DATA NET1(53)/ 45/,NET2(53)/ 0/,NET3(53)/ -1/,
1085 & NET4(53)/ 36/,NET5(53)/ 33/
1086 DATA KASH( 1)/ 0/,KASH( 2)/ 573/,KASH( 3)/ 740/,KASH( 4)/ 139/
1087 DATA KASH( 5)/1013/,KASH( 6)/ 960/,KASH( 7)/ 559/,KASH( 8)/ 16/
1088 DATA KASH( 9)/ 328/,KASH(10)/ 594/,KASH(11)/ 608/,KASH(12)/1042/
1089 DATA KASH(13)/ 797/,KASH(14)/ 147/,KASH(15)/ 384/,KASH(16)/ 0/
1090 DATA KASH(17)/ 0/,KASH(18)/ 0/,KASH(19)/ 601/,KASH(20)/ 314/
1091 DATA KASH(21)/ 916/,KASH(22)/ 300/,KASH(23)/ 279/,KASH(24)/ 24/
1092 DATA KASH(25)/ 335/,KASH(26)/ 52/,KASH(27)/ 31/,KASH(28)/ 356/
1093 DATA KASH(29)/ 202/,KASH(30)/ 38/,KASH(31)/ 110/,KASH(32)/ 503/
1094 DATA KASH(33)/ 691/,KASH(34)/ 251/,KASH(35)/ 391/,KASH(36)/ 923/
1095 DATA KASH(37)/ 9/,KASH(38)/ 531/,KASH(39)/ 209/,KASH(40)/ 293/
1096 DATA KASH(41)/ 168/,KASH(42)/ 60/,KASH(43)/ 643/,KASH(44)/ 118/
1097 DATA KASH(45)/ 90/,KASH(46)/ 155/,KASH(47)/ 216/,KASH(48)/ 286/
1098 DATA KASH(49)/ 0/,KASH(50)/ 265/,KASH(51)/ 1/,KASH(52)/ 510/
1099 DATA KASH(53)/ 67/,KASH(54)/1055/,KASH(55)/ 587/,KASH(56)/ 237/
1100 DATA KASH(57)/ 82/,KASH(58)/ 132/,KASH(59)/ 74/,KASH(60)/ 230/
1101 DATA KASH(61)/ 45/,KASH(62)/ 937/,KASH(63)/ 0/,KASH(64)/ 0/
1102 END
1103 SUBROUTINE ERR(JERNO)
1104 CC NAM: ERR VER: 1.0 DAT: 12/08/78 CMP: ALL
1105 CC
1106 CC SYS: MACS
1107 CC
1108 CC ENT: JERNO > 0 - ERROR NUMBER
1109 CC = 0 - OUTPUT TOTAL # OF ERRORS FOR CURRENT INSTRUCTION
1110 CC = -1 - OUTPUT TOTAL # OF ERRORS FOR PROGRAM
1111 CC
1112 CC RTN: JERNO - N/C
1113 CC
1114 CC FNC: THIS ROUTINE TABLES ERROR #'S FOR EACH SOURCE STATEMENT
1115 CC AND AT THE END OF SCAN OUTPUTS ALL ERRORS FOR IT.
1116 CC IT OUTPUTS TOTAL # ERRORS FOR THE PROGRAM AT THE END.
1117 CC
1118 CC REV: N/A
1119 CC
1120 CCALLS PAGE
1121 C
1122 C*
1123 IMPLICIT INTEGER (A-Z)
1124 COMMON /A/ ISYM(3000),KARD1(96),ITOKEN(70),TKNSIZ,TKNTYP,
1125 & TKNVAL,TKNVA2,JSUC,JPTR,LPTR,NXSYM,KOLUMN,KD1BCT,KD1LNO,JERR,
1126 & MNUM,IPASS,IPC2,IPC,IOPC,INS(5),INSL,ISIZ,IADM(7,2),LUOT
1127 COMMON /A/ KASH(64),KPAC(15),KPWCT,LENSYM,KCLAS(64)
1128 COMMON /A/ NET1(64),NET2(64),NET3(64),NET4(64),NET5(64)
1129 COMMON /A/ NBPW,KSYS,IEOT,LSP,JBUF(83),KARD2(80,3),IHB480,IHEX9K
1130 COMMON /A/ IA1SHF,KCFF,LUSI,LUDI,LUOO,LLEN,IPLEN
1131 COMMON /A/ LIST,ICOL,NEST,LUCI,LULT
1132 C
1133 DIMENSION NERR(2,10)
1134 DATA KD1LN2/0/
1135 DATA ITOTER/0/,LASK/42/
1136 C*** TABLE THE ERROR FOR THIS SOURCE LINE?
1137 IF(JERNO.LE.0) GO TO 100
1138 IF(JERR.EQ.10) RETURN
1139 JERR=JERR+1
1140 NERR(1,JERR)=JERNO
1141 NERR(2,JERR)=KOLUMN
1142 RETURN
1143 C*** PRINT THE ERRORS IF ANY, 0=NONE, LESS THAN 0= PRINT TOTAL
1144 100 IF(JERNO.LT.0) GO TO 300
1145 IF(JERR.EQ.0) RETURN
1146 C*** PRINT EACH ERROR FOR THIS SOURCE LINE.
1147 DO 200 K=1,JERR
1148 KK=NERR(2,K)
1149 DO 130 J=1,41
1150 130 JBUF(J)=LSP
1151 C*** NAX # CHARS TO PRINT.
1152 IF(KK.GT.41) KK=41
1153 IF(KK.GT.0) JBUF(KK)=LASK
1154 C
1155 C*** IF "NOLIST" PRINT THE SOURCE LINE HERE
1156 C*** KD1LN2= LAST LINE # ENCOUNTERED WITH AN ERROR.
1157 JBUF(51)=KD1LN2
1158 IF(LIST.EQ.1) GO TO 140
1159 IF(KARD1(1).EQ.0) GO TO 140
1160 IF(KD1BCT.GT.41) KD1BCT=41
1161 WRITE(LUOT,9900) KD1LNO,(KARD1(J),J=1,KD1BCT)
1162 CALL PAGE(1)
1163 9900 FORMAT(I4,21X,80A1)
1164 KARD1(1)=0
1165 140 CONTINUE
1166 WRITE(LUOT,9980) NERR(1,K),KD1LN2,(JBUF(J),J=1,KK)
1167 9980 FORMAT('****** ERROR ',I4,'--',I4,41A1)
1168 CALL PAGE(1)
1169 200 CONTINUE
1170 C*** KEEP LINE # OF THIS ERROR.
1171 KD1LN2=KD1LNO
1172 ITOTER=ITOTER+JERR
1173 JERR=0
1174 RETURN
1175 C*** FINAL ERROR COUNT PRINT
1176 300 WRITE(LUOT,9970) ITOTER,KD1LN2
1177 9970 FORMAT(/' ****** TOTAL ERRORS ',I3,'--',I4)
1178 CALL PAGE(2)
1179 C*** IF SOURCE GOES TO FILE, PRINT TOTAL ERRORS AT CONSOLE
1180 IF(LUOT.NE.LULT) WRITE(LULT,9970) ITOTER,KD1LN2
1181 RETURN
1182 END
1183 SUBROUTINE COMDEP
1184 CC NAM: COMDEP VER: 1.0 DAT: 12/08/78 CMP: PDP-11
1185 CC
1186 CC SYS: MACS
1187 CC
1188 CC ENT: N/A
1189 CC
1190 CC RTN: N/A
1191 CC
1192 CC FNC: THIS ROUTINE SETS VARIABLES IN COMMON TO WHAT THE
1193 CC COMPUTER IT IS CURRENTLY RUNNING ON REQUIRES.
1194 CC IT ALSO SETS I/O DEVICE NUMBERS TO 6800 DEVICES.
1195 CC DEVICE NUMBER VARIABLE NAME
1196 CC 2 LUSI - SOURCE INPUT
1197 CC 3 LUOT - ASSEMBLY LISTING(TO A FILE)
1198 CC 6 LUOT - ASSEMBLY LISTING( TO PRINTER)
1199 CC 5 LUOT - ASSEMBLY LISTING( TO CONSOLE)
1200 CC 5 LULT - OUTPUT TO CONSOLE.
1201 CC 5 LUCI - INPUT FROM CONSOLE.
1202 CC 1 LUOO - ASSEMBLED OBJECT OUTPUT.
1203 CC
1204 CC
1205 CC REV: N/A
1206 CC
1207 C*
1208 IMPLICIT INTEGER (A-Z)
1209 COMMON /A/ ISYM(3000),KARD1(96),ITOKEN(70),TKNSIZ,TKNTYP,
1210 & TKNVAL,TKNVA2,JSUC,JPTR,LPTR,NXSYM,KOLUMN,KD1BCT,KD1LNO,JERR,
1211 & MNUM,IPASS,IPC2,IPC,IOPC,INS(5),INSL,ISIZ,IADM(7,2),LUOT
1212 COMMON /A/ KASH(64),KPAC(15),KPWCT,LENSYM,KCLAS(64)
1213 COMMON /A/ NET1(64),NET2(64),NET3(64),NET4(64),NET5(64)
1214 COMMON /A/ NBPW,KSYS,IEOT,LSP,JBUF(83),KARD2(80,3),IHB480,IHEX9K
1215 COMMON /A/ IA1SHF,KCFF,LUSI,LUDI,LUOO,LLEN,IPLEN
1216 COMMON /A/ LIST,ICOL,NEST,LUCI,LULT
1217 C
1218 C
1219 C
1220 C*** IHB480 CHANGED TO HEX B180 FROM B480
1221 DATA IB480/O130600/,IHX9K/O110000/
1222 C*** IHB480 = $B180 HEX
1223 IHB480 = IB480
1224 C*** IHEX9K = 9000 HEX
1225 IHEX9K=IHX9K
1226 C*** # OF BYTES PER COMPUTER WORD
1227 NBPW=2
1228 C
1229 C*** DEFAULT SOURCE OUTPUT DEVICE NUMBER
1230 C
1231 LUOT=6
1232 C
1233 C*** SOURCE INPUT DEVICE NUMBER
1234 C
1235 LUSI=2
1236 C
1237 C*** CONSOLE INPUT
1238 C
1239 LUCI=5
1240 C
1241 C*** CONSOLE OUTPUT
1242 C
1243 LULT=5
1244 C
1245 C*** OBJECT OUTPUT(S RECORDS) DEVICE #
1246 LUOO=1
1247 C*** POWER OF 2 SHIFT
1248 C*** 'AND' MASK
1249 KCFF=255
1250 C*** LINE COUNT
1251 KD1LNO=0
1252 C*** END OF RECORD POINTER
1253 KD1BCT=0
1254 RETURN
1255 END
1256 SUBROUTINE SOUCIN(I)
1257 CC NAM: SOUCIN VER: 1.0 DAT: 12/08/78 CMP: PDP-11
1258 CC
1259 CC SYS: MC68000 ASM
1260 CC
1261 CC ENT: N/A
1262 CC
1263 CC RTN: I=0=END OF FILE - I=1=END OF FILE NOT FOUND
1264 CC
1265 CC FNC: READ A SOURCE RECORD DEPENDING ON COMPUTER TYPE
1266 CC
1267 CCALLS MPUCVC
1268 C
1269 C*
1270 IMPLICIT INTEGER (A-Z)
1271 COMMON /A/ ISYM(3000),KARD1(96),ITOKEN(70),TKNSIZ,TKNTYP,
1272 & TKNVAL,TKNVA2,JSUC,JPTR,LPTR,NXSYM,KOLUMN,KD1BCT,KD1LNO,JERR,
1273 & MNUM,IPASS,IPC2,IPC,IOPC,INS(5),INSL,ISIZ,IADM(7,2),LUOT
1274 COMMON /A/ KASH(64),KPAC(15),KPWCT,LENSYM,KCLAS(64)
1275 COMMON /A/ NET1(64),NET2(64),NET3(64),NET4(64),NET5(64)
1276 COMMON /A/ NBPW,KSYS,IEOT,LSP,JBUF(83),KARD2(80,3),IHB480,IHEX9K
1277 COMMON /A/ IA1SHF,KCFF,LUSI,LUDI,LUOO,LLEN,IPLEN
1278 DATA IO377/O377/
1279 9920 FORMAT(100A1)
1280 I=1
1281 GO TO 200
1282 135 I=0
1283 C*** RESET LINE COUNTER AND BUFFER POINTER
1284 KD1BCT=0
1285 KD1LNO=0
1286 RETURN
1287 200 CONTINUE
1288 READ(LUSI,9920,END=135) KARD1
1289 C*** UPDATE LINE COUNT
1290 KD1LNO=KD1LNO+1
1291 C*** REMOVE BLANK FROM UPPER BYTE
1292 DO 300J=1,95
1293 KARD1(J)=MPUAND(KARD1(J),IO377)
1294 300 CONTINUE
1295 C*** SET END OF LINE
1296 KD1BCT=95
1297 KARD1(96)=IEOT
1298 RETURN
1299 END
1300 SUBROUTINE FILEOP(IOP)
1301 CC NAM: FILEOP VER: 1.0 DAT 12/08/78 CMP: PDP-11
1302 CC
1303 CC SYS: MACS
1304 CC
1305 CC ENT: IOP - 1 = OPEN SI FILE
1306 CC - 2 = CLOSE SI FILE
1307 CC - 3 = REWIND SOURCE INPUT FILE FOR SECOND PASS.
1308 CC - 4 = CLOSE OBJ FILE
1309 CC - 5 = OPEN OBJ FILE
1310 CC - 6 = OPEN FILE FOR LIST TO GO TO.
1311 CC
1312 CC RTN: N/C
1313 CC
1314 CC FNC: THIS ROUTINE IS FOR FILE OPERATIONS ON DIFFERENT
1315 CC COMPUTERS, SUCH AS OPENING AND CLOSING FILES ETC.
1316 CC
1317 CC REV: N/A
1318 CC
1319 CCALLS ASSIGN
1320 C
1321 C*
1322 IMPLICIT INTEGER (A-Z)
1323 COMMON /A/ ISYM(3000),KARD1(96),ITOKEN(70),TKNSIZ,TKNTYP,
1324 & TKNVAL,TKNVA2,JSUC,JPTR,LPTR,NXSYM,KOLUMN,KD1BCT,KD1LNO,JERR,
1325 & MNUM,IPASS,IPC2,IPC,IOPC,INS(5),INSL,ISIZ,IADM(7,2),LUOT
1326 COMMON /A/ KASH(64),KPAC(15),KPWCT,LENSYM,KCLAS(64)
1327 COMMON /A/ NET1(64),NET2(64),NET3(64),NET4(64),NET5(64)
1328 COMMON /A/ NBPW,KSYS,IEOT,LSP,JBUF(83),KARD2(80,3),IHB480,IHEX9K
1329 COMMON /A/ IA1SHF,KCFF,LUSI,LUDI,LUOO,LLEN,IPLEN
1330 COMMON /A/ LIST,ICOL,NEST,LUCI,LULT
1331 DATA LSPP/' '/
1332 GO TO (100,200,300,400,500,600),IOP
1333 9910 FORMAT(100A2)
1334 100 CONTINUE
1335 WRITE(LULT,9900)
1336 9900 FORMAT(' ENTER SI FILENAME')
1337 READ(LUCI,9910) JBUF
1338 C*** INSERT ZERO AS LAST CHAR
1339 DO 150 I=1,10
1340 IF(JBUF(I).NE.LSPP) J=I
1341 150 CONTINUE
1342 JBUF(J+1)=0
1343 CALL ASSIGN(LUSI,JBUF,0)
1344 GO TO 610
1345 200 CONTINUE
1346 CALL CLOSE(LUSI)
1347 RETURN
1348 300 CONTINUE
1349 REWIND LUSI
1350 RETURN
1351 400 CONTINUE
1352 CALL CLOSE(LUOO)
1353 RETURN
1354 500 CONTINUE
1355 WRITE(LULT,9930)
1356 9930 FORMAT(' ENTER OBJ FILENAME')
1357 READ(LUCI,9910) JBUF
1358 C*** INSERT ZERO AS LAST CHAR
1359 DO 550 I=1,10
1360 IF(JBUF(I).NE.LSPP) J=I
1361 550 CONTINUE
1362 JBUF(J+1)=0
1363 CALL ASSIGN(LUOO,JBUF,0)
1364 RETURN
1365 C
1366 C*** OPEN FILE FOR LISTING
1367 C
1368 600 CONTINUE
1369 RETURN
1370 610 CONTINUE
1371 WRITE(LULT,9950)
1372 9950 FORMAT(' ENTER LISTING FILENAME')
1373 READ(LUCI,9910) JBUF
1374 LUOT=3
1375 C*** INSERT ZERO AS LAST CHAR
1376 DO 650 I=1,10
1377 IF(JBUF(I).NE.LSPP) J=I
1378 650 CONTINUE
1379 JBUF(J+1)=0
1380 CALL ASSIGN(LUOT,JBUF,0)
1381 RETURN
1382 END
1383 SUBROUTINE REREAD
1384 CC NAM: REREAD VER: 1.0 DAT: 12/08/78 CMP: ALL
1385 CC
1386 CC SYS: MC68000 ASM
1387 CC
1388 CC ENT: ALL VARIABLES USED ARE IN COMMON
1389 CC
1390 CC RTN: N/A
1391 CC
1392 CC FNC: THIS ROUTINE INCREMENTS THE @NNN NUMBER IN A MACRO.
1393 CC
1394 CC REV: N/A
1395 CC
1396 CCALLS NONE.
1397 C
1398 C*
1399 IMPLICIT INTEGER (A-Z)
1400 COMMON /A/ ISYM(3000),KARD1(96),ITOKEN(70),TKNSIZ,TKNTYP,
1401 & TKNVAL,TKNVA2,JSUC,JPTR,LPTR,NXSYM,KOLUMN,KD1BCT,KD1LNO,JERR,
1402 & MNUM,IPASS,IPC2,IPC,IOPC,INS(5),INSL,ISIZ,IADM(7,2),LUOT
1403 COMMON /A/ KASH(64),KPAC(15),KPWCT,LENSYM,KCLAS(64)
1404 COMMON /A/ NET1(64),NET2(64),NET3(64),NET4(64),NET5(64)
1405 COMMON /A/ NBPW,KSYS,IEOT,LSP,JBUF(83),KARD2(80,3),IHB480,IHEX9K
1406 COMMON /A/ IA1SHF,KCFF,LUSI,LUDI,LUOO,LLEN,IPLEN
1407 C*** 57 = ASCII 39 = 9
1408 C*** IS THE COUNT > 9?
1409 IF(KARD2(4,1).EQ.57) GO TO 100
1410 KARD2(4,1)=KARD2(4,1)+1
1411 RETURN
1412 100 KARD2(4,1)=48
1413 IF(KARD2(3,1).EQ.57) GO TO 200
1414 KARD2(3,1)=KARD2(3,1)+1
1415 RETURN
1416 200 KARD2(3,1)=48
1417 KARD2(2,1)=KARD2(2,1)+1
1418 RETURN
1419 END
1420 SUBROUTINE DEBUG(II)
1421 C THIS SUBROUTINE IS FOR DEBUGGING ONLY
1422 C IT IS CALLED FROM 'PAGE' AND 'OUTPUT'
1423 C
1424 DATA I1STP/0/
1425 GO TO (10,100),II
1426 10 CONTINUE
1427 I1STP=1
1428 RETURN
1429 100 CONTINUE
1430 IF(I1STP.EQ.1) II=1
1431 RETURN
1432 END
1433 SUBROUTINE PAR
1434 CC NAM: PAR VER: 1.0 DAT: 12/08/78 CMP: ALL
1435 CC PGM: PARSE ROUITNE
1436 CC
1437 CC SYS: MC68000 ASM
1438 CC
1439 CC ENT: N/A
1440 CC RTN: N/A
1441 CC
1442 CC FNC: CHECK THE PARSE NET FOR THE TOKEN TYPE AND WHEN FOUND
1443 CC DOES ITS ACTIONS.
1444 CC
1445 CC REV: N/A
1446 CC
1447 CCALLS SCN-ACT1-ACT2-ERR
1448 CC
1449 CC ERROR NUMBERS CALLED: 203,204,222
1450 CC
1451 C*
1452 IMPLICIT INTEGER (A-Z)
1453 COMMON /A/ ISYM(3000),KARD1(96),ITOKEN(70),TKNSIZ,TKNTYP,
1454 & TKNVAL,TKNVA2,JSUC,JPTR,LPTR,NXSYM,KOLUMN,KD1BCT,KD1LNO,JERR,
1455 & MNUM,IPASS,IPC2,IPC,IOPC,INS(5),INSL,ISIZ,IADM(7,2),LUOT
1456 COMMON /A/ KASH(64),KPAC(15),KPWCT,LENSYM,KCLAS(64)
1457 C TKNTYP DEFINED ALTERNATE SUCCESSOR ACTION
1458 COMMON /A/ NET1(64),NET2(64),NET3(64),NET4(64),NET5(64)
1459 COMMON /A/ NBPW,KSYS,IEOT,LSP,JBUF(83),KARD2(80,3),IHB480,IHEX9K
1460 COMMON /A/ IA1SHF,KCFF,LUSI,LUDI,LUOO,LLEN,IPLEN
1461 C
1462 DIMENSION JSTACK(20)
1463 C*** SPECIAL ALT,SUC CODE ***
1464 DATA NONE/0/
1465 100 KOLUMN=0
1466 105 CALL SCN
1467 110 JG=1
1468 NPTR=1
1469 LPTR=0
1470 C*** HAVE WE CAME TO END OF FILE?
1471 IF(TKNTYP.EQ.0) RETURN
1472 130 CONTINUE
1473 IF(NET2(JG).EQ.NONE) GO TO 140
1474 C... *** DEFINED LOWER, PUSH ENTRY INTO STACK
1475 JSTACK(NPTR)=JG
1476 NPTR=NPTR+1
1477 IF(NPTR.NE.20) GO TO 135
1478 C... *** ERROR - PARSE NET STACK OVERFLOW
1479 CALL ERR(222)
1480 RETURN
1481 135 CONTINUE
1482 JG=NET2(JG)
1483 GO TO 130
1484 140 CONTINUE
1485 IF(NET1(JG).EQ.TKNTYP) GO TO 170
1486 C--- DEBUG...
1487 C IF(IPASS.EQ.0) WRITE(LUOT,881) JG
1488 881 FORMAT('PAR-TST,JG=',I4)
1489 150 CONTINUE
1490 JG=NET3(JG)
1491 IF(JG) 200,160,130
1492 C*** "NONE" FOUND, GET THE LAST ENTRY ON THE STACK
1493 160 NPTR=NPTR-1
1494 IF(NPTR.NE.0) GO TO 165
1495 C... *** ERROR - SYNTAX ERROR
1496 IF(IPASS.GE.0) CALL ERR(204)
1497 IOPC=0
1498 RETURN
1499 165 JG=JSTACK(NPTR)
1500 GO TO 150
1501 C*** TOKEN TYPE FOUND
1502 170 J5=NET5(JG)
1503 IF(J5.EQ.NONE) GO TO 180
1504 IF(IPASS.GE.0) GO TO 175
1505 CALL ACT1(J5)
1506 GO TO 180
1507 175 CONTINUE
1508 CALL ACT2(J5)
1509 180 IF(KOLUMN.LE.0) GO TO 105
1510 TKNTYP=-1
1511 190 JG=NET4(JG)
1512 IF(JG.LT.0) GO TO 200
1513 IF(TKNTYP.LT.0) CALL SCN
1514 GO TO 130
1515 C*** "EXIT" FOUND
1516 200 NPTR=NPTR-1
1517 IF(NPTR.NE.0) GO TO 210
1518 C... *** ASSURE PROPER TERMINATION OF OPERAND
1519 IF(TKNTYP.EQ.0) RETURN
1520 IF(KARD1(KOLUMN).EQ.LSP) RETURN
1521 IF(IPASS.GE.0) CALL ERR(203)
1522 RETURN
1523 210 JG=JSTACK(NPTR)
1524 J5=NET5(JG)
1525 IF(J5.EQ.NONE) GO TO 190
1526 IF(IPASS.GE.0) GO TO 220
1527 CALL ACT1(J5)
1528 GO TO 190
1529 220 CONTINUE
1530 CALL ACT2(J5)
1531 GO TO 190
1532 END
1533 SUBROUTINE SCN
1534 CC NAM: SCN VER: 1.0 DAT: 12/08/78 CMP: PDP-11
1535 CC
1536 CC SYS: MACS
1537 CC
1538 CC ENT: N/A
1539 CC
1540 CC RTN: N/A
1541 CC
1542 CC FNC: ISSUES READ TO 'SOUCIN' TO GET NEXT SOURCE LINE.
1543 CC BREAKS IT INTO 'TOKENS'. STACKS MACROS INTO ARRAYS
1544 CC 'KARD2' AND 'MFLD' FOR PROCESSING.
1545 CC
1546 CC NOTE: THIS ROUTINE IS 16-BIT MACHINE DEPENDENT DUE TO BIT
1547 CC HANDLING IN 'TKNVA2'. IT HOLDS THE 2 MOST SIGNIFICANT
1548 CC BYTES OF A 32-BIT NUMBER.
1549 CC
1550 CC REV: N/A
1551 CC
1552 CCALLS OUTPUT-MPUGTC-ERR-SOUCIN-LKP-REREAD-MPUPTC-KLAS-ASCBIN
1553 CC
1554 CC ERROR NUMBERS CALLED: 201,202,226
1555 CC
1556 C*
1557 IMPLICIT INTEGER (A-Z)
1558 COMMON /A/ ISYM(3000),KARD1(96),ITOKEN(70),TKNSIZ,TKNTYP,
1559 & TKNVAL,TKNVA2,JSUC,JPTR,LPTR,NXSYM,KOLUMN,KD1BCT,KD1LNO,JERR,
1560 & MNUM,IPASS,IPC2,IPC,IOPC,INS(5),INSL,ISIZ,IADM(7,2),LUOT
1561 COMMON /A/ KASH(64),KPAC(15),KPWCT,LENSYM,KCLAS(64)
1562 COMMON /A/ NET1(64),NET2(64),NET3(64),NET4(64),NET5(64)
1563 COMMON /A/ NBPW,KSYS,IEOT,LSP,JBUF(83),KARD2(80,3),IHB480,IHEX9K
1564 COMMON /A/ IA1SHF,KCFF,LUSI,LUDI,LUOO,LLEN,IPLEN
1565 C
1566 COMMON /A/LIST,ICOL,NEST,LUCI,LULT,MFLD(11,3)
1567 C
1568 DIMENSION KCTB(140)
1569 EQUIVALENCE (MFLD(11,1),MPTR)
1570 DATA MDEP/0/
1571 C*** MULTIPLE CHARACTER ACTION ARRAY
1572 DATA KCTB/1,2,2,2,2,2,2,2,1,2,
1573 & 0,-1,25,24,27,24,25,-1,-1,-1,
1574 & 1,2,2,2,3,2,2,3,1,1,
1575 & 5,2,4,2,6,2,3,1,1,1,
1576 & 1,6,6,6,1,6,6,6,1,1,
1577 & 1,2,1,1,2,1,1,6,1,1,
1578 & 1,2,1,1,2,1,1,6,1,1,
1579 & 1,2,2,2,2,2,1,6,1,1,
1580 & 1,2,1,1,7,1,1,6,1,1,
1581 & 1,2,1,2,2,2,1,6,1,1,
1582 & 1,2,2,2,2,2,2,6,1,1,
1583 & 1,6,6,6,2,6,6,3,1,1,
1584 & 1,2,6,6,2,6,6,6,1,1,
1585 & 1,1,1,1,2,1,1,6,1,1/
1586 DATA LASK/42/,L0/48/
1587 DATA LBS/92/,LAT/64/,LLB/60/,LRB/62/,LCM/44/,LPD/46/
1588 C
1589 JCC=0
1590 IF(ICOL.NE.-2) ICOL=KOLUMN
1591 IF(KOLUMN.GT.0) GO TO 150
1592 C
1593 C*** READ IN THE NEXT SOURCE RECORD
1594 C
1595 100 CONTINUE
1596 101 CONTINUE
1597 IF(KD1BCT.NE.0) CALL OUTPUT
1598 IF(MPTR.EQ.0) GO TO 130
1599 C
1600 C*** MACRO EXPANSION
1601 N1=1
1602 C*** BLANK BUFFER TO REMOVE LAST INSTRCUTION
1603 KD1BCT=1
1604 DO 50 I=1,95
1605 50 KARD1(I)=LSP
1606 102 CONTINUE
1607 CALL MPUGTC(KK,ISYM(MPTR),N1)
1608 IF(KK.GT.1) GO TO 107
1609 IF(KK.EQ.0) GO TO 1020
1610 C*** MEXIT, ARE WE IN IFXX-ENDC?
1611 IF(ICOL.GE.0) GO TO 1020
1612 MPTR=MPTR+1
1613 GO TO 102
1614 C... *** END OF MACRO
1615 1020 MPTR=0
1616 MDEP=MDEP-1
1617 IF(MDEP.EQ.0) GO TO 130
1618 DO 103 J=1,11
1619 MFLD(J,1)=MFLD(J,2)
1620 103 MFLD(J,2)=MFLD(J,3)
1621 DO 104 J=1,80
1622 KARD2(J,1)=KARD2(J,2)
1623 104 KARD2(J,2)=KARD2(J,3)
1624 GO TO 102
1625 107 N1=N1+1
1626 IF(KK.EQ.LBS) GO TO 108
1627 KARD1(KD1BCT)=KK
1628 KD1BCT=KD1BCT+1
1629 IF(KK.NE.IEOT) GO TO 102
1630 C... *** END OF CARD
1631 MPTR=MPTR + (N1 + NBPW - 2) / NBPW
1632 KD1BCT=KD1BCT - 2
1633 GO TO 140
1634 C... *** INSERT ACTUAL PARAMETER
1635 108 CONTINUE
1636 CALL MPUGTC(KK,ISYM(MPTR),N1)
1637 N1=N1+1
1638 IF(KK.NE.LAT) GO TO 110
1639 C... *** USE GENERATED LABEL
1640 N=1
1641 GO TO 116
1642 110 KK=KK-L0
1643 IF(KK.LT.0) GO TO 112
1644 IF(KK.LE.9) GO TO 114
1645 C... *** ERROR - ILLEGAL MACRO PARAMETER
1646 112 CALL ERR(224)
1647 GO TO 102
1648 114 N=MFLD(KK+1,1)
1649 IF(N.NE.0) GO TO 116
1650 IF(KK.NE.0) GO TO 102
1651 IF(KARD1(KD1BCT-1).NE.LPD) GO TO 102
1652 KD1BCT=KD1BCT-1
1653 GO TO 102
1654 116 KK=KARD2(N,1)
1655 N=N+1
1656 IF(KK.EQ.0) GO TO 102
1657 KARD1(KD1BCT)=KK
1658 KD1BCT=KD1BCT+1
1659 GO TO 116
1660 C
1661 130 CALL SOUCIN(I)
1662 C*** I = 0 = EOF
1663 IF(I.EQ.0) GO TO 295
1664 C... *** COMMENT CARD?
1665 IF(KARD1(1).NE.LASK) GO TO 140
1666 135 IOPC=0
1667 CALL OUTPUT
1668 GO TO 130
1669 C
1670 C*** INITIALIZE FOR A NEW CARD
1671 140 KOLUMN=1
1672 C+++ 16-BIT - TKNVA2 = 1ST 2 BYTES IF MORE THAN 2 IN CONSTANT
1673 TKNVA2=0
1674 FLDN=0
1675 DO 145 I=2,5
1676 145 INS(I)=0
1677 JCC=-1
1678 ITOKEN(69)=0
1679 C*** SETUP THE 1ST CHAR OF THE TOKEN
1680 150 TKNSIZ=0
1681 JC=KARD1(KOLUMN)
1682 IF(JC.NE.LSP) GO TO 170
1683 C... *** BLANK DELIMITER(S)
1684 FLDN=FLDN+1
1685 C@@@ CHECK FOR END OF OPERAND FIELD
1686 IF(FLDN.EQ.3) GO TO 295
1687 160 KOLUMN=KOLUMN+1
1688 JC=KARD1(KOLUMN)
1689 IF(JC.EQ.LSP) GO TO 160
1690 C*** IS THIS A NULL LINE? IF SO GO PRINT IT.
1691 IF(JCC.EQ.-1.AND.JC.EQ.4.AND.FLDN.EQ.1) GO TO 135
1692 C*** GET CHAR CLASS
1693 170 JCC=KLAS(JC)
1694 C*** SET THE TOKEN'S TYPE
1695 TKNTYP=KCTB(JCC+10)
1696 IF(TKNTYP.LT.0) TKNTYP=JC
1697 180 J=KCTB(JCC)
1698 GO TO (270,190),J
1699 C*** 1ST CHAR OF A MULTIPLE CHARACTER TOKEN
1700 190 J=KCTB(JCC+20)
1701 GO TO (220,250,200,260,270,280),J
1702 C*** DISCARD CHARACTER AND CONTINUE
1703 200 KOLUMN=KOLUMN+1
1704 C*** CHARACTER ACTION FOR NEXT CHARACTER OF MULTI-CHAR TOKEN
1705 JC=KARD1(KOLUMN)
1706 JCX=KLAS(JC)*10+30+JCC
1707 J=KCTB(JCX)
1708 GO TO (220,250,200,260,270,280,230),J
1709 C*** CHARACTER ACTION ROUTINE.
1710 C*** ERROR '201' ILLEGAL CHARACTER SCANNED
1711 220 IF(IPASS.GE.0) CALL ERR(201)
1712 GO TO 295
1713 C*** ' SCANNED, INCLUDE IT IF THERE ARE 2
1714 230 IF(JC.NE.KARD1(KOLUMN+1)) GO TO 270
1715 C*** SKIP THE NEXT CHAR IN THE RECORD (^ OR ')
1716 KOLUMN=KOLUMN+1
1717 C*** ADD CHARACTER TO TOKEN AND CONTINUE.
1718 250 TKNSIZ=TKNSIZ+1
1719 IF(TKNSIZ.LE.68) GO TO 255
1720 C... *** ERROR '202' TOKEN OVERFLOW (OVER 70 CHARACTERS LONG)
1721 IF(IPASS.GE.0) CALL ERR(202)
1722 GO TO 295
1723 255 ITOKEN(TKNSIZ)=JC
1724 GO TO 200
1725 C*** ADD CHARACTERS TO TOKEN AND STOP.
1726 260 TKNSIZ=TKNSIZ+1
1727 ITOKEN(TKNSIZ)=JC
1728 C*** DISCARD CHARACTER AND STOP
1729 270 KOLUMN=KOLUMN+1
1730 C*** LEAVE CHARACTER IN STRING AND STOP
1731 280 CONTINUE
1732 C*** LAST CHARACTER OF A TOKEN, DO ITS ACTION
1733 290 J=KCTB(JCC+30)
1734 GO TO (900,300,700,800,295,600),J
1735 C*** END OF CARD RETURN
1736 295 TKNTYP=0
1737 RETURN
1738 C
1739 C*** TOKEN ACTION ROUTINES
1740 C
1741 C*** VARIABLE NAME FOUND ***
1742 C... *** STATEMENT LABEL?
1743 300 IF(KARD1(KOLUMN).NE.58) GO TO 305
1744 C*** LABEL:
1745 KOLUMN=KOLUMN + 1
1746 FLDN=0
1747 305 IF(FLDN.NE.0) GO TO 310
1748 C... *** INSIDE A MACRO DEFINITION?
1749 IF(ICOL.LT.0) GO TO 150
1750 TKNTYP=29
1751 GO TO 900
1752 C... *** OPCODE FIELD?
1753 310 IF(FLDN.NE.1) GO TO 390
1754 C... *** OPCODE FIELD - LOOKUP THE OPCODE ***
1755 CALL LKP(-1,JSUC,JPTR)
1756 IF(JSUC.GT.0) GO TO 320
1757 C... *** UNDEFINED OP CODE
1758 IF(ICOL.EQ.-2) GO TO 100
1759 GO TO 900
1760 320 IOPC=ISYM(JPTR)
1761 INS(1)=ISYM(JPTR+1)
1762 C... *** LOOKING FOR ENDC?
1763 IF(ICOL.NE.-2) GO TO 330
1764 INSL=0
1765 IF(IOPC.EQ.18) NEST=NEST+1
1766 IF(IOPC.NE.1) GO TO 100
1767 IF(INS(1).NE.2) GO TO 100
1768 NEST=NEST-1
1769 IF(NEST.GE.0) GO TO 100
1770 ICOL=0
1771 NEST=0
1772 GO TO 100
1773 330 TKNTYP=30
1774 C... *** TEST FOR MACRO CALL
1775 IF(IOPC.NE.0) GO TO 900
1776 C... *** INSIDE A MACRO DEFINITION?
1777 IF(ICOL.LT.0) GO TO 900
1778 C
1779 C... *** MACRO CALL *** - ASSURE NOT TOO DEEP
1780 IF(MDEP.EQ.0) GO TO 351
1781 IF(MDEP.NE.3) GO TO 340
1782 C... *** ERROR - NESTED TOO DEEP
1783 CALL ERR(226)
1784 GO TO 900
1785 340 DO 342 J=1,11
1786 MFLD(J,3)=MFLD(J,2)
1787 342 MFLD(J,2)=MFLD(J,1)
1788 DO 344 J=1,80
1789 KARD2(J,3)=KARD2(J,2)
1790 344 KARD2(J,2)=KARD2(J,1)
1791 351 MDEP=MDEP+1
1792 IP=0
1793 MPTR=JPTR+1
1794 C... *** INCREASE THE GENERATED MACRO NUMBER
1795 MNUM=MNUM+1
1796 CALL REREAD
1797 C*** INITIALIZE THE FIELD POINTERS
1798 DO 352 NF=1,10
1799 352 MFLD(NF,1)=0
1800 N2=6
1801 NF=1
1802 C... *** LOOK FOR OPCODE.SIZE
1803 IF(KARD1(KOLUMN).NE.LPD) GO TO 354
1804 MFLD(1,1)=N2
1805 KOLUMN=KOLUMN+1
1806 353 KK=KARD1(KOLUMN)
1807 KOLUMN=KOLUMN+1
1808 IF(KK.EQ.LSP) KK=0
1809 KARD2(N2,1)=KK
1810 N2=N2+1
1811 IF(KK.EQ.IEOT) GO TO 380
1812 IF(KK.NE.0) GO TO 353
1813 C... *** SKIP TO THE START OF THE OPERAND FIELD
1814 354 DO 355 KOLUMN=KOLUMN,KD1BCT
1815 IF(KARD1(KOLUMN).NE.LSP) GO TO 358
1816 355 CONTINUE
1817 RETURN
1818 C*** MOVE THE OPERAND TO KARD2 AND LOOK FOR COMMAS
1819 358 NF=NF+1
1820 IF(NF.EQ.11) GO TO 101
1821 MFLD(NF,1)=N2
1822 360 KK=KARD1(KOLUMN)
1823 KOLUMN=KOLUMN+1
1824 IF(IP.EQ.0) GO TO 365
1825 IF(KK.NE.LRB) GO TO 370
1826 IP=IP-1
1827 GO TO 360
1828 C... ** IP EQ 0
1829 365 IF(KK.EQ.LSP) KK=IEOT
1830 IF(KK.EQ.LCM) KK=0
1831 IF(KK.NE.LLB) GO TO 370
1832 IP=IP+1
1833 GO TO 360
1834 C... ** NOT < OR >
1835 370 KARD2(N2,1)=KK
1836 N2=N2+1
1837 IF(KK.EQ.0) GO TO 358
1838 IF(KK.NE.4) GO TO 360
1839 C... *** END OF CARD
1840 380 KARD2(N2-1,1)=0
1841 GO TO 101
1842 C
1843 C... *** REGISTER NAME?
1844 390 CALL LKP(1,JSUC,JPTR)
1845 IF(JSUC.LE.0) GO TO 900
1846 IF(ISYM(JPTR).NE.2) GO TO 900
1847 TKNTYP=28
1848 GO TO 900
1849 C
1850 C*** CONSECUTIVE ', PUT IN A BLANK
1851 600 IF(TKNSIZ.GT.0) GO TO 605
1852 TKNSIZ=1
1853 ITOKEN(1)=32
1854 605 CONTINUE
1855 IF(IOPC.EQ.4) GO TO 625
1856 J=2
1857 IF(IPASS.EQ.0) J=64
1858 I=ISIZ
1859 C... *** LEAVE AS A STRING FOR DC.B
1860 IF(IOPC.NE.5) GO TO 610
1861 C... *** DC - LEAVE AS STRING IF DC.B
1862 IF(TKNSIZ.EQ.1) GO TO 610
1863 IF(ISIZ.LE.1) RETURN
1864 610 CONTINUE
1865 IF(I.EQ.0.AND.TKNSIZ.NE.1) I=J
1866 IF(I.EQ.J.AND.TKNSIZ.GT.2) I=I+J
1867 TKNVAL=0
1868 NB=5-I/J*2
1869 IF(NB.EQ.5) NB=4
1870 C*** IF MORE THAN 4 CHARACTERS USE ONLY 4.
1871 IF(TKNSIZ.LT.5) GO TO 615
1872 TKNSIZ=4
1873 CALL ERR(210)
1874 615 CONTINUE
1875 DO 620 J=1,TKNSIZ
1876 CALL MPUPTC(ITOKEN(J),TKNVAL,NB)
1877 620 NB=NB+1
1878 TKNTYP=25
1879 C*** TKNVAL & TKNVA2 ARE REVERSED IN MEMORY HERE AS COMPARED TO 6800
1880 C*** REVERSE THEM.
1881 J=TKNVAL
1882 TKNVAL=TKNVA2
1883 TKNVA2=J
1884 GO TO 900
1885 625 IADM(1,1)= -1
1886 RETURN
1887 C*** BINARY CONVERSION FROM CHARACTER STRING
1888 700 CONTINUE
1889 TKNVAL=0
1890 C*** SET 2 MSB ALSO
1891 TKNVA2=0
1892 CALL ASCBIN
1893 GO TO 900
1894 C
1895 C*** HEXADECIMAL CONVERSION FROM CHARACTER STRING
1896 800 TKNVAL=0
1897 DO 850 J=2,TKNSIZ
1898 JC=ITOKEN(J)
1899 I=JC-L0
1900 IF (I.GT.9) I=I-7
1901 C+++ 16-BIT - PUT MORE THAN 2 BYTES IN TKNVA2
1902 IF(J.LT.6) GO TO 840
1903 TKNVA2=ISHFT(TKNVA2,4)
1904 TKNVA2=TKNVA2 + ISHFT(TKNVAL,-12)
1905 840 CONTINUE
1906 TKNVAL=ISHFT(TKNVAL,4) + I
1907 C
1908 C*** EXIT FROM THE SCAN SUBROUTINE...
1909 850 CONTINUE
1910 900 CONTINUE
1911 RETURN
1912 END
1913 FUNCTION KLAS(KL)
1914 CC NAM: KLAS VER: 1.0 DAT: 12/08/78 CMP: ALL
1915 CC
1916 CC SYS: MACS
1917 CC
1918 CC ENT: KL - CHARACTER FROM INPUT BUFFER 'KARD1'.
1919 CC
1920 CC RTN: KL - N/C
1921 CC KLAS - SET TO CLASS
1922 CC
1923 CC FNC: DETERMINE THE CLASS OF A CHARACTER FROM THE INPUT
1924 CC BUFFER AND RETURN IT.
1925 CC
1926 CC REV: N/A
1927 C*
1928 IMPLICIT INTEGER (A-Z)
1929 COMMON /A/ ISYM(3000),KARD1(96),ITOKEN(70),TKNSIZ,TKNTYP,
1930 & TKNVAL,TKNVA2,JSUC,JPTR,LPTR,NXSYM,KOLUMN,KD1BCT,KD1LNO,JERR,
1931 & MNUM,IPASS,IPC2,IPC,IOPC,INS(5),INSL,ISIZ,IADM(7,2),LUOT
1932 COMMON /A/ KASH(64),KPAC(15),KPWCT,LENSYM,KCLAS(64)
1933 COMMON /A/ NET1(64),NET2(64),NET3(64),NET4(64),NET5(64)
1934 COMMON /A/ NBPW,KSYS,IEOT,LSP,JBUF(83),KARD2(80,3),IHB480,IHEX9K
1935 COMMON /A/ IA1SHF,KCFF,LUSI,LUDI,LUOO,LLEN,IPLEN
1936 C*** CHARACTER SET BASE OFFSET
1937 DATA JCOFS/31/
1938 JL=KL-JCOFS
1939 C*** 00-1F ARE EOT'S
1940 IF(JL.GT.0) GO TO 925
1941 KLAS=1
1942 RETURN
1943 C*** SPECIAL CHARACTERS
1944 925 IF(JL.LE.64) GO TO 950
1945 KLAS=9
1946 RETURN
1947 950 KLAS=KCLAS(JL)
1948 RETURN
1949 END
1950 SUBROUTINE LKP(NTYP,NSUC,NPTR)
1951 CC NAM: LKP VER: 1.0 DAT: 12/08/78 CMP: ALL
1952 CC
1953 CC SYS: MC68000 ASM
1954 CC
1955 CC ENT: NTYP - TOKEN TYPE (-1, 0 OR 1 SEE STF)
1956 CC NSUC - N/A
1957 CC NPTR - N/A
1958 CC
1959 CC RTN: NTYP - N/C
1960 CC NSUC - -1=> NO ENTRY IN THE HASH TABLE
1961 CC - 0=> ENTRY IN HASH, BUT NO SYMBOL IN THE TABLE
1962 CC - >0=> ENTRY FOUND, INDEX TO SYMBOL ENTRY IN SYM
1963 CC NPTR - NSUC= -1=> INDEX TO HASH TABLE
1964 CC - NSUC= 0=> POINTER TO THE PREVIOUS LINK IN SYM
1965 CC - NSUC= >0=> INDEX TO THE DATA ENTRY OF THE SYMBOL
1966 CC
1967 CC FNC: PACK THE TOKEN INTO COMPUTER WORDS AND SEARCH THE HASH
1968 CC AND SYMBOL TABLE FOR THE SYMBOL.
1969 CC
1970 CC REV: N/A
1971 CC
1972 CCALLS MPUPTC-MPUAND
1973 CC
1974 C*
1975 IMPLICIT INTEGER (A-Z)
1976 COMMON /A/ ISYM(3000),KARD1(96),ITOKEN(70),TKNSIZ,TKNTYP,
1977 & TKNVAL,TKNVA2,JSUC,JPTR,LPTR,NXSYM,KOLUMN,KD1BCT,KD1LNO,JERR,
1978 & MNUM,IPASS,IPC2,IPC,IOPC,INS(5),INSL,ISIZ,IADM(7,2),LUOT
1979 COMMON /A/ KASH(64),KPAC(15),KPWCT,LENSYM,KCLAS(64)
1980 COMMON /A/ NET1(64),NET2(64),NET3(64),NET4(64),NET5(64)
1981 COMMON /A/ NBPW,KSYS,IEOT,LSP,JBUF(83),KARD2(80,3),IHB480,IHEX9K
1982 COMMON /A/ IA1SHF,KCFF,LUSI,LUDI,LUOO,LLEN,IPLEN
1983 C
1984 EQUIVALENCE(ITOKEN(70),ITYP1)
1985 C*** TKNSIZ//(NUMBER BYTES PER WORD ***
1986 KPWCT=(TKNSIZ+NBPW-1) / NBPW
1987 KPAC(KPWCT)=0
1988 NTYP1=MPUAND(NTYP,255)+ISHFT(KPWCT,8)
1989 NPTR=0
1990 NSUC=-1
1991 DO 100 J=1,TKNSIZ
1992 NPTR=NPTR+ITOKEN(J)
1993 J1=J
1994 100 CALL MPUPTC(ITOKEN(J),KPAC,J1)
1995 NPTR=MPUAND(NPTR,63)+1
1996 JP=KASH(NPTR)
1997 110 IF(JP.EQ.0) RETURN
1998 IF(ISYM(JP+1).EQ.NTYP1) GO TO 130
1999 120 NSUC=0
2000 NPTR=JP
2001 JP=ISYM(JP+2)
2002 GO TO 110
2003 130 JPP = JP + 2
2004 DO 140 J=1,KPWCT
2005 JPP=JPP + 1
2006 IF(ISYM(JPP).NE.KPAC(J)) GO TO 120
2007 140 CONTINUE
2008 NSUC=JP
2009 NPTR=JP+KPWCT+3
2010 RETURN
2011 END
2012 SUBROUTINE STF(KSUC,KPTR,KSIZ,KTYP)
2013 CC NAM: STF VER: 1.0 DAT: 12/08/78 CMP: ALL
2014 CC
2015 CC SYS: MC68000 ASM
2016 CC
2017 CC ENT: KSUC - -1=> NO ENTRY IN HASH TABLE
2018 CC - 0=> ENTRY IN HASH, BUT CANNOT FIND THE SYMBOL
2019 CC - >0=> SYMBOL FOUND, INDEX TO THE SYMBOL ENTRY
2020 CC KPTR - KSUC= -1=> INDEX TO THE HASH TABLE
2021 CC - KSUC= 0=> POINTER TO THE PREVIOUS LINK
2022 CC - KSUC= >0=> INDEX TO THE DATA ENTRY OF THE SYMBOL
2023 CC KSIZ - REQUIRED SIZE OF THE DATA ENTRY
2024 CC KTYP - -1=> DICTIONARY SYMBOL
2025 CC - 0=> CONSTANT SYMBOL
2026 CC - 1=> VARIABLE SYMBOL
2027 CC
2028 CC RTN: KSUC - INDEX TO THE SYMBOL ENTRY
2029 CC KPTR - INDEX TO THE SYMBOL'S DATA ENTRY
2030 CC KSIZ - N/CC
2031 CC KTYP - N/CC
2032 CC
2033 CC FNC: STORE THE SYMBOL IN 'KPAC' INTO THE SYMBOL TABLE.
2034 CC
2035 CC REV: N/A
2036 CC
2037 CCALLS ERR
2038 CC
2039 CC ERROR NUMBERS CALLED: 221
2040 C*
2041 IMPLICIT INTEGER (A-Z)
2042 COMMON /A/ ISYM(3000),KARD1(96),ITOKEN(70),TKNSIZ,TKNTYP,
2043 & TKNVAL,TKNVA2,JSUC,JPTR,LPTR,NXSYM,KOLUMN,KD1BCT,KD1LNO,JERR,
2044 & MNUM,IPASS,IPC2,IPC,IOPC,INS(5),INSL,ISIZ,IADM(7,2),LUOT
2045 COMMON /A/ KASH(64),KPAC(15),KPWCT,LENSYM,KCLAS(64)
2046 COMMON /A/ NET1(64),NET2(64),NET3(64),NET4(64),NET5(64)
2047 COMMON /A/ NBPW,KSYS,IEOT,LSP,JBUF(83),KARD2(80,3),IHB480,IHEX9K
2048 COMMON /A/ IA1SHF,KCFF,LUSI,LUDI,LUOO,LLEN,IPLEN
2049 C
2050 EQUIVALENCE(ITOKEN(70),KTYP1)
2051 K = 0
2052 IF (KSUC .LE. 0) K = KPWCT + 3
2053 260 IF (KSUC) 200,210,250
2054 200 KASH(KPTR)=NXSYM
2055 GO TO 220
2056 210 ISYM(KPTR+2)=NXSYM
2057 220 ISYM(NXSYM)=0
2058 ISYM(NXSYM+1)=MPUAND(KTYP,255)+ISHFT(KPWCT,8)
2059 ISYM(NXSYM+2)=0
2060 JCX = NXSYM + 2
2061 DO 230 J=1,KPWCT
2062 JCX= JCX + 1
2063 230 ISYM(JCX)=KPAC(J)
2064 KSUC=NXSYM
2065 IF (NXSYM + K + KSIZ - 1 .LE. LENSYM) GO TO 250
2066 CALL ERR(221)
2067 C*** SET POINTERS TO USE SCRATCH AREA
2068 KPTR=NXSYM+K
2069 RETURN
2070 250 KPTR=NXSYM+ K
2071 NXSYM=KPTR+KSIZ
2072 RETURN
2073 END
2074 SUBROUTINE ACT1(KMD)
2075 CC NAM: ACT1 VER: 1.0 DAT: 12/08/78 CMP: 16-BIT
2076 CC
2077 CC SYS: MACS
2078 CC
2079 CC ENT: KMD - EQUALS ACTION TO BE TAKEN UPON ENTRY AS DETERMINED
2080 CC FROM PARSE TABLE.
2081 CC
2082 CC RTN: KMD - N/C
2083 CC
2084 CC FNC: P A S S O N E A C T I O N S
2085 CC ------------------------------
2086 CC PERFORM THE ACTIONS FOR THE DIFFERENT "TOKENS"
2087 CC ENCOUNTERED DURING THE STATEMENT SCAN.
2088 CC IT SETS ADDRESS MODE IN 'IADM' TABLE, ENTERS EXPRESSION
2089 CC IN EXPRESSION TABLE, ENTERS NEW SYMBOL IN SYMBOL TABLE.
2090 CC ---------------------------------------------
2091 CC THIS SUBROUTINE IS A MODIFICATION OF "ACT2"
2092 CC THERE MUST NOT BE ANY DIFFERENCE BETWEEN ACT1
2093 CC AND ACT2 THAT COULD AFFECT THE ASSUMED SIZE OF
2094 CC THE INSTRUCTIONS.
2095 CC ----------------------------------------------
2096 CC
2097 CC THIS ROUTINE IS 16-BIT DEPENDENT DUE TO THE CHECK ON
2098 CC 'TKNVA2' FOR THE 2 MOST SIGNIFICANT BYTES OF A 32-BIT #.
2099 CC INTEGER CONSTANT 192=$C0, 128=$80($=HEX).
2100 CC NOTE ALSO INTEGER CONSTANTS 192 & 64 ARE SPECIAL HEX
2101 CC VALUES $C0 AND $40.
2102 CC
2103 CC REV: N/A
2104 CC
2105 CC ERROR NUMBERS CALLED: 221,225
2106 CC
2107 CCALLS ERR-LKP-STF-SCN-MPUPTC-BUILD1-EXP
2108 CC
2109 C*
2110 IMPLICIT INTEGER (A-Z)
2111 COMMON /A/ ISYM(3000),KARD1(96),ITOKEN(70),TKNSIZ,TKNTYP,
2112 & TKNVAL,TKNVA2,JSUC,JPTR,LPTR,NXSYM,KOLUMN,KD1BCT,KD1LNO,JERR,
2113 & MNUM,IPASS,IPC2,IPC,IOPC,INS(5),INSL,ISIZ,IADM(7,2),LUOT
2114 COMMON /A/ KASH(64),KPAC(15),KPWCT,LENSYM,KCLAS(64)
2115 COMMON /A/ NET1(64),NET2(64),NET3(64),NET4(64),NET5(64)
2116 COMMON /A/ NBPW,KSYS,IEOT,LSP,JBUF(83),KARD2(80,3),IHB480,IHEX9K
2117 COMMON /A/ IA1SHF,KCFF,LUSI,LUDI,LUOO,LLEN,IPLEN
2118 COMMON /A/ LIST,ICOL,NEST,LUCI,LULT,MFLD(11,3),IOBJ,LLENSW,NOP
2119 COMMON /A/ NXSYM1
2120 DIMENSION NSZ(40),MREL(40)
2121 EQUIVALENCE (IADM(4,1),SYMTYP),(IADM(5,1),LFRF)
2122 DATA LB/66/,LW/87/,LL/76/,LAP/39/
2123 DATA LS/83/
2124 DATA Z8000/O100000/
2125 C*** OPCODE SIZES 01 02 03 04 05 06 07 08 09 10
2126 C*** 01-10
2127 DATA NSZ/ 0, 2, 0,-1,-1, 2, 2, 2,-1,-1,
2128 & -1,-1,-1,-1, 2,-1,-1,-1, 0,-1,
2129 & -1,-1,-1,-1, 2,-1, 2, 2, 2,-1,
2130 & 0, 2, 2,-1,-1,-1,-1,-1,-1, 0/
2131 C
2132 C*** USE PC REL? 01 02 03 04 05 06 07 08 09 10
2133 C*** 01-10
2134 DATA MREL/ 0, 0, 0, 0,-1, 0, 0, 0, 1, 1,
2135 & 1, 1,-1, 1, 1, 1, 1, 0, 0, 1,
2136 & 1, 1, 1, 1, 0, 0, 0, 0, 0, 1,
2137 & 0,-1, 0, 1, 0, 1, 1, 1, 1, 0/
2138 GO TO(100,200,300,400,500,600,700,800,800,
2139 & 1000,1100,1200,1300,1400,1500,1600,1700),KMD
2140 C*** EXPRESSION ACTION
2141 CALL EXP(KMD)
2142 RETURN
2143 C
2144 C*** STATEMENT LABEL
2145 C
2146 100 CALL LKP(1,LSUC,LPTR)
2147 C*** SAVE AS FLAG FOR FINDING MULT DEF MACRO
2148 N1=0
2149 IF(LSUC.LE.0) GO TO 105
2150 IF(ISYM(LPTR).EQ.0) GO TO 110
2151 C*** ERROR - MULTIPLE DEFINED SYMBOL
2152 ISYM(LPTR)=IADM(7,1) + 192
2153 GO TO 120
2154 C*** CHECK FOR SYMBOL ALREADY USED AS MACRO OR LABEL.
2155 105 CALL LKP(-1,N1,N2)
2156 CALL STF(LSUC,LPTR,2,1)
2157 C*** *** FORWARD REFERENCE
2158 110 ISYM(LPTR)=IADM(7,1) + 64
2159 ISYM(LPTR+1)=IPC
2160 C+++ 16-BIT - PUT M.S.B. OF P-COUNT IN SYM TABLE.
2161 ISYM(LSUC)=IPC2
2162 C*** SAVE FOR BUILD1
2163 120 ITOKEN(69)=LSUC
2164 RETURN
2165 C
2166 C*** OPCODE
2167 C
2168 200 KSYS=1
2169 IF(JSUC.GT.0) GO TO 210
2170 C*** ERROR - UNDEFINED OP-CODE
2171 KOLUMN=0
2172 RETURN
2173 C*** *** MACRO DEFINITION?
2174 210 IF(IOPC.GE.0) GO TO 260
2175 IQ=0
2176 C*** ASSURE OPCODE IS MACRO
2177 IF(INS(1).NE.0) CALL ERR(225)
2178 C*** IS SYMBOL ALREADY DEF?
2179 IF(ISYM(LPTR).EQ.192) GO TO 250
2180 C*** CHECK FOR MULT DEF MACRO
2181 IF(N1.LT.NXSYM1) GO TO 220
2182 C*** SET MULT DEF FLAG
2183 ISYM(LPTR)=192
2184 GO TO 230
2185 220 CONTINUE
2186 C*** TABLE THE MACRO DEFINITION
2187 ISYM(LPTR)=0
2188 C*** MAKE FIRST WORD NON-ZERO FOR SYM TABLE ROUTINE 'PRSYM'
2189 225 ISYM(LSUC)=1
2190 C*** MAKE TYPE 255 & KEEP # OF WORDS IN NAME
2191 ISYM(LSUC+1)=ISYM(LSUC+1)+254
2192 C*** *** CALL FOR OPCODE FIELD
2193 230 KOLUMN=-1
2194 CALL SCN
2195 C*** *** FIND # FIELDS AND CHECK FOR ENDM
2196 NF=3
2197 IF(TKNTYP.NE.30) GO TO 234
2198 IF(IOPC.GT.0) GO TO 232
2199 IF(IOPC.EQ.0) GO TO 234
2200 IF(INS(1).EQ.0) CALL ERR(225)
2201 IF(INS(1).NE.1) GO TO 231
2202 C*** ENDM
2203 ISYM(LPTR+1)=0
2204 KOLUMN=0
2205 RETURN
2206 C
2207 C*** MEXIT
2208 231 LPTR=LPTR+1
2209 CALL MPUPTC(1,ISYM(LPTR),1)
2210 GO TO 230
2211 232 IF(IOPC.LT.4) NF=2
2212 C*** *** PACK THE CARD INTO SYM
2213 234 N1=1
2214 N2=1
2215 236 KK=KARD1(N1)
2216 N1=N1+1
2217 238 CALL MPUPTC(KK,ISYM(LPTR+1),N2)
2218 N2=N2+1
2219 IF(KK.NE.LAP) GO TO 240
2220 C*** *** QUOTE FOUND
2221 IQ=IQ+1
2222 IF(IQ.EQ.2) IQ=0
2223 240 IF(IQ.NE.0) GO TO 244
2224 IF(KK.NE.LSP) GO TO 244
2225 NF=NF-1
2226 IF(NF.NE.0) GO TO 242
2227 KK=4
2228 GO TO 238
2229 242 KK=KARD1(N1)
2230 IF(KK.NE.LSP) GO TO 244
2231 N1=N1+1
2232 GO TO 242
2233 244 IF(KK.NE.4) GO TO 236
2234 C*** *** END OF CARD
2235 NW=(N2 + NBPW -2) / NBPW
2236 LPTR=LPTR+NW
2237 NXSYM=NXSYM+NW
2238 IF(NXSYM.LE.LENSYM-100) GO TO 230
2239 C*** *** SYMBOL TABLE OVERFLOW
2240 CALL ERR(221)
2241 RETURN
2242 C*** MULT DEF MACRO AND LABEL-FLUSH OUT MACRO AND LEAVE SYBOL
2243 C*** TABLE DEFINED AS LABEL INSTEAD OF MACRO
2244 250 CONTINUE
2245 KOLUMN= -1
2246 CALL SCN
2247 IF(INS(1).NE.1) GO TO 250
2248 KOLUMN=0
2249 RETURN
2250 C*** LOOKUP TENTATIVE INST. LENGTH
2251 260 IF(IOPC.LE.0) RETURN
2252 INSL=NSZ(IOPC)
2253 ISIZ=2
2254 IADM(5,2)=0
2255 LFRF=0
2256 IADM(1,1)=0
2257 IF(INSL.GE.0) GO TO 265
2258 C*** *** VARIABLE SIZE
2259 CALL EXP(21)
2260 RETURN
2261 C*** *** FIXED SIZE
2262 265 KOLUMN=0
2263 RETURN
2264 C
2265 C*** DATA SIZE
2266 C
2267 300 IF(ITOKEN(1).EQ.LB) ISIZ=0
2268 IF(ITOKEN(1).EQ.LL) ISIZ=4
2269 IF(ITOKEN(1).EQ.LS) ISIZ=0
2270 RETURN
2271 C
2272 C*** COMMA STARTING FIELD-2 OPERAND ***
2273 C
2274 C
2275 400 CALL EXP(21)
2276 IF(IOPC.NE.4) GO TO 410
2277 C*** DC - FORCE DATA OUT
2278 CALL BUILD1
2279 RETURN
2280 410 IF(IOPC.GE.19) GO TO 420
2281 C*** *** OPCODE REQUIRES ONLY ONE OPERAND
2282 KOLUMN=0
2283 RETURN
2284 420 IF(KSYS.EQ.2) KOLUMN=0
2285 KSYS=2
2286 TKNVA2=0
2287 RETURN
2288 C
2289 C*** OPERAND - REGISTER
2290 C
2291 500 IADM(1,KSYS)=0
2292 C*** *** ADDR REGISTER?
2293 IF(ISYM(JPTR+1).GT.7) IADM(1,KSYS)=8
2294 RETURN
2295 C
2296 C*** REGISTER INDIRECT MODE ***
2297 C
2298 600 CONTINUE
2299 IADM(1,KSYS)=16
2300 RETURN
2301 C
2302 C*** POST INCREMENT ***
2303 C
2304 700 CONTINUE
2305 IADM(1,KSYS)=24
2306 RETURN
2307 C
2308 C*** PRE DECREMENT ***
2309 C
2310 800 CONTINUE
2311 IADM(1,KSYS)=32
2312 RETURN
2313 C
2314 C*** IMMEDIATE OPERAND ***
2315 C
2316 C
2317 1000 CALL EXP(37)
2318 KK=ISIZ
2319 IF(KK.EQ.0) KK=2
2320 IADM(1,KSYS)=60
2321 IF(INSL.GT.0) GO TO 1010
2322 C*** *** FIRST FIELD
2323 INSL=2
2324 1010 INS(3)=TKNVAL
2325 C+++ 16-BIT - MOST SIGNIFICANT BYTE OF P-COUNT
2326 INS(2)=TKNVA2
2327 INSL=INSL + KK
2328 RETURN
2329 C
2330 C*** DISPLACEMENT ***
2331 C
2332 1100 IADM(1,KSYS)=56
2333 CALL EXP(37)
2334 C
2335 K=2
2336 C*** PC REL?
2337 IF(IADM(4,KSYS).EQ.1) GO TO 1110
2338 IF(IADM(5,KSYS).EQ.0) GO TO 1105
2339 C*** DEFAULT FORWARD REFERENCES TO 2 OR 4 BYTES
2340 IF(IADM(7,2).EQ.1) K=4
2341 GO TO 1110
2342 C+++ 16-BIT
2343 1105 IF(TKNVA2.EQ.-1) GO TO 1110
2344 C*** CHECK FOR ADDRESS FROM FF8000-FFFFFF
2345 I=MPUAND(TKNVAL,Z8000)
2346 IF(I.EQ.Z8000.AND.TKNVA2.EQ.KCFF) GO TO 1110
2347 IF(TKNVA2.NE.0) K=4
2348 C*** ADDR >$7FFF IS LONG ADDR.
2349 IF(I.NE.0.AND.TKNVA2.EQ.0) K=4
2350 1110 IF(INSL.LT.0) GO TO 1120
2351 C*** *** SECOND FIELD
2352 INSL=INSL + K
2353 1115 IF(K.EQ.4) IADM(1,KSYS)=57
2354 RETURN
2355 C*** *** FIRST FIELD
2356 1120 INSL=K + 2
2357 INS(3)=TKNVAL
2358 C+++ 16-BIT - MOST SIGNIFICANT BYTE OF P-COUNT
2359 INS(2)=TKNVA2
2360 GO TO 1115
2361 C
2362 C*** REGISTER FOR 3(A1) ADDRESSING MODE ***
2363 C
2364 1200 CONTINUE
2365 C*** TEST FOR ORG.L ALREADY SET ADDR MODE
2366 IF(IADM(1,KSYS).EQ.57) INSL=INSL-2
2367 RETURN
2368 C
2369 C*** .L FOR 3(A1.L) ADDRESSING MODE ***
2370 C
2371 1300 RETURN
2372 C
2373 C*** SECOND REGISTER FOR 3(A1,A2) ADDRESSING MODE ***
2374 C
2375 1400 RETURN
2376 C
2377 C*** SECOND REGISTER OF R1-R2 FOR LDM,STM
2378 C
2379 1500 RETURN
2380 C
2381 C*** 'STRING' GT 4 BYTES (DC ONLY)
2382 C
2383 1600 INS(3)=TKNSIZ
2384 IADM(1,1)=-1
2385 RETURN
2386 C
2387 C*** CONSTANT OR VARIABLE OPERAND ***
2388 C
2389 1700 CONTINUE
2390 IADM(4,KSYS)=0
2391 C
2392 IF(TKNTYP.EQ.24) GO TO 1710
2393 C*** CONSTANT OPERAND
2394 IF(TKNTYP.NE.42) GO TO 1730
2395 C*** ASTERISK
2396 IADM(4,KSYS)=IADM(7,1)
2397 TKNVAL=IPC
2398 TKNVA2=IPC2
2399 GO TO 1730
2400 C*** DEFINED PREVIOUSLY?
2401 1710 IF(JSUC.GT.0) GO TO 1720
2402 C*** NEW DEFINITION, PUT IN SY.
2403 CALL STF(JSUC,JPTR,2,1)
2404 ISYM(JPTR)=0
2405 ISYM(JPTR+1)= 0
2406 1720 IF(MPUAND(ISYM(JPTR),192).EQ.0) IADM(5,KSYS)=1
2407 TKNVAL=ISYM(JPTR+1)
2408 TKNVA2=ISYM(JSUC)
2409 C*** PC REL?
2410 IF(MPUAND(ISYM(JPTR),7).EQ.1) IADM(4,KSYS)=1
2411 C*** *** GIVE OPERAND TO EXP
2412 1730 CALL EXP(22)
2413 RETURN
2414 END
2415 SUBROUTINE BUILD1
2416 CC NAM: BUILD1 VER: 10.0 DAT: 12/08/78 CMP: 16-BIT
2417 CC
2418 CC SYS: MACS
2419 CC
2420 CC ENT: N/A
2421 CC
2422 CC RTN: N/A
2423 CC
2424 CC FNC: BUILD THE INSTRUCTION FOR PASS ONE
2425 CC USES INFORMATION IN TABLE 'IADM', AND 'INS' ARRAY.
2426 CC
2427 CC REV: N/A
2428 CC
2429 CCALLS MPUAND-ERR-MOD2-IABS-PAGE
2430 CC
2431 CC ERROR NUMBERS CALLED: 223,229,239,240
2432 C*
2433 IMPLICIT INTEGER (A-Z)
2434 COMMON /A/ ISYM(3000),KARD1(96),ITOKEN(70),TKNSIZ,TKNTYP,
2435 & TKNVAL,TKNVA2,JSUC,JPTR,LPTR,NXSYM,KOLUMN,KD1BCT,KD1LNO,JERR,
2436 & MNUM,IPASS,IPC2,IPC,IOPC,INS(5),INSL,ISIZ,IADM(7,2),LUOT
2437 COMMON /A/ KASH(64),KPAC(15),KPWCT,LENSYM,KCLAS(64)
2438 COMMON /A/ NET1(64),NET2(64),NET3(64),NET4(64),NET5(64)
2439 COMMON /A/ NBPW,KSYS,IEOT,LSP,JBUF(83),KARD2(80,3),IHB480,IHEX9K
2440 COMMON /A/ IA1SHF,KCFF,LUSI,LUDI,LUOO,LLEN,PLEN
2441 COMMON /A/ LIST,ICOL,NEST,LUCI,LULT,MFLD(11,3),IOBJ,LLENSW,NOP
2442 COMMON /A/ NXSYM1
2443 DIMENSION IMCD(6),NIMM(40)
2444 EQUIVALENCE (IADM(4,1),SYMTYP)
2445 DATA MASK2/0/,Z7000/O70000/,Z8000/O100000/,Z7100/O70400/
2446 DATA ZB001/O130001/,ZD001/O150001/,ZD002/O150002/
2447 DATA Z9001/O110001/,Z9002/O110002/,ZF000/O170000/
2448 C ORI SUBI EORI CMPI ANDI ADDI
2449 DATA IMCD/ 0000, 1024, 2560, 3072, 512, 1536/
2450 DATA NIMM/
2451 & 0,0,0,0,0,1,1,1,1,1,0,0,0,1,1,0,0,0,0,1,
2452 & 1,1,1,0,0,0,0,1,1,1,1,1,0,1,1,1,1,1,1,0/
2453 C
2454 IF(ISIZ.EQ.0) ISIZ=1
2455 C
2456 C*** PERFORM ACTIONS FOR THE OPCODE CLASS
2457 IF(IOPC.GT.0) GO TO 1620
2458 INSL=0
2459 RETURN
2460 1620 IF(INSL.LT.0) INSL=2
2461 GO TO(100, 200,9223,400,500, 600, 700, 800, 900, 1000,
2462 & 1100,1200,1300,1400,1500,1600,1700,1800,1900),IOPC
2463 J=IOPC-19
2464 GO TO(2000,2100,2200,2300,2400,2500,2600,2700,2800,2900,3000,
2465 & 9223,3200,9223,3400,3500,3600,3700,3800),J
2466 J=J-19
2467 GO TO(3900),J
2468 GO TO 9223
2469 C
2470 C*** PSEUDO OPS WITHOUT OPERANDS
2471 100 INS1=INS(1)
2472 GO TO(110,120,120,130,140,150,170,180,120,120,120,197),INS1
2473 C... *** END
2474 110 IPASS=0
2475 IPC2=0
2476 IPC=0
2477 MNUM=0
2478 C*** SLEW & PRINT HEADER IF PASS 1 ERRORS
2479 CALL PAGE(82)
2480 KD1LNO=0
2481 REWIND LUSI
2482 C*** RESET TO START OF PASS 1
2483 LIST=1
2484 RETURN
2485 120 RETURN
2486 C*** LIST ***
2487 130 LIST=1
2488 RETURN
2489 C
2490 C*** NOLIST ***
2491 140 LIST=0
2492 RETURN
2493 C*** TTL
2494 150 CONTINUE
2495 RETURN
2496 C*** NOPAGE
2497 170 CONTINUE
2498 NOP=0
2499 RETURN
2500 C
2501 C*** NOOBJ - NO OBJECT OUTPUT
2502 C
2503 180 CONTINUE
2504 IOBJ=0
2505 RETURN
2506 197 CONTINUE
2507 C*** MASK2 DIRECTIVE
2508 MASK2=1
2509 TKNSIZ=4
2510 C*** FIND ROOM FOR 'DCNT'
2511 ITOKEN(1)=68
2512 ITOKEN(2)=67
2513 ITOKEN(3)=78
2514 ITOKEN(4)=84
2515 CALL LKP(-1,LSUC,LPTR)
2516 C*** PUT 'DCNT' IN SYMM TABLE
2517 CALL STF(LSUC,LPTR,2,-1)
2518 ISYM(LPTR)=32
2519 C*** SET OPCODE
2520 ISYM(LPTR+1)=Z7100
2521 NXSYM1=NXSYM
2522 C*** FIND 'DBRA'
2523 ITOKEN(1)=68
2524 ITOKEN(2)=66
2525 ITOKEN(3)=82
2526 ITOKEN(4)=65
2527 CALL LKP(-1,LSUC,LPTR)
2528 IF(LSUC.LE.0) GO TO 199
2529 DO 198 I=1,16
2530 ISYM(LSUC+3)=LSP
2531 LSUC=LSUC+ISHFT(ISYM(LSUC+1),-8)+5
2532 198 CONTINUE
2533 C*** CHANGE OPCODE OF 'STOP' TO 2
2534 ITOKEN(1)=83
2535 ITOKEN(2)=84
2536 ITOKEN(3)=79
2537 ITOKEN(4)=80
2538 CALL LKP(-1,LSUC,LPTR)
2539 IF(LSUC.LE.0) GO TO 199
2540 ISYM(LPTR)=2
2541 RETURN
2542 9900 FORMAT(' SYMBOL DBRA NOT FOUND')
2543 199 WRITE(LULT,9900)
2544 RETURN
2545 C
2546 C
2547 C*** OP CODES WITHOUT OPERANDS
2548 200 RETURN
2549 C
2550 400 INSL=0
2551 C
2552 C*** DC
2553 IF(IADM(1,1).GE.0) GO TO 410
2554 C*** 'STRING'
2555 KK=INS(3)
2556 I=MOD(INS(3),ISIZ)
2557 IF(I.NE.0) KK=KK-I+ISIZ
2558 GO TO 415
2559 410 KK=ISIZ
2560 415 I=0
2561 GO TO 545
2562 C
2563 C*** PSEUDO OPS WITH OPERANDS
2564 500 INSL=0
2565 INS1=INS(1)
2566 GO TO(510,520,520,540,550,560,570),INS1
2567 GO TO 9223
2568 C... *** ORG
2569 510 IPC=INS(3)
2570 C+++ 16-BIT - GET MOST SIGNIFICANT BYTE
2571 IPC2=INS(2)
2572 IADM(7,1)=0
2573 IADM(7,2)=0
2574 IF(ISIZ.EQ.4) IADM(7,2)=1
2575 GO TO 530
2576 C... *** EQU
2577 520 IF(LPTR.GT.0) GO TO 522
2578 C... *** ERROR - NO LABEL ON STATEMENT
2579 CALL ERR(229)
2580 RETURN
2581 522 ISYM(LPTR)=MPUAND(ISYM(LPTR),192) + SYMTYP
2582 ISYM(LPTR+1)=INS(3)
2583 IF(INS(1).EQ.2) GO TO 525
2584 C... *** 'SET' DIRECTIVE, ALLOW REDEFINITION
2585 ISYM(LPTR)= SYMTYP + 64
2586 C+++ 16 BIT PUT M.S.B. OF ADDRESS IN SYM TABLE.
2587 C*** LSUC HAS BEEN SAVE IN 'ACT1'
2588 525 KK=ITOKEN(69)
2589 ISYM(KK)=INS(2)
2590 C*** FORWARD REF ILLEGAL
2591 530 IF(IADM(5,1).EQ.1) GO TO 9240
2592 RETURN
2593 C
2594 C*** DS
2595 C
2596 C*** KK=INS(3)*ISIZ
2597 540 I=0
2598 KK=ISIZ
2599 CALL MUL(I,KK,INS(2),INS(3))
2600 C*** CHECK FOR A FORWARD REFERERENCE WHICH IS ILLEGAL
2601 IF(IADM(5,1).EQ.1) GO TO 9240
2602 545 LPTR=0
2603 C*** IPC=IPC + KK
2604 CALL ADD(IPC2,IPC,I,KK)
2605 IF(ISIZ.NE.1) CALL MOD2
2606 RETURN
2607 C
2608 C*** RORG
2609 C
2610 550 IPC=INS(3)
2611 C+++ 16-BIT - GET MOST SIGNIFICANT BYTE
2612 IPC2=INS(2)
2613 IADM(7,1)=1
2614 IADM(7,2)=0
2615 RETURN
2616 C
2617 C*** FAIL
2618 C
2619 560 RETURN
2620 C
2621 C*** SPC ***
2622 C
2623 570 CONTINUE
2624 RETURN
2625 C
2626 C*** LINK/UNLK - ADDRESS REGISTER TO BITS 2-0
2627 C
2628 600 CONTINUE
2629 C*** CHECK FOR LINK - 20048 = $4E50 = LINK
2630 IF(INS(1).EQ.20048) INSL=4
2631 RETURN
2632 C
2633 C*** SWAP - DATA REGISTER TO BITS 2-0
2634 C
2635 700 RETURN
2636 C
2637 C*** TRAP - ESTABLISH DISPLACEMENT IN BITS 3-0
2638 C
2639 800 RETURN
2640 C
2641 C*** ABS/CLR/NEG/NOT/TST - BUILD EA
2642 C
2643 900 RETURN
2644 C
2645 C*** NBCD
2646 C
2647 1000 RETURN
2648 C
2649 C*** PEA
2650 C
2651 1100 RETURN
2652 C
2653 C*** JSR,JMP
2654 C
2655 1200 CONTINUE
2656 RETURN
2657 C
2658 C*** BCC
2659 C
2660 1300 CONTINUE
2661 IF(INSL.EQ.6) INSL=4
2662 IF(ISIZ.NE.1) GO TO 1310
2663 C*** FORCE SHORT FORM
2664 INSL=2
2665 RETURN
2666 1310 IF(INS(3).EQ.-1) RETURN
2667 C*** IS IT A FORWARD REFERENCE?
2668 IF(IADM(5,1).EQ.1) RETURN
2669 C... *** BACKWARD REFERENCE
2670 IOFS=INS(3)-IPC-2
2671 IF(IABS(IOFS).LE.127) INSL=2
2672 RETURN
2673 C
2674 C*** NEGX
2675 C
2676 1400 RETURN
2677 C
2678 C*** EXT
2679 C
2680 1500 RETURN
2681 C
2682 C*** TAS
2683 C
2684 1600 RETURN
2685 C
2686 C*** SCC
2687 1700 RETURN
2688 C
2689 C*** CONDITIONAL ASSEMBLY
2690 C
2691 1800 INSL=0
2692 INS1=INS(1)
2693 GO TO(1810,1820),INS1
2694 C... *** EQ
2695 C
2696 1810 IF(INS(3).NE.0) GO TO 1890
2697 IF(INS(2).NE.0) GO TO 1890
2698 RETURN
2699 C... *** NE
2700 1820 IF(INS(3).EQ.0.AND.INS(2).EQ.0) GO TO 1890
2701 RETURN
2702 C... *** SKIP TO ENDC
2703 1890 ICOL=-2
2704 RETURN
2705 C
2706 C*** PAGE LENGTH(PLEN) - LINE LENGTH(LLEN)
2707 C
2708 1900 CONTINUE
2709 IF(INS(1).GT.2) INSL=4
2710 RETURN
2711 C
2712 C*** MULTIPLY,DIVIDE
2713 C
2714 2000 RETURN
2715 C
2716 C*** ADD/SUB PROCESSING
2717 C
2718 2100 CONTINUE
2719 IF(IADM(1,2).EQ.8.AND.ISIZ.EQ.1) RETURN
2720 C*** ADD1/SUBQ? IF SO FORCE QUICK
2721 C*** 20480=$5000 - 20736 = $ 5100
2722 IF(INS(1).EQ.20480.OR.INS(1).EQ.20736) GO TO 2120
2723 IF(INS(3).LE.0) RETURN
2724 IF(INS(3).GT.8) RETURN
2725 C*** TEST FOR IMMEDIATE SOURCE
2726 IF(IADM(1,1).NE.60) RETURN
2727 C*** ADD1/SUBI? IF SO FORCE IT
2728 IF(INS(1).EQ.ZD001.OR.INS(1).EQ.Z9001) RETURN
2729 C*** ADDA/SUBA?
2730 IF(INS(1).EQ.ZD002.OR.INS(1).EQ.Z9002) RETURN
2731 C... *** QUICK MODE
2732 2120 INSL=INSL - 2
2733 IF(ISIZ.EQ.4) INSL= INSL - 2
2734 RETURN
2735 C
2736 C*** AND,OR
2737 C
2738 2200 RETURN
2739 C
2740 C*** EOR
2741 2300 RETURN
2742 C
2743 C*** CMP
2744 C
2745 2400 RETURN
2746 C
2747 C*** EXG
2748 C
2749 2500 RETURN
2750 C
2751 C*** CHK
2752 C
2753 2600 RETURN
2754 C
2755 C*** CMPM
2756 C
2757 2700 RETURN
2758 C
2759 C*** ADDX,SUBX
2760 C
2761 2800 RETURN
2762 C
2763 C*** ABCD,SBCD
2764 C
2765 2900 RETURN
2766 C
2767 C*** MOVEP
2768 C
2769 3000 RETURN
2770 C
2771 C*** DCNT
2772 C
2773 3200 IF(MASK2.EQ.0) INSL=4
2774 RETURN
2775 C
2776 C*** LEA
2777 C
2778 3400 RETURN
2779 C
2780 C*** SHIFTS
2781 C
2782 3500 CONTINUE
2783 IF(IADM(1,1).EQ.60.AND.ISIZ.EQ.4) INSL=INSL-2
2784 C*** ALLOW #BIT NUMBER ALSO
2785 IF(IADM(1,1).EQ.60) IADM(1,1)=56
2786 IF(IADM(1,1).EQ.56) INSL=INSL-2
2787 RETURN
2788 C
2789 C*** BIT INSTRUCTIONS
2790 C
2791 3600 CONTINUE
2792 IF(IADM(1,1).EQ.60.AND.ISIZ.EQ.4) INSL=INSL-2
2793 IF(MASK2.NE.1) RETURN
2794 I=MPUAND(INS(5),1)
2795 IF(I.EQ.0) RETURN
2796 GO TO 3930
2797 3900 IF(MASK2.NE.0) RETURN
2798 IF(INS(3).GT.7) RETURN
2799 3930 CONTINUE
2800 IF(IADM(1,2).NE.16) RETURN
2801 INSL=INSL+2
2802 IADM(1,2)=40
2803 IADM(3,2)=1
2804 RETURN
2805 C
2806 C*** MOVE INSTRUCTION
2807 C*-* TEST FOR IMMEDIATE SOURCE AND D SINK
2808 3700 CONTINUE
2809 C*** MOVEQ?
2810 IF(INS(1).EQ.Z7000) GO TO 3705
2811 IF(IADM(1,1).NE.60) RETURN
2812 IF(IADM(1,2).NE.0) RETURN
2813 C *-* MOVE #,D - CAN W USE LDQ?
2814 C
2815 IF(ISIZ.NE.4) GO TO 3710
2816 C*** FORWARD REFERENCE?
2817 IF(IADM(5,1).EQ.1) RETURN
2818 IF(INS(3).LT. -127) RETURN
2819 IF(INS(3).GT.127) RETURN
2820 C*** IS VALUE TO BIG FOR MOVEQ DEFAULT?
2821 IF(INS(2).NE.0.AND.INS(2).NE.-1) RETURN
2822 C*** DON'T DEFAULT TO MOVEQ FOR VALID 16 BIT POSITIVE #
2823 IF(INS(2).EQ.0.AND.MPUAND(TKNVAL,Z8000).NE.0) RETURN
2824 C * -* USE LDQ
2825 3705 INSL=2
2826 RETURN
2827 C
2828 C*** USE 4 BYTES FOR MOVE #,REG
2829 3710 CONTINUE
2830 INSL=4
2831 RETURN
2832 C
2833 C*** LDM,STM
2834 C
2835 3800 INSL=INSL+2
2836 RETURN
2837 C
2838 C*** ERROR RETURNS
2839 C
2840 C... *** UNDEFINED ACTION (INTERNAL ERROR)
2841 C
2842 9223 CALL ERR(223)
2843 RETURN
2844 C
2845 C*** ILLEGAL FORWARD REFERENCE
2846 C
2847 9240 CONTINUE
2848 CALL ERR(240)
2849 RETURN
2850 END
2851 SUBROUTINE EXP(NACT)
2852 CC
2853 CC NAM: EXP VER:1.00 DATE: 12/11/78 CMP: PDP-11
2854 CC SYS: MACS
2855 CC
2856 CC ENT: NACT - 1 = INITIALIZE
2857 CC 2 = OPERAND (VALUE IN TKNVAL)
2858 CC 3 = RESERVED
2859 CC 4 = OPERATOR: UNARY MINUS
2860 CC 5 = >> (SHIFT RIGHT)
2861 CC 6 = << (SHIFT LEFT)
2862 CC 7 = & (AND)
2863 CC 8 = ^ (OR)
2864 CC 9 = % (EOR)
2865 CC 10 = * (MPY)
2866 CC 11 = YMTYP/IADM(4,K (DIV)
2867 CC 12 = + (ADD)
2868 CC 13 = - (SUB)
2869 CC 14 = ( (OPEN PREN)
2870 CC 15 = ) (CLOSE PAREN)
2871 CC 16 = I- (BGN EXPR)
2872 CC 17 = -I (END EXPR)
2873 CC
2874 CC RTN: TKNVAL = VALUE OF THE EXPRESSION
2875 CC IADM(4,KSYS) = MODE OF THE RESULT
2876 CC 0 = ABSOLUTE
2877 CC 1 = RELATIVE
2878 CC KSYS=1=1ST OPERAND
2879 CC KSYS=2=2ND OPERAND
2880 CC
2881 CC FNC: PERFORMS EXPRESSION RECOGNIZE BY BOTTOM UP OPERATOR
2882 CC PRECEDENT.
2883 CC
2884 CC REV: NYMTYP/IADM(4,KA
2885 CC
2886 CCALLS MPUIOR-ERR-ISHFT-MPUAND
2887 CC
2888 CC ERROR NUMBERS CALLED: 223,237
2889 CC
2890 C*
2891 IMPLICIT INTEGER (A-Z)
2892 COMMON /A/ ISYM(3000),KARD1(96),ITOKEN(70),TKNSIZ,TKNTYP,
2893 & TKNVAL,TKNVA2,JSUC,JPTR,LPTR,NXSYM,KOLUMN,KD1BCT,KD1LNO,JERR,
2894 & MNUM,IPASS,IPC2,IPC,IOPC,INS(5),INSL,ISIZ,IADM(7,2),LUOT
2895 COMMON /A/ KASH(64),KPAC(15),KPWCT,LENSYM,KCLAS(64)
2896 COMMON /A/ NET1(64),NET2(64),NET3(64),NET4(64),NET5(64)
2897 COMMON /A/ NBPW,KSYS,IEOT,LSP,JBUF(83),KARD2(80,3),IHB480,IHEX9K
2898 COMMON /A/ IA1SHF,KCFF,LUSI,LUDI,LUOO,LLEN,IPLEN
2899 C
2900 DIMENSION STK1(20),STK2(20),FVTAB(17),ACTAB(17)
2901 DIMENSION STK11(20)
2902 C
2903 C - > < & ^ % * / + - ( ) 4 5
2904 DATA FVTAB/0,0,0,7,6,6,5,5,5,4,4,3,3,2,2,1,1/
2905 DATA ACTAB/0,0,0,3,4,4,4,4,4,4,4,4,4,2,2,1,1/
2906 C
2907 KACT=NACT-20
2908 C 1 2 3 4 5 6 7 8 9 10
2909 GO TO ( 10, 20,999,200,200,200,200,200,200,200,
2910 & 200,200,200,240,200,999,200),KACT
2911 C
2912 C*** INITIALIZE
2913 C
2914 10 NDX=1
2915 LOP=16
2916 STK1(1)=LOP
2917 RETURN
2918 C
2919 C*** OPERAND
2920 C
2921 20 NDX=NDX+1
2922 STK1(NDX)=TKNVAL
2923 STK2(NDX)=IADM(4,KSYS)
2924 C*** SAVE UPPER 2 BYTES
2925 STK11(NDX)=TKNVA2
2926 TKNVA2=0
2927 RETURN
2928 C
2929 C*** OPERATORS
2930 C
2931 200 FVOP1=FVTAB(KACT)
2932 205 IF(FVOP1.LE.FVTAB(LOP)) GO TO 1000
2933 240 LOP=KACT
2934 NDX=NDX +1
2935 STK1(NDX)=KACT
2936 RETURN
2937 C
2938 C*** UNSTACK THE OPERATION
2939 C
2940 1000 J=ACTAB(LOP)
2941 GO TO (1010,1020,1030,1040),J
2942 C
2943 C*** BEGIN EXPRESSION - END EXPRESSION
2944 C
2945 1010 TKNVAL=STK1(2)
2946 IADM(4,KSYS)=STK2(2)
2947 C*** SET POSSIBLE NUMBER >$FFFF
2948 TKNVA2=STK11(2)
2949 RETURN
2950 C
2951 C*** LEFT PAREN - RIGHT PAREN
2952 C
2953 1020 NDX=NDX-1
2954 STK1(NDX)=STK1(NDX+1)
2955 STK11(NDX)=STK11(NDX+1)
2956 STK2(NDX)=STK2(NDX+1)
2957 LOP=STK1(NDX-1)
2958 RETURN
2959 C
2960 C*** UNARY MINUS
2961 C
2962 1030 KK= STK1(NDX)
2963 S1= STK2(NDX)
2964 S2= 0
2965 KK1= STK11(NDX)
2966 C*** COMPLEMENT THE #
2967 CALL NEGATE(KK1,KK)
2968 NDX=NDX-1
2969 GO TO 3000
2970 C
2971 C** ARITHMETIC OPERATOR
2972 C
2973 1040 NDX=NDX-2
2974 A= STK1(NDX)
2975 A1=STK11(NDX)
2976 S1=STK2(NDX)
2977 B= STK1(NDX+2)
2978 B1=STK11(NDX+2)
2979 S2=STK2(NDX+2)
2980 C
2981 C*** PERFORM THE OPERATION
2982 C
2983 GO TO ( 999, 999, 999, 999,2050,2060,2070,2080, 999,
2984 & 2100,2110,2120,2130),LOP
2985 C
2986 C*** SHIFT RIGHT
2987 2050 B= -B
2988 C
2989 C***
2990 C
2991 2060 KK=ISHFT(A,B)
2992 GO TO 3000
2993 C
2994 C*** AND
2995 C
2996 2070 KK=MPUAND(A,B)
2997 GO TO 3000
2998 C
2999 C*** OR
3000 C
3001 2080 KK=MPUIOR(A,B)
3002 GO TO 3000
3003 C
3004 C*** MPY
3005 C
3006 2100 CONTINUE
3007 C*** USE REG MPY IF NEG #'S
3008 IF(B1.EQ.-1.AND.A1.EQ.-1) GO TO 2108
3009 C*** GO MPY
3010 2102 CALL MUL(A1,A,B1,B)
3011 KK=A
3012 KK1=A1
3013 GO TO 3000
3014 2108 A1=0
3015 B1=0
3016 GO TO 2102
3017 C
3018 C*** DIV
3019 C
3020 2110 CONTINUE
3021 IF(A1.EQ.-1.AND.B1.EQ.-1) GO TO 2118
3022 C*** IS IT DIV BY ZERO?
3023 IF(B.EQ.0.AND.B1.EQ.0) GO TO 2900
3024 CALL DIV(A1,A,B1,B)
3025 KK=A
3026 KK1=A1
3027 GO TO 3000
3028 2118 KK=A/B
3029 KK1=0
3030 GO TO 3000
3031 C
3032 C*** ADD
3033 C
3034 2120 CALL ADD(A1,A,B1,B)
3035 KK=A
3036 KK1=A1
3037 GO TO 3100
3038 C
3039 C*** SUB
3040 C
3041 2130 CALL SUB(A1,A,B1,B)
3042 KK=A
3043 KK1=A1
3044 IF(S1.EQ.S2) S1 =0
3045 GO TO 3200
3046 2900 KK=0
3047 KK1=0
3048 C
3049 C*** ASSURE VALID OPERATION FOR OPERAND MODES
3050 C
3051 C... *** DISALLOW REL,XXX
3052 3000 IF(S1.EQ.0) GO TO 3100
3053 IF(IPASS.GE.0) CALL ERR(237)
3054 C... *** DISALLOW XXX,REL
3055 3100 IF(S2.EQ.0) GO TO 3200
3056 IF(IPASS.GE.0) CALL ERR(237)
3057 C
3058 C... *** ALLOW ANY MODE
3059 C
3060 3200 STK1(NDX)=KK
3061 STK2(NDX)=S1
3062 STK11(NDX)=KK1
3063 LOP=STK1(NDX-1)
3064 GO TO 205
3065 C
3066 C*** ERROR EXIT
3067 C
3068 999 CALL ERR(223)
3069 RETURN
3070 END
3071 SUBROUTINE RANGE(KK)
3072 CC NAM: RANGE VER: 1.0 DAT: 12/08/78 CMP: 16-BIT
3073 CC
3074 CC SYS: MACS
3075 CC
3076 CC ENT: KK - NUMERIC VALUE TO BE CHECKED FOR SIZE
3077 CC
3078 CC RTN: KK - N/C
3079 CC
3080 CC FNC: VALIDATE NUMERIC RANGE VALUES IN #N TYPE STATEMENTS
3081 CC
3082 CC REL: N/A
3083 CC
3084 CCALLS ERR-ISHFT
3085 CC
3086 CC ERROR NUMBERS CALLED: 210
3087 CC
3088 C*
3089 IMPLICIT INTEGER (A-Z)
3090 COMMON /A/ ISYM(3000),KARD1(96),ITOKEN(70),TKNSIZ,TKNTYP,
3091 & TKNVAL,TKNVA2,JSUC,JPTR,LPTR,NXSYM,KOLUMN,KD1BCT,KD1LNO,JERR,
3092 & MNUM,IPASS,IPC2,IPC,IOPC,INS(5),INSL,ISIZ,IADM(7,2),LUOT
3093 COMMON /A/ KASH(64),KPAC(15),KPWCT,LENSYM,KCLAS(64)
3094 COMMON /A/ NET1(64),NET2(64),NET3(64),NET4(64),NET5(64)
3095 COMMON /A/ NBPW,KSYS,IEOT,LSP,JBUF(83),KARD2(80,3),IHB480,IHEX9K
3096 COMMON /A/ IA1SHF,KCFF,LUSI,LUDI,LUOO,LLEN,IPLEN
3097 KKK=KK
3098 IF(ISIZ.EQ.128) RETURN
3099 C*** WORD OR BYTE?
3100 IF(ISIZ.EQ.0) GO TO 100
3101 C*** CHECK UPPER 2 BYTES
3102 IF(TKNVA2.EQ.0) RETURN
3103 IF(TKNVA2.NE.-1) GO TO 210
3104 RETURN
3105 100 CONTINUE
3106 C
3107 IF(TKNVA2.GT.0) GO TO 210
3108 JJ=ISHFT(KKK,-8)
3109 IF(JJ.EQ.0) RETURN
3110 IF(JJ.EQ.255) RETURN
3111 210 CALL ERR(210)
3112 RETURN
3113 END
3114 SUBROUTINE ACT2(KMD)
3115 CC NAM: ACT2 VER: 1.0 DAT: 12/08/78 CMP: 16-BIT
3116 CC
3117 CC SYS: MACS
3118 CC
3119 CC ENT: KMD - EQUALS ACTION TO BE TAKEN AS FOUND
3120 CC IN THE PARSE TABLE.
3121 CC
3122 CC RTN: N/C
3123 CC
3124 CC FNC: P A S S T W O A C T I O N S
3125 CC ------------------------------
3126 CC PERFORM THE ACTIONS FOR THE DIFFERENT "TOKENS"
3127 CC ENCOUNTERED DURING THE STATEMENT SCAN.
3128 CC SETS UP 'IADM' TABLE, ENTERS EXP IN EXP TABLE.
3129 CC
3130 CC THIS ROUTINE IS 16-BIT DEPENDENT DUE TO THE CHECK ON
3131 CC 'TKNVA2' FOR THE 2 MOST SIGNIFICANT BYTES OF A 32-BIT #.
3132 CC INTEGER CONSTANT 192=$C0, 128=$80($=HEX).
3133 CC
3134 CC REV: N/A
3135 CC
3136 CCALLS ERR-LKP-SCN-OUTPUT-RANGE-MASK-EXP-MPUGTC
3137 CC IABS-ISHFT-MPUAND-MPUIOR
3138 CC
3139 CC ERROR NUMBERS CALLED: 205,206,207,208,209,212,213,214,219,227
3140 CC 228,231,234,235
3141 C*
3142 IMPLICIT INTEGER (A-Z)
3143 COMMON /A/ ISYM(3000),KARD1(96),ITOKEN(70),TKNSIZ,TKNTYP,
3144 & TKNVAL,TKNVA2,JSUC,JPTR,LPTR,NXSYM,KOLUMN,KD1BCT,KD1LNO,JERR,
3145 & MNUM,IPASS,IPC2,IPC,IOPC,INS(5),INSL,ISIZ,IADM(7,2),LUOT
3146 COMMON /A/ KASH(64),KPAC(15),KPWCT,LENSYM,KCLAS(64)
3147 COMMON /A/ NET1(64),NET2(64),NET3(64),NET4(64),NET5(64)
3148 COMMON /A/ NBPW,KSYS,IEOT,LSP,JBUF(83),KARD2(80,3),IHB480,IHEX9K
3149 COMMON /A/ IA1SHF,KCFF,LUSI,LUDI,LUOO,LLEN,IPLEN
3150 COMMON /A/LIST,ICOL,NEST
3151 DIMENSION NSZF(40),NSZ(40),MREL(40)
3152 EQUIVALENCE(IADM(4,1),SYMTYP),(IADM(5,1),LFRF)
3153 DATA LB/66/,LW/87/,LL/76/,LAP/39/
3154 DATA LS/83/
3155 C*** 0 = UNSIZED INSTRUCTION
3156 C*** 1 = B,W,L ALLOWED
3157 C*** 2 = B ONLY
3158 C*** 66 = W ONLY
3159 C*** 130 = L ONLY
3160 C*** SIZE SUBFIELD ALLOWED? ***
3161 DATA NSZF/
3162 & 0,0,0,1,1,0,66,0,1,2,130,0,-1,1,1,2,0,0,0,66,
3163 & 1,1,1,1,130,66,1,1,2,1,0,0,1,130,1,1,1,1,1,0/
3164 C OPCODE SIZES 01 02 03 04 05 06 07 08 09 10
3165 C*** 01-10
3166 DATA NSZ/ 0, 2, 0,-1,-1,-1, 2,-1,-1,-1,
3167 & -1,-1,-1,-1, 2,-1,-1, 0, 0,-1,
3168 & -1,-1,-1,-1, 2,-1, 2, 2, 2,-1,
3169 & 0,-1, 2,-1,-1,-1,-1,-1,-1, 0/
3170 C USE PC REL? 01 02 03 04 05 06 07 08 09 10
3171 C*** 01-10
3172 DATA MREL/ 0, 0, 0, 0,-1, 0, 0, 0, 1, 1,
3173 & 1, 1,-1, 1, 1, 1, 1, 0, 0, 1,
3174 & 1, 1, 1, 1, 0, 0, 0, 0, 0, 1,
3175 & 0,-1, 0, 1, 0, 1, 1, 1, 1, 0/
3176 DATA Z8000/O100000/
3177 C
3178 GO TO(100,200,300,400,500,600,700,800,800,
3179 & 1000,1100,1200,1300,1400,1500,1600,1700),KMD
3180 C*** EXPRESSION ACTION
3181 CALL EXP(KMD)
3182 RETURN
3183 C
3184 C*** STATEMENT LABEL
3185 C
3186 100 CALL LKP(1,LSUC,LPTR)
3187 IF(LSUC.LE.0) RETURN
3188 IR=ISYM(LPTR)
3189 KR=MPUAND(IR,192)
3190 C
3191 C*** SAVE FOR BUILD2
3192 ITOKEN(69)=LSUC
3193 IF(KR.NE.192) GO TO 110
3194 C*** REDEFINED SYMBOL
3195 CALL ERR(206)
3196 RETURN
3197 C
3198 C*** DEFINE FOR PASS TWO
3199 110 ISYM(LPTR)= MPUAND(IR,63) + 128
3200 C
3201 RETURN
3202 C
3203 C*** OPCODE
3204 C
3205 200 KSYS=1
3206 IF(JSUC.GT.0) GO TO 210
3207 C*** ERROR 207 - UNDEFINED OP-CODE
3208 CALL ERR(207)
3209 KOLUMN=0
3210 RETURN
3211 C *** MACRO DEFINITION?
3212 210 IF(IOPC.GT.0) GO TO 260
3213 IF(IOPC.EQ.0) GO TO 265
3214 C *** LOOK FOR ENDM
3215 230 KOLUMN=-1
3216 LPTR=0
3217 IOPC=0
3218 CALL SCN
3219 IF(TKNTYP.NE.30) GO TO 230
3220 IF(IOPC.GE.0) GO TO 230
3221 C*** ASSURE NOT MEXIT
3222 IF(INS(1).EQ.2) GO TO 230
3223 KOLUMN=0
3224 RETURN
3225 C *** NEED OPERAND FIELD?
3226 260 CONTINUE
3227 INSL=NSZ(IOPC)
3228 JNSL=INSL
3229 IF(IOPC.GE.4) GO TO 270
3230 C *** OPERAND FIELD NOT NEEDED
3231 265 KOLUMN=0
3232 RETURN
3233 270 IADM(1,1)=-1
3234 IADM(3,2)=0
3235 IADM(1,2)=-1
3236 IADM(6,1)=0
3237 IADM(6,2)=0
3238 ISIZ=64
3239 C*** ALLOW .B ONLY FOR BIT INSTRUCTIONS
3240 IF(IOPC.EQ.36) ISIZ=0
3241 IADM(4,1)=0
3242 IADM(4,2)=0
3243 IADM(5,2)=0
3244 LFRF=0
3245 CALL EXP(21)
3246 RETURN
3247 C
3248 C*** DATA SIZE
3249 C
3250 C
3251 300 KK=NSZF(IOPC)
3252 C
3253 IF(KK.GT.0) GO TO 310
3254 C
3255 C*** IS "S" ALLOWED?
3256 IF(KK.EQ.0) GO TO 305
3257 C
3258 IF(ITOKEN(1).NE.LS) GO TO 390
3259 C*** ALLOW "S"
3260 ISIZ=0
3261 RETURN
3262 C
3263 C *** ERROR - SIZE SUBFIELD NOT ALLOWED FOR THIS OPCODE
3264 305 CALL ERR(205)
3265 RETURN
3266 310 IF(TKNSIZ.NE.1) GO TO 390
3267 IF(ITOKEN(1).NE.LB) GO TO 320
3268 ISIZ=0
3269 GO TO 395
3270 320 IF(ITOKEN(1).NE.LL) GO TO 330
3271 ISIZ=128
3272 GO TO 395
3273 330 IF(ITOKEN(1).EQ.LW) GO TO 392
3274 C *** ERROR - UNKNOWN DATA SIZE SPECIFIED
3275 390 CALL ERR(212)
3276 RETURN
3277 392 ISIZ=64
3278 395 CONTINUE
3279 C*** IF ALL 3 SIZES ALLOWED, SKIP
3280 IF(KK.EQ.1) RETURN
3281 IF(ISIZ.NE.KK-2) CALL ERR(238)
3282 RETURN
3283 C
3284 C*** COMMA STARTING FIELD-2 OPERAND ***
3285 C
3286 C
3287 400 CALL EXP(21)
3288 IF(IOPC.NE.4) GO TO 410
3289 C*** DC - FORCE OUT
3290 CALL OUTPUT
3291 INSL=-1
3292 RETURN
3293 C
3294 410 CONTINUE
3295 IF(KSYS.EQ.2) GO TO 420
3296 C*** CHECK FOR 'LINK' - 20048 = $4E50 = LINK
3297 IF(IOPC.EQ.6.AND.INS(1).EQ.20048) GO TO 430
3298 IF(IOPC.GE.19) GO TO 430
3299 C *** OPCODE REQUIRES ONLY ONE OPERAND
3300 420 CALL ERR(219)
3301 KOLUMN=0
3302 RETURN
3303 C+++ MOVE REG,MODE TO SS 2
3304 430 KSYS=2
3305 TKNVA2=0
3306 RETURN
3307 C
3308 C*** OPERAND - REGISTER
3309 C
3310 500 IADM(1,KSYS)=0
3311 JR=ISYM(JPTR+1)
3312 IADM(2,KSYS)=JR
3313 C
3314 C *** STATUS REGISTER?
3315 IF(JR.LE.15) GO TO 510
3316 C *** DEFINE AS STATUS REGISTER
3317 IADM(1,KSYS)=64
3318 RETURN
3319 C *** ADDR REGISTER?
3320 510 IF(JR.GT.7) IADM(1,KSYS)=8
3321 IF(IOPC.EQ.38) CALL MASK(JR)
3322 RETURN
3323 C
3324 C*** REGISTER INDIRECT MODE ***
3325 C
3326 600 IADM(1,KSYS)=16
3327 GO TO 900
3328 C
3329 C*** POST INCREMENT ***
3330 C
3331 700 IADM(1,KSYS)=24
3332 RETURN
3333 C
3334 C*** PRE DECREMENT ***
3335 C
3336 800 IADM(1,KSYS)=32
3337 C
3338 C*** REGISTER OF (A1) ADDRESSING MODE ***
3339 C
3340 900 JR=ISYM(JPTR+1)
3341 910 IF(JR.GT.7) GO TO 920
3342 C *** ERROR - REGISTER INDIRECT SPECIFIES DATA REGISTER.
3343 CALL ERR(213)
3344 RETURN
3345 920 IADM(2,KSYS)=JR
3346 RETURN
3347 C
3348 C*** IMMEDIATE OPERAND ***
3349 C
3350 1000 IADM(1,KSYS)=60
3351 CALL EXP(37)
3352 C
3353 CALL RANGE(TKNVAL)
3354 1006 IF(INSL.GT.0) GO TO 1010
3355 C *** DETERMINE OPERAND SIZE
3356 INSL=4
3357 IF(ISIZ.NE.128) GO TO 1008
3358 INSL=6
3359 C+++ 16-BIT - GET NEXT 2 BYTES
3360 INS(2)=TKNVA2
3361 1008 INS(3)=TKNVAL
3362 RETURN
3363 C *** SECOND OPERAND FIELD
3364 1010 IF(JNSL.GE.0) GO TO 1190
3365 IADM(3,2)=2
3366 IF(ISIZ.EQ.128) IADM(3,2)=4
3367 INSL=INSL+ IADM(3,2)
3368 C+++ IN CASE 16-BITS GET REST OF #
3369 INS(4)=TKNVA2
3370 INS(5)=TKNVAL
3371 RETURN
3372 C
3373 C*** DISPLACEMENT ***
3374 C
3375 C
3376 1100 CALL EXP(37)
3377 KM=56
3378 KL=2
3379 C*** RELOCATABLE SYMBOL
3380 RTYP=MREL(IOPC)
3381 C
3382 IF(RTYP.LE.0) GO TO 1110
3383 C *** IS EXPRESSION ABSOLUTE?
3384 IF(IADM(4,KSYS).EQ.0) GO TO 1110
3385 C
3386 IF(IADM(7,2).EQ.1.AND.IADM(5,KSYS).GT.0) CALL ERR(231)
3387 K=INSL
3388 IF(K.LT.0) K=2
3389 C*** TKNVAL=TKNVAL - IPC - K
3390 C*** SUBTRACT IPC FROM TKNVAL
3391 CALL SUB(TKNVA2,TKNVAL,IPC2,IPC)
3392 C*** NOW SUBTRACT K
3393 CALL SUB(TKNVA2,TKNVAL,0,K)
3394 KM=58
3395 C*** TEST FOR VALID NEG#
3396 IF(TKNVA2.EQ.-1) GO TO 1120
3397 C
3398 C*** TEST FOR GREATER THAN 2 BYTES INSTEAD OF ONE(32767 NOT 127)
3399 IF(TKNVA2.NE.0) CALL ERR(208)
3400 GO TO 1120
3401 C*** ABSOLUTE SYMBOL, FIND ITS SIZE
3402 1110 CONTINUE
3403 C*** BACK OR FORWARD REF?
3404 IF(IADM(5,KSYS).EQ.0) GO TO 1112
3405 C*** IS LONG OR SHORT FWD REF IN USE - ORG.L?
3406 IF(IADM(7,2).EQ.1) GO TO 1115
3407 C*:: NOT ORG.L, CHECK SIZE OF FORWARD ADDRESS
3408 IF(TKNVA2.EQ.0) GO TO 1120
3409 C*** DON'T GIVE ERROR FOR BCC, IT WILL BE CAUGHT LATER IF VALID ERR.
3410 IF(IOPC.EQ.13) GO TO 1120
3411 C*** VALID NEGATIVE #?
3412 IF(TKNVA2.EQ.-1) GO TO 1120
3413 C*** DC?
3414 IF(IOPC.EQ.4) GO TO 1120
3415 C*** ERROR - FORWARD REFERENCE IS LONG ABSOLUTE
3416 CALL ERR(210)
3417 GO TO 1120
3418 C*** BAKWARDS REF, CHECK SIZE OF VALUE
3419 C*** VALID NEG #?
3420 1112 IF(TKNVA2.EQ.-1) GO TO 1120
3421 C*** CHECK FOR ADDRESS FF8000-FFFFFF
3422 I=MPUAND(TKNVAL,Z8000)
3423 IF(I.EQ.Z8000.AND.TKNVA2.EQ.KCFF) GO TO 1120
3424 IF(TKNVA2.NE.0) GO TO 1115
3425 C*** ADDRESS >$7FFF IS LONG
3426 IF(I.EQ.0) GO TO 1120
3427 1115 KM=57
3428 KL=4
3429 C *** SAVE ADDRESS MODE AND VALUE
3430 1120 IADM(1,KSYS)=KM
3431 IF(INSL.GT.0) GO TO 1130
3432 C *** FIRST FIELD
3433 INSL=KL + 2
3434 C+++ 16-BIT - TKNVA2 IS ALWAYS ZEROED AT START OF SOURCE LINE
3435 C IN CASE CURRENT # IS NOT BIG ENOUGH TOGO THERE
3436 INS(2)=TKNVA2
3437 C
3438 INS(3)=TKNVAL
3439 KOPN=3
3440 RETURN
3441 C
3442 C
3443 C *** SECOND FIELD
3444 1130 IF(JNSL.GE.0) GO TO 1190
3445 C
3446 INSL=INSL + KL
3447 IADM(3,2)=KL
3448 INS(4)=TKNVA2
3449 C
3450 INS(5)=TKNVAL
3451 KOPN=5
3452 RETURN
3453 C
3454 C*** ERROR - INSTRUCTION DOESN'T ALLOW THIS MODE
3455 1190 CALL ERR(234)
3456 C
3457 RETURN
3458 C
3459 C
3460 C
3461 C*** REGISTER FOR 3(A1) ADDRESSING MODE ***
3462 C
3463 1200 JR=ISYM(JPTR+1)
3464 C
3465 C*** IN CASE UJNDEFINEDS ARE PRESENT COUNT MAY BE OFF
3466 IF(INSL.EQ.10.AND.IADM(7,2).EQ.0) INSL=8
3467 C*** SWITCH VALUE TO PRINT IF ORG.L IN SOME CASES
3468 IF(IADM(3,2).EQ.4) IADM(3,2)=2
3469 C*** HAS LONG FORWARD REF BEEN SET?
3470 IF(IADM(1,KSYS).EQ.57) INSL=INSL-2
3471 IF(IADM(1,KSYS).EQ.58) GO TO 1220
3472 C*** ABSOLUTE SYMBOL
3473 IF(TKNVA2.EQ.0) GO TO 1210
3474 C*** VALID NEG #?
3475 IF(TKNVA2.EQ.-1) GO TO 1210
3476 C *** ERROR - 32 BIT DISPLACEMENT
3477 CALL ERR(208)
3478 C*** RESET TO SHORT ADDRESS
3479 IADM(1,KSYS)=56
3480 RETURN
3481 1210 IADM(1,KSYS)=40
3482 GO TO 910
3483 C *** (PC) RELATIVE ADDRESS MODE - USE (PC)+X+D
3484 1220 IADM(1,KSYS)=59
3485 GO TO 1410
3486 C
3487 C*** .L FOR 3(A1.L) ADDRESSING MODE ***
3488 C
3489 1300 IF(TKNSIZ.NE.1) GO TO 1310
3490 C*** ALLOW WORD .W
3491 IF(ITOKEN(1).EQ.LW) RETURN
3492 IF(ITOKEN(1).EQ.LL) GO TO 1310
3493 C *** ERROR - SIZE FOR TAG(A1.L) IS NOT L
3494 CALL ERR(214)
3495 RETURN
3496 1310 IF(IADM(1,KSYS).EQ.48) GO TO 1320
3497 IF(IADM(1,KSYS).EQ.59) GO TO 1320
3498 C *** ERROR - ILLEGAL ADDRESS MODE
3499 CALL ERR(209)
3500 RETURN
3501 1320 INS(KOPN)=INS(KOPN) + 2048
3502 RETURN
3503 C
3504 C*** SECOND REGISTER FOR 3(A1,A2) ADDRESSING MODE ***
3505 C
3506 1400 JR=ISYM(JPTR+1)
3507 IF(IADM(4,KSYS).NE.0) CALL ERR(231)
3508 IADM(1,KSYS)=48
3509 1410 IF(IABS(TKNVAL).GT.128) CALL ERR(208)
3510 INS(KOPN)=ISHFT(JR,12) + MPUAND(TKNVAL,255)
3511 RETURN
3512 C
3513 C*** SECOND REGISTER OF R1-R2 FOR LDM,STM
3514 C
3515 1500 IF(IOPC.EQ.38) GO TO 1510
3516 C *** ERROR - NOT LDM,STM
3517 CALL ERR(227)
3518 RETURN
3519 1510 KR=ISYM(JPTR+1)
3520 IF(JR.GT.KR) GO TO 1530
3521 DO 1520 J=JR,KR
3522 JJ=J
3523 1520 CALL MASK(JJ)
3524 RETURN
3525 1530 DO 1540 J=KR,JR
3526 JJ=J
3527 1540 CALL MASK(JJ)
3528 RETURN
3529 C
3530 C*** 'STRING' OVER 4 BYTES LONG
3531 C
3532 1600 INS(3)=TKNSIZ
3533 RETURN
3534 C
3535 C*** CONSTANT OR VARIABLE OPERAND ***
3536 C
3537 1700 CONTINUE
3538 IADM(4,KSYS)=0
3539 IF(TKNTYP.EQ.24) GO TO 1710
3540 C *** CONSTANT OPERAND
3541 C
3542 IF(TKNTYP.NE.42) GO TO 1730
3543 C*** ASTERISKS
3544 TKNVAL=IPC
3545 C+++ 16-BIT - UPPER BYTE.
3546 TKNVA2=IPC2
3547 IADM(4,KSYS)=IADM(7,1)
3548 GO TO 1730
3549 C *** DEFINED PREVIOUSLY?
3550 1710 IF(JSUC.GT.0) GO TO 1720
3551 C *** INTERNAL ERROR - MISSING SYMBOL
3552 CALL ERR(228)
3553 GO TO 1730
3554 1720 TKNVAL=ISYM(JPTR+1)
3555 KK=ISYM(JPTR)
3556 C+++ 16-BIT - GET M.S.B.
3557 TKNVA2=ISYM(JSUC)
3558 C
3559 C*** IS SYMBOL RELOCATABLE?
3560 IF(MPUAND(KK,7).EQ.1) IADM(4,KSYS)=1
3561 KK=MPUAND(KK,192)
3562 C
3563 C*** UNDEFINED SYMBOL?
3564 IF(KK.NE.0) GO TO 1725
3565 CALL ERR(207)
3566 C*** FORCE LONG ADDR FOR UNDEF A DISPLACEMENT CALC TO AVOID PHASE PROB
3567 KK=64
3568 C*** SET UNDEFINED FLAG
3569 IADM(5,KSYS)=2
3570 1725 CONTINUE
3571 C*** REDEFINED SYMBOL?
3572 IF(KK.EQ.192) CALL ERR(206)
3573 C*** FORWARD REFERENCE?
3574 IF(KK.EQ.64) IADM(5,KSYS)=MPUIOR(IADM(5,KSYS),1)
3575 C*** GIVE OPERAND TO EXP
3576 1730 CALL EXP(22)
3577 RETURN
3578 END
3579 SUBROUTINE MASK(JR)
3580 CC NAM: MASK VER: 1.0 DAT: 12/08/78 CMP: ALL
3581 CC
3582 CC SYS: MACS
3583 CC
3584 CC ENT: JR - MASK TO BE SHIFTED
3585 CC
3586 CC RTN: JR - N/C
3587 CC
3588 CC FNC: FORMAT REGISTER BIT MASK FOR LDM,STM
3589 CC
3590 CC REV: N/A
3591 CC
3592 CCALLS ISHFT-MPUIOR
3593 CC
3594 C*
3595 IMPLICIT INTEGER (A-Z)
3596 COMMON /A/ ISYM(3000),KARD1(96),ITOKEN(70),TKNSIZ,TKNTYP,
3597 & TKNVAL,TKNVA2,JSUC,JPTR,LPTR,NXSYM,KOLUMN,KD1BCT,KD1LNO,JERR,
3598 & MNUM,IPASS,IPC2,IPC,IOPC,INS(5),INSL,ISIZ,IADM(7,2),LUOT
3599 COMMON /A/ KASH(64),KPAC(15),KPWCT,LENSYM,KCLAS(64)
3600 COMMON /A/ NET1(64),NET2(64),NET3(64),NET4(64),NET5(64)
3601 COMMON /A/ NBPW,KSYS,IEOT,LSP,JBUF(83),KARD2(80,3),IHB480,IHEX9K
3602 COMMON /A/ IA1SHF,KCFF,LUSI,LUDI,LUOO,LLEN,IPLEN
3603 C
3604 IB=ISHFT(1,JR)
3605 IADM(6,1)=MPUIOR(IADM(6,1),IB)
3606 C
3607 KR=15 -JR
3608 IB=ISHFT(1,KR)
3609 IADM(6,2)=MPUIOR(IADM(6,2),IB)
3610 RETURN
3611 END
3612 SUBROUTINE MOD2
3613 CC NAM: MOD2 VER: 1.0 DAT: 12/08/78 CMP: PDP-11
3614 CC
3615 CC SYS: MACS
3616 CC
3617 CC ENT: N/A
3618 CC
3619 CC RTN: N/A
3620 CC
3621 CC FNC: FORCE TO AN EVEN WORD BOUNDARY
3622 CC
3623 CC REV: N/A
3624 CC
3625 CCALLS MPUAND-ADD
3626 CC
3627 C*
3628 IMPLICIT INTEGER (A-Z)
3629 COMMON /A/ ISYM(3000),KARD1(96),ITOKEN(70),TKNSIZ,TKNTYP,
3630 & TKNVAL,TKNVA2,JSUC,JPTR,LPTR,NXSYM,KOLUMN,KD1BCT,KD1LNO,JERR,
3631 & MNUM,IPASS,IPC2,IPC,IOPC,INS(5),INSL,ISIZ,IADM(7,2),LUOT
3632 C
3633 IF(MPUAND(IPC,1).EQ.0) RETURN
3634 C*** IPC=IPC+1 - ADD ALL 24 BITS
3635 CALL ADD(IPC2,IPC,0,1)
3636 IF(LPTR.EQ.0) RETURN
3637 ISYM(LPTR+1)=IPC
3638 I=ITOKEN(69)
3639 ISYM(I)=IPC2
3640 C*** FORWARD REF IS ON ODD BYTE
3641 CALL ERR(230)
3642 RETURN
3643 END
3644 SUBROUTINE OUTPUT
3645 CC NAM: OUTPUT VER: 1.0 DAT: 12/08/78 CMP: PDP-11
3646 CC
3647 CC SYS: MACS
3648 CC
3649 CC ENT: N/A
3650 CC
3651 CC RTN: N/C
3652 CC
3653 CC FNC: OUTPUT THE CURRENT INSTRUCTION.
3654 CC
3655 CC REV: N/A
3656 CC
3657 CCALLS BUILD1-BUILD2-PAGE-PCOUNT-OBJ-MPUCA1-MPUAND-ERR-MOD2
3658 CC HEXASC
3659 CC
3660 CC ERROR NUMBERS CALLED: 230
3661 CC
3662 C*
3663 IMPLICIT INTEGER (A-Z)
3664 COMMON /A/ ISYM(3000),KARD1(96),ITOKEN(70),TKNSIZ,TKNTYP,
3665 & TKNVAL,TKNVA2,JSUC,JPTR,LPTR,NXSYM,KOLUMN,KD1BCT,KD1LNO,JERR,
3666 & MNUM,IPASS,IPC2,IPC,IOPC,INS(5),INSL,ISIZ,IADM(7,2),LUOT
3667 COMMON /A/ KASH(64),KPAC(15),KPWCT,LENSYM,KCLAS(64)
3668 COMMON /A/ NET1(64),NET2(64),NET3(64),NET4(64),NET5(64)
3669 COMMON /A/ NBPW,KSYS,IEOT,LSP,JBUF(83),KARD2(80,3),IHB480,IHEX9K
3670 COMMON /A/ IA1SHF,KCFF,LUSI,LUDI,LUOO,LLEN,IPLEN
3671 COMMON /A/ LIST,ICOL,NEST,LUCI,LULT,MFLD(11,3),IOBJ,LLENSW
3672 EQUIVALENCE(INS(1),INS1)
3673 DIMENSION KRDOUT(95)
3674 DIMENSION INS1A(4),INS2(4),INS3(4),INS4(4),INS5(4),IPC22(2),
3675 & IPC1(4)
3676 DATA LSPHEX/' ' /
3677 C*** PUT OUT INSTRUCTION OR SPECIAL PRINT.
3678 C*** REGULAR INSTRUCTION
3679 1 CONTINUE
3680 C
3681 C*** ARE WE IN A MACRO DEFINITION?
3682 IF(ICOL.EQ. -1) INSL=0
3683 C... *** FINISH BUILDING THE INSTRUCTION.
3684 IF(IPASS.GE.0) GO TO 3
3685 C*** ARE WE IN IFXX?
3686 IF(ICOL.LT.0) GO TO 17
3687 CALL BUILD1
3688 17 CONTINUE
3689 C
3690 C*** DEBUG
3691 C
3692 I=2
3693 CALL DEBUG(I)
3694 IF(I.EQ.1) GO TO 5
3695 C*** END DEBUG
3696 18 IF(JERR.GT.0) GO TO 5
3697 GO TO 900
3698 3 CONTINUE
3699 C*** ARE WE IN IFXX?
3700 IF(ICOL.LT.0) GO TO 5
3701 CALL BUILD2
3702 CALL OBJ
3703 5 II=1
3704 C*** HAS THE LINE ALREADY BEEN PRINTED?
3705 IF(KARD1(1).EQ.0) GO TO 1000
3706 KD1BCT=LLEN-25
3707 C*** NOLIST ON?
3708 6 IF(LIST.EQ.0) GO TO 500
3709 C*** SKIP ADJUSTMENT IF REMARK
3710 IF(KARD1(1).EQ.42) GO TO 8000
3711 C*** SHOULD OUTPUT BE PRETTILY ADJUSTED??
3712 IF(LLENSW.EQ.0) GO TO 8000
3713 C*** ADJUST OUTPUT TO SPECIFIC COLUMNS
3714 C*** IS THERE A LABEL?
3715 DO 7000 I=1,KD1BCT
3716 7000 KRDOUT(I)=LSP
3717 I=1
3718 IPOS=1
3719 IF(KARD1(1).EQ.LSP) GO TO 7050
3720 DO 7010 I=1,31
3721 KRDOUT(I)=KARD1(I)
3722 IPOS=I+1
3723 IF(KARD1(I).EQ.LSP) GO TO 7050
3724 7010 CONTINUE
3725 C*** IF HERE 31ST CHAR NOT BLANK
3726 KRDOUT(32)=LSP
3727 C*** FIND END OF LABEL
3728 J=I
3729 DO 7020 I=J,KD1BCT
3730 IF(KARD1(I).EQ.LSP) GO TO 7050
3731 7020 CONTINUE
3732 GO TO 8100
3733 7050 CONTINUE
3734 C*** FIND MNEMONIC
3735 J=I+1
3736 DO 7100 I=J,KD1BCT
3737 IF(KARD1(I).NE.LSP) GO TO 7150
3738 7100 CONTINUE
3739 GO TO 8100
3740 C*** MNEMONIC
3741 7150 CONTINUE
3742 IF(IPOS.LT.10) IPOS=10
3743 DO 7200 K=IPOS,KD1BCT
3744 KRDOUT(K)=KARD1(I)
3745 IF(KARD1(I).EQ.LSP) GO TO 7250
3746 I=I+1
3747 7200 CONTINUE
3748 GO TO 8100
3749 7250 CONTINUE
3750 IPOS=K+1
3751 C*** OPCODE
3752 C*** REMOVE ANY EXCESS BLANKS BETWEEN MNEMONIC & OPERAND.
3753 DO 7260 K=I,KD1BCT
3754 IF(KARD1(K).NE.LSP) GO TO 7280
3755 7260 CONTINUE
3756 GO TO 8100
3757 7280 I=K
3758 J=0
3759 IF(IPOS.LT.18) IPOS=18
3760 DO 7300 K=IPOS,KD1BCT
3761 IF(KARD1(I).EQ.IEOT) GO TO 8100
3762 C*** CHECK FOR ' '
3763 IF(KARD1(I).EQ.39) J=J+1
3764 C*** IS IT 1ST '?
3765 IF(MOD(J,2).NE.0) GO TO 7290
3766 IF(KARD1(I).EQ.LSP) GO TO 7350
3767 7290 KRDOUT(K)=KARD1(I)
3768 I=I+1
3769 7300 CONTINUE
3770 GO TO 8100
3771 7350 CONTINUE
3772 C*** REMARKS
3773 C*** REMOVE ANY EXCESS BLANKS BETWEEN OPERAND AND REMARKS.
3774 DO 7360 J=I,KD1BCT
3775 IF(KARD1(J).NE.LSP) GO TO 7380
3776 7360 CONTINUE
3777 GO TO 8100
3778 7380 CONTINUE
3779 I=J
3780 IF(J.LT.40) J=40
3781 IF(K.GT.40) J=K+1
3782 DO 7400 K=J,KD1BCT
3783 IF(KARD1(I).EQ.IEOT) GO TO 8100
3784 KRDOUT(K)=KARD1(I)
3785 I=I+1
3786 7400 CONTINUE
3787 GO TO 8100
3788 8000 DO 8 J=1,KD1BCT
3789 8 KRDOUT(J)=KARD1(J)
3790 8100 CONTINUE
3791 C WRITE(LUOT,9999) INSL,(INS(I),I=1,5)
3792 9999 FORMAT(' OUTPUT-INSL,INS=',I3,5O8)
3793 CALL HEXASC(INS(1),INS1A,4,1)
3794 CALL HEXASC(INS(2),INS2,4,1)
3795 CALL HEXASC(INS(3),INS3,4,1)
3796 CALL HEXASC(INS(4),INS4,4,1)
3797 CALL HEXASC(INS(5),INS5,4,1)
3798 CALL HEXASC(IPC2,IPC22,2,1)
3799 CALL HEXASC(IPC,IPC1,4,1)
3800 IF(INSL.EQ.0) GO TO 10
3801 IF(INSL.LT.0) GO TO 20
3802 C*** 20 = SPC
3803 IF(INSL.EQ.20) GO TO 950
3804 GO TO(100,200,200,400,400,600,600,880,80),INSL
3805 C*** 5 WORD INSTRUCTION
3806 WRITE(LUOT,999) KD1LNO,IPC22,IPC1,INS1A,INS2,INS3,INS4,INS5
3807 & , (KRDOUT(J),J=1,KD1BCT)
3808 GO TO 690
3809 C*** FOUR WORD INSTRUCTION
3810 880 IF(IADM(3,2).EQ.2) GO TO 770
3811 C... *** LONG INTEGER IN INS(5)
3812 WRITE(LUOT,2999) KD1LNO,IPC22,IPC1,INS1A,INS3,INS4,INS5,
3813 & (KRDOUT(J),J=1,KD1BCT)
3814 GO TO 690
3815 C.. *** SHORT INTEGER IN INS(5)
3816 770 WRITE(LUOT,1999) KD1LNO,IPC22,IPC1,INS1A,INS2,INS3,INS5,
3817 & (KRDOUT(J),J=1,KD1BCT)
3818 GO TO 690
3819 C*** THREE WORD INSTRUCTION
3820 600 IF(IADM(3,2).EQ.0) GO TO 660
3821 C... *** SHORT INTEGER IN INS(5)
3822 WRITE(LUOT,1998) KD1LNO,IPC22,IPC1,INS1A,INS3,INS5,
3823 & (KRDOUT(J),J=1,KD1BCT)
3824 GO TO 700
3825 C... *** NO INTEGER IN INS(5) - INS(3) ONLY
3826 660 WRITE(LUOT,998) KD1LNO,IPC22,IPC1,INS1A,INS2,INS3,
3827 & (KRDOUT(J),J=1,KD1BCT)
3828 GO TO 700
3829 C
3830 500 CONTINUE
3831 IF(INSL.EQ.0) GO TO 800
3832 IF(INSL.LT.0) GO TO 540
3833 C*** CHECK FOR SPC
3834 IF(INSL.EQ.20) GO TO 980
3835 GO TO (800,700,700,700,700,700,700,700,78),INSL
3836 GO TO 700
3837 540 IF(INSL.NE.-1) GO TO 35
3838 GO TO 800
3839 C*** TWO WORD INSTRUCTION
3840 400 WRITE(LUOT,997) KD1LNO,IPC22,IPC1,INS1A,INS3,
3841 & (KRDOUT(J),J=1,KD1BCT)
3842 GO TO 700
3843 C*** ONE WORD INSTRUCTION
3844 200 WRITE(LUOT,996) KD1LNO,IPC22,IPC1,INS1A,(KRDOUT(J),J=1,KD1BCT)
3845 GO TO 700
3846 C*** ONE BYTE VALUE
3847 100 WRITE(LUOT,995) KD1LNO,IPC22,IPC1,INS3(3),INS3(4),
3848 & (KRDOUT(J),J=1,KD1BCT)
3849 GO TO 800
3850 80 CONTINUE
3851 C*** CONVERT VALUE TO ASCII
3852 CALL HEXASC(ITOKEN(1),INS2,2,1)
3853 WRITE(LUOT,995) KD1LNO,IPC22,IPC1,INS2(1),INS2(2),
3854 & (KRDOUT(J),J=1,KD1BCT)
3855 CALL PAGE(1)
3856 78 INSL=1
3857 IF(INS1.EQ.1) GO TO 75
3858 DO 70 J=2,INS1
3859 CALL PCOUNT
3860 IF(LIST.EQ.0) GO TO 70
3861 C*** IS OPTION G- OR G?
3862 IF(LUDI.EQ.0) GO TO 70
3863 C*** CONVERT HEX TO ASCII
3864 CALL HEXASC(IPC,IPC1,4,1)
3865 CALL HEXASC(IPC2,IPC22,2,1)
3866 CALL HEXASC(ITOKEN(J),KRDOUT,2,1)
3867 WRITE(LUOT,991) IPC22,IPC1,KRDOUT(1),KRDOUT(2)
3868 CALL PAGE(1)
3869 70 CONTINUE
3870 75 CALL PCOUNT
3871 C*** DON'T 0 MOD 2 IF DC.B
3872 LPTR=0
3873 IF(ISIZ.EQ.0) GO TO 72
3874 I=2
3875 IF(ISIZ.EQ.128) I=4
3876 C*** IF NOT 0 MOD 2 FOR .W OR 0 MOD 4 FOR .L PUT OUT FIILER OF 0
3877 IF(INS1.LT.5) INS1=INS1+4
3878 J=MOD(INS1,I)
3879 IF(J.EQ.0) GO TO 72
3880 I=I-J
3881 DO 71 J=1,I
3882 CALL PNCH(4,0)
3883 IF(LIST.EQ.0) GO TO 71
3884 C*** IS OPTION G- OR G?
3885 IF(LUDI.EQ.0) GO TO 71
3886 C*** 'LPTR' MUST = 0
3887 CALL HEXASC(IPC,IPC1,4,1)
3888 CALL HEXASC(IPC2,IPC22,2,1)
3889 CALL HEXASC(LPTR,KRDOUT,2,1)
3890 WRITE(LUOT,991) IPC22,IPC1,KRDOUT(1),KRDOUT(2)
3891 CALL PAGE(1)
3892 71 CALL PCOUNT
3893 72 KARD1(1)=0
3894 INSL=0
3895 GO TO 800
3896 C*** PSUEDO OP
3897 10 WRITE(LUOT,994) KD1LNO,(KRDOUT(J),J=1,KD1BCT)
3898 GO TO 800
3899 C*** PSEUDO OP WITH A VALUE
3900 20 IF(INSL.NE.-1) GO TO 30
3901 C... *** PRINT W/O PC
3902 WRITE(LUOT,993) KD1LNO,INS2,INS3,(KRDOUT(J),J=1,KD1BCT)
3903 GO TO 800
3904 C... *** DS - PRINT WITH PC
3905 30 WRITE(LUOT,997) KD1LNO,IPC22,IPC1,INS2,INS3,(KRDOUT(J),J=1,KD1BCT)
3906 35 CALL ADD(IPC2,IPC,INS(2),INS(3))
3907 INSL=0
3908 GO TO 800
3909 999 FORMAT(I5,1X,2A1,4A1,1X,12A1/16X,8A1,1X,100A1)
3910 1999 FORMAT(I5,1X,6A1,1X,12A1/16X,4A1,5X,100A1)
3911 2999 FORMAT(I5,1X,6A1,1X,8A1/16X,8A1,1X,100A1)
3912 1998 FORMAT(I5,1X,6A1,1X,12A1,1X,100A1)
3913 998 FORMAT(I5,1X,6A1,1X,12A1,1X,100A1)
3914 997 FORMAT(I5,1X,6A1,1X,8A1,5X,100A1)
3915 996 FORMAT(I5,1X,6A1,1X,4A1,9X,100A1)
3916 995 FORMAT(I5,1X,6A1,1X,2A1,11X,100A1)
3917 994 FORMAT(I5,21X,100A1)
3918 993 FORMAT(I5,8X,8A1,5X,100A1)
3919 991 FORMAT(6X,6A1,1X,2A1)
3920 9920 FORMAT(A1)
3921 C*** INCREMENT LINE COUNT BY 2
3922 690 II=2
3923 C*** ASSURE EVEN BOUNDARY
3924 700 IF(MPUAND(IPC,1).EQ.0) GO TO 800
3925 CALL ERR(230)
3926 CALL PNCH(4,0)
3927 CALL MOD2
3928 C*** PRINT THE ERRORS IF ANY
3929 800 CALL ERR(0)
3930 IF(KARD1(1).NE.0) CALL PAGE(II)
3931 C*** COMPUTE NEW PC ADDRESS
3932 C
3933 900 KARD1(1)=0
3934 IF(INSL.LE.0) RETURN
3935 C*** INCREMENT THE P-COUNTER.
3936 CALL PCOUNT
3937 RETURN
3938 C*** SPC ***
3939 950 CONTINUE
3940 I=INS(3)
3941 C
3942 DO 960 J=1,I
3943 CALL PAGE(1)
3944 960 WRITE(LUOT,9920) LSPHEX
3945 C
3946 980 KARD1(1)=0
3947 INSL=0
3948 GO TO 800
3949 1000 CONTINUE
3950 C*** IF DC FINISH OUTPUT IF REQUIRED & INCREMENT THE PCOUNT
3951 IF(IOPC.NE.4) GO TO 800
3952 IF(INSL.EQ.9.AND.LUDI.EQ.0) GO TO 78
3953 IF(LUDI.EQ.0) GO TO 800
3954 KARD1(1)=LSP
3955 KD1BCT=1
3956 GO TO 6
3957 END
3958 SUBROUTINE BUILD2
3959 CC NAM: BUILD2 VER: 1.0 DAT: 12/08/78 CMP: 16-BIT
3960 CC
3961 CC SYS: MACS
3962 CC
3963 CC ENT: N/A
3964 CC
3965 CC RTN: N/A
3966 CC
3967 CC FNC: BUILD THE INSTRUCTION FOR PASS TWO
3968 CC
3969 CC THIS ROUTINE IS 16-BIT DEPENDENT DUE TO THE
3970 CC 24-BIT ADDRESS WHICH MUST BE MANIPULATED.
3971 CC
3972 CC REV: N/A
3973 CC
3974 CCALLS ERR-MOD2-ISHFT-MPUAND-MPUIOR-PAGE
3975 CC
3976 CC ERROR NUMBERS CALLED: 205,208,209,210,212,213,215,216,217,218
3977 CC 220,223,229,232,233,234,236,238
3978 C*
3979 IMPLICIT INTEGER (A-Z)
3980 COMMON /A/ ISYM(3000),KARD1(96),ITOKEN(70),TKNSIZ,TKNTYP,
3981 & TKNVAL,TKNVA2,JSUC,JPTR,LPTR,NXSYM,KOLUMN,KD1BCT,KD1LNO,JERR,
3982 & MNUM,IPASS,IPC2,IPC,IOPC,INS(5),INSL,ISIZ,IADM(7,2),LUOT
3983 COMMON /A/ KASH(64),KPAC(15),KPWCT,LENSYM,KCLAS(64)
3984 COMMON /A/ NET1(64),NET2(64),NET3(64),NET4(64),NET5(64)
3985 COMMON /A/ NBPW,KSYS,IEOT,LSP,JBUF(83),KARD2(80,3),IHB480,IHEX9K
3986 COMMON /A/ IA1SHF,KCFF,LUSI,LUDI,LUOO,LLEN,IPLEN
3987 COMMON /A/ LIST,ICOL,NEST,LUCI,LULT,MFLD(11,3),IOBJ,LLENSW,NOP
3988 COMMON /A/ NXSYM1,LIST1,MASK2
3989 DIMENSION IMCD(6),NIMM(40)
3990 EQUIVALENCE(IADM(4,1),SYMTYP),(IADM(5,1),LFRF)
3991 EQUIVALENCE (INS(1),INS1)
3992 C ORI SUBI EORI CMPI ANDI ADDI
3993 DATA IMCD/ 0000, 1024, 2560, 3072, 512, 1536/
3994 C
3995 C*** THE FOLLOWING DATA STATEMENTS DEFINE HEX CONSTANTS
3996 C*** LOCAL TO THIS ROUTINE.
3997 C
3998 DATA IH4E60/O47140/,IH40C0/O40300/
3999 DATA IH44C0/O42300/,IH46C0/O43300/
4000 DATA IH48C0/O44300/
4001 C
4002 C*** END HEX DATA CONSTANTS.
4003 C
4004 C*** 01-20 NO IMM - 2ND ROW IS 21 04
4005 DATA NIMM/
4006 & 0,0,0,0,0,1,1,1,1,1,0,0,0,1,1,0,0,0,0,1,
4007 & 1,1,1,0,0,0,0,1,1,1,1,1,0,1,1,1,1,1,1,0/
4008 C
4009 C*** HEX 7000
4010 DATA I7KH/O70000/
4011 DATA IHA0C0/O120300/
4012 DATA IH5K/O50000/,IH5100/O50400/
4013 DATA IH4100/O40400/
4014 DATA ZB001/O130001/,ZD001/O150001/,ZD002/O150002/,Z9001/O110001/
4015 DATA Z9002/O110002/,ZF000/O170000/,Z8000/O100000/
4016 DATA ZB140/O130500/
4017 DATA CMP/0/,MASK2/0/
4018 C*** ERROR 220 ???
4019 C***
4020 IF(IOPC.EQ.0) GO TO 45
4021 C*** CHECK FOR DC WITH A LABEL, IS SO SKIP ERR 220 CHECK
4022 IF(IOPC.EQ.4) GO TO 50
4023 IF(IOPC.EQ.5) GO TO 50
4024 C... *** NOT SET,EQU ASSURE NO PHASE ERROR
4025 IF(LPTR.EQ.0) GO TO 40
4026 IF(ISYM(LPTR+1).NE.IPC) CALL ERR(220)
4027 C*** PERFORM ACTIONS FOR THE OPCODE CLASS
4028 40 IF(IOPC.GT.0) GO TO 50
4029 45 INSL=0
4030 RETURN
4031 50 IF(INSL.LT.0) INSL=2
4032 GO TO(100, 200,9223,400,500, 600, 700, 800, 900, 950,
4033 & 1100,1100,1300,1400,1500, 950, 950,1800,1900),IOPC
4034 J=IOPC-19
4035 GO TO(2000,2100,2200,2300,2400,2500,2600,2700,2800,2900,3000,
4036 & 9223,3200,9223,3400,3500,3600,3700,3800),J
4037 J=J-19
4038 GO TO(3900),J
4039 GO TO 9223
4040 C
4041 C*** PSEUDO OPS WITHOUT OPERANDS
4042 100 CONTINUE
4043 GO TO(110,120,130,140,150,160,170,180,190,195,196,197),INS1
4044 C... *** END
4045 110 IPASS=1
4046 120 RETURN
4047 C*** PAGE
4048 130 CONTINUE
4049 CALL PAGE(84)
4050 RETURN
4051 C
4052 C*** LIST
4053 140 LIST=1
4054 145 KARD1(1)=0
4055 RETURN
4056 C
4057 C*** NOLIST ***
4058 150 LIST=0
4059 RETURN
4060 C*** TTL
4061 160 CALL PAGE(80)
4062 GO TO 145
4063 C*** NO PAGE(NOP)
4064 170 CONTINUE
4065 NOP=0
4066 RETURN
4067 C
4068 C*** NOOBJ -NO OBJECT OUTPUT, SET IN PASS 1
4069 C
4070 180 RETURN
4071 C
4072 C*** CMPL - CMP DESTINATION,SOURCE
4073 C
4074 190 CMP=1
4075 RETURN
4076 C
4077 C*** CMPR - CMP S,D
4078 C
4079 195 CMP=0
4080 RETURN
4081 C
4082 C*** 'G' DIRECTIVE
4083 C
4084 196 LUDI=1
4085 RETURN
4086 C
4087 C*** 'MASK2' DIRECTIVE
4088 C
4089 197 MASK2=1
4090 RETURN
4091 C
4092 C*** OP CODES WITHOUT OPERANDS
4093 200 RETURN
4094 C
4095 C*** DC
4096 400 GO TO 540
4097 C
4098 C*** PSEUDO OPS WITH OPERANDS
4099 500 IF(IADM(1,1).EQ.56) GO TO 505
4100 IF(IADM(1,1).NE.57) CALL ERR(234)
4101 505 INSL=-1
4102 GO TO(510,520,520,540,508,560,570),INS1
4103 GO TO 9223
4104 C*** RORG
4105 508 IADM(7,1)=1
4106 GO TO 512
4107 C... *** ORG AND RORG
4108 510 IADM(7,1)=0
4109 512 IPC=INS(3)
4110 C+++ 16-BIT - GET MOST SIGNIFICANT BYTE
4111 IPC2=INS(2)
4112 IADM(7,2)=0
4113 IF(ISIZ.EQ.128) IADM(7,2)=1
4114 CALL PNCH(3,IPC)
4115 RETURN
4116 C... *** EQU
4117 520 IF(LPTR.GT.0) GO TO 522
4118 C... *** ERROR - NO LABEL ON STATEMENT
4119 CALL ERR(229)
4120 RETURN
4121 522 ISYM(LPTR)=MPUAND(ISYM(LPTR),192) + SYMTYP
4122 ISYM(LPTR+1)=INS(3)
4123 C
4124 C*** IS THIS "SET"?
4125 IF(INS(1).NE.2)
4126 & ISYM(LPTR)=128
4127 C*** SAVED IN 'ACT2'
4128 KK=ITOKEN(69)
4129 IF(KK.EQ.0) RETURN
4130 ISYM(KK)=INS(2)
4131 RETURN
4132 C... *** DC AND DS
4133 540 INSL=1
4134 IF(ISIZ.EQ.0) GO TO 545
4135 C*** IF PCOUNT ODD, PUT OUT FILL BYTE(A ZERO) IN 'S' RECORD
4136 IF(MPUAND(IPC,1).NE.0) CALL PNCH(4,0)
4137 CALL MOD2
4138 INSL=2
4139 IF(ISIZ.EQ.128) INSL=4
4140 545 IF(IOPC.NE.4) GO TO 550
4141 C... *** DC
4142 C
4143 INS1=INS(3)
4144 IF(IADM(1,1).GE.0) GO TO 547
4145 C*** INSL=9 TELLS OUTPUT TO PRINT STRING BYTE AT A TIME
4146 INSL=9
4147 C... *** 'STRING' OVER 4 BYTES
4148 C
4149 DO 546 J=1,INS1
4150 CALL PNCH(4,ITOKEN(J))
4151 546 CONTINUE
4152 RETURN
4153 C*** NUMERIC TYTE,WORD, OR LONG DC CONSTANT
4154 547 IF(INSL.EQ.4) GO TO 548
4155 C... *** BYTE OR WORD - ASSURE NOT TOO BIG
4156 C
4157 CALL RANGE(INS(3))
4158 RETURN
4159 C
4160 C+++ 16-BIT - GET 1ST 2 BYTES
4161 548 INS(1)=TKNVA2
4162 RETURN
4163 C... *** DS
4164 C*** INS(3)=INS(3)*INSL
4165 550 CONTINUE
4166 CALL MUL(INS(2),INS(3),0,INSL)
4167 555 INSL=-2
4168 C*** IPC=IPC+INS(3)
4169 CALL PNCH(5,INS(3))
4170 RETURN
4171 C
4172 C*** FAIL
4173 560 CALL ERR(INS(3))
4174 RETURN
4175 C*** SPC ***
4176 570 CONTINUE
4177 INSL=20
4178 RETURN
4179 C
4180 C*** LINK/UNLK - ADDRESS REGISTER TO BITS 2-0
4181 600 IF(IADM(1,1).NE.8) GO TO 9213
4182 C*** 2 BYTE LINK INSTRUCTION ILLEGAL
4183 IF(INSL.EQ.2.AND.INS(1).EQ.20048) GO TO 12340
4184 C*** CHECK FOR UNLK - 20056 = $4E58
4185 IF(INS(1).EQ.20056) INSL=2
4186 INS(1)=INS(1)+IADM(2,1)-8
4187 RETURN
4188 C
4189 C*** SWAP - DATA REGISTER TO BITS 2-0
4190 700 IF(IADM(1,1).NE.0) GO TO 9215
4191 INS(1)=INS(1)+IADM(2,1)
4192 RETURN
4193 C
4194 C*** TRAP - ESTABLISH DISPLACEMENT IN BITS 3-0
4195 800 INSL=2
4196 IF(IADM(1,1).EQ.60) IADM(1,1)=56
4197 IF(IADM(1,1).NE.56) GO TO 9209
4198 IF(INS(3).GT.15) GO TO 9210
4199 IF(INS(3).LT.0) GO TO 9216
4200 INS(1)=INS(1)+INS(3)
4201 RETURN
4202 C
4203 C*** ABS/CLR/NEG/NOT/TST - BUILD EA
4204 C
4205 900 INS(1)=INS(1)+ISIZ
4206 C*** CHECK FOR ADDRESS REG
4207 950 IF(IADM(1,1).EQ.8) GO TO 9215
4208 C*** *** ERROR IF IMMEDIATE MODE
4209 IF(IADM(1,1).GT.57.AND.IADM(1,1).LT.61) GO TO 9209
4210 GO TO 8300
4211 C
4212 C*** PEA-JSR-JMP
4213 C
4214 1100 CONTINUE
4215 C*** PEA (AN)+ AND PEA -(AN) ILLEGAL, CHECK FOR THEM
4216 IF(IADM(1,1).EQ.16) GO TO 8300
4217 IF(IADM(1,1).LT.40) GO TO 9209
4218 IF(IADM(1,1).EQ.60) GO TO 9209
4219 GO TO 8300
4220 C
4221 C*** BCC
4222 C
4223 1300 IOFS=INS(3) - IPC - 2
4224 C
4225 MAG=IABS(IOFS)
4226 C*** ALLOW ABSOLUTE ADDRESS ONLY
4227 IF(IADM(1,1).LT.56) CALL ERR(234)
4228 C*** IN CASE BIT 16 SET INSTRUCTION TO LONG, RESET
4229 IF(INSL.EQ.6) INSL=4
4230 C
4231 IF(ISIZ.NE.0) GO TO 1310
4232 C*** FORCE SHORT FORM
4233 IF(MAG.GT.127) CALL ERR(208)
4234 GO TO 1320
4235 1310 IF(LFRF.NE.0) GO TO 1330
4236 C... *** BACKWARD REFERENCE
4237 IF(MAG.GT.127) GO TO 1330
4238 C... *** USE SHORT FORM
4239 1320 INS(1)=INS(1) + MPUAND(IOFS,255)
4240 INSL=2
4241 C*** IF OFFSET IS ZERO IT WILL CAUSE HARDWARE TO EXPECT LONG BRANCH AND
4242 C*** USE NEXT 2 BYTES FOR OFFSET SO FLAG AS ERROR. THIS IS CAUSED BY
4243 C*** A BRA TO NEXT INSTRUCTION.
4244 IF(IOFS.EQ.0) GO TO 9208
4245 RETURN
4246 C... *** USE LONG FORMAT
4247 1330 IF(MAG.GT.32767) CALL ERR(208)
4248 INS(3)=IOFS
4249 RETURN
4250 C
4251 C*** NEGX
4252 1400 GO TO 900
4253 C
4254 C*** EXT
4255 1500 IF(ISIZ.EQ.0) GO TO 9217
4256 C
4257 IF(ISIZ.EQ.128) INS(1)=IH48C0
4258 INS(1)=MPUIOR(INS(1),IADM(2,1))
4259 IF(IADM(1,1).EQ.8) CALL ERR(215)
4260 RETURN
4261 C
4262 C*** CONDITIONAL ASSEMBLY
4263 1800 INSL=0
4264 INS1=INS(1)
4265 GO TO(1810,1820),INS1
4266 C... *** EQ
4267 1810 IF(INS(3).NE.0) GO TO 1890
4268 IF(INS(2).NE.0) GO TO 1890
4269 RETURN
4270 C... *** NE
4271 1820 IF(INS(3).EQ.0.AND.INS(2).EQ.0) GO TO 1890
4272 RETURN
4273 C... *** SKIP TO ENDC
4274 1890 ICOL=-2
4275 RETURN
4276 C
4277 C*** PAGE LENGTH(PLEN) - LINE LENGTH(LLEN)
4278 C
4279 1900 CONTINUE
4280 C*** IS IT PLEN?
4281 IF(INS1.EQ.2) GO TO 1980
4282 C*** CHECK FOR NEW MASK SET - STOP
4283 IF(INS1.EQ.1) GO TO 1910
4284 INSL=4
4285 IF(IADM(1,1).NE.60) CALL ERR(232)
4286 RETURN
4287 1910 CONTINUE
4288 C*** LLEN
4289 LLENSW=1
4290 LLEN=INS(3)
4291 IF(LLEN.GT.120) LLEN=120
4292 IF(LLEN.LT.26) LLEN=26
4293 INSL=0
4294 RETURN
4295 C*** PLEN
4296 1980 IPLEN=INS(3)
4297 RETURN
4298 C*** MULTIPLY,DIVIDE
4299 2000 ISIZ=0
4300 GO TO 8110
4301 C
4302 C*** ADD/SUB PROCESSING
4303 C
4304 C... *** TEST FOR IMMEDIATE SOURCE
4305 2100 CONTINUE
4306 C*** BYTE ADD ON AN ILLEGAL
4307 IF(IADM(1,2).EQ.8.AND.ISIZ.EQ.0) GO TO 9217
4308 C*** ADD.B AN,DN ILLEGAL
4309 IF(IADM(1,1).EQ.8.AND.ISIZ.EQ.0) GO TO 9217
4310 C*** DESINATION PC REL & PC REL + INDEX ILLEGAL
4311 IF(IADM(1,2).GT.57.AND.IADM(1,2).LT.61) CALL ERR(231)
4312 C*** CHECK FOR ADDI/SUBI - IF SO SKIP QUICK
4313 IF(INS(1).EQ.ZD001.OR.INS(1).EQ.Z9001) GO TO 6980
4314 C*** IF ADDQ/SUBQ FORCE IT
4315 IF(INS(1).EQ.IH5K.OR.INS(1).EQ.IH5100) GO TO 2108
4316 C*** ADDA/SUBA?
4317 IF(INS(1).EQ.ZD002.OR.INS(1).EQ.Z9002) GO TO 2125
4318 IF(IADM(1,1).NE.60) GO TO 2120
4319 C... *** POSSIBLE QUICK MODE?
4320 IF(INS(3).LE.0) GO TO 2110
4321 IF(INS(3).GT.8) GO TO 2110
4322 C*** CHECK FORWARD REF CANNOT BE 'Q'
4323 IF(LFRF.GT.0.AND.IADM(5,2).GT.0) GO TO 2110
4324 IF(LFRF.GT.0.AND.IADM(1,2).LT.56) GO TO 2110
4325 C... *** QUICK MODE
4326 2105 INSL=INSL - 2
4327 IF(ISIZ.EQ.128) INSL=INSL - 2
4328 IF(INS(3).GT.8) GO TO 9210
4329 KK=IH5K
4330 C*** IH5100=$5100
4331 IF(INS(1).EQ.IHEX9K.OR.INS(1).EQ.IH5100) KK=IH5100
4332 C
4333 INS(1)=ISHFT(INS(3),9) + ISIZ
4334 INS(1)=MPUIOR(INS(1),KK)
4335 IADM(3,2)=0
4336 INS(3)=INS(5)
4337 C*** INCASE LONG WORD
4338 INS(2)=INS(4)
4339 GO TO 8600
4340 C*** ADDQ/SUBQ MUST BE IMM
4341 2108 IF(IADM(1,1).NE.60) CALL ERR(234)
4342 GO TO 2105
4343 C... *** USE IMMEDIATE OP-CODE?
4344 2110 IF(IADM(1,2).NE.8) GO TO 7000
4345 C... *** CREATE MODE FIELD
4346 2120 IF(IADM(1,2).EQ.0) GO TO 8110
4347 IF(IADM(1,2).NE.8) GO TO 2130
4348 C... *** SINK IS A REGISTER - ASSURE NOT BYTE
4349 IF(ISIZ.EQ.0) GO TO 9217
4350 2125 ISIZ=ISIZ*2
4351 C*** DN AS DEST INVALID
4352 IF(IADM(1,2).EQ.0) GO TO 9213
4353 C*** ADDA/SUBA INST.
4354 INS(1)=MPUAND(INS(1),ZF000)
4355 C***
4356 INS(1)=INS(1) + MPUIOR(ISIZ,192)
4357 GO TO 8210
4358 C... *** SINK TO MEMORY - ASSURE SOURCE IS D REGISTER
4359 2130 ISIZ=ISIZ+256
4360 GO TO 8400
4361 C
4362 C*** AND,OR
4363 C
4364 C
4365 2200 IF(IADM(1,1).EQ.8) GO TO 9215
4366 IF(IADM(1,1).NE.0) GO TO 2310
4367 C*** POSSIBLE D->EA
4368 IF(IADM(1,2).EQ.0) GO TO 8100
4369 IF(IADM(1,2).EQ.8) GO TO 9215
4370 ISIZ=MPUIOR(ISIZ,256)
4371 GO TO 8400
4372 C
4373 C*** EOR
4374 C*** 8192 = $2000
4375 2300 IF(IADM(1,1).NE.60) GO TO 8400
4376 C*** IMMEDIATE MODE
4377 INS(1)=8192
4378 C... *** TEST FOR CCR/SR DESTINATION
4379 2310 IF(IADM(1,2).EQ.64) GO TO 2320
4380 C... *** NOT CCR/SR - TRY IMM MODE
4381 IF(IADM(1,1).EQ.60) GO TO 7000
4382 GO TO 8100
4383 C... *** CCR/SR DESTINATION - ASSURE IMMEDIATE
4384 2320 IF(IADM(1,1).NE.60) CALL ERR(232)
4385 C... ***CREATE IMM BIT PATTERM
4386 KK=ISHFT(INS(1),-12)
4387 KK=MPUAND(KK,7)
4388 INS(1)=IMCD(KK+1) + IADM(2,2)
4389 RETURN
4390 C
4391 C*** CMP
4392 C*** SWITCH INFO ON CMP
4393 2380 KK=IADM(1,1)
4394 IADM(1,1)=IADM(1,2)
4395 IADM(1,2)=KK
4396 KK=IADM(2,1)
4397 IADM(2,1)=IADM(2,2)
4398 IADM(2,2)=KK
4399 C*** IF 6 OR MORE BYTE INST, SWITCH 'INS' ALSO
4400 IF(INSL.LT.6) GO TO 2390
4401 IF(IADM(1,1).LT.40) GO TO 2390
4402 KK=INS(2)
4403 INS(2)=INS(4)
4404 INS(4)=KK
4405 KK=INS(3)
4406 INS(3)=INS(5)
4407 INS(5)=KK
4408 2390 GO TO (2406,2620,2720),I
4409 C... *** IS COMPARE WITH A REGISTER?
4410 2400 CONTINUE
4411 C*** IS IT CMP S,D?
4412 I=1
4413 IF(CMP.EQ.0) GO TO 2380
4414 C*** CMPA?
4415 2406 IF(INS(1).EQ.ZB001.AND.IADM(1,1).NE.8) GO TO 9213
4416 IF(IADM(1,1).NE.8) GO TO 2410
4417 C*** *** YES, USE CMPA(BYTE MODE ILLEGAL)
4418 IF(ISIZ.EQ.0) GO TO 9217
4419 ISIZ=ISIZ*2
4420 INS(1)=MPUIOR(IHA0C0,ISIZ)
4421 GO TO 8510
4422 C... *** CAN WE USE CMPI?
4423 2410 IF(IADM(1,2).NE.60) GO TO 8400
4424 INS(1)=3072 + ISIZ
4425 IF(IADM(1,1).LT.40) GO TO 8300
4426 C... *** MEMORY MODE
4427 KK=INS(3)
4428 INS(3)= INS(5)
4429 INS(5)=KK
4430 C+++ 16-BIT
4431 KK=INS(2)
4432 INS(2)= INS(4)
4433 INS(4)=KK
4434 IADM(3,2)=2
4435 IF(IADM(1,1).EQ.57) IADM(3,2)=4
4436 C*** 3=UNDEFINED SYMBOL/LABEL
4437 IF(IADM(5,2).EQ.3) IADM(3,2)=3
4438 GO TO 8300
4439 C
4440 C*** EXG
4441 2500 CONTINUE
4442 C*** EXG DN,DM
4443 IF(IADM(1,1).EQ.0.AND.IADM(1,2).EQ.0) GO TO 2530
4444 C*** EXG AN,DM
4445 IF(IADM(1,1).EQ.8.AND.IADM(1,2).EQ.0) GO TO 2505
4446 C*** EXG DN,AM
4447 IF(IADM(1,1).EQ.0.AND.IADM(1,2).EQ.8) GO TO 2510
4448 C*** EXG AN,AM
4449 IF(IADM(1,1).EQ.8.AND.IADM(1,2).EQ.8) GO TO 2520
4450 GO TO 9209
4451 2505 CONTINUE
4452 C*** EXG AN,DM
4453 I=IADM(2,1)
4454 IADM(2,1)=IADM(2,2)
4455 IADM(2,2)=I
4456 2510 CONTINUE
4457 C*** DN,AM - 64=$40
4458 INS(1)=INS(1)+64
4459 GO TO 2530
4460 C*** AN,AM
4461 2520 CONTINUE
4462 INS(1)=ZB140
4463 2530 INS(1)=INS(1)+ISHFT(IADM(2,1),9)+IADM(2,2)
4464 RETURN
4465 C
4466 C*** CHK
4467 2600 I=2
4468 C*** IS IT CHK S,D?
4469 IF(CMP.EQ.0) GO TO 2380
4470 2620 GO TO 8500
4471 C
4472 C*** CMPM
4473 2700 I=3
4474 C*** IS IT CMPM D,S?
4475 IF(CMP.EQ.1) GO TO 2380
4476 2720 IF(IADM(1,1).NE.24) GO TO 9209
4477 IF(IADM(1,2).NE.24) GO TO 9209
4478 GO TO 7100
4479 C
4480 C*** ADDX,SUBX
4481 2800 GO TO 2910
4482 C
4483 C*** ABCD,SBCD
4484 2900 ISIZ=0
4485 2910 IF(IADM(1,1).NE.0) GO TO 2920
4486 IF(IADM(1,2).NE.0) GO TO 9209
4487 GO TO 7100
4488 C... *** -(A1),-(A1) MODE
4489 2920 IF(IADM(1,1).NE.32) GO TO 9209
4490 IF(IADM(1,2).NE.32) GO TO 9209
4491 IADM(2,2)=IADM(2,2)-8
4492 GO TO 7100
4493 C
4494 C*** MOVEP
4495 C
4496 3000 CONTINUE
4497 C*** CHECK FOR CORRECT BYTE SIZE - .B ILLEGAL
4498 IF(ISIZ.EQ.0) GO TO 9205
4499 C*** ENTER LONG WORD FLAG?
4500 IF(ISIZ.EQ.128) INS(1)=INS(1) + 64
4501 C*** FIND ADDRESS MODE
4502 IF(IADM(1,1).EQ.40) GO TO 3020
4503 C*** REG TO MEMORY INSTRUCTION
4504 IF(IADM(1,2).NE.40) GO TO 9209
4505 C*** RESET ADDRESS MODE FLAG TO ADD IN A FLAG LATER
4506 IADM(1,2)=8
4507 C*** SET REG -> MEMORY FLAG - 128=$80
4508 INS(1)=MPUIOR(INS(1),128)
4509 GO TO 8500
4510 C*** MEMORY -> REG INSTRUCTION
4511 3020 IADM(1,1)=8
4512 GO TO 8200
4513 C
4514 C*** DCNT
4515 C
4516 3200 INSL=2
4517 IF(IADM(1,2).EQ.57) IADM(1,2)=56
4518 IF(IADM(1,1).NE.0) GO TO 9215
4519 IF(IADM(1,2).NE.56) GO TO 9209
4520 IOFS=INS(3) - IPC -2
4521 IF(MASK2.EQ.0) GO TO 3201
4522 IF(IOFS.GE.0.OR.IOFS.LT.-128) CALL ERR(208)
4523 INS(1)=INS(1) + ISHFT(IADM(2,1),9) + MPUAND(IOFS,255)
4524 RETURN
4525 C*** DBCC
4526 3201 CONTINUE
4527 INS(1)=INS(1)+IADM(2,1)
4528 INSL=4
4529 INS(3)=IOFS
4530 RETURN
4531 C
4532 C*** LEA
4533 C
4534 3400 CONTINUE
4535 C*** DESTINATION MUST BE ADDRESS ONLY
4536 IF(IADM(1,2).NE.8) GO TO 9213
4537 IADM(2,2)=MPUAND(IADM(2,2),7)
4538 C*** CHECK FOR VALID MODES
4539 IF(IADM(1,1).EQ.16) GO TO 8210
4540 IF(IADM(1,1).LT.40) GO TO 9213
4541 C*** IMM INVALID
4542 IF(IADM(1,1).EQ.60) GO TO 9234
4543 GO TO 8210
4544 C
4545 C*** SHIFTS
4546 3500 CONTINUE
4547 IF(IADM(1,1).EQ.60.AND.ISIZ.EQ.128) INSL=INSL-2
4548 C*** MAKE #BITNO LOOK LIKE BITNO
4549 IF(IADM(1,1).EQ.60) IADM(1,1)=56
4550 IF(IADM(1,1).EQ.56) INSL=INSL-2
4551 C*** ADDRESS REG IS ILLEGAL
4552 IF(IADM(1,2).EQ.8) GO TO 9215
4553 IF(IADM(1,2).NE.0) GO TO 3520
4554 C... *** REGISTER SHIFT
4555 IF(IADM(1,1).EQ.0) GO TO 3510
4556 C... *** STATIC SHIFT
4557 IF(IADM(1,1).NE.56) GO TO 9209
4558 IF(INS(3).LT.1) GO TO 9216
4559 IF(INS(3).GT.8) GO TO 9208
4560 IF(INS(3).EQ.8) INS(3)=0
4561 INS(1)=INS(1)+ISHFT(INS(3),9)+ISIZ+IADM(2,2)
4562 RETURN
4563 C... *** DYNAMIC SHIFT
4564 3510 ISIZ=ISIZ + LSP
4565 GO TO 8400
4566 C... *** MEMORY SHIFT
4567 3520 KK=MPUAND(INS(1),24)
4568 INS(1)=INS(1) - KK + 192 + ISHFT(KK,6)
4569 C*** 192 = $C0
4570 C
4571 C*** ALLOW SHIFT 1,MEMORY
4572 IF(IADM(1,1).NE.56) GO TO 9209
4573 IF(INS(3).NE.1) CALL ERR(236)
4574 C*** WORD SIZE ONLY ALLOWED.
4575 IF(ISIZ.NE.64) CALL ERR(238)
4576 INS(3)=INS(5)
4577 IF(IADM(7,2).EQ.0) GO TO 8600
4578 IF(LFRF.GT.0.OR.TKNVA2.NE.0) INS(3)=INS(4)
4579 GO TO 8600
4580 C
4581 C*** BIT INSTRUCTIONS
4582 3600 CONTINUE
4583 IF(IADM(1,1).EQ.60.AND.ISIZ.EQ.128) INSL=INSL-2
4584 J=8
4585 C*** AN DESTINATION ILLEGAL
4586 IF(IADM(1,2).EQ.8) GO TO 9209
4587 C*** IMM DESTINATION ILLEGAL
4588 IF(IADM(1,2).EQ.60) GO TO 9209
4589 C*** WORD ILLEGAL IN THIS CASE, MASK 3
4590 IF(ISIZ.EQ.64.AND.MASK2.LT.2) CALL ERR(238)
4591 C*** IF MASK 2 AND BX GO ADJUST IT
4592 IF(MASK2.EQ.1) GO TO 3920
4593 3605 IF(IADM(1,1).NE.0) GO TO 3610
4594 C*** DYNAMIC - IS IT BTST?
4595 IF(INS(1).EQ.256) GO TO 8510
4596 C*** PC REL & PC REL + INDEX ILLEGAL FOR OTHERS
4597 IF(IADM(1,2).GT.57.AND.IADM(1,2).LT.61) CALL ERR(231)
4598 GO TO 8510
4599 C*** STATIC
4600 3610 IF(IADM(1,1).EQ.56.OR.IADM(1,1).EQ.60) GO TO 3620
4601 GO TO 9209
4602 C*** 1792=$700
4603 3620 INS(1)=INS(1)+1792
4604 IF(IADM(1,2).EQ.0) J=32
4605 INS(3)=MOD(INS(3),J)
4606 GO TO 3680
4607 3640 INS(3)=INS(3)-8
4608 GO TO 3680
4609 C*** MASK2=1 - AND WE HAVE BX.BB - ADJUST FOR MASK 2
4610 3660 CONTINUE
4611 C*** ODD ADDRESS?
4612 I=MPUAND(INS(5),1)
4613 IF(I.EQ.0) GO TO 3670
4614 INS(5)=INS(5)-1
4615 GO TO 3930
4616 3670 INS(3)=INS(3)+8
4617 C*** TEST PC REL - PC REL + INDEX - VALID FOR BTST ONLY
4618 3680 CONTINUE
4619 C*** BTST+$700 AT THIS POINT
4620 IF(INS(1).EQ.2048) GO TO 8600
4621 IF(IADM(1,2).GT.57.AND.IADM(1,2).LT.61) CALL ERR(231)
4622 GO TO 8600
4623 3900 IF(IADM(1,2).EQ.8) GO TO 9209
4624 IF(IADM(1,2).EQ.60) GO TO 9209
4625 IF(IADM(1,1).EQ.60.AND.ISIZ.EQ.128) INSL=INSL-2
4626 J=16
4627 IF(MASK2.NE.0) GO TO 3605
4628 3920 IF(IADM(1,1).EQ.0.AND.IADM(1,2).EQ.0) GO TO 8510
4629 IF(IADM(1,1).EQ.0) GO TO 9209
4630 C*** (AN)+ -(AN)
4631 IF(IADM(1,2).EQ.24.OR.IADM(1,2).EQ.32) GO TO 9209
4632 IF(IADM(1,2).EQ.0) J=32
4633 INS(1)=INS(1)+1792
4634 INS(3)=MOD(INS(3),J)
4635 IF(IADM(1,2).EQ.0) GO TO 3680
4636 IF(IOPC.EQ.36) GO TO 3660
4637 IF(INS(3).GT.7) GO TO 3640
4638 C*** ADJ ADDR BY
4639 INS(5)=INS(5)+1
4640 C*** IF (AN) SET UP DISPLACEMENT OF 1
4641 3930 IF(IADM(1,2).NE.16) GO TO 3680
4642 INSL=INSL+2
4643 IADM(3,2)=1
4644 IADM(1,2)=40
4645 GO TO 3680
4646 C
4647 C*** MOVE INSTRUCTION
4648 C... *** TEST FOR IMMEDIATE SOURCE AND D SINK
4649 3700 CONTINUE
4650 C*** CHECK FOR 2ND OPERAND PRESENT
4651 IF(IADM(1,2).EQ.-1) GO TO 9209
4652 C*** MOVE S,PC REL OR PC REL+INDEX ILLEGAL
4653 IF(IADM(1,2).GT.57.AND.IADM(1,2).LT.61) CALL ERR(231)
4654 C*** MOVEQ?
4655 IF(INS(1).EQ.I7KH) GO TO 3705
4656 IF(IADM(1,1).NE.60) GO TO 3710
4657 C*** IMM PC REL INVALID
4658 IF(SYMTYP.EQ.1) CALL ERR(231)
4659 IF(IADM(1,2).NE.0) GO TO 3710
4660 C... *** MOVE #,0 - CAN WE USE LDQ?
4661 C*** 128 = $80
4662 IF(ISIZ.NE.128) GO TO 3710
4663 C*** FORWARD REFERENCE?
4664 IF(IADM(5,1).GT.0) GO TO 3710
4665 IF(INS(3).LT. -127) GO TO 3710
4666 IF(INS(3).GT.127) GO TO 3710
4667 IF(INS(2).NE.0.AND.INS(2).NE.-1) GO TO 3710
4668 IF(INS(2).EQ.0.AND.MPUAND(TKNVAL,Z8000).NE.0) GO TO 3710
4669 C... *** USE LDQ
4670 3705 INS(1)= I7KH + ISHFT(IADM(2,2),9) + MPUAND(INS(3),255)
4671 INSL=2
4672 C*** ONLY DN DEST ALLOWED
4673 IF(IADM(1,2).NE.0) GO TO 9209
4674 IF(IABS(INS(3)).GT.KCFF) GO TO 9210
4675 RETURN
4676 3710 IF(ISIZ.NE.0) GO TO 3720
4677 C... *** BYTE MODE
4678 IF(IADM(1,1).EQ.8) GO TO 9217
4679 IF(IADM(1,2).EQ.8) GO TO 9217
4680 3720 INS(1)=ISHFT(ISIZ,6)+4096
4681 C*** MOVE.W= OPCODE 3 - MOVE.L = OPCODE 2
4682 C*** 12288=$3000 - 8192=$2000
4683 IF(ISIZ.EQ.0) GO TO 3726
4684 IF(INS(1).EQ.12288) GO TO 3722
4685 INS(1)=12288
4686 GO TO 3726
4687 3722 INS(1)=8192
4688 3726 CONTINUE
4689 KM=MPUAND(IADM(1,2),56)
4690 IF(KM.EQ.56) GO TO 3730
4691 C... *** REGISTER MODE (00-60)
4692 KR=MPUAND(IADM(2,2),7)
4693 GO TO 3740
4694 C... *** MEMORY MODE (7X)
4695 3730 KR=MPUAND(IADM(1,2),7)
4696 C... *** FORM FIELD-1 REG,MODE
4697 3740 INS(1)=INS(1)+ISHFT(KR,9)+ISHFT(KM,3)
4698 C... *** FORM FIELD-2 EA
4699 C
4700 C... *** TEST FOR CONTROL REGISTER SOURCE
4701 IF(IADM(1,1).NE.64) GO TO 3760
4702 C... *** SOURCE IS CONTROL REGISTER - ASSURE USP -> A
4703 IF(IADM(2,1).NE.16) GO TO 3750
4704 IF(IADM(1,2).NE.8) GO TO 9213
4705 C
4706 INS(1)=IH4E60 + IADM(2,2)
4707 RETURN
4708 C
4709 C... *** MOVE SR,EA?
4710 3750 IF(IADM(2,1).NE.124) GO TO 9233
4711 C... *** 124 = $7C
4712 INS(1)=IH40C0
4713 GO TO 8600
4714 C... *** TEST FOR CONTROL REGISTER DESTINATION
4715 3760 IF(IADM(1,2).NE.64) GO TO 8300
4716 C... *** DESTINATION IS CONTROL REGISTER A-> USP?
4717 IF(IADM(2,2).NE.16) GO TO 3770
4718 C
4719 IF(IADM(1,1).NE.8) GO TO 9213
4720 INS(1)=(IH4E60 - 8) + IADM(2,1)
4721 RETURN
4722 C... *** ASSUME EA -> CC/SR
4723 3770 INS(1)=IH44C0
4724 IF(IADM(2,2).EQ.124) INS(1)=IH46C0
4725 GO TO 8300
4726 C
4727 C*** LDM,STM - MOVEM
4728 C*** 19456 = $4C00
4729 3800 INSL=INSL+2
4730 C
4731 C*** CHECK FOR ILLEGAL LDM
4732 IF(IADM(1,1).LT.9.AND.INS(1).EQ.19456) GO TO 9209
4733 INS(5)=INS(3)
4734 INS(4)=INS(2)
4735 KM=2
4736 KK=1
4737 C*** IS IT STM PART OF MOVEM?
4738 IF(IADM(1,1).LT.9) GO TO 3810
4739 INS(1)=19456
4740 C*** LDM - ASSURE NOT -1(A)
4741 IF(IADM(1,1).EQ.32) GO TO 9209
4742 C*** PUT IN BIT 7 FOR LDM
4743 INS(1)=INS(1) + 128
4744 C*** SET THE MASK A0-D7 IN
4745 INS(3)=IADM(6,1)
4746 GO TO 3820
4747 C*** STM - ASSURE NOT (A)+ OR PC RELATIVE
4748 3810 CONTINUE
4749 KK=2
4750 KM=1
4751 C*** SET IN D0-A7 BIT MASK
4752 INS(3)=IADM(6,2)
4753 IF(IADM(1,2).EQ.24) GO TO 9209
4754 IF(IADM(1,2).GE.58) GO TO 9208
4755 C*** ASSURE NOT BYTE MODE
4756 3820 IF(ISIZ.EQ.0) GO TO 9217
4757 ISIZ=ISIZ-64
4758 C
4759 C*** DISALLOW REGISTER DIRECT MODES
4760 IF(IADM(1,KK).LE.8) GO TO 9209
4761 C*** ASSURE MASK IS FIRST FIELD
4762 IF(IADM(1,KM).GT.8) GO TO 9209
4763 IF(INSL.EQ.6) IADM(3,2)=2
4764 IF(INSL.EQ.8) IADM(3,2)=4
4765 INS(1)=INS(1) + ISIZ
4766 C*** IF CONTROL MODE (AN), MASK MUST APPEAR SAME AS LDM MASK FOR (AN).
4767 IF(IADM(1,2).EQ.16.OR.IADM(1,2).EQ.40) INS(3)=IADM(6,1)
4768 IF(IADM(1,2).EQ.56.OR.IADM(1,2).EQ.57) INS(3)=IADM(6,1)
4769 IF(IADM(1,2).EQ.48) INS(3)=IADM(6,1)
4770 C*** LDM STM
4771 GO TO (8300,8600),KK
4772 C
4773 C*** --- STANDARD ACTIONS --
4774 C
4775 C*** IMMEDIATE OPCODE
4776 C*** ADDI/SUBI TO AN ILLEGAL
4777 6980 IF(IADM(1,2).EQ.8) GO TO 9209
4778 C*** MUST BE IMM
4779 IF(IADM(1,1).NE.60) GO TO 9209
4780 7000 IF(IADM(1,2).EQ.60) GO TO 9209
4781 KK=ISHFT(INS(1),-12)
4782 KK=MPUAND(KK,7)
4783 INS(1)=IMCD(KK+1)+ISIZ
4784 IF(IADM(1,2).EQ.8) GO TO 9215
4785 GO TO 8610
4786 C
4787 C*** REGISTER-REGISTER OPCODES
4788 7100 KK=ISHFT(IADM(2,2),9)
4789 INS(1)=MPUIOR(INS(1),KK)+ISIZ
4790 INS(1)=MPUIOR(INS(1),IADM(2,1))
4791 RETURN
4792 C
4793 C -------- FIELD 1 --> FIELD 2 -------
4794 C
4795 C*** ESTABLISH SIZE IN BITS 7-6
4796 C... *** IS IMMEDIATE EA ALLOWED?
4797 8100 IF(IADM(1,1).NE.60) GO TO 8110
4798 IF(NIMM(IOPC).NE.0) GO TO 9218
4799 8110 INS(1)=INS(1)+ISIZ
4800 C
4801 C*** ESTABLISH REGISTER(2) IN BITS 11-9
4802 8200 IF(IADM(1,2).NE.0) GO TO 9215
4803 8210 KK=ISHFT(IADM(2,2),9)
4804 INS(1)=MPUIOR(INS(1),KK)
4805 C
4806 C*** ESTABLISH EA(1) IN BITS 5-0
4807 8300 IF(IADM(1,1).LT.0) GO TO 9209
4808 INS(1)=INS(1)+IADM(1,1)
4809 IF(IADM(1,1).NE.0) GO TO 8320
4810 C... *** DATA REGISTER MODE
4811 INS(1)=INS(1)+IADM(2,1)
4812 RETURN
4813 8320 IF(IADM(1,1).LT.56) INS(1)=INS(1)+IADM(2,1)-8
4814 C... *** ASSURE NOT SR DESTINATION
4815 IF(IADM(1,1).EQ.64) GO TO 9233
4816 RETURN
4817 C
4818 C -------- FIELD 2 --> FIELD 1 -------
4819 C*** ESTABLISH SIZE IN BITS 7-6
4820 8400 INS(1)=INS(1)+ISIZ
4821 C
4822 C*** ESTABLISH DATA REGISTER(1) IN BITS 11-9
4823 8500 IF(IADM(1,1).NE.0) GO TO 9215
4824 8510 INS(1)=INS(1)+ISHFT(IADM(2,1),9)
4825 C
4826 C*** ESTABLISH EA(2) IN BITS 5-0
4827 C... *** IS IMMEDIATE EA ALLOWED?
4828 8600 IF(IADM(1,2).NE.60) GO TO 8610
4829 IF(NIMM(IOPC).NE.0) GO TO 9218
4830 8610 IF(IADM(1,2).LT.0) GO TO 9209
4831 INS(1)=INS(1)+IADM(1,2)
4832 IF(IADM(1,2).NE.0) GO TO 8620
4833 C... *** DATA REGISTER MODE
4834 INS(1)=INS(1)+IADM(2,2)
4835 RETURN
4836 8620 IF(IADM(1,2).LT.56) INS(1)=INS(1)+IADM(2,2)-8
4837 C... *** ASSURE NOT SR DESTINATION
4838 IF(IADM(1,2).EQ.64) GO TO 9233
4839 RETURN
4840 C
4841 C*** ERROR STOPS
4842 C
4843 C*** BYTE SIZE ERROR
4844 9205 CALL ERR(205)
4845 RETURN
4846 C... *** RANGE ERROR
4847 9208 CALL ERR(208)
4848 RETURN
4849 C... *** ILLEGAL ADDRESS MODE
4850 9209 CALL ERR(209)
4851 RETURN
4852 C*** VALUE TO BIG
4853 9210 CALL ERR(210)
4854 RETURN
4855 C*** DATA SIZE INVALID
4856 9212 CALL ERR(212)
4857 RETURN
4858 C... *** REGISTER MUST BE ADDRESS REGISTER
4859 9213 CALL ERR(213)
4860 RETURN
4861 C... *** REGISTER MUST BE DATA REGISTER
4862 9215 CALL ERR(215)
4863 RETURN
4864 C... *** NEGATIVE NOT ALLOWED
4865 9216 CALL ERR(216)
4866 RETURN
4867 C... *** BYTE MODE NOT ALLOWED
4868 9217 CALL ERR(217)
4869 RETURN
4870 C... *** DESTINATION MUST BE ALTERABLE
4871 9218 CALL ERR(218)
4872 RETURN
4873 C... *** UNDEFINED ACTION (INTERNAL ERROR)
4874 9223 CALL ERR(223)
4875 RETURN
4876 C... *** ILLEGAL REGISTER FOR THIS INSTRUCTION
4877 9233 CALL ERR(233)
4878 RETURN
4879 12340 INSL=4
4880 9234 CALL ERR(234)
4881 RETURN
4882 END
4883 SUBROUTINE OBJ
4884 CC NAM: OBJ VER: 1.0 DAT: 12/08/78 CMP: 16-BIT
4885 CC
4886 CC SYS: MACS
4887 CC
4888 CC ENT: N/A
4889 CC
4890 CC RTN: N/A
4891 CC
4892 CC FNC: CREATE THE OBJECT FILE OUTPUT
4893 CC STUFFS EACH BYTE INTO A BUFFER, CALCULATES CHECKSUM.
4894 CC
4895 CC REV: N/A
4896 CC
4897 CCALLS PNCH
4898 CC
4899 C*
4900 IMPLICIT INTEGER (A-Z)
4901 COMMON /A/ ISYM(3000),KARD1(96),ITOKEN(70),TKNSIZ,TKNTYP,
4902 & TKNVAL,TKNVA2,JSUC,JPTR,LPTR,NXSYM,KOLUMN,KD1BCT,KD1LNO,JERR,
4903 & MNUM,IPASS,IPC2,IPC,IOPC,INS(5),INSL,ISIZ,IADM(7,2),LUOT
4904 COMMON /A/ KASH(64),KPAC(15),KPWCT,LENSYM,KCLAS(64)
4905 COMMON /A/ NET1(64),NET2(64),NET3(64),NET4(64),NET5(64)
4906 COMMON /A/ NBPW,KSYS,IEOT,LSP,JBUF(83),KARD2(80,3),IHB480,IHEX9K
4907 COMMON /A/ IA1SHF,KCFF,LUSI,LUDI,LUOO,LLEN,IPLEN
4908 COMMON /A/ LIST,ICOL,NEST,LUCI,LULT,MFLD(11,3),IOBJ
4909 C
4910 C*** RETURN IF NO PUNCH OUTPUT DESIRED
4911 IF(IOBJ.EQ.0) RETURN
4912 IF(INSL.LE.0) RETURN
4913 C*** IF LONG 'STRING' DO NOT PUT OUT AGAIN
4914 IF(INSL.EQ.9) RETURN
4915 C*** SPC?
4916 IF(INSL.EQ.20) RETURN
4917 IF(INSL.NE.1) CALL PNCH(4,ISHFT(INS(1),-8))
4918 CALL PNCH(4,INS(1))
4919 GO TO (100,100,200,200,300,300,400,400,500,500),INSL
4920 C... *** ONE WORD
4921 100 RETURN
4922 C... *** THREE WORD OR LARGER
4923 C
4924 300 IF(IADM(3,2).EQ.0) GO TO 500
4925 GO TO 200
4926 400 IF(IADM(3,2).NE.2) GO TO 200
4927 C... *** PUNCH INS(2)
4928 500 CALL PNCH(4,ISHFT(INS(2),-8))
4929 CALL PNCH(4,INS(2))
4930 C... *** TWO WORD
4931 200 CALL PNCH(4,ISHFT(INS(3),-8))
4932 CALL PNCH(4,INS(3))
4933 IF(INSL.LT.6) RETURN
4934 IF(IADM(3,2).EQ.0) RETURN
4935 C... *** FOUR/FIVE WORD
4936 C
4937 IF(IADM(3,2).NE.4) GO TO 1000
4938 C... *** PUNCH INS(4)
4939 CALL PNCH(4,ISHFT(INS(4),-8))
4940 CALL PNCH(4,INS(4))
4941 C... *** FIVE WORD
4942 1000 CALL PNCH(4,ISHFT(INS(5),-8))
4943 CALL PNCH(4,INS(5))
4944 RETURN
4945 END
4946 SUBROUTINE PNCH(JTYP,JVAL)
4947 CC NAM: PNCH VER: 1.0 DAT: 02/19/79 CMP: PDP-11
4948 CC
4949 CC SYS: MACS
4950 CC
4951 CC ENT: JTYP - FUNCTION TYPE
4952 CC 1 - OUTPUT HEADER
4953 CC 2 - OUTPUT TRAILER
4954 CC 3 - NEW ORIGIN
4955 CC 4 - NEXT BYTE IN SEQUENCE
4956 CC 5 - ADJUST COUNT FOR A 'DS'
4957 CC JVAL - DATA BYTE
4958 CC
4959 CC RTN: JTYP - N/C
4960 CC JVAL - N/C
4961 CC
4962 CC FNC: WRITE THE OBJECT RECORDS TO DEVICE 'LUOO'
4963 CC IF NO OUTPUT DESIRED(IOBJ=0) IT RETURNS.
4964 CC S1 RECORD = 2 BYTE ADDRESS
4965 CC S2 RECORD = 3 BYTE ADDRESS
4966 CC
4967 CCALLS MPUAND-HEXASC-ISHFT-ADD
4968 CC
4969 C*
4970 IMPLICIT INTEGER (A-Z)
4971 COMMON /A/ ISYM(3000),KARD1(96),ITOKEN(70),TKNSIZ,TKNTYP,
4972 & TKNVAL,TKNVA2,JSUC,JPTR,LPTR,NXSYM,KOLUMN,KD1BCT,KD1LNO,JERR,
4973 & MNUM,IPASS,IPC2,IPC,IOPC,INS(5),INSL,ISIZ,IADM(7,2),LUOT
4974 COMMON /A/ KASH(64),KPAC(15),KPWCT,LENSYM,KCLAS(64)
4975 COMMON /A/ NET1(64),NET2(64),NET3(64),NET4(64),NET5(64)
4976 COMMON /A/ NBPW,KSYS,IEOT,LSP,JBUF(83),KARD2(80,3),IHB480,IHEX9K
4977 COMMON /A/ IA1SHF,KCFF,LUSI,LUDI,LUOO,LLEN,IPLEN
4978 COMMON /A/ LIST,ICOL,NEST,LUCI,LULT,MFLD(11,3),IOBJ,LLENSW,NOP
4979 DIMENSION LIN(17)
4980 DIMENSION LIN2(50)
4981 DATA JX/0/
4982 DATA CKSM/0/
4983 DATA JPC/0/,JPC1/0/
4984 DATA ISREC/1/
4985 9900 FORMAT('S',I1,50A1)
4986 C*** CHECK FOR NO OBJECT OUT
4987 IF(IOBJ.EQ.0) RETURN
4988 JVAL1=JVAL
4989 GO TO(100,200,300,400,250),JTYP
4990 C
4991 C*** OUTPUT HEADER
4992 100 WRITE(LUOO,110)
4993 110 FORMAT('S00600004844521B')
4994 RETURN
4995 C
4996 200 CONTINUE
4997 C*** OUTPUT TRAILER
4998 C*** ASSURE LAST RECORD IS OUT
4999 IF(JX.NE.0) GO TO 410
5000 220 WRITE(LUOO,210)
5001 210 FORMAT('S9030000FC')
5002 RETURN
5003 C*** INCREMENT FOR A 'DS'
5004 250 NPC1=IPC2
5005 NPC=IPC
5006 CALL ADD(NPC1,NPC,INS(2),JVAL1)
5007 GO TO 320
5008 C
5009 C*** NEW ORIGIN
5010 300 NPC=JVAL1
5011 NPC1=IPC2
5012 320 IF(JX.NE.0) GO TO 410
5013 GO TO 430
5014 C
5015 C*** NEXT BYTE IN SEQUENCE
5016 400 CONTINUE
5017 JX=JX+1
5018 LIN(JX)=JVAL1
5019 C*** IS THIS FIRST TIME THRU?
5020 IF(CKSM.NE.0) GO TO 405
5021 C*** ADD 2 BYTE ADDRESS TO COUNT
5022 J=ISHFT(JPC,-8)
5023 CKSM=IPC2 + J + MPUAND(JPC,KCFF)
5024 405 CKSM=CKSM+JVAL1
5025 IF(JX.NE.16) RETURN
5026 C*** OUTPUT THE FULL LINE
5027 C*** NPC=NPC+JX - USE 'ADD' TO GET 32 BITS.
5028 CALL ADD(NPC1,NPC,0,JX)
5029 410 JX=JX+1
5030 C*** JXX= # BYTES IN RECORD INCLUDING CHECK SUM
5031 JXX=JX + 2 + ISREC - 1
5032 J=CKSM + JXX
5033 C*** CALCULATE THE CHECK SUM.
5034 CKSM=KCFF - MPUAND(J,KCFF)
5035 LIN(JX) = CKSM
5036 C*** CONVERT THE WHOLE MESS TO ASCII
5037 CALL HEXASC(JXX,LIN2,2,1)
5038 CALL HEXASC(JPC,LIN2,4,5)
5039 J=7
5040 DO 415 I=1,JX
5041 J=J+2
5042 CALL HEXASC(LIN(I),LIN2,2,J)
5043 415 CONTINUE
5044 J=J+1
5045 C*** IS IT 16 OR 24 BIT ADDRESS?
5046 IF(ISREC.EQ.1) GO TO 425
5047 CALL HEXASC(JPC1,LIN2,2,3)
5048 WRITE(LUOO,9900) ISREC,(LIN2(I),I=1,J)
5049 GO TO 430
5050 C*** 2 BYTE ADDRESS.
5051 425 WRITE(LUOO,9900) ISREC,LIN2(1),LIN2(2),(LIN2(I),I=5,J)
5052 430 JX=0
5053 C*** OUTPUT TRAILER?
5054 IF(JTYP.EQ.2) GO TO 220
5055 CKSM = 0
5056 C*** INCREMENT THE P-COUNT
5057 JPC=NPC
5058 JPC1=NPC1
5059 IF(JPC1.NE.0) ISREC=2
5060 IF(JPC1.EQ.0) ISREC=1
5061 RETURN
5062 END
5063 SUBROUTINE PRSYM
5064 CC NAM: PRSYM VER: 1.0 DAT: 01/31/79 CMP: PDP-11
5065 CC
5066 CC SYS:MACS
5067 CC
5068 CC ENT: N/A
5069 CC
5070 CC RTN: N/A
5071 CC
5072 CC FNC: FIND SYMBOL NAME AND ADDRESS IN SYMBOL TABLE,
5073 CC STUFF IN LOW 'ISYM', SORT, THEN OUTPUT TO 'LUOT'.
5074 CC
5075 CCALLS MPUGTC-MPUPTC-MPUAND-PAGE-ISHFT
5076 CC
5077 C*
5078 IMPLICIT INTEGER (A-Z)
5079 COMMON /A/ ISYM(3000),KARD1(96),ITOKEN(70),TKNSIZ,TKNTYP,
5080 & TKNVAL,TKNVA2,JSUC,JPTR,LPTR,NXSYM,KOLUMN,KD1BCT,KD1LNO,JERR,
5081 & MNUM,IPASS,IPC2,IPC,IOPC,INS(5),INSL,ISIZ,IADM(7,2),LUOT
5082 COMMON /A/ KASH(64),KPAC(15),KPWCT,LENSYM,KCLAS(64)
5083 COMMON /A/ NET1(64),NET2(64),NET3(64),NET4(64),NET5(64)
5084 COMMON /A/ NBPW,KSYS,IEOT,LSP,JBUF(83),KARD2(80,3),IHB480,IHEX9K
5085 COMMON /A/ IA1SHF,KCFF,LUSI,LUDI,LUOO,LLEN,IPLEN
5086 COMMON /A/ LIST,ICOL,NEST,LUCI,LULT,MFLD(11,3),IOBJ,LLENSW,NOP
5087 COMMON /A/ NXSYM1
5088 DATA LSN/1/
5089 DATA LSPP/' '/
5090 C*** SHOULD TABLE BE LISTED?
5091 IF(LIST.EQ.0) RETURN
5092 9900 FORMAT(//' SYMBOL TABLE - APPROX',I5,' SYMBOL ENTRIES LEFT'/)
5093 NX=(LENSYM-NXSYM)/9
5094 WRITE(LUOT,9900) NX
5095 CALL PAGE(4)
5096 NX=NXSYM1
5097 10 ISIZ=ISHFT(ISYM(NX+1),-8)
5098 ITYP=MPUAND(ISYM(NX+1),255)
5099 C*** CHECK FOR MACRO
5100 IF(ITYP.EQ.255) GO TO 1000
5101 IF(ITYP.NE.1) GO TO 850
5102 C*** SYMBOL IS A LABEL
5103 JPTR=NX+ISIZ+3
5104 ITYP=MPUAND(ISYM(JPTR),7)
5105 IF(ITYP.GT.1) GO TO 850
5106 C*** GET CHAR SYMBOL 2 BY 2
5107 I=ISIZ*2
5108 CALL MPUGTC(J,ISYM(NX+3),I)
5109 C*** IF LAST CHAR IS BINARY ZERO, REPLACE WITH ASCII BLANK
5110 IF(J.EQ.0) CALL MPUPTC(LSP,ISYM(NX+3),I)
5111 I=ISYM(NX+3)
5112 J=LSPP
5113 IF(ISIZ.GT.1) J=ISYM(NX+4)
5114 K=LSPP
5115 IF(ISIZ.GT.2) K=ISYM(NX+5)
5116 L=LSPP
5117 IF(ISIZ.GT.3) L=ISYM(NX+6)
5118 JJ=LSN
5119 IF(LSN.EQ.1) GO TO 800
5120 70 II=LSN/6
5121 C*** NEGATIVE DO LOOP VALUE
5122 M= -1
5123 C*** FIND WHERE THIS SYMBOL GOES ALPHABETICALLY & INSERT
5124 C*** NEXT HIGH LOCATION IN TABLE
5125 KK=1
5126 IF(II.EQ.2) KK=7
5127 IF(II.LT.3) GO TO 100
5128 II=(II+1)/2
5129 KK=LSN - II*6
5130 C*** UPPER HALF OF ARRAY?
5131 100 CONTINUE
5132 KKK=KK
5133 IF(ISYM(KK).LT.I) GO TO 200
5134 C*** LOWER HALF?
5135 IF(ISYM(KK).GT.I) GO TO 400
5136 IF(ISYM(KK+1).LT.J) GO TO 200
5137 IF(ISYM(KK+1).GT.J) GO TO 400
5138 IF(ISYM(KK+2).LT.K) GO TO 200
5139 IF(ISYM(KK+2).GT.K) GO TO 400
5140 IF(ISYM(KK+3).LT.L) GO TO 200
5141 IF(ISYM(KK+3).GT.L) GO TO 400
5142 C*** UPPER HALF OF ARRAY, FIND WHICH HALF OF THIS HALF SYMBOL FALLS IN
5143 C*** ARE WE DONE?
5144 200 IF(II.EQ.1) GO TO 500
5145 C*** NOT DONE, CUT IN HALF AGAIN
5146 KK=KK + (II/2)*6
5147 II=(II+1)/2
5148 C*** ARE WE AT TOP OF TABLE?
5149 IF(KK.GE.LSN) GO TO 800
5150 GO TO 100
5151 C*** LOWER HALF, CUT IT IN HALF
5152 400 IF(II.EQ.1) GO TO 450
5153 KK=KK - (II/2)*6
5154 II=(II+1)/2
5155 GO TO 100
5156 C*** CHECK FOR POSSIBILITY CURRENT VALUE IS LESS THAN
5157 C*** NEXT LOWEST ONE BEING POINTED AT.
5158 450 IF(KK.EQ.1) GO TO 550
5159 C*** CHECK NEXT LOWER VALUE.
5160 KK=KK-6
5161 GO TO 100
5162 500 KKK=KKK+6
5163 550 CONTINUE
5164 C*** MOVE SYMBOLS UP IN TABLE
5165 JJ=LSN
5166 600 ISYM(JJ+6)=ISYM(JJ)
5167 C*** IS LOOP DONE?
5168 IF(JJ.EQ.KKK) GO TO 800
5169 JJ=JJ-1
5170 GO TO 600
5171 C*** INSERT CURRENT SYMBOL
5172 C*** SET NEXT SYMBOL IN ALPHABETICAL ORDER
5173 800 ISYM(JJ)=I
5174 ISYM(JJ+1)=J
5175 ISYM(JJ+2)=K
5176 ISYM(JJ+3)=L
5177 C*** INSERT ADDRESS OF SYMBOL.
5178 ISYM(JJ+4)=ISYM(NX)
5179 ISYM(JJ+5)=ISYM(JPTR+1)
5180 C*** FIND BYTE POSITION TO CHECK FOR ZERO IF ODD # OF CHAR IN NAME.
5181 LSN=LSN+6
5182 C*** ADVANCE TOTHE NEXT SYMBOL
5183 850 NX=NX+ISIZ+5
5184 IF(NX.LT.NXSYM) GO TO 10
5185 C*** IF NO ENTRIES DON'T OUTPUT.
5186 870 IF(LSN.EQ.1) GO TO 900
5187 LSN=LSN-1
5188 C*** PRINT SYMBOL TABLE
5189 DO 300I=1,LSN,24
5190 NX=I+23
5191 IF(NX.GT.LSN) NX=LSN
5192 II=1
5193 DO 250 J=I,NX,6
5194 JBUF(II)=ISHFT(ISYM(J),8)+ISHFT(ISYM(J),-8)
5195 JBUF(II+1)=ISHFT(ISYM(J+1),8)+ISHFT(ISYM(J+1),-8)
5196 JBUF(II+2)=ISHFT(ISYM(J+2),8)+ISHFT(ISYM(J+2),-8)
5197 JBUF(II+3)=ISHFT(ISYM(J+3),8)+ISHFT(ISYM(J+3),-8)
5198 C*** CONVERT HEX TO ASCII
5199 CALL HEXASC(ISYM(J+4),JBUF,2,II+4)
5200 CALL HEXASC(ISYM(J+5),JBUF,4,II+6)
5201 II=II+10
5202 250 CONTINUE
5203 II=II-1
5204 WRITE(LUOT,998) (JBUF(J),J=1,II)
5205 CALL PAGE(1)
5206 300 CONTINUE
5207 998 FORMAT(4(1X,4A2,3X,6A1))
5208 900 CONTINUE
5209 RETURN
5210 C*** FIND END OF MACRO AND START WITH SYMBOL FOLLOWING IT.
5211 1000 CONTINUE
5212 NX=NX+ISIZ+5
5213 1040 K=1
5214 IF(NX.GE.NXSYM) GO TO 870
5215 1050 CALL MPUGTC(I,ISYM(NX),K)
5216 K=K+1
5217 C*** END OF MACRO DEFINITION IS A 04 FOLLOWED BY WORD OF ZEROS
5218 IF(I.NE.4) GO TO 1050
5219 NX=NX+(K+2)/2-1
5220 IF(ISYM(NX).NE.0) GO TO 1040
5221 NX=NX+1
5222 GO TO 10
5223 END
5224 SUBROUTINE PAGE(LCNT)
5225 CC NAM: PAGE VER: 1.0 DAT: 02/02/79 CMP: PDP-11
5226 CC
5227 CC SYS: MC6800 ASM
5228 CC
5229 CC ENT: LCNT - NUMBER OF LINES JUST OUTPUT, OR IF > 79 THEN
5230 CC - 80 = SET TTL IN BUFFER
5231 CC - 81 = OUTPUT HEADER TO DEVICE 'LULT'
5232 CC - 82 = OUTPUT HEADER TO DEVICE 'LUOT'
5233 CC - 83 = SAME AS 82 FOR PDP-11
5234 CC - 84 = 'PAGE', SLEW TO TOP OF PAGE IF 'LUOT'=PRINTER
5235 CC - 85 = SKIP TO BOTTOM OF PAGE, DONOT PRINT HEADER
5236 CC
5237 CC RTN: N/C
5238 CC
5239 CC FNC: THIS ROUTINE INCREMENTS THE LINE COUNTER AND OUTPUTS A
5240 CC TOP OF PAGE HEADER AT PROPER TIME. IT PUTS
5241 CC HEADER INTO OUTPUT BUFFER WHEN ENCOUNTERING THE 'TTL'
5242 CC COMMAND. PAGING IS EFFECTIVE FOR PRINTER OUTPUT ONLY.
5243 CC THIS ROUTINE CONTAINS THE RELEASE # AND COPYRIGHT
5244 CC MESSAGE IN A DATA STATEMENT, THE ONLY PLACE IT APPEARS
5245 CC IN THE PROGRAM.
5246 CC NOTE: THIS ROUTINE CAN POSSIBLY BE CHANGED TO CALL ADD ROUTINE
5247 CC THIS WOULD HELP DECREASE ASSEMBLE TIME. TRY:
5248 CC CALL ADD(IPC2,IPC,0,INSL)
5249 CC THEN REMOVE ALL OTHER INSTRUCTIONS FROM DATA IO1
5250 CC TO STATEMENT 240.
5251 CC
5252 CCALLS MPUPTC
5253 CC
5254 C*
5255 IMPLICIT INTEGER (A-Z)
5256 COMMON /A/ISYM(3000),KARD1(96),ITOKEN(70),TKNSIZ,TKNTYP,
5257 & TKNVAL,TKNVA2,JSUC,JPTR,LPTR,NXSYM,KOLUMN,KD1BCT,KD1LNO,JERR,
5258 & MNUM,IPASS,IPC2,IPC,IOPC,INS(5),INSL,ISIZ,IADM(7,2),LUOT
5259 COMMON /A/ KASH(64),KPAC(15),KPWCT,LENSYM,KCLAS(64)
5260 COMMON /A/ NET1(64),NET2(64),NET3(64),NET4(64),NET5(64)
5261 COMMON /A/ NBPW,KSYS,IEOT,LSP,JBUF(83),KARD2(80,3),IHB480,IHEX9K
5262 COMMON /A/ IA1SHF,KCFF,LUSI,LUDI,LUOO,LLEN,IPLEN
5263 COMMON /A/ LIST,ICOL,NEST,LUCI,LULT,MFLD(11,3),IOBJ,LLENSW,NOP
5264 DIMENSION ITTL(30)
5265 C*** RELEASE AND COPYRIGHT MESSAGE..
5266 DATA ITTL/'MC','68','00','0 ','AS','M ','RE'
5267 & ,'V=',' 1','.4',' -',' C','OP','YR','IG','HT'
5268 & ,' B','Y ','MO','TO','RO','LA',' 1','97','8 ',' ',
5269 & ' ',' ',' ',' '/
5270 DATA IPAGE/1/,LINENO/0/
5271 DATA ITTLSZ/30/
5272 C*** ITTLSZ IS SIZE OF 'ITTL'
5273 DATA ISW/0/
5274 998 FORMAT(2X,30A2,' PAGE',I3//)
5275 9900 FORMAT(80A1)
5276 9910 FORMAT(5X,40A2)
5277 9920 FORMAT(1X,30A2)
5278 9930 FORMAT(2X,30A2)
5279 C*** ALWAYS SET TTL
5280 IF(LCN.EQ.80) GO TO 500
5281 C** IS LISTING REQUIRED?
5282 IF(LIST.EQ.0) RETURN
5283 C*** IS PAGING REQUIRED?
5284 IF(NOP.EQ.0) RETURN
5285 LCN=LCNT
5286 IF(LCN.GT.79) GO TO 500
5287 C*** INCREMENT LINE COUNT
5288 LINENO=LINENO+LCN
5289 IF(LINENO.LT.IPLEN-6) RETURN
5290 C*** PAGE IT
5291 GO TO 8400
5292 500 CONTINUE
5293 LCN=LCN-79
5294 GO TO(8000,8100,8200,8300,8400,8400),LCN
5295 RETURN
5296 C*** PUT TTL IN BUFFER
5297 8000 CONTINUE
5298 DO 8020 I=1,30
5299 8020 ITTL(I)=' '
5300 J=1
5301 C*** FIND 'TTL' IN BUFFER
5302 DO 8030 I=LCN,72
5303 C*** LOOK FOR 'L' IN 'TTL'
5304 IF(KARD1(I).EQ.76) GO TO 8040
5305 8030 CONTINUE
5306 8040 LCN= I+1
5307 C*** INSERT THE TITLE.
5308 DO 8050 I=LCN,64
5309 CALL MPUPTC(KARD1(I),ITTL,J)
5310 J=J+1
5311 8050 CONTINUE
5312 C*** REVERSE THE LETTERS IN TITLE
5313 DO 8060 I=1,30
5314 ITTL(I)=ISHFT(ITTL(I),8) + ISHFT(ITTL(I),-8)
5315 8060 CONTINUE
5316 RETURN
5317 C*** OUTPUT TO 'LULT'
5318 8100 WRITE(LULT,9920) (ITTL(I),I=1,ITTLSZ)
5319 RETURN
5320 C*** OUTPUT TO LUOT
5321 8200 CONTINUE
5322 C*** IF ERRORS IN PASS1 SLEW TO TOP OF PAGE FOR PASS2
5323 IF(LINENO.EQ.3) RETURN
5324 IF(LINENO.EQ.0) GO TO 8220
5325 GO TO 8400
5326 8220 IF(LUOT.NE.LULT) WRITE(LUOT,998) (ITTL(I),I=1,ITTLSZ),IPAGE
5327 IPAGE=IPAGE+1
5328 LINENO=3
5329 RETURN
5330 8300 CONTINUE
5331 GO TO 8200
5332 8400 CONTINUE
5333 C*** SKIP TO TOP OF PAGE
5334 IF(LUOT.EQ.LULT) RETURN
5335 DO 8450 I=LINENO,IPLEN
5336 WRITE(LUOT,9900) LSP
5337 8450 CONTINUE
5338 LINENO=3
5339 IF(LCN.EQ.6) RETURN
5340 GO TO 8220
5341 9000 RETURN
5342 END
5343 SUBROUTINE PCOUNT
5344 CC NAM: PCOUNT VER: 1.0 DAT: 01/29/79 CMP: PDP-11
5345 CC
5346 CC SYS: MACS
5347 CC
5348 CC ENT: 'IPC' CONTAINS 2 LEAST SIGNIFICANT BYTES OF P-COUNT.
5349 CC 'IPC2' = MOST SIGNIFICANT BYTE OF P-COUNTER.
5350 CC 'INSL' = AMOUNT TO INCREMENT P-COUNT BY.
5351 CC
5352 CC RTN: 'IPC' AND 'IPC2' HAVE NEXT P-COUNT.
5353 CC
5354 CC FNC: THE CURRENT INSTRUCTION LENGTH IN 'INSL' IS ADDED
5355 CC TO 'IPC' & 'IPC2' TO GIVE NEXT INSTRUCTION ADDRESS.
5356 CC
5357 CC REV: N/A
5358 CC
5359 C*
5360 IMPLICIT INTEGER (A-Z)
5361 COMMON /A/ ISYM(3000),KARD1(96),ITOKEN(70),TKNSIZ,TKNTYP,
5362 & TKNVAL,TKNVA2,JSUC,JPTR,LPTR,NXSYM,KOLUMN,KD1BCT,KD1LNO,JERR,
5363 & MNUM,IPASS,IPC2,IPC,IOPC,INS(5),INSL,ISIZ,IADM(7,2),LUOT
5364 COMMON /A/ KASH(64),KPAC(15),KPWCT,LENSYM,KCLAS(64)
5365 COMMON /A/ NET1(64),NET2(64),NET3(64),NET4(64),NET5(64)
5366 COMMON /A/ NBPW,KSYS,IEOT,LSP,JBUF(83),KARD2(80,3),IHB480,IHEX9K
5367 COMMON /A/ IA1SHF,KCFF,LUSI,LUDI,LUOO,LLEN,IPLEN
5368 COMMON /A/ LIST,ICOL,NEST
5369 DATA IO1/O100000/,IO7/O77777/
5370 C*** SAVE M.S. BIT
5371 K=IPC .AND. IO1
5372 C*** REMOVE M.S. BIT SO CARRY ON ADD CAN BE DETECTED
5373 IPC=IPC .AND. IO7
5374 IPC=IPC + INSL
5375 C*** DID ADD PUT A BIT IN 16TH POSITION?
5376 J=IPC .AND. IO1
5377 IF(J.NE.0) GO TO220
5378 C*** NO CARRY ON ADD, PUT 16TH BIT BACK IN CASE IT IS 1.
5379 IPC=IPC .OR. K
5380 GO TO 240
5381 220 CONTINUE
5382 C*** ADD HAD CARRY, INCREMENT 2ND WORD IF PREVIOUS UPPER BIT NOT ZERO.
5383 IF(K.NE.0) K=1
5384 IPC2=IPC2+K
5385 C*** J NE 0 AND K NE 0 THERE IS ROLL OVER AND 16TH BIT MUST BE ZERO.
5386 IF(K.EQ.1) IPC=IPC .AND. IO7
5387 240 CONTINUE
5388 RETURN
5389 END
5390 SUBROUTINE HEXASC(IHEX,IB,KNT,IPOS)
5391 CC NAM: HEXASC VER: 1.0 DATE: 05/18/19 CMP: PDP-11
5392 CC
5393 CC SYS: MACS
5394 CC
5395 CC ENT: IHEX - CONTAINS HEX CHARACTERS TO CONVERT
5396 CC IB - N/A
5397 CC KNT - NUMBER OF HEX CHAR TO CONVERT
5398 CC MAX OF 4 HEX CHARS, ONE WORD, CAN BE CONVERTED AT A TI
5399 CC IPOS - POSITION IN 'IB' TO PUT THE CONVERTED CHARS.
5400 CC
5401 CC RTN: IHEX - N/C
5402 CC IB - CONTAINS THE HEX CHARS IN ASCII, 1 PER WORD
5403 CC KNT - N/C
5404 CC IPOS - N/C
5405 CC
5406 CC REV: N/A
5407 CC
5408 CC
5409 CC FNC: CHANGE HEX VALUES TO ASCII AND STORE ONE CONVERTED HEX VALUE
5410 CC PER ARRAY WORD.
5411 CC
5412 CCALLS MPUAND-ISHFT
5413 C*
5414 IMPLICIT INTEGER (A-Z)
5415 COMMON /A/ ISYM(3000),KARD1(96),ITOKEN(70),TKNSIZ,TKNTYP,
5416 & TKNVAL,TKNVA2,JSUC,JPTR,LPTR,NXSYM,KOLUMN,KD1BCT,KD1LNO,JERR,
5417 & MNUM,IPASS,IPC2,IPC,IOPC,INS(5),INSL,ISIZ,IADM(7,2),LUOT
5418 COMMON /A/ KASH(64),KPAC(15),KPWCT,LENSYM,KCLAS(64)
5419 COMMON /A/ NET1(64),NET2(64),NET3(64),NET4(64),NET5(64)
5420 COMMON /A/ NBPW,KSYS,IEOT,LSP,JBUF(83),KARD2(80,3),IHB480,IHEX9K
5421 COMMON /A/ IA1SHF,KCFF,LUSI,LUDI,LUOO,LLEN,IPLEN
5422 COMMON /A/ LIST,ICOL,NEST
5423 DIMENSION IB(120)
5424 IPOS2=IPOS+KNT-1
5425 K=IHEX
5426 DO 100 I=1,KNT
5427 C*** GET 1ST 4 BITS
5428 J=MPUAND(K,15)
5429 C*** CHECK 0-9 & A-F
5430 IF(J.GT.9) GO TO 50
5431 C*** 0-9
5432 IB(IPOS2)=J+48
5433 GO TO 80
5434 C*** A-F
5435 50 CONTINUE
5436 IB(IPOS2)=J + 55
5437 80 IPOS2=IPOS2-1
5438 C*** GET THE NEXT 4 BITS TO THE RIGHT, LEAST SIGNIFICANT.
5439 K=ISHFT(K,-4)
5440 100 CONTINUE
5441 RETURN
5442 END
5443 FUNCTION MPUAND (JA,JB)
5444 CC NAM: MPUAND VER: 1.0 DATE: 04/16/79 CMP: PDP-11
5445 CC
5446 CC SYS: MACS
5447 CC
5448 CC ENT: JA - VALUE TO BE ANDED
5449 CC JB - VALUE TO AND WITH
5450 CC
5451 CC RTN: JA - N/C
5452 CC JB - N/C
5453 CC
5454 CC FNC: 'AND' JA WITH JB
5455 CC
5456 CC REV: N/A
5457 C*
5458 MPUAND=JA .AND. JB
5459 RETURN
5460 END
5461 FUNCTION MPUIOR (JA,JB)
5462 CC NAM: MPUIOR VER: 1.0 DATE: 04/16/79 CMP:PDP-11
5463 CC
5464 CC SYS: MACS
5465 CC
5466 CC ENT: JA - VALUE TO BE 'ORED'
5467 CC JB - VALUE TO USE IN THE 'OR'
5468 CC
5469 CC RTN: JA - N/C
5470 CC JB - N/C
5471 CC
5472 CC FNC: THE VALUE OF JB IS 'ORED' INTO JA
5473 CC
5474 CC REV: N/A
5475 CC
5476 C*
5477 MPUIOR= JA .OR. JB
5478 RETURN
5479 END
5480 FUNCTION ISHFT(K1,K2)
5481 CC NAM: ISHFT VER: 1.0 DATE: 04/16/79 CMP: PDP-11
5482 CC
5483 CC SYS: MACS
5484 CC
5485 CC ENT: K1 - VALUE TO BE SHIFTED
5486 CC K2 - AMOUNT TO SHIFT K1
5487 CC = MINUS VALUE, SHIFT RIGHT TO LSB.
5488 CC = POSITIVE VALUE, SHIFT LEFT, HIGH ORDER BIT.
5489 CC
5490 CC RTN: K1 - N/C
5491 CC K2 - N/C
5492 CC
5493 CC FNC: SHIFT A 16-BIT WORD RIGHT OR LEFT.
5494 CC
5495 CC REV: N/A
5496 CC
5497 CCALLS IABS
5498 DATA IO7/O37777/
5499 DATA IO57S/O77777/
5500 DATA IO4/O40000/
5501 DATA IO1/O100000/
5502 K=K1
5503 C***
5504 C*** ASSEMBLY ROUTINE SHIFT MAY NOT BE RETURNING RIGHT
5505 C**
5506 C*** USE MULT AND DIVIDE FOR NOW
5507 C
5508 KK=K2
5509 50 CONTINUE
5510 C*** IF SHIFT VALUE IS ZERO, RETURN
5511 IF(KK.EQ.0) GO TO 300
5512 IF(KK.LT.0) GO TO 100
5513 DO 80 I=1,KK
5514 C*** SAVE 15TH BIT IN CASE ON. IF SO IT CAUSES A RUNTIME
5515 C*** MULTIPLY ERROR. IF ON IT MUST BE OR'ED IN LATER SO IT ISN'T LOST
5516 KKK=K .AND. IO4
5517 K=K .AND. IO7
5518 80 K=K*2
5519 C*** IF THE 15TH BIT WAS ON BEFORE LAST SHIFT, OR IT IN HERE, IT IS
5520 C*** THE 16TH BIT.
5521 IF(KKK.NE.0) K=K .OR. IO1
5522 ISHFT=K
5523 RETURN
5524 100 KK=IABS(KK)
5525 C*** STATEMENT: KK= -KK APEARS TO CAUSE F342 ERROR, SO USED IABS
5526 DO 250 I=1,KK
5527 C*** KEEP UPPER BIT IN CASE ON. IF IT IS ON IT MUST BE OR'ED
5528 C*** IN. IF LEFT ON # IS MINUS AND DIVIDE WILL NOT WORK FOR SHIFTING
5529 C*** DATA.
5530 KKK=K .AND. IO1
5531 K=K .AND. IO57S
5532 K=K/2
5533 C*** IF 16TH BIT WAS ON PUT IT IN 15TH POSITION .
5534 IF(KKK.NE.0) K=K .OR. IO4
5535 250 CONTINUE
5536 300 CONTINUE
5537 ISHFT=K
5538 RETURN
5539 END
5540 SUBROUTINE MPUPTC(JBYT,JBUF,JBIX)
5541 CC NAM: MPUPTC VER: 1.0 DATE: 04/19/79 CMP: 16-BIT
5542 CC
5543 CC SYS: MACS
5544 CC
5545 CC ENT: JBYT - BYTE IN THE RIGHT 8 BITS OF THE WORD(LOW ORDER BITS)
5546 CC JBUF - N/A
5547 CC JBIX - BYTE INDEX LOCATION TO PLACE JBYT IN JBUF, LEFT BYTE
5548 CC IS BYTE 1 ETC.
5549 CC
5550 CC RTN: JBYT - N/C
5551 CC JBUF - CONTAINS BYTE FROM JBYT IN THE JBIX POSITION
5552 CC JBIX - N/C
5553 CC
5554 CC FNC: TAKE THE RIGHT JUSTIFIED, ZERO FILLED BYTE FROM
5555 CC JBYT AND PLACE IT IN THE JBIX POSITION OF JBUF.
5556 CC
5557 CC REV: N/A
5558 CC
5559 CCALLS MPUAND-ISHFT-MOD
5560 CC
5561 C*
5562 DIMENSION JBUF(10)
5563 DATA IOV1/O177400/
5564 K1=JBIX
5565 J1=JBYT
5566 KK=MOD(K1,2)
5567 IF(KK.EQ.0) GO TO 500
5568 C*** M.S. BYTE - UPPER BYTE OF WORD
5569 K1=K1/2+1
5570 KK=JBUF(K1)
5571 JBUF(K1)=MPUAND(KK,255) + ISHFT(J1,8)
5572 RETURN
5573 C*** L.S. BYTE - LOWER BYTE OF WORD
5574 500 CONTINUE
5575 K1=K1/2
5576 KK=JBUF(K1)
5577 JBUF(K1)=MPUAND(KK,IOV1) + J1
5578 RETURN
5579 END
5580 SUBROUTINE MPUGTC(JBYT,JBUF,JBIX)
5581 CC NAM: MGUPTC VER: 1.0 DATE: 04/19/79 CMP: 16-BIT
5582 CC
5583 CC SYS: MACS
5584 CC
5585 CC ENT: JBYT - N/A
5586 CC JBUF - WORD OR ARRAY CONTAINING DESIRED BYTE(CHAR)
5587 CC JBIX - INDEX, POSITION IN JBUF TO GET BYTE(CHAR) FROM
5588 CC
5589 CC RTN: JBYT - BYTE(CHAR) FROM JBUF, RIGHT JUSTIFIED, ZERO FILLED
5590 CC JBUF - N/C
5591 CC JBIX - N/C
5592 CC
5593 CC FNC: TAKE THE JBIX BYTE(CHAR) FROM JBUF AND STORE IT
5594 CC RIGHT JUSTIFIED, ZERO FILLED IN JBYT, THE LOWER 8 BITS.
5595 CC
5596 CC REV: N/A
5597 CC
5598 CCALLS MPUAND-ISHFT-MOD
5599 CC
5600 C*
5601 DIMENSION JBUF(1)
5602 K1=JBIX
5603 KK=MOD(K1,2)
5604 IF(KK.EQ.0) GO TO 500
5605 C*** M.S. BYTE - UPPER BYTE OF WORD
5606 K1=K1/2+1
5607 KK=JBUF(K1)
5608 JBYT=ISHFT(KK,-8)
5609 RETURN
5610 C*** L.S. BYTE - LOWER BYTE OF WORD
5611 500 CONTINUE
5612 K1=K1/2
5613 KK=JBUF(K1)
5614 JBYT=MPUAND(KK,255)
5615 RETURN
5616 END
5617 SUBROUTINE ASCBIN
5618 CC NAM: ASCBIN VER: 1.0 DATA@E: 04-23/79 CMP: PDP-11
5619 CC
5620 CC SYS: MACS
5621 CC
5622 CC ENT: 'ITOKEN' = THE ARRAY WHICH CONTAINS THE RIGHT JUSTIFIED
5623 CC ZERO FILLED ASCII NUMBER.
5624 CC 'TKNSIZ' = NUMBER OF CHARACTERS IN 'ITOKEN'
5625 CC 'TKNVAL AND 'TKNVA2'= 0
5626 CC
5627 CC RTN: 'TKNVAL' = 2 LEAST SIGNIFICANT BYTES.
5628 CC 'TKNVA2' = 2 M.S.B.
5629 CC
5630 CC FNC: THIS ROUTINE TAKES A RIGHT JUSTIFIED, ZERO FILLED ASCII
5631 CC ARRAY AND CONVERTS IT TO A BINARY # UP TO 4 BYTES LONG.
5632 CC
5633 CC REV: N/A
5634 CC
5635 CCALLS ISHFT
5636 CC
5637 C*
5638 C*
5639 IMPLICIT INTEGER (A-Z)
5640 COMMON /A/ ISYM(3000),KARD1(96),ITOKEN(70),TKNSIZ,TKNTYP,
5641 & TKNVAL,TKNVA2,JSUC,JPTR,LPTR,NXSYM,KOLUMN,KD1BCT,KD1LNO,JERR,
5642 & MNUM,IPASS,IPC2,IPC,IOPC,INS(5),INSL,ISIZ,IADM(7,2),LUOT
5643 COMMON /A/ KASH(64),KPAC(15),KPWCT,LENSYM,KCLAS(64)
5644 COMMON /A/ NET1(64),NET2(64),NET3(64),NET4(64),NET5(64)
5645 COMMON /A/ NBPW,KSYS,IEOT,LSP,JBUF(83),KARD2(80,3),IHB480,IHEX9K
5646 COMMON /A/ IA1SHF,KCFF,LUSI,LUDI,LUOO,LLEN,IPLEN
5647 COMMON /A/ LIST,ICOL,NEST
5648 C***
5649 DATA IO1/O100000/
5650 DATA IO7/O77777/
5651 DO 600 I=1,TKNSIZ
5652 C*** REMOVE ASCII BITS
5653 ITOKEN(I)=ITOKEN(I) - 48
5654 C*** SAVE FOR LATER
5655 TKNVA3=TKNVAL
5656 TKNVA4=TKNVA2
5657 C*** SHIFT TWICE
5658 DO 100 J=1,2
5659 C*** IS M.S. BIT ON?
5660 K=TKNVAL .AND. IO1
5661 C*** SHOULD M.S. BIT BE MOVED INTO 2ND WORD, 1ST BIT.
5662 IF(K.NE.0) K=1
5663 TKNVA2=ISHFT(TKNVA2,1)+K
5664 50 TKNVAL=ISHFT(TKNVAL,1)
5665 100 CONTINUE
5666 C*** ADD IN THE # WE HAD BEFORE SHIFTING STARTED
5667 C
5668 C*** SAVE M.S. BIT
5669 K=TKNVAL .AND. IO1
5670 C*** REMOVE M.S. BITSO CARRY ON ADD CAN BE DETECTED
5671 TKNVAL=TKNVAL .AND. IO7
5672 200 TKNVAL=TKNVAL+TKNVA3
5673 C*** DID ADD PUT A BIT IN 16TH POSITION?
5674 J=TKNVAL .AND.IO1
5675 C*** NO CARRY ON ADD, PUT 16TH BIT BACK IN CASE IT IS 1
5676 IF(J.EQ.0)
5677 1 TKNVAL=TKNVAL .OR. K
5678 220 CONTINUE
5679 C*** ADD HAD CARRY, INCREMENT 2ND WORD IF PREVIOUS UPPER BIT NOT ZERO.
5680 IF(K.NE.0) K=1
5681 IF(J.EQ.0) K=0
5682 TKNVA2=TKNVA2+K+TKNVA4
5683 C*** IF J NE 0 AND K NE 0 THERE IS ROLL OVER & 16TH BIT MUST BE ZERO
5684 IF(K.EQ.1) TKNVAL=TKNVAL .AND. IO7
5685 240 CONTINUE
5686 C*** SHIFT LEFT ONE MORE BIT
5687 K=TKNVAL .AND. IO1
5688 IF(K.NE.0) K=1
5689 TKNVA2=ISHFT(TKNVA2,1)+K
5690 250 TKNVAL=ISHFT(TKNVAL,1)
5691 C*** SAVE M.S. BIT
5692 K=TKNVAL .AND. IO1
5693 C*** REMOVE M.S. BIT SO CARRY ON ADD CAN BE DETECTED
5694 TKNVAL=TKNVAL .AND. IO7
5695 C*** ADD IN THE NEW #.
5696 TKNVAL=TKNVAL+ITOKEN(I)
5697 C*** DID ADD PUT A BIT IN 16TH POSITION?
5698 J=TKNVAL .AND. IO1
5699 IF(J.NE.0) GO TO 300
5700 C*** NO CARRY ON ADD, PUT 16TH BIT BACK IN CASE IT IS 1
5701 TKNVAL=TKNVAL .OR. K
5702 GO TO 400
5703 300 CONTINUE
5704 C*** ADD HAD CARRY, INCREMENT 2ND WORD IF PREVIOUS UPPER BIT NOT ZERO.
5705 IF(K.NE.0) K=1
5706 TKNVA2=TKNVA2+K
5707 C*** IF J NE 0 & K NE 0 THERE IS CARRY OVER, ZERO 16TH BIT.
5708 IF(K.EQ.1) TKNVAL=TKNVAL .AND. IO7
5709 400 CONTINUE
5710 600 CONTINUE
5711 RETURN
5712 END
\f
programunit missng page 1
error messages
6. line 438 . 3 statement structure
line 439 . 0 statement sequence
line 442 . 0 statement sequence
line 443 . 0 statement sequence
line 444 . 0 statement sequence
line 445 . 0 statement sequence
line 446 . 0 statement sequence
line 447 . 0 statement sequence
line 448 . 0 statement sequence
line 449 . 0 statement sequence
line 453 . 0 statement sequence
line 474 . 4 type
line 477 . 3 type
line 505 . 3 type
line 506 . 3 type
line 508 . 3 type
line 509 . 3 type
line 510 . 3 type
line 511 . 3 type
line 512 . 3 type
line 525 . 1 label not referred
line 528 . 1 label not referred
line 548 . 3 type
line 549 . 3 type
line 550 . 3 type
line 551 . 3 type
line 552 . 3 type
line 565 . 1 label not referred
line 570 . 3 call
line 570 . 4 type
line 572 illegal number of main programs
***fortran sorry 90
▶EOF◀