Commit | Line | Data |
---|---|---|
81e70d48 PH |
1 | /FUTIL - FILE UTILITY - V07A |
2 | ||
3 | VERSION=07 | |
4 | PATCH="A&77 | |
5 | ||
6 | / OS/8 FILE UTILITY PROGRAM. ALLOWS EXAMINATION AND | |
7 | / MODIFICATION OF OS/8 MASS STORAGE DEVICES FROM THE CON- | |
8 | / SOLE. DUMPING OF BLOCKS, LISTING OF WORDS AND MODIFICA- | |
9 | / TION OF WORDS CAN BE DONE IN 7 FORMATS: OCTAL; SIGNED AND | |
10 | / UNSIGNED DECIMAL; UNPACKED, 6-BIT PACKED, XS240 PACKED AND | |
11 | / OS/8 PACKED ASCII. LISTING AND DUMPING CAN ALSO BE DONE | |
12 | / IN 5 MORE FORMATS: BCD, BYTE (OCTAL CHARACTER), 2 PSEUDO- | |
13 | / SYMBOLIC FORMATS [PDP-8 & FPP-12/8A], AND A COMBINATION | |
14 | / FORMAT FOR DIRECTORY DUMPING. PROGRAM USES BOTH COMMAND | |
15 | / WORDS AND COMMAND CHARACTERS (LIKE ODT) FOR DIRECTION. | |
16 | ||
17 | /BY: JIM CRAPUCHETTES | |
18 | / MENLO COMPUTER ASSOCIATES, INC. | |
19 | / (FORMERLY: FRELAN ASSOCIATES) | |
20 | / P.O. BOX 298 | |
21 | / MENLO PARK, CALIF. 94025 | |
22 | / | |
23 | / | |
24 | /VERSIONS 1 THRU 4 - "XTAPE" FOR THE XSYSTEM, | |
25 | / LAST REVISION--APRIL 1970. | |
26 | / | |
27 | /VERSION 5 - OS/8 OPERATION, JULY 1972 THRU JUNE 1976 | |
28 | / "(...)", "C & 'CC AS NUMBERS, IOT DECODING, LIST | |
29 | / & DUMP FORMATS, OUTPUT TO LPT:, FILE DATE & LOC | |
30 | / IN DIRECTORY, "WORD MEMREF...", BCD OUTPUT, | |
31 | / ADDITIONAL ODT OUTPUTS, "BYTE" OUTPUT. | |
32 | /VERSION 6 - EXPANSION OF OS/8 OPERATION, JUNE 1976: | |
33 | / "FILLER" FOR "MODIFY", SEARCH LIMITS CHANGE, "WRITE" | |
34 | / WITH AN ARGUMENT, FPP INSTRUCTION DECODING, CHAINING | |
35 | / SUPPORT (FOR CCL CALLS), LOAD MODULE HANDLING AND | |
36 | / "SHOW HEADER", MULTIPLE DEFAULT EXTENSIONS, ^R FOR | |
37 | / RETYPE, SET REPLACES OPTION, NEW OUTPUT ROUTINE FOR | |
38 | / "DIRECTORY" FORMAT, LINK OVERLAY HANDLING, ODT CHANGES, | |
39 | / EXIT, SCAN, WRITE LOCKED OPERATION, SPEED UP SEARCHES, | |
40 | / XS240 FORMATS | |
41 | /VERSION 6.17 - APR 1, 1977; BATCH OPERATION, COMMENT | |
42 | /VERSION 6.20 - MAY 16, 1977; NEW DATE, FULL FILE OUTPUT | |
43 | / (SET/SHOW DDEV, OPEN ..., CLOSE), OPT ":" ON DEVICES. | |
44 | /VERSION 6.21 - JUN 4, 1977; NEW INPUT ROUTINE, TEMP STORAGE | |
45 | /VERSION 6.22 - JUL 13, 1977; CRTL-Q & -S, SCOPE MODE, | |
46 | / IF/END COMMANDS, ALPHA DATE. | |
47 | / | |
48 | /PREVIOUS VERSIONS HAVE BEEN AVAILABLE THROUGH DECUS, | |
49 | / DEC SUPPORT BEGINS WITH VERSION 7 - 20-JUL-77. | |
50 | \f/ SOME ROUTINES AND IDEAS USED IN THIS PROGRAM WERE | |
51 | / DERIVED FROM EDIT-8 AND FOCAL, BY RICK MERRILL, DEC. | |
52 | / THE ODT COMMAND SET IS NEARLY IDENTICAL TO THE OS/8 | |
53 | / ODT COMMAND SET EXCEPT THAT 15 BIT ADDRESSES ARE USED | |
54 | / EVERYWHERE AND THERE ARE NO COMMANDS FOR PROGRAM EXECU- | |
55 | / TION. | |
56 | / THE DOUBLE PRECISION ARITHMETIC ROUTINES ARE A MUCH | |
57 | / MODIFIED VERSION OF DECUS 8-115A. | |
58 | ||
59 | ||
60 | / ASSEMBLY INFORMATION: | |
61 | / | |
62 | / .R PAL8 [VERSION 9] | |
63 | / *FUTIL<FUTIL/L/K/P=6400$ | |
64 | / .SA ... FUTIL | |
65 | / | |
66 | / THE LISTING FILE REQUIRES ABOUT 725 BLOCKS, THE BIN- | |
67 | / ARY FILE ABOUT 35 BLOCKS AND THE CREF LISTING FILE ABOUT | |
68 | / 960 BLOCKS. CREFING REQUIRES EITHER "/M" OR "/X" FOR | |
69 | / CREF V3. | |
70 | ||
71 | ||
72 | /MEMORY ALLOCATION: | |
73 | / | |
74 | /00000-06310 PROGRAM PROPER | |
75 | /06310-06577 ARGUMENT STRING BUFFER | |
76 | /06400-06777 --- ONCE ONLY CODE FOR CHAIN --- | |
77 | /06600-07177 DDEV HANDLER AREA, 2 PAGES | |
78 | /07200-07577 DEVICE HANDLER AREA, 2 PAGES | |
79 | / | |
80 | /10000-11777 USR AREA & ERROR MESSAGES (SWAPPED) | |
81 | /12000-12377 CCB/HEADER CODE, OPEN, CLOSE & OUTPUT | |
82 | /12600-15700 TEXT STRINGS, LISTS | |
83 | /15700-16377 STRING MASK, COMMAND BUFFERS, PDL | |
84 | /16400-16577 CCB BUFFER, 1 PAGE | |
85 | /16600-17177 DDEV BUFFER, 2 PAGES | |
86 | /17200-17577 I/O BUFFER, 2 PAGES | |
87 | \f/PAGE 0: POINTERS, CONSTANTS, VARIABLES, SWITCHES, ADDRESSES | |
88 | ||
89 | ||
90 | *0 | |
91 | ||
92 | OVLFLG, 0 /OVERLAY FLAG FOR SAVE FILES | |
93 | ||
94 | DPSGN, 0 | |
95 | LASTOP, 0 | |
96 | THISOP, 0 | |
97 | ||
98 | ZBLOCK 3 /USED BY ODT | |
99 | ||
100 | /VARIABLES & SWITCHES | |
101 | PDLPT, 0 /P.D.L. POINTER | |
102 | DPNT, RUBO-1 /USED UNIVERSALLY (SCOPE INITIALIZATION) | |
103 | SPNT, SCOPLS-1 /USED BY 'XSTRIN', 'XSMASK', 'READ', 'TERMT' | |
104 | SCANX1, BATLS-1 /USED BY 'SORTJ' (BATCH INITIALIZATION) | |
105 | SCANX2, 0 /USED BY 'XSTRIN' | |
106 | GETPNT, 0 /USED BY 'GET' & 'BKLOC' | |
107 | COMIR, 0 /USED FOR USER LINE INPUT | |
108 | COMOUT, COMB-1 /USED FOR USER LINE SCAN | |
109 | TYPSW, 0 /ODT COMMAND OCT-SYM SWITCH (0=OCT) | |
110 | ERMODE, 0 /ERROR MESSAGE MODE SWITCH (0=LONG) | |
111 | ||
112 | TEMP, 0 | |
113 | TEMP1, 0 | |
114 | TEMP2, 0 | |
115 | TEMP3, 0 | |
116 | ACC1, 0 /24 BIT ACCUMULATORS | |
117 | ACC2, 0 | |
118 | ACCX1, 0 | |
119 | ACCX2, 0 | |
120 | ||
121 | NAM1= ACC1 /DEFINITIONS FOR NAME BUFFER: | |
122 | NAM2= ACC1+1 / THESE LOCATIONS ARE USED FOR A | |
123 | NAM3= ACC1+2 / 6 CHARACTER FILE (OR DEVICE) | |
124 | NAM4= ACC1+3 / NAME & A 2 CHAR EXTENSION. | |
125 | ||
126 | OPER1, 0 | |
127 | OPER2, 0 | |
128 | ||
129 | TEMPV1, 0 /24 BIT TEMPORARY STORAGE FOR | |
130 | TEMPV2, 0 / "SET TEMP ..." & "EVAL T" | |
131 | ||
132 | CHAR, 0 | |
133 | CNT, 0 | |
134 | CNTR, 0 | |
135 | CNTRA, 0 | |
136 | NCNT, 0 /LINE POSITION COUNTER | |
137 | FCNT, 0 /FORMAT NUMBER (INIT TO PACKED ASCII) | |
138 | OUTPNT, PACOUT /POINTER TO DEFAULT OUTPUT ROUTINE | |
139 | MODSW, 0 /MODES: NORMAL=0,MAPPED=+,OFFSET=-. | |
140 | CHARSW, 0 /CHARACTER PACK & UNPACK SWITCH | |
141 | CRSWT, 0 /= -1 IF GWORD TERMINATOR WAS A SPACE | |
142 | SHUT, 0 /= -1 IF SOMETHING OPEN | |
143 | MODIF, 0 /= -1 IF SOMETHING WAS MODIFIED | |
144 | ABSSW, 0 /ABSOLUTE OR RELATIVE LOCATION FOR SEARCHES | |
145 | DSWIT, 0 /DUMP SWITCH: "DUMP","LIST" & "SHOW ERR" -> 1 | |
146 | DMODE, 0 /DUMP MODE: NONE=0,PART=1,ALL=4000 | |
147 | ||
148 | CBLK, 0 /= CURRENT BLOCK | |
149 | 0 /DUMMY FOR "SHOW ABS" | |
150 | CAD, 0 /= CURRENT ADDRESS (0 -> 377)+IOBUF | |
151 | BLK, 0 /= "BLOCK" | |
152 | LOCH, 0 | |
153 | LOCL, 0 /= "LOCATION" (DISPLACEMENT) | |
154 | UBLK, 0 /UPPER LIMIT FOR SEARCHES | |
155 | ULOCH, 1 | |
156 | ULOCL, 7577 | |
157 | LBLK, 0 /LOWER LIMIT FOR SEARCHES | |
158 | LLOCH, 0 | |
159 | LLOCL, 200 | |
160 | SBLK, 0 /"LOCATION" FOR "ODT" ROUTINES | |
161 | SLOCH, 0 | |
162 | SLOCL, 0 | |
163 | ||
164 | OFFSET, 0 /OFFSET | |
165 | FILLER, 0 /FILLER CONSTANT FOR "MODIFY" | |
166 | MASK, -1 /MASK FOR WORD SEARCH | |
167 | SMASKL, -1 /= -(LENGTH OF SMASK) | |
168 | RBLK1, 0 /START BLOCK OF FILE | |
169 | DEVAD, 7607 /DEVICE ENTRY ADDR (INIT TO "SYS") | |
170 | DEVNO, 1 /DEVICE NUMBER (INIT TO "SYS") | |
171 | USRAD, 7700 /USR ADDRESS, INITIALIZED TO OUT | |
172 | /7700=MSGS IN; 0=NONE IN; 200=USR IN | |
173 | ||
174 | /CONSTANTS | |
175 | M400, -400 | |
176 | M240, -240 | |
177 | M215, -215 | |
178 | M200, -200 | |
179 | M100, -100 | |
180 | M20, -20 | |
181 | M10, -10 | |
182 | M1, -1 | |
183 | N7, 7 | |
184 | N15, 15 | |
185 | N20, 20 | |
186 | N77, 77 | |
187 | N177, 177 | |
188 | N200, 200 | |
189 | N377, 377 | |
190 | N7000, 7000 | |
191 | N7400= M400 | |
192 | ||
193 | /ADDRESSES | |
194 | READLN= JMS I . /GET NEXT INPUT LINE, WITH | |
195 | READ / SPECIAL TERMINATORS | |
196 | TYPSTI, TYPSTR | |
197 | TYPSI, TYPES | |
198 | TYPECI, TYPEC | |
199 | TWOCI, TWOCS | |
200 | CRLFI, CRLF | |
201 | DIGIT= JMS I . /OUTPUT AN ASCII DIGIT | |
202 | DODIG | |
203 | SPACE1= JMS I . /OUTPUT 1 SPACE OR ... | |
204 | DO1SP | |
205 | SPACE2= JMS I . /OUTPUT 2 SPACES | |
206 | DO2SP | |
207 | CTRLI, CTRL | |
208 | TWOT, PACOUT | |
209 | TYPEI, TYPE | |
210 | DECI, DPRT | |
211 | OCTI, OPRT | |
212 | DEC2I, DEC2 | |
213 | PDATEI, PDATE | |
214 | RTL6I, RTL6 | |
215 | RTR6I, RTR6 | |
216 | SOCTI, OCTSET | |
217 | BKLOCI, BKLOC | |
218 | EVALI, EVAL | |
219 | ||
220 | PUSH= JMS I . /PUSH AC ON P.D.L. | |
221 | PUSHX | |
222 | POP= JMS I . /POP P.D.L. INTO AC | |
223 | POPX | |
224 | CALUSR= JMS I . /DO USR FUNCTION | |
225 | USEUSR | |
226 | TADIDP= JMS I . /"TAD I DPNT" IN FIELD 1 | |
227 | TIDPNT | |
228 | TADICAD= JMS I . /"TAD I CAD" IN FIELD 1 | |
229 | TICAD | |
230 | DCAICAD= JMS I . /"DCA I CAD" IN FIELD 1 | |
231 | DICAD | |
232 | ||
233 | GWORDI, GWORD | |
234 | GARGI, GARGS | |
235 | ARGI, ARG | |
236 | GETI, GET | |
237 | ODGETI, ODGET | |
238 | GETNI, GETN | |
239 | SSKIPI, SSKIP | |
240 | LIMITI, LIMITS | |
241 | INCI, INC | |
242 | SORTI, SORTJ | |
243 | ENDCI, ENDC | |
244 | RECRLF, MAIN1-1 | |
245 | RESTAR, MAIN1 | |
246 | ||
247 | ERROR= JMS I . | |
248 | XERROR | |
249 | ||
250 | COMST, COMB-1 | |
251 | TEMPST, TEMPL-1 | |
252 | MASKBS, SMASKB-1 | |
253 | ||
254 | ||
255 | PAGE | |
256 | \f/PROGRAM MAIN LOOP AND DRIVER. COLLECTS CHARACTERS | |
257 | /INTO COMMAND BUFFER UNTIL END IS REACHED. | |
258 | ||
259 | DCA USRAD /CLEAR ON RESTART (NOTHING IN)! | |
260 | TLS /RAISE TELETYPE FLAG | |
261 | DCA SHUT /NOTHING IS OPEN | |
262 | JMS I CRLFI /OUTPUT CR-LF. | |
263 | MAIN1, JMS I SOCTI /SET INPUT TO OCTAL; EXEC 'COMMENT' | |
264 | DCA DSWIT /RESET DUMP OUTPUT SWITCH | |
265 | TAD COMST /INIT COMMAND BUFFER. | |
266 | DCA COMIR | |
267 | TAD (PDLB+1 /INIT PUSH-DOWN-LIST | |
268 | DCA PDLPT | |
269 | MAIN2, READLN /GET A LINE FROM INPUT. | |
270 | CCHARL-1 /CR LF ; ! / ALT- | |
271 | COPSL-CCHARL / MODES ETC... | |
272 | JMP MAIN1 /BUFFER WAS EMPTIED. | |
273 | ||
274 | ||
275 | /ROUTINE TO HANDLE CARRIAGE RETURN. | |
276 | CRCR, JMS I ENDCI /PUT A CR IN BUFFER | |
277 | JMP CRCRC /ONLY A CR IN BUFFER | |
278 | JMS I GWORDI /GET COMMAND WORD | |
279 | JMP CRCRN /BUFFER BEGINS WITH A # | |
280 | ISZ CRSWT /WORD ENDED BY A CR? | |
281 | JMP CRCR1 /YES, ONLY A FEW ARE OK | |
282 | JMS I SORTI /NO, LOOK UP COMMAND | |
283 | CWORDL-1 | |
284 | WOPSL-CWORDL | |
285 | ERCB, ERROR /NOT A LEGAL COMMAND | |
286 | / | |
287 | CRCR1, JMS I SORTI /"WRITE","REWIND","EXIT" & "COMMENT" | |
288 | CWORL2-1 | |
289 | WOPSLL-CWORL2 | |
290 | ERCA, ERROR /SOMETHING NOT LEGAL | |
291 | / | |
292 | CRCRN, JMS CLOSE /CLOSE THE OPEN LOCATION IF OPEN | |
293 | CRCRC, DCA SHUT / MARK LOCATION CLOSED | |
294 | JMP MAIN1 | |
295 | ||
296 | /ROUTINE TO HANDLE SLASH | |
297 | SLASH, JMS I ENDCI /END BUFFER WITH A CR | |
298 | JMP SLA1 /OPEN LAST, CR ONLY | |
299 | JMS WCHEK /DOES LINE START W. A WORD? | |
300 | JMS I LIMITI /NO, GET ARG-- | |
301 | SBLK / & SLOCH & SLOCL | |
302 | SLA1, SPACE1 /OUTPUT SPACE | |
303 | SLO1, JMS ODTOUT /GET THE WORD & OUTPUT | |
304 | SLO2, SPACE1 /FOLLOWED BY 2 SPACES | |
305 | SPACE1 /(FOR ";"--OUTPUT ONLY 1 SPACE AND | |
306 | JMS I ODGETI / THEN FORCE ACTION & IGNORE VALUE) | |
307 | STA | |
308 | JMP CRCRC /GO MARK LOCATION OPEN | |
309 | ||
310 | /ROUTINE TO HANDLE ALT MODE & ESCAPE KEYS | |
311 | ALTMOD, TAD OUTPNT /USE OUTPUT ROUTINE 'SET' BY | |
312 | JMP ALTM1 / 'FORMAT' OPTION. | |
313 | ||
314 | /ROUTINE TO CLOSE A LOCATION, OUTPUT ITS (NEW) CONTENTS IN A | |
315 | / SPECIFIED FORMAT AND THEN RE-OPEN. THE ROUTINE HANDLES: | |
316 | / # (BCD), $ (OS/8 ASCII), % (BYTE OCTAL), & (XS240 ASCII), | |
317 | / : (SIGNED DECIMAL), < (OCTAL), = (UNSIGNED DECIMAL), | |
318 | / > (PDP SYMBOLIC), @ (DATE), [ (ASCII), \ (FPP SYMBOLIC), | |
319 | / ] (PACKED ASCII) AND ? (DIRECTORY). | |
320 | / | |
321 | OMODES, TAD SCANX1 /'SORTJ' POINTER TO CHAR LIST | |
322 | TAD (OTABLE-1-CCHARL | |
323 | DCA DPNT /POINT INTO ADDR TABLE, | |
324 | TADIDP / GET OUTPUT ROUTINE ADDR, | |
325 | ALTM1, DCA OMODPT / & SET POINTER TO ROUTINE. | |
326 | JMS ECLOSE /CLOSE THIS LOCATION | |
327 | SPACE1 /OUTPUT SPACE | |
328 | DCA CHARSW /RESET UNPACK SWITCH | |
329 | JMS I ODGETI /GET WORD | |
330 | JMS I OMODPT /OUTPUT IN DESIRED FORMAT | |
331 | JMP SLO2 /AND GO REOPEN. | |
332 | OMODPT, 0 | |
333 | ||
334 | /ROUTINE TO HANDLE BACKARROW. | |
335 | BACKAR, JMS ECLOSE /CLOSE THIS LOCATION | |
336 | TADICAD /GET THE CONTENTS, | |
337 | JMP UPARR1 /AND USE THEM AS THE ADDR | |
338 | ||
339 | /ROUTINE TO HANDLE UPARROW. | |
340 | UPARR, JMS ECLOSE /CLOSE THIS LOCATION | |
341 | TADICAD /IS THIS A 'PAGE 0' REF.? | |
342 | AND N200 | |
343 | SZA CLA | |
344 | TAD SLOCL /YES, USE PAGE BITS | |
345 | AND M200 / MASK PAGE OR 0 TO PAGE # | |
346 | DCA SLOCL / & SAVE IT | |
347 | TADICAD /GET THE CONTENTS, | |
348 | AND N177 /AND USE THE ADDRESS BITS. | |
349 | TAD SLOCL / ALONG WITH PAGE BITS | |
350 | UPARR1, DCA SLOCL /THIS IS 12 BIT ADDR | |
351 | JMP EXCL2 /NOW GO FINISH | |
352 | \f/ROUTINE TO HANDLE SEMICOLON, LINE FEED & EXCLAMATION. | |
353 | ||
354 | SEMIC, DCA I READLN-4400 /SET NO-OUTPUT SWITCH | |
355 | LFLF, STA /LINE-FEED - CLOSE,INCREMENT,OUTPUT | |
356 | EXCL, DCA OMODPT /EXCLAMATION - CLOSE,DECREMENT,OUTPUT | |
357 | JMS ECLOSE /CLOSE THIS LOCATION | |
358 | IAC | |
359 | DCA ACC1 /SET UP D.P. INCREMENT | |
360 | DCA ACC2 | |
361 | EXCL1, DCA DPSGN /(FOR SAFETY) | |
362 | ISZ OMODPT /INCREMENT OR DECREMENT? | |
363 | JMS DPNEG / DECREMENT, NEGATE VALUE | |
364 | CLL | |
365 | TAD ACC1 | |
366 | TAD SLOCL /UPDATE LOCATION TO 15 BITS | |
367 | DCA SLOCL | |
368 | RAL | |
369 | TAD ACC2 | |
370 | TAD SLOCH | |
371 | AND N7 / (BUT ONLY 15 BITS) | |
372 | DCA SLOCH | |
373 | TAD I READLN-4400 / ANY OUTPUT? | |
374 | SNA CLA | |
375 | JMP SLO2+1 / NO, WAS ";" DO ONE SPACE | |
376 | EXCL2, JMS I CRLFI /GIVE CR/LF FOR NEXT LINE | |
377 | JMS I BKLOCI /OUTPUT ADDRESS | |
378 | SBLK-1 | |
379 | JMS I TWOCI /OUTPUT "\ " | |
380 | 3440 | |
381 | JMP SLO1 /NOW GO OPEN NEXT LOCATION | |
382 | ||
383 | /ROUTINE TO HANDLE PLUS & MINUS. | |
384 | PLUS, STA /"+", SET SWITCH | |
385 | MINUS, DCA OMODPT /"-", CLEAR SWITCH | |
386 | JMS I ENDCI /END BUFFER, TEST | |
387 | JMP EXCL2 /NO ARG, DO SAME AGAIN | |
388 | JMS WCHEK /LINE START WITH A COMMAND? | |
389 | JMS I ARGI /NO, GET AN ARG | |
390 | JMP EXCL1 /UPDATE LOC & GO OPEN | |
391 | ||
392 | ||
393 | ECLOSE, 0 /SUB. TO CLOSE THE LOCATION IF ARG. | |
394 | JMS I ENDCI /END BUFFER WITH A CR. | |
395 | JMP I ECLOSE /ONLY A CR IN BUFFER, DONE | |
396 | JMS WCHEK /DOES LINE START W. A WORD? | |
397 | JMS CLOSE /ARG IN BUFFER, USE IT | |
398 | JMP I ECLOSE /DONE | |
399 | ||
400 | CLOSE, 0 /SUBROUTINE TO CLOSE A LOCATION | |
401 | JMS I ARGI /GET ONE ARG | |
402 | ISZ SHUT /ANYTHING OPEN? | |
403 | JMP I CLOSE /NO, RETURN | |
404 | JMS I ODGETI /YES, SET UP THINGS RIGHT | |
405 | STA | |
406 | DCA MODIF /SET MODIFY FLAG | |
407 | TAD ACC1 /USE "LOC" AS DATA | |
408 | DCAICAD /STORE IT | |
409 | JMP I CLOSE | |
410 | ||
411 | ||
412 | PAGE | |
413 | \f/ROUTINE TO 'EVALUATE' A SIGNED DOUBLE PRECISION ARITHMETIC | |
414 | / EXPRESSION & OUTPUT THE RESULTS IN OCTAL & D.P. SIGNED | |
415 | / DECIMAL. | |
416 | XVAL, JMS I EVALI /GO EVALUATE | |
417 | SKP /TERMINATED BY A CR | |
418 | ERCC, ERROR / SORRY!--TOO MANY ")"S | |
419 | JMS I TWOCI /"= " | |
420 | 7540 | |
421 | TAD ACC2 | |
422 | JMS I OCTI /OUTPUT HIGH ORDER IN OCTAL | |
423 | TAD ACC1 | |
424 | JMS I OCTI /OUTPUT LOW ORDER IN OCTAL | |
425 | TAD ACCX1 /SAVE REMAINDER FOR LATER | |
426 | DCA COMIR | |
427 | TAD ACCX2 | |
428 | DCA COMOUT | |
429 | TAD (-7 | |
430 | DCA XERROR /MUST DEVELOP 7 DIGITS | |
431 | JMS I TWOCI /OUTPUT " (" | |
432 | 4050 | |
433 | TAD ACC2 /IS DPAC NEG? | |
434 | SMA CLA | |
435 | JMP DLOOP1-1 /NO, OUTPUT " " | |
436 | JMS DPNEG /YES, MAKE IT POSITIVE | |
437 | TAD N15 / AND OUTPUT "-". | |
438 | SPACE1 | |
439 | DLOOP1, TAD (12 /RESET DIVISOR TO 10(10) | |
440 | DCA OPER1 | |
441 | DCA OPER2 | |
442 | JMS DDIV /GO DIVIDE DPAC BY 10(10) | |
443 | TAD ACCX1 / GET REMAINDER | |
444 | PUSH /PUT IT ON PUSH-DOWN-LIST | |
445 | ISZ XERROR /DONE YET? | |
446 | JMP DLOOP1 | |
447 | TAD COMOUT /YES, RESTORE REMAINDER | |
448 | DCA ACCX2 | |
449 | TAD COMIR | |
450 | DCA ACCX1 | |
451 | TAD (-7 | |
452 | DCA XERROR /NOW SET UP TO OUTPUT 7 DIGITS | |
453 | DLOOP2, POP / IN REVERSE ORDER! | |
454 | DIGIT /MAKE REMAIN A DIGIT | |
455 | ISZ XERROR /DONE? | |
456 | JMP DLOOP2 | |
457 | JMS I TYPECI /YES, OUTPUT ")" | |
458 | ") | |
459 | JMP I RECRLF / AND CR/LF | |
460 | ||
461 | ||
462 | /ERROR ROUTINE | |
463 | XERROR, 0 | |
464 | CLA /CLEAR POSSIBLE JUNK FROM AC | |
465 | DCA DSWIT /RESET IN CASE DUMP MODE | |
466 | CDF 0 | |
467 | JMS I TYPECI /OUTPUT "?" | |
468 | "? | |
469 | TAD (ERLIST-1 /INIT LIST POINTER | |
470 | DCA DPNT | |
471 | DCA TEMP /SET CODE TO 0 | |
472 | XERR1, ISZ TEMP /BUMP ERROR CODE | |
473 | TADIDP /GET AN ADDRESS | |
474 | SNA | |
475 | JMP XERR2 /(FOR DEBUGGING) | |
476 | CMA /= -(ADDR+1) | |
477 | TAD XERROR /DOES IT MATCH THE CALL? | |
478 | SZA CLA | |
479 | JMP XERR1 /NO | |
480 | XERR2, TAD TEMP /YES, OUTPUT ERROR CODE | |
481 | JMS I DEC2I / AS 2 DECIMAL DIGITS | |
482 | JMS I TYPSI /NOW OUTPUT " AT " | |
483 | MS17 | |
484 | TAD (-COMB+1 /CALCULATE POSITION IN | |
485 | TAD COMOUT / COMMAND BUFFER, | |
486 | JMS I DEC2I / & OUTPUT AS 2 DIGITS. | |
487 | TAD ERMODE /LONG/SHORT MESSAGES? [NOTE: THIS -> | |
488 | XERR3, SZA CLA / "7600" (A CLA) IF 'USROUT' ERROR!] | |
489 | JMP XERR4 /SHORT, GO DO CR/LF | |
490 | JMS USROUT /LONG, BE SURE MESSAGES ARE IN | |
491 | SPACE2 /OUTPUT 2 SPACES | |
492 | TAD TEMP /CODE = ADDRESS-1 OF ADDRESS | |
493 | DCA DPNT / OF MESSAGE | |
494 | TADIDP /GET MESSAGE ADDR | |
495 | JMS I TYPSTI / OUTPUT MESSAGE | |
496 | XERR4, JMS I CRLFI /OUTPUT A CR,LF PAIR | |
497 | JMP I .+1 /*** CIF BAT /BATCH OPER. | |
498 | MAIN1 /*** JMP I N7000 /'BATABT'! | |
499 | ||
500 | ||
501 | USEUSR, 0 /USR CALLER SUBROUTINE (FROM EITHER FIELD!) | |
502 | DCA USRSAV /SAVE CONTENTS OF AC | |
503 | RDF | |
504 | TAD UCDF0 /SET UP RETURN FIELD (FOR 2ND USR CALL) | |
505 | DCA USRCDF | |
506 | UCDF0, CDF 0 /SET TO HERE FOR 1ST CALL | |
507 | TAD USRAD /IS USR IN OR OUT? | |
508 | SMA SZA CLA | |
509 | JMP USRIN /IN, GO TO IT | |
510 | CIF 10 | |
511 | JMS I M100 /OUT, DO "USRIN" FUNCTION | |
512 | 10 | |
513 | TAD N200 | |
514 | DCA USRAD / & SO INDICATE | |
515 | USRIN, CDF CIF 10 | |
516 | TAD USEUSR /MOVE RETURN ADDRESS TO THE | |
517 | DCA I N200 / USR ENTRY POINT | |
518 | USRCDF, CDF /SET UP D.F. FOR RETURN | |
519 | TAD USRSAV /RESTORE AC CONTENTS | |
520 | JMP I (201 / & FAKE A CALL TO IT | |
521 | USRSAV, | |
522 | ||
523 | USROUT, 0 /SUBROUTINE TO REMOVE USR BY RECALLING | |
524 | ERC15, TAD USRAD / ERROR MESSAGES FROM SCRATCH | |
525 | SPA CLA / BLOCKS ON SYS. | |
526 | JMP I USROUT /JUST EXIT IF PRESENT... | |
527 | TAD M100 | |
528 | DCA USRAD /SET USR TO "OUT" | |
529 | JMS I (7607 /READ IN THE MESSAGES | |
530 | 610 / 6 PAGES TO FIELD 1 | |
531 | 0 / STARTING AT LOC 10000 | |
532 | 27 / FROM SCRATCH BLKS | |
533 | SKP CLA /!!! ERROR !!! | |
534 | JMP I USROUT /OK, JUST EXIT | |
535 | TAD M200 | |
536 | DCA XERR3 /NO MORE MESSAGES ON ERROR! | |
537 | TAD ERC16 | |
538 | DCA ERC15 /AND NO MORE "SHOW ERROR"! | |
539 | ERC16, ERROR /TELL THE HORRIBLE STORY! | |
540 | ||
541 | ||
542 | PAGE | |
543 | \f/ROUTINE TO EXECUTE THE BLOCK 'SCAN' COMMAND | |
544 | XSCAN, JMS I GARGI /GET ARGS CONVERTED | |
545 | TAD (SCANER / & SET UP FOR SCANNING | |
546 | JMP XDUM0 | |
547 | ||
548 | /ROUTINE TO EXECUTE THE BLOCK 'DUMP' COMMAND | |
549 | XDUMP, TAD MODSW /MAPPED MODE? | |
550 | SMA SZA CLA | |
551 | ERC14, ERROR /YES, DUMP IS MEANINGLESS! | |
552 | JMS XDLCOM /DO COMMON STUFF | |
553 | TAD (LLIST / & SET UP FOR DUMPING | |
554 | XDUM0, DCA XGFORM /SET OUTPUT ROUTINE--DUMP/SCAN | |
555 | XDUM1, ISZ DPNT /SKIP FIRST WORD | |
556 | ISZ DPNT /SKIP A WORD | |
557 | TAD I DPNT /GET NEXT START BLOCK. | |
558 | JMS BLKTST | |
559 | TAD I DPNT /GET NEXT -(# BLOCKS) | |
560 | DCA TEMP1 | |
561 | XDUM2, JMS I CTRLI /TEST HERE FOR 'SCAN' TERMINATE | |
562 | DCA LOCL /SET LOC TO 0 | |
563 | DCA LOCH | |
564 | TAD M400 /SET TO -400(8) [1 BLOCK] | |
565 | JMS I XGFORM /DUMP OR SCAN A BLOCK | |
566 | ISZ BLK /INCREMENT BLOCK NUMBER | |
567 | ISZ TEMP1 /DONE? | |
568 | JMP XDUM2 /NO, DO NEXT BLOCK | |
569 | ISZ TEMP /YES, ARE ALL ARGS DONE? | |
570 | JMP XDUM1 /NO, DO NEXT | |
571 | JMP XLIS2 /YES, DONE--RESET SWITCH | |
572 | ||
573 | /ROUTINE TO EXECUTE THE LOCATION 'LIST' COMMAND | |
574 | XLIST0, JMS XDLCOM /DO COMMON STUFF | |
575 | XLIS1, TAD I DPNT /GET BLOCK # | |
576 | JMS BLKTST /TEST & SET BLK | |
577 | TAD I DPNT /GET & SET LOCATION | |
578 | DCA LOCH | |
579 | TAD I DPNT | |
580 | DCA LOCL | |
581 | TAD I DPNT /GET -(# WORDS) | |
582 | JMS LLIST /NOW GO DO IT | |
583 | ISZ TEMP /ARE ALL ARGS USED? | |
584 | JMP XLIS1 /NO, CONTINUE | |
585 | XLIS2, DCA DSWIT /RESET DUMP SWITCH | |
586 | JMP I RECRLF / DO CR/LF & CONTINUE | |
587 | ||
588 | /COMMON SUBROUTINE FOR 'XDUMP'&'XLIST0' | |
589 | XDLCOM, 0 | |
590 | TAD OUTPNT /INITIALIZE DEFAULTS | |
591 | DCA LISTPT | |
592 | TAD OUTSW | |
593 | DCA LOUTSW | |
594 | JMS XGFORM /GET FORMAT, IF ANY | |
595 | NOP /RETURN FOR NO FORMAT | |
596 | JMS I GARGI /GET ARGS | |
597 | ISZ DSWIT /SET DUMP SWITCH | |
598 | JMP I XDLCOM | |
599 | ||
600 | /SUBROUTINE TO OUTPUT -[C(AC)] WORDS FROM THE DEVICE | |
601 | /BEGINNING AT BLK.LOC IN THE SPECIFIED FORMAT | |
602 | LLIST, 0 | |
603 | DCA CNTRA /SET UP -# WORDS TO LIST | |
604 | DCA CHARSW /RESET UNPACK SWITCH | |
605 | LLIS1, JMS I CRLFI | |
606 | TAD LOCL | |
607 | AND N7 /SET UP # ON THIS LINE | |
608 | DCA CNTR | |
609 | TAD LOUTSW /IF CHARACTER OUTPUT, | |
610 | SNA CLA | |
611 | TAD M10 / DOUBLE # WORDS/LINE | |
612 | TAD CNTR | |
613 | TAD M10 | |
614 | DCA CNTR | |
615 | JMS I BKLOCI /OUTPUT LOCATION | |
616 | BLK-1 | |
617 | JMS I TYPSI /OUTPUT ": " | |
618 | MS13 | |
619 | LLIS2, JMS I GETI /GET A WORD | |
620 | JMP LLIS3 /FILE MODE, NO SUCH ADDR.. | |
621 | JMS I LISTPT /OUTPUT IT | |
622 | TAD LOUTSW /TEST MODE SWITCH | |
623 | SPA | |
624 | JMP LLIS5 /"SYMBOLIC", CR/LF NOW | |
625 | SZA CLA /CHARACTERS, NO SPACES | |
626 | SPACE2 /NUMBERS, TWO SPACES | |
627 | LLIS3, JMS I INCI /INCREMENT LOC | |
628 | ISZ CNTRA /ALL WORDS DONE? | |
629 | JMP LLIS4 /NO | |
630 | JMS I CRLFI | |
631 | JMP I LLIST /YES, RETURN | |
632 | / | |
633 | LLIS4, ISZ CNTR /ALL DONE WITH THIS LINE? | |
634 | JMP LLIS2 /NOT YET | |
635 | JMP LLIS1 /YES, OUTPUT CR/LF & CONTINUE | |
636 | / | |
637 | LLIS5, STA | |
638 | DCA CNTR /FORCE A CR/LF | |
639 | JMP LLIS3 | |
640 | LISTPT, 0 | |
641 | LOUTSW, 0 | |
642 | ||
643 | ||
644 | /SUBROUTINE TO GET A FORMAT FOR 'XFORM' & 'XDLCOM' | |
645 | XGFORM, 0 | |
646 | JMS I GWORDI /GET A WORD | |
647 | JMP I XGFORM /NOT FOLLOWED BY A WORD | |
648 | JMS I SORTI /LOOK UP WORD | |
649 | FORML-1 | |
650 | FOPSL-FORML | |
651 | ERCD, ERROR /WORD NOT RECOGNIZED | |
652 | / | |
653 | XFSYM, STL RAR /"SYMBOLIC"; SWITCH NEG | |
654 | XFNUM, IAC /NUMERIC; SWITCH POS | |
655 | XFCHR, DCA LOUTSW /CHARACTER; SWITCH 0 | |
656 | TAD SCANX1 /'SORTJ' POINTER TO CHAR | |
657 | TAD (-FORML /CALCULATE FORMAT # | |
658 | CLL RAR /(DIVIDE BY 2) | |
659 | DCA TEMP1 / & SAVE IT. | |
660 | TAD TEMP1 | |
661 | TAD (FTABLE-1 | |
662 | DCA DPNT | |
663 | TADIDP | |
664 | DCA LISTPT /SET UP OUTPUT POINTER | |
665 | ISZ XGFORM /BUMP RETURN ADDRESS | |
666 | JMP I XGFORM | |
667 | ||
668 | /ROUTINE TO 'SET' THE 'FORMAT' OPTION | |
669 | XFORM, JMS XGFORM /GET FORMAT WORD | |
670 | ERCE, ERROR /NUMBER?! SORRY ABOUT THAT! | |
671 | TAD LOUTSW /OK, SET UP DEFAULTS: | |
672 | DCA OUTSW / SWITCH, | |
673 | TAD LISTPT | |
674 | DCA OUTPNT / ROUTINE POINTER, | |
675 | TAD TEMP1 | |
676 | DCA FCNT / & FORMAT # | |
677 | JMP XSETN | |
678 | OUTSW, 0 /MODE:0=NOTHING,+=SPACES,-=CR/LF | |
679 | ||
680 | ||
681 | PAGE | |
682 | \f/ROUTINE TO EXECUTE THE 'OPEN' COMMAND. | |
683 | XOPEN, STA /"." LEGAL IN FILE NAME | |
684 | JMS GNAME /GET FILE NAME FOR OUTPUT | |
685 | CIF 10 | |
686 | JMP XOPEN1 /NOW GO TO FIELD 1 TO HANDLE | |
687 | ||
688 | ||
689 | /ROUTINE TO EXECUTE THE 'CLOSE' COMMAND. | |
690 | XCLOSE, CDF CIF 10 | |
691 | JMP XCLOS1 /ALL CODE IS IN FIELD 1 | |
692 | ||
693 | ||
694 | /ROUTINE TO EXECUTE THE 'FILE' COMMAND. | |
695 | XFIERR, TAD TEMP1 /MADE ALL POSSIBLE ATTEMPTS | |
696 | SMA CLA / AT EXTENSION RETRIES? | |
697 | JMP XFIOUT / YES, ALL TRIES DONE! | |
698 | ISZ DPSGN /THIS WILL SKIP ON 1ST FAIL | |
699 | ISZ TEMP1 /THIS WILL SKIP ON 2ND FAIL | |
700 | TAD (1404 / 2ND TRY--USE "LD" EXTEN | |
701 | DCA NAM4 / 3RD TRY--USE NULL EXTEN | |
702 | JMP XFICHN+2 / 3RD TRY IS FINAL FAILURE | |
703 | / | |
704 | XFIOUT, JMS PNAME /OUTPUT FILE NAME & | |
705 | JMS I TYPSI /"LOOKUP FAILED" | |
706 | MS15 | |
707 | / | |
708 | XFILEN, JMS I CRLFI /OUTPUT CR/LF | |
709 | ISZ CRSWT /WAS LAST ENDED BY A CR? | |
710 | JMP I RESTAR /YES, DONE | |
711 | XFILE, STA /"." LEGAL IN FILE NAME | |
712 | JMS GNAME /GET NEXT FILE NAME | |
713 | XFICHN, STA | |
714 | DCA DPSGN /SET TRY AGAIN SWITCH | |
715 | TAD (NAM1 /INIT POINTER TO NAME | |
716 | DCA FSTBLK | |
717 | TAD DEVNO /GET DEVICE # | |
718 | CALUSR | |
719 | 2 /LOOKUP | |
720 | FSTBLK, 0 /NAME PNTR, BECOMES ST BLK | |
721 | FBKLEN, 0 / BECOMES -(FILE LENGTH) | |
722 | JMP XFIERR /LOOKUP FAILED | |
723 | TAD FSTBLK | |
724 | DCA RBLK1 /SET UP PAGE 0 ST BLK | |
725 | CDF 10 | |
726 | DCA I (CCBB / & RESET CCBB | |
727 | TAD I (1404 /GET # ADD'L INFO WORDS | |
728 | DCA GDEV2 / (NEGATIVE) & SAVE IT | |
729 | TAD GDEV2 | |
730 | TAD I (17 /POINT TO FIRST OF THEM | |
731 | DCA GDEV3 / (THE DATE, IF PRESENT) | |
732 | TAD I N7 /GET THE NUMBER OF THE | |
733 | AND N7 / DIRECTORY SEGMENT IN | |
734 | DCA CNTR / CORE & SAVE IT. | |
735 | TAD GDEV2 /WAS # OF ADD'L WRDS = 0? | |
736 | SZA CLA | |
737 | TAD I GDEV3 / NO, GET THE DATE WORD | |
738 | CDF 0 | |
739 | DCA GDEV1 /STORE DATE OR 0 (NO DATE) | |
740 | JMS PNAME /OUTPUT FILE NAME | |
741 | TAD FSTBLK | |
742 | JMS I OCTI /OUTPUT ST. BLK. IN OCTAL | |
743 | JMS I TYPECI | |
744 | "- | |
745 | TAD FBKLEN /CALCULATE LAST BLK # | |
746 | CMA | |
747 | TAD FSTBLK | |
748 | JMS I OCTI / & OUTPUT IN OCTAL | |
749 | SPACE2 /OUTPUT 2 SPACES | |
750 | TAD FBKLEN | |
751 | CIA | |
752 | JMS I OCTI /OUTPUT LENGTH IN OCTAL | |
753 | JMS I TWOCI /" (" | |
754 | 4050 | |
755 | TAD FBKLEN | |
756 | CIA | |
757 | JMS I DECI / & AGAIN IN DECIMAL | |
758 | JMS I TYPSI /") " | |
759 | MS33 | |
760 | TAD CNTR /GET SEGMENT # | |
761 | JMS I RTL6I / & PUT IN BITS 3-5 | |
762 | JMS I TWOCI / TO OUTPUT IT & "." | |
763 | 6056 | |
764 | TAD GDEV3 /GET ADDR OF 1ST ADD'L WRD | |
765 | TAD (-1400-4 / FOR OFFSET OF NAME START | |
766 | JMS OCT3 /OUTPUT LOCATION IN SEG | |
767 | SPACE2 / & TWO SPACES | |
768 | TAD GDEV1 /GET DATE WORD | |
769 | SZA /IS IT = 0? | |
770 | JMS I PDATEI /NO, OUTPUT DATE | |
771 | JMP XFILEN /NOW OUTPUT CR/LF & CONTINUE | |
772 | ||
773 | ||
774 | /ROUTINE TO 'SET' THE 'DEVICE' OPTION | |
775 | XDEV, JMS GDEVICE /GET & FETCH DEVICE HANDLER | |
776 | DEVHAN+1 / (2 PAGE HANDLER IS OK) | |
777 | DCA DEVAD /SET UP HANDLER ADDRESS | |
778 | TAD GDEV2 /SAVE DEVICE # | |
779 | DCA DEVNO | |
780 | DCA RBLK1 / & NO FILE KNOWN | |
781 | DCA SHUT / & NOTHING OPENED | |
782 | DCA MODIF / & NOTHING MODIFIED | |
783 | TAD NAM1 | |
784 | CIF 10 | |
785 | JMP XDEVM /GO FINISH SETUP IN FIELD 1 | |
786 | ||
787 | ||
788 | /ROUTINE TO 'SET' THE 'DDEV' OPTION | |
789 | XDDEV, JMS GDEVICE /GET & FETCH DEVICE HANDLER | |
790 | DMPHAN+1 / (2 PAGE HANDLER IS OK) | |
791 | CIF 10 | |
792 | JMP XDDEV1 /GO TO FIELD 1 TO FINISH SETUP | |
793 | ||
794 | GDEVICE,0 /SUBROUTINE TO GET DEVICE NAME & FETCH HANDLER | |
795 | JMS GNAME /GET DEV NAME ("." ILLEGAL) | |
796 | TAD NAM1 /MOVE NAME TO CALL | |
797 | DCA GDEV1 | |
798 | TAD NAM2 | |
799 | DCA GDEV2 | |
800 | TAD I GDEVICE /GET HANDLER SPACE ADDRESS | |
801 | ISZ GDEVICE | |
802 | DCA GDEV3 | |
803 | CALUSR | |
804 | 1 /FETCH HANDLER | |
805 | GDEV1, 0 | |
806 | GDEV2, 0 | |
807 | GDEV3, 0 | |
808 | ERCY, ERROR /NO SUCH HANDLER | |
809 | TAD GDEV3 /RETURN HANDLER ADDRESS | |
810 | JMP I GDEVICE | |
811 | ||
812 | ||
813 | PAGE | |
814 | \f/ROUTINE TO EXECUTE THE 'SHOW' COMMAND | |
815 | XSHBLK, JMS I TYPSI /"BLOCK = " | |
816 | MS32 | |
817 | TAD RBLK1 /OUTPUT BLOCK IN OCTAL | |
818 | XSTYPE, JMS I OCTI | |
819 | XSHCR, JMS I CRLFI /GIVE A CR & LF | |
820 | DCA DSWIT /BE SURE SWITCH IS RESET | |
821 | ISZ CRSWT /LAST WORD ENDED BY CR? | |
822 | JMP I RESTAR /YES, DONE | |
823 | XSHOW, JMS I GWORDI /GET A WORD | |
824 | JMP ERCG /NUMBERS NOT RECOGNIZED | |
825 | JMS I SORTI /LOOK IT UP | |
826 | SHOWL-1 | |
827 | SHOWOP-SHOWL | |
828 | ERCG, ERROR /NOT FOLLOWED BY LEGAL WORD | |
829 | ||
830 | XSHVER, JMS I TYPSI /"VERSION = <VERSION><PATCH>" | |
831 | MSVER | |
832 | JMP XSHCR | |
833 | ||
834 | XSHMSK, JMS I TYPSI /"MASK = " | |
835 | MS02 | |
836 | TAD MASK | |
837 | JMP XSTYPE | |
838 | ||
839 | XSHOFF, JMS I TYPSI /"OFFSET = " | |
840 | MS09 | |
841 | TAD OFFSET | |
842 | CIA | |
843 | JMP XSTYPE | |
844 | ||
845 | XSHFIL, JMS I TYPSI /"FILLER = " | |
846 | MS37 | |
847 | TAD FILLER | |
848 | JMP XSTYPE | |
849 | ||
850 | XSHODL, JMS I TYPSI /"ODT LOC = " | |
851 | MS12 | |
852 | JMS I BKLOCI /OUTPUT IT | |
853 | SBLK-1 | |
854 | JMP XSHBKS | |
855 | ||
856 | XSHREL, JMS I TYPSI /"REL. LOC = " | |
857 | MS20 | |
858 | JMS I BKLOCI / & OUTPUT IT | |
859 | BLK-1 | |
860 | JMP XSHBKS | |
861 | ||
862 | XSHABS, JMS I TYPSI /"ABS. LOC = " | |
863 | MS03 | |
864 | TAD CAD /OUTPUT LOCATION IN BLOCK | |
865 | TAD (-IOBUF | |
866 | DCA CAD | |
867 | JMS I BKLOCI | |
868 | CBLK-1 | |
869 | XSHBKS, TAD MODIF /HAS BLOCK BEEN MODIFIED? | |
870 | SMA CLA | |
871 | JMP XSHCR / NO, SAY NOTHING! | |
872 | JMS I TYPSI / YES, SAY " MOD" | |
873 | MSMOD | |
874 | JMP XSHCR | |
875 | ||
876 | XSHUPP, JMS I TYPSI /"UPPER = " | |
877 | MS04 | |
878 | JMS I BKLOCI /OUTPUT IN BLOCK.LOC FORM | |
879 | UBLK-1 | |
880 | JMP XSHCR | |
881 | ||
882 | XSHLOW, JMS I TYPSI /"LOWER = " | |
883 | MS05 | |
884 | JMS I BKLOCI | |
885 | LBLK-1 | |
886 | JMP XSHCR | |
887 | ||
888 | XSHFMT, JMS I TYPSI /"FORMAT = " | |
889 | MS06 | |
890 | TAD FCNT | |
891 | TAD (FMTLS-1 /SET UP FOR CORRECT TITLE | |
892 | XSHFM, DCA DPNT | |
893 | TADIDP /GET MESSAGE ADDRESS | |
894 | JMS I TYPSTI /OUTPUT DESCRIPTOR | |
895 | JMP XSHCR | |
896 | ||
897 | XSHMOD, JMS I TYPSI /"MODE = " | |
898 | MS10 | |
899 | TAD MODSW /GET CORRECT MESSAGE | |
900 | TAD (MODELS-1 /(OFFSET INTO TABLE) | |
901 | JMP XSHFM /GET ADDRESS & OUTPUT | |
902 | ||
903 | XSHOUT, JMS I TYPSI /"OUTPUT = " | |
904 | MS30 | |
905 | TAD TYPSW /SET UP MESSAGE ADDRESS | |
906 | TAD (OUTLS-1 /(OFFSET INTO TABLE) | |
907 | JMP XSHFM | |
908 | ||
909 | XSHSMS, JMS I TYPSI /"SMASK = " | |
910 | MS07 | |
911 | TAD SMASKL | |
912 | DCA TEMP /-# TO OUTPUT | |
913 | TAD MASKBS | |
914 | DCA DPNT /SET UP TO OUTPUT | |
915 | TAD M10 /SET LINE LENGTH | |
916 | DCA TEMP1 | |
917 | JMP XSHSM2 | |
918 | XSHSM1, JMS I TWOCI /OUTPUT ", " | |
919 | 5440 | |
920 | ISZ TEMP1 /ENOUGH ON THIS LINE? | |
921 | JMP XSHSM2 /NO, OK | |
922 | JMS I CRLFI /YES, OUTPUT CR-LF | |
923 | SPACE2 / & 2 SPACES | |
924 | STA /MAKE LINE 1 LONGER | |
925 | JMP XSHSM1-3 /AND RESET LENGTH | |
926 | / | |
927 | XSHSM2, TADIDP /GET NEXT VALUE | |
928 | JMS I OCTI / & OUTPUT IT | |
929 | ISZ TEMP /ENOUGH? | |
930 | JMP XSHSM1 | |
931 | JMP XSHCR /OK, GET NEXT WORD | |
932 | ||
933 | XSHDEV, JMS I TYPSI /"DEVICE = XXXX" | |
934 | MSDEV | |
935 | JMS I TWOCI /NOW OUTPUT " (" | |
936 | 4050 | |
937 | TAD DEVNO /GET THE DEVICE # | |
938 | JMS I DEC2I / & OUTPUT AS 2 DIGITS | |
939 | JMS I TYPECI /FINALLY OUTPUT ")" | |
940 | ") | |
941 | JMP XSHCR | |
942 | ||
943 | XSHDDEV,JMS I TYPSI /"DDEV = XXXX" | |
944 | MSDDEV | |
945 | JMP XSHCR | |
946 | ||
947 | ||
948 | FPRNT, 0 /PRINT FIELD DIGIT FROM BITS 6-8 | |
949 | RTR /MOVE TO BITS 9-11 | |
950 | RAR | |
951 | AND N7 /MASK TO 1 DIGIT | |
952 | DIGIT / & OUTPUT IN ASCII | |
953 | JMP I FPRNT | |
954 | ||
955 | ||
956 | PAGE | |
957 | \f/CONTINUATION OF 'SHOW' COMMAND | |
958 | ||
959 | /SHOW 'CCB' HANDLER | |
960 | XSHCCB, CDF CIF 10 | |
961 | JMS GCCB /SET UP CCB FOR FILE | |
962 | DCA DPSGN / & SET UP SEGMENTS | |
963 | JMS I TYPSI /"CCB:" | |
964 | MS11 | |
965 | JMS CCHDST /DO SETUP, OUTPUT START | |
966 | JMS I TYPSI /", JSW = " | |
967 | MS19 | |
968 | JMS NXTOCT /OUTPUT J.S.W. IN OCTAL | |
969 | JMS I CRLFI | |
970 | JMS I TYPSI /" CORE SEGS: " | |
971 | MS14 | |
972 | XSHCC1, TAD (-4 | |
973 | DCA CNTR /-#/LINE | |
974 | XSHCC2, TADIDP /GET ORIGIN WORD | |
975 | DCA TEMP1 | |
976 | TADIDP / & COUNT WORD | |
977 | DCA TEMP2 | |
978 | TAD TEMP2 /GO OUTPUT START FIELD | |
979 | JMS FPRNT | |
980 | TAD TEMP1 / & START ADDR | |
981 | JMS I OCTI | |
982 | JMS I TYPECI / & A "-" | |
983 | "- | |
984 | TAD TEMP2 /OUTPUT FIELD AGAIN | |
985 | JMS FPRNT | |
986 | TAD TEMP2 / PAGE COUNT -> PAGES | |
987 | CLL RAL | |
988 | AND M200 /MASK OFF FIELD DATA | |
989 | TAD TEMP1 /ADD ORIGIN ADDR | |
990 | TAD M1 / & SUBTRACT 1 FOR END | |
991 | JMS I OCTI /OUTPUT END ADDR IN OCTAL | |
992 | ISZ DPSGN /DONE? | |
993 | JMP XSHCC4 /NO | |
994 | TAD OVLFLG /YES, OVERLAYS? (LINK OUTPUT) | |
995 | SNA | |
996 | JMP XSHCR / NO, DONE | |
997 | DCA DPNT / YES, RESET POINTER | |
998 | JMP XSHHD1 / & CONTINUE | |
999 | / | |
1000 | XSHCC4, JMS I TWOCI /OUTPUT SEPARATOR | |
1001 | 5440 | |
1002 | ISZ CNTR /DONE ON THIS LINE? | |
1003 | JMP XSHCC2 /NO | |
1004 | JMS I CRLFI /YES | |
1005 | SPACE2 /ADD 2 SPACES | |
1006 | STA /AND 1 MORE ITEM PER LINE | |
1007 | JMP XSHCC1 | |
1008 | ||
1009 | /SHOW 'HEADER' HANDLER | |
1010 | XSHHDR, CDF CIF 10 | |
1011 | JMS GHDR /SET UP HEADER FOR MODULE | |
1012 | JMS I TYPSI /"HEADER:" | |
1013 | MS38 | |
1014 | JMS CCHDST /DO SETUP, OUTPUT START | |
1015 | JMS I TYPSI /", NEXT WORD = " | |
1016 | MS39 | |
1017 | TADIDP /GET FIELD DIGIT | |
1018 | DIGIT / & OUTPUT | |
1019 | JMS NXTOCT /FOLLOWED BY ADDRESS | |
1020 | JMS I TYPSI /", LOAD VER = " | |
1021 | MS40 | |
1022 | JMS NXTOCT / & OUTPUT VERSION | |
1023 | TADIDP /GET E.P. FLAG | |
1024 | SNA CLA | |
1025 | JMP XSHHD1 / NO E.P. | |
1026 | JMS I TYPSI /", EP REQ'D" | |
1027 | MS41 | |
1028 | XSHHD1, JMS I CRLFI /TO THE NEXT LINE | |
1029 | JMS I TYPSI /" OVLYS START... | |
1030 | MS42 | |
1031 | XSHHD2, TADIDP /GET NUMBER OF OVERLAYS | |
1032 | SNA / FOR THIS LEVEL | |
1033 | JMP XSHCR / 0 = END, DONE | |
1034 | DCA TEMP1 /SAVE IT | |
1035 | JMS I CRLFI /OUTPUT A CR/LF | |
1036 | SPACE2 / AND 4 SPACES | |
1037 | SPACE2 | |
1038 | TAD TEMP1 | |
1039 | JMS I DEC2I /# OVLYS IN DECIMAL | |
1040 | SPACE2 | |
1041 | TADIDP /GET MEMORY START WORD | |
1042 | DCA TEMP2 | |
1043 | TAD TEMP2 | |
1044 | JMS FPRNT /OUTPUT START FIELD | |
1045 | TAD TEMP2 | |
1046 | AND M400 / & DOUBLE-PAGE | |
1047 | JMS I OCTI | |
1048 | SPACE2 | |
1049 | JMS NXTOCT /OUTPUT RELATIVE BLOCK | |
1050 | SPACE2 | |
1051 | JMS NXTOCT /OUTPUT OVERLAY LENGTH | |
1052 | JMP XSHHD2 /AND DO ANOTHER ROUND! | |
1053 | ||
1054 | /SHOW 'ERRORS' HANDLER | |
1055 | XSHERR, JMS USROUT /BE SURE MESSAGES ARE IN | |
1056 | ISZ DSWIT /SET DUMP SWITCH | |
1057 | JMS I TYPSI /"ERRORS: FUTIL VERSION ..." | |
1058 | MSERR | |
1059 | JMS I CRLFI | |
1060 | CLA IAC | |
1061 | DCA DPNT /SET POINTER & CODE | |
1062 | XSHER1, JMS I CRLFI /DO ANOTHER CR/LF | |
1063 | TAD DPNT /TEST FOR LAST REAL MESSAGE | |
1064 | TAD (-EMSEND /(NOT DEBUG MESSAGE!) | |
1065 | SNA CLA | |
1066 | JMP XSHCR | |
1067 | TAD DPNT /OUTPUT ERROR CODE | |
1068 | JMS I DEC2I / AS 2 DIGITS | |
1069 | JMS I TYPSI /THEN " = " | |
1070 | MS01 | |
1071 | TADIDP /GET ADDR OF MESSAGE AND | |
1072 | JMS I TYPSTI / OUTPUT IT | |
1073 | JMP XSHER1 | |
1074 | ||
1075 | ||
1076 | CCHDST, 0 | |
1077 | JMS I CRLFI | |
1078 | JMS I TYPSI /" SA = " | |
1079 | MS18 | |
1080 | TAD (CCBB | |
1081 | DCA DPNT /SET UP POINTER TO DATA | |
1082 | TADIDP /GET 2ND WORD FROM CCB/HDR | |
1083 | JMS FPRNT /IT HAS START FIELD SO OUTPUT | |
1084 | JMS NXTOCT / FOLLOWED BY START ADDR | |
1085 | JMP I CCHDST | |
1086 | ||
1087 | ||
1088 | PAGE | |
1089 | \f/ROUTINE TO EXECUTE THE 'SET' COMMAND | |
1090 | XSETN, ISZ CRSWT /WAS LAST INFO ENDED BY CR? | |
1091 | JMP I RESTAR /YES, DONE | |
1092 | XSET, JMS I GWORDI /GET OPTION WORD | |
1093 | JMP XSET1 /NO NUMBERS PLEASE! | |
1094 | ISZ CRSWT /WAS WORD ENDED BY A CR? | |
1095 | ERCK, ERROR /YES, ILLEGAL HERE | |
1096 | JMS I SORTI /LOOK UP WORD | |
1097 | SETLST-1 | |
1098 | SETJMP-SETLST | |
1099 | XSET1, ERROR /WHAT??? | |
1100 | ||
1101 | ||
1102 | /ROUTINE TO 'SET' THE 'DMODE' (DUMP MODE) | |
1103 | XDMODE, JMS I GWORDI /GET A WORD | |
1104 | JMP ERC11 /NO NUMBERS HERE! | |
1105 | JMS I SORTI /LOOK IT UP | |
1106 | XDMLST-1 | |
1107 | XDMOPS-XDMLST | |
1108 | ERC11, ERROR /NO LIKEE!! | |
1109 | / | |
1110 | CLL STA RAR /4000: 'ALL' (ECHO TO TTY & FILE) | |
1111 | XDMODS, IAC / 1: 'PART' (ONLY DUMP,LIST,ETC) | |
1112 | DCA DMODE / 0: 'NONE' (TTY ONLY) | |
1113 | JMP XSETN | |
1114 | ||
1115 | ||
1116 | /ROUTINE TO 'SET' THE 'OUTPUT' OPTION | |
1117 | XOUTS, JMS I GWORDI /GET OPTION WORD | |
1118 | JMP ERCL / # IN THE BUFFER | |
1119 | JMS I SORTI /LOOK IT UP | |
1120 | XOLST-1 | |
1121 | XOOPS-XOLST | |
1122 | ERCL, ERROR /NOT FOLLOWED BY LEGAL WORD | |
1123 | / | |
1124 | CLL STA RAL /-1: 'FPP' (SYMBOLIC) | |
1125 | XOUTS1, IAC /+1: 'PDP' (SYMBOLIC) | |
1126 | DCA TYPSW / 0: 'OCTAL' | |
1127 | JMP XSETN | |
1128 | ||
1129 | ||
1130 | /ROUTINE TO 'SET' THE 'MASK' OPTION | |
1131 | XMASK, JMS I ARGI /GET ONE ARG | |
1132 | TAD ACC1 /GET 'LOC' | |
1133 | DCA MASK / & SET MASK | |
1134 | JMP XSETN | |
1135 | ||
1136 | ||
1137 | /ROUTINE TO 'SET' THE 'OFFSET' OPTION | |
1138 | XOFFS, JMS I ARGI /GET ONE ARG | |
1139 | TAD ACC1 /GET # | |
1140 | CIA | |
1141 | DCA OFFSET /SET IT | |
1142 | JMP XSETN | |
1143 | ||
1144 | ||
1145 | /ROUTINE TO 'SET' THE 'ERROR' (MODE) OPTION | |
1146 | XEMODE, JMS I GWORDI /GET WORD | |
1147 | JMP ERCZ /NO NUMBERS ALLOWED!!! | |
1148 | JMS I SORTI /LOOK IT UP | |
1149 | XELST-1 | |
1150 | XEOPS-XELST | |
1151 | ERCZ, ERROR /ILLEGAL SOMETHING | |
1152 | / | |
1153 | XEMOD1, IAC /'SHORT' | |
1154 | DCA ERMODE /'LONG' | |
1155 | JMP XSETN | |
1156 | ||
1157 | ||
1158 | /ROUTINE TO 'SET' THE 'UPPER' LIMITS OPTION | |
1159 | XUPP, JMS I LIMITI /UPPER, GET ARGS | |
1160 | UBLK | |
1161 | JMP XSETN | |
1162 | ||
1163 | /ROUTINE TO 'SET' THE 'LOWER' LIMITS OPTION | |
1164 | XLOW, JMS I LIMITI /LOWER, GET ARGS | |
1165 | LBLK | |
1166 | JMP XSETN | |
1167 | ||
1168 | /ROUTINE TO 'SET' THE 'MODE' OPTION | |
1169 | XMODE, JMS I GWORDI /GET OPTION WORD | |
1170 | JMP ERCJ /NUMBER IN BUFFER, BAIL OUT | |
1171 | JMS I SORTI /LOOK IT UP | |
1172 | MODLST-1 | |
1173 | MODOPS-MODLST | |
1174 | ERCJ, ERROR /NOT RECOGNIZED | |
1175 | / | |
1176 | CLL STA RTL /-1: OFFSET | |
1177 | XMODS, IAC /+2: LOAD (MODULE) | |
1178 | IAC /+1: SAVE (FILE) | |
1179 | DCA MODSW / 0: NORMAL | |
1180 | JMP XSETN | |
1181 | ||
1182 | /ROUTINE TO 'SET' THE 'FILLER' OPTION | |
1183 | XFILL, JMS I ARGI /GET ONE ARG | |
1184 | TAD ACC1 | |
1185 | DCA FILLER / & SET AS FILLER | |
1186 | JMP XSETN | |
1187 | ||
1188 | /ROUTINE TO 'SET' THE 'TEMP' STORAGE | |
1189 | XTEMP, JMS I ARGI /GET THE 24 BIT ARG (EXPRESSION!) | |
1190 | TAD ACC1 /NOW SAVE THE 24 BITS FOR LATER | |
1191 | DCA TEMPV1 | |
1192 | TAD ACC2 /GET IT BACK WITH "EVAL T" | |
1193 | DCA TEMPV2 / (OR IN AN EXPRESSION) | |
1194 | JMP XSETN | |
1195 | ||
1196 | ||
1197 | /ROUTINE TO EXECUTE THE 'IF' COMMAND | |
1198 | XIF, JMS I EVALI /EVALUATE THE EXPRESSION | |
1199 | SKP / TERMIN = CR, OK | |
1200 | JMP ERCC / TOO MANY PARENS | |
1201 | TAD ACC1 /TEST THE 24-BIT VALUE FOR ZERO | |
1202 | SNA | |
1203 | TAD ACC2 | |
1204 | SNA CLA | |
1205 | JMP I RESTAR /OK, JUST CONTINUE | |
1206 | XIFSKP, TAD COMST /NOT ZERO, BEGIN SKIPPING FOR | |
1207 | DCA COMIR / LINE STARTING WITH "END" | |
1208 | READLN /GET A LINE FROM THE INPUT | |
1209 | TYPEM-1 / WITH THESE TERMINATORS | |
1210 | IFSKPO-TYPEM | |
1211 | JMP XIFSKP /BUFFER EMPTIED | |
1212 | / | |
1213 | XIFCR, JMS I ENDCI /CR FOUND, TIDY THINGS UP | |
1214 | JMP XIFSKP / CR ONLY | |
1215 | JMS I GWORDI /GET 1ST WORD ON LINE | |
1216 | JMP XIFSKP / NO WORD | |
1217 | TAD (-0516 /IS THE WORD "EN..."? | |
1218 | SZA CLA | |
1219 | JMP XIFSKP / NO, KEEP LOOKING! | |
1220 | JMP I RESTAR /YES! BEGIN EXECUTION AGAIN! | |
1221 | ||
1222 | ||
1223 | /ROUTINE TO OUTPUT LOCATION THAT SATISFIED ONE | |
1224 | /OF THE SEARCH COMMANDS. IF ABSSW=0, OUTPUT | |
1225 | /AS RELATIVE LOCATION. | |
1226 | ABKLOC, 0 | |
1227 | TAD ABSSW /IS IT 0? | |
1228 | SZA CLA | |
1229 | JMP ABK2 /NO, OUTPUT AS ABSOLUTE | |
1230 | JMS I BKLOCI /OUTPUT LOCATION | |
1231 | BLK-1 | |
1232 | ABK1, JMS I TWOCI /OUTPUT ": " | |
1233 | 7240 | |
1234 | JMS I TWOT | |
1235 | JMP I ABKLOC | |
1236 | / | |
1237 | ABK2, TAD LOCL /MAKE ABSOLUTE | |
1238 | AND N377 | |
1239 | DCA CAD | |
1240 | JMS I BKLOCI /NOW OUTPUT IT | |
1241 | CBLK-1 | |
1242 | JMP ABK1 | |
1243 | ||
1244 | TWOCS, 0 /OUTPUT 2-CHARACTER ARG | |
1245 | TAD I TWOCS /GET ARG | |
1246 | ISZ TWOCS /SKIP IT | |
1247 | JMS I TWOT /OUTPUT IT | |
1248 | JMP I TWOCS | |
1249 | ||
1250 | NXTOCT, 0 | |
1251 | TADIDP /GET NEXT WORD FROM BLOCK | |
1252 | JMS I OCTI / & OUTPUT IN OCTAL | |
1253 | JMP I NXTOCT | |
1254 | ||
1255 | ||
1256 | PAGE | |
1257 | \f/ROUTINE TO EXECUTE THE 'WORD' SEARCH COMMAND | |
1258 | XWORD, JMS SSET /INITIALIZE SEARCH | |
1259 | TAD CNOP /SET UP FOR NORMAL, | |
1260 | DCA CNOP+1 | |
1261 | TAD M10 / EQUAL SEARCH | |
1262 | XWOR2, TAD (SNA CLA /"UNEQUAL" WORD SEARCH | |
1263 | DCA XWORC | |
1264 | XWOR1, JMS I GWORDI /GET POSSIBLE WORD | |
1265 | JMP XWOR3 /NUMBERS IN BUFFER | |
1266 | ISZ CRSWT /WAS IT ENDED BY A CR? | |
1267 | ERCI, ERROR /YES, VELLY SOLLY! | |
1268 | JMS I SORTI /LOOK UP COMMAND: UN, ME, | |
1269 | XWORCL-1 / AB, FR, TO | |
1270 | XWOROP-XWORCL | |
1271 | ERCH, ERROR /COMMAND NOT RECOGNIZED | |
1272 | / | |
1273 | XWOR7, TAD XWOR4+1 /"MEMREF", ONLY MEMORY- | |
1274 | DCA CNOP+1 / REFERENCE OP-CODES CAN | |
1275 | JMP XWOR1 / EVER BE OUTPUT. | |
1276 | / | |
1277 | XWOR3, JMS I ARGI /GET AN ARG | |
1278 | TAD ACC1 /GET THE VALUE | |
1279 | AND MASK | |
1280 | CIA | |
1281 | DCA CNT /LOOK FOR THIS WORD | |
1282 | JMS LSETUP /SET UP COUNT OF WORDS TO DO | |
1283 | XWOR4, JMS I GETI /GET A WORD | |
1284 | JMP XWOR5 /FILE MODE, NO SUCH ADDRESS | |
1285 | AND MASK | |
1286 | TAD CNT | |
1287 | XWORC, HLT /WILL BE "SZA CLA" OR "SNA CLA" | |
1288 | JMP XWOR5 /DID NOT MATCH | |
1289 | JMS OPRTST /TEST FOR OP-CODES 6 & 7 | |
1290 | CNOP, NOP / 7--OPR | |
1291 | NOP / 6--IOT;"NOP" OR "JMP XWOR5" | |
1292 | JMS ABKLOC /DID MATCH, OUTPUT LOC | |
1293 | JMS I GETI /GET THAT WORD | |
1294 | JMP ERCP / OH I HOPE NOT!!! | |
1295 | JMS I OCTI /AND OUTPUT IT IN OCTAL | |
1296 | JMS I CRLFI | |
1297 | XWOR5, JMS LCHEK /DONE YET? | |
1298 | JMP XWOR4 /NO | |
1299 | ||
1300 | /SUBROUTINE TO INITIALIZE THE SEARCH COMMANDS | |
1301 | SSET, 0 | |
1302 | DCA ABSSW /RESET ABSOLUTE SWITCH | |
1303 | TAD LBLK /SET UP START BLK & LOC | |
1304 | DCA BLK | |
1305 | TAD LLOCH | |
1306 | DCA LOCH | |
1307 | TAD LLOCL | |
1308 | DCA LOCL | |
1309 | TAD UBLK /SET UP END BLK & LOC | |
1310 | DCA EBLK | |
1311 | TAD ULOCH | |
1312 | DCA ELOCH | |
1313 | TAD ULOCL | |
1314 | DCA ELOCL | |
1315 | JMP I SSET | |
1316 | ||
1317 | /COMMON OPTIONS FOR 'WORD' AND 'STRING' SEARCHES | |
1318 | ||
1319 | XWSABS, STA | |
1320 | DCA ABSSW /'ABSOLUTE'--SET SWITCH | |
1321 | JMP XWSRET | |
1322 | / | |
1323 | XWSFRM, JMS I LIMITI /'FROM'--GET LOWER LIMITS | |
1324 | BLK | |
1325 | JMP XWSRET | |
1326 | / | |
1327 | XWSTO, TAD UBLK /'TO'--SET UP IF NEEDED | |
1328 | DCA EBLK | |
1329 | JMS I LIMITI / & GET UPPER LIMITS | |
1330 | EBLK | |
1331 | XWSRET, STA CLL RAL /= -2, CALCULATE RETURN ADDRESS AS | |
1332 | TAD I GWORDI / LAST CALL TO "GWORD" TO ALLOW | |
1333 | DCA LCHEK / THESE TO BE COMMON TO BOTH | |
1334 | JMP I LCHEK / 'WORD' AND 'STRING' SEARCHES. | |
1335 | EBLK, 0 | |
1336 | ELOCH, 0 | |
1337 | ELOCL, 0 | |
1338 | ||
1339 | ||
1340 | LSETUP, 0 /SET SEARCH WORD-COUNTERS **** SEE NOTE **** | |
1341 | DCA ACC1 /INITIALIZE THESE TO 0 | |
1342 | DCA ACC2 | |
1343 | TAD MODSW /IN A MAPPED MODE? | |
1344 | SMA SZA CLA | |
1345 | JMP LSETL / YES, IGNORE BLOCK PARTS | |
1346 | TAD BLK / NO, SET UP FOR 24 BIT | |
1347 | DCA ACC1 | |
1348 | TAD EBLK / BLK-EBLK | |
1349 | DCA OPER1 | |
1350 | DCA OPER2 | |
1351 | JMS DSUB /DO THE SUBTRACTION | |
1352 | TAD (400 /NOW SET UP MULTIPLY BY 400 | |
1353 | DCA OPER1 | |
1354 | DCA OPER2 | |
1355 | JMS DMUL /GIVES: (BLK-EBLK)*400 | |
1356 | LSETL, CLL IAC | |
1357 | TAD ELOCL | |
1358 | DCA OPER1 /NOW SET UP ELOC+1 | |
1359 | RAL | |
1360 | TAD ELOCH | |
1361 | DCA OPER2 | |
1362 | JMS DSUB /AND SUBTRACT IT | |
1363 | TAD LOCL /NOW ADD LOC TO GIVE: | |
1364 | DCA OPER1 / (BLK-EBLK)*400+(LOC-ELOC-1) | |
1365 | TAD LOCH / WHICH IS 24-BIT COUNT OF | |
1366 | DCA OPER2 / WORDS TO SEARCH. | |
1367 | JMS DADD | |
1368 | TAD ACC2 /IF NOT NEGATIVE, ALREADY TOO | |
1369 | SMA CLA | |
1370 | JMP I RECRLF / FAR, SO JUST QUIT NOW! | |
1371 | JMP I LSETUP | |
1372 | ||
1373 | /**** NOTE: COUNT LEFT SET UP IN ACC1 & ACC2 **** | |
1374 | ||
1375 | LCHEK, 0 /CHECK IF SEARCH RANGE EXHAUSTED | |
1376 | JMS I INCI /INCREMENT LOC | |
1377 | ISZ ACC1 /COUNT WORDS TO DO | |
1378 | JMP I LCHEK | |
1379 | ISZ ACC2 / (24-BIT) | |
1380 | JMP I LCHEK | |
1381 | JMP I RECRLF /DO CR/LF & STOP! | |
1382 | ||
1383 | ||
1384 | TIDPNT, 0 /"TAD I DPNT" IN FIELD 1 | |
1385 | CDF 10 | |
1386 | TAD I DPNT | |
1387 | CDF 0 | |
1388 | JMP I TIDPNT | |
1389 | ||
1390 | ||
1391 | ASCII, 0 /ASCII OUTPUT FORMAT FROM DEVICE | |
1392 | AND N177 /MAKE CHARS INTO "STANDARD" | |
1393 | TAD N200 / FORM: 7 BITS + PARITY ON | |
1394 | JMS I TYPEI / TO CAUSE CORRECT PRINTING | |
1395 | JMP I ASCII | |
1396 | ||
1397 | ||
1398 | PAGE | |
1399 | \f/ROUTINE TO 'REWIND' THE DEVICE | |
1400 | XREWIN, CDF 10 | |
1401 | TAD USRAD /RESET DIRECTORY SEGMENT KEY | |
1402 | SMA CLA | |
1403 | DCA I N7 / IN USR IF IT IS IN MEMORY. | |
1404 | CDF 0 | |
1405 | JMS I DEVAD /CALL HANDLER | |
1406 | 0110 /READ, 1 PAGE, FIELD 1 | |
1407 | PDLB /DUMMY BUFFER (ZAP P.D.L.) | |
1408 | 1 /BLK 1 | |
1409 | JMP RERROR /READ ERROR! | |
1410 | JMP I RESTAR | |
1411 | ||
1412 | /READ ERROR--TEST TYPE & OUTPUT MESSAGE | |
1413 | ||
1414 | RERROR, SPA CLA /BIT 0 = 1 IF FATAL | |
1415 | ERC00, ERROR /FATAL | |
1416 | ERC01, ERROR /NON-FATAL | |
1417 | ||
1418 | ||
1419 | /ROUTINE TO EXECUTE THE 'STRING' SEARCH COMMAND | |
1420 | XSTRIN, JMS SSET /INITIALIZE | |
1421 | TAD (STJMP-STCDF /RESET MASKING SWITCH | |
1422 | XSTR0, TAD XREWIN / OR SET MASKING SWITCH | |
1423 | DCA SMSKSW | |
1424 | JMS I GWORDI /GET POSSIBLE WORD | |
1425 | JMP XSTR1 /NUMBERS ONLY | |
1426 | ISZ CRSWT /FOLLOWED BY A CR? | |
1427 | JMP ERCI / YES, KICK OUT***** | |
1428 | JMS I SORTI /LOOK UP OPTION: MA, | |
1429 | STRLST-1 / AB, FR, TO | |
1430 | STROPS-STRLST | |
1431 | JMP ERCH /NO LIKEE! | |
1432 | / | |
1433 | XSTR1, JMS I GARGI /GET ARGS - THEN REPACK INTO BUFFER | |
1434 | TAD TEMP / MASKING THEM IF SPECIFIED | |
1435 | DCA CNTR /SET UP LENGTH | |
1436 | TAD TEMPST | |
1437 | DCA SCANX2 /STORING DONE IN NEG. FORM | |
1438 | JMP XSTR2+2 /GO SET UP MASK | |
1439 | / | |
1440 | XSTR2, ISZ TEMP3 /MASK END? | |
1441 | JMP XSTR3 | |
1442 | TAD MASKBS /YES, RESET MASK | |
1443 | DCA SPNT | |
1444 | TAD SMASKL /SET UP LENGTH | |
1445 | DCA TEMP3 | |
1446 | XSTR3, ISZ DPNT /SKIP 2 EXTRA WORDS | |
1447 | ISZ DPNT | |
1448 | TAD I DPNT /GET A WORD | |
1449 | JMS STRMSK /TEST & MASK | |
1450 | CIA /NEGATE | |
1451 | DCA I SCANX2 /STORE | |
1452 | ISZ DPNT /BUMP POINTER | |
1453 | ISZ CNTR /DONE? | |
1454 | JMP XSTR2 | |
1455 | JMS LSETUP /YES, SET UP COUNT OF WORDS | |
1456 | XSTR4, TAD TEMPST /SET UP FOR SEARCH: | |
1457 | DCA DPNT / STRING, | |
1458 | TAD TEMP | |
1459 | DCA CNTR / & STRING LENGTH. | |
1460 | TAD LOCL | |
1461 | DCA XLOCL /SAVE CURRENT LOCATION | |
1462 | TAD LOCH | |
1463 | DCA XLOCH | |
1464 | TAD BLK | |
1465 | DCA XBLK | |
1466 | TAD ACC1 / & COUNT FOR RESET | |
1467 | DCA OPER1 | |
1468 | TAD ACC2 | |
1469 | DCA OPER2 | |
1470 | JMP XSTR6 /NOW SET UP MASK | |
1471 | / | |
1472 | XSTR5, JMS LCHEK /DONE? | |
1473 | ISZ TEMP3 /NO, AT MASK END? | |
1474 | JMP XSTR7 | |
1475 | XSTR6, TAD MASKBS / YES, RESET MASK | |
1476 | DCA SPNT | |
1477 | TAD SMASKL | |
1478 | DCA TEMP3 | |
1479 | XSTR7, JMS I GETI /GET NEXT WORD | |
1480 | JMP XSTR10 /MAPPED MODE, NO SUCH ADDRESS | |
1481 | JMS STRMSK /TEST & MASK | |
1482 | TAD I DPNT /COMPARE? | |
1483 | SZA CLA | |
1484 | JMP XSTR10 /NO, GO RESET & CONTINUE | |
1485 | ISZ CNTR /MATCHED ENOUGH? | |
1486 | JMP XSTR5 /NOT YET | |
1487 | JMS XRSET /YES, RESET LOCATION & COUNT | |
1488 | TAD TEMP /AND LENGTH | |
1489 | DCA CNTR | |
1490 | XSTR8, TAD M10 | |
1491 | DCA ACCX1 / -(#/LINE) | |
1492 | JMS ABKLOC /OUTPUT THIS LOCATION | |
1493 | XSTR9, JMS I GETI /GET A WORD | |
1494 | JMP ERCP /BAD,BAD,BAD!!! | |
1495 | JMS I OCTI /AND OUTPUT IN OCTAL | |
1496 | JMS I INCI /INCREMENT LOC | |
1497 | ISZ CNTR /DONE? | |
1498 | JMP XSTR11 /NO, CONTINUE | |
1499 | JMS I CRLFI /YES, OUTPUT CR/LF | |
1500 | XSTR10, JMS XRSET /RESET LOCATION & COUNT | |
1501 | JMS LCHEK /DONE? | |
1502 | JMP XSTR4 /NO, LOC INC'D, TRY NEXT | |
1503 | / | |
1504 | XSTR11, SPACE2 /OUTPUT " " | |
1505 | ISZ ACCX1 /DONE ON THIS LINE? | |
1506 | JMP XSTR9 /NO, NOT YET | |
1507 | JMS I CRLFI /YES | |
1508 | JMP XSTR8 | |
1509 | ||
1510 | XRSET, 0 /RESET BLK & LOC FROM XBLK & XLOC | |
1511 | TAD XLOCL /LOC | |
1512 | DCA LOCL | |
1513 | TAD XLOCH | |
1514 | DCA LOCH | |
1515 | TAD XBLK /BLK | |
1516 | DCA BLK | |
1517 | TAD OPER1 /WORDS LEFT TO SEARCH | |
1518 | DCA ACC1 | |
1519 | TAD OPER2 | |
1520 | DCA ACC2 | |
1521 | JMP I XRSET | |
1522 | ||
1523 | STRMSK, 0 /STRING MASKING *** NEXT WORD MODIFIED *** | |
1524 | SMSKSW, CDF 10 /"CDF 10" OR "JMP I STRMSK" | |
1525 | AND I SPNT /OK, MASK IN FIELD 1 | |
1526 | CDF 0 | |
1527 | JMP I STRMSK | |
1528 | STJMP= JMP I STRMSK | |
1529 | STCDF= CDF 10 | |
1530 | ||
1531 | XBLK, 0 | |
1532 | XLOCH, 0 | |
1533 | XLOCL, 0 | |
1534 | ||
1535 | ||
1536 | PAGE | |
1537 | \f/ROUTINE TO EXECUTE THE BLOCK 'WRITE' COMMAND | |
1538 | XWRARG, JMS I ARGI /GET ONE ARG | |
1539 | TAD ACC1 /USE IT AS THE BLOCK | |
1540 | SKP | |
1541 | XWRITE, TAD WBLK /SET BLOCK | |
1542 | DCA XWBLK | |
1543 | JMS I DEVAD /CALL HANDLER | |
1544 | 4210 /WRITE, 2 PAGES, FIELD 1 | |
1545 | IOBUF | |
1546 | XWBLK, 0 /[** COUNTER FOR MODIFY **] | |
1547 | JMP WERROR /WRITE ERROR | |
1548 | DCA MODIF /CLEAR SOMETHING-CHANGED FLAG | |
1549 | JMP I RESTAR | |
1550 | ||
1551 | /WRITE ERROR--TEST TYPE & OUTPUT MESSAGE | |
1552 | ||
1553 | WERROR, SPA CLA /BIT 0 = 1 IF FATAL | |
1554 | ERC02, ERROR /FATAL | |
1555 | ERC03, ERROR /NON-FATAL | |
1556 | ||
1557 | ||
1558 | /ROUTINE TO EXECUTE THE 'MODIFY' COMMAND | |
1559 | XMODIF, JMS I GWORDI /GET FORMAT WORD IF ONE | |
1560 | JMP XMODEF /NONE, GET DEFAULT | |
1561 | DCA MODTMP /SAVE FOR LATER | |
1562 | ISZ CRSWT /TERMINATED BY A CR? | |
1563 | JMP ERCO / YES, SAVE USER FROM HIMSELF! | |
1564 | TAD MODTMP /TEST FORMAT FOR RECOGNITION | |
1565 | JMS I SORTI | |
1566 | MODIFL-1 | |
1567 | MODADS-MODIFL | |
1568 | ERCO, ERROR / I THEENK YOU USE BAD WORD! | |
1569 | / | |
1570 | /NO FORMAT DESCRIPTOR GIVEN, USE DEFAULT | |
1571 | XMODEF, TAD FCNT /USE CURRENT FORMAT, | |
1572 | TAD (MODDLS-1 / WITH A LITTLE DIFFERENCE | |
1573 | DCA DPNT | |
1574 | TADIDP /GET THE ONE TO USE | |
1575 | DCA MODTMP / AND SAVE IT | |
1576 | / | |
1577 | XMOD0, JMS I GARGI /OK, NOW GET ARGS | |
1578 | TAD TEMP /MOVE COUNT TO A SAFE PLACE | |
1579 | DCA XWBLK | |
1580 | XMOD1, TAD I DPNT /GET BLOCK # | |
1581 | JMS BLKTST /TEST & SET BLK | |
1582 | TAD I DPNT /GET LOC | |
1583 | DCA LOCH | |
1584 | TAD I DPNT | |
1585 | DCA LOCL | |
1586 | TAD I DPNT /GET -(# LOCS) | |
1587 | DCA CNTR | |
1588 | XMOD2, TAD COMST /INIT COMM. BUFF. FOR MODS | |
1589 | DCA COMIR | |
1590 | DCA CHARSW /RESET HALF SWITCH | |
1591 | JMS I SOCTI /INITIALIZE INPUT TO OCTAL | |
1592 | JMS I BKLOCI /OUTPUT START LOC | |
1593 | BLK-1 | |
1594 | JMS I TWOCI /AND ": " | |
1595 | 7240 | |
1596 | READLN /GET A LINE (TEST: RUBOUT, ^U & ^R) | |
1597 | TYPEM-1 /IGNORE LF'S | |
1598 | MCHARO-TYPEM | |
1599 | JMP XMOD2 /BUFFER EMPTIED! | |
1600 | ||
1601 | ||
1602 | /CR TYPED, END | |
1603 | XMODCR, JMS I ENDCI /END BUFFER WITH A CR. | |
1604 | JMP XMOD2 /ONLY A CR IN BUFFER-RETRY! | |
1605 | TAD MODTMP /NOW LOOK UP FORMAT | |
1606 | JMS I SORTI | |
1607 | MODIFL-1 | |
1608 | MODIFO-MODIFL | |
1609 | ERCP, ERROR /ILLEGAL (EXTRA BAD IF HERE) | |
1610 | ||
1611 | XMODDN, ISZ XWBLK /RETURN HERE, ALL ARGS DONE? | |
1612 | JMP XMOD1 /NO | |
1613 | JMP I RESTAR /YES | |
1614 | MODTMP, 0 | |
1615 | ||
1616 | XGET, 0 /SUB. TO SET CURRENT LOC & FLAG | |
1617 | JMS I GETI /SET LOCATION | |
1618 | ERC07, ERROR /MAPPED MODE, NO SUCH ADDRESS | |
1619 | STA | |
1620 | DCA MODIF /SET FLAG | |
1621 | JMP I XGET | |
1622 | ||
1623 | /NUMERIC FORMATS HERE | |
1624 | XNUM0, JMS I SORTI /TEST TERMINATOR | |
1625 | GETLST-1-1 /SPACE, COMMA, CR | |
1626 | NUMOPS-GETLST+1 | |
1627 | JMP ERCQ /ILLEGAL TERMIN | |
1628 | / | |
1629 | XNUM1, JMS I GETNI /COMMA, SKIP IT | |
1630 | JMS I SSKIPI / SPACE, IGNORE IT | |
1631 | XNUM2, JMS EXPRIN /GET NEXT ARG--EXPRESSION | |
1632 | JMS XGET /SET UP LOCATION | |
1633 | TAD ACC1 | |
1634 | DCAICAD / & STORE VALUE | |
1635 | JMS I INCI /INCREMENT LOCATION | |
1636 | ISZ CNTR /ALL MODS DONE? | |
1637 | JMP XNUM0 /NO, TEST TERMIN | |
1638 | JMP XMODDN /YES, TEST NEXT SET | |
1639 | / | |
1640 | XNUM3, TAD CNTR /DONE? | |
1641 | SNA CLA | |
1642 | JMP XMODDN /YES | |
1643 | JMS XGET /NO, SET UP LOC | |
1644 | TAD FILLER | |
1645 | DCAICAD /AND FILL WITH 'FILLER' | |
1646 | JMS I INCI /INCREMENT LOC | |
1647 | ISZ CNTR /DONE? | |
1648 | JMP XNUM3 /NO | |
1649 | JMP XMODDN /YES | |
1650 | ||
1651 | /ASCII FORMAT HERE | |
1652 | JMS CGET /GET A CHAR & CHECK FOR CR | |
1653 | XASC1, JMS XGET /SET UP LOC & SET FLAG | |
1654 | TAD CHAR | |
1655 | DCAICAD /STORE THIS CHAR | |
1656 | JMS I INCI /INCREMENT LOC | |
1657 | ISZ CNTR /MODS DONE? | |
1658 | JMP XASC1-1 /NO | |
1659 | JMP XMODDN /YES | |
1660 | ||
1661 | CGET, 0 /GET NEXT CHAR. IF CR, MODS DONE | |
1662 | JMS CGTEST /GET & TEST NEXT | |
1663 | JMP XNUM3 /CR, FILL REST WITH 'FILLER' | |
1664 | JMP I CGET | |
1665 | ||
1666 | CGTEST, 0 /SUB. TO GET A CHAR & CHECK FOR CR | |
1667 | JMS I GETNI /GET NEXT CHARACTER | |
1668 | TAD CHAR /IS IT A CR? | |
1669 | TAD M215 | |
1670 | SZA CLA | |
1671 | ISZ CGTEST /RETURN TO CALL+2 IF NOT | |
1672 | JMP I CGTEST | |
1673 | ||
1674 | ||
1675 | DO1SP, 0 /OUTPUT " " + AC | |
1676 | JMS I TYPECI | |
1677 | " | |
1678 | JMP I DO1SP /ANOTHER TUFFIE | |
1679 | ||
1680 | DO2SP, 0 /OUTPUT " " + AC (PACKED ASCII) | |
1681 | JMS I TWOCI | |
1682 | 4040 | |
1683 | JMP I DO2SP /FAST & SWEET! | |
1684 | ||
1685 | ||
1686 | PAGE | |
1687 | \f/ROUTINE TO EXECUTE THE 'SMASK' (STRING MASK) COMMAND | |
1688 | XSMASK, JMS I GARGI /GET ARGS | |
1689 | TAD TEMP | |
1690 | DCA SMASKL /SAVE -(MASK LENGTH) | |
1691 | TAD MASKBS /SET UP TO STORE WORDS | |
1692 | DCA SPNT | |
1693 | XSMAS1, ISZ DPNT /SKIP 2 WORDS | |
1694 | ISZ DPNT | |
1695 | TAD I DPNT /GET & STORE ONE | |
1696 | CDF 10 | |
1697 | DCA I SPNT | |
1698 | CDF 0 | |
1699 | ISZ DPNT /SKIP 1 MORE | |
1700 | ISZ TEMP /DONE ? | |
1701 | JMP XSMAS1 /NO | |
1702 | JMP I RESTAR | |
1703 | ||
1704 | ||
1705 | /XS240 PACKED ASCII FORMAT HERE | |
1706 | XXS20, TAD M240 /SET OFFSET | |
1707 | /PACKED ASCII FORMAT HERE | |
1708 | XPAC0, DCA PNAME /CLEAR OFFSET | |
1709 | XPAC1, TAD M240 /IS CHAR < 240? | |
1710 | TAD CHAR | |
1711 | SMA CLA | |
1712 | JMP XPAC2 /NO, JUST PACK CHAR | |
1713 | CMA | |
1714 | JMS PACK /YES, PACK A FLAG (77) FIRST | |
1715 | XPAC2, TAD CHAR /NOW GO PACK CHAR | |
1716 | TAD PNAME /(WITH DESIRED OFFSET) | |
1717 | JMS PACK | |
1718 | JMS CGET /NOW GET & TEST NEXT | |
1719 | JMP XPAC1 / OK, CONTINUE | |
1720 | ||
1721 | /OS/8 ASCII HERE | |
1722 | XOPS1, TAD LOCL /TEST START & COUNT FOR EVEN | |
1723 | RAR /(LOW BIT TO LINK & | |
1724 | CLA / CLEAR AC) | |
1725 | TAD CNTR | |
1726 | RAR /(LOW TO LINK, LINK TO AC0) | |
1727 | SZL SPA CLA /BOTH L=0 & AC0=0 FOR OK | |
1728 | ERC04, ERROR /START OR COUNT NOT EVEN | |
1729 | XOPS2, TAD CHARSW /GET SWITCH | |
1730 | ISZ CHARSW / & BUMP IT | |
1731 | CLL RAR /ROTATE AC 11 INTO LINK | |
1732 | SZL SNA CLA /CHARACTER 3? | |
1733 | JMP XOPS5 /NO, CHAR 1 OR CHAR 2 | |
1734 | STA | |
1735 | TAD CAD /YES, BACK UP POINTER | |
1736 | DCA CAD | |
1737 | STA CLL RAL / & SET LOOP COUNT TO -2 | |
1738 | DCA CHARSW | |
1739 | XOPS3, TAD CHAR /GET REST OF CHAR | |
1740 | CLL RTL /4 BITS LEFT | |
1741 | RTL | |
1742 | DCA CHAR /SAVE IT | |
1743 | TAD CHAR /NOW MERGE 4 BITS WITH | |
1744 | AND N7400 / A PREVIOUS CHAR | |
1745 | TADICAD | |
1746 | DCAICAD /4 BITS OF 3RD + 1ST OR 2ND | |
1747 | ISZ CAD /BUMP POINTER | |
1748 | ISZ CHARSW /DONE? | |
1749 | JMP XOPS3 | |
1750 | TAD CNTR /YES, DONE ALL MODS? | |
1751 | SNA CLA | |
1752 | JMP XMODDN /YES, TEST FOR DONE | |
1753 | XOPS4, JMS CGET /GET & TEST NEXT CHAR | |
1754 | JMP XOPS2 /OK, DO NEXT | |
1755 | / | |
1756 | XOPS5, JMS XGET /SET UP CURRENT LOC | |
1757 | TAD CHAR | |
1758 | DCAICAD /AND STORE CHARACTER | |
1759 | JMS I INCI /INCREMENT LOC | |
1760 | ISZ CNTR /BUMP COUNTER FOR LATER | |
1761 | JMP XOPS4 / SO IGNORE SKIP NOW | |
1762 | JMP XOPS4 | |
1763 | ||
1764 | PACK, 0 /SUB. TO PACK CHARACTERS | |
1765 | AND N77 /USE ONLY 6 BITS | |
1766 | ISZ CHARSW /CHECK HALF | |
1767 | JMP PACK1 | |
1768 | TADICAD /RIGHT HALF, ADD TO LEFT | |
1769 | DCAICAD | |
1770 | TAD CNTR /ALL MODS DONE? | |
1771 | SZA CLA | |
1772 | JMP I PACK /NO | |
1773 | JMP XMODDN /YES | |
1774 | / | |
1775 | PACK1, JMS I RTL6I /LEFT HALF, ROTATE INTO IT | |
1776 | DCA CHARSW /SAVE IT | |
1777 | JMS XGET /SET UP CURRENT LOC | |
1778 | TAD CHARSW | |
1779 | DCAICAD /STORE WORD | |
1780 | JMS I INCI /INCREMENT LOC | |
1781 | ISZ CNTR /BUMP COUNTER FOR LATER | |
1782 | NOP / SO DON'T SKIP NOW | |
1783 | STA | |
1784 | DCA CHARSW /RESET SWITCH | |
1785 | JMP I PACK | |
1786 | ||
1787 | ||
1788 | PNAME, 0 /PRINT A FILE NAME, PADDED W. SPACES | |
1789 | TAD NAM1 | |
1790 | JMS I TWOT / OUTPUT UP TO | |
1791 | TAD NAM2 | |
1792 | JMS I TWOT / 6 CHARACTERS | |
1793 | TAD NAM3 | |
1794 | JMS I TWOT / OF FILE NAME, | |
1795 | JMS I TYPECI / A "." | |
1796 | ". | |
1797 | TAD NAM4 / & UP TO 2 CHARS | |
1798 | JMS I TWOT / OF EXTENSION. | |
1799 | PNAME1, SPACE1 /OUTPUT A " " | |
1800 | TAD NCNT /11(10) CHARS ON LINE YET? | |
1801 | TAD (-13 | |
1802 | SPA CLA | |
1803 | JMP PNAME1 /NO, OUTPUT ANOTHER SPACE | |
1804 | JMP I PNAME | |
1805 | ||
1806 | ||
1807 | /SUBROUTINE TO GET A NUMERIC ARGUMENT FROM THE | |
1808 | / COMMAND BUFFER AND RETURN IT TO THE 3 WORDS | |
1809 | / POINTED TO BY CALL+1. THE FIRST WORD (BLOCK | |
1810 | / NUMBER) IS NOT CHANGED IF NO BLOCK PART WAS | |
1811 | / GIVEN IN THE COMMAND. | |
1812 | ||
1813 | LIMITS, 0 | |
1814 | TAD I LIMITS /GET ADDRESS OF 3 WORDS | |
1815 | ISZ LIMITS | |
1816 | DCA PNAME / & SAVE IT | |
1817 | JMS I ARGI /GET COMMAND DATA | |
1818 | TAD TEMP1 /GET BLOCK NUMBER PART | |
1819 | ISZ TEMP1 /WAS A BLOCK PART SPEC'D? | |
1820 | DCA I PNAME / YES, STORE IT | |
1821 | CLA /(CLEAR IN CASE NOT!) | |
1822 | ISZ PNAME /BUMP POINTER | |
1823 | TAD ACC2 | |
1824 | AND N7 | |
1825 | DCA I PNAME /STORE HIGH 3 BITS | |
1826 | ISZ PNAME | |
1827 | TAD ACC1 | |
1828 | DCA I PNAME / & LOW 12 BITS OF ADDR. | |
1829 | JMP I LIMITS | |
1830 | ||
1831 | ||
1832 | PAGE | |
1833 | \f/SUBROUTINE TO 'GET' A WORD FROM THE DEVICE. | |
1834 | / | |
1835 | / THE ACTUAL WORD ON THE DEVICE THAT IS ACCESSED | |
1836 | / IS DEPENDENT ON THE MODE SWITCH, AS FOLLOWS: | |
1837 | / | |
1838 | / MODE ACTION | |
1839 | / | |
1840 | / 0 = NORMAL THE HIGH 7 BITS OF THE 15 BIT ADDRESS | |
1841 | / ARE ADDED TO THE SPECIFIED BLOCK # | |
1842 | / TO GET THE ACTUAL BLOCK & THE LOW 8 | |
1843 | / BITS OF THE 15 BIT ADDR ARE USED TO | |
1844 | / SPECIFY THE WORD WITHIN THE BLOCK. | |
1845 | / | |
1846 | / -1 = OFFSET THE 12 BIT "OFFSET" (WHICH IS NEGATED) | |
1847 | / IS ADDED TO THE LOW 12 BITS OF THE | |
1848 | / ADDRESS, AND THEN THE NEW ADDRESS IS | |
1849 | / HANDLED AS ABOVE. | |
1850 | / THIS MODE IS USED PRIMARILY WHEN | |
1851 | / WORKING WITH THE OPERATING SYSTEM | |
1852 | / WITH OVERLAYS WHOSE REAL START BLOCK | |
1853 | / AND LOCATION WITHIN A FIELD ARE KNOWN. | |
1854 | / BY SETTING THE "OFFSET" TO THE START | |
1855 | / ADDRESS OF THE OVERLAY, ITS REAL | |
1856 | / ADDRESSES CAN BE USED AND THE PROPER | |
1857 | / LOCATIONS WILL BE ACCESSED. | |
1858 | / | |
1859 | / +1 = SAVE THIS MODE IS USED WITH CORE IMAGE | |
1860 | / "SAVE" FILES ONLY. THE FILE'S CCB | |
1861 | / (CORE CONTROL BLOCK) IS USED TO | |
1862 | / DETERMINE THE REAL LOCATION ON THE | |
1863 | / DEVICE OF THE SPECIFIED 15 BIT ADDR- | |
1864 | / ESS. THE START BLOCK OF THE FILE | |
1865 | / IS USED, AND ANY SPECIFIED "BLOCK" | |
1866 | / PART IS USED TO SPECIFY THE OVERLAY | |
1867 | / WANTED AT THAT ADDRESS. FOR FILES | |
1868 | / WITHOUT OVERLAYS (GENERATED BY THE | |
1869 | / MONITOR "SAVE" COMMAND), THIS PART | |
1870 | / MUST BE ZERO (0) OR NO MATCH WILL | |
1871 | / OCCUR. FOR FILES WITH OVERLAYS | |
1872 | / (GENERATED BY THE PROGRAM "LINK"), | |
1873 | / A LEGAL OVERLAY AT THE SPECIFIED | |
1874 | / ADDRESS MUST BE SPECIFIED FOR A | |
1875 | / MATCH TO OCCUR. THIS MODE CAN ONLY | |
1876 | / BE USED AFTER A "FILE" COMMAND. | |
1877 | / | |
1878 | / +2 = LOAD THIS MODE IS USED WITH OS/8 FORTRAN | |
1879 | / IV LOAD MODULES. THE FILE'S HEADER | |
1880 | / BLOCK IS USED TO DETERMINE THE REAL | |
1881 | / LOCATION ON THE DEVICE OF THE SPECI- | |
1882 | / FIED 15 BIT ADDRESS AND THE "BLOCK" | |
1883 | / PART IS USED TO SPECIFY THE OVERLAY | |
1884 | / WANTED AT THAT ADDRESS. THIS MODE CAN | |
1885 | / ONLY BE USED AFTER A "FILE" COMMAND. | |
1886 | ||
1887 | ||
1888 | /CALLING SEQUENCE: | |
1889 | / | |
1890 | / JMS I GETI | |
1891 | / RETURN1 /MODE=MAPPED, NO SUCH ADDRESS | |
1892 | / NORMAL RETURN /'CAD' SET, DATA IN AC | |
1893 | \f/SUBROUTINE 'GET'--PART OF THIS PAGE & ALL OF NEXT | |
1894 | ||
1895 | GET, 0 | |
1896 | JMS I CTRLI /GO TEST FOR CONTROL-CHARS | |
1897 | TAD MODSW /OK, TEST MODE | |
1898 | SNA | |
1899 | JMP GET0 /NORMAL MODE, NO CHANGES | |
1900 | SMA CLA | |
1901 | JMP GET4 /SAVE MODE, DO MAPPING | |
1902 | TAD OFFSET /OFFSET MODE, ADD IT | |
1903 | GET0, JMS DBLPGS /NOW ADD 'DOUBLE PAGES' | |
1904 | TAD BLK / OF LOC TO BLK TO SET | |
1905 | DCA CBLK /'CURRENT BLOCK' | |
1906 | GET1, JMS GETIO /OUTPUT CURREN (IF NEEDED), GET NEXT | |
1907 | JMP RERROR / READ ERROR, GO TELL ABOUT IT | |
1908 | TAD MODSW /TEST AGAIN FOR OFFSET | |
1909 | SPA CLA | |
1910 | TAD OFFSET /YES, ADD IT AGAIN | |
1911 | TAD LOCL /USE 8 ADDRESS BITS FROM LOC | |
1912 | AND N377 | |
1913 | TAD BUFST /INTO BUFFER, TO SET | |
1914 | DCA CAD /'CURRENT ADDRESS' | |
1915 | TADICAD /NOW GET THE WORD | |
1916 | ISZ GET /RETURN TO CALL+2 WITH IT | |
1917 | GETX, JMP I GET /[EXIT TO CALL+1 FOR MAP FAIL] | |
1918 | ||
1919 | GETIO, 0 /DO I/O FOR 'GET' & 'SCANER' | |
1920 | TAD CBLK /IS THIS SAME BLOCK AS IS IN | |
1921 | CIA /CORE CURRENTLY? | |
1922 | TAD RBLK | |
1923 | SNA CLA | |
1924 | JMP GETIO2 /YES, USE IT. | |
1925 | ISZ MODIF /NO, ANY CHANGES IN THIS BLK? | |
1926 | JMP GETIO1 /NO, DEVICE OK AS IS | |
1927 | JMS I DEVAD /CALL DEVICE HANDLER | |
1928 | 4210 /WRITE, 2 PAGES, FIELD 1 | |
1929 | BUFST, IOBUF | |
1930 | WBLK, 0 | |
1931 | JMP WERROR /WRITE ERROR | |
1932 | GETIO1, TAD CBLK /NOW UPDATE OUTPUT BLOCK | |
1933 | DCA WBLK | |
1934 | TAD CBLK / AND INPUT BLOCK # | |
1935 | DCA RBLK | |
1936 | DCA MODIF / AND RESET SWITCH | |
1937 | TAD CBLK /SHOW BLOCK NUMBER IN LIGHTS | |
1938 | MQL / (IF THERE ARE ANY!) | |
1939 | CLA | |
1940 | JMS I DEVAD /CALL DEVICE HANDLER | |
1941 | 0210 /READ, 2 PAGES, FIELD 1 | |
1942 | IOBUF | |
1943 | RBLK, -1 /(NOTHING IN CORE-ILLEGAL BLK #) | |
1944 | JMP I GETIO /READ ERROR | |
1945 | GETIO2, ISZ GETIO /OK, DO NORMAL RETURN | |
1946 | JMP I GETIO | |
1947 | ||
1948 | ||
1949 | DBLPGS, 0 /CONVERT LOCATION TO DOUBLE-PAGES | |
1950 | TAD LOCL | |
1951 | AND M400 /HIGH 4 BITS HERE | |
1952 | CLL RAL /BECOME LOW 4 BITS | |
1953 | TAD LOCH /FOR A 7 BIT VALUE | |
1954 | RTL | |
1955 | RTL | |
1956 | JMP I DBLPGS | |
1957 | ||
1958 | ||
1959 | /GET WORD ROUTINE FOR "ODT" COMMANDS | |
1960 | ||
1961 | ODGET, 0 | |
1962 | TAD SBLK /SET UP BLOCK | |
1963 | DCA BLK | |
1964 | TAD SLOCH | |
1965 | DCA LOCH | |
1966 | TAD SLOCL | |
1967 | DCA LOCL /SET UP LOCATION | |
1968 | JMS I GETI /NOW GET WORD | |
1969 | ERC05, ERROR /MAPPED MODE, NO SUCH ADDRESS | |
1970 | JMP I ODGET / & RETURN WITH IT | |
1971 | ||
1972 | ||
1973 | /OUTPUT 12 BIT BLOCK # & 15 BIT ADDRESS IN OCTAL | |
1974 | ||
1975 | BKLOC, 0 | |
1976 | TAD I BKLOC /GET ARGUMENT (ADDR-1) | |
1977 | ISZ BKLOC | |
1978 | DCA GETPNT / & SET UP A-XR | |
1979 | TAD I GETPNT /GET BLOCK PART | |
1980 | JMS I OCTI / & OUTPUT IT | |
1981 | TAD I GETPNT /GET FIELD | |
1982 | AND N7 | |
1983 | JMS I TWOCI / & OUTPUT "." & IT | |
1984 | 5660 / (".0") | |
1985 | TAD I GETPNT /GET ADDRESS | |
1986 | JMS I OCTI / & OUTPUT IT | |
1987 | JMP I BKLOC | |
1988 | ||
1989 | ||
1990 | /SUBROUTINE TO GET A COMMAND WORD OR CHARACTER | |
1991 | /FROM THE COMMAND BUFFER. IF THE BUFFER CONTAINS | |
1992 | /ONLY NUMERIC ITEMS, RETURN TO CALL+1. TERMINATOR | |
1993 | /IS SPACE OR CR | |
1994 | GWORD, 0 | |
1995 | JMS I SSKIPI /GET NEXT NON-SPACE | |
1996 | TAD CHAR | |
1997 | AND N77 /USE THIS CHAR AS LEFT | |
1998 | JMS I RTL6I / 6 BITS. | |
1999 | DCA CHARSW /SAVE IT | |
2000 | JMS I SORTI /CHECK FOR ^K, ^D, (, ", ', | |
2001 | GWLST1-1 / DIGITS, SPACE & CR | |
2002 | GWOPS1-GWLST1 | |
2003 | JMS I GETNI /NONE, IS NEXT A SPACE | |
2004 | JMS I SORTI / OR A C.R.? | |
2005 | GWLST2-1 | |
2006 | GWOPS2-GWLST2 | |
2007 | TAD CHAR /NONE, USE AS LOWER 6 BITS | |
2008 | AND N77 | |
2009 | TAD CHARSW | |
2010 | DCA CHARSW /SAVE IT | |
2011 | GWD1, JMS I GETNI /LOOK FOR SPACE OR C.R. | |
2012 | JMS I SORTI | |
2013 | GWLST2-1 | |
2014 | GWOPS2-GWLST2 | |
2015 | JMP GWD1 /NEITHER, KEEP LOOKING | |
2016 | / | |
2017 | GWD2, STA /SPACE FOUND, SET SWITCH | |
2018 | GWD3, DCA CRSWT /CR FOUND, RESET SWITCH | |
2019 | TAD CHARSW /RETURN WITH WORD | |
2020 | ISZ GWORD / TO CALL+2 | |
2021 | GWD4, JMP I GWORD | |
2022 | /EXIT TO CALL+1 IF ANY NUMERIC ITEM FOUND-- | |
2023 | / ^K, ^D, (, ", ', DIGITS | |
2024 | ||
2025 | ||
2026 | /"DIRECTORY" FORMAT OUTPUT ROUTINE | |
2027 | DIRDMP, 0 | |
2028 | JMS I OCTI /OUTPUT IN OCTAL FIRST | |
2029 | SPACE2 | |
2030 | TADICAD | |
2031 | JMS DIROUT / THEN 3 OTHERS | |
2032 | JMP I DIRDMP | |
2033 | ||
2034 | /"?" ODT OUTPUT ROUTINE | |
2035 | DIROUT, 0 | |
2036 | CIA /ASSUME WAS NEGATIVE | |
2037 | JMS I DECI / & OUTPUT IN DECIMAL | |
2038 | SPACE2 | |
2039 | TADICAD | |
2040 | JMS I PDATEI /OUTPUT AGAIN AS DATE | |
2041 | SPACE2 | |
2042 | TADICAD | |
2043 | JMS I TWOT /OUTPUT LAST TIME AS PACKED ASCII | |
2044 | JMP I DIROUT | |
2045 | ||
2046 | ||
2047 | PAGE | |
2048 | \f/CONTINUATION OF 'GET' -- MAPPING FOR "SAVE" AND "LOAD" | |
2049 | / MODES DONE HERE. | |
2050 | ||
2051 | GET4, JMS DBLPGS /GET # DOUBLE-PAGES | |
2052 | DCA CAD / & SAVE IT | |
2053 | STA | |
2054 | TAD MODSW /TEST FOR SAVE OR LOAD MODE | |
2055 | SZA CLA | |
2056 | JMP GETL1 / LOAD MODE | |
2057 | CDF CIF 10 | |
2058 | JMS GCCB /SAVE MODE, GET CCB | |
2059 | DCA SEGCNT / & SET UP # SEGMENTS | |
2060 | TAD RBLK1 /SET UP ACTUAL FIRST BLOCK | |
2061 | IAC | |
2062 | DCA CBLK / FOR MAPPING. | |
2063 | GETS1, CDF 10 | |
2064 | TAD I GETPNT /GET AN ORIGIN WORD | |
2065 | DCA GETORG | |
2066 | TAD I GETPNT / & A CONTROL WORD. | |
2067 | CDF 0 | |
2068 | DCA GETCW | |
2069 | TAD GETCW /TEST FOR FIELD MATCH | |
2070 | CLL RTR | |
2071 | RAR | |
2072 | AND N7 /(MASK OFF COUNT) | |
2073 | CIA | |
2074 | TAD LOCH /SAME? | |
2075 | SZA CLA | |
2076 | JMP GETS2 /NO, TRY NEXT SEGMENT | |
2077 | TAD LOCL /YES, NOW TEST ADDRESSES | |
2078 | AND M200 /(MASK TO PAGE) | |
2079 | STL CIA | |
2080 | TAD GETORG /[ORIG PAGE]-[ADDR PAGE] | |
2081 | SZA SNL /ABOVE THE ORIGIN? | |
2082 | JMP GETS2 /NO, TRY NEXT | |
2083 | RAR /OK, DIVIDE BY 2 (WITH SIGN) | |
2084 | DCA GETORG / & SAVE IT. | |
2085 | TAD GETCW /BEYOND TOP OF SEGMENT? | |
2086 | AND M100 /(MASK OFF FIELD AND MAKE) | |
2087 | SNA | |
2088 | STL RAR / 0 => 40, THEN SUBTRACT | |
2089 | TAD M100 / ONE PAGE) | |
2090 | TAD GETORG | |
2091 | SPA CLA | |
2092 | JMP GETS2 /NO, TRY NEXT | |
2093 | TAD GETORG /YES, UPDATE CBLK TO RIGHT | |
2094 | CIA | |
2095 | JMS UPCBLK / ACTUAL BLOCK | |
2096 | TAD BLK /MUST BE IN "LVL 0" OR | |
2097 | SZA CLA | |
2098 | JMP GETX / RETURN AS BAD | |
2099 | JMP GET1 /NOW GO GET THE DATA | |
2100 | / | |
2101 | GETS2, CLA | |
2102 | TAD GETCW /UPDATE CBLK | |
2103 | AND M100 | |
2104 | SNA | |
2105 | STL RAR /(MAKING 0 => 40) | |
2106 | TAD (100 /(ROUND UP PAGE COUNT) | |
2107 | JMS UPCBLK | |
2108 | ISZ SEGCNT /ALL SEGMENTS DONE? | |
2109 | JMP GETS1 /NO, TRY NEXT | |
2110 | TAD OVLFLG /YES, OVERLAYS? (LINK OUTPUT) | |
2111 | SNA | |
2112 | JMP GETX / NO, RETURN TO CALL+1 | |
2113 | TAD (4 / YES, RESET POINTER | |
2114 | DCA GETPNT / TO SKIP OVER LVL 0 | |
2115 | JMP GETL2 / & CONTINUE | |
2116 | / | |
2117 | GETL1, CDF CIF 10 | |
2118 | JMS GHDR /GET & TEST HEADER | |
2119 | GETL2, CDF 10 | |
2120 | TAD I GETPNT /GET NUMBER OF OVERLAYS | |
2121 | DCA SEGCNT | |
2122 | TAD I GETPNT /GET PAGE & FIELD | |
2123 | DCA GETCW | |
2124 | TAD I GETPNT /GET REL BLK NUMBER | |
2125 | TAD RBLK1 / + START BLOCK | |
2126 | DCA CBLK / = ABS START BLK, THIS LEVEL | |
2127 | TAD I GETPNT /GET LENGTH, THESE OVERLAYS | |
2128 | CDF 0 | |
2129 | DCA GETORG | |
2130 | TAD GETCW /GET DBL-PAGE & FIELD | |
2131 | SNA | |
2132 | JMP GETX / 0 = THE END!!! | |
2133 | AND M400 /CONVERT TO DBL-PAGE # | |
2134 | CLL RTL | |
2135 | RTL | |
2136 | TAD GETCW / IN BITS 5-11 | |
2137 | RAL | |
2138 | AND N177 | |
2139 | CIA /-(DBL-PG # OF OVLY START) | |
2140 | TAD CAD /+(DBL-PG # OF DESIRED) | |
2141 | SPA | |
2142 | JMP GETL3 / GONE TOO FAR, MISSED IT! | |
2143 | DCA GETCW /= RELATIVE BLOCK NUMBER | |
2144 | TAD GETCW /IS THIS WITHIN THIS OVLY? | |
2145 | CIA | |
2146 | TAD GETORG | |
2147 | SPA SNA CLA | |
2148 | JMP GETL2 / NO, TRY NEXT OVERLAY | |
2149 | TAD BLK /OK, SET UP -(#LVL +1) | |
2150 | CMA | |
2151 | DCA GETORG | |
2152 | TAD GETORG /ADDR IS OK, IS THERE A | |
2153 | TAD SEGCNT / LEVEL WANTED? | |
2154 | GETL3, SPA CLA | |
2155 | JMP GETX /ILLEGAL LEVEL; TOO FAR--EXIT | |
2156 | TAD GETCW /ALL OK! ADD RELATIVE BLK | |
2157 | SKP | |
2158 | GETL4, TAD SEGCNT / TO (LVLS-1)*LENGTH | |
2159 | TAD CBLK | |
2160 | DCA CBLK / TO OVERLAY START BLOCK | |
2161 | ISZ GETORG /[MULTIPLY BY ADDING] | |
2162 | JMP GETL4 | |
2163 | JMP GET1 | |
2164 | GETORG, 0 | |
2165 | GETCW, 0 | |
2166 | SEGCNT, 0 | |
2167 | ||
2168 | UPCBLK, 0 | |
2169 | JMS I RTR6I /MOVE COUNT TO BITS 6-11 | |
2170 | CLL RAR /DIVIDE FOR DOUBLE PAGES | |
2171 | TAD CBLK /UPDATE | |
2172 | DCA CBLK | |
2173 | JMP I UPCBLK | |
2174 | ||
2175 | ||
2176 | ||
2177 | PAGE | |
2178 | \f/NUMERIC OUTPUT SUBROUTINES, NO ZERO SUPPRESSION: | |
2179 | ||
2180 | OPRT, 0 /4-DIGIT OCTAL | |
2181 | JMS NUMOUT | |
2182 | -1000 | |
2183 | -100 | |
2184 | -10 | |
2185 | 0 | |
2186 | JMP I OPRT | |
2187 | ||
2188 | OCT3, 0 /3-DIGIT OCTAL | |
2189 | JMS NUMOUT | |
2190 | -100 | |
2191 | -10 | |
2192 | 0 | |
2193 | JMP I OCT3 | |
2194 | ||
2195 | BPRT, 0 /3-DIGIT BCD | |
2196 | JMS NUMOUT | |
2197 | -400 | |
2198 | -20 | |
2199 | 0 | |
2200 | JMP I BPRT | |
2201 | ||
2202 | ||
2203 | SGNDP, 0 /4-DIGIT DECIMAL, SIGNED | |
2204 | DCA NUMB | |
2205 | TAD NUMB | |
2206 | SPA CLA | |
2207 | TAD N15 | |
2208 | SPACE1 /OUTPUT "-" OR " " | |
2209 | TAD NUMB /NOW OUTPUT IN DECIMAL | |
2210 | SPA | |
2211 | CIA | |
2212 | JMS DPRT | |
2213 | JMP I SGNDP | |
2214 | ||
2215 | DECIMAL | |
2216 | ||
2217 | DPRT, 0 /4-DIGIT DECIMAL, UNSIGNED | |
2218 | JMS NUMOUT | |
2219 | -1000 | |
2220 | -100 | |
2221 | -10 | |
2222 | 0 | |
2223 | JMP I DPRT | |
2224 | ||
2225 | DEC2, 0 /2-DIGIT DECIMAL, UNSIGNED | |
2226 | AND N177 /MASK IT FIRST | |
2227 | JMS NUMOUT | |
2228 | -10 | |
2229 | 0 | |
2230 | JMP I DEC2 | |
2231 | ||
2232 | OCTAL | |
2233 | ||
2234 | NUMOUT, 0 /THE REAL OUTPUT SUBROUTINE | |
2235 | DCA NUMB /SAVE THE NUMBER | |
2236 | NUMO1, DCA NUMDGT /RESET "DIGIT" TO 0 | |
2237 | CLA CLL | |
2238 | TAD NUMB /GET CURRENT VALUE | |
2239 | TAD I NUMOUT /SUBTRACT DIGIT BASE | |
2240 | SNL /DID IT OVERFLOW? | |
2241 | JMP NUMO2 /NO, TOO FAR! | |
2242 | ISZ NUMDGT /YES, BUMP DIGIT | |
2243 | DCA NUMB / & UPDATE VALUE | |
2244 | JMP NUMO1+1 | |
2245 | / | |
2246 | NUMO2, CLA CLL | |
2247 | TAD NUMDGT /OUTPUT THE "DIGIT" | |
2248 | DIGIT | |
2249 | ISZ NUMOUT /BUMP TO NEXT ARG | |
2250 | TAD I NUMOUT /DONE ENOUGH? | |
2251 | SZA CLA | |
2252 | JMP NUMO1 | |
2253 | TAD NUMB /YES, SO OUTPUT THE LAST | |
2254 | DIGIT / ONE. | |
2255 | JMP I NUMOUT /AND RETURN | |
2256 | NUMB, 0 | |
2257 | NUMDGT, 0 | |
2258 | ||
2259 | SSKIP, 0 /SKIP SPACES IN COMMAND BUFFER. | |
2260 | TAD CHAR | |
2261 | TAD M240 /IS THIS A SPACE? | |
2262 | SZA CLA | |
2263 | JMP I SSKIP /NO, DONE | |
2264 | JMS I GETNI /YES, GET NEXT CHAR | |
2265 | JMP SSKIP+1 / & GO TRY IT | |
2266 | ||
2267 | ||
2268 | /OS/8 ASCII OUTPUT SUBROUTINE. OUTPUTS 1 CHAR | |
2269 | / FOR EVEN WORD & 2 CHARS FOR ODD WORD. | |
2270 | ||
2271 | OSTYPE, 0 | |
2272 | JMS OSSET /DO SETUP FOR UNPACKING | |
2273 | JMS I (ASCII /OUTPUT CHARS TO "STANDARD" | |
2274 | ISZ CHARSW /UNPACK 2ND CHARACTER? | |
2275 | JMP OSUNPK / YES, & RETURN TO OSSET CALL! | |
2276 | JMP I OSTYPE /DONE, RETURN TO CALLER | |
2277 | ||
2278 | ||
2279 | /OS/8 "BYTE" OUTPUT SUBROUTINE. OUTPUT ONE | |
2280 | / 8-BIT OCTAL NUMBER FOR EVEN WORD AND TWO 8- | |
2281 | / BIT OCTAL NUMBERS FOR ODD WORD. USED FOR | |
2282 | / DUMPING OS/8 ".BN" FILES OR ASCII IN OCTAL. | |
2283 | ||
2284 | BYTEO, 0 | |
2285 | JMS OSSET /DO SETUP FOR UNPACKING | |
2286 | JMS OCT3 /3 DIGIT OCTAL OUTPUT | |
2287 | ISZ CHARSW /UNPACK 2ND "CHAR"? | |
2288 | SKP | |
2289 | JMP I BYTEO / DONE, RETURN | |
2290 | SPACE2 /YES, BUT OUTPUT 2 SPACES | |
2291 | JMP OSUNPK / BEFORE DOING UNPACKING | |
2292 | ||
2293 | ||
2294 | /OS/8 FORMAT UNPACKING ROUTINES FOR 'OSTYPE' AND | |
2295 | / 'BYTEO'. THE SUBROUTINE SETS UP THE COUNTER | |
2296 | / FOR NUMBER OF OUTPUTS TO DO, SAVING & RESTORING | |
2297 | / THE AC. THE ROUTINE WILL BE CALLED ONLY IF 2 | |
2298 | / OUTPUTS BEING DONE AND DOES THE UNPACK OF THE | |
2299 | / 2ND "CHARACTER", RETURNING TO THE CALLER OF THE | |
2300 | / SUBROUTINE! | |
2301 | ||
2302 | OSSET, 0 /ENTER HERE TO INITIALIZE | |
2303 | DCA INC /SAVE AC | |
2304 | IAC | |
2305 | AND LOCL /AC = 0 OR 1 | |
2306 | CMA /AC = -1 OR -2 (-# TO DO) | |
2307 | DCA CHARSW /SET UP UNPACK COUNT | |
2308 | OSRETN, TAD INC /GET VALUE TO AC | |
2309 | AND N377 /MASK TO 8 BITS | |
2310 | JMP I OSSET | |
2311 | / | |
2312 | OSUNPK, STA /JUMP HERE IF 2ND CHAR TO GET | |
2313 | TAD CAD | |
2314 | DCA SGNDP /POINT TO HIGH WORD | |
2315 | CDF 10 | |
2316 | TAD I CAD /GET LOW BITS OF "CHAR" | |
2317 | AND N7400 / MASK TO 4 BITS AND | |
2318 | JMS I RTR6I / MOVE TO BITS 8-11 | |
2319 | RTR | |
2320 | DCA INC /SAVING IT HERE FOR LATER! | |
2321 | TAD I SGNDP /NOW GET HIGH BITS OF "CHAR" | |
2322 | AND N7400 / MASK TO 4 BITS AND | |
2323 | CDF 0 | |
2324 | CLL RTR / MOVE TO BITS 4-7 | |
2325 | RTR | |
2326 | JMP OSRETN /GET OTHER BITS & RETURN! | |
2327 | ||
2328 | ||
2329 | /SUBROUTINE TO INCREMENT THE "CURRENT LOCATION" | |
2330 | ||
2331 | INC, 0 | |
2332 | ISZ LOCL /INCREMENT LOW 12 ADDR BITS | |
2333 | JMP I INC /OK AS IS | |
2334 | CLL | |
2335 | TAD LOCH /LOW OVERFLOW, INCR. HIGH | |
2336 | TAD (7771 / 3 ADDRESS BITS (& TEST) | |
2337 | AND N7 | |
2338 | DCA LOCH | |
2339 | SZL /DID HIGH OVERFLOW ALSO? | |
2340 | TAD N200 / YES, THEN BUMP BLK ALSO | |
2341 | TAD BLK | |
2342 | DCA BLK | |
2343 | JMP I INC | |
2344 | ||
2345 | ||
2346 | PAGE | |
2347 | \f/OUTPUT PACKED STRING, ADDRESS IN CALL+1, | |
2348 | / TERMINATOR IS XX00. | |
2349 | TYPES, 0 | |
2350 | TAD I TYPES | |
2351 | ISZ TYPES | |
2352 | JMS TYPSTR | |
2353 | JMP I TYPES | |
2354 | ||
2355 | /OUTPUT PACKED STRING, ADDRESS IN AC, TERMIN IS XX00 | |
2356 | TYPSTR, 0 | |
2357 | DCA GETNT | |
2358 | TTAGN, CDF 10 | |
2359 | TAD I GETNT | |
2360 | CDF 0 | |
2361 | ISZ GETNT | |
2362 | JMS PACOUT | |
2363 | TAD GNAME | |
2364 | AND N77 | |
2365 | SNA CLA | |
2366 | JMP I TYPSTR | |
2367 | JMP TTAGN | |
2368 | ||
2369 | /PACKED ASCII OUTPUT ROUTINE | |
2370 | PACOUT, 0 | |
2371 | DCA GNAME | |
2372 | TAD GNAME /USE LEFT 6 BITS | |
2373 | JMS I RTR6I | |
2374 | JMS ONECHR | |
2375 | TAD GNAME /USE RIGHT 6 BITS | |
2376 | JMS ONECHR | |
2377 | JMP I PACOUT | |
2378 | ||
2379 | /OUTPUT TRIMMED OR UNTRIMMED ASCII IN THE AC | |
2380 | ONECHR, 0 /NO CODE FOR CR/LF | |
2381 | AND N77 | |
2382 | SNA | |
2383 | JMP I ONECHR /IGNORE "@" | |
2384 | TAD (-40 | |
2385 | SMA | |
2386 | TAD M100 | |
2387 | JMS I TYPECI | |
2388 | 340 | |
2389 | JMP I ONECHR | |
2390 | ||
2391 | ||
2392 | /SUBROUTINE TO MATCH CHAR AGAINST LIST1 AND JUMP | |
2393 | /THROUGH LIST2 WHEN MATCH FOUND. BOTH LISTS IN | |
2394 | /FIELD 1. | |
2395 | ||
2396 | SORTJ, 0 | |
2397 | SNA | |
2398 | TAD CHAR /USE CHAR IF AC = 0 | |
2399 | DCA SORTEM /ITEM TO LOOK UP | |
2400 | TAD I SORTJ | |
2401 | ISZ SORTJ /GET LIST1 ADDRESS | |
2402 | DCA SCANX1 | |
2403 | SORT1, CDF 10 | |
2404 | TAD I SCANX1 /COMPARE WITH SORTEM | |
2405 | CDF 0 | |
2406 | SNA /0 ? | |
2407 | JMP SORT2 /END OF LIST | |
2408 | CIA STL | |
2409 | TAD SORTEM | |
2410 | SZA CLA /DOES IT MATCH? | |
2411 | JMP SORT1 /NO, TRY NEXT | |
2412 | TAD SCANX1 /YES, GET ADDRESS... | |
2413 | TAD I SORTJ | |
2414 | DCA SORTJ /...OF JUMP ADDRESS | |
2415 | CDF 10 | |
2416 | TAD I SORTJ | |
2417 | DCA SORTJ | |
2418 | CDF 0 | |
2419 | JMP I SORTJ /GO TO ROUTINE | |
2420 | SORT2, ISZ SORTJ /MATCH NOT FOUND, | |
2421 | JMP I SORTJ /EXIT TO CALL+3 | |
2422 | SORTEM, 0 | |
2423 | ||
2424 | ||
2425 | /SUBROUTINE TO GET A NAME FOR 'XOPEN', 'XFILE', 'XDEV' & 'XDDEV' | |
2426 | ||
2427 | GNAME, 0 /GET A FILE OR DEVICE NAME | |
2428 | DCA TEMP1 /SET UP "." SWITCH AND | |
2429 | TAD TEMP1 / FILE/DEVICE SWITCH | |
2430 | DCA TEMP2 | |
2431 | DCA NAM1 | |
2432 | DCA NAM2 /CLEAR NAME AREA | |
2433 | DCA NAM3 | |
2434 | TAD (2326 / & INIT EXTENSION TO "SV" | |
2435 | DCA NAM4 | |
2436 | TAD (NAM1 / & INIT POINTER FOR NAME | |
2437 | DCA TEMP | |
2438 | JMS I SSKIPI /SKIP LEADING SPACES | |
2439 | STA | |
2440 | TAD COMOUT /BACK UP THE POINTER | |
2441 | DCA COMOUT | |
2442 | JMS GPAIR /1ST & 2ND CHAR | |
2443 | JMS GPAIR /3RD & 4TH | |
2444 | GETSCN, JMS GPAIR /5TH & 6TH OR 1ST & 2ND EXT. | |
2445 | JMS GETNT /SCAN FOR TERMINATOR | |
2446 | CLA | |
2447 | JMP .-2 | |
2448 | / | |
2449 | GETCOL, TAD TEMP2 /":" SEEN, DEVICE OR FILE NAME? | |
2450 | SZA CLA | |
2451 | JMP GETNTC / FILE, JUST USE THE ":" | |
2452 | ISZ TEMP2 / DEVICE, FLAG ":" SEEN | |
2453 | JMP GETSCN+1 / AND SCAN TO TERMIN. | |
2454 | / | |
2455 | GETPER, ISZ TEMP1 /"." FOUND, FIRST ONE? | |
2456 | ERCM, ERROR /NO, THE END... | |
2457 | DCA NAM4 /YES, RESET EXT, | |
2458 | TAD (NAM4 / SET POINTER | |
2459 | DCA TEMP | |
2460 | JMP GETSCN / & GO GET IT | |
2461 | / | |
2462 | GETEND, STA /TERM = SPACE, SET SWITCH | |
2463 | DCA CRSWT /TERM = CR, RESET SWITCH | |
2464 | JMP I GNAME /..DONE.... | |
2465 | ||
2466 | GETNT, 0 /GET & TEST A CHAR | |
2467 | JMS I GETNI /GET NEXT CHAR | |
2468 | JMS I SORTI /TEST IT | |
2469 | GETLST-1 | |
2470 | GETOPS-GETLST | |
2471 | GETNTC, TAD CHAR /OK, USE CHAR | |
2472 | AND N77 /MASK TO 6 BITS | |
2473 | JMP I GETNT / & EXIT WITH IT | |
2474 | ||
2475 | GPAIR, 0 /GET RIGHT/LEFT-HALF-CHARS | |
2476 | JMS GETNT | |
2477 | JMS I RTL6I /TO LEFT HALF | |
2478 | DCA I TEMP / & STORE IT | |
2479 | JMS GETNT | |
2480 | TAD I TEMP /MERGE WITH LAST LEFT | |
2481 | DCA I TEMP | |
2482 | ISZ TEMP /BUMP POINTER | |
2483 | JMP I GPAIR | |
2484 | ||
2485 | RTL6, 0 /ROTATE AC 6 LEFT | |
2486 | CLL RTL | |
2487 | RTL | |
2488 | RTL | |
2489 | JMP I RTL6 | |
2490 | ||
2491 | RTR6, 0 /ROTATE AC 6 RIGHT | |
2492 | CLL RTR | |
2493 | RTR | |
2494 | RTR | |
2495 | JMP I RTR6 | |
2496 | ||
2497 | ||
2498 | PAGE | |
2499 | \f/SUBROUTINE TO READ A "LINE" FROM THE USER. IT CHECKS FOR | |
2500 | / RUBOUT, ^U AND ^R FIRST, THEN CHECKS FOR ONE OF A LIST OF | |
2501 | / TERMINATORS PASSED BY THE CALLER. AS WITH OS/8, RUBOUT | |
2502 | / DELETES CHARACTES AND ^U DELETES THE CURRENT LINE. ^R | |
2503 | / (FOR RETYPE) ECHOES THE CURRENT COMMAND BUFFER IN THE SAME | |
2504 | / MANNER AS LINE-FEED DOES FOR OS/8. IF THE CHARACTER IS A | |
2505 | / TERMINATOR, CONTROL PASSES DIRECTLY TO THE CORRESPONDING | |
2506 | / CALLER ROUTINE (OUT OF THIS ROUTINE). INPUT CHARACTERS | |
2507 | / ARE ALSO TRANSLATED FROM LOWER CASE TO UPPER CASE. EXIT | |
2508 | / IN THE NORMAL MANNER OCCURS ONLY ON BUFFER EMPTY FROM | |
2509 | / RUBOUT OR ^U. | |
2510 | ||
2511 | READ, 0 /READ AND ECHO INPUT CHARACTER | |
2512 | TAD I READ /GET TWO LIST ADDRESS PARAMETERS | |
2513 | ISZ READ | |
2514 | DCA RETERM / FROM CALLER AND SET UP IN | |
2515 | TAD I READ / SORT ROUTINE CALL | |
2516 | ISZ READ | |
2517 | DCA RETERM+1 | |
2518 | RENEXT, JMS RKEY /GET A CHAR | |
2519 | JMP RUBO /RUBOUT, GO BEGIN DELETIONS | |
2520 | REKEY, DCA CHAR | |
2521 | JMS I SORTI /CHECK FOR CTRL-R & CTRL-U | |
2522 | REACTL-1 | |
2523 | REACTS-REACTL | |
2524 | TAD CHAR | |
2525 | JMS I TYPEI | |
2526 | JMS I SORTI /CHECK FOR CALLER TERMINATORS | |
2527 | RETERM, 0 / PARAMETERS HERE | |
2528 | 0 | |
2529 | TAD CHAR /NONE, JUST STORE IN BUFFER | |
2530 | SKP | |
2531 | RESPC, TAD (" /FOR CAMMAND INPUT, TAB -> SPACE! | |
2532 | CDF 10 | |
2533 | DCA I COMIR /COMMAND (LINE) INPUT BUFFER | |
2534 | CDF 0 | |
2535 | JMP RENEXT | |
2536 | / | |
2537 | /+++ FOR SCOPE OPERATION, RUBOUTS CAUSE OUTPUT OF THE | |
2538 | /+++ SEQUENCE BACKSPACE, SPACE, BACKSPACE TO CLEAR THE | |
2539 | /+++ PREVIOUS CHARACTER FROM THE SCREEN. IF "SCOPE | |
2540 | /+++ MODE" IS SET, RUBO IS OVERLAID ON STARTUP. | |
2541 | ||
2542 | /*** FOR BATCH OPERATION, RUBOUTS ARE IGNORED BY 'RKEY' | |
2543 | /*** AND 'RUBO' IS OVERLAID WITH CODE TO IGNORE A LINE- | |
2544 | /*** FEED THAT FOLLOWS A CARRIAGE-RETURN. | |
2545 | / | |
2546 | RUBO, JMS BTEST /RUBOUT TYPED,TEST FOR EMPTY | |
2547 | JMP RUBOF / INPUT BUFFER EMPTY! | |
2548 | JMS I TYPECI /OK, OUTPUT 1ST "\" | |
2549 | "\ | |
2550 | RUBO1, JMS BTEST /NOW EMPTY? | |
2551 | JMP RUBOE / YES, LINE END | |
2552 | TAD COMIR /ECHO LAST CHAR IN BUFFER | |
2553 | DCA ENDC | |
2554 | CDF 10 | |
2555 | TAD I ENDC | |
2556 | CDF 0 | |
2557 | JMS I TYPEI | |
2558 | STA | |
2559 | TAD COMIR /NOW BACK UP POINTER | |
2560 | DCA COMIR | |
2561 | JMS RKEY /GET A CHAR | |
2562 | JMP RUBO1 /ANOTHER RUBOUT, GO HANDLE | |
2563 | DCA BTEST /SAVE THE CHAR | |
2564 | JMS I TYPECI / DO CLOSING "\" | |
2565 | "\ | |
2566 | TAD BTEST | |
2567 | JMP REKEY /& GO USE NEW CHAR | |
2568 | / | |
2569 | RUBOE, JMS I TYPECI /BUFFER WAS EMPTIED, | |
2570 | "\ /OUTPUT CLOSING "\" | |
2571 | RUBOF, JMS I CRLFI / & A CR/LF | |
2572 | JMP I READ | |
2573 | / | |
2574 | RECHO, JMS I TYPECI /ECHO "^R" & THEN | |
2575 | "R-100 | |
2576 | JMS I CRLFI /ECHO CURRENT LINE | |
2577 | TAD COMST /INIT AUTO-XR | |
2578 | DCA COMOUT | |
2579 | RECHO1, TAD COMOUT /DONE? | |
2580 | CIA | |
2581 | TAD COMIR | |
2582 | SNA CLA | |
2583 | JMP RENEXT /YES, MORE INPUT | |
2584 | JMS I GETNI /NO, GET NEXT CHAR | |
2585 | JMS I TYPEI / & OUTPUT IT | |
2586 | JMP RECHO1 / & CONTINUE | |
2587 | / | |
2588 | RERASE, JMS I TYPECI /OUTPUT "^U" | |
2589 | "U-100 | |
2590 | JMP RUBOF /GO OUTPUT CR/LF & EXIT | |
2591 | ||
2592 | BTEST, 0 /TEST FOR COMM. BUFFER EMPTY | |
2593 | TAD COMIR | |
2594 | CIA | |
2595 | TAD COMST | |
2596 | SZA CLA /EMPTY? | |
2597 | ISZ BTEST /NO, STILL OK, TO CALL+2 | |
2598 | JMP I BTEST / OTHERWISE TO CALL+1 | |
2599 | \fRKEY, 0 /GET A NON-NULL CHAR, TEST & TRANSLATE | |
2600 | KSF /*** JMS I CTRLI /CHECK KEYBOARD | |
2601 | JMP .-1 /*** CIF BAT /BATCH OPER. | |
2602 | JMS I CTRLI /*** JMS I BATINI | |
2603 | KSF /*** ERROR /EOF!! | |
2604 | JMP RKEY+1 /*** NOP /MUST USE SPECIAL CARE | |
2605 | KRB /*** NOP / TO HANDLE CTRL-Q! | |
2606 | AND N177 /MASK OFF PARITY | |
2607 | SNA | |
2608 | JMP RKEY+1 /NULL CHAR | |
2609 | TAD (-177 /IS IT A RUBOUT? | |
2610 | SNA | |
2611 | RKEY0, JMP I RKEY /YES, EXIT TO CALL+1 /*** BATCH | |
2612 | ISZ RKEY /NO, EXIT TO CALL+2 /*** OPER. | |
2613 | TAD (2 /TEST FOR ALT-MODES | |
2614 | SMA | |
2615 | JMP RKEY1 / 375 OR 376 | |
2616 | TAD (35 /IS IT LOWER CASE? | |
2617 | SMA | |
2618 | TAD (-40 /YES, MAKE UPPER CASE | |
2619 | TAD (-35 | |
2620 | RKEY1, TAD (375 /RESTORE CHAR & ADD PARITY | |
2621 | JMP I RKEY / & EXIT WITH IT | |
2622 | ||
2623 | ||
2624 | /SUBROUTINE TO TERMINATE COMMAND BUFFER WITH A C.R. | |
2625 | /RETURN TO CALL+1 IF ONLY A CR (EXCLUDING LEADING | |
2626 | /SPACES) IN BUFFER, TO CALL+2 IF ANYTHING ELSE. | |
2627 | ENDC, 0 | |
2628 | TAD (215 /PUT A CR IN BUFFER | |
2629 | CDF 10 | |
2630 | DCA I COMIR | |
2631 | CDF 0 | |
2632 | TAD COMST /INIT'L BUFFER UNLOAD | |
2633 | DCA COMOUT | |
2634 | TAD CHAR /SAVE CHAR FOR POSSIBLE | |
2635 | DCA TEMP / USE BY 'WCHEK' | |
2636 | JMS I GETNI /GET FIRST CHARACTER | |
2637 | JMS I SSKIPI /SKIP LEADING SPACES | |
2638 | TAD CHAR /GET 1ST NON-SPACE | |
2639 | TAD M215 /IS IT A CR? | |
2640 | SZA CLA /YES, NOTHING IN BUFFER | |
2641 | ISZ ENDC /OTHERWISE RETURN TO CALL+2 | |
2642 | JMP I ENDC | |
2643 | ||
2644 | ||
2645 | DODIG, 0 /OUTPUT AC AS AN ASCII DIGIT | |
2646 | JMS I TYPECI | |
2647 | "0 | |
2648 | JMP I DODIG | |
2649 | ||
2650 | ||
2651 | PAGE | |
2652 | \f/'FPP'/OCTAL/'PDP' OUTPUT ROUTINE FOR ODT | |
2653 | ODTOUT, 0 | |
2654 | TAD TYPSW /-1, 0, +1 | |
2655 | TAD (TAD ODTOL /GENERATE ADDRESS OF DESIRED | |
2656 | DCA ODTOPT / OUTPUT ROUTINE | |
2657 | ODTOPT, HLT /[USED TWICE!] | |
2658 | DCA ODTOPT | |
2659 | JMS I ODGETI /GET SPECIFIED WORD | |
2660 | JMS I ODTOPT / & OUTPUT IT | |
2661 | JMP I ODTOUT | |
2662 | ||
2663 | FPPDMP /-1 = OCTAL + FPP | |
2664 | ODTOL, OPRT / 0 = OCTAL | |
2665 | PDPDMP /+1 = OCTAL + PDP | |
2666 | ||
2667 | ||
2668 | /OCTAL & 'PDP' (SYMBOLIC) DUMP ROUTINE | |
2669 | PDPDMP, 0 | |
2670 | JMS I OCTI /FIRST OUTPUT IN OCTAL | |
2671 | SPACE2 /FOLLOWED BY 2 SPACES, | |
2672 | JMS PDPOUT / & THEN AS 'PDP' | |
2673 | JMP I PDPDMP | |
2674 | ||
2675 | ||
2676 | /'PDP' (SYMBOLIC) INSTRUCTION DECODING | |
2677 | PDPOUT, 0 | |
2678 | CLA | |
2679 | JMS OPRTST /TEST FOR OPR & IOT | |
2680 | JMP OPRS / OPR | |
2681 | JMS IOPRNT / IOT | |
2682 | SYMS, JMS GETOP /GET OP-CODE TO BITS 9-11 | |
2683 | RAL / * 2 | |
2684 | JMS SYMTYP /OUTPUT 3 CHAR SYMBOL & SPACE | |
2685 | INSLST /(TABLE FOR INDEXING) | |
2686 | -2 /(- # WORDS) | |
2687 | JMS OPRTST /TEST FOR OPR & IOT | |
2688 | JMP SYMEND / OPR, DONE | |
2689 | JMP IOTS / IOT | |
2690 | TADICAD /MEMORY REF., INDIRECT? | |
2691 | AND (400 | |
2692 | SNA CLA | |
2693 | JMP REFS1 /NO | |
2694 | JMS I TWOCI /YES, OUTPUT "I " | |
2695 | 1140 | |
2696 | REFS1, TADICAD /SET UP ADDR BITS | |
2697 | AND N177 | |
2698 | DCA BITVAL /SAVE THEM | |
2699 | TADICAD /IS THIS A 'PAGE 0 REF'? | |
2700 | AND N200 | |
2701 | SZA CLA | |
2702 | TAD LOCL /NO, USE PAGE BITS | |
2703 | AND M200 | |
2704 | TAD BITVAL /OK, NOW ADD ADDR BITS | |
2705 | REFS2, JMS I OCTI /OUTPUT IN OCTAL | |
2706 | SYMEND, JMP I PDPOUT /DONE, RETURN | |
2707 | ||
2708 | / | |
2709 | IOTS, TADICAD /USE ONLY LAST 9 BITS | |
2710 | AND (777 | |
2711 | JMP REFS2 /AND OUTPUT IN OCTAL | |
2712 | / | |
2713 | OPRS, TADICAD /IS THIS A NOP? | |
2714 | AND (777 | |
2715 | SNA | |
2716 | JMP SYMS /YES, OUTPUT "NOP " | |
2717 | AND N200 /IS THERE A CLA IN IT? | |
2718 | SNA CLA | |
2719 | JMP OPRS1 /NO, CONTINUE | |
2720 | JMS SYMTYP /YES, OUTPUT "CLA " | |
2721 | CLANAM | |
2722 | -2 | |
2723 | IAC | |
2724 | OPRS1, DCA CNT /SET ANYTHING OUTPUT SWITCH | |
2725 | TADICAD /SET UP WORD FOR DECODE | |
2726 | JMS I RTL6I | |
2727 | RAR | |
2728 | DCA BITVAL /SAVE IT | |
2729 | TADICAD /CHECK FOR OPR1, OPR2 OR EAE | |
2730 | CLL RAR | |
2731 | AND N200 | |
2732 | SNA | |
2733 | JMP OPR1A /OPR1 MICRO-INSTRUCTION | |
2734 | SNL CLA | |
2735 | JMP OPR2A /OPR2 MICRO-INSTRUCTION | |
2736 | / | |
2737 | /DO THE DOCODING FOR THE EAE MICRO-INSTRUCTIONS | |
2738 | EAE, TAD (EAELST-2 /SET UP EAE LIST POINTER | |
2739 | DCA BITPNT | |
2740 | JMS BITS /SHIFT & CHECK BIT 5 | |
2741 | JMS OPRTYP /IF = 1, "MQA " | |
2742 | TAD BITVAL /CHECK BIT 6 | |
2743 | CLL RAL /("SCA" IN "A" MODE OF 8/E | |
2744 | DCA BITVAL / 'MODE BIT' IN "B" MODE) | |
2745 | SZL | |
2746 | TAD N20 /IF ON, USE OTHER WORDS | |
2747 | DCA EAETMP | |
2748 | JMS BITS /CHECK BIT 7 | |
2749 | JMS OPRTYP / "MQL " | |
2750 | TADICAD | |
2751 | AND (16 | |
2752 | TAD EAETMP /(ADD SWITCH WORD) | |
2753 | JMS SYMLIM /CHECK FOR & OUTPUT LAST INST. | |
2754 | -36 /UPPER LIMIT | |
2755 | EAETMP, 0 | |
2756 | / | |
2757 | /DO THE DECODING FOR THE OPR1 MICRO-INSTRUCTIONS | |
2758 | OPR1A, TAD (OP1LST-2 /SET OPR1 LIST | |
2759 | DCA BITPNT | |
2760 | JMS BITS /SHIFT & CHECK BIT 5 | |
2761 | JMS OPRTYP /IF = 1, OUTPUT "CLL " | |
2762 | JMS BITS /CHECK BIT 6 | |
2763 | JMS OPRTYP / "CMA " | |
2764 | JMS BITS /CHECK BIT 7 | |
2765 | JMS OPRTYP / "CML " | |
2766 | ISZ BITPNT /BUMP POINTER | |
2767 | ISZ BITPNT | |
2768 | TADICAD /LOOK FOR IAC | |
2769 | RAR | |
2770 | SZL CLA | |
2771 | JMS OPRTYP /OUTPUT "IAC " | |
2772 | TADICAD /SET UP TO CHECK FOR ROTATES | |
2773 | AND (16 | |
2774 | JMS SYMLIM /CHECK & OUTPUT | |
2775 | -12 /UPPER LIMIT | |
2776 | ||
2777 | ||
2778 | PAGE | |
2779 | \f/OCTAL & 'FPP' (SYMBOLIC) DUMP ROUTINE | |
2780 | FPPDMP, 0 | |
2781 | JMS I OCTI /FIRST OUTPUT IN OCTAL | |
2782 | SPACE2 / THEN 2 SPACES | |
2783 | JMS FPPOUT / & THEN AS FPP | |
2784 | JMP I FPPDMP | |
2785 | ||
2786 | /THE FOLLOWING ROUTINES ARE USED BY 'PDPOUT' | |
2787 | ||
2788 | /DO THE DECODING FOR THE OPR2 MICROINSTRUCTIONS | |
2789 | OPR2A, TAD (OP2LST-2 /SET UP LIST POINTER | |
2790 | DCA BITPNT | |
2791 | JMS BITS /SHIFT & CHECK BIT 5 | |
2792 | JMS OPR2T /IF 1, OUTPUT "SMA " OR "SPA " | |
2793 | JMS BITS /CHECK BIT 6 | |
2794 | JMS OPR2T / "SZA " OR "SNA " | |
2795 | JMS BITS /CHECK BIT 7 | |
2796 | JMS OPR2T / "SNL " OR "SZL " | |
2797 | JMS BITS /CHECK BIT 8 | |
2798 | SKP | |
2799 | JMP OPR2B /IT WAS 0 | |
2800 | TADICAD /MUST CHECK FOR "SKP " | |
2801 | AND (160 | |
2802 | SNA CLA /ARE ALL SKIP SENSES = 0? | |
2803 | JMS OPRTYP /YES, SO OUTPUT "SKP " | |
2804 | OPR2B, TAD (OP2LST+14 /SET UP CHECK FOR OSR & HLT | |
2805 | DCA BITPNT | |
2806 | JMS BITS /CHECK BIT 9 | |
2807 | JMS OPRTYP / "OSR " | |
2808 | JMS BITS /CHECK BIT 10 | |
2809 | JMS OPRTYP / "HLT " | |
2810 | JMP OPEND /CHECK FOR ANY DONE | |
2811 | ||
2812 | SYMLIM, 0 /CHECK LAST SYMBOL AGAINST LIMIT | |
2813 | DCA CHAR /SAVE AC | |
2814 | TAD CHAR | |
2815 | SPA SNA /IS IT > 0? | |
2816 | JMP OPEND /NO, TEST IF ANY OUTPUT DONE | |
2817 | TAD I SYMLIM /IT IS > UPPER LIMIT? | |
2818 | SMA SZA CLA | |
2819 | JMP OPEND /NO, GO CHECK AGAIN | |
2820 | TAD CHAR /CALCULATE ADDRESS | |
2821 | JMS OPRTYP / & OUTPUT LAST | |
2822 | JMP SYMEND /...DONE | |
2823 | / | |
2824 | OPEND, CLA | |
2825 | TAD CNT /ANYTHING OUTPUT? | |
2826 | SZA CLA | |
2827 | JMP SYMEND /YES, DONE WITH OUTPUT | |
2828 | JMS SYMTYP /NO, OUTPUT "OPR " | |
2829 | OPRMES | |
2830 | -2 | |
2831 | JMP IOTS /NOW GO OUTPUT LAST 9 BITS | |
2832 | ||
2833 | BITS, 0 /DECODE A WORD ONE BIT AT A TIME | |
2834 | TAD BITVAL /SHIFT A BIT INTO LINK | |
2835 | CLL RAL | |
2836 | DCA BITVAL /SAVE FOR LATER | |
2837 | ISZ BITPNT /BUMP SYMBOL POINTER | |
2838 | ISZ BITPNT | |
2839 | SNL | |
2840 | ISZ BITS /TO CALL+2 IF L = 0 | |
2841 | JMP I BITS | |
2842 | ||
2843 | OPRTYP, 0 /OUTPUT AN OPR SYMBOL | |
2844 | JMS SYMTYP /OUTPUT THE SYMBOL | |
2845 | BITPNT, 0 /ADDRESS | |
2846 | -2 | |
2847 | ISZ CNT /SET SWITCH | |
2848 | JMP I OPRTYP | |
2849 | ||
2850 | SYMTYP, 0 /OUTPUT A SYMBOL | |
2851 | TAD I SYMTYP /ADD TABLE ADDR TO ANY INDEX | |
2852 | ISZ SYMTYP | |
2853 | DCA SYMPNT /SAVE POINTER | |
2854 | TAD I SYMTYP /GET COUNT OF WORDS | |
2855 | ISZ SYMTYP | |
2856 | DCA BITS / & SAVE IT | |
2857 | SYMNXT, CDF 10 /"SYMBOL"S IN FIELD 1 | |
2858 | TAD I SYMPNT | |
2859 | CDF 0 | |
2860 | JMS I TWOT /OUTPUT A PAIR OF LETTERS | |
2861 | ISZ SYMPNT | |
2862 | ISZ BITS /DONE? | |
2863 | JMP SYMNXT | |
2864 | JMP I SYMTYP | |
2865 | SYMPNT, 0 | |
2866 | ||
2867 | OPR2T, 0 /OUTPUT AN OPR2 SYMBOL | |
2868 | TADICAD | |
2869 | AND (10 /IF BIT IS ON, REVERSE THE | |
2870 | JMS OPRTYP /SENSE OF THE SKIP | |
2871 | JMP I OPR2T | |
2872 | ||
2873 | BITVAL, 0 | |
2874 | ||
2875 | ||
2876 | IOPRNT, 0 /OUTPUT I/O NAMES | |
2877 | TAD (IOTTAB /SET UP POINTER | |
2878 | IOPRN1, DCA IOPNT /SET (OR UPDATE) POINTER | |
2879 | CDF 10 | |
2880 | TAD I IOPNT /GET NEXT IOT | |
2881 | CDF 0 | |
2882 | SNA /AT END OF TABLE? | |
2883 | JMP I IOPRNT /YES, CODE NOT FOUND | |
2884 | CIA | |
2885 | TADICAD /NO, DO THEY MATCH? | |
2886 | SNA CLA | |
2887 | JMP IOPRN2 /YES, OUTPUT NAME | |
2888 | TAD (4 /NO, UPDATE POINTER | |
2889 | TAD IOPNT | |
2890 | JMP IOPRN1 / & TRY AGAIN | |
2891 | / | |
2892 | IOPRN2, IAC /WORD FOLLOWS CODE | |
2893 | JMS SYMTYP /OUTPUT THE MNEMONIC | |
2894 | IOPNT, 0 | |
2895 | -3 | |
2896 | JMP SYMEND / & RETURN | |
2897 | ||
2898 | ||
2899 | OPRTST, 0 /TEST "INSTRUCTION" FOR OPR & IOT | |
2900 | TADICAD /GET WORD | |
2901 | AND N7000 /MASK OFF OP CODE | |
2902 | TAD (1000 /IS IT AN OPR? | |
2903 | SNA | |
2904 | JMP I OPRTST /YES, EXIT TO CALL+1 | |
2905 | ISZ OPRTST | |
2906 | TAD (1000 /IS IT AN IOT? | |
2907 | SZA CLA | |
2908 | ISZ OPRTST /NO, EXIT TO CALL+3 | |
2909 | JMP I OPRTST / YES, TO CALL+2 | |
2910 | ||
2911 | ||
2912 | PAGE | |
2913 | \f/'FPP' (SYMBOLIC) INSTRUCTION DECODING | |
2914 | FPPOUT, 0 | |
2915 | CLA /HARD TO TELL WHAT MIGHT COME! | |
2916 | TADICAD /GET THE WORD | |
2917 | AND (600 /MASK OFF MODE BITS | |
2918 | SNA | |
2919 | JMP SPECIAL / NON-ARITHMETIC | |
2920 | TAD M400 /GIVES: -=BASE, 0=LONG, +=INDIR. | |
2921 | DCA TEMP2 | |
2922 | JMS GETOP /GET OP-CODE TO BITS 9-11 | |
2923 | FPLEA, JMS MULT3 /MULTIPLY BY 3 (WORDS/OP OUT) | |
2924 | JMS SYMTYP /OUTPUT 6 CHAR OPR SYMBOL | |
2925 | FPPINS /(INCLUDING "LEA") | |
2926 | -3 | |
2927 | TAD TEMP2 /NOW HANDLE MODE | |
2928 | SNA | |
2929 | JMP LONG / LONG INDEXED | |
2930 | SMA CLA | |
2931 | JMP INDIR / INDIRECT INDEXED | |
2932 | BASE, JMS I TYPSI / BASE - OUTPUT " B+" | |
2933 | MSBASE | |
2934 | TADICAD /GET WORD AGAIN | |
2935 | AND N177 / MASK OFF OFFSET | |
2936 | JMS MULT3 / MULTIPLY IT BY 3 | |
2937 | JMS OCT3 / & OUTPUT IN OCTAL | |
2938 | JMP I FPPOUT | |
2939 | / | |
2940 | INDIR, JMS I TYPSI /OUTPUT "% B+" | |
2941 | MSINDI | |
2942 | TADICAD /GET WORD AGAIN | |
2943 | AND N7 / MASK OFF OFFSET | |
2944 | JMS MULT3 / MULTIPLY IT BY 3 | |
2945 | JMS OCT3 / & OUTPUT IT IN OCTAL | |
2946 | JMP XRPLUS /FINALLY DO XR OUTPUT | |
2947 | / | |
2948 | LONG, JMS I TWOCI /OUTPUT "# " | |
2949 | 4340 | |
2950 | JMS FLDOUT /AND FIELD AND "*" | |
2951 | XRPLUS, JMS GET678 /GET XR FIELD | |
2952 | JMS I TWOCI / & OUTPUT ",X" WHERE | |
2953 | 5460 / "X" IS A DIGIT | |
2954 | TADICAD /GET WORD THE LAST TIME | |
2955 | AND (100 / AND CHECK "+" BIT | |
2956 | SZA CLA | |
2957 | JMS I TYPECI /OUTPUT "+" OR SKIP | |
2958 | "+ /[A NOP] | |
2959 | JMP I FPPOUT | |
2960 | / | |
2961 | SPECIAL,JMS GETOP /GET OP-CODE | |
2962 | JMS I SORTI / & BRANCH ON IT | |
2963 | FPPMO0-1 | |
2964 | FPPMOJ-FPPMO0 | |
2965 | SPCOP0, TADICAD /FALLS THRU ON 0, GET | |
2966 | AND (170 / SUB-OP-CODE | |
2967 | JMS I SORTI / & BRANCH ON IT | |
2968 | FPPOP0-1 | |
2969 | FPPOPJ-FPPOP0 | |
2970 | SPOP00, TADICAD /FALLS THRU ON 0, USE AS | |
2971 | AND N7 / INDEX INTO LAST LIST | |
2972 | IAC | |
2973 | SPOP04, JMS MULT3 /THREE WORDS/SYMBOL | |
2974 | JMS SYMTYP /OUTPUT ONE OF SEVERAL | |
2975 | FPOP00 / SYMBOLS IN THIS LIST | |
2976 | -3 | |
2977 | JMP I FPPOUT | |
2978 | / | |
2979 | SPOP05, CLL STA /= -1 | |
2980 | JMP SPOP04 /OUTPUT "STARTE" | |
2981 | / | |
2982 | SPNUSE, CLL STA RAL /= -2 | |
2983 | JMP SPOP04 /OUTPUT "UNUSED" | |
2984 | / | |
2985 | SPO123, JMS GET678 /"ALN X", "ATX X", "XTA X" | |
2986 | CLL RAL /(2 WORDS PER) | |
2987 | JMS SYMTYP /OUTPUT SYMBOL | |
2988 | FPXR1S-2 | |
2989 | -2 | |
2990 | JMP XROUT / & XR VALUE | |
2991 | / | |
2992 | SPOP10, TAD (4 /"LDX *,X" | |
2993 | SPOP11, JMS SYMTYP /"ADDX *,X" | |
2994 | FPXR2S | |
2995 | -4 | |
2996 | XROUT, TADICAD /GET XR FIELD | |
2997 | AND N7 | |
2998 | DIGIT / & OUTPUT AS DIGIT | |
2999 | JMP I FPPOUT | |
3000 | / | |
3001 | SPCOP1, TADICAD /GROUP 0 OR 1? | |
3002 | AND (100 | |
3003 | SNA CLA | |
3004 | JMP SPOP1J / 1 = CONDITIONAL JUMPS | |
3005 | JMS GET678 / 0 = SETS, ETC. | |
3006 | TAD (-4 /SUB-OP-CODES 0 THRU 3? | |
3007 | SMA CLA | |
3008 | JMP SPNUSE / NO, 4 THRU 7 = UN-USED | |
3009 | JMS GET678 /0 THRU 3: SETX,SETB,JSA,JSR | |
3010 | IAC / +1+1 => 2 THRU 5 | |
3011 | SPCOP3, IAC / 1: TRAP3 | |
3012 | SPCOP4, JMS MULT3 / 0: TRAP4 | |
3013 | JMS SYMTYP /GO DO ONE OF THESE | |
3014 | FOP134 | |
3015 | -3 | |
3016 | JMP DOFLD /FINISH WITH FIELD | |
3017 | / | |
3018 | SPOP1J, JMS CONDIT /CONDITIONAL JUMPS | |
3019 | 1200 / "J--" | |
3020 | SPACE2 | |
3021 | DOFLD, JMS FLDOUT /OUTPUT FIELD & "*" | |
3022 | JMP I FPPOUT | |
3023 | / | |
3024 | SPCOP2, JMS I TYPSI /OUTPUT "JNX " | |
3025 | MSJNX | |
3026 | JMP XRPLUS-1 / & HANDLE ADDRESS | |
3027 | / | |
3028 | / SPCOP3 & SPCOP4 | |
3029 | / | |
3030 | SPCOP5, TADICAD /GET WORD AGAIN | |
3031 | AND (100 | |
3032 | SZA CLA | |
3033 | JMP SPNUSE /BIT 5 ON IS UNUSED OP | |
3034 | JMS CONDIT /LOAD TRUTH | |
3035 | 1424 / "LT--" | |
3036 | JMP I FPPOUT | |
3037 | / | |
3038 | SPCOP7, IAC / "LEA" INDIRECT, SET SWITCH | |
3039 | SPCOP6, DCA TEMP2 / "LEA" LONG, SET SWITCH | |
3040 | CLL STA | |
3041 | JMP FPLEA / & GO DO OUTPUT | |
3042 | ||
3043 | ||
3044 | PAGE | |
3045 | \fPDATE, 0 /ROUTINE TO OUTPUT AN EXTENDED DATE WORD | |
3046 | DCA CRLF /SAVE IT | |
3047 | TAD CRLF /GET WORD & MASK | |
3048 | AND N377 | |
3049 | CLL RTR /DAY (4-8) TO 7-11 | |
3050 | RAR | |
3051 | JMS I DEC2I / OUTPUT AS 2 DIGITS (MASKED) | |
3052 | JMS I TYPECI / AND A SEPARATOR | |
3053 | "- | |
3054 | TAD CRLF /GET WORD A SECOND TIME | |
3055 | JMS I RTR6I /MONTH (0-3) TO 7-10 | |
3056 | RAR / FOR MONTH*2 | |
3057 | AND (36 / MASK IT AND USE AS AN INDEX | |
3058 | JMS I TYPSI / TO OUTPUT MONTH IN ALPHA | |
3059 | MONTHS / FORM (WITH SAFETY...) | |
3060 | JMS I TYPECI /FOLLOWED BY "-" | |
3061 | "- | |
3062 | TAD CRLF /GET LAST TIME | |
3063 | AND N7 / MASK OFF YEAR | |
3064 | TAD YRTEST / TEST IF .GT. THIS YEAR | |
3065 | SMA SZA | |
3066 | TAD (-10 / YES, SUBTRACT 8 | |
3067 | TAD YRBASE / ADD TO BASE YEAR | |
3068 | JMS I DEC2I / & OUTPUT IT | |
3069 | JMP I PDATE | |
3070 | YRTEST, 0 /-(THIS YEAR) FOR TESTING | |
3071 | YRBASE, 0 /BASE YEAR FOR DATE + THIS YEAR | |
3072 | ||
3073 | ||
3074 | TYPEA, 0 /OUTPUT ASCII CHARACTER IN THE AC | |
3075 | TAD I TYPEA /GET ARG, IF ANY | |
3076 | ISZ TYPEA | |
3077 | DCA I RTL6I /SAVE THE CHAR HERE FOR FIELD 1 | |
3078 | JMS I CTRLI | |
3079 | CIF 10 | |
3080 | JMP TYPE1 /GO TO FIELD 1 TO DO THE OUTPUT | |
3081 | / | |
3082 | TYPEX, ISZ NCNT /BUMP LINE POSITION | |
3083 | JMP I TYPEA / & EXIT | |
3084 | ||
3085 | CRLF, 0 /OUTPUT CARRIAGE RETURN, LINE FEED | |
3086 | CLA | |
3087 | JMS TYPEA | |
3088 | 215 | |
3089 | JMS TYPEA | |
3090 | 212 | |
3091 | DCA NCNT /RESET LINE POSITION | |
3092 | JMP I CRLF | |
3093 | ||
3094 | ||
3095 | TYPEC, 0 /OUTPUT A SINGLE CHAR ARG | |
3096 | TAD I TYPEC /GET IT | |
3097 | ISZ TYPEC | |
3098 | JMS TYPE /OUTPUT IT | |
3099 | JMP I TYPEC | |
3100 | ||
3101 | ||
3102 | TYPE, 0 /CHARACTER OUTPUT ROUTINE | |
3103 | AND N377 /BE SURE ONLY 8 BITS | |
3104 | SNA | |
3105 | TAD CHAR /USE CHAR IF AC = 0 | |
3106 | DCA TCHAR /CHAR TO OUTPUT | |
3107 | TAD TCHAR | |
3108 | JMS I SORTI /CHECK FOR SPECIALS | |
3109 | TYPEL-1 | |
3110 | TYPEOP-TYPEL | |
3111 | TAD TCHAR /IS TCHAR < 240? | |
3112 | TAD M240 | |
3113 | SPA CLA | |
3114 | JMP TYPCTL /NO, OUTPUT AS CTRL-CHAR | |
3115 | TYPC, JMS TYPEA /NOW OUTPUT CHAR | |
3116 | TCHAR, 0 | |
3117 | JMP I TYPE | |
3118 | / | |
3119 | TYPALT, JMS TYPEA /OUTPUT "$" FOR ALT-MODES | |
3120 | "$ | |
3121 | JMP I TYPE | |
3122 | / | |
3123 | TYPCR, JMS CRLF /C.R. TO OUTPUT | |
3124 | JMP I TYPE | |
3125 | / | |
3126 | TYPTAB, JMS TYPEA /SPACE OVER FOR TAB | |
3127 | " | |
3128 | TAD NCNT /TAB TO OUTPUT | |
3129 | TAD M10 | |
3130 | SNA | |
3131 | JMP I TYPE | |
3132 | SMA | |
3133 | JMP TYPTAB+3 /REDUCE BY TAB SIZE | |
3134 | CLA | |
3135 | JMP TYPTAB | |
3136 | / | |
3137 | TYPCTL, JMS TYPEA /CONTROL-CHAR, OUTPUT AS | |
3138 | "^ | |
3139 | TAD C100 / "^","CHAR+100" | |
3140 | JMP TYPC | |
3141 | C100, 100 | |
3142 | ||
3143 | ||
3144 | CTRL, 0 /CHECK FOR CTRL-C, CTRL-S, CTRL-Q & CTRL-P | |
3145 | DCA CTRLQS /CLEAR HANG FLAG | |
3146 | CTRL0, KSF /HAS A KEY BEEN HIT? | |
3147 | JMP CTRLX /NO, TEST IF HANGING | |
3148 | KRS | |
3149 | AND N177 /YES, MASK OFF PARITY BIT | |
3150 | TAD (-"C+300 /IS IT A CTRL-C (ABORT PROGRAM)? | |
3151 | SNA | |
3152 | BCTRLC, JMP CTRLC /*** JMP I CTRLCI /== ABORT == | |
3153 | TAD M20 /IS IT A CTRL-S (STOP OUTPUT)? | |
3154 | SZA | |
3155 | JMP CTRL1 | |
3156 | ISZ CTRLQS / YES, SET HANG FLAG | |
3157 | KCC / & CLEAR HARDWARE FLAG | |
3158 | CTRL1, TAD (2 /IS IT A CTRL-Q (START OUTPUT)? | |
3159 | SZA | |
3160 | JMP CTRL2 | |
3161 | KCC / YES, CLEAR THE HARDWARE | |
3162 | JMP I CTRL / & JUST EXIT | |
3163 | / | |
3164 | CTRL2, IAC /IS IT A CTRL-P (STOP PROGRAM)? | |
3165 | SZA CLA | |
3166 | JMP CTRLX /NO, TEST IF HANGING | |
3167 | KCC | |
3168 | DCA DSWIT /YES, RESET DUMP SWITCH | |
3169 | JMS I TYPECI /OUTPUT "^P" | |
3170 | "P-100 | |
3171 | JMP I RECRLF / THEN CR/LF & RESTART | |
3172 | / | |
3173 | /ROUTINE TO EXECUTE THE 'EXIT' COMMAND | |
3174 | / | |
3175 | XEXIT, | |
3176 | CTRLC, DCA DSWIT /RESET DUMP SWITCH | |
3177 | JMP I M200 / & GO TO SYSTEM | |
3178 | CTRLCI, XERR4+1 /*** CTRL-C ABORTS JOB STREAM! *** | |
3179 | / | |
3180 | CTRLX, TAD CTRLQS /HANGING BECAUSE OF CTRL-S? | |
3181 | SZA CLA | |
3182 | JMP CTRL0 / YES, BACK FOR ANOTHER ROUND | |
3183 | JMP I CTRL / NO, OUT WE GO! | |
3184 | ||
3185 | CTRLQS, 0 /CTRL-S, CTRL-Q FLAG | |
3186 | ||
3187 | ||
3188 | PAGE | |
3189 | \f/INPUT AN UNSIGNED 24 BIT NUMBER | |
3190 | ACCEPT, 0 | |
3191 | DCA ACC1 /CLEAR LO | |
3192 | DCA ACC2 / & HI WORDS | |
3193 | DCA DADD / & LEGAL INPUT SWITCH | |
3194 | JMS I SSKIPI /GET FIRST NON-SPACE | |
3195 | SKP | |
3196 | ACCPT1, JMS I GETNI /DON'T IGNORE SPACES | |
3197 | JMS I SORTI /CHECK FOR ^D, ^K, (, ", ', | |
3198 | GWLST1-1 / DIGITS, SPACE | |
3199 | ACOPS-GWLST1 | |
3200 | JMP ACCPT3 /NONE OF THE ABOVE | |
3201 | / | |
3202 | ACCNUM, TAD CHAR | |
3203 | TAD (-"0 /MAKE A DIGIT | |
3204 | DCA OCTSET | |
3205 | TAD OCTSET /IS DIGIT LEGAL? | |
3206 | CIA | |
3207 | TAD ACBASE | |
3208 | SPA SNA CLA | |
3209 | ERC09, ERROR / NO, ILLEGAL DIGIT! | |
3210 | ACCMUL, TAD ACBASE /SET UP MULTIPLY OF PREVIOUS | |
3211 | DCA OPER1 / BY BASE | |
3212 | DCA OPER2 | |
3213 | JMS DMUL / DO MULTIPLY | |
3214 | TAD OCTSET /SET UP ADD OF NEXT "DIGIT" | |
3215 | DCA OPER1 | |
3216 | DCA OPER2 | |
3217 | JMS DADD /OK, DO THE ADD (& SET SWITCH) | |
3218 | JMP ACCPT1 | |
3219 | / | |
3220 | STA / SPACE HERE | |
3221 | DCA CRSWT /SET SWITCH: CR HERE | |
3222 | ACCPT3, TAD DADD /TERMINATING CHAR RECEIVED | |
3223 | SNA CLA /CHECK FOR LEGAL INPUT | |
3224 | ERCR, ERROR /YOU CAN'T OUT-SMART ME! | |
3225 | JMP I ACCEPT | |
3226 | ACBASE, 10 | |
3227 | / | |
3228 | / | |
3229 | DQUOTE, JMS QUOTEC / " - GET SINGLE CHAR | |
3230 | DCA OCTSET / SAVE VALUE | |
3231 | JMP ACCMUL / & USE IT AS A "DIGIT" | |
3232 | / | |
3233 | SQUOTE, JMS QUOTEC / ' - PACKED ASCII, GET 1ST | |
3234 | AND N77 /MASK TO 6 BITS | |
3235 | JMS I RTL6I /MOVE TO LEFT HALF | |
3236 | DCA OCTSET / & SAVE IT | |
3237 | JMS QUOTEC /GET 2ND CHAR | |
3238 | AND N77 /MASK | |
3239 | TAD OCTSET /MERGE | |
3240 | JMP DQUOTE+1 / & USE THIS AS A "DIGIT" | |
3241 | / | |
3242 | CTRLD, TAD (2 / ^D - SET RADIX TO DECIMAL | |
3243 | CTRLK, JMS OCTSET / ^K - SET RADIX TO OCTAL | |
3244 | JMP ACCPT1 | |
3245 | ||
3246 | ||
3247 | /SUB. TO SET UP FOR OCTAL/DECIMAL INPUT. CALLED FROM | |
3248 | / COMMAND INPUT & MODIFY & IF AN "^K"/"^D" IN INPUT. | |
3249 | OCTSET, 0 /SET UP FOR OCTAL/DECIMAL INPUT | |
3250 | TAD (10 /ENTER WITH AC= 2 FOR DECIMAL | |
3251 | DCA ACBASE | |
3252 | JMP I OCTSET | |
3253 | ||
3254 | QUOTEC, 0 /GET A QUOTED CHARACTER | |
3255 | JMS CGTEST /GET & TEST FOR A CR | |
3256 | ERC13, ERROR / ILLEGAL USE OF " OR ' | |
3257 | TAD CHAR /OK, RETURN WITH IT | |
3258 | JMP I QUOTEC | |
3259 | ||
3260 | ||
3261 | /SUBROUTINE TO DEVELOP ARGUMENTS FROM THE COMMAND | |
3262 | /BUFFER, AND RETURN WITH -(#) OF ARGS IN 'TEMP'. | |
3263 | GARGS, 0 | |
3264 | TAD TEMPST /GET BUFFER ADDRESS | |
3265 | DCA DPNT | |
3266 | DCA TEMP /ZERO THE NUMBER OF ARGS | |
3267 | GAR1, STA | |
3268 | DCA TEMP1 /SET BLK TO -1 | |
3269 | STA | |
3270 | DCA CNT /RESET SWITCH | |
3271 | GAR2, JMS EXPRIN /GET NEXT ARG | |
3272 | JMS I SSKIPI /IGNORE TRAILING SPACES | |
3273 | JMS I SORTI /BRANCH ON TERMINATOR | |
3274 | GARLST-1 | |
3275 | GAROPS-GARLST | |
3276 | ERCS, ERROR /ILLEGAL TERMIN., FLAME OUT | |
3277 | / | |
3278 | GAR3, JMS GPUT /CR FOUND, END | |
3279 | TAD TEMPST /SET UP POINTER FOR | |
3280 | DCA DPNT / GETTING RESULTS | |
3281 | JMP I GARGS | |
3282 | / | |
3283 | GAR4, JMS I GETNI /SKIP OVER "." | |
3284 | TAD ACC1 /.= TERMIN (BLOCK PART) | |
3285 | JMP GAR1+1 /SET BLOCK & GET NEXT | |
3286 | / | |
3287 | GAR5, TAD ACC1 /-= TERMIN (LOC PART) | |
3288 | DCA TEMP2 | |
3289 | JMS I GETNI /SKIP OVER "-" | |
3290 | JMP GAR2-1 /GO SET SWITCH | |
3291 | / | |
3292 | GAR6, JMS GPUT /,= TERMIN | |
3293 | JMS I GETNI /SKIP OVER "," | |
3294 | JMP GAR1 | |
3295 | ||
3296 | ||
3297 | /SUBROUTINE TO PUT THE DEVELOPED ARGS IN THE ARG | |
3298 | /BUFFER. ALL ARGUMENTS ARE STORED IN 4 WORDS IN | |
3299 | /THE BUFFER, AS SPECIFIED BY: | |
3300 | / BLOCK.LOC1-LOC2 (TERMINATED BY , OR C.R.) | |
3301 | /AS: | |
3302 | /I-------I-------I-------I-------I----- | |
3303 | /I WORD1 I WORD2 I WORD3 I WORD4 I ETC. | |
3304 | /I-------I-------I-------I-------I----- | |
3305 | /WHERE: | |
3306 | / WORD1= BLOCK (OR -1 IF NONE SPECIFIED) | |
3307 | / WORD2= LOC (HIGH) [ONLY 3 BITS, LOC2 IF SPEC'D] | |
3308 | / WORD3= LOC1 (LOW) | |
3309 | / WORD4= LOC2-LOC1-1 (LOC2=LOC1 IF NOT | |
3310 | / SPECIFIED) [ONLY 12 LOW BITS USED] | |
3311 | GPUT, 0 | |
3312 | TAD TEMP1 | |
3313 | DCA I DPNT /SET BLOCK | |
3314 | ISZ CNT /WAS A LOC2 SPECIFIED? | |
3315 | JMP GPUT1 /YES, OK | |
3316 | TAD ACC1 | |
3317 | DCA TEMP2 /NO, MAKE ARGS SAME | |
3318 | GPUT1, TAD ACC2 /STORE HIGH ADDR | |
3319 | AND N7 /MASKED TO 3 BITS | |
3320 | DCA I DPNT | |
3321 | TAD TEMP2 /USE 1ST ARG | |
3322 | DCA I DPNT | |
3323 | TAD ACC1 | |
3324 | CMA | |
3325 | TAD TEMP2 | |
3326 | DCA I DPNT /DIFF= (TEMP2-ACC1-1) | |
3327 | STA | |
3328 | TAD TEMP /ANOTHER ENTRY | |
3329 | DCA TEMP | |
3330 | JMP I GPUT | |
3331 | ||
3332 | ||
3333 | XS240O, 0 /XS240 FORMAT PACKED ASCII | |
3334 | JMS I RTR6I /HIGH 6 BITS | |
3335 | AND N77 | |
3336 | SPACE1 / PLUS A SPACE | |
3337 | TADICAD /THEN LOW 6 BITS, | |
3338 | AND N77 | |
3339 | SPACE1 / PLUS A SPACE | |
3340 | JMP I XS240O | |
3341 | ||
3342 | ||
3343 | GETN, 0 /GET NEXT CHAR FROM COMM. BUFF. | |
3344 | CDF 10 | |
3345 | TAD I COMOUT | |
3346 | CDF 0 | |
3347 | DCA CHAR | |
3348 | JMP I GETN | |
3349 | ||
3350 | ||
3351 | PAGE | |
3352 | \f/ROUTINE TO EVALUATE THE PARENTHESIZED EXPRESSION | |
3353 | /OF DOUBLE PRECISION INTEGERS IN THE COMMAND BUFFER. | |
3354 | /IT CALLS ITSELF RECURSIVELY TO EVALUATE EXPRESSIONS | |
3355 | /IN "(...)", PLACING INFORMATION ON A PUSH-DOWN-LIST | |
3356 | /OR DOING ARITHMETIC ACCORDING TO OPERATOR PRECIDENCE. | |
3357 | / | |
3358 | /OPERATIONS (IN ORDER OF PRECIDENCE): | |
3359 | / OR AND ADD SUB DIV MPY | |
3360 | / ! & + - / * | |
3361 | ||
3362 | /ALL ARITHMETIC IS DONE IN DOUBLE-PRECISION SIGNED | |
3363 | /INTEGER. OVERFLOW ON MULTIPLY, ADD OR SUBTRACT IS | |
3364 | /IGNORED BUT DIVIDE BY 0 WILL CAUSE AN ERROR. | |
3365 | ||
3366 | ||
3367 | EVAL, 0 | |
3368 | DCA OPER2 /0 => D.P. TEMP (NEW NUMBER | |
3369 | DCA OPER1 / OR LAST RESULT). | |
3370 | DCA LASTOP /0 => LASTOP | |
3371 | JMS I TERMTI /GET NEXT & TEST FOR TERM. | |
3372 | JMP EVAL1 /TERM, CHECK IT | |
3373 | JMP ENUM / IT MUST BE A NUMBER | |
3374 | ||
3375 | EVAL1, JMS I SORTI /CHECK LEGAL TERMS | |
3376 | EVLST1-1 /"+","-" & "(" | |
3377 | EVOPS1-EVLST1 | |
3378 | ERCT, ERROR /SORRY ABOUT THAT | |
3379 | ||
3380 | EVAL2, JMS I LPARI /IS CHAR "("? | |
3381 | ERCU, ERROR /YES,ILLEGAL (NO OP FIRST) | |
3382 | EVMIN, TAD CNTRA /SEQN # OF TERMINATOR | |
3383 | DCA THISOP /SET UP THISOP | |
3384 | TAD CNTRA /IS IT ")" OR "CR"? | |
3385 | TAD M10 | |
3386 | SMA CLA | |
3387 | DCA THISOP /YES, 0 => THISOP | |
3388 | EVAL3, TAD THISOP /CHECK PRIORITIES | |
3389 | CIA | |
3390 | TAD LASTOP /IS LASTOP < THISOP? | |
3391 | SPA CLA | |
3392 | JMP EVPAR /YES, CONTINUE SCAN | |
3393 | TAD THISOP / IS THISOP+LASTOP=0? | |
3394 | TAD LASTOP | |
3395 | SNA CLA | |
3396 | JMP EVALX /YES, DONE | |
3397 | TAD LASTOP /NO, DO THIS OP NOW | |
3398 | TAD EVTAB | |
3399 | DCA EVOP /SET UP OPERATION | |
3400 | TAD LASTOP /IS THIS =0? | |
3401 | SNA CLA | |
3402 | JMP EVOP /YES, DO OP | |
3403 | POP /NO, POP LAST OFF LIST | |
3404 | DCA ACC2 / INTO D.P.AC. | |
3405 | POP | |
3406 | DCA ACC1 | |
3407 | EVOP, HLT /JMS TO OPERATION ROUTINE | |
3408 | TAD ACC2 | |
3409 | DCA OPER2 /DUPLICATE D.P.AC. INTO | |
3410 | TAD ACC1 | |
3411 | DCA OPER1 / D.P. TEMP | |
3412 | POP | |
3413 | DCA LASTOP /POP UP ANOTHER OLD OPERATOR | |
3414 | JMP EVAL3 /AND GO DO IT | |
3415 | ||
3416 | EVPAR, JMS I LPARI /IS CHAR A "("? | |
3417 | JMP EVLPAR /YES, GO DO A SUB-EXPRESSION | |
3418 | TAD LASTOP /NO, PUSH DOWN OLD OP | |
3419 | PUSH | |
3420 | TAD OPER1 / & D.P. TEMP (LAST | |
3421 | PUSH | |
3422 | TAD OPER2 / RESULT OR NEW NUMBER). | |
3423 | PUSH | |
3424 | TAD THISOP /UPDATE LASTOP | |
3425 | DCA LASTOP | |
3426 | EVNEXT, JMS I TERMTI /GET NEXT & TEST FOR TERM. | |
3427 | JMP EVLPAR /TERM, MUST BE A "(" | |
3428 | ENUM, JMS I SORTI /CHECK FOR "C","B", ETC... | |
3429 | EVLST2-1 | |
3430 | EVOPS2-EVLST2 | |
3431 | JMS ACCEPT /GET A # OR BOMB OUT! | |
3432 | STA | |
3433 | TAD COMOUT /BACK UP POINTER | |
3434 | DCA COMOUT | |
3435 | ENUMX, TAD ACC1 | |
3436 | DCA OPER1 /LO ORDER PART | |
3437 | TAD ACC2 | |
3438 | DCA OPER2 /HI ORDER PART | |
3439 | JMP EVOPN /GO CHECK TERMINATOR | |
3440 | / | |
3441 | EVDATE, CDF 10 /"D" -- USE DATE WORD | |
3442 | TAD I (7666 /GET DATE WORD | |
3443 | CDF 0 | |
3444 | JMP EVBLK+1 | |
3445 | EVREM, TAD ACCX1 /"R" -- USE REMAINDER | |
3446 | DCA ACC1 | |
3447 | TAD ACCX2 / AS NEXT "INPUT". | |
3448 | JMP EVBLK+2 | |
3449 | EVTEMP, TAD TEMPV1 /"T" -- USE 'TEMP' STORAGE | |
3450 | DCA ACC1 | |
3451 | TAD TEMPV2 | |
3452 | JMP EVBLK+2 | |
3453 | EVSR, LAS SKP /"S" -- USE SWITCHES | |
3454 | TADICAD /"C" -- USE CONTENTS | |
3455 | JMP EVBLK+1 | |
3456 | EVFIL, TAD FILLER /"F" -- USE FILLER | |
3457 | JMP EVBLK+1 | |
3458 | EVLOC, TAD LOCL /"L" -- USE LOCATION | |
3459 | DCA ACC1 | |
3460 | TAD LOCH | |
3461 | JMP EVBLK+2 | |
3462 | EVBLK, TAD BLK /"B" -- USE BLOCK | |
3463 | DCA ACC1 /INTO LO ORDER PART | |
3464 | DCA ACC2 /0 HIGH ORDER PART | |
3465 | JMP ENUMX /CHECK NEXT CHARACTER | |
3466 | ||
3467 | EVLPAR, JMS I LPARI /IS CHAR "("? | |
3468 | SKP | |
3469 | ERCV, ERROR /NO, DIE! (ILLEGAL OPERATOR) | |
3470 | EVPAR2, TAD LASTOP /PUSH DOWN LASTOP | |
3471 | PUSH | |
3472 | TAD EVAL /PREPARE TO RE-CALL | |
3473 | PUSH | |
3474 | JMS EVAL /RECURSIVE CALL | |
3475 | ERCW, ERROR /TERM = CR, NOT ENOUGH PARENS | |
3476 | POP | |
3477 | DCA EVAL /RESTORE RETURN ADDR | |
3478 | POP | |
3479 | DCA LASTOP /RESTORE LASTOP | |
3480 | EVOPN, JMS I TERMTI /GET NEXT & TEST FOR TERM. | |
3481 | JMP EVAL2 /OK | |
3482 | JMP EVPAR2-1 /GARBAGE, GIVE SAME ERROR | |
3483 | ||
3484 | EVALX, TAD CNTRA /WAS CHAR CR OR ")"? | |
3485 | TAD M10 | |
3486 | SNA CLA | |
3487 | ISZ EVAL / ")", RETURN TO CALL+2 | |
3488 | JMP I EVAL / CR, RETURN TO CALL+1 | |
3489 | ||
3490 | LPARI, LPAR | |
3491 | TERMTI, TERMT | |
3492 | ||
3493 | EVTAB, JMS I . /JMS THRU TABLE TO OPERATIONS | |
3494 | ||
3495 | DIOR /INCLUSIVE OR | |
3496 | DAND /AND | |
3497 | DADD /ADD | |
3498 | DSUB /SUBTRACT | |
3499 | DDIV /DIVIDE | |
3500 | DMUL /MULTIPLY | |
3501 | ||
3502 | ||
3503 | PAGE | |
3504 | \fPUSHX, 0 /PUSH AC ONTO LIST | |
3505 | CDF 10 | |
3506 | DCA I PDLPT | |
3507 | CDF 0 | |
3508 | ISZ PDLPT /BUMP POINTER | |
3509 | JMP I PUSHX | |
3510 | ||
3511 | POPX, 0 /POP LIST INTO AC | |
3512 | STA STL /SET LINK SO IT WILL BE 0 | |
3513 | TAD PDLPT /BACK UP POINTER | |
3514 | DCA PDLPT | |
3515 | CDF 10 | |
3516 | TAD I PDLPT | |
3517 | CDF 0 | |
3518 | JMP I POPX | |
3519 | ||
3520 | ||
3521 | LPAR, 0 /CHECK IF CHAR = "(" | |
3522 | TAD CHAR | |
3523 | TAD (-"( | |
3524 | SZA CLA | |
3525 | ISZ LPAR /IF IT IS NOT, TO CALL+2 | |
3526 | JMP I LPAR / ELSE TO CALL+1 | |
3527 | ||
3528 | /COMPARE CHAR AGAINST LIST OF TERMINATORS. IF IT | |
3529 | /IS ONE, RETURN TO CALL+1, ELSE TO CALL+2. | |
3530 | TERMT, 0 | |
3531 | CLA CLL | |
3532 | JMS I GETNI /GET NEXT CHARACTER | |
3533 | JMS I SSKIPI /IGNORE SPACES | |
3534 | TAD (TERMS-1 /SET UP POINTER | |
3535 | DCA SPNT | |
3536 | DCA CNTRA /SET CNTRA TO 0 | |
3537 | TERMT1, CDF 10 | |
3538 | TAD I SPNT /GET AN ITEM | |
3539 | CDF 0 | |
3540 | ISZ CNTRA /ADD 1 TO ITEM # | |
3541 | SNA | |
3542 | JMP TERMTE /WAS 0, END | |
3543 | CIA | |
3544 | TAD CHAR /SAME AS THIS? | |
3545 | SNA CLA | |
3546 | JMP I TERMT /YES, TO CALL+1 | |
3547 | JMP TERMT1 | |
3548 | TERMTE, ISZ TERMT /DIDN'T FIND IT, TO | |
3549 | JMP I TERMT / CALL+2 | |
3550 | ||
3551 | /DOUBLE-PRECISION ROUTINES | |
3552 | ||
3553 | DADD, 0 /D.P. ADD | |
3554 | CLL | |
3555 | TAD OPER1 | |
3556 | TAD ACC1 /ADD LOW ORDER PARTS | |
3557 | DCA ACC1 | |
3558 | RAL /GET CARRY TO AC11 | |
3559 | TAD OPER2 /ADD HIGH ORDER PARTS | |
3560 | TAD ACC2 | |
3561 | DCA ACC2 /STORE HIGH ORDER PART | |
3562 | JMP I DADD | |
3563 | ||
3564 | DSUB, 0 /D.P. SUBTRACT | |
3565 | DCA DPSGN /ZERO IT FOR SAFETY | |
3566 | JMS MULNEG /NEGATE OPERAND | |
3567 | JMS DADD / & ADD | |
3568 | JMP I DSUB | |
3569 | ||
3570 | DAND, 0 /D.P. LOGICAL AND | |
3571 | TAD ACC2 /AND HIGH ORDER PARTS | |
3572 | AND OPER2 | |
3573 | DCA ACC2 | |
3574 | TAD ACC1 /AND LOW ORDER PARTS | |
3575 | AND OPER1 | |
3576 | DCA ACC1 | |
3577 | JMP I DAND /RETURN | |
3578 | ||
3579 | DIOR, 0 /D.P. LOGICAL INCLUSIVE OR | |
3580 | TAD ACC2 /IOR HIGH ORDER PARTS | |
3581 | CMA | |
3582 | AND OPER2 | |
3583 | TAD ACC2 | |
3584 | DCA ACC2 | |
3585 | TAD ACC1 /IOR LOW ORDER PARTS | |
3586 | CMA | |
3587 | AND OPER1 | |
3588 | TAD ACC1 | |
3589 | DCA ACC1 | |
3590 | JMP I DIOR | |
3591 | ||
3592 | ||
3593 | /SUBROUTINE TO GET SINGLE ARGS FROM THE COMMAND | |
3594 | /BUFFER. MUST BE IN 'BLOK.LOC' FORM. ONLY ".", | |
3595 | /SPACE AND CR ARE ALLOWED OTHER THAN DIGITS. | |
3596 | ARG, 0 | |
3597 | STA | |
3598 | ARG1, DCA TEMP1 /SET 'BLOK' [INIT TO -1] | |
3599 | JMS EXPRIN / GET AN ARG | |
3600 | JMS I SORTI /LOOK UP TERMINATOR | |
3601 | ARGLST-1 | |
3602 | ARGOPS-ARGLST | |
3603 | ERCQ, ERROR /ILLEGAL TERMINATOR | |
3604 | / | |
3605 | ARG2, JMS I GETNI /SKIP OVER "." | |
3606 | TAD ACC1 /TERM = ".", SET 'BLOK' | |
3607 | JMP ARG1 | |
3608 | / | |
3609 | ARG3, JMP I ARG /TERM = " " OR CR | |
3610 | ||
3611 | ||
3612 | /GET NEXT ARG FROM COMM. BUFF. IF NEXT CHAR IS | |
3613 | / A "(", USE 'EVAL' TO GET IT, OTHERWISE USE | |
3614 | / 'ACCEPT'. | |
3615 | EXPRIN, 0 | |
3616 | JMS I SSKIPI /IGNORE SPACES | |
3617 | JMS LPAR /IS CHAR A "("? | |
3618 | JMP EXPRI1 | |
3619 | JMS ACCEPT /NO, MUST BE A NUMBER | |
3620 | JMP I EXPRIN | |
3621 | / | |
3622 | EXPRI1, JMS I EVALI /YES, GO EVALUATE EXPRESSION | |
3623 | ERC08, ERROR /CR = ILLEGAL TERMINATOR | |
3624 | JMS CGTEST /OK, SKIP OVER ")" & TEST FOR CR | |
3625 | SKP | |
3626 | STA /NO, SET SWITCH | |
3627 | DCA CRSWT /YES, RESET IT | |
3628 | JMP I EXPRIN / & LEAVE... | |
3629 | ||
3630 | ||
3631 | SCANER, 0 /EXECUTION SUBROUTINE FOR 'SCAN' COMMAND | |
3632 | CLA | |
3633 | TAD BLK /SET UP DESIRED BLOCK | |
3634 | DCA CBLK | |
3635 | JMS GETIO /DO NECESSARY I/O | |
3636 | SKP CLA / READ ERROR! | |
3637 | JMP I SCANER /THIS BLOCK IS OK! | |
3638 | TAD BLK | |
3639 | JMS I OCTI /OUTPUT BLOCK NUMBER | |
3640 | JMS I TYPSI / & TELL IT'S BAD | |
3641 | MSBAD | |
3642 | JMS I CRLFI / TO ANOTHER LINE | |
3643 | JMP I SCANER | |
3644 | ||
3645 | ||
3646 | PAGE | |
3647 | \f/SIGNED MULTIPLY AND DIVIDE ROUTINES | |
3648 | ||
3649 | DMUL, 0 | |
3650 | JMS MDCOM /MAKE DPAC POS, INITIALIZE | |
3651 | SPA CLA /MAKE SURE MULTIPLIER IS POSITIVE | |
3652 | JMS MULNEG / IT WAS NEG, MAKE POS & SET SIGN | |
3653 | DMUL1, TAD ACC2 /SHIFT RIGHT & OUT | |
3654 | RAR | |
3655 | DCA ACC2 /THRU HI OF LO | |
3656 | TAD ACC1 | |
3657 | RAR | |
3658 | DCA ACC1 /THRU LO OF LO INTO LINK | |
3659 | ISZ DPNEG /DONE YET? | |
3660 | JMP DMUL2 /NO, CONTINUE | |
3661 | DMUL4, TAD DPSGN /YES, CHECK SIGN OF RESULT | |
3662 | RAR | |
3663 | SZL CLA /SKIP IF SIGN OK | |
3664 | JMS DPNEG /NOT OK, NEGATE | |
3665 | JMP I DMUL | |
3666 | / | |
3667 | DMUL2, SNL /ADD IN THIS TIME? | |
3668 | JMP DMUL3 /NO, BIT OUT WAS 0 | |
3669 | CLA CLL /YES, BIT WAS 1 | |
3670 | TAD OPER1 /START WITH LOW | |
3671 | TAD ACCX1 | |
3672 | DCA ACCX1 | |
3673 | CLA RAL /GET CARRY | |
3674 | TAD OPER2 /ADD HIGH PARTS | |
3675 | DMUL3, TAD ACCX2 /AND BEGIN SHIFTING OUT | |
3676 | RAR | |
3677 | DCA ACCX2 | |
3678 | TAD ACCX1 | |
3679 | RAR | |
3680 | DCA ACCX1 | |
3681 | JMP DMUL1 | |
3682 | ||
3683 | DDIV, 0 | |
3684 | TAD DDIV /MOVE RETURN ADDRESS | |
3685 | DCA DMUL | |
3686 | JMS MDCOM /MAKE DPAC POS, INITIALIZE | |
3687 | SMA CLA /IS DIVISOR NEGATIVE? | |
3688 | JMS MULNEG / NO, NEGATE IT & SET SIGN | |
3689 | SZL / IS IT 0? (CARRY OUT ON NEGATE) | |
3690 | ERCX, ERROR / YES, YOU LOST | |
3691 | ISZ DPSGN /CORRECT FOR SIGN DIF IN * & / | |
3692 | DDIV1, TAD ACCX1 /SUBTRACT LO OF LO | |
3693 | TAD OPER1 | |
3694 | DCA ACCX1 | |
3695 | CLA RAL /CARRY TO AC | |
3696 | TAD ACCX2 /SUBTRACT HI OF LO | |
3697 | TAD OPER2 | |
3698 | SPA /TOO FAR? | |
3699 | JMP DDIV2 /YES | |
3700 | CLL CML /NO, SET LINK | |
3701 | DCA ACCX2 | |
3702 | JMP DDIV3 | |
3703 | DDIV2, CLA | |
3704 | TAD OPER1 /RESET LO ORDER PART | |
3705 | CIA | |
3706 | TAD ACCX1 | |
3707 | DCA ACCX1 | |
3708 | CLL /RESET LINK | |
3709 | DDIV3, TAD ACC1 /BEGIN SHIFTING | |
3710 | RAL | |
3711 | DCA ACC1 | |
3712 | TAD ACC2 | |
3713 | RAL | |
3714 | DCA ACC2 | |
3715 | ISZ DPNEG /DONE YET? | |
3716 | SKP | |
3717 | JMP DMUL4 /YES, CHECK SIGN & RETURN | |
3718 | TAD ACCX1 /NO, KEEP SHIFTING | |
3719 | RAL | |
3720 | DCA ACCX1 | |
3721 | TAD ACCX2 | |
3722 | RAL | |
3723 | DCA ACCX2 | |
3724 | JMP DDIV1 | |
3725 | ||
3726 | MDCOM, 0 /COMMON ROUTINE FOR MULTIPLY & DIVIDE | |
3727 | DCA DPSGN /RESET SIGN | |
3728 | TAD ACC2 /IS DPAC POS? | |
3729 | SPA CLA | |
3730 | JMS DPNEG /NO, NEGATE | |
3731 | DCA ACCX2 / 0 => DPACX | |
3732 | DCA ACCX1 | |
3733 | TAD (-31 /INITIALIZE COUNTER | |
3734 | DCA DPNEG | |
3735 | CLL | |
3736 | TAD OPER2 /RETURN W. HIGH OPERAND | |
3737 | JMP I MDCOM | |
3738 | ||
3739 | MULNEG, 0 /NEGATE THE MULTIPLIER/DIVISOR | |
3740 | TAD OPER1 /DO LO-ORDER PART | |
3741 | CLL CIA | |
3742 | DCA OPER1 | |
3743 | TAD OPER2 /DO HI-ORDER PART | |
3744 | CMA | |
3745 | SZL /CARRY? | |
3746 | CLL IAC /YES, ADD IT IN | |
3747 | DCA OPER2 | |
3748 | ISZ DPSGN /SIGN CHANGE MADE | |
3749 | JMP I MULNEG | |
3750 | ||
3751 | DPNEG, 0 /NEGATE THE D.P.AC. | |
3752 | TAD ACC1 /DO LO-ORDER PART | |
3753 | CLL CIA | |
3754 | DCA ACC1 | |
3755 | TAD ACC2 /DO HI-ORDER PART | |
3756 | CMA | |
3757 | SZL /CARRY? | |
3758 | CLL IAC /YES, ADD IT IN | |
3759 | DCA ACC2 | |
3760 | ISZ DPSGN /SIGN CHANGE MADE | |
3761 | JMP I DPNEG | |
3762 | ||
3763 | ||
3764 | BLKTST, 0 /TEST & SET BLK | |
3765 | DCA DPNEG /SAVE DATA | |
3766 | TAD DPNEG /GET IT BACK AGAIN | |
3767 | ISZ DPNEG /LEGAL BLOCK NUMBER? | |
3768 | DCA BLK / YES IF NOT 7777 (-1) | |
3769 | CLA / IF NOT, CLEAR JUNK | |
3770 | JMP I BLKTST | |
3771 | ||
3772 | ||
3773 | DICAD, 0 /"DCA I CAD" IN FIELD 1 | |
3774 | CDF 10 | |
3775 | DCA I CAD | |
3776 | CDF 0 | |
3777 | JMP I DICAD | |
3778 | ||
3779 | TICAD, 0 /"TAD I CAD" IN FIELD 1 | |
3780 | CDF 10 | |
3781 | TAD I CAD | |
3782 | CDF 0 | |
3783 | JMP I TICAD | |
3784 | ||
3785 | ||
3786 | PAGE | |
3787 | \f/CHECK IF THE COMMAND BUFFER STARTS WITH A WORD. IF | |
3788 | /IT DOES, RETURN TO 'MAIN3' WITH THE SPECIAL CHAR- | |
3789 | /ACTER AND JUST USE IT AS PART OF THE COMMAND STRING. | |
3790 | /IF IT DOES NOT, TEST FOR EXPRESSIONS [IN "(...)", | |
3791 | /TO ALLOW CHARACTERS IN THE EXPRESSIONS TO NOT BE | |
3792 | /TAKEN AS COMMAND CHARACTERS] AND SINGLE & DOUBLE | |
3793 | /QUOTES [THE FOLLOWING CHARACTER OR CHARACTERS ARE | |
3794 | /LITERALS, NOT COMMANDS]. IF THE PARENS MATCH AND | |
3795 | /THE QUOTES ARE FOLLOWED BY THE CORRECT NUMBER OF | |
3796 | /CHARACTERS, THEN THE LAST CHARACTER WAS AN "ODT" | |
3797 | /COMMAND TO BE EXECUTED SO RETURN TO CALL+1. OTHER- | |
3798 | /WISE RETURN TO 'MAIN3' AS ABOVE. | |
3799 | ||
3800 | WCHEK, 0 | |
3801 | JMS I GWORDI /COM BUF BEGIN WITH A WORD? | |
3802 | JMP WCHEK2 /NO, TEST FOR PARENS, ETC. | |
3803 | WCHEK1, STA | |
3804 | TAD COMIR /YES, BACK UP COMIR | |
3805 | DCA COMIR | |
3806 | TAD TEMP /AND USE THE SPECIAL CHAR AS | |
3807 | JMP I .+1 / PART OF THE COMMAND STRING | |
3808 | RESPC+1 | |
3809 | / | |
3810 | WCHEK2, STA | |
3811 | TAD COMOUT /SET UP ANOTHER A-XR | |
3812 | DCA DPNT | |
3813 | DCA CNT /RESET (OR SET) PAREN COUNT | |
3814 | WCHEK3, TADIDP /GET A CHAR FROM COMM. BUFF. | |
3815 | JMS I SORTI / & GO TEST IT | |
3816 | WCKLST-1 | |
3817 | WCKOPS-WCKLST | |
3818 | JMP WCHEK3 /NONE, CONTINUE SCAN | |
3819 | / | |
3820 | WCHEK4, TAD CNT /CR, DO PARENS MATCH? | |
3821 | SZA CLA | |
3822 | JMP WCHEK1 /NO, CONTINUE COMMAND INPUT | |
3823 | JMP I WCHEK /YES, INPUT IS DONE | |
3824 | / | |
3825 | WCHEK5, STA CLL RAL /SET TO -2 | |
3826 | IAC /AC = +1 OR -1 | |
3827 | TAD CNT / UPDATE PAREN COUNT | |
3828 | JMP WCHEK3-1 / & CONTINUE SCAN | |
3829 | / | |
3830 | WCHEK6, JMS WCHONE / ' -- 2 CHARACTERS | |
3831 | JMS WCHONE / " -- 1 CHARACTER | |
3832 | JMP WCHEK3 /OK, CONTINUE SCAN | |
3833 | ||
3834 | WCHONE, 0 | |
3835 | TADIDP /GET NEXT CHAR | |
3836 | TAD M215 /IS IT A CR? | |
3837 | SNA CLA | |
3838 | JMP WCHEK1 /YES, DON'T EXECUTE SPECIAL | |
3839 | JMP I WCHONE /NO, OK | |
3840 | \f/FPP INSTRUCTION DECODING SUPPORT SUBROUTINES | |
3841 | ||
3842 | GETOP, 0 /GET OP-CODE (BITS 0-3) TO BITS 9-11 | |
3843 | TADICAD | |
3844 | AND N7000 | |
3845 | CLL RTL | |
3846 | RTL | |
3847 | JMP I GETOP | |
3848 | ||
3849 | GET678, 0 /GET BITS 678 TO BITS 9-11 | |
3850 | TADICAD | |
3851 | CLL RTR | |
3852 | RAR | |
3853 | AND N7 | |
3854 | JMP I GET678 | |
3855 | ||
3856 | MULT3, 0 /MULTIPLY AC BY THREE | |
3857 | DCA GETOP | |
3858 | TAD GETOP | |
3859 | CLL RAL | |
3860 | TAD GETOP /WORKS FOR POS OR NEG! | |
3861 | JMP I MULT3 | |
3862 | ||
3863 | CONDIT, 0 /OUTPUT CONDITIONAL FPP INSTRUCTION | |
3864 | TAD I CONDIT /GET LEADING 1 OR 2 CHARS | |
3865 | ISZ CONDIT | |
3866 | JMS I TWOT / & OUTPUT THEM | |
3867 | JMS GET678 /GET CONDITION CODE | |
3868 | JMS I SYMTYI / AS INDEX TO TABLE | |
3869 | FPCOND | |
3870 | -1 | |
3871 | JMP I CONDIT | |
3872 | SYMTYI, SYMTYP | |
3873 | ||
3874 | FLDOUT, 0 /OUTPUT FIELD DIGIT & "*" | |
3875 | TADICAD | |
3876 | AND N7 /GET FIELD | |
3877 | JMS I RTL6I / TO BITS 3-5 | |
3878 | JMS I TWOCI / & OUTPUT "F*" | |
3879 | 6052 / WHERE "F" IS DIGIT | |
3880 | JMP I FLDOUT | |
3881 | ||
3882 | ||
3883 | ||
3884 | DECIMAL /SET RADIX TO DECIMAL | |
3885 | ||
3886 | TEMPL= . /ARGUMENT BUFFER | |
3887 | /L(TEMPL)=180(10) | |
3888 | F0END= TEMPL+180 | |
3889 | DMPHAN-F0END /(SHOW SPACE LEFT) | |
3890 | ||
3891 | OCTAL | |
3892 | ||
3893 | PAGE /****** MUST BE NO LITERALS! ****** | |
3894 | ||
3895 | DMPHAN= 06600 /DUMP HANDLER AREA, 2 FIELD 0 PAGES | |
3896 | ||
3897 | DEVHAN= 07200 /DEVICE HANDLER AREA, 2 FIELD 0 PGS | |
3898 | ||
3899 | ||
3900 | IFNZRO DMPHAN-F0END&4000 <BADERR,__CAN'T RUN> | |
3901 | ||
3902 | /IF THE ABOVE ASSEMBLES, THE BUFFERS ARE OVER- | |
3903 | / RUNNING THE DUMP DEVICE HANDLER. | |
3904 | ||
3905 | ||
3906 | *TEMPL /ADD INITIALIZATION CODE WHICH IS OVERLAID | |
3907 | ||
3908 | INIMSG, 0 /INITIALIZE ERROR MESSAGES ON SCRATCH BLKS | |
3909 | CDF 10 | |
3910 | TAD I (7726 /BUT FIRST CHECK FOR "SCOPE MODE" | |
3911 | CDF 0 | |
3912 | AND N200 / (BIT 4 OF 17726) | |
3913 | SNA CLA | |
3914 | JMP INIDAT / NOT SET, GO SET UP DATE | |
3915 | INISCO, TAD I SPNT /SET, CHANGE RUBOUT HANDLER TO | |
3916 | SNA | |
3917 | JMP INIDAT / ERASE CHARACTERS FROM SCREEN | |
3918 | DCA I DPNT / AND FROM BUFFER (MUCH EASIER | |
3919 | JMP INISCO / THAN ON HARD COPY!) | |
3920 | / | |
3921 | INIDAT, CDF 10 /NOW INIT EXTENDED DATE | |
3922 | TAD I (7666 /GET SYSTEM DATE WORD | |
3923 | CDF 0 | |
3924 | AND N7 /PICK OFF THIS YEAR PART | |
3925 | CIA | |
3926 | DCA YRTEST / AND SET TEST YEAR (NEG) | |
3927 | TAD I M1 /NOW GET EXTENDED YEAR BITS | |
3928 | AND (600 / FROM "B.I.P." WORD AND | |
3929 | CLL RTR / MOVE TO BITS 7,8 (*8) | |
3930 | RTR | |
3931 | TAD (106 /ADD TO A STARTING BASE OF 70[10] | |
3932 | CIA | |
3933 | TAD YRTEST /AND ADD THIS YEAR ALSO | |
3934 | CIA | |
3935 | DCA YRBASE /= 70 + EXTEND*8 + THIS YEAR | |
3936 | TAD I (7746 /GET JSW | |
3937 | AND (6777 /CLEAR BIT 2 (CAN RESTART!) | |
3938 | CLL RAR | |
3939 | STL RAL /SET BIT 11 (DON'T SAVE FIELD 1) | |
3940 | DCA I (7746 /& PUT IT BACK | |
3941 | JMS I (7607 /WRITE ERROR MESSAGES | |
3942 | 4610 / 6 PAGES, FIELD 1 | |
3943 | 0 / FROM LOC 10000 | |
3944 | 27 / NORMAL SAVE AREA! | |
3945 | SKP CLA | |
3946 | JMP I INIMSG /OK, JUST EXIT | |
3947 | TAD M200 | |
3948 | DCA XERR3 /FAILED, ASSUME WRITE LOCKED | |
3949 | TAD (ERROR / SO NO ERROR MESSAGES ON | |
3950 | DCA ERC15 / ERROR OR "SHOW ERRORS" | |
3951 | JMP I INIMSG | |
3952 | ||
3953 | ||
3954 | PAGE /LITERALS HERE ARE OK! | |
3955 | \f/INITIALIZATION CODE--RESIDES IN BUFFER AREA AND IS WIPED | |
3956 | / OUT DURING EXECUTION. HANDLES CHAINED AND NORMAL STARTS. | |
3957 | ||
3958 | START, CLA SKP /NORMAL | |
3959 | STA /CHAINED (FROM CCL!) | |
3960 | DCA TEMP | |
3961 | CDF 10 | |
3962 | DCA I (CCBB /ZAP CCB SWITCH | |
3963 | CDF 0 | |
3964 | TAD N200 | |
3965 | DCA I (7745 /RESET START ADDRESS | |
3966 | JMS INIMSG /INIT SCOPE, DATE & ERROR MESSAGES | |
3967 | JMS BATSET /TEST & SET UP FOR BATCH | |
3968 | ISZ TEMP /CHAINED? | |
3969 | JMP I (201 / NO, START IT UP! | |
3970 | CDF 10 | |
3971 | TAD I M200 /YES, 1ST OUTPUT DEVICE? | |
3972 | CDF 0 | |
3973 | AND (17 /(IGNORE LENGTH SPEC) | |
3974 | SNA | |
3975 | JMP STSWIT / NO, LEAVE AS SYS | |
3976 | DCA DEVNO /YES, SET DEVICE NUMBER | |
3977 | TAD DEVNO | |
3978 | CALUSR /NOW DO HANDLER FETCH BY | |
3979 | 1 / NUMBER (PAINTING?) | |
3980 | STDEV, DEVHAN+1 /--2 PAGES-- | |
3981 | JMP STERR /ARGGGG! FAILED!!! | |
3982 | TAD STDEV | |
3983 | DCA DEVAD /SET UP HANDLER ENTRY | |
3984 | TAD M200 | |
3985 | DCA DPNT /SET UP FIELD 1 POINTER | |
3986 | TADIDP /GET NAME OF FILE | |
3987 | DCA NAM1 | |
3988 | TADIDP | |
3989 | DCA NAM2 | |
3990 | TADIDP | |
3991 | DCA NAM3 | |
3992 | TADIDP /GET EXTENSION | |
3993 | DCA NAM4 | |
3994 | TAD NAM1 /WAS THERE REALLY A NAME? | |
3995 | SZA CLA | |
3996 | STA / YES, SET NAME SWITCH | |
3997 | DCA TEMP / NO, RESET | |
3998 | CDF 10 | |
3999 | DCA I (XDNAM /CLEAR DEVICE NAME WORDS | |
4000 | DCA I (XDNAM+1 | |
4001 | TAD I DPNT /GET NEXT WORD & TEST FOR ZERO | |
4002 | SZA CLA | |
4003 | JMP STSWIT / SOMETHING NOT RIGHT! | |
4004 | TAD I DPNT /OK, ASSUME CCL CHAIN & SET | |
4005 | DCA I (XDNAM / UP DEVICE NAME | |
4006 | TAD I DPNT | |
4007 | DCA I (XDNAM+1 | |
4008 | TAD I (XDNAM /EMPTY? | |
4009 | SZA CLA | |
4010 | JMP STSWIT | |
4011 | TAD (0423 /YES, MUST BE DEFAULT NAME-- | |
4012 | DCA I (XDNAM / "DSK" | |
4013 | TAD (1300 | |
4014 | DCA I (XDNAM+1 | |
4015 | STSWIT, CDF 10 | |
4016 | TAD I (7643 /TEST SWITCHES | |
4017 | AND N200 / "/E"? | |
4018 | DCA ERMODE / 0= LONG, NON-0= SHORT | |
4019 | IAC | |
4020 | AND I (7643 / "/L"? [LOAD] | |
4021 | SNA CLA | |
4022 | JMP STSWO /NO, CHECK NEXT | |
4023 | TAD NAM4 /YES, SET DEFAULT EXTENSION | |
4024 | SNA | |
4025 | TAD (1404 / TO ".LD" | |
4026 | DCA NAM4 | |
4027 | IAC | |
4028 | JMP STSWEX-2 / & GO SET MODE | |
4029 | / | |
4030 | STSWO, TAD I (7644 | |
4031 | AND (1000 / "/O"? [OFFSET] | |
4032 | SNA CLA | |
4033 | JMP STSWS /NO, GO CHECK LAST | |
4034 | TAD I (7646 /YES, GET LOW 12 BITS OF | |
4035 | CIA / "=NNNN" AS OFFSET AND | |
4036 | DCA OFFSET / IT UP | |
4037 | STA | |
4038 | JMP STSWEX-1 / & GO SET MODE | |
4039 | / | |
4040 | STSWS, TAD I (7644 / "/S"? [SAVE] | |
4041 | AND (40 | |
4042 | SNA CLA | |
4043 | JMP STSWEX /NO, WAS NOT ANY THAT COUNT | |
4044 | TAD NAM4 /YES, SET DEFAULT EXTENSION | |
4045 | SNA | |
4046 | TAD (2326 / TO ".SV" | |
4047 | DCA NAM4 | |
4048 | IAC / & SET MODE | |
4049 | DCA MODSW /-1=OFF,0=NOR,+1=SV,+2=LD | |
4050 | STSWEX, CDF 0 | |
4051 | ISZ TEMP /FILE NAME SPECIFIED? | |
4052 | JMP I (201 / NO, JUST START | |
4053 | DCA CRSWT /YES, SET SWITCH TO CR, | |
4054 | STTLS, TLS / START TTY *** BATCH OPER. | |
4055 | JMS I CRLFI / & DO CR/LF | |
4056 | TAD NAM4 /ANY EXTENSION SPECIFIED? | |
4057 | SNA CLA | |
4058 | STA / NO--ALLOW 3 TRIES: SV, LD, NULL | |
4059 | DCA TEMP1 / ELSE ALLOW ONLY 1 TRY | |
4060 | TAD NAM4 /IF NO EXTENSION SET YET, | |
4061 | SNA | |
4062 | TAD (2326 / SET TO START DEFAULTS WITH SV | |
4063 | DCA NAM4 | |
4064 | JMP XFICHN /NOW GO DO FILE LOOKUP | |
4065 | / | |
4066 | STERR, TLS /START UP OUTPUT *** BATCH OPER. | |
4067 | JMP ERCY / & GIVE ERROR! | |
4068 | ||
4069 | ||
4070 | PAGE | |
4071 | \f/INITIALIZATION CODE FOR BATCH OPERATION | |
4072 | ||
4073 | BATSET, 0 | |
4074 | TAD I M1 /TEST BIT 1 OF 07777 FOR "BIP" | |
4075 | RAL / (BATCH-IN-PROGRESS) | |
4076 | SMA CLA | |
4077 | JMP I BATSET / NO, INTERACTIVE MODE | |
4078 | TAD I M1 / YES, GET FIELD BITS OF BATCH | |
4079 | AND (70 / TO GENERATE A "CIF BAT" | |
4080 | TAD (CIF / AND SET UP 3 CALLS: | |
4081 | DCA CBATI / INPUT, | |
4082 | TAD CBATI | |
4083 | DCA CBATO / OUTPUT AND | |
4084 | TAD CBATI | |
4085 | DCA CBATE / ERROR. | |
4086 | BATMOV, TAD I SCANX1 /GET NEXT STORAGE ADDRESS | |
4087 | SNA | |
4088 | JMP I BATSET / 0 = ALL DONE! | |
4089 | DCA DPNT /SET UP POINTER | |
4090 | BATLUP, TAD I SCANX1 /GET A PATCH WORD | |
4091 | SNA | |
4092 | JMP BATMOV / 0 = GROUP END | |
4093 | BATPAT, CDF 0 /CHANGED FOR "TYPEB"!! | |
4094 | DCA I DPNT /PATCH THE WORD | |
4095 | CDF 0 | |
4096 | JMP BATLUP /DO IT AGAIN! | |
4097 | ||
4098 | ||
4099 | /"SCOPE MODE" PATCHES FOR RUBOUT HANDLER. INITIAL- | |
4100 | / IZATION CODE FIRST CHECKS FOR SCOPE AND THEN FOR | |
4101 | / BATCH. THUS, IF BOTH ARE SET, FIRST THINGS WILL BE | |
4102 | / SET UP FOR SCOPE AND THEN THEY WILL BE RESET FOR | |
4103 | / BATCH. THIS SEQUENCE IS REQUIRED! | |
4104 | ||
4105 | SCOPLS, RELOC RUBO | |
4106 | JMS BTEST /BUFFER NOW EMPTY? | |
4107 | JMP RENEXT / YES, JUST IGNORE RUBOUT | |
4108 | STA | |
4109 | TAD COMIR /NO, BACK UP POINTER | |
4110 | DCA COMIR | |
4111 | TAD COMIR /SET UP POINTER FOR TESTING, ALSO | |
4112 | DCA COMOUT | |
4113 | JMS RUBO2 /OUTPUT BACKSPACE, SPACE, BACKSPACE | |
4114 | JMS I GETNI /GET RUBBED OUT CHAR AND TEST | |
4115 | TAD CHAR | |
4116 | TAD M240 / FOR A CONTROL CHAR | |
4117 | SPA CLA | |
4118 | JMS RUBO2 /YES, ERASE "^" ALSO! | |
4119 | JMP RENEXT /TRY FOR ANOTHER CHAR | |
4120 | ||
4121 | RUBO2, HLT /MUST BE NON-ZERO!!! | |
4122 | JMS I TYPEAI /OUTPUT A BACKSPACE, | |
4123 | "H-100 /(CTRL-H) | |
4124 | SPACE1 / SPACE, | |
4125 | JMS I TYPEAI / BACKSPACE SEQUENCE TO | |
4126 | "H-100 / CLEAR OFF SCREEN CHAR | |
4127 | JMP I RUBO2 | |
4128 | TYPEAI, TYPEA | |
4129 | 0 | |
4130 | ||
4131 | RELOC | |
4132 | ||
4133 | ||
4134 | BATLS, /PATCHES--ADDRESS-1, CODE, 0 WITH EXTRA 0 FOR END. | |
4135 | ||
4136 | RUBO-1 /==== INPUT PATCHES ==== | |
4137 | RELOC RUBO | |
4138 | DCA CHAR /SAVE NEW CHAR INPUT | |
4139 | TAD CHAR /IS THIS A FORM-FEED? | |
4140 | TAD RM214 | |
4141 | SNA | |
4142 | JMP RKEY+1 / YES, JUST IGNORE IT! | |
4143 | TAD R2 /NO, THEN IS IT A LINE-FEED? | |
4144 | SNA CLA | |
4145 | TAD RLAST / YES, WAS LAST A CARRIAGE-RETURN? | |
4146 | TAD M215 | |
4147 | SZA CLA | |
4148 | TAD CHAR /NO TO ONE OR OTHER, USE CHAR. | |
4149 | DCA RLAST / YES TO BOTH, SET TO 0! | |
4150 | TAD RLAST /OK, WAS IT A CR-LF PAIR? | |
4151 | SNA CLA | |
4152 | JMP RKEY+1 / YES, JUST IGNORE LF! | |
4153 | JMP REKEY+1 / NO, GO USE THIS CHAR | |
4154 | ||
4155 | BATINI, 5400 /IN THE BATCH FIELD | |
4156 | RM214, -214 | |
4157 | R2, 2 | |
4158 | RLAST, 215 /!!! CR OF ".R FUTIL" HAS AN LF !! | |
4159 | 0 | |
4160 | ||
4161 | RKEY+1-1 | |
4162 | RELOC /TO PUT 'CBATI' ON THIS PAGE | |
4163 | CBATI= .+1 /REALLY ON "CIF BAT" | |
4164 | RELOC RKEY+1 | |
4165 | JMS I CTRLI /CHECK FOR CONTROL KEYS | |
4166 | CIF /*** CIF BAT | |
4167 | JMS I BATINI /GET A BATCH CHARACTER | |
4168 | ERC17, ERROR /!!! EOF ON INPUT !!! | |
4169 | NOP /FILLER FOR INTERACTIVE CTRL-Q | |
4170 | NOP | |
4171 | 0 | |
4172 | ||
4173 | RKEY0-1 | |
4174 | RELOC RKEY0 | |
4175 | JMP RKEY+1 /IGNORE RUBOUT UNDER BATCH | |
4176 | NOP / & RETURN TO CALL+1! | |
4177 | 0 | |
4178 | ||
4179 | BCTRLC-1 | |
4180 | RELOC BCTRLC | |
4181 | JMP I CTRLCI /CTRL-C, ABORT JOB STREAM! | |
4182 | 0 | |
4183 | ||
4184 | RELOC /==== OUTPUT PATCHES ==== | |
4185 | 201-1 | |
4186 | NOP | |
4187 | 0 | |
4188 | ||
4189 | STTLS-1 | |
4190 | NOP /ZAP 3 "TLS"S USED FOR STARTUP | |
4191 | 0 | |
4192 | ||
4193 | STERR-1 | |
4194 | NOP | |
4195 | 0 | |
4196 | ||
4197 | RELOC /==== ERROR PATCH ==== | |
4198 | ||
4199 | XERR4-1 | |
4200 | CBATE= . /REALLY ON "CIF BAT" | |
4201 | RELOC XERR4 | |
4202 | CIF /*** CIF BAT | |
4203 | JMP I N7000 /ABORT TO BATCH FIELD! | |
4204 | 0 | |
4205 | ||
4206 | RELOC | |
4207 | ||
4208 | BATPAT-1 | |
4209 | CDF 10 /*** NEXT CODE IN FIELD 1 *** | |
4210 | 0 | |
4211 | ||
4212 | TYPEB-1 | |
4213 | RELOC | |
4214 | CBATO= .+1 /REALLY ON "CIF BAT" | |
4215 | IFDEF TYPEB </NO PASS1 ERROR! | |
4216 | RELOC TYPEB /*** REALLY IN FIELD 1 *** | |
4217 | > | |
4218 | CDF 10 /*** SET UP RETURN D.F. | |
4219 | CIF /*** CIF BAT | |
4220 | JMS I .+1 /OUTPUT A CHARACTER TO LOG | |
4221 | 7400 /BATOUT, IN THE BATCH FIELD | |
4222 | CDF 0 /*** RESET D.F. | |
4223 | 0 | |
4224 | ||
4225 | RELOC | |
4226 | ||
4227 | 0 | |
4228 | ||
4229 | ||
4230 | PAGE | |
4231 | ||
4232 | FIELD 1 /THE END OF FIELD 0! | |
4233 | \f*10000 /PUT A POINTER HERE! | |
4234 | ||
4235 | NXTIOT /ADDR OF NEXT FREE SPACE IN TABLE | |
4236 | ||
4237 | ||
4238 | /ERROR MESSAGES AND ADDRESS LIST. THESE ITEMS RESIDE | |
4239 | / UNDER THE USR, REQUIRING THAT THE USR SWAP THEM | |
4240 | / WHEN IT IS USED AND THAT THE PROGRAM KICK OUT THE | |
4241 | / USR WHEN AN ERROR OCCURS IN LONG ERROR MESSAGE MODE | |
4242 | / OR WHEN A "SHOW ERRORS" COMMAND IS GIVEN. IT IS | |
4243 | / TO THE ADVANTAGE OF DECTAPE (AND PROBABLY ALSO | |
4244 | / FLOPPY DISK) SYSTEMS TO USE SHORT ERROR MESSAGE | |
4245 | / MODE TO REDUCE USR SWAPPING IF DOING MANY "FILE" | |
4246 | / OR "SET DEVICE ...DDEV..." COMMANDS. | |
4247 | ||
4248 | *10002 /MESSAGE ADDRESS AT ERROR CODE NUMBER +1 (AUTO-XR) | |
4249 | ||
4250 | /LIST OF ADDRESSES OF ERROR MESSAGES | |
4251 | ||
4252 | ERMSA | |
4253 | ERMSB | |
4254 | ERMSC | |
4255 | ERMS14 | |
4256 | ERMSD | |
4257 | ERMSE | |
4258 | ERMSG | |
4259 | ERMSH | |
4260 | ERMSI | |
4261 | ERMSK | |
4262 | ERMSJ | |
4263 | ERMSXO | |
4264 | ERMSL | |
4265 | ERMSZ | |
4266 | ERMSO | |
4267 | ERMS11 | |
4268 | ERMS04 | |
4269 | ERMSP | |
4270 | ERMSQ | |
4271 | ERMSR | |
4272 | ERMS09 | |
4273 | ERMS08 | |
4274 | ERMS13 | |
4275 | ERMSS | |
4276 | ERMST | |
4277 | ERMSU | |
4278 | ERMSV | |
4279 | ERMSW | |
4280 | ERMSX | |
4281 | ERMSY | |
4282 | ERMSM | |
4283 | ERMS00 | |
4284 | ERMS01 | |
4285 | ERMS02 | |
4286 | ERMS03 | |
4287 | ERMS10 | |
4288 | ERMSF | |
4289 | ERMSGC | |
4290 | ERMSHD | |
4291 | ERMS05 | |
4292 | ERMS07 | |
4293 | ERMS18 | |
4294 | ERMS19 | |
4295 | ERMS20 | |
4296 | ERMS15 | |
4297 | ERMS16 | |
4298 | EMSEND, ERMS17 | |
4299 | ERMS99 | |
4300 | ||
4301 | ||
4302 | /ERROR MESSAGES: | |
4303 | ||
4304 | ERMSA, TEXT &ILLEGAL SINGLE-WORD COMMAND& | |
4305 | ||
4306 | ERMSB, TEXT &ILLEGAL MULTI-WORD COMMAND& | |
4307 | ||
4308 | ERMSC, TEXT &TOO MANY ")"S& | |
4309 | ||
4310 | ERMSD, TEXT &ILLEGAL FORMAT WORD& | |
4311 | ||
4312 | ERMSE, TEXT &BAD FORMAT SYNTAX& | |
4313 | ||
4314 | ERMSF, TEXT &NO FILE FOR C.C.B./HEADER REQUEST& | |
4315 | ||
4316 | ERMSGC, TEXT &BAD C.C.B (NOT A SAVE FILE)& | |
4317 | ||
4318 | ERMSHD, TEXT &BAD HEADER (NOT A LOAD MODULE)& | |
4319 | ||
4320 | ERMSG, TEXT &ILLEGAL ITEM TO SHOW& | |
4321 | ||
4322 | ERMSH, TEXT &ILLEGAL SEARCH MODIFIER& | |
4323 | ||
4324 | ERMSI, TEXT &BAD SEARCH SYNTAX& | |
4325 | ||
4326 | ERMSJ, TEXT &ILLEGAL MODE& | |
4327 | ||
4328 | ERMSK, TEXT &SET OPTION FOLLOWED BY A CR, BAD SYNTAX& | |
4329 | ||
4330 | ERMSXO, TEXT &NUMBER OR ILLEGAL SET OPTION& | |
4331 | ||
4332 | ERMSL, TEXT &NUMBER OR ILLEGAL OUTPUT OPTION& | |
4333 | ||
4334 | ERMSM, TEXT &ILLEGAL "." IN NAME (FILE OR DEVICE)& | |
4335 | ||
4336 | ERMSO, TEXT &ILLEGAL MODIFY FORMAT& | |
4337 | ||
4338 | ERMSP, TEXT &PROGRAM OR HARDWARE PROBLEM& | |
4339 | ||
4340 | ERMSQ, TEXT &BAD TERMINATOR IN SINGLE ARGUMENT& | |
4341 | ||
4342 | ERMSR, TEXT &TERMINATOR BEFORE LEGAL NUMBER INPUT& | |
4343 | ||
4344 | ERMSS, TEXT &BAD TERMINATOR IN MULTIPLE ARGUMENT& | |
4345 | ||
4346 | ERMST, TEXT &ILLEGAL CHARACTER IN EXPRESSION& | |
4347 | ||
4348 | ERMSU, TEXT &ILLEGAL USE OF "(" IN EXPRESSION& | |
4349 | ||
4350 | ERMSV, TEXT &ILLEGAL OPERATOR IN EXPRESSION& | |
4351 | ||
4352 | ERMSW, TEXT &TOO FEW ")"S IN EXPRESSION& | |
4353 | ||
4354 | ERMSX, TEXT &DIVISION BY 0 ATTEMPTED& | |
4355 | ||
4356 | ERMSY, TEXT &UNKNOWN HANDLER NAME& | |
4357 | ||
4358 | ERMSZ, TEXT &NUMBER OR ILLEGAL ERROR OPTION& | |
4359 | ||
4360 | ERMS01, TEXT &NON-& | |
4361 | *.-1 | |
4362 | ||
4363 | ERMS00, TEXT &FATAL READ ERROR& | |
4364 | ||
4365 | ERMS03, TEXT &NON-& | |
4366 | *.-1 | |
4367 | ||
4368 | ERMS02, TEXT &FATAL WRITE ERROR& | |
4369 | ||
4370 | ERMS04, TEXT &ODD START LOC OR COUNT IN OS/8 MODIFY& | |
4371 | ||
4372 | ERMS05, TEXT &BAD ADDRESS/OVERLAY (ODT COMMANDS)& | |
4373 | ||
4374 | /ERMS06, | |
4375 | ||
4376 | ERMS07, TEXT &BAD ADDRESS/OVERLAY (MODIFY)& | |
4377 | ||
4378 | ERMS08, TEXT &ARGUMENT EXPRESSION NOT TERMINATED BY ")"& | |
4379 | ||
4380 | ERMS09, TEXT &ILLEGAL DIGIT& | |
4381 | ||
4382 | ERMS10, TEXT &DUMP HANDLER ERROR& | |
4383 | ||
4384 | ERMS11, TEXT &NUMBER OR ILLEGAL DMODE OPTION& | |
4385 | ||
4386 | /ERMS12, | |
4387 | ||
4388 | ERMS13, TEXT &ILLEGAL USE OF ' OR "& | |
4389 | ||
4390 | ERMS14, TEXT &MAPPED MODE--USE LIST, NOT DUMP& | |
4391 | ||
4392 | ERMS15, TEXT &NO ERROR MESSAGES& | |
4393 | ||
4394 | ERMS16, TEXT &INPUT ERROR ON MESSAGES& | |
4395 | ||
4396 | ERMS17, TEXT &EOF ON BATCH INPUT& | |
4397 | ||
4398 | ERMS18, TEXT &ENTER FAILED& | |
4399 | ||
4400 | ERMS19, TEXT &CLOSE FAILED& | |
4401 | ||
4402 | ERMS20, TEXT &DUMP FILE OVERRUN& | |
4403 | ||
4404 | ERMS99, TEXT &DEBUG& | |
4405 | \f*12000 /BEGIN ABOVE THE USR AREA | |
4406 | ||
4407 | /GCCB & GHDR--ROUTINES TO READ IN THE FIRST BLOCK OF THE | |
4408 | / LAST FILE SPECIFIED BY THE LAST "FILE" COMMAND, ASSUM- | |
4409 | / ING THAT IT WAS A SAVE FILE OR LOAD MODULE, AND DO THE | |
4410 | / FEW CHECKS THAT ARE AVAILABLE TO TEST FOR A CCB (CORE- | |
4411 | / CONTROL-BLOCK) OR HEADER BLOCK BEFORE LETTING THE DATA | |
4412 | / BE USED FOR THE APPROPRIATE PURPOSE. | |
4413 | ||
4414 | GCCB, 0 /GET CORE-CONTROL-BLOCK | |
4415 | JMS CCBHDR /DO COMMON TEST & READ-IN | |
4416 | SMA CLA /1ST WORD (-# SEGS) NEG? | |
4417 | JMP GCCERR / NO, CAN'T BE CCB | |
4418 | TAD I (CCBB+3 /GET JOB STATUS WORD | |
4419 | AND (200 /OVERLAY BIT SET (LINK)? | |
4420 | SZA CLA / 0 = NO | |
4421 | TAD (CCBB+140-1 / 1 = YES, START ADDR-1 | |
4422 | CDF 0 | |
4423 | DCA I (OVLFLG /NO = 0; YES = ADDR-1 | |
4424 | CDF 10 | |
4425 | TAD I (CCBB+1 /2ND WORD A "CDF CIF X0"? | |
4426 | AND (7707 | |
4427 | CIA | |
4428 | TAD GCCCDF | |
4429 | SZA CLA | |
4430 | GCCERR, JMS ERROR1 /LOOKS BAD, JUST EXIT NOW! | |
4431 | ISZ GETSWX /LOOKS OK, 1ST TIME SINCE READ? | |
4432 | JMP GCCB2 /NO, DON'T CHANGE THINGS AGAIN | |
4433 | TAD (CCBB+140+3 /YES, POINT TO LENGTH WORDS | |
4434 | GCCB1, DCA GHDR / TO CHANGE PAGES TO BLOCKS | |
4435 | TAD I GHDR /GET A WORD - PAGES | |
4436 | SNA | |
4437 | JMP GCCB2 / 0 = DONE | |
4438 | IAC /ROUND DOWN IN 2 STEPS FOR PDP-8 | |
4439 | CLL RAR | |
4440 | DCA I GHDR /STORE A WORD - BLOCKS | |
4441 | TAD GHDR /UPDATE POINTER TO NEXT | |
4442 | TAD (4 | |
4443 | JMP GCCB1 | |
4444 | / | |
4445 | GCCB2, DCA GETSWX /BE SURE SWITCH STAYS CLEAR | |
4446 | TAD I SEGNI /GET -# SEGMENTS | |
4447 | GCCCDF, CDF CIF 0 | |
4448 | JMP I GCCB /OK, RETURN VALUE | |
4449 | ||
4450 | GHDR, 0 /GET HEADER BLOCK (FORTRAN IV) | |
4451 | TAD (3 /TO SET UP CCBB+6 | |
4452 | JMS CCBHDR /DO COMMON TEST & READ-IN | |
4453 | TAD (-2 /1ST WORD MUST BE EXACTLY 2 | |
4454 | SZA CLA | |
4455 | JMP HDRERR / NO, CAN'T BE A HEADER | |
4456 | ISZ GETSWX /1ST TIME THRU SINCE READ? | |
4457 | JMP GHDR1 / NO, DON'T CHANGE ANYTHING | |
4458 | DCA I (CCBB+47 /YES, BE SURE THESE WORDS | |
4459 | DCA I (CCBB+50 / ARE 0 FOR USERS | |
4460 | TAD I (CCBB+1 /GET START FIELD WORD | |
4461 | SNA | |
4462 | JMP HDRERR / SHOULD BE 1 THRU 7 | |
4463 | CLL RTL /LOOKS OK, MOVE FIELD TO BITS | |
4464 | RAL / 6-8 TO HELP "SHOW HEAD" | |
4465 | DCA I (CCBB+1 | |
4466 | TAD I (CCBB+1 /ARE THESE ONLY BITS SET? | |
4467 | AND (7707 | |
4468 | SZA CLA | |
4469 | JMP HDRERR / NO, SOMETHING MUST BE BAD | |
4470 | TAD I (CCBB+3 /OK, TEST FIELD OF NEXT FREE | |
4471 | SNA | |
4472 | JMP HDRERR / SHOULD BE 1 THRU 7 | |
4473 | AND (7770 | |
4474 | SZA CLA | |
4475 | HDRERR, JMS ERROR1 | |
4476 | GHDR1, DCA GETSWX /MAKE SURE THIS IS 0 | |
4477 | CMA /AC NON-ZERO FOR OK | |
4478 | CDF CIF 0 | |
4479 | JMP I GHDR /OK, BACK TO USER | |
4480 | ||
4481 | CCBHDR, 0 | |
4482 | TAD (CCBB+3 /CCBB+6 FOR GHDR | |
4483 | CDF 0 | |
4484 | DCA I (GETPNT /SET UP POINTER FOR 'GET' | |
4485 | TAD I (DEVAD /GET ADDR OF DEVICE | |
4486 | DCA DEVADX / HANDLER & SAVE HERE | |
4487 | TAD I (RBLK1 /GET START BLOCK NUMBER | |
4488 | SNA | |
4489 | ERCF, JMS ERROR1 / NO FILE!!! GIVE ERROR | |
4490 | CDF 10 | |
4491 | DCA GCCBLK /OK, SET UP 1ST BLOCK | |
4492 | TAD I SEGNI /IS SOMETHING IN MEMORY? | |
4493 | SZA | |
4494 | JMP I CCBHDR / YES, RETURN 1ST WORD | |
4495 | CIF 0 | |
4496 | JMS I DEVADX /NO, READ 1ST BLOCK OF FILE | |
4497 | 0110 /READ; 1 PAGE; FIELD 1 | |
4498 | SEGNI, CCBB /BUFFER IS HERE | |
4499 | GCCBLK, 0 /BLOCK NUMBER | |
4500 | JMP RDERX /...BAD NEWS... | |
4501 | STA | |
4502 | DCA GETSWX /OK, SET "JUST READ" SWITCH | |
4503 | TAD I SEGNI /AND GET 1ST WORD | |
4504 | JMP I CCBHDR | |
4505 | / | |
4506 | RDERX, CDF CIF 0 /RETURN TO FIELD 0 | |
4507 | JMP I (RERROR / FOR READ ERROR | |
4508 | ||
4509 | DEVADX, 0 | |
4510 | GETSWX, 0 | |
4511 | ||
4512 | ||
4513 | MSMOD, TEXT " MOD" | |
4514 | ||
4515 | MSBAD, TEXT " BAD BLOCK" | |
4516 | ||
4517 | ||
4518 | PAGE | |
4519 | \f/CONTINUATION OF OUTPUT COMMANDS AND ROUTINES FROM FIELD 0 | |
4520 | ||
4521 | /CONTINUATION OF 'SET' 'DDEV' HANDLER | |
4522 | ||
4523 | XDDEV1, DCA DDEVAD /SET UP HANDLER ADDRESS | |
4524 | TAD I (GDEV2 | |
4525 | DCA DDEVNO / AND DEVICE NUMBER | |
4526 | CDF 10 | |
4527 | TAD DDEVNO /LOOK AT DCW FOR SPECIFIED | |
4528 | TAD (7760-1 / DEVICE TO SEE IF FILE | |
4529 | DCA DDCWPT / STRUCTURED. | |
4530 | TAD I DDCWPT /BIT 0 = 1 FOR FILES | |
4531 | SMA CLA | |
4532 | TAD (212 / NO, LINE-AT-A-TIME | |
4533 | DCA DDEVS / YES, BLOCK-AT-A-TIME | |
4534 | TAD DMPADR /OK, INITIALIZE OUTPUT POINTER | |
4535 | DCA DMPPTR | |
4536 | DCA XOSIZ / AND ZERO BLOCK COUNTER | |
4537 | DCA DNAM / AND CLEAR ANY FILE NAME | |
4538 | IAC | |
4539 | DCA DMPBLK / AND SET BLOCK NUMBER TO 1 | |
4540 | JMP XDDEV2 /LAST, GO SET UP NAME FOR OUTPUT | |
4541 | ||
4542 | ||
4543 | /CONTINUATION OF EXECUTION OF 'OPEN' COMMAND | |
4544 | ||
4545 | XOPEN1, TAD (NAM1-1 /SET UP POINTER TO FIELD 0 FILE | |
4546 | DCA DPNT / NAME (NOTE: XR IN FIELD 1!!!) | |
4547 | TAD I DPNT /MOVE THE FILE NAME UP HERE | |
4548 | DCA DNAM | |
4549 | TAD I DPNT | |
4550 | DCA DNAM+1 | |
4551 | TAD I DPNT | |
4552 | DCA DNAM+2 | |
4553 | TAD I DPNT /GET THE EXTENSION PART | |
4554 | ISZ I (TEMP1 / WAS ANYTHING REALLY SPECIFIED? | |
4555 | JMP XOPEN2 | |
4556 | CLA | |
4557 | TAD (0425 / NO, DEFAULT TO ".DU" | |
4558 | XOPEN2, DCA DNAM+3 | |
4559 | TAD XCLNAM /SET UP POINTER TO NAME FOR USR | |
4560 | DCA XOBLK | |
4561 | CDF 10 /SET UP RETURN FIELD | |
4562 | TAD I DDCWPT /CLEAR ANY OPEN FILE ON | |
4563 | AND (7770 / THIS DEVICE SO "OPEN" | |
4564 | DCA I DDCWPT / CAN BE DONE WHENEVER! | |
4565 | CIF 0 /SET UP SUBROUTINE FIELD | |
4566 | TAD DDEVNO /GET DUMP DEVICE NUMBER | |
4567 | JMS USEUSR / AND GO GET USR & CALL IT. | |
4568 | 3 /ENTER | |
4569 | XOBLK, 0 /NAME POINTER, BECOMES START BLK | |
4570 | XOSIZ, 0 / BECOMES -# BLOCKS CAN USE | |
4571 | ERC18, JMS ERROR1 /THE ENTER FAILED! | |
4572 | TAD XOBLK /OK! SET UP FILE START BLOCK | |
4573 | DCA DMPBLK | |
4574 | TAD DMPADR /INITIALIZE POINTER | |
4575 | DCA DMPPTR | |
4576 | XOCEX, CDF CIF 0 | |
4577 | JMP MAIN1 /TRY NEXT COMMAND | |
4578 | ||
4579 | DDEVAD, 7607 /INIT ADDRESS TO "SYS:" (SEE ABOVE) | |
4580 | DDEVNO, 1 /INIT THIS TO "SYS:" ALSO. | |
4581 | DDCWPT, 7760 / THIS ALSO | |
4582 | ||
4583 | DNAM, 0 /DUMP FILE NAME, INIT TO NULL | |
4584 | 0 | |
4585 | 0 | |
4586 | 0 /(EXTENSION HERE) | |
4587 | ||
4588 | ||
4589 | /CONTINUATION OF EXECUTION OF 'CLOSE' COMMAND | |
4590 | ||
4591 | XCLOS1, TAD DNAM /IS ANY FILE OPEN? | |
4592 | SNA CLA | |
4593 | JMP XOCEX / NO, IGNORE COMMAND | |
4594 | TAD XCTLZ / YES, OUTPUT A CTRL-Z | |
4595 | JMS DMPOUT / AND FILL TO END | |
4596 | XCTLZ, "Z-100 | |
4597 | TAD XOBLK /OK, CALCULATE FILE SIZE | |
4598 | CIA | |
4599 | TAD DMPBLK /= NEXT - START | |
4600 | DCA XCLSIZ /= FILE SIZE IN BLOCKS | |
4601 | TAD DDEVNO /GET DUMP DEVICE NUMBER | |
4602 | CIF 0 | |
4603 | JMS USEUSR /GET USR AND CALL IT | |
4604 | 4 /CLOSE | |
4605 | XCLNAM, DNAM /POINTER TO FILE NAME | |
4606 | XCLSIZ, 0 /SIZE OF NEW FILE | |
4607 | ERC19, JMS ERROR1 /OH NO! CLOSE FAILED! | |
4608 | DCA DNAM /OK, ZAP KNOWLEDGE OF FILE | |
4609 | JMP XOCEX | |
4610 | ||
4611 | ||
4612 | DMPOUT, 0 /DUMP FILE CHARACTER OUTPUT ROUTINE | |
4613 | DCA DMPCHR /SAVE THE CHARACTER | |
4614 | TAD DMPCHR /PUT IT INTO FILE BUFFER | |
4615 | CDF 10 /(MUST BE SURE!) | |
4616 | DMPNUL, DCA I DMPPTR /INSERT AN 8 BIT CHAR | |
4617 | ISZ DMPPTR | |
4618 | TAD DMPPTR /NOW AT END OF BUFFER? | |
4619 | TAD (-DMPBUF-400 | |
4620 | SNA CLA | |
4621 | JMP DMPIT / YES, DUMP BUFFER NOW | |
4622 | TAD DMPCHR /NO, FILL FOLLOWING THIS CHAR? | |
4623 | CIA | |
4624 | TAD I DMPOUT /(THE TEST CHAR @ CALL+1) | |
4625 | SNA CLA | |
4626 | JMP DMPNUL / YES, FILL WITH NULLS! | |
4627 | JMP I DMPOUT / NO, EXECUTE FILL CHAR | |
4628 | / | |
4629 | DMPIT, CIF 0 | |
4630 | JMS I DDEVAD /CALL DUMP FILE HANDLER | |
4631 | 4210 /WRITE, 2 PAGES, FIELD 1 | |
4632 | DMPADR, DMPBUF | |
4633 | DMPBLK, 1 /BLOCK NUMBER | |
4634 | ERC10, JMS ERROR1 /ERROR ON OUTPUT FILE! | |
4635 | TAD DMPADR /NOW RESET OUTPUT POINTER | |
4636 | DCA DMPPTR | |
4637 | ISZ DMPBLK /INCREMENT BLOCK NUMBER | |
4638 | ISZ XOSIZ /ANY MORE SPACE LEFT? | |
4639 | JMP I DMPOUT / YES, EXIT NOW | |
4640 | DCA DNAM / NO! ZAP DUMP FILE | |
4641 | ERC20, JMS ERROR1 / AND DIE! | |
4642 | DMPCHR, 0 | |
4643 | DMPPTR, 0 /CHARACTER OUTPUT POINTER | |
4644 | ||
4645 | ||
4646 | PAGE | |
4647 | \f/CONTINUATION OF ROUTINE TO OUTPUT A CHAR TO A DEVICE | |
4648 | ||
4649 | TYPE1, TAD I (DMODE /TTY= NONE, PART&-DSWIT, ALL | |
4650 | AND I (DSWIT / SO TEST FOR PART&DSWIT | |
4651 | SZA CLA | |
4652 | JMP TYPE2 /NO OUTPUT TO TTY | |
4653 | TAD I (RTL6 /GET CHARACTER TO OUTPUT | |
4654 | TYPEB, NOP /*** CDF 10 /*** BATCH | |
4655 | TSF /*** CIF BAT /*** CHANGES | |
4656 | JMP .-1 /*** JMS I .+1 /*** LOG | |
4657 | TLS /*** 7400 /*** OUTPUT | |
4658 | CLA /*** CDF 0 | |
4659 | TYPE2, STL CLA RAR /=4000 (SET AC BIT 0 FOR TEST) | |
4660 | TAD I (DSWIT /=4000 OR 4001 (DSWIT=1) | |
4661 | AND I (DMODE /FILE= PART&DSWIT OR ALL | |
4662 | SNA CLA | |
4663 | JMP TYPE3 / OUTPUT TO TTY ONLY | |
4664 | TAD DDEVS /FILE STRUCTURED OUTPUT? | |
4665 | CDF 10 | |
4666 | SNA | |
4667 | TAD I (DNAM / YES, FILE OPEN? | |
4668 | CDF 0 | |
4669 | SNA CLA | |
4670 | JMP TYPE3 / NO TO EITHER | |
4671 | TAD I (RTL6 /OK, GET CHARACTER TO OUTPUT | |
4672 | JMS DMPOUT /OUTPUT IT & TEST FOR END | |
4673 | DDEVS, 0 /TEST: 0=FILE, 212= NON-FILE | |
4674 | TYPE3, CDF CIF 0 | |
4675 | JMP TYPEX /BACK AND OUT | |
4676 | ||
4677 | ||
4678 | ERROR1, 0 /FIELD 1 ERROR ROUTINE HEAD | |
4679 | CLA /CLEAR POSSIBLE JUNK IN AC | |
4680 | TAD ERROR1 /MOVE RETURN ADDR TO FIELD 0 | |
4681 | CDF CIF 0 | |
4682 | DCA I (XERROR | |
4683 | JMP I (XERROR+1 | |
4684 | ||
4685 | ||
4686 | XDDEV2, CDF 0 /NAME IS OVER THERE | |
4687 | TAD I (NAM1 /MOVE DEVICE NAME INTO STRING | |
4688 | DCA XDDNAM / IN THIS FIELD FOR "SHOW DDEV" | |
4689 | TAD I (NAM2 | |
4690 | DCA XDDNAM+1 | |
4691 | CDF CIF 0 | |
4692 | JMP XSETN /BACK TO 'SET' | |
4693 | ||
4694 | MSDDEV, TEXT "@DDEV = SYS@" | |
4695 | XDDNAM= .-3 | |
4696 | ||
4697 | MSDEV, TEXT "@DEVICE = SYS@" | |
4698 | ||
4699 | XDNAM= .-3 /ADDR OF 1ST WORD OF DEVICE NAME | |
4700 | ||
4701 | /CONTINUATION OF CODE FROM FIELD 0 | |
4702 | ||
4703 | XDEVM, DCA XDNAM /SET 4 DEVICE NAME CHARS IN | |
4704 | TAD I (NAM2 / OUTPUT MESSAGE | |
4705 | DCA XDNAM+1 | |
4706 | CDF 10 | |
4707 | DCA I (CCBB /NO C.C.B. OR HEADER PRESENT | |
4708 | CDF CIF 0 | |
4709 | STA | |
4710 | DCA I (RBLK /RESET BLOCK NUMBER | |
4711 | JMP XSETN /GO DO NEXT OPTION | |
4712 | ||
4713 | ||
4714 | MSERR, TEXT " ERROR CODES: FUTIL " | |
4715 | *.-1 | |
4716 | ||
4717 | /VERSION NUMBER MESSAGE--THE FOLLOWING CODE INSERTS THE | |
4718 | / VERSION NUMBER AND PATCH LEVEL SET NEAR THE START OF | |
4719 | / THE SOURCE INTO THE VERSION MESSAGE. | |
4720 | ||
4721 | MSVER, TEXT "VERSION = ???" /VERS = 2 DIGITS, PATCH = 1 | |
4722 | *.-2 | |
4723 | VERTEN= VERSION%12 /TENS DIGIT | |
4724 | VERONE= -VERTEN^12+VERSION /ONES DIGIT | |
4725 | VERTEN^100+VERONE+6060 /INSERT TWO DIGITS | |
4726 | PATCH^100 /INSERT PATCH + NULL TERM | |
4727 | ||
4728 | /ALPHA MONTH NAMES PLUS DUMMIES FOR PDATE SUBROUTINE | |
4729 | ||
4730 | MONTHS, TEXT " 00@JAN@FEB@MAR@APR@MAY@JUN@JUL" | |
4731 | TEXT "AUG@SEP@OCT@NOV@DEC@ 13@ 14@ 15" | |
4732 | ||
4733 | ||
4734 | PAGE | |
4735 | \f/SYMBOLICS FOR PDP-8 INSTRUCTIONS: | |
4736 | INSLST, TEXT "AND TAD ISZ DCA JMS JMP IOT NOP " | |
4737 | *.-1 | |
4738 | ||
4739 | / GROUP 1 MICRO-INSTS.: | |
4740 | OP1LST, TEXT "CLL CMA CML IAC BSW RAL RTL RAR RTR " | |
4741 | *.-1 | |
4742 | ||
4743 | ||
4744 | / GROUP 2 MICRO-INST'S: | |
4745 | OP2LST, TEXT "SMA SZA SNL SKP SPA SNA SZL OSR HLT " | |
4746 | *.-1 | |
4747 | ||
4748 | / EAE MICRO-INST'S: | |
4749 | EAELST, TEXT "MQA MQL SCL MUY DVI NMI SHL ASR LSR SCA " | |
4750 | *.-1 | |
4751 | TEXT "DAD DST SWBADPSZDPICDCM SAM " | |
4752 | *.-1 | |
4753 | ||
4754 | CLANAM, 0314 /"CLA " | |
4755 | 0140 | |
4756 | ||
4757 | OPRMES, 1720 /"OPR " | |
4758 | 2240 | |
4759 | \f/ IOT INSTRUCTIONS: | |
4760 | ||
4761 | IOTTAB, 6000 | |
4762 | TEXT "SKON" | |
4763 | 6001 | |
4764 | TEXT "ION@" | |
4765 | 6002 | |
4766 | TEXT "IOF@" | |
4767 | 6003 | |
4768 | TEXT "SRQ@" | |
4769 | 6004 | |
4770 | TEXT "GTF@" | |
4771 | 6005 | |
4772 | TEXT "RTF@" | |
4773 | 6006 | |
4774 | TEXT "SGT@" | |
4775 | 6007 | |
4776 | TEXT "CAF@" | |
4777 | 6010 | |
4778 | TEXT "RPE@" | |
4779 | 6011 | |
4780 | TEXT "RSF@" | |
4781 | 6012 | |
4782 | TEXT "RRB@" | |
4783 | 6014 | |
4784 | TEXT "RCF@" | |
4785 | 6016 | |
4786 | TEXT "RCC@" | |
4787 | 6020 | |
4788 | TEXT "PCE@" | |
4789 | 6021 | |
4790 | TEXT "PSF@" | |
4791 | 6022 | |
4792 | TEXT "PCF@" | |
4793 | 6024 | |
4794 | TEXT "PPC@" | |
4795 | 6026 | |
4796 | TEXT "PLS@" | |
4797 | 6030 | |
4798 | TEXT "KCF@" | |
4799 | 6031 | |
4800 | TEXT "KSF@" | |
4801 | 6032 | |
4802 | TEXT "KCC@" | |
4803 | 6034 | |
4804 | TEXT "KRS@" | |
4805 | 6035 | |
4806 | TEXT "KIE@" | |
4807 | 6036 | |
4808 | TEXT "KRB@" | |
4809 | 6040 | |
4810 | TEXT "TFL@" | |
4811 | 6041 | |
4812 | TEXT "TSF@" | |
4813 | 6042 | |
4814 | TEXT "TCF@" | |
4815 | 6044 | |
4816 | TEXT "TPC@" | |
4817 | 6045 | |
4818 | TEXT "TSK@" | |
4819 | 6046 | |
4820 | TEXT "TLS@" | |
4821 | 6100 | |
4822 | TEXT "DPI@" | |
4823 | 6101 | |
4824 | TEXT "SMP@" | |
4825 | 6102 | |
4826 | TEXT "SPL@" | |
4827 | 6103 | |
4828 | TEXT "EPI@" | |
4829 | 6104 | |
4830 | TEXT "CMP@" | |
4831 | 6105 | |
4832 | TEXT "S,CMP" | |
4833 | 6106 | |
4834 | TEXT "CEP@" | |
4835 | 6107 | |
4836 | TEXT "SPO@" | |
4837 | 6110 | |
4838 | TEXT "RCTV" | |
4839 | 6111 | |
4840 | TEXT "RCRL" | |
4841 | 6112 | |
4842 | TEXT "RCRH" | |
4843 | 6113 | |
4844 | TEXT "RCCV" | |
4845 | 6114 | |
4846 | TEXT "RCGB" | |
4847 | 6115 | |
4848 | TEXT "RCLC" | |
4849 | 6116 | |
4850 | TEXT "RCCB" | |
4851 | 6130 | |
4852 | TEXT "CLZE" | |
4853 | 6131 | |
4854 | TEXT "CLSK" | |
4855 | 6132 | |
4856 | TEXT "CLOE" | |
4857 | 6133 | |
4858 | TEXT "CLAB" | |
4859 | 6134 | |
4860 | TEXT "CLEN" | |
4861 | 6135 | |
4862 | TEXT "CLSA" | |
4863 | 6136 | |
4864 | TEXT "CLBA" | |
4865 | 6137 | |
4866 | TEXT "CLCA" | |
4867 | 6201 | |
4868 | TEXT "CDF 00" | |
4869 | *.-1 | |
4870 | 6211 | |
4871 | TEXT "CDF 10" | |
4872 | *.-1 | |
4873 | 6221 | |
4874 | TEXT "CDF 20" | |
4875 | *.-1 | |
4876 | 6231 | |
4877 | TEXT "CDF 30" | |
4878 | *.-1 | |
4879 | 6241 | |
4880 | TEXT "CDF 40" | |
4881 | *.-1 | |
4882 | 6251 | |
4883 | TEXT "CDF 50" | |
4884 | *.-1 | |
4885 | 6261 | |
4886 | TEXT "CDF 60" | |
4887 | *.-1 | |
4888 | 6271 | |
4889 | TEXT "CDF 70" | |
4890 | *.-1 | |
4891 | 6202 | |
4892 | TEXT "CIF 00" | |
4893 | *.-1 | |
4894 | 6212 | |
4895 | TEXT "CIF 10" | |
4896 | *.-1 | |
4897 | 6222 | |
4898 | TEXT "CIF 20" | |
4899 | *.-1 | |
4900 | 6232 | |
4901 | TEXT "CIF 30" | |
4902 | *.-1 | |
4903 | 6242 | |
4904 | TEXT "CIF 40" | |
4905 | *.-1 | |
4906 | 6252 | |
4907 | TEXT "CIF 50" | |
4908 | *.-1 | |
4909 | 6262 | |
4910 | TEXT "CIF 60" | |
4911 | *.-1 | |
4912 | 6272 | |
4913 | TEXT "CIF 70" | |
4914 | *.-1 | |
4915 | 6203 | |
4916 | TEXT "CDIF00" | |
4917 | *.-1 | |
4918 | 6213 | |
4919 | TEXT "CDIF10" | |
4920 | *.-1 | |
4921 | 6223 | |
4922 | TEXT "CDIF20" | |
4923 | *.-1 | |
4924 | 6233 | |
4925 | TEXT "CDIF30" | |
4926 | *.-1 | |
4927 | 6243 | |
4928 | TEXT "CDIF40" | |
4929 | *.-1 | |
4930 | 6253 | |
4931 | TEXT "CDIF50" | |
4932 | *.-1 | |
4933 | 6263 | |
4934 | TEXT "CDIF60" | |
4935 | *.-1 | |
4936 | 6273 | |
4937 | TEXT "CDIF70" | |
4938 | *.-1 | |
4939 | 6204 | |
4940 | TEXT "CINT" | |
4941 | 6214 | |
4942 | TEXT "RDF@" | |
4943 | 6224 | |
4944 | TEXT "RIF@" | |
4945 | 6234 | |
4946 | TEXT "RIB@" | |
4947 | 6244 | |
4948 | TEXT "RMF@" | |
4949 | 6254 | |
4950 | TEXT "SINT" | |
4951 | 6264 | |
4952 | TEXT "CUF@" | |
4953 | 6274 | |
4954 | TEXT "SUF@" | |
4955 | 6550 | |
4956 | TEXT "FFST" | |
4957 | 6551 | |
4958 | TEXT "FPINT" | |
4959 | 6552 | |
4960 | TEXT "FPICL" | |
4961 | 6553 | |
4962 | TEXT "FPCOM" | |
4963 | 6554 | |
4964 | TEXT "FPHLT" | |
4965 | 6555 | |
4966 | TEXT "FPST" | |
4967 | 6556 | |
4968 | TEXT "FPRST" | |
4969 | 6557 | |
4970 | TEXT "FPIST" | |
4971 | 6561 | |
4972 | TEXT "FMODE" | |
4973 | 6563 | |
4974 | TEXT "FMRB" | |
4975 | 6564 | |
4976 | TEXT "FMRP" | |
4977 | 6565 | |
4978 | TEXT "FMDO" | |
4979 | 6567 | |
4980 | TEXT "FPEP" | |
4981 | ||
4982 | ||
4983 | NXTIOT, ZBLOCK 200 /LEAVE ROOM FOR EXPANSION | |
4984 | ||
4985 | 0 /TABLE TERMINATOR | |
4986 | ||
4987 | ||
4988 | /CODES MAY BE ADDED TO THE TABLE IN THE SPACE LEFT BY THE | |
4989 | / "ZBLOCK 200". SINCE EACH ENTRY REQUIRES 4 WORDS (THE | |
4990 | / ACTUAL CODE IN THE FIRST WORD AND UP TO 6 PACKED ASCII | |
4991 | / CHARACTERS IN THE NEXT THREE WORDS, PADDED WITH TRAIL- | |
4992 | / ING 0'S), THERE IS ROOM FOR 40 OCTAL (32 DECIMAL) IOTS | |
4993 | / AND THEIR NAMES. THESE CAN BE PATCHED IN DIRECTLY | |
4994 | / USING THE PROGRAM ITSELF. **** NOTE THAT THE CONTENTS | |
4995 | / OF LOCATION 10000 POINT TO THE FIRST FREE ENTRY. **** | |
4996 | \f/SYMBOLICS FOR FPP-12/8A INSTRUCTIONS | |
4997 | ||
4998 | MSBASE, TEXT " B+" | |
4999 | ||
5000 | MSINDI, TEXT "% B+" | |
5001 | ||
5002 | MSJNX, TEXT "JNX " | |
5003 | ||
5004 | /THE FOLLOWING STRINGS ARE PADDED WITH "@"S IN PROPER | |
5005 | / PLACES TO FORCE WORD ALIGNMENT AS NEEDED. | |
5006 | ||
5007 | TEXT "LEA@" /+1 WORD 0000 | |
5008 | FPPINS, TEXT "FLDA@@FADD@@FSUB@@FDIV" | |
5009 | TEXT "FMUL@@FADDM@FSTA@@FMULM" | |
5010 | ||
5011 | TEXT "UNUSEDSTARTE" | |
5012 | *.-1 | |
5013 | FPOP00, TEXT "FNOP@@FEXIT@FPAUSEFCLA@@FNEG" | |
5014 | TEXT "FNORM@STARTFSTARTDJAC@@" | |
5015 | ||
5016 | FPXR1S, TEXT "ALN ATX XTA " | |
5017 | ||
5018 | FPXR2S, TEXT "ADDX *,@LDX *,@" | |
5019 | ||
5020 | FOP134, TEXT "TRAP4 TRAP3 SETX SETB JSA @JSR " | |
5021 | ||
5022 | FPCOND, TEXT "EQGELEA@NELTGTAL" | |
5023 | ||
5024 | ||
5025 | /CONTROL TABLES FOR FPP INSTRUCTION DECODING | |
5026 | ||
5027 | FPPMO0, 7 /MAJOR SUB-OP-CODE OF SPECIALS | |
5028 | 6 | |
5029 | 5 | |
5030 | 4 | |
5031 | 3 | |
5032 | 2 | |
5033 | 1 | |
5034 | 0 /END & FALL-OUT POINT | |
5035 | ||
5036 | FPPMOJ, SPCOP7 | |
5037 | SPCOP6 | |
5038 | SPCOP5 | |
5039 | SPCOP4 | |
5040 | SPCOP3 | |
5041 | SPCOP2 | |
5042 | SPCOP1 | |
5043 | ||
5044 | FPPOP0, 170 /MINOR SUB-OP-CODE OF SUB-OP-CODE | |
5045 | 160 / 0 SPECIALS | |
5046 | 150 | |
5047 | 140 | |
5048 | 130 | |
5049 | 120 | |
5050 | 110 | |
5051 | 100 | |
5052 | 70 | |
5053 | 60 | |
5054 | 50 | |
5055 | 40 | |
5056 | 30 | |
5057 | 20 | |
5058 | 10 | |
5059 | 00 | |
5060 | ||
5061 | FPPOPJ, SPNUSE /ALL UNUSED POSSIBILITIES | |
5062 | SPNUSE | |
5063 | SPNUSE | |
5064 | SPNUSE | |
5065 | SPNUSE | |
5066 | SPNUSE | |
5067 | SPOP11 | |
5068 | SPOP10 | |
5069 | SPNUSE | |
5070 | SPNUSE | |
5071 | SPOP05 | |
5072 | SPOP04 | |
5073 | SPO123 | |
5074 | SPO123 | |
5075 | SPO123 | |
5076 | \f/MESSAGES: | |
5077 | ||
5078 | MS01, TEXT " = " | |
5079 | ||
5080 | MS07, 0023 /"SMASK = " | |
5081 | MS02, TEXT "MASK = " | |
5082 | ||
5083 | MS03, TEXT "ABS. LOC = " | |
5084 | ||
5085 | MS04, TEXT "UPPER = " | |
5086 | ||
5087 | MS05, TEXT "LOWER = " | |
5088 | ||
5089 | MS06, TEXT "FORMAT = " | |
5090 | ||
5091 | MS08, TEXT "DIRECTORY" | |
5092 | ||
5093 | MS09, TEXT "OFFSET = " | |
5094 | ||
5095 | MS10, TEXT "MODE = " | |
5096 | ||
5097 | MS11, TEXT "CCB:" | |
5098 | ||
5099 | MS12, TEXT "ODT LOC = " | |
5100 | ||
5101 | MS13, TEXT ": " | |
5102 | ||
5103 | MS14, TEXT " CORE SEGS: " | |
5104 | ||
5105 | MS15, TEXT "LOOKUP FAILED" | |
5106 | ||
5107 | MS16, TEXT "FPP" | |
5108 | ||
5109 | MS17, TEXT " AT " | |
5110 | ||
5111 | MS18, TEXT " SA = " | |
5112 | ||
5113 | MS19, TEXT ", JSW = " | |
5114 | ||
5115 | MS20, TEXT "REL. LOC = " | |
5116 | ||
5117 | MS21, TEXT "PACKED" | |
5118 | ||
5119 | MS22, TEXT "ASCII" | |
5120 | ||
5121 | MS23, TEXT "OS/8" | |
5122 | ||
5123 | MS24, 2516 /"UNSIGNED" | |
5124 | ||
5125 | MS25, TEXT "SIGNED" | |
5126 | ||
5127 | MS26, TEXT "OCTAL" | |
5128 | ||
5129 | MS27, TEXT "OFFSET" | |
5130 | ||
5131 | MS28, TEXT "SAVE" | |
5132 | ||
5133 | MS29, TEXT "NORMAL" | |
5134 | ||
5135 | MS30, TEXT "OUTPUT = " | |
5136 | ||
5137 | MS31, TEXT "PDP" | |
5138 | ||
5139 | MS32, TEXT "BLOCK = " | |
5140 | ||
5141 | MS33, TEXT ") " | |
5142 | ||
5143 | MS34, TEXT "LOAD" | |
5144 | ||
5145 | MS35, TEXT "BCD" | |
5146 | ||
5147 | MS36, TEXT "BYTE" | |
5148 | ||
5149 | MS37, TEXT "FILLER = " | |
5150 | ||
5151 | MS38, TEXT "HEADER:" | |
5152 | ||
5153 | MS39, TEXT ", NEXT WORD = " | |
5154 | ||
5155 | MS40, TEXT ", LOAD V " | |
5156 | ||
5157 | MS41, TEXT ", E.P. REQ'D" | |
5158 | ||
5159 | MS42, TEXT " OVLYS START BLOCK LENGTH" | |
5160 | ||
5161 | MS43, TEXT "XS240" | |
5162 | \f/MAIN LOOP CHARACTER LIST | |
5163 | CCHARL, "# | |
5164 | "$ | |
5165 | "% | |
5166 | "& | |
5167 | ": | |
5168 | "< | |
5169 | "= | |
5170 | "> | |
5171 | "? | |
5172 | "@ | |
5173 | "[ | |
5174 | "\ | |
5175 | "] | |
5176 | "/ | |
5177 | "! | |
5178 | "+ | |
5179 | "- | |
5180 | "; | |
5181 | "^ | |
5182 | "_ | |
5183 | /'TYPE' COMMAND LIST | |
5184 | TYPEL, 211 /TAB | |
5185 | 233 /ALT MODES | |
5186 | 375 | |
5187 | 376 | |
5188 | /'XMODIF' CHECK LIST | |
5189 | TYPEM, 215 /CR | |
5190 | 212 /LF | |
5191 | 0 | |
5192 | ||
5193 | /ADDRESSES FOR 'OMODES' | |
5194 | OTABLE, BPRT /# | |
5195 | OSTYPE /$ | |
5196 | BYTEO /% | |
5197 | XS240O /& | |
5198 | SGNDP /: | |
5199 | OPRT /< | |
5200 | DPRT /= | |
5201 | PDPOUT /> | |
5202 | DIROUT /? | |
5203 | PDATE /@ | |
5204 | ASCII /[ | |
5205 | FPPOUT /\ | |
5206 | PACOUT /] | |
5207 | ||
5208 | /MAIN LOOP JUMP LIST - RESPOND TO SPECIAL CHAR | |
5209 | COPSL, OMODES | |
5210 | OMODES | |
5211 | OMODES | |
5212 | OMODES | |
5213 | OMODES | |
5214 | OMODES | |
5215 | OMODES /SEE ABOVE LIST | |
5216 | OMODES | |
5217 | OMODES | |
5218 | OMODES | |
5219 | OMODES | |
5220 | OMODES | |
5221 | OMODES | |
5222 | SLASH | |
5223 | EXCL | |
5224 | PLUS | |
5225 | MINUS | |
5226 | SEMIC | |
5227 | UPARR | |
5228 | BACKAR | |
5229 | RESPC | |
5230 | ALTMOD | |
5231 | ALTMOD | |
5232 | ALTMOD | |
5233 | CRCR | |
5234 | LFLF | |
5235 | ||
5236 | /'TYPE' JUMP LIST | |
5237 | TYPEOP, TYPTAB | |
5238 | TYPALT | |
5239 | TYPALT | |
5240 | TYPALT | |
5241 | TYPCR | |
5242 | TYPCR+1 | |
5243 | ||
5244 | /COMMAND WORD LIST FOR COMMANDS NOT FOLLOWED BY CR | |
5245 | CWORDL, TEXT "EVE@DUD@LIL@FIF@OPSCSTSMWOW@MOM@SHSES@WRIFEXCOC@" | |
5246 | ||
5247 | /MAIN LOOP JUMP LIST - EXECUTE A COMMAND | |
5248 | WOPSL, XVAL | |
5249 | XVAL | |
5250 | XDUMP | |
5251 | XDUMP | |
5252 | XLIST0 | |
5253 | XLIST0 | |
5254 | XFILE | |
5255 | XFILE | |
5256 | XOPEN | |
5257 | XSCAN | |
5258 | XSTRIN | |
5259 | XSMASK | |
5260 | XWORD | |
5261 | XWORD | |
5262 | XMODIF | |
5263 | XMODIF | |
5264 | XSHOW | |
5265 | XSET | |
5266 | XSET | |
5267 | XWRARG | |
5268 | XIF | |
5269 | XEXIT | |
5270 | MAIN1 /COMMENT | |
5271 | MAIN1 | |
5272 | ||
5273 | /LISTS FOR COMMANDS FOLLOWED BY A CR. | |
5274 | CWORL2, TEXT "REWRENEXCLCOC@" | |
5275 | ||
5276 | WOPSLL, XREWIN /REWIND | |
5277 | XWRITE /WRITE | |
5278 | MAIN1 /END | |
5279 | XEXIT /EXIT | |
5280 | XCLOSE /CLOSE | |
5281 | MAIN1 /COMMENT | |
5282 | MAIN1 | |
5283 | \f/'XFORM' LISTS ----ORDER IS CRITICAL---- | |
5284 | FORML, TEXT "PAP@ASA@OSOSXSX@UNU@SIS@OCO@BCB@BYBYPDPDFPF@DID@" | |
5285 | ||
5286 | FOPSL, XFCHR /PACKED (ASCII) | |
5287 | XFCHR | |
5288 | XFCHR /ASCII | |
5289 | XFCHR | |
5290 | XFCHR /OS/8 (ASCII, PACKED) | |
5291 | XFCHR | |
5292 | XFCHR /XS240 (ASCII, PACKED) | |
5293 | XFCHR | |
5294 | XFNUM /UNSIGNED (DECIMAL) | |
5295 | XFNUM | |
5296 | XFNUM /SIGNED (DECIMAL) | |
5297 | XFNUM | |
5298 | XFNUM /OCTAL | |
5299 | XFNUM | |
5300 | XFNUM /BCD | |
5301 | XFNUM | |
5302 | XFNUM /BYTE (OCTAL) | |
5303 | XFNUM | |
5304 | XFSYM /PDP (SYMBOLIC) | |
5305 | XFSYM | |
5306 | XFSYM /FPP (SYMBOLIC) | |
5307 | XFSYM | |
5308 | XFSYM /DIRECTORY | |
5309 | XFSYM | |
5310 | ||
5311 | / ROUTINE ADDRESS LIST | |
5312 | ||
5313 | FTABLE, PACOUT | |
5314 | ASCII | |
5315 | OSTYPE | |
5316 | XS240O | |
5317 | DPRT | |
5318 | SGNDP | |
5319 | OPRT | |
5320 | BPRT | |
5321 | BYTEO | |
5322 | PDPDMP | |
5323 | FPPDMP | |
5324 | DIRDMP | |
5325 | ||
5326 | /'XSHFMT' DESCRIPTOR ADDRESS LIST | |
5327 | FMTLS, MS21 /PACKED ASCII | |
5328 | MS22 /ASCII | |
5329 | MS23 /OS/8 ASCII | |
5330 | MS43 /XS240 ASCII | |
5331 | MS24 /UNSIGNED DECIMAL | |
5332 | MS25 /SIGNED DECIMAL | |
5333 | MS26 /OCTAL | |
5334 | MS35 /BCD | |
5335 | MS36 /BYTE | |
5336 | MS31 /PDP SYMBOLIC | |
5337 | MS16 /FPP SYMBOLIC | |
5338 | MS08 /DIRECTORY | |
5339 | ||
5340 | ||
5341 | /'XMODIF' COMMAND LIST | |
5342 | MODIFL, TEXT "PAP@ASA@OSXSNUN@" | |
5343 | ||
5344 | /'XMODIF' JUMP LIST | |
5345 | MODIFO, XPAC0 /PACKED | |
5346 | XPAC0 | |
5347 | XASC1 /ASCII | |
5348 | XASC1 | |
5349 | XOPS1 /OS/8 | |
5350 | XXS20 /XS240 | |
5351 | XNUM2 /NUMERIC | |
5352 | XNUM2 | |
5353 | ||
5354 | MODADS, XMOD0 /MODIFL TEST LIST | |
5355 | XMOD0 | |
5356 | XMOD0 | |
5357 | XMOD0 | |
5358 | XMOD0 | |
5359 | XMOD0 | |
5360 | XMOD0 | |
5361 | XMOD0 | |
5362 | XMOD0 | |
5363 | ||
5364 | MODDLS, TEXT "PAASOSXSNUNUNUNUNUNUNUNU" /DEFAULT LIST | |
5365 | ||
5366 | /'XMODIF' CHARACTER JUMP LIST | |
5367 | MCHARO, XMODCR /CR, END | |
5368 | RENEXT /LF, IGNORE | |
5369 | ||
5370 | /'XIF' CHARACTER JUMP LIST | |
5371 | IFSKPO, XIFCR /CR, END OF LINE | |
5372 | RENEXT /LF, IGNORE | |
5373 | ||
5374 | /XNUM JUMP LIST | |
5375 | NUMOPS, XNUM1 /, | |
5376 | ERCQ /: | |
5377 | ERCQ /. | |
5378 | XNUM1+1 /SPACE | |
5379 | XNUM3 /CR | |
5380 | \f/'XSHOW' COMMAND LIST | |
5381 | SHOWL, TEXT "BLB@ODCCC@HEH@ABA@RER@SMVE" | |
5382 | *.-1 | |
5383 | /'XSET' COMMAND LIST | |
5384 | SETLST, TEXT "DDFOF@OUO@ERE@OFUPLOTEDEDMMOFIMAM@ | |
5385 | ||
5386 | /'XSHOW' JUMP LIST | |
5387 | SHOWOP, XSHBLK /BLOCK | |
5388 | XSHBLK | |
5389 | XSHODL /ODT LOC | |
5390 | XSHCCB /CCB (CORE CONTROL BLOCK) | |
5391 | XSHCCB | |
5392 | XSHHDR /HEADER (F4 LOAD MODULE) | |
5393 | XSHHDR | |
5394 | XSHABS /ABS. LOC | |
5395 | XSHABS | |
5396 | XSHREL /REL. LOC | |
5397 | XSHREL | |
5398 | XSHSMS /SMASK | |
5399 | XSHVER /VERSION | |
5400 | XSHDDEV /DDEV | |
5401 | XSHFMT /FORMAT | |
5402 | XSHFMT | |
5403 | XSHOUT /OUTPUT | |
5404 | XSHOUT | |
5405 | XSHERR /ERRORS | |
5406 | XSHERR | |
5407 | XSHOFF /OFFSET | |
5408 | XSHUPP /UPPER | |
5409 | XSHLOW /LOWER | |
5410 | ERCG /TEMP--NOT ALLOWED FOR SHOW | |
5411 | XSHDEV /DEVICE | |
5412 | ERCG /DMODE--NOT ALLOWED FOR SHOW | |
5413 | XSHMOD /MODE | |
5414 | XSHFIL /FILLER | |
5415 | XSHMSK /MASK | |
5416 | XSHMSK | |
5417 | ||
5418 | /'XSET' JUMP LIST | |
5419 | SETJMP, XDDEV /DDEV (DUMP DEVICE) | |
5420 | XFORM /FORMAT | |
5421 | XFORM | |
5422 | XOUTS /OUTPUT | |
5423 | XOUTS | |
5424 | XEMODE /ERROR (MODE) | |
5425 | XEMODE | |
5426 | XOFFS /OFFSET | |
5427 | XUPP /UPPER | |
5428 | XLOW /LOWER | |
5429 | XTEMP /TEMP | |
5430 | XDEV /DEVICE | |
5431 | XDMODE /DMODE (DUMP MODE) | |
5432 | XMODE /MODE | |
5433 | XFILL /FILLER | |
5434 | XMASK /MASK | |
5435 | XMASK | |
5436 | ||
5437 | /'XEMODE' COMMAND LIST | |
5438 | XELST, TEXT "SHS@LOL@" | |
5439 | ||
5440 | /'XEMODE' BRANCH LIST | |
5441 | XEOPS, XEMOD1 /SHORT | |
5442 | XEMOD1 | |
5443 | XEMOD1+1 /LONG | |
5444 | XEMOD1+1 | |
5445 | ||
5446 | /'XOUTS' LISTS | |
5447 | XOLST, TEXT "FPF@PDP@OCO@" | |
5448 | ||
5449 | XOOPS, XOUTS1-1 /FPP SYMBOLIC | |
5450 | XOUTS1-1 | |
5451 | XOUTS1 /PDP SYMBOLIC | |
5452 | XOUTS1 | |
5453 | XOUTS1+1 /OCTAL | |
5454 | XOUTS1+1 | |
5455 | ||
5456 | /'XMODE' COMMAND LIST | |
5457 | MODLST, TEXT "OFO@SAS@LOL@NON@" | |
5458 | ||
5459 | /'XMODE' JUMP LIST | |
5460 | MODOPS, XMODS-1 /OFFSET | |
5461 | XMODS-1 | |
5462 | XMODS+1 /SAVE FILE | |
5463 | XMODS+1 | |
5464 | XMODS /LOAD MODULE | |
5465 | XMODS | |
5466 | XMODS+2 /NORMAL | |
5467 | XMODS+2 | |
5468 | ||
5469 | /'XDMODE' LISTS | |
5470 | XDMLST, TEXT "ALPANO" | |
5471 | ||
5472 | XDMOPS, XDMODS-1 /ALL | |
5473 | XDMODS /PART | |
5474 | XDMODS+1 /NONE | |
5475 | ||
5476 | ||
5477 | /LIST OF DESCRIPTOR ADDRESSES FOR "SHOW MODE" | |
5478 | ||
5479 | MS27 /-1 = "OFFSET" | |
5480 | MODELS, MS29 / 0 = "NORMAL" | |
5481 | MS28 /+1 = "SAVE" | |
5482 | MS34 /+2 = "LOAD" | |
5483 | ||
5484 | ||
5485 | /LIST OF DESCRIPTOR ADDRESSES FOR "SHOW OUTPUT" | |
5486 | ||
5487 | MS16 /-1 = "FPP (SYMBOLIC)" | |
5488 | OUTLS, MS26 / 0 = "OCTAL" | |
5489 | MS31 /+1 = "PDP (SYMBOLIC)" | |
5490 | ||
5491 | ||
5492 | /'XWORD' COMMAND LIST | |
5493 | XWORCL, TEXT "UNU@" | |
5494 | *.-1 | |
5495 | /'XSTRIN' COMMAND LIST | |
5496 | STRLST, TEXT "FRF@TOT@ABA@MAM@ME" | |
5497 | ||
5498 | ||
5499 | /'XWORD' JUMP LIST | |
5500 | XWOROP, XWOR2 /UNEQUAL | |
5501 | XWOR2 | |
5502 | XWSFRM /FROM | |
5503 | XWSFRM | |
5504 | XWSTO /TO | |
5505 | XWSTO | |
5506 | XWSABS /ABSOLUTE | |
5507 | XWSABS | |
5508 | ERCH /MASKED--NO! | |
5509 | XWOR7 /MEMREF | |
5510 | XWOR7 | |
5511 | ||
5512 | /'XSTRIN' JUMP LIST | |
5513 | STROPS, XWSFRM /FROM | |
5514 | XWSFRM | |
5515 | XWSTO /TO | |
5516 | XWSTO | |
5517 | XWSABS /ABSOLUTE | |
5518 | XWSABS | |
5519 | XSTR0 /MASKED | |
5520 | XSTR0 | |
5521 | ERCH /MEMREF--NO! | |
5522 | \f/LIST OF TERMINATORS, IN ORDER, FOR 'EVAL' | |
5523 | TERMS, "! /1 | |
5524 | "& /2 | |
5525 | "+ /3 | |
5526 | "- /4 | |
5527 | "/ /5 | |
5528 | "* /6 | |
5529 | "( /7 | |
5530 | ") /10 | |
5531 | 215 /CR: 11 | |
5532 | 0 | |
5533 | ||
5534 | /'GWORD' & 'ACCEPT' COMMAND LISTS | |
5535 | GWLST1, "9 | |
5536 | "8 | |
5537 | "7 | |
5538 | "6 | |
5539 | "5 | |
5540 | "4 | |
5541 | "3 | |
5542 | "2 | |
5543 | "1 | |
5544 | "0 | |
5545 | 204 /^D | |
5546 | 213 /^K | |
5547 | "" | |
5548 | "' | |
5549 | "( | |
5550 | GWLST2, 240 /SPACE | |
5551 | 215 /CR | |
5552 | 0 | |
5553 | ||
5554 | /'GWORD' JUMP LISTS | |
5555 | GWOPS1, GWD4 / 9 - A NUMBER | |
5556 | GWD4 / 8 - A NUMBER | |
5557 | GWD4 / 7 - A NUMBER | |
5558 | GWD4 / 6 - A NUMBER | |
5559 | GWD4 / 5 - A NUMBER | |
5560 | GWD4 / 4 - A NUMBER | |
5561 | GWD4 / 3 - A NUMBER | |
5562 | GWD4 / 2 - A NUMBER | |
5563 | GWD4 / 1 - A NUMBER | |
5564 | GWD4 / 0 - A NUMBER | |
5565 | GWD4 /^D - A NUMBER | |
5566 | GWD4 /^K - A NUMBER | |
5567 | GWD4 / " - A NUMBER | |
5568 | GWD4 / ' - A NUMBER | |
5569 | GWD4 / ( - A NUMBER | |
5570 | GWOPS2, GWD2 /SPACE - TERMINATOR | |
5571 | GWD3 / CR - " | |
5572 | ||
5573 | /'ACCEPT' JUMP LIST | |
5574 | ACOPS, ACCNUM / 9 - A DIGIT | |
5575 | ACCNUM / 8 - A DIGIT | |
5576 | ACCNUM / 7 - A DIGIT | |
5577 | ACCNUM / 6 - A DIGIT | |
5578 | ACCNUM / 5 - A DIGIT | |
5579 | ACCNUM / 4 - A DIGIT | |
5580 | ACCNUM / 3 - A DIGIT | |
5581 | ACCNUM / 2 - A DIGIT | |
5582 | ACCNUM / 1 - A DIGIT | |
5583 | ACCNUM / 0 - A DIGIT | |
5584 | CTRLD / ^D SWITCH | |
5585 | CTRLK / ^K SWITCH | |
5586 | DQUOTE / " - SINGLE ASCII | |
5587 | SQUOTE / ' - PACKED ASCII | |
5588 | ERCR / ( - ILLEGAL HERE | |
5589 | ACCPT3-2 /SPACE - END | |
5590 | ACCPT3-1 /CR - END | |
5591 | ||
5592 | /'GARGS' JUMP LIST - TERMINATORS | |
5593 | GAROPS, GAR5 /- | |
5594 | GAR6 /, | |
5595 | ERCS /:, SHOULDN'T SEE, WILL DO ERROR | |
5596 | GAR4 /. | |
5597 | ERCS /SPACE, SHOULDN'T SEE, WILL DO 'ERROR' | |
5598 | GAR3 /CR | |
5599 | ||
5600 | /'GARGS' & 'ARG' COMMAND LISTS | |
5601 | GARLST, "- | |
5602 | ", | |
5603 | GETLST, ": | |
5604 | ARGLST, ". | |
5605 | 240 /SPACE | |
5606 | 215 /CR | |
5607 | 0 | |
5608 | ||
5609 | /'GETNT' LISTS | |
5610 | GETOPS, GETCOL | |
5611 | GETPER | |
5612 | GETEND | |
5613 | GETEND+1 | |
5614 | ||
5615 | /'ARG' JUMP LIST | |
5616 | ARGOPS, ARG2 | |
5617 | ARG3 | |
5618 | ARG3 | |
5619 | ||
5620 | /'WCHEK' LISTS | |
5621 | WCKLST, "( | |
5622 | ") | |
5623 | "" | |
5624 | "' | |
5625 | 215 | |
5626 | 0 | |
5627 | ||
5628 | WCKOPS, WCHEK5+1 | |
5629 | WCHEK5 | |
5630 | WCHEK6+1 | |
5631 | WCHEK6 | |
5632 | WCHEK4 | |
5633 | ||
5634 | /'EVAL' JUMP LIST 1 | |
5635 | EVOPS1, EVNEXT /+ | |
5636 | EVMIN /- | |
5637 | EVLPAR /( | |
5638 | ||
5639 | /'EVAL' COMMAND LISTS | |
5640 | EVLST1, "+ | |
5641 | "- | |
5642 | "( | |
5643 | 0 | |
5644 | ||
5645 | EVLST2, "L | |
5646 | "B | |
5647 | "S | |
5648 | "C | |
5649 | "F | |
5650 | "R | |
5651 | "T | |
5652 | "D | |
5653 | 0 | |
5654 | ||
5655 | /'EVAL' JUMP LIST 2 | |
5656 | EVOPS2, EVLOC /L (LOC) | |
5657 | EVBLK /B (BLK) | |
5658 | EVSR /S (S.R.) | |
5659 | EVSR+1 /C (CONTENTS) | |
5660 | EVFIL /F (FILLER) | |
5661 | EVREM /R (REMAINDER) | |
5662 | EVTEMP /T (TEMP) | |
5663 | EVDATE /D (DATE) | |
5664 | ||
5665 | /ACTION CHARS FOR "READLN" SUBROUTINE | |
5666 | REACTL, "R-100 /CTRL-R = RE-ECHO | |
5667 | "U-100 /CTRL-U = ERASE LINE | |
5668 | 0 | |
5669 | ||
5670 | REACTS, RECHO | |
5671 | RERASE | |
5672 | \f/ERROR ROUTINE ADDRESS LIST: | |
5673 | ||
5674 | ERLIST, ERCA | |
5675 | ERCB | |
5676 | ERCC | |
5677 | ERC14 | |
5678 | ERCD | |
5679 | ERCE | |
5680 | ERCG | |
5681 | ERCH | |
5682 | ERCI | |
5683 | ERCK | |
5684 | ERCJ | |
5685 | XSET1 | |
5686 | ERCL | |
5687 | ERCZ | |
5688 | ERCO | |
5689 | ERC11 | |
5690 | ERC04 | |
5691 | ERCP | |
5692 | ERCQ | |
5693 | ERCR | |
5694 | ERC09 | |
5695 | ERC08 | |
5696 | ERC13 | |
5697 | ERCS | |
5698 | ERCT | |
5699 | ERCU | |
5700 | ERCV | |
5701 | ERCW | |
5702 | ERCX | |
5703 | ERCY | |
5704 | ERCM | |
5705 | ERC00 | |
5706 | ERC01 | |
5707 | ERC02 | |
5708 | ERC03 | |
5709 | ERC10 | |
5710 | ERCF | |
5711 | GCCERR | |
5712 | HDRERR | |
5713 | ERC05 | |
5714 | ERC07 | |
5715 | ERC18 | |
5716 | ERC19 | |
5717 | ERC20 | |
5718 | ERC15 | |
5719 | ERC16 | |
5720 | ERC17 | |
5721 | 0 | |
5722 | ||
5723 | ||
5724 | DECIMAL | |
5725 | ||
5726 | SMASKB, -1 /STRING SEARCH MASK BUFFER | |
5727 | /L(SMASKB)=66(10) | |
5728 | COMB= SMASKB+66 /COMMAND INPUT BUFFER | |
5729 | /L(COMB)= 140(10) | |
5730 | PDLB= COMB+140 /PUSH-DOWN-LIST BUFFER | |
5731 | /**** ALSO REWIND BUFFER! **** | |
5732 | CCBB-PDLB /SHOW PDL SPACE | |
5733 | ||
5734 | OCTAL | |
5735 | ||
5736 | ||
5737 | CCBB= 16400 /CORE-CONTROL-BLOCK BUFFER AND HEADER | |
5738 | / BUFFER FOR LOAD MODULES, 1 PAGE FIELD 1 | |
5739 | ||
5740 | DMPBUF= 16600 /DUMP OUTPUT BUFFER, 2 PAGES FIELD 1 | |
5741 | ||
5742 | IOBUF= 17200 /DEVICE I/O DUFFER, 2 PAGES FIELD 1 | |
5743 | ||
5744 | ||
5745 | $$$$ | |
5746 | \f |