Added CREF.MAC
[retro-software/dec/tops10/v4.5.git] / src / cref.mac
1 TITLE   CREF V40A - CROSS REFERENCE PROGRAM\r
2 SUBTTL CCL SYSTEM - BOWERING/RPG/PMH/NGP/TNH/TWE/JBS - 01-MAY-71\r
3 ;*****(C)COPYRIGHT 1968,1969,1970,1971, DIGITAL EQUIPMENT CORP., MAYNARD MASS.,USA *****\r
4 \r
5 INTERNAL JOBVER,PURE\r
6 LOC <JOBVER==137>\r
7         XWD 0,000040    ;CREF VERSION NUMBER\r
8 \r
9 IFNDEF PURE,<PURE=1>\r
10    IFN PURE,<HISEG>\r
11 \r
12 EXTERNAL        JOBFF,  JOBREL, JOBDDT, JOBSYM\r
13 INTERNAL        CREF\r
14 \r
15 IFNDEF TEMPC,<TEMPC==1> ;TMPCOR UUO ALLOWED IF SET TO 1\r
16 IFNDEF FAILC,<FAILC==1> ;NO FAIL BLOCK STRUCTURE UNLESS REQUESTED\r
17 ;ACCUMULATOR DEFINITIONS\r
18 AC0=0\r
19 TEMP=1\r
20 TEMP1=2\r
21 WPL=3   ;CONTAINS COUNT OF HOW MANY REFERENCES/LINE IN LISTING\r
22 RC=WPL\r
23 SX=4\r
24 BYTEX=5\r
25 BYTEM=6\r
26 TX=BYTEM\r
27 TIO=6   ;AC USED FOR MTAPE FLAGS IN COMMAND SCANNER LOGICTX=BYTEM\r
28 C=7\r
29 CS=10\r
30 LINE=11 ;HOLDS LINE #\r
31 FLAG=12\r
32 FREE=13 ;POINTS TO HIGH END OF INCREMENT BYTE TABLE\r
33 SYMBOL=14       ;POINTS TO ENTRY COUNT AT LOW END OF SYMBOL TABLE\r
34 TOP=15  ;CONTAINS HIGHEST AVAILABLE ADR IN MEMORY\r
35 IO=16   ;HOLDS FLAGS\r
36 PP=17   ;PUSH DOWN POINTER\r
37 \f;DEFINITIONS FOR LENGTHS OF LINES AND PAGES\r
38 WPLLPT==^D14    ;IN OUTPUT LPT LISTING, 14 REFERENCES/LINE\r
39 WPLTTY==8       ;IN OUTPUT TTY LISTING, 8 REFERENCES/LINE\r
40 .LPP==^D53      ;LINES PER PAGE IN LISTING\r
41 PDL==30         ;PUSH DOWN STACK LENGTH\r
42 \r
43 IOLST== 000001  ;IF 1, SUPPRESS PROGRAM LISTING\r
44 IONCRF==000002  ;1 IF COMMAND STRING SEARCH LIMITS BEING USED\r
45 IOPAGE==000004  ;IF 1, DO A FORM FEED\r
46 IOFAIL==000010  ;1 IF "NEW STYLE" CREF DATA HAS BBEN SEEN\r
47 IODEF== 000020  ;1 IF SYMBOL IS A DEFINING OCCURRANCE\r
48 IOENDL==000040\r
49 IORPG== 000100  ;1 IF RPG SYSTEM IN USE (SET BY STATTING AT (JOBSA)+1)\r
50 IOTABS==000200  ;"RUBOUT A" SEEN AT AND OF CREF DATA (INSERT TAB IN LISTING)\r
51 IOEOF== 000400  ;END OF FILE SEEN\r
52 IONLZ== 001000  ;LEADING ZERO TEST\r
53 IOTB2== 002000  ;FOR F4\r
54 IOTTY== 004000  ;1 IF LISTING DEVICE IS TTY\r
55 IOERR== 010000  ;IMPROPER INPUT DATA SEEN\r
56 IODF2== 020000  ;DEFINING OCCURRANCE OF A SYMBOL\r
57 IOSYM== 040000  ;SYMBOL DEFINED WITH = OR :\r
58 IOMAC== 100000  ;MACRO NAME\r
59 IOOP==  200000  ;OPDEF, OP CODE, OR PSEUDO INSTRUCTION OCCURRANCE\r
60 IOPROT==400000  ;1 IF INPUT 'CRF' OR 'LST' FILE IS PROTECTED\r
61                 ;BY /P SWITCH\r
62 \r
63 \f;DEFINITIONS FOR "OLD STYLE" CODES FROM VARIOUS PROCESSORS\r
64 %OP==33\r
65 %MAC==34\r
66 %LINE==35\r
67 %SYM==36\r
68 %EOF==37        ;MULTIPLE-PROGRAM BREAK CHARACTER\r
69 \r
70 A==0            ;ASCII MODE\r
71 AL==1           ;ASCII LINE MODE\r
72 \r
73 CTLI==1         ;CONTROL DEVICE NUMBER (INPUT)\r
74 CHAR==2                 ;INPUT DEVICE NUMBER\r
75 LST==3                  ;LISTING DEVICE NUMBER\r
76 \r
77 ;       COMMAND STRING ACCUMULATORS\r
78 \r
79 ACDEV=TEMP                      ;DEVICE\r
80 ACFILE=TEMP1                    ;FILE\r
81 ACEXT=LINE                      ;EXTENSION\r
82 ACDEL=4                 ;DELIMITER\r
83 ACPNTR=5                        ;BYTE POINTER\r
84 \r
85 ;FLAGS USED IN AC TIO\r
86 \r
87 TIORW==1000     ;MTAPE REWIND FLAG\r
88 TIOLE==2000     ;SET(BUT NOT USED ANYWHERE) BY BACKSPACE REQUEST\r
89 TIOCLD==20000   ;CLEAR DIRECTORY FLAG\r
90 \r
91 OPDEF   RESET   [CALLI   0]\r
92 OPDEF   DEVCHR  [CALLI   4]\r
93 OPDEF   WAIT    [MTAPE   0]\r
94 OPDEF   CORE    [CALLI  11]\r
95 OPDEF   UTPCLR  [CALLI  13]\r
96 \r
97 OPDEF   DDTOUT  [CALLI 3]\r
98 OPDEF   EXIT    [CALLI 12]\r
99 TMPCOR==44      ;TMPCOR UUO CALLI #\r
100 \f\r
101 MLON\r
102 \r
103 CREF:   TDZA IO,IO              ;START HERE FROM (JOBSA)\r
104         MOVSI IO,IORPG          ;START HERE FROM (JOBSA)+1\r
105         RESET\r
106         MOVEI ENDCLR\r
107         MOVEM JOBFF             ;INIT JOBFF TO 1ST FREE LOCATION\r
108         MOVE PP,[IOWD PDL,PPSET]        ;INIT PUSH DOWN LIST\r
109 \r
110 IFN TEMPC,<\r
111         SETZM TMPFLG            ;ZERO TMPCOR FLAG\r
112         TLNN IO,IORPG           ;IS A CCL TYPE CALL?\r
113         JRST TMPEND             ;NO\r
114         HRRZ AC0,JOBFF          ;GET START OF BUFFER AREA\r
115         HRLI AC0,-200           ;-LENGTH IN LH FOR TMPCOR IOWD\r
116         MOVEM AC0,TMPFIL+1      ;STORE IT IN TMPCOR IOWD\r
117         SOS TMPFIL+1            ;MAKE IT CONFORM TO IOWD FORMAT\r
118         HRRM AC0,CTIBUF+1       ;SET UP DUMMY BYTE POINTER\r
119         MOVSI TEMP,(SIXBIT /CRE/)       ;SETUP 2 WORD BLOCK FOR TMPCOR UUO\r
120         MOVEM TEMP,TMPFIL\r
121         MOVE TEMP,[XWD 1,TMPFIL]        ;SET UP FOR READ FROM CORE\r
122         CALLI TEMP,TMPCOR       ;READ AND DELETE FILE "CRE"\r
123         JRST TMPEND             ;FILE NOT THERE, TRY THE DISK\r
124         ADD AC0,TEMP            ;GET END OF BUFFER\r
125         MOVEM AC0,JOBFF         ;DUMMY UP JOBFF\r
126         MOVEM AC0,SVJFF         ;SAVE NEW JOBFF\r
127         IMULI TEMP,5            ;CALCULATE THE CHARACTER COUNT\r
128         ADDI TEMP,1             ;MAKE SURE YOU GET THE LAST CHARACTER IN THE BUFFER\r
129         MOVEM TEMP,CTIBUF+2     ;DUMMY UP CHARACTER COUNT IN HEADER\r
130         MOVEI TEMP,440700       ;SET UP REST OF BYTE POINTER\r
131         HRLM TEMP,CTIBUF+1      ;HEADER NOW COMPLETE\r
132         SETOM TMPFLG\r
133         MOVSI IO,IOPAGE!IOSYM!IOMAC!IORPG\r
134         JRST RETRPG             ;RETURN TO MAIN FLOW\r
135 TMPEND:>\r
136         MOVEI TEMP,AL           ;OPEN FILE IN ASCII LINE MODE\r
137         MOVSI TEMP+1,(SIXBIT /TTY/)\r
138         TLNE IO,IORPG           ;USING CCL MODE?\r
139         MOVSI TEMP+1,(SIXBIT /DSK/)     ;YES\r
140         MOVEM TEMP+1,CTIDEV     ;SAVE DEVICE NAME\r
141         MOVEI TEMP+2,CTIBUF     ;SET UP INPUT BUFFER HEADER ADDRESS\r
142         OPEN CTLI,TEMP          ;OPEN INPUT COMMAND FILE\r
143          JRST CREF              ;OPEN FAILURE, START OVER\r
144         INBUF CTLI,1            ;SET UP 1 INPUT BUFFER\r
145         HRRZ JOBFF\r
146         MOVEM SVJFF             ;SAVE JOBFF\r
147         TLNN IO,IORPG\r
148         JRST RETRPG             ;NOT IN CCL MODE\r
149 \f;THE FOLLOWING CODE LOOKS UP A FILE -DSK:NNNCRE.TMP\r
150 ;AND TRIES TO INITIALIZE IT. IF EVERYTHING WORKS, THAT FILE IS\r
151 ;USED FOR THE COMMAND DATA TO CREF. IF SOMETHING GOES WRONG,\r
152 ;CREF IS STARTED AT ITS USUAL PLACE AND AN ASTERISC IS TYPED.\r
153 ;THIS CODE IS USED ONLY FOR THE NEW COMMAND LANGUAGE AND IS STARTED\r
154 ;BY STARTING AT: (JOBSA)+1\r
155 \r
156         MOVEI AC0,3             ;JOB # IS 3 CHARS LONG\r
157         CALLI TEMP,30           ;GET JOB #\r
158 CREF1:  IDIVI TEMP,12\r
159         ADDI TEMP+1,"0"-40      ;CHANGE REMAINDER TO SIXBIT DIGIT\r
160         LSHC TEMP+1,-6          ;SHOVE DIGITS INTO TEMP+2\r
161         SOJG AC0,CREF1                  ;3 DIGITS YET?\r
162         HRRI TEMP+2,(SIXBIT /CRE/)\r
163         MOVEM TEMP+2,CTIDIR             ;SET UP ###CRE\r
164         MOVSI TEMP,(SIXBIT /TMP/)\r
165         MOVEM TEMP,CTIDIR+1             ;SET UP EXTENSION\r
166         SETZM CTIDIR+3                  ;CLEAR PROJ,PROG\r
167         LOOKUP CTLI,CTIDIR              ;DO LOOKUP ON COMMAND FILE\r
168          JRST CREF              ;FILE ###CRE.TMP NOT FOUND\r
169 \r
170 \fRETRPG:        TLO IO,IOPAGE!IOSYM!IOMAC\r
171         HRRZ 0,SVJFF            ;GET THE SAVED JOBFF\r
172         MOVEM 0,JOBFF           ;RESTORE JOBFF\r
173         SKIPE JOBDDT\r
174         JRST .+3        ;NO CORE UUO WHEN USING DDT\r
175         CORE 0,                 ;SHRINK CORE\r
176          JRST CREF              ;CORE FAILURE\r
177         SETZM STCLR\r
178         MOVE 0,[XWD STCLR,STCLR+1]\r
179         BLT 0,ENDCLR            ;CLEAR OUT VARIABLE AREA\r
180 \r
181         MOVE PP,[IOWD PDL,PPSET]        ;INIT PUSH DOWN LIST POINTER\r
182         HLLOS UPPLIM            ;?\r
183 \r
184         TLNE IO,IORPG           ;IN CCL MODE?\r
185         JRST    LSTSET          ;YES, NO *\r
186         PUSHJ PP,CRLF   ;NO\r
187         MOVEI C,"*"\r
188         PUSHJ PP,TYO    ;OUTPUT *\r
189 \f;THIS CODE IS USED TO SET UP  SOURCE AND\r
190 ;DESTINATION DEVICES, DO MAGTAPE SPACING COMMANDS, ETC.\r
191 \r
192 LSTSET: MOVSI   ACDEV,(SIXBIT /LPT/)\r
193         MOVEM   ACDEV,LSTDEV            ;DEFAULT LIST DEVICE IS LPT:\r
194         PUSHJ   PP,NAME1        ;GET NEXT DEVICE\r
195         CAIE    C,"_"           ;LISTING DEVICE SPECIFIED?\r
196         JRST    LSTS2           ;NO\r
197         SKIPE   ACDEV\r
198         MOVEM   ACDEV,LSTDEV    ;SAVE DEVICE NAME\r
199         MOVEM   ACFILE,LSTDIR   ;STORE FILE NAME\r
200         MOVEM   ACEXT,LSTDIR+1\r
201 \r
202 LSTS2:  MOVEI FLAG,AL           ;INIT DEVICE IN ASCII LINE MODE\r
203         MOVE FLAG+1,LSTDEV      ;GET DEVICE NAME\r
204         MOVSI FLAG+2,LSTBUF     ;BUFFER HEADER ADDRESS\r
205         OPEN LST,FLAG           ;TRY TO INIT DEVICE\r
206          JRST ERRAVL            ;OPEN FAILED\r
207         OUTBUF LST,2\r
208 \r
209         CAIE    C,"_"           ;LISTING DEVICE SPECIFIED?\r
210         JRST    INSET1          ;NO\r
211         DEVCHR ACDEV,           ;GET OUTPUT DEVICE CHARACTERISTICS\r
212         TLNE    ACDEV,10        ;IS IT A TTY?\r
213         TLO     IO,IOTTY        ;YES, SET TTY FLAG\r
214         TLZE    TIO,TIORW       ;REWIND REQUESTED?\r
215         MTAPE   LST,1           ;YES\r
216         JUMPGE  CS,LSTSE3\r
217         MTAPE   LST,17          ;BACKSPACE MTA\r
218         AOJL    CS,.-1          ;IF COUNT IS NEG., BACKSPACE AGAIN\r
219         WAIT    LST,            ;WAIT FOR TAPE TO STOP SO LOAD POINT CAN BE SENSED\r
220         STATO   LST,1B24        ;SKIP IF AT LOAD POINT-\r
221                                 ; THIS PUTS TAPE ON CORRECT SIDE OF EOF\r
222         MTAPE   LST,16          ;SPACE FORWARD 1 FILE\r
223 LSTSE3: SOJG    CS,.-1          ;LOOP UNTIL POS. COUNT RUNS OUT\r
224 \r
225         TLNE    TIO,TIOCLD      ;DIRECTORY CLEAR REQUESTED?\r
226         UTPCLR  LST,            ;YES, CLEAR IT\r
227         ENTER   LST,LSTDIR\r
228         JRST    ERRENT\r
229 \fINSET: PUSHJ   PP,NAME1        ;GET NEXT COMMAND NAME\r
230 INSET1: SKIPN   ACDEV\r
231         MOVSI   ACDEV,(SIXBIT /DSK/)\r
232         MOVEM   ACDEV,INDEV     ;SAVE DEVICE FOR ERR MESSAGES\r
233         SKIPN   ACFILE\r
234         MOVE    ACFILE,[SIXBIT /CREF/]\r
235         MOVEM   ACFILE,INDIR    ;STORE FILE IN DIRECTORY\r
236 \r
237         MOVEI ACDEV-1,A         ;INIT DEVICE IN "A" MODE\r
238         MOVEI ACDEV+1,INBUF     ;SET UP ARG FOR BUFFER HEADER\r
239         OPEN CHAR,ACDEV-1       ;OPEN CHANNEL\r
240          JRST ERRAVI            ;FAILED\r
241 \r
242         TLZE    TIO,TIORW       ;REWIND?\r
243         MTAPE   CHAR,1          ;YES\r
244         JUMPGE  CS,INSET2\r
245         MTAPE   CHAR,17\r
246         MTAPE   CHAR,17\r
247         AOJL    CS,.-1\r
248         WAIT    CHAR,\r
249         STATO   CHAR,1B24\r
250         MTAPE   CHAR,16\r
251 INSET2: SOJGE   CS,.-1\r
252 \fINSET3:        INBUF   CHAR,2\r
253         JUMPN   ACEXT,INSET4    ;TAKE USER'S EXTENSION IF NON-BLANK\r
254         MOVE ACEXT,[SIXBIT /LSTCRF/]    ;TRY CRF 1ST, THEN LST\r
255         JSP ACDEV,INSETI                ;LOOKUP FILE (DON'T RETURN IF FOUND)\r
256         JUMPN ACEXT,.-1                 ;KEEP LOOKING UNTIL EXT'S GONE\r
257         MOVSI ACEXT,(SIXBIT /TMP/)      ;FINALLY TRY TMP THEN NULL\r
258         JSP ACDEV,INSETI\r
259 INSET4: MOVEI ACDEV,ERRFND              ;RETURN IS CONTINUE OR JRST ERRFND\r
260 \r
261 INSETI: HLLM    ACEXT,INDIR+1   ;STORE EXTENSION\r
262         LSH     ACEXT,^D18      ;SLIDE NEXT EXT INTO PLACE\r
263         LOOKUP  CHAR,INDIR\r
264           JRST  (ACDEV)         ;NOT FOUND\r
265 \r
266         SKIPN FIRSTL            ;HAS INITIAL PRINTING LINE BEEN REQUESTED?\r
267         JRST LSTS7              ;NO\r
268         TLNE IO,IORPG\r
269         JRST LSTS4              ;NO MESSAGE OUTPUT FOR RPG SYSTEM\r
270         MOVEI TEMP,[ASCIZ /RESTART LISTING AT LINE:     /]\r
271         DDTOUT CTLI,\r
272         INPUT CTLI,             ;INPUT THE ANSWER\r
273 LSTS4:  MOVEI AC0,0             ;INIT DECIMAL NUMBER ASSEMBLER\r
274 LSTS5:  PUSHJ PP,TTYIN  ;GET CHARACTER\r
275         CAIL C,"0"      ;IS IT A DIGIT?\r
276         CAILE C,"9"\r
277         JRST LSTS6      ;NO\r
278         IMULI AC0,12    ;YES\r
279         ADDI AC0,-"0"(C)\r
280         JRST LSTS5\r
281 \r
282 LSTS6:  MOVEM AC0,FIRSTL        ;SAVE DECIMAL NUMBER\r
283 LSTS7:                  ;TO HERE IF NO INITIAL LINE SPECIFIED\r
284 \fIFN FAILC,<\r
285         MOVEI FREE,BLKST-1      ;SET UP THINGS FOR COMBG\r
286         MOVEM FREE,BLKND\r
287 >\r
288 \r
289 RECYCL: HRRZ    FREE,JOBFF      ;RETURN FOR MULTIPLE F4 PROGS\r
290         ADDI    FREE,1\r
291         TRZ     FREE,1          ;SET UP BYTE TABLE ADR ON EVEN LOCATION\r
292 \r
293         HRRZ    C,JOBREL        ;SET UP HIGH ADR OF SYMBOL TABLE\r
294         SKIPE   JOBDDT\r
295         HRRZ    C,JOBSYM        ;SAVE DDT'S SYMBOL TABLE WHEN IN USE\r
296         SOS     TOP,C           ;ALLOW 1 WORD SLOP\r
297         SUBI    C,LENGTH        ;MOVE AN INITIAL VESTIGIAL SYMBOL TABLE TO HIGH MEMORY\r
298         MOVE    SYMBOL,C\r
299         HRLI    C,SYMNUM\r
300         BLT     C,0(TOP)        ;MOVE THE 5 WORDS STARTING AT SYMNUM BELOW\r
301         PUSHJ   PP,SRCHI\r
302         MOVEI   LINE,1  ;INITIALIZE LINE COUNTER\r
303         PUSHJ PP,READ   ;TEST FIRST CHARACTER\r
304         CAIE C,%EOF     ;PROGRAM BREAK?\r
305         JRST M2A        ;NO, PROCESS\r
306         JRST M2         ;YES, BYPASS\r
307 \r
308 ;THIS IS AN INITIAL VESTIGIAL SYMBOL TABLE - IT MAKES INITIALIZATION\r
309 ;OF THE SYMBOL TABLE SEARCH EASY\r
310 \r
311 SYMNUM: EXP     LENGTH/2        ;COUNT OF INITIAL ENTRIES IN SYMBOL TABLE\r
312         1B0                             ;MOST NEGATIVE POSSIBLE SYMBOL\r
313         -1                      ;GARBAGE VALUE FOR MOST NEG. SYMBOL\r
314         -1B36           ;MOST POSITIVE POSSIBLE SYMBOL\r
315         -1                      ;GARBAGE VALUE FOR MOST POS. SYMBOL\r
316 LENGTH= .-SYMNUM\r
317 \fMLON\r
318 M1:     TLNN    IO,IOLST        ;IS PROGRAM LISTING SUPPRESSED?\r
319         PUSHJ   PP,WRITE        ;NO, OUTPUT CHARACTER\r
320 M2:     PUSHJ   PP,READ         ;GET NEXT CHARACTER\r
321 M2A:    CAIN C,177              ;RUBOUT?\r
322         JRST FAILM              ;ALL "NEW STYLE" CREF DATA BEGINS WITH RUBOUT\r
323         CAIN C,12\r
324         JRST M1\r
325         CAIN C,15\r
326         JRST FCKLF\r
327         CAIG C,%EOF             ;IS CHAR IN RANGE OF "OLD STYLE" CREF CONTROL CHARS.?\r
328         CAIGE C,%OP\r
329         SKIPA                   ;NO\r
330         JRST M2C                ;YES\r
331         TLZE IO,IOENDL\r
332         TLNE IO,IOLST\r
333         JRST M1\r
334         PUSH PP,C\r
335         MOVEI C,11\r
336         PUSHJ PP,WRITE\r
337         POP PP,C\r
338         JRST M1\r
339 \r
340 M2C:    TLNE IO,IOFAIL          ;IF "NEW STYLE" DATA SEEN (IOFAIL=1),IGNORE OLD\r
341         JRST M1                 ;IGNORE "OLD STYLE" CREF DATA\r
342         TLZ IO,IOENDL\r
343         TLO IO,IOTB2\r
344         XCT     MTAB-%OP(C)     ;DO SOMETHING (USUALLY SET BITS) WITH CONTROL CHAR\r
345         JRST    M3              ;BITS WERE SET (EITHER IOOP,IOMAC, OR IOSYM)\r
346 \r
347 M2B:    TLNN    IO,IOLST\r
348         PUSHJ   PP,CNVRT        ;IF MAKING LISTING, CONVERT (LINE) TO TEXT\r
349         TLNE IO,IOTABS\r
350         JRST    [MOVEI  C,11\r
351                  TLNN   IO,IOLST\r
352                  PUSHJ  PP,WRITE\r
353                  JRST   M2B1\r
354                 ]\r
355 M2B1:   AOJA    LINE,M2         ;INDEX LINE NUMBER AND START ON NEXT LINE\r
356 \r
357 \fM3:    MOVEI   AC0,0   ;INIT RADIX 50 SYMBOL\r
358 M4:     PUSHJ   PP,READ ;GET NEXT CHAR FOR SYMBOL\r
359         CAIL    C,"$"\r
360         CAILE   C,"Z"\r
361         JRST    M5A             ;CHAR NOT IN RADIX 50 SET\r
362         HLRZ    C,CSTAT-" "(C)  ;GET RADIX 50 CODE FOR CHAR\r
363         JUMPE   C,M5A           ;CHAR NOT IN RADIX 50 SET\r
364         IMULI   AC0,50          ;BUILD SYMBOL AND LOOP\r
365         ADD     AC0,C\r
366         JRST    M4\r
367 \r
368 M5A:    PUSHJ PP,M5             ;LEFT JUSTIFY SYMBOL AND STORE IN DATA TABLES\r
369         JRST M2\r
370 \r
371         IMULI   AC0,50\r
372 M5:     CAMG    AC0,[RADIX5 0,%%%%% ]\r
373         JUMPN   AC0,.-2         ;MULTIPLY BY 50 UNTIL LEFT JUSTIFIED\r
374         JUMPN   AC0,M6          ;SYMBOL GOOD IF NOT ZERO, SAVE IN TABLES\r
375 ERROR:  JSP     RC,ERRMSG ;     MOVE    PP,[IOWD PDL,PPSET]     ;RESTORE PP\r
376         SIXBIT  /?IMPROPER INPUT DATA@/\r
377 \r
378 M6:     TDNE    IO,SX           ;IS THIS TYPE OF SYMBOL BEING CROSS REFERENCED?\r
379         TLNE    IO,IONCRF\r
380         POPJ    PP,             ;NO\r
381         IOR     AC0,SX  ;PUT SYMBOL TYPE BITS INTO SYMBOL\r
382 \r
383         CAML    LINE,LOWLIM     ;IS THIS LINE INSIDE THE COMMAND STRING RANGE REQUEST?\r
384         CAMLE   LINE,UPPLIM\r
385         TDZA    FLAG,FLAG       ;NO\r
386         MOVSI   FLAG,(1B0)      ;YES, SET FLAG TO STORE IN DATA TABLES\r
387         JRST    SRCH            ;STORE SYMBOL, SYM TYPE, AND RANGE FLAG IN TABLES\r
388         POPJ    PP,\r
389 \r
390 ;THIS TABLE'S ENTRIES ARE EXECUTED FROM M2C+4\r
391 \r
392 MTAB:   MOVSI   SX,IOOP         ;CODE TYPE IS OP CODE, OPDEF,PSEUDO INSTRUCTION \r
393         MOVSI   SX,IOMAC        ;MACRO NAME\r
394         SKIPA   C,LINE\r
395         MOVSI   SX,IOSYM        ;NORMAL SYMBOL (DEFINED WITH = OR :)\r
396         JRST R0                 ;BREAK BETWEEN PROGRAMS\r
397 \r
398 FCKLF:  TLNE IO,IOTABS!IOTB2\r
399         TLO IO,IOENDL\r
400         JRST M1\r
401 \fR0:    TLO IO,IOPAGE\r
402         SETZM FIRSTL            ;FOR TABLES, EVERYTHING GETS LISTED\r
403         PUSH PP,SYMBOL\r
404 IFN FAILC,<\r
405         SKIPE BYTEX,BLKST       ;CHECK FOR FAIL BLOCK STRUCTURE\r
406         PUSHJ PP,BLKPRN\r
407 >\r
408         SOS     SX,0(SYMBOL)\r
409         MOVSI   FLAG,IOSYM\r
410 R1:     PUSHJ   PP,LINOUT\r
411 R1B:    SOJE    SX,FINIS\r
412         ADDI    SYMBOL,2\r
413         SKIPL   2(SYMBOL)\r
414         JRST    R1B\r
415         MOVE    C,1(SYMBOL)\r
416         HRRZ    BYTEX,2(SYMBOL)\r
417         ADDI BYTEX,1\r
418         HRLI    BYTEX,(POINT 6,0,5)\r
419         MOVE    BYTEM,-1(BYTEX)\r
420 \r
421 R1A:    TDZE    C,FLAG\r
422         JRST    R2\r
423         TLO     IO,IOPAGE\r
424         LSH     FLAG,1\r
425         JUMPN   FLAG,R1A\r
426 \r
427 R2:     TLZ IO,IONLZ    ;NO NON-ZEROS YET (FOR F4 ONLY)\r
428         PUSHJ   PP,R50ASC\r
429         MOVEI   LINE,0\r
430 \r
431 R3:     PUSHJ   PP,GETVAL\r
432         JRST    R1\r
433         PUSHJ   PP,CNVRT\r
434         JRST    R3\r
435 \f;SUBROUTINE TO CONVERT LINE NUMBERS TO ASCII TEXT\r
436 CNVRT:  MOVEI   TEMP,6  ;OUTPUT SPACES FOR LEADING ZEROS\r
437 CNVR1:  MOVEI C+1," "-"0"\r
438         SKIPE C\r
439         IDIVI C,12\r
440         HRLM C+1,(PP)\r
441         SOSG TEMP\r
442         SKIPE C\r
443         PUSHJ PP,CNVR1\r
444         HLRZ C,(PP)\r
445         MOVEI C,"0"(C)\r
446         JRST WRITE\r
447 \r
448 R50ASC: IDIVI   C,50\r
449         PUSH    PP,CS\r
450         SKIPE   C\r
451         PUSHJ   PP,R50ASC\r
452         POP     PP,C\r
453         HRRZ    C,CSTAT(C)\r
454         CAIN C,"0"      ;TEST FOR LEADING 0'S\r
455         TLNE IO,IONLZ\r
456         TLOA IO,IONLZ\r
457         MOVEI C," "\r
458         JRST    WRITE0\r
459 \fFREAD: PUSHJ PP,READ   ;GET CHARACTER COUNT\r
460         MOVE TEMP1,C    ;1ST CHAR IS COUNT OF CHARS IN FOLLOWING SYMBOL\r
461         MOVEI AC0,0\r
462 FM4:    PUSHJ PP,READ\r
463         CAIL C,"$"\r
464         CAILE C,"Z"     ;CHECK RANGE\r
465         JRST ERROR\r
466         HLRZ C,CSTAT-" "(C)\r
467         JUMPE C,ERROR   ;ILLEGAL RADIX50\r
468         IMULI AC0,50\r
469         ADD AC0,C\r
470         SOJG TEMP1,FM4  ;MORE CHARS TO GO?\r
471         POPJ PP,\r
472 \r
473 FAILM:  PUSHJ PP,READ   ;IS THIS REALLY THE START?\r
474         CAIE C,102      ;RUBOUT B BEGINS ALL "NEW STYLE" CREF DATA\r
475         JRST NOTINF\r
476         TLZ IO,IOENDL   ;INFORMATION WAS SEEN\r
477         TLO IO,IOFAIL   ;THIS IS FAIL\r
478 FM2:    PUSHJ PP,READ\r
479         CAIN C,177      ;POSSIBLE END?\r
480         JRST TEND       ;CHECK\r
481         CAILE C,16      ;IN RANGE?\r
482         JRST ERROR\r
483         XCT DTAB-1(C)\r
484         TLZE SX,IODF2   ;DO WE WANT TO DEFINE IT?\r
485         TLO IO,IODEF    ;YES, SET FLAG\r
486         PUSHJ PP,FREAD  ;GET THE SYMBOL\r
487 FM6:    PUSHJ PP,M5     ;GO ENTER SYYMBOL\r
488         JRST FM2\r
489 \r
490 NOTINF: PUSH PP,C       ;PUT IT OUT AS IT WAS READ\r
491         MOVEI C,177\r
492         TLNN IO,IOLST\r
493         PUSHJ PP,WRITE\r
494         POP PP,C\r
495         JRST M1 ;BACK INTO MAIN STREAM\r
496 \r
497 TEND:   MOVE AC0,SVLAB  ;IS THERE A LABEL TO PUT IN\r
498         SETZM SVLAB\r
499         MOVSI SX,IOSYM\r
500         SKIPE AC0\r
501         PUSHJ PP,M5\r
502         PUSHJ PP,READ   ;CHECK FOR END CHARACTER\r
503         CAIN C,101\r
504         TLO IO,IOTABS   ;CREF DATA TERMINATED WITH "RUBOUT A" MEANS\r
505                         ;INSERT TAB IN LISTING\r
506         CAIE C,103      ;ALL NEW STYLE CREF DATA ENDS WITH "RUBOUT A" OR "RUBOUT C"\r
507         CAIN C,101\r
508         SKIPA\r
509         JRST ERROR      ;BAD CREF DATA\r
510         MOVE C,LINE     ;SET UP TO ENTER\r
511         JRST M2B\r
512 \f;TABLE FOR NEW STYLE CREF CONTROL CHARACTERS\r
513 ;THE TABLE ENTRIES ARE EXECUTED FROM FM2+5\r
514 \r
515 DTAB:   JRST SETLAB             ;FOLLOWING SYM DEFINED WITH = OR :\r
516         JRST DLAB               ;THE DEFINING OCCURANCE OF THE ABOVE  SYMBOL\r
517         MOVSI SX,IOOP           ;FOLLOWING SYM IS OP CODE, OPDEF, OR PSEUDO INSTRUCTION\r
518         MOVSI SX,IOOP!IODF2     ;DEFINING OCCURANCE OF THE ABOVE (I. E. OPDEF)\r
519         MOVSI SX,IOMAC          ;MACRO NAME\r
520         MOVSI SX,IOMAC!IODF2    ;MACRO DEFINITION\r
521         REPEAT 6,<JRST ERROR>\r
522 IFN FAILC,<\r
523         JRST BBEG       ;BEGINNING OF A BLOCK FOR THE STANFORD "FAIL" ASSEMBLER\r
524         JRST BBEND      ;END OF THE ABOVE BLOCK\r
525 >\r
526 \r
527 IFE FAILC,<\r
528         JRST    ERROR           ;BLOCK STRUCTURE NOT ASSEMBLED IN\r
529         JRST    ERROR\r
530 >\r
531 \fSETLAB:        PUSHJ PP,FREAD          ;GET LABEL\r
532         EXCH AC0,SVLAB          ;CHANGE FOR OLD\r
533         JUMPE AC0,FM2           ;NO OLD, GO GET MORE\r
534         MOVSI SX,IOSYM          ;SET TO DEFINE\r
535         JRST FM6\r
536 \r
537 DLAB:   MOVE AC0,SVLAB          ;USE LAST LABEL\r
538         SETZM SVLAB\r
539         JUMPE AC0,ERROR         ;ERROR IF NONE THERE\r
540         MOVSI SX,IOSYM\r
541         TLO IO,IODEF\r
542         JRST FM6\r
543 \r
544 IFN FAILC,<\r
545 BBEG:   AOS TEMP,LEVEL          ;GET CURRENT LEVEL\r
546         MOVSI SX,0\r
547         PUSHJ PP,COMBG          ;GO INSER\r
548         JRST FM2\r
549 \r
550 BBEND:  MOVE TEMP,LEVEL         ;CURRENT LEVEL\r
551         MOVEI SX,1\r
552         PUSHJ PP,COMBG\r
553         SOS LEVEL               ;RESET\r
554         JRST FM2\r
555 \r
556 COMBG:  PUSHJ PP,FREAD          ;GET NAME\r
557         SKIPA\r
558         IMULI AC0,50\r
559         CAMG AC0,[RADIX50 0,%%%%% ]\r
560         JRST .-2\r
561         MOVE TEMP1,FREE\r
562         ADDI FREE,4             ;RESERVE 4 WORDS\r
563         CAML FREE,SYMBOL\r
564         PUSHJ PP,XCEED          ;OVERLAP\r
565         MOVEM AC0,(TEMP1)       ;SAVE NAME\r
566         HRLZM TEMP,1(TEMP1)     ;AND LEVEL\r
567         MOVEM LINE,2(TEMP1)     ;AND CURRENT LINE\r
568         HRLM SX,2(TEMP1)\r
569         MOVE TEMP,BLKND         ;SAVE CURRENT POINTER\r
570         HRRM TEMP1,1(TEMP)      ;SET UP LINK\r
571         MOVEM TEMP1,BLKND\r
572         POPJ PP,\r
573 >\r
574 \fIFN FAILC,<\r
575 BLKPRN: PUSHJ PP,LINOUT\r
576         MOVE C,@BLKND\r
577         PUSHJ PP,R50ASC\r
578         MOVEI C,11\r
579         PUSHJ PP,WRITE\r
580         MOVE C,[RADIX50 0,PROGRA]\r
581         PUSHJ PP,R50ASC\r
582         MOVEI C,"M"\r
583         PUSHJ PP,WRITE\r
584 BLKP3:  PUSHJ PP,LINOUT\r
585         HLRZ BYTEM,1(BYTEX)\r
586         LSH BYTEM,-1\r
587         JUMPE BYTEM,BLKP1\r
588         PUSHJ PP,TABOUT\r
589         SOJG BYTEM,.-1\r
590 BLKP1:  HLRZ BYTEM,1(BYTEX)\r
591         HLRZ SX,2(BYTEX)\r
592         TRNE BYTEM,1\r
593         ADDI SX,4\r
594         JUMPE SX,BLKP2\r
595         MOVEI C," "\r
596         PUSHJ PP,WRITE\r
597         SOJG SX,.-1\r
598 BLKP2:  MOVE C,(BYTEX)\r
599         PUSHJ PP,R50ASC\r
600         HLRZ SX,2(BYTEX)\r
601         MOVNS SX\r
602         ADDI SX,5\r
603         MOVEI C," "\r
604         PUSHJ PP,WRITE\r
605         SOJG SX,.-1\r
606         HRRZ C,2(BYTEX)\r
607         PUSHJ PP,CNVRT\r
608         HRRZ BYTEX,1(BYTEX)\r
609         JUMPN BYTEX,BLKP3\r
610         TLO IO,IOPAGE\r
611         POPJ PP,\r
612 >\r
613 \f;THE LEFT HALF OF THIS TABLE IS USED TO CONVERT FROM ASCII TEXT\r
614         ;TO RADIX 50 CODE- THE FIRST LOCATION STARTS AT 40 (SPACE)\r
615         ;ZERO ENTRIES IN LEFT HALF INDICATE INVALID RADIX 50 CHAR\r
616 ;THE RIGHT HALF IS USED TO CONVERT FROM RADIX 50 TO ASCII\r
617 \r
618 CSTAT:\r
619         XWD     00," "\r
620         XWD     00,"0"\r
621         XWD     00,"1"\r
622         XWD     00,"2"\r
623         XWD     46,"3"\r
624         XWD     47,"4"\r
625         XWD     00,"5"\r
626         XWD     00,"6"\r
627 \r
628         XWD     00,"7"\r
629         XWD     00,"8"\r
630         XWD     00,"9"\r
631         XWD     00,"A"\r
632         XWD     00,"B"\r
633         XWD     00,"C"\r
634         XWD     45,"D"\r
635         XWD     00,"E"\r
636 \r
637         XWD     01,"F"\r
638         XWD     02,"G"\r
639         XWD     03,"H"\r
640         XWD     04,"I"\r
641         XWD     05,"J"\r
642         XWD     06,"K"\r
643         XWD     07,"L"\r
644         XWD     10,"M"\r
645 \r
646         XWD     11,"N"\r
647         XWD     12,"O"\r
648         XWD     00,"P"\r
649         XWD     00,"Q"\r
650         XWD     00,"R"\r
651         XWD     00,"S"\r
652         XWD     00,"T"\r
653         XWD     00,"U"\r
654 \f       XWD     00,"V"\r
655         XWD     13,"W"\r
656         XWD     14,"X"\r
657         XWD     15,"Y"\r
658         XWD     16,"Z"\r
659         XWD     17,"."\r
660         XWD     20,"$"\r
661         XWD     21,"%"\r
662 \r
663         XWD     22,0\r
664         XWD     23,0\r
665         XWD     24,0\r
666         XWD     25,0\r
667         XWD     26,0\r
668         XWD     27,0\r
669         XWD     30,0\r
670         XWD     31,0\r
671 \r
672         XWD     32,0\r
673         XWD     33,0\r
674         XWD     34,0\r
675         XWD     35,0\r
676         XWD     36,0\r
677         XWD     37,0\r
678         XWD     40,0\r
679         XWD     41,0\r
680 \r
681         XWD     42,0\r
682         XWD     43,0\r
683         XWD     44,0\r
684 ;----\r
685 \f;SEARCH THE SYMBOL TABLE AND STORE STUFF IN IT\r
686 SRCH:   HRRZ    SX,SRCMID       ;GET POINTER TO SYM IN MIDDLE OF TABLE\r
687 SRCH01: HRRZ    TX,SRCMSB       ;GET "MOST SIGNIFICANT BIT"\r
688                                 ; OF TABLE ENTRY COUNT\r
689 \r
690 ;START LOGORITHMIC SEARCH\r
691 SRCH10: CAML    AC0,-1(SX)      ;IS SYMBOL HIGHER THAN THIS?\r
692         JRST    SRCH30          ;YES\r
693 SRCH12: SUB     SX,TX           ;NO,MOVE DOWN BY DELTA INCREMENT\r
694 SRCH13: LSH     TX,-1           ;DIVIDE DELTA INCREMENT BY 2\r
695         CAMG    SX,TOP          ;OVER THE TOP OF THE TABLE?\r
696         JUMPN   TX,SRCH10       ;NO,GO LOOK SOME MORE (SEARCH IS OVER WHEN DELTA=0)\r
697         JUMPN   TX,SRCH12       ;YES,MOVE DOWN INTO TABLE (SEARCH IS OVER WHEN DELTA=0)\r
698         CAMLE   LINE,UPPLIM     ;SYMBOL NOT FOUND, SAVE SYMBOL IF IT MIGHT BE \r
699                         ;IN RANGE (SPECIFIED IN COMMAND STRING) OR IF NO RANGE GIVEN\r
700         POPJ    PP,\r
701         SUBI    SX,1            ;MAKE SX POINT TO 1ST SYM TO BE MOVED\r
702         MOVEI   TX,-2(SYMBOL)\r
703         CAILE   TX,2(FREE)      ;IS THERE ROOM LEFT BETWEEN THE TWO TABLES?\r
704         JRST    SRCH20          ;YES\r
705         PUSHJ   PP,XCEED        ;NO, GET MORE CORE AND MOVE SYM TABLE UP\r
706         ADDI    SX,2000         ;UPDATE SY TABLE POINTERS BY AMOUNT OF NEW CORE\r
707         ADDI    TX,2000\r
708 \r
709 SRCH20: MOVE    SYMBOL,TX\r
710         HRLI    TX,2(TX)\r
711         BLT     TX,-2(SX)       ;MOVE SYM TABLE TO MAKE HOLE\r
712         AOS     0(SYMBOL)       ;INDEX SYM TAB ENTRY COUNT TO ACCOUNT FOR NEW ENTRY\r
713         MOVE    TX,FREE         ;GET 1ST ADR OF A WORD PAIR FOR STORING INCREMENTS\r
714         MOVEI BYTEX,1(FREE)     ;GET ADR OF 2ND BYTE FOR 1ST WORD PAIR\r
715         HRLI    BYTEX,(POINT 6,,5)      ;SET UP POINTER FOR 2ND BYTE OF 1ST WORD PAIR\r
716         ADDI    FREE,2          ;UPDATE FREE WORD POINTER\r
717         MOVEM   AC0,-1(SX)      ;SAVE SYMBOL IN SYMBOL TABLE\r
718         SETZM 1(TX)             ;ZERO BYTES AND POINTER TO 2ND WORD PAIR\r
719         MOVEI C,1               ;ASSUME NON-DEF OCCURANCE OF SYMBOL\r
720         TLNE IO,IODEF           ;CORRECT ASSUMPTION?\r
721         TRC C,3                 ;NO, 2 INDICATES A DEF OCCURANCE (1 IS NON-DEF)\r
722         DPB C,[POINT 6,1(TX),5] ;SAVE REASON (DEF OR NOT) OF \r
723                                 ;LAST OCCURANCE OF SYM IN 1ST BYTE\r
724         MOVE C,LINE\r
725         LSH C,1         ;LINE # IS STORED SHIFTED LEFT 1 TO LEAVE ROOM FOR A 1 BIT\r
726                                 ;FOR A DEF OCCR OF THE SYMBOL\r
727         TLZN IO,IODEF\r
728         IORI C,1                ;IT WAS DEF OCCURANCE, TURN ON BIT\r
729         HRLM    LINE,0(SX)      ;SAVE LINE # AND DEFINE BIT IN LEFT HALF OF SYM VALUE\r
730         HRRM    TX,0(SX)        ;SAVE POINTER TO BYTE WORD PAIRS\r
731                                 ; IN RIGHT HALF OF SYM VALUE\r
732         PUSHJ   PP,SRCHI        ;CALCULATE NEW MIDDLE ADR OF SYM TABLE AND \r
733                                 ;A NEW STARTING DELTA\r
734         JRST    STV12\r
735 \fSRCH30:        CAMN    AC0,-1(SX)      ;HAS THE SYMBOL BEEN FOUND?\r
736         JRST    STV10           ;YES\r
737         ADD     SX,TX           ;NO, LOOK HIGHER IN TABLE\r
738         JRST    SRCH13\r
739 \r
740 \f;SYMBOL FOUND IN TABLE\r
741 STV10:  LDB     C,[POINT 17,0(SX),17]   ;GET LAST LINE # WHERE SYMBOL WAS SEEN\r
742         HRRZ TX,0(SX)           ;GET ADR OF 1ST WORD OF 1ST WORD PAIR\r
743                                 ;WHERE INCREMENTS ARE STORED\r
744         CAME C,LINE             ;IS THIS OCCR ON SAME LINE AS LAST OCCR?\r
745         JRST STV10A             ;NO\r
746         LDB TEMP,[POINT 6,1(TX),5];YES, GET REASON (DEF OR NOT) FOR STORING LAST TIME\r
747         TLNN IO,IODEF   ;IS THIS OCCR A DEF ONE?\r
748         JRST STV10B     ;NO\r
749         TROE TEMP,2     ;YES, WAS THE PREVIOUS ONE DEF? (A LINE MAY HAVE BOTH\r
750                         ;DEF AND NON-DEF OCCRS)\r
751         POPJ PP,        ;YES, DO NOTHING (2 DEFG OCCURANCES ON SAME LINE)\r
752         JRST STV10C     ;NO,DEF+NON-DEF OCCRS ON SAME LINE\r
753 STV10B: TROE TEMP,1     ;WAS PREVIOUS OCCR NON-DEF?\r
754         POPJ PP,        ;YES, DO NOTHING (2 NON-DEF OCCRS ON SAME LINE)\r
755 STV10C: DPB TEMP,[POINT 6,1(TX),5];SAVE TYPE (DEF OR NOT) OF OCCR IN 1ST BYTE\r
756         JRST STV10D     ;STORE INDICATING DEF+NON-DEF ON SAME LINE\r
757 \r
758 ;THIS SYMBOL IS A NEW SYMBOL NEVER BEFORE SEEN\r
759 STV10A: MOVEI TEMP,1            ;ASSUME THIS IS A NON-DEF OCCR\r
760         TLNE IO,IODEF           ;CORRECT ASSUMPTION?\r
761         TRC TEMP,3              ;NO, CHANGE 1 TO A 2 TO SHOW DEFING OCCR\r
762         DPB TEMP,[POINT 6,1(TX),5]      ;SAVE NEW LINE # IN BITS 0-17 OF SYM VALUE\r
763 STV10D:\r
764         DPB LINE,[POINT 17,0(SX),17]\r
765         LSH LINE,1\r
766         TLZN IO,IODEF\r
767         IORI LINE,1             ;MAKE DEFINE BIT BE LOW ORDER BIT OF 2*LINE#\r
768         LSH C,1\r
769         SUBM    LINE,C          ;CALCULATE DELTA LINE#\r
770         LSH LINE,-1             ;NOW ELIMINATE DEFINE BIT\r
771         MOVE    BYTEX,0(TX)     ;GET BYTE POINTER TO LAST BYTE FOR LAST SYM OCCURRANCE\r
772 \f\r
773 STV12:  ORM     FLAG,0(SX)      ;SAVE SYMBOL TYPE (MACRO, SYMBOL,OP CODE)\r
774         CAIGE   C,^D32          ;IS DELTA LINE# (OR LINE# THE 1ST TIME)\r
775                                 ; BIGGER THAN 1 BYTE?\r
776         JRST    STV20           ;NO, IT FITS\r
777         MOVEM   PP,PPTEMP       ;2 (OR MORE) BYTES NEEDED\r
778 \r
779 ;DIVIDE 2*LINE#+DEFINE BIT  INTO 5 BIT BYTES, TURN ON\r
780 ;BIT 30 WHENEVER THERE ARE MORE BYTES LEFT. CALL\r
781 ;STV20 TO STORE THE BYTES AWAY. FOR THE LAST BYTE DO NOT TURN ON BIT 30,\r
782 ;THUS INDICATING NO MORE BYTES\r
783 STV14:  IDIVI   C,^D32\r
784         PUSH    PP,CS\r
785         CAIL    C,^D32\r
786         JRST    STV14\r
787 STV16:  TRO     C,40\r
788         PUSHJ   PP,STV20\r
789         POP     PP,C\r
790         CAME    PP,PPTEMP\r
791         JRST    STV16\r
792 \r
793 STV20:  TRNE    BYTEX,1         ;IS BYTE POINTER IN 1ST WORD OF WORD PAIR? OR\r
794         CAML    BYTEX,[POINT 6,,16]     ;IN LEFT HALF OR 2ND WORD OF PAIR?\r
795         JRST    STV22           ;YES, CONTINUE USING THIS WORD PAIR\r
796         HRRM    FREE,0(BYTEX)   ;NO,MAKE RH OF 2ND WORD OF PAIR POINT TO NEW WORD PAIR\r
797         MOVE    BYTEX,FREE      ;INIT ADREESS OF BYTE POINTER IN NEW WORD PAIR\r
798         HRLI    BYTEX,(POINT 6,,);INIT BYTE POINTER PARTS TO LEFT BYTE OF\r
799                                 ; 1ST WORD OF NEW PAIR\r
800         ADDI    FREE,2          ;UPDATE FREE END OF TABLE\r
801         CAML    FREE,SYMBOL     ;ROOM AVAILABLE?\r
802         PUSHJ   PP,XCEED        ;NO, GET MORE CORE AND MOVE SYMBOL TABLE UP\r
803 \r
804 STV22:  IDPB    C,BYTEX         ;STORE INCREMENT BYTE AWAY\r
805         MOVEM   BYTEX,0(TX)     ;SAVE BYTE POINTER IN 1ST WORD OF 1ST WORD PAIR\r
806 POPOUT: POPJ    PP,\r
807 \fGETVAL:        TLZN IO,IODEF\r
808         JRST GETV20\r
809         MOVEI C,"#"\r
810         PUSHJ PP,WRITE\r
811 GETV20: CAMN    BYTEX,BYTEM\r
812         POPJ    PP,\r
813         AOS     0(PP)\r
814         PUSHJ   PP,TABOUT\r
815         MOVEI   C,0\r
816 GETV10: TRNE    BYTEX,1\r
817         CAML    BYTEX,[POINT 6,,16]\r
818         JRST    GETV12\r
819         MOVE    BYTEX,0(BYTEX)\r
820         HRLI    BYTEX,(POINT 6,,)\r
821 \r
822 GETV12: ILDB    CS,BYTEX\r
823         ROT     CS,-5\r
824         LSHC    C,5\r
825         JUMPN   CS,GETV10\r
826         TRNN C,1        ;SET DEFINED FLAG\r
827         TLO IO,IODEF\r
828         LSH C,-1\r
829         ADDB    LINE,C\r
830         POPJ    PP,\r
831 \fTABOUT:        MOVEI   C,11\r
832         SOJGE   WPL,WRITE0\r
833         PUSHJ   PP,LINOUT\r
834         JRST    TABOUT\r
835 \r
836 LINOUT: SOSG    LPP\r
837         TLO     IO,IOPAGE\r
838         MOVEI   C,15\r
839         PUSHJ   PP,WRITE\r
840         MOVEI   C,12\r
841         PUSHJ   PP,WRITE\r
842         MOVEI   WPL,WPLLPT              ;ASSUME LINES FOR LPT\r
843         TLNE IO,IOTTY                   ;CORRECT ASSUMPTION?\r
844         MOVEI WPL,WPLTTY                ;NO, SET UP LINES TO TTY\r
845 \r
846         POPJ    PP,\r
847 \r
848 WRITE0: TLZN    IO,IOPAGE\r
849         JRST    WRITE\r
850         PUSH    PP,C\r
851         MOVEI   C,14\r
852         PUSHJ   PP,WRITE\r
853         MOVEI   C,.LPP\r
854         MOVEM   C,LPP\r
855         POP     PP,C\r
856 \r
857 WRITE:  CAMGE LINE,FIRSTL       ;HAVE WE REACHED REQUESTED LINE?\r
858         POPJ PP,\r
859         SOSG    LSTBUF+2\r
860         PUSHJ   PP,DMPLST\r
861         IDPB    C,LSTBUF+1\r
862         CAIN    C,12            ;IF NOT LINE-FEED, OR\r
863         TLNN IO,IOTTY           ;IF NOT TTY, DON'T OUTPUT EVERY LINE\r
864         POPJ    PP,\r
865         JRST DMPLST             ;OUPUT LINE\r
866 \f;GET 1K MORE CORE AND MOVE THE SYMBOL TABLE (BOTH DDT'S AND CREF'S)\r
867 ;UP INTO THE NEW SPACE\r
868 \r
869 XCEED:  PUSH    PP,0\r
870         PUSH    PP,1\r
871         PUSH    PP,2\r
872         HRRZ    1,JOBREL        ;GET CURRENT TOP\r
873         MOVEI   0,2000(1)\r
874 XCEED2: CORE    0,              ;REQUEST MORE CORE\r
875         JRST    ERRCOR          ;ERROR, BOMB OUT\r
876         HRRZ    2,JOBREL        ;GET NEW TOP\r
877 \r
878 XCEED1: MOVE    0,0(1)          ;GET ORIGIONAL\r
879         MOVEM   0,0(2)          ;STORE IN NEW LOCATION\r
880         SUBI    2,1             ;DECREMENT UPPER\r
881         CAMLE   1,SYMBOL        ;HAVE WE ARRIVED?\r
882         SOJA    1,XCEED1        ;NO, GET ANOTHER\r
883         MOVEI   1,2000\r
884         ADDM    1,SYMBOL\r
885         ADDM    1,JOBSYM\r
886         ADDM    1,TOP\r
887         POP     PP,2\r
888         POP     PP,1\r
889         POP     PP,0\r
890 \r
891 ;FIND LEFT MOST BIT OF NUMBER OF ENTRIES IN SYMBOL TABLE AND\r
892 ;STORE IT IN SRCMSB. FIND MIDDLE ADR OF SYMBOL TABLE AND STORE\r
893 ;THE ADR IN SRCMID\r
894 \r
895 SRCHI:  PUSH    PP,0\r
896         PUSH    PP,1\r
897         MOVEI   1,0\r
898         FAD     1,0(SYMBOL)\r
899         LSH     1,-^D27\r
900         MOVEI   0,1000\r
901         LSH     0,-357(1)\r
902         HRRZM   0,SRCMSB\r
903         LSH     0,1\r
904         ADD     0,SYMBOL\r
905         HRRZM   0,SRCMID\r
906         POP     PP,1\r
907         POP     PP,0\r
908         POPJ    PP,\r
909 \fFINIS: POP PP,SYMBOL\r
910 FINIS3: TLZN IO,IOEOF   ;END OF FILE SEEN?\r
911         JRST RECYCL     ;NO, RECYCLE\r
912         TLNE    IO,IORPG        ;SEEN AN END-OF-FILE\r
913         JRST    RPGFN           ;NO.\r
914         PUSHJ   PP,CRLF\r
915         PUSHJ   PP,CRLF\r
916         MOVE    C,JOBREL\r
917         ADD     C,FREE\r
918         SUB     C,SYMBOL\r
919         LSH     C,-^D10\r
920         ADDI    C,1\r
921         IDIVI   C,^D10\r
922         JUMPE   C,FINIS1\r
923         ADDI    C,"0"\r
924         PUSHJ   PP,TYO\r
925 FINIS1: MOVEI   C,"0"(CS)\r
926         PUSHJ   PP,TYO\r
927         MOVE RC,[POINT 6,[SIXBIT /K CORE@/]]\r
928         PUSHJ PP,PNTM1          ;PRINT MESSAGE\r
929 \fRPGFN: CLOSE   LST,\r
930         PUSHJ   PP,TSTLST       ;YES, TEST FOR ERRORS\r
931         RELEAS  LST,\r
932         CLOSE   CHAR,\r
933 RPGFN1: RELEAS  CHAR,\r
934         TLNN IO,IORPG\r
935         JRST    CREF            ;RETURN FOR NEXT ASSEMBLY\r
936         MOVSI IO,IORPG\r
937 RPGFN2: PUSHJ PP,TTYIN\r
938         CAIG C,15\r
939         CAIGE C,12\r
940         SKIPA\r
941         JRST RPGFN2\r
942         MOVSI C,70000\r
943         ADDM C,CTIBUF+1\r
944         AOS CTIBUF+2\r
945         JRST RETRPG\r
946 \fNAME1: SETZB   ACDEV,ACFILE\r
947         SETZB   ACEXT,ACDEL\r
948         SETZB   TIO,CS\r
949 \r
950 NAME3:  MOVSI   ACPNTR,(POINT 6,AC0)    ;SET POINTER\r
951         TDZA    AC0,AC0         ;CLEAR SYMBOL\r
952 \r
953 SLASH:  PUSHJ   PP,SW0\r
954 GETIOC: PUSHJ   PP,TTYIN        ;GET INPUT CHARACTER\r
955         CAIN    C,"/"\r
956         JRST    SLASH\r
957         CAIN    C,"("\r
958         JRST    SWITCH\r
959         CAIN    C,":"\r
960         JRST    DEVICE\r
961         CAIN    C,"."\r
962         JRST    NAME\r
963         CAIE    C,"_"\r
964         CAIG    C,15\r
965         JRST    TERM\r
966         CAIN    C,33    ;NEW ALT MODE?\r
967         JRST    TERM    ;YES\r
968         CAIN    C,"["\r
969         JRST    PROGNP          ;GET PROGRAMER NUMBER PAIR\r
970         SUBI    C,40            ;CONVERT TO 6-BIT\r
971         TLNE    ACPNTR,770000   ;HAVE WE STORED SIX BYTES?\r
972         IDPB    C,ACPNTR        ;NO, STORE IT\r
973         JRST    GETIOC          ;GET NEXT CHARACTER\r
974 \r
975 DEVICE: SKIPA   ACDEV,AC0       ;DEVICE NAME\r
976 NAME:   MOVE    ACFILE,AC0      ;FILE NAME\r
977         MOVE    ACDEL,C         ;SET DELIMITER\r
978         JRST    NAME3           ;GET NEXT SYMBOL\r
979 \r
980 TERM:   CAIE    ACDEL,":"       ;IF PREVIOUS DELIMITER\r
981         CAIN ACDEL,0            ;ASSUME FILE NAME IF NOTHING ELSE\r
982         MOVE    ACFILE,AC0      ;SET FILE\r
983         CAIN    ACDEL,"."       ;IF PERIOD,\r
984         HLLZ    ACEXT,AC0       ;SET EXTENSION\r
985         POPJ    PP,             ;EXIT\r
986 \fPROGNP:        JUMPL   PP,PROGN2       ;ERROR IF OUTPUT\r
987 ERRCM:  JSP RC,ERRMSG\r
988         SIXBIT /?COMMAND ERROR@/\r
989 \r
990 PROGN1: HRLZM   RC,INDIR+3      ;COMMA, STORE LEFT HALF\r
991 PROGN2: MOVEI   RC,0            ;CLEAR AC\r
992 PROGN3: PUSHJ   PP,TTYIN\r
993         CAIN    C,","\r
994         JRST    PROGN1          ;STORE LEFT HALF\r
995         HRRM    RC,INDIR+3      ;ASSUME TERMINAL\r
996         CAIN    C,"]"\r
997         JRST    GETIOC          ;YES, RETURN TO MAIN SCAN\r
998         LSH     RC,3            ;SHIFT PREVIOUS RESULT\r
999         ADDI    RC,-"0"(C)      ;ADD IN NEW NUMBER\r
1000         JRST    PROGN3          ;GET NEXT CHARACTER\r
1001 \fSWITCH:        PUSHJ   PP,TTYIN\r
1002         CAIL    C,"0"\r
1003         CAILE   C,"9"\r
1004         JRST    SWIT1\r
1005         PUSHJ   PP,GETLIM\r
1006         CAIE    C,","\r
1007         JRST    ERRCM\r
1008         MOVEM   RC,LOWLIM\r
1009         PUSHJ   PP,TTYIN\r
1010         PUSHJ   PP,GETLIM\r
1011         CAIE    C,")"\r
1012         JRST    ERRCM\r
1013         MOVEM   RC,UPPLIM\r
1014         CAMGE   RC,LOWLIM\r
1015         TLO     IO,IONCRF\r
1016         JRST    GETIOC\r
1017 \r
1018 SWIT1:  CAIN    C,")"\r
1019         JRST    GETIOC\r
1020         PUSHJ   PP,SW1\r
1021         PUSHJ   PP,TTYIN\r
1022         JRST    SWIT1\r
1023 \r
1024 GETLIM: TDZA    RC,RC\r
1025 GETLI1: PUSHJ   PP,TTYIN\r
1026         CAIL    C,"0"\r
1027         CAILE   C,"9"\r
1028         POPJ    PP,\r
1029         IMULI   RC,^D10\r
1030         ADDI    RC,-"0"(C)\r
1031         JRST    GETLI1\r
1032 \r
1033 SW0:    PUSHJ   PP,TTYIN\r
1034 SW1:    MOVEI   C,-"A"(C)       ;CONVERT FROM ASCII TO NUMERIC\r
1035         CAILE   C,"Z"-"A"       ;WITHIN BOUNDS?\r
1036         JRST    ERRCM           ;NO, ERROR\r
1037         MOVE    RC,[POINT 4,BYTAB]\r
1038         IBP     RC\r
1039         SOJGE   C,.-1           ;MOVE TO PROPER BYTE\r
1040         LDB     C,RC            ;PICK UP BYTE\r
1041         JUMPE   C,ERRCM         ;TEST FOR VALID SWITCH\r
1042         CAIG    C,TEMP\r
1043         JUMPL   PP,ERRCM\r
1044         XCT     SWTAB-1(C)      ;EXECUTE INSTRUCTION\r
1045         POPJ    PP,             ;EXIT\r
1046 \f       DEFINE  SETSW           (LETTER,INSTRUCTION) <\r
1047         INSTRUCTION\r
1048 J=      <"LETTER"-"A">-^D9*<I=<"LETTER"-"A">/^D9>\r
1049         SETCOD  \I,J>\r
1050 \r
1051         DEFINE  SETCOD          (I,J)\r
1052         <BYTAB'I=BYTAB'I!<.-SWTAB>B<4*J+3>>\r
1053 \r
1054 BYTAB0= 0                       ;INITIALIZE TABLE\r
1055 BYTAB1= 0\r
1056 BYTAB2= 0\r
1057 \r
1058 SWTAB:\r
1059         SETSW   Z,<TLO  TIO,TIOCLD      >\r
1060         SETSW   A,<ADDI CS,1            >\r
1061         SETSW   B,<SUBI CS,1            >\r
1062         SETSW   K,<TLZ  IO,IOSYM        >\r
1063         SETSW   M,<TLZ  IO,IOMAC        >\r
1064         SETSW   O,<TLO  IO,IOOP         >\r
1065         SETSW   S,<TLO  IO,IOLST        >\r
1066         SETSW   T,<TLO  TIO,TIOLE       >\r
1067         SETSW   W,<TLO  TIO,TIORW       >\r
1068         SETSW R,<SETOM FIRSTL>\r
1069 \r
1070 BYTAB:\r
1071         +BYTAB0\r
1072         +BYTAB1\r
1073         +BYTAB2\r
1074 \f\r
1075 CRLF:   MOVEI   C,15            ;OUTPUT CARRIAGE RETURN\r
1076         PUSHJ   PP,TYO\r
1077         MOVEI   C,12            ;AND LINE FEED\r
1078 TYO:    LSH     C,35\r
1079         HRRI    C,C\r
1080         DDTOUT  C,              ;TELETYPE CHARACTER OUTPUT\r
1081         POPJ    PP,\r
1082 \fTTYIN:                 ;COMMAND CHARACTER INPUT SUBROUTINE\r
1083 RPGIN:  SOSG CTIBUF+2\r
1084         JRST CKRPGI\r
1085 RPGIN1: IBP CTIBUF+1\r
1086         MOVE C,@CTIBUF+1\r
1087         TRNN C,1\r
1088         JRST RPGIN2\r
1089 \r
1090         AOS     CTIBUF+1\r
1091         MOVNI   C,5\r
1092         ADDM    C,CTIBUF+2\r
1093         JRST    RPGIN\r
1094 RPGIN2: LDB C,CTIBUF+1\r
1095         JUMPE C,RPGIN\r
1096         CAIE    C," "           ;SKIP BLANKS\r
1097         CAIN    C,"     "\r
1098         JRST    TTYIN\r
1099         CAIE    C,175\r
1100         CAIN    C,176\r
1101         MOVEI   C,33            ;CHANGE ALL ALT MODES TO 033\r
1102         CAIN    C,32\r
1103         JRST    TTYIN           ;IGNORE ^Z (EOF)\r
1104         CAIL    C,140\r
1105         TRZ     C,40            ;CHANGE LOWER CASE TO UPPER CASE\r
1106         POPJ    PP,             ;NO, EXIT\r
1107 \fCKRPGI:\r
1108 IFN TEMPC,<     SKIPE TMPFLG    ;IS TMPCOR UUO IN ACTION\r
1109         JRST TMPDON             ;YES, EXIT>\r
1110         IN CTLI,0\r
1111         JRST RPGIN1\r
1112         STATO CTLI,740000\r
1113         JRST RPGCK2\r
1114         JSP RC,ERRMSG\r
1115         SIXBIT /?DATA ERROR READING COMMAND FILE@/\r
1116 IFN TEMPC,<\r
1117 TMPDON: MOVE AC0,[XWD 2,TEMP]\r
1118         MOVSI TEMP,(SIXBIT /CRE/)\r
1119         MOVEI TEMP1,0\r
1120         CALLI AC0,TMPCOR        ;DELETE TMPCOR FILE "CRE"\r
1121         JFCL                    ;FAILED, SO WHO CARES>\r
1122 LEAVE:  CALLI 1,12              ;EXIT\r
1123         JRST CREF\r
1124 \r
1125 RPGCK2: TLNN IO,IORPG           ;IN CCL MODE?\r
1126         JRST CREF               ;NO, START OVER\r
1127         SETZB TEMP,TEMP+1       ;YES, DELETE COMMAND FILE\r
1128         SETZB TEMP+2,TEMP+3\r
1129         RENAME CTLI,TEMP\r
1130         JFCL\r
1131         JRST LEAVE\r
1132 \fREAD:  SOSG    INBUF+2         ;BUFFER EMPTY?\r
1133         JRST    READ3           ;YES\r
1134 READ1:  ILDB    C,INBUF+1       ;PLACE CHARACTER IN C\r
1135         JUMPE C,READ\r
1136         POPJ    PP,\r
1137 \r
1138 READ3:  INPUT   CHAR,0          ;GET NEXT BUFFER\r
1139         STATO   CHAR,762000     ;ERROR?\r
1140         JRST    READ1           ;NO, GET CHARACTER\r
1141         TLO     IO,IOEOF        ;EOF SEEN.  FIRST TIME?\r
1142         STATO   CHAR,742000\r
1143         JRST    R0\r
1144 \r
1145         MOVEI CS,INDEV\r
1146         JSP RC,DVFNEX\r
1147         SIXBIT /?INPUT DATA ERROR, @/\r
1148 \r
1149 DMPLST: OUTPUT  LST,0           ;OUTPUT BUFFER\r
1150 TSTLST: STATO   LST,740000      ;ANY ERRORS?\r
1151         POPJ    PP,             ;NO, EXIT\r
1152 \r
1153         MOVEI CS,LSTDEV\r
1154         JSP RC,DVFNEX\r
1155         SIXBIT /?OUTPUT DATA ERROR, @/\r
1156 \fERRAVI:        SKIPA CS,[INDEV]        ;INPUT DEVICE INIT FAILURE\r
1157 ERRAVL: MOVEI CS,LSTDEV         ;LISTING DEVICE INIT FAILURE\r
1158         JSP RC,DVFNEX\r
1159         SIXBIT /?DEVICE NOT AVAILABLE, @/\r
1160 \r
1161 \r
1162 ERRENT: MOVEI CS,LSTDEV\r
1163         JSP RC,DVFNEX\r
1164         SIXBIT /?CANNOT ENTER FILE @/\r
1165 \r
1166 ERRFND: MOVEI CS,INDEV\r
1167         JSP RC,DVFNEX\r
1168         SIXBIT /?CANNOT FIND FILE @/\r
1169 \r
1170 ERRCOR: JSP RC,ERRMSG\r
1171         SIXBIT /?INSUFFICIENT MEMORY AVAILABLE@/\r
1172 \r
1173 \fERRMSG:        PUSHJ PP,PNTMSG         ;FOR SIMPLE ERROR MESSAGES\r
1174         JRST ERRFIN\r
1175 \r
1176 DVFNEX: PUSHJ PP,PNTMSG         ;PRINT MESSAGE DEV:FILENAME.EXT\r
1177         PUSHJ PP,PNTSIX         ;PRINT DEVICE\r
1178         MOVEI C,":"\r
1179         PUSHJ PP,TYO            ;PRINT COLON\r
1180         ADDI CS,1               ;ADVANCE POINTER TO FILENAME\r
1181         SKIPN (CS)              ;IS FILENAME 0?\r
1182         JRST ERRFIN             ;YES, NO FILENAME\r
1183         PUSHJ PP,PNTSIX         ;NO, PRINT FILENAME\r
1184         ADDI CS,1               ;ADVANCE POINTER TO EXTENSION\r
1185         HLLZS C,(CS)            ;ZERO OUT OTHER HALF. EXTENSION=0?\r
1186         JUMPE C,ERRFIN          ;EXTENSION 0?\r
1187         MOVEI C,"."             ;NO\r
1188         PUSHJ PP,TYO            ;PRINT DOT\r
1189         PUSHJ PP,PNTSIX         ;PRINT EXTENSION\r
1190 \r
1191 ERRFIN: PUSHJ PP,CRLF\r
1192         JRST CREF               ;START CREF OVER\r
1193 \r
1194 PNTSIX: HRLI CS,(POINT 6,0)     ;PRINT 1 WORD OF SIXBIT\r
1195 PNTSX1: TLNN CS,770000          ;NEXT ILDB GO OVER WORD BOUNDARY?\r
1196         POPJ PP,                ;YES, FINISHED\r
1197         ILDB C,CS\r
1198         JUMPE C,.-2             ;STOP AT A 0\r
1199         ADDI C,40               ;CONVERT TO ASCII\r
1200         PUSHJ PP,TYO\r
1201         JRST PNTSX1\r
1202 \r
1203 PNTMSG: PUSHJ PP,CRLF           ;PRINT SIXBIT MESSAGE\r
1204         HRLI RC,(POINT 6,0)\r
1205 PNTM1:  ILDB C,RC\r
1206         CAIN C,40               ;STOP AT @\r
1207         POPJ PP,\r
1208         ADDI C,40               ;CONVERT TO ASCII\r
1209         PUSHJ PP,TYO\r
1210         JRST PNTM1\r
1211 \fLIT\r
1212 \f\r
1213         IFN PURE, <LOC  140>\r
1214 \r
1215 SVJFF:  BLOCK   1\r
1216 \r
1217 CTIBUF: BLOCK   3       ;COMMAND FILE INPUT BUFFER HEADER\r
1218 CTIDEV: BLOCK 1         ;INPUT COMMAND DEVICE\r
1219 CTIDIR: BLOCK   4\r
1220 TMPFIL: BLOCK 2                 ;SIXBIT /CRE/\r
1221                                 ;XWD -200,C(JOBFF)\r
1222                                 ;FOR TMPCOR UUO\r
1223 TMPFLG: BLOCK 1         ;FLAG FOR TMPCOR UUO IN PROGRESS\r
1224 \r
1225 \r
1226 STCLR:          ;START BLT CLEAR HERE\r
1227 \r
1228 INBUF:  BLOCK   3\r
1229 INDEV:  BLOCK   1       ;INPUT DEVICE (FOR ERR MESSAGES ONLY)\r
1230 INDIR:  BLOCK   4\r
1231 \r
1232 LSTBUF: BLOCK   3\r
1233 LSTDEV: BLOCK   1       ;LIST DEVICE (FOR ERR MESSAGES ONLY)\r
1234 LSTDIR: BLOCK   4\r
1235 \r
1236 PPSET:  BLOCK   PDL\r
1237 LPP:    BLOCK   1\r
1238 \r
1239 PPTEMP: BLOCK   1\r
1240 FIRSTL: BLOCK 1 ;LINE # AFTER WHICH TO PRINT LISTING\r
1241 \r
1242 SRCMSB: BLOCK   1       ;MOST SIGNIFICANT BIT (USED BY SRCH)\r
1243 SRCMID: BLOCK   1       ;ADR IN MIDDLE OF SYM TABLE (USED BY SRCH)\r
1244 \r
1245 LOWLIM: BLOCK   1\r
1246 UPPLIM: BLOCK   1\r
1247 LEVEL:  BLOCK   1\r
1248 SVLAB:  BLOCK 1\r
1249 IFN FAILC,<\r
1250 BLKST:  BLOCK 1\r
1251 BLKND:  BLOCK 1\r
1252 >\r
1253 \r
1254 ENDCLR: END CREF\r
1255 \f\r