projects / pdp8.git / blame_incremental
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (non-incremental) | history | HEAD
A large commit.
[pdp8.git] / sw / os8 / v3d / sources / extensions / dectapes / dectape1 / futil.pa
... / ...
CommitLineData
1/FUTIL - FILE UTILITY - V07A
2
3VERSION=07
4PATCH="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
92OVLFLG, 0 /OVERLAY FLAG FOR SAVE FILES
93
94DPSGN, 0
95LASTOP, 0
96THISOP, 0
97
98ZBLOCK 3 /USED BY ODT
99
100/VARIABLES & SWITCHES
101PDLPT, 0 /P.D.L. POINTER
102DPNT, RUBO-1 /USED UNIVERSALLY (SCOPE INITIALIZATION)
103SPNT, SCOPLS-1 /USED BY 'XSTRIN', 'XSMASK', 'READ', 'TERMT'
104SCANX1, BATLS-1 /USED BY 'SORTJ' (BATCH INITIALIZATION)
105SCANX2, 0 /USED BY 'XSTRIN'
106GETPNT, 0 /USED BY 'GET' & 'BKLOC'
107COMIR, 0 /USED FOR USER LINE INPUT
108COMOUT, COMB-1 /USED FOR USER LINE SCAN
109TYPSW, 0 /ODT COMMAND OCT-SYM SWITCH (0=OCT)
110ERMODE, 0 /ERROR MESSAGE MODE SWITCH (0=LONG)
111
112TEMP, 0
113TEMP1, 0
114TEMP2, 0
115TEMP3, 0
116ACC1, 0 /24 BIT ACCUMULATORS
117ACC2, 0
118ACCX1, 0
119ACCX2, 0
120
121NAM1= ACC1 /DEFINITIONS FOR NAME BUFFER:
122NAM2= ACC1+1 / THESE LOCATIONS ARE USED FOR A
123NAM3= ACC1+2 / 6 CHARACTER FILE (OR DEVICE)
124NAM4= ACC1+3 / NAME & A 2 CHAR EXTENSION.
125
126OPER1, 0
127OPER2, 0
128
129TEMPV1, 0 /24 BIT TEMPORARY STORAGE FOR
130TEMPV2, 0 / "SET TEMP ..." & "EVAL T"
131
132CHAR, 0
133CNT, 0
134CNTR, 0
135CNTRA, 0
136NCNT, 0 /LINE POSITION COUNTER
137FCNT, 0 /FORMAT NUMBER (INIT TO PACKED ASCII)
138OUTPNT, PACOUT /POINTER TO DEFAULT OUTPUT ROUTINE
139MODSW, 0 /MODES: NORMAL=0,MAPPED=+,OFFSET=-.
140CHARSW, 0 /CHARACTER PACK & UNPACK SWITCH
141CRSWT, 0 /= -1 IF GWORD TERMINATOR WAS A SPACE
142SHUT, 0 /= -1 IF SOMETHING OPEN
143MODIF, 0 /= -1 IF SOMETHING WAS MODIFIED
144ABSSW, 0 /ABSOLUTE OR RELATIVE LOCATION FOR SEARCHES
145DSWIT, 0 /DUMP SWITCH: "DUMP","LIST" & "SHOW ERR" -> 1
146DMODE, 0 /DUMP MODE: NONE=0,PART=1,ALL=4000
147
148CBLK, 0 /= CURRENT BLOCK
149 0 /DUMMY FOR "SHOW ABS"
150CAD, 0 /= CURRENT ADDRESS (0 -> 377)+IOBUF
151BLK, 0 /= "BLOCK"
152LOCH, 0
153LOCL, 0 /= "LOCATION" (DISPLACEMENT)
154UBLK, 0 /UPPER LIMIT FOR SEARCHES
155ULOCH, 1
156ULOCL, 7577
157LBLK, 0 /LOWER LIMIT FOR SEARCHES
158LLOCH, 0
159LLOCL, 200
160SBLK, 0 /"LOCATION" FOR "ODT" ROUTINES
161SLOCH, 0
162SLOCL, 0
163
164OFFSET, 0 /OFFSET
165FILLER, 0 /FILLER CONSTANT FOR "MODIFY"
166MASK, -1 /MASK FOR WORD SEARCH
167SMASKL, -1 /= -(LENGTH OF SMASK)
168RBLK1, 0 /START BLOCK OF FILE
169DEVAD, 7607 /DEVICE ENTRY ADDR (INIT TO "SYS")
170DEVNO, 1 /DEVICE NUMBER (INIT TO "SYS")
171USRAD, 7700 /USR ADDRESS, INITIALIZED TO OUT
172 /7700=MSGS IN; 0=NONE IN; 200=USR IN
173
174/CONSTANTS
175M400, -400
176M240, -240
177M215, -215
178M200, -200
179M100, -100
180M20, -20
181M10, -10
182M1, -1
183N7, 7
184N15, 15
185N20, 20
186N77, 77
187N177, 177
188N200, 200
189N377, 377
190N7000, 7000
191N7400= M400
192
193/ADDRESSES
194READLN= JMS I . /GET NEXT INPUT LINE, WITH
195 READ / SPECIAL TERMINATORS
196TYPSTI, TYPSTR
197TYPSI, TYPES
198TYPECI, TYPEC
199TWOCI, TWOCS
200CRLFI, CRLF
201DIGIT= JMS I . /OUTPUT AN ASCII DIGIT
202 DODIG
203SPACE1= JMS I . /OUTPUT 1 SPACE OR ...
204 DO1SP
205SPACE2= JMS I . /OUTPUT 2 SPACES
206 DO2SP
207CTRLI, CTRL
208TWOT, PACOUT
209TYPEI, TYPE
210DECI, DPRT
211OCTI, OPRT
212DEC2I, DEC2
213PDATEI, PDATE
214RTL6I, RTL6
215RTR6I, RTR6
216SOCTI, OCTSET
217BKLOCI, BKLOC
218EVALI, EVAL
219
220PUSH= JMS I . /PUSH AC ON P.D.L.
221 PUSHX
222POP= JMS I . /POP P.D.L. INTO AC
223 POPX
224CALUSR= JMS I . /DO USR FUNCTION
225 USEUSR
226TADIDP= JMS I . /"TAD I DPNT" IN FIELD 1
227 TIDPNT
228TADICAD= JMS I . /"TAD I CAD" IN FIELD 1
229 TICAD
230DCAICAD= JMS I . /"DCA I CAD" IN FIELD 1
231 DICAD
232
233GWORDI, GWORD
234GARGI, GARGS
235ARGI, ARG
236GETI, GET
237ODGETI, ODGET
238GETNI, GETN
239SSKIPI, SSKIP
240LIMITI, LIMITS
241INCI, INC
242SORTI, SORTJ
243ENDCI, ENDC
244RECRLF, MAIN1-1
245RESTAR, MAIN1
246
247ERROR= JMS I .
248 XERROR
249
250COMST, COMB-1
251TEMPST, TEMPL-1
252MASKBS, SMASKB-1
253
254
255PAGE
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.
263MAIN1, 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
269MAIN2, 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.
276CRCR, 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
285ERCB, ERROR /NOT A LEGAL COMMAND
286/
287CRCR1, JMS I SORTI /"WRITE","REWIND","EXIT" & "COMMENT"
288 CWORL2-1
289 WOPSLL-CWORL2
290ERCA, ERROR /SOMETHING NOT LEGAL
291/
292CRCRN, JMS CLOSE /CLOSE THE OPEN LOCATION IF OPEN
293CRCRC, DCA SHUT / MARK LOCATION CLOSED
294 JMP MAIN1
295
296/ROUTINE TO HANDLE SLASH
297SLASH, 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
302SLA1, SPACE1 /OUTPUT SPACE
303SLO1, JMS ODTOUT /GET THE WORD & OUTPUT
304SLO2, 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
311ALTMOD, 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/
321OMODES, 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,
325ALTM1, 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.
332OMODPT, 0
333
334/ROUTINE TO HANDLE BACKARROW.
335BACKAR, 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.
340UPARR, 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
350UPARR1, DCA SLOCL /THIS IS 12 BIT ADDR
351 JMP EXCL2 /NOW GO FINISH
352\f/ROUTINE TO HANDLE SEMICOLON, LINE FEED & EXCLAMATION.
353
354SEMIC, DCA I READLN-4400 /SET NO-OUTPUT SWITCH
355LFLF, STA /LINE-FEED - CLOSE,INCREMENT,OUTPUT
356EXCL, 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
361EXCL1, 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
376EXCL2, 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.
384PLUS, STA /"+", SET SWITCH
385MINUS, 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
393ECLOSE, 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
400CLOSE, 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
412PAGE
413\f/ROUTINE TO 'EVALUATE' A SIGNED DOUBLE PRECISION ARITHMETIC
414/ EXPRESSION & OUTPUT THE RESULTS IN OCTAL & D.P. SIGNED
415/ DECIMAL.
416XVAL, JMS I EVALI /GO EVALUATE
417 SKP /TERMINATED BY A CR
418ERCC, 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
439DLOOP1, 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
453DLOOP2, 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
463XERROR, 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
472XERR1, 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
480XERR2, 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 ->
488XERR3, 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
496XERR4, JMS I CRLFI /OUTPUT A CR,LF PAIR
497 JMP I .+1 /*** CIF BAT /BATCH OPER.
498 MAIN1 /*** JMP I N7000 /'BATABT'!
499
500
501USEUSR, 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
506UCDF0, 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
515USRIN, CDF CIF 10
516 TAD USEUSR /MOVE RETURN ADDRESS TO THE
517 DCA I N200 / USR ENTRY POINT
518USRCDF, CDF /SET UP D.F. FOR RETURN
519 TAD USRSAV /RESTORE AC CONTENTS
520 JMP I (201 / & FAKE A CALL TO IT
521USRSAV,
522
523USROUT, 0 /SUBROUTINE TO REMOVE USR BY RECALLING
524ERC15, 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"!
539ERC16, ERROR /TELL THE HORRIBLE STORY!
540
541
542PAGE
543\f/ROUTINE TO EXECUTE THE BLOCK 'SCAN' COMMAND
544XSCAN, 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
549XDUMP, TAD MODSW /MAPPED MODE?
550 SMA SZA CLA
551ERC14, ERROR /YES, DUMP IS MEANINGLESS!
552 JMS XDLCOM /DO COMMON STUFF
553 TAD (LLIST / & SET UP FOR DUMPING
554XDUM0, DCA XGFORM /SET OUTPUT ROUTINE--DUMP/SCAN
555XDUM1, 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
561XDUM2, 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
574XLIST0, JMS XDLCOM /DO COMMON STUFF
575XLIS1, 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
585XLIS2, DCA DSWIT /RESET DUMP SWITCH
586 JMP I RECRLF / DO CR/LF & CONTINUE
587
588/COMMON SUBROUTINE FOR 'XDUMP'&'XLIST0'
589XDLCOM, 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
602LLIST, 0
603 DCA CNTRA /SET UP -# WORDS TO LIST
604 DCA CHARSW /RESET UNPACK SWITCH
605LLIS1, 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
619LLIS2, 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
627LLIS3, 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/
633LLIS4, ISZ CNTR /ALL DONE WITH THIS LINE?
634 JMP LLIS2 /NOT YET
635 JMP LLIS1 /YES, OUTPUT CR/LF & CONTINUE
636/
637LLIS5, STA
638 DCA CNTR /FORCE A CR/LF
639 JMP LLIS3
640LISTPT, 0
641LOUTSW, 0
642
643
644/SUBROUTINE TO GET A FORMAT FOR 'XFORM' & 'XDLCOM'
645XGFORM, 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
651ERCD, ERROR /WORD NOT RECOGNIZED
652/
653XFSYM, STL RAR /"SYMBOLIC"; SWITCH NEG
654XFNUM, IAC /NUMERIC; SWITCH POS
655XFCHR, 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
669XFORM, JMS XGFORM /GET FORMAT WORD
670ERCE, 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
678OUTSW, 0 /MODE:0=NOTHING,+=SPACES,-=CR/LF
679
680
681PAGE
682\f/ROUTINE TO EXECUTE THE 'OPEN' COMMAND.
683XOPEN, 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.
690XCLOSE, CDF CIF 10
691 JMP XCLOS1 /ALL CODE IS IN FIELD 1
692
693
694/ROUTINE TO EXECUTE THE 'FILE' COMMAND.
695XFIERR, 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/
704XFIOUT, JMS PNAME /OUTPUT FILE NAME &
705 JMS I TYPSI /"LOOKUP FAILED"
706 MS15
707/
708XFILEN, JMS I CRLFI /OUTPUT CR/LF
709 ISZ CRSWT /WAS LAST ENDED BY A CR?
710 JMP I RESTAR /YES, DONE
711XFILE, STA /"." LEGAL IN FILE NAME
712 JMS GNAME /GET NEXT FILE NAME
713XFICHN, 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
720FSTBLK, 0 /NAME PNTR, BECOMES ST BLK
721FBKLEN, 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
775XDEV, 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
789XDDEV, 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
794GDEVICE,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
805GDEV1, 0
806GDEV2, 0
807GDEV3, 0
808ERCY, ERROR /NO SUCH HANDLER
809 TAD GDEV3 /RETURN HANDLER ADDRESS
810 JMP I GDEVICE
811
812
813PAGE
814\f/ROUTINE TO EXECUTE THE 'SHOW' COMMAND
815XSHBLK, JMS I TYPSI /"BLOCK = "
816 MS32
817 TAD RBLK1 /OUTPUT BLOCK IN OCTAL
818XSTYPE, JMS I OCTI
819XSHCR, 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
823XSHOW, 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
828ERCG, ERROR /NOT FOLLOWED BY LEGAL WORD
829
830XSHVER, JMS I TYPSI /"VERSION = <VERSION><PATCH>"
831 MSVER
832 JMP XSHCR
833
834XSHMSK, JMS I TYPSI /"MASK = "
835 MS02
836 TAD MASK
837 JMP XSTYPE
838
839XSHOFF, JMS I TYPSI /"OFFSET = "
840 MS09
841 TAD OFFSET
842 CIA
843 JMP XSTYPE
844
845XSHFIL, JMS I TYPSI /"FILLER = "
846 MS37
847 TAD FILLER
848 JMP XSTYPE
849
850XSHODL, JMS I TYPSI /"ODT LOC = "
851 MS12
852 JMS I BKLOCI /OUTPUT IT
853 SBLK-1
854 JMP XSHBKS
855
856XSHREL, JMS I TYPSI /"REL. LOC = "
857 MS20
858 JMS I BKLOCI / & OUTPUT IT
859 BLK-1
860 JMP XSHBKS
861
862XSHABS, 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
869XSHBKS, 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
876XSHUPP, JMS I TYPSI /"UPPER = "
877 MS04
878 JMS I BKLOCI /OUTPUT IN BLOCK.LOC FORM
879 UBLK-1
880 JMP XSHCR
881
882XSHLOW, JMS I TYPSI /"LOWER = "
883 MS05
884 JMS I BKLOCI
885 LBLK-1
886 JMP XSHCR
887
888XSHFMT, JMS I TYPSI /"FORMAT = "
889 MS06
890 TAD FCNT
891 TAD (FMTLS-1 /SET UP FOR CORRECT TITLE
892XSHFM, DCA DPNT
893 TADIDP /GET MESSAGE ADDRESS
894 JMS I TYPSTI /OUTPUT DESCRIPTOR
895 JMP XSHCR
896
897XSHMOD, 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
903XSHOUT, JMS I TYPSI /"OUTPUT = "
904 MS30
905 TAD TYPSW /SET UP MESSAGE ADDRESS
906 TAD (OUTLS-1 /(OFFSET INTO TABLE)
907 JMP XSHFM
908
909XSHSMS, 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
918XSHSM1, 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/
927XSHSM2, 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
933XSHDEV, 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
943XSHDDEV,JMS I TYPSI /"DDEV = XXXX"
944 MSDDEV
945 JMP XSHCR
946
947
948FPRNT, 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
956PAGE
957\f/CONTINUATION OF 'SHOW' COMMAND
958
959/SHOW 'CCB' HANDLER
960XSHCCB, 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
972XSHCC1, TAD (-4
973 DCA CNTR /-#/LINE
974XSHCC2, 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/
1000XSHCC4, 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
1010XSHHDR, 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
1028XSHHD1, JMS I CRLFI /TO THE NEXT LINE
1029 JMS I TYPSI /" OVLYS START...
1030 MS42
1031XSHHD2, 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
1055XSHERR, 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
1062XSHER1, 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
1076CCHDST, 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
1088PAGE
1089\f/ROUTINE TO EXECUTE THE 'SET' COMMAND
1090XSETN, ISZ CRSWT /WAS LAST INFO ENDED BY CR?
1091 JMP I RESTAR /YES, DONE
1092XSET, JMS I GWORDI /GET OPTION WORD
1093 JMP XSET1 /NO NUMBERS PLEASE!
1094 ISZ CRSWT /WAS WORD ENDED BY A CR?
1095ERCK, ERROR /YES, ILLEGAL HERE
1096 JMS I SORTI /LOOK UP WORD
1097 SETLST-1
1098 SETJMP-SETLST
1099XSET1, ERROR /WHAT???
1100
1101
1102/ROUTINE TO 'SET' THE 'DMODE' (DUMP MODE)
1103XDMODE, 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
1108ERC11, ERROR /NO LIKEE!!
1109/
1110 CLL STA RAR /4000: 'ALL' (ECHO TO TTY & FILE)
1111XDMODS, 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
1117XOUTS, 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
1122ERCL, ERROR /NOT FOLLOWED BY LEGAL WORD
1123/
1124 CLL STA RAL /-1: 'FPP' (SYMBOLIC)
1125XOUTS1, IAC /+1: 'PDP' (SYMBOLIC)
1126 DCA TYPSW / 0: 'OCTAL'
1127 JMP XSETN
1128
1129
1130/ROUTINE TO 'SET' THE 'MASK' OPTION
1131XMASK, 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
1138XOFFS, 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
1146XEMODE, JMS I GWORDI /GET WORD
1147 JMP ERCZ /NO NUMBERS ALLOWED!!!
1148 JMS I SORTI /LOOK IT UP
1149 XELST-1
1150 XEOPS-XELST
1151ERCZ, ERROR /ILLEGAL SOMETHING
1152/
1153XEMOD1, IAC /'SHORT'
1154 DCA ERMODE /'LONG'
1155 JMP XSETN
1156
1157
1158/ROUTINE TO 'SET' THE 'UPPER' LIMITS OPTION
1159XUPP, JMS I LIMITI /UPPER, GET ARGS
1160 UBLK
1161 JMP XSETN
1162
1163/ROUTINE TO 'SET' THE 'LOWER' LIMITS OPTION
1164XLOW, JMS I LIMITI /LOWER, GET ARGS
1165 LBLK
1166 JMP XSETN
1167
1168/ROUTINE TO 'SET' THE 'MODE' OPTION
1169XMODE, 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
1174ERCJ, ERROR /NOT RECOGNIZED
1175/
1176 CLL STA RTL /-1: OFFSET
1177XMODS, 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
1183XFILL, 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
1189XTEMP, 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
1198XIF, 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
1206XIFSKP, 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/
1213XIFCR, 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.
1226ABKLOC, 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
1232ABK1, JMS I TWOCI /OUTPUT ": "
1233 7240
1234 JMS I TWOT
1235 JMP I ABKLOC
1236/
1237ABK2, TAD LOCL /MAKE ABSOLUTE
1238 AND N377
1239 DCA CAD
1240 JMS I BKLOCI /NOW OUTPUT IT
1241 CBLK-1
1242 JMP ABK1
1243
1244TWOCS, 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
1250NXTOCT, 0
1251 TADIDP /GET NEXT WORD FROM BLOCK
1252 JMS I OCTI / & OUTPUT IN OCTAL
1253 JMP I NXTOCT
1254
1255
1256PAGE
1257\f/ROUTINE TO EXECUTE THE 'WORD' SEARCH COMMAND
1258XWORD, JMS SSET /INITIALIZE SEARCH
1259 TAD CNOP /SET UP FOR NORMAL,
1260 DCA CNOP+1
1261 TAD M10 / EQUAL SEARCH
1262XWOR2, TAD (SNA CLA /"UNEQUAL" WORD SEARCH
1263 DCA XWORC
1264XWOR1, JMS I GWORDI /GET POSSIBLE WORD
1265 JMP XWOR3 /NUMBERS IN BUFFER
1266 ISZ CRSWT /WAS IT ENDED BY A CR?
1267ERCI, ERROR /YES, VELLY SOLLY!
1268 JMS I SORTI /LOOK UP COMMAND: UN, ME,
1269 XWORCL-1 / AB, FR, TO
1270 XWOROP-XWORCL
1271ERCH, ERROR /COMMAND NOT RECOGNIZED
1272/
1273XWOR7, TAD XWOR4+1 /"MEMREF", ONLY MEMORY-
1274 DCA CNOP+1 / REFERENCE OP-CODES CAN
1275 JMP XWOR1 / EVER BE OUTPUT.
1276/
1277XWOR3, 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
1283XWOR4, JMS I GETI /GET A WORD
1284 JMP XWOR5 /FILE MODE, NO SUCH ADDRESS
1285 AND MASK
1286 TAD CNT
1287XWORC, HLT /WILL BE "SZA CLA" OR "SNA CLA"
1288 JMP XWOR5 /DID NOT MATCH
1289 JMS OPRTST /TEST FOR OP-CODES 6 & 7
1290CNOP, 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
1297XWOR5, JMS LCHEK /DONE YET?
1298 JMP XWOR4 /NO
1299
1300/SUBROUTINE TO INITIALIZE THE SEARCH COMMANDS
1301SSET, 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
1319XWSABS, STA
1320 DCA ABSSW /'ABSOLUTE'--SET SWITCH
1321 JMP XWSRET
1322/
1323XWSFRM, JMS I LIMITI /'FROM'--GET LOWER LIMITS
1324 BLK
1325 JMP XWSRET
1326/
1327XWSTO, TAD UBLK /'TO'--SET UP IF NEEDED
1328 DCA EBLK
1329 JMS I LIMITI / & GET UPPER LIMITS
1330 EBLK
1331XWSRET, 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.
1335EBLK, 0
1336ELOCH, 0
1337ELOCL, 0
1338
1339
1340LSETUP, 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
1356LSETL, 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
1375LCHEK, 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
1384TIDPNT, 0 /"TAD I DPNT" IN FIELD 1
1385 CDF 10
1386 TAD I DPNT
1387 CDF 0
1388 JMP I TIDPNT
1389
1390
1391ASCII, 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
1398PAGE
1399\f/ROUTINE TO 'REWIND' THE DEVICE
1400XREWIN, 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
1414RERROR, SPA CLA /BIT 0 = 1 IF FATAL
1415ERC00, ERROR /FATAL
1416ERC01, ERROR /NON-FATAL
1417
1418
1419/ROUTINE TO EXECUTE THE 'STRING' SEARCH COMMAND
1420XSTRIN, JMS SSET /INITIALIZE
1421 TAD (STJMP-STCDF /RESET MASKING SWITCH
1422XSTR0, 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/
1433XSTR1, 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/
1440XSTR2, 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
1446XSTR3, 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
1456XSTR4, 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/
1472XSTR5, JMS LCHEK /DONE?
1473 ISZ TEMP3 /NO, AT MASK END?
1474 JMP XSTR7
1475XSTR6, TAD MASKBS / YES, RESET MASK
1476 DCA SPNT
1477 TAD SMASKL
1478 DCA TEMP3
1479XSTR7, 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
1490XSTR8, TAD M10
1491 DCA ACCX1 / -(#/LINE)
1492 JMS ABKLOC /OUTPUT THIS LOCATION
1493XSTR9, 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
1500XSTR10, JMS XRSET /RESET LOCATION & COUNT
1501 JMS LCHEK /DONE?
1502 JMP XSTR4 /NO, LOC INC'D, TRY NEXT
1503/
1504XSTR11, SPACE2 /OUTPUT " "
1505 ISZ ACCX1 /DONE ON THIS LINE?
1506 JMP XSTR9 /NO, NOT YET
1507 JMS I CRLFI /YES
1508 JMP XSTR8
1509
1510XRSET, 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
1523STRMSK, 0 /STRING MASKING *** NEXT WORD MODIFIED ***
1524SMSKSW, CDF 10 /"CDF 10" OR "JMP I STRMSK"
1525 AND I SPNT /OK, MASK IN FIELD 1
1526 CDF 0
1527 JMP I STRMSK
1528STJMP= JMP I STRMSK
1529STCDF= CDF 10
1530
1531XBLK, 0
1532XLOCH, 0
1533XLOCL, 0
1534
1535
1536PAGE
1537\f/ROUTINE TO EXECUTE THE BLOCK 'WRITE' COMMAND
1538XWRARG, JMS I ARGI /GET ONE ARG
1539 TAD ACC1 /USE IT AS THE BLOCK
1540 SKP
1541XWRITE, TAD WBLK /SET BLOCK
1542 DCA XWBLK
1543 JMS I DEVAD /CALL HANDLER
1544 4210 /WRITE, 2 PAGES, FIELD 1
1545 IOBUF
1546XWBLK, 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
1553WERROR, SPA CLA /BIT 0 = 1 IF FATAL
1554ERC02, ERROR /FATAL
1555ERC03, ERROR /NON-FATAL
1556
1557
1558/ROUTINE TO EXECUTE THE 'MODIFY' COMMAND
1559XMODIF, 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
1568ERCO, ERROR / I THEENK YOU USE BAD WORD!
1569/
1570/NO FORMAT DESCRIPTOR GIVEN, USE DEFAULT
1571XMODEF, 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/
1577XMOD0, JMS I GARGI /OK, NOW GET ARGS
1578 TAD TEMP /MOVE COUNT TO A SAFE PLACE
1579 DCA XWBLK
1580XMOD1, 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
1588XMOD2, 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
1603XMODCR, 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
1609ERCP, ERROR /ILLEGAL (EXTRA BAD IF HERE)
1610
1611XMODDN, ISZ XWBLK /RETURN HERE, ALL ARGS DONE?
1612 JMP XMOD1 /NO
1613 JMP I RESTAR /YES
1614MODTMP, 0
1615
1616XGET, 0 /SUB. TO SET CURRENT LOC & FLAG
1617 JMS I GETI /SET LOCATION
1618ERC07, ERROR /MAPPED MODE, NO SUCH ADDRESS
1619 STA
1620 DCA MODIF /SET FLAG
1621 JMP I XGET
1622
1623/NUMERIC FORMATS HERE
1624XNUM0, JMS I SORTI /TEST TERMINATOR
1625 GETLST-1-1 /SPACE, COMMA, CR
1626 NUMOPS-GETLST+1
1627 JMP ERCQ /ILLEGAL TERMIN
1628/
1629XNUM1, JMS I GETNI /COMMA, SKIP IT
1630 JMS I SSKIPI / SPACE, IGNORE IT
1631XNUM2, 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/
1640XNUM3, 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
1653XASC1, 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
1661CGET, 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
1666CGTEST, 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
1675DO1SP, 0 /OUTPUT " " + AC
1676 JMS I TYPECI
1677 "
1678 JMP I DO1SP /ANOTHER TUFFIE
1679
1680DO2SP, 0 /OUTPUT " " + AC (PACKED ASCII)
1681 JMS I TWOCI
1682 4040
1683 JMP I DO2SP /FAST & SWEET!
1684
1685
1686PAGE
1687\f/ROUTINE TO EXECUTE THE 'SMASK' (STRING MASK) COMMAND
1688XSMASK, 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
1693XSMAS1, 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
1706XXS20, TAD M240 /SET OFFSET
1707/PACKED ASCII FORMAT HERE
1708XPAC0, DCA PNAME /CLEAR OFFSET
1709XPAC1, 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
1715XPAC2, 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
1722XOPS1, 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
1728ERC04, ERROR /START OR COUNT NOT EVEN
1729XOPS2, 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
1739XOPS3, 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
1753XOPS4, JMS CGET /GET & TEST NEXT CHAR
1754 JMP XOPS2 /OK, DO NEXT
1755/
1756XOPS5, 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
1764PACK, 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/
1775PACK1, 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
1788PNAME, 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.
1799PNAME1, 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
1813LIMITS, 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
1832PAGE
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
1895GET, 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
1903GET0, JMS DBLPGS /NOW ADD 'DOUBLE PAGES'
1904 TAD BLK / OF LOC TO BLK TO SET
1905 DCA CBLK /'CURRENT BLOCK'
1906GET1, 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
1917GETX, JMP I GET /[EXIT TO CALL+1 FOR MAP FAIL]
1918
1919GETIO, 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
1929BUFST, IOBUF
1930WBLK, 0
1931 JMP WERROR /WRITE ERROR
1932GETIO1, 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
1943RBLK, -1 /(NOTHING IN CORE-ILLEGAL BLK #)
1944 JMP I GETIO /READ ERROR
1945GETIO2, ISZ GETIO /OK, DO NORMAL RETURN
1946 JMP I GETIO
1947
1948
1949DBLPGS, 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
1961ODGET, 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
1969ERC05, 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
1975BKLOC, 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
1994GWORD, 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
2011GWD1, 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/
2017GWD2, STA /SPACE FOUND, SET SWITCH
2018GWD3, DCA CRSWT /CR FOUND, RESET SWITCH
2019 TAD CHARSW /RETURN WITH WORD
2020 ISZ GWORD / TO CALL+2
2021GWD4, JMP I GWORD
2022/EXIT TO CALL+1 IF ANY NUMERIC ITEM FOUND--
2023/ ^K, ^D, (, ", ', DIGITS
2024
2025
2026/"DIRECTORY" FORMAT OUTPUT ROUTINE
2027DIRDMP, 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
2035DIROUT, 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
2047PAGE
2048\f/CONTINUATION OF 'GET' -- MAPPING FOR "SAVE" AND "LOAD"
2049/ MODES DONE HERE.
2050
2051GET4, 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.
2063GETS1, 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/
2101GETS2, 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/
2117GETL1, CDF CIF 10
2118 JMS GHDR /GET & TEST HEADER
2119GETL2, 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?
2154GETL3, SPA CLA
2155 JMP GETX /ILLEGAL LEVEL; TOO FAR--EXIT
2156 TAD GETCW /ALL OK! ADD RELATIVE BLK
2157 SKP
2158GETL4, 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
2164GETORG, 0
2165GETCW, 0
2166SEGCNT, 0
2167
2168UPCBLK, 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
2177PAGE
2178\f/NUMERIC OUTPUT SUBROUTINES, NO ZERO SUPPRESSION:
2179
2180OPRT, 0 /4-DIGIT OCTAL
2181 JMS NUMOUT
2182 -1000
2183 -100
2184 -10
2185 0
2186 JMP I OPRT
2187
2188OCT3, 0 /3-DIGIT OCTAL
2189 JMS NUMOUT
2190 -100
2191 -10
2192 0
2193 JMP I OCT3
2194
2195BPRT, 0 /3-DIGIT BCD
2196 JMS NUMOUT
2197 -400
2198 -20
2199 0
2200 JMP I BPRT
2201
2202
2203SGNDP, 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
2215DECIMAL
2216
2217DPRT, 0 /4-DIGIT DECIMAL, UNSIGNED
2218 JMS NUMOUT
2219 -1000
2220 -100
2221 -10
2222 0
2223 JMP I DPRT
2224
2225DEC2, 0 /2-DIGIT DECIMAL, UNSIGNED
2226 AND N177 /MASK IT FIRST
2227 JMS NUMOUT
2228 -10
2229 0
2230 JMP I DEC2
2231
2232OCTAL
2233
2234NUMOUT, 0 /THE REAL OUTPUT SUBROUTINE
2235 DCA NUMB /SAVE THE NUMBER
2236NUMO1, 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/
2246NUMO2, 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
2256NUMB, 0
2257NUMDGT, 0
2258
2259SSKIP, 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
2271OSTYPE, 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
2284BYTEO, 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
2302OSSET, 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
2308OSRETN, TAD INC /GET VALUE TO AC
2309 AND N377 /MASK TO 8 BITS
2310 JMP I OSSET
2311/
2312OSUNPK, 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
2331INC, 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
2346PAGE
2347\f/OUTPUT PACKED STRING, ADDRESS IN CALL+1,
2348/ TERMINATOR IS XX00.
2349TYPES, 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
2356TYPSTR, 0
2357 DCA GETNT
2358TTAGN, 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
2370PACOUT, 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
2380ONECHR, 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
2396SORTJ, 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
2403SORT1, 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
2420SORT2, ISZ SORTJ /MATCH NOT FOUND,
2421 JMP I SORTJ /EXIT TO CALL+3
2422SORTEM, 0
2423
2424
2425/SUBROUTINE TO GET A NAME FOR 'XOPEN', 'XFILE', 'XDEV' & 'XDDEV'
2426
2427GNAME, 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
2444GETSCN, JMS GPAIR /5TH & 6TH OR 1ST & 2ND EXT.
2445 JMS GETNT /SCAN FOR TERMINATOR
2446 CLA
2447 JMP .-2
2448/
2449GETCOL, 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/
2455GETPER, ISZ TEMP1 /"." FOUND, FIRST ONE?
2456ERCM, 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/
2462GETEND, STA /TERM = SPACE, SET SWITCH
2463 DCA CRSWT /TERM = CR, RESET SWITCH
2464 JMP I GNAME /..DONE....
2465
2466GETNT, 0 /GET & TEST A CHAR
2467 JMS I GETNI /GET NEXT CHAR
2468 JMS I SORTI /TEST IT
2469 GETLST-1
2470 GETOPS-GETLST
2471GETNTC, TAD CHAR /OK, USE CHAR
2472 AND N77 /MASK TO 6 BITS
2473 JMP I GETNT / & EXIT WITH IT
2474
2475GPAIR, 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
2485RTL6, 0 /ROTATE AC 6 LEFT
2486 CLL RTL
2487 RTL
2488 RTL
2489 JMP I RTL6
2490
2491RTR6, 0 /ROTATE AC 6 RIGHT
2492 CLL RTR
2493 RTR
2494 RTR
2495 JMP I RTR6
2496
2497
2498PAGE
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
2511READ, 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
2518RENEXT, JMS RKEY /GET A CHAR
2519 JMP RUBO /RUBOUT, GO BEGIN DELETIONS
2520REKEY, 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
2527RETERM, 0 / PARAMETERS HERE
2528 0
2529 TAD CHAR /NONE, JUST STORE IN BUFFER
2530 SKP
2531RESPC, 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/
2546RUBO, JMS BTEST /RUBOUT TYPED,TEST FOR EMPTY
2547 JMP RUBOF / INPUT BUFFER EMPTY!
2548 JMS I TYPECI /OK, OUTPUT 1ST "\"
2549 "\
2550RUBO1, 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/
2569RUBOE, JMS I TYPECI /BUFFER WAS EMPTIED,
2570 "\ /OUTPUT CLOSING "\"
2571RUBOF, JMS I CRLFI / & A CR/LF
2572 JMP I READ
2573/
2574RECHO, 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
2579RECHO1, 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/
2588RERASE, JMS I TYPECI /OUTPUT "^U"
2589 "U-100
2590 JMP RUBOF /GO OUTPUT CR/LF & EXIT
2591
2592BTEST, 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
2611RKEY0, 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
2620RKEY1, 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.
2627ENDC, 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
2645DODIG, 0 /OUTPUT AC AS AN ASCII DIGIT
2646 JMS I TYPECI
2647 "0
2648 JMP I DODIG
2649
2650
2651PAGE
2652\f/'FPP'/OCTAL/'PDP' OUTPUT ROUTINE FOR ODT
2653ODTOUT, 0
2654 TAD TYPSW /-1, 0, +1
2655 TAD (TAD ODTOL /GENERATE ADDRESS OF DESIRED
2656 DCA ODTOPT / OUTPUT ROUTINE
2657ODTOPT, 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
2664ODTOL, OPRT / 0 = OCTAL
2665 PDPDMP /+1 = OCTAL + PDP
2666
2667
2668/OCTAL & 'PDP' (SYMBOLIC) DUMP ROUTINE
2669PDPDMP, 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
2677PDPOUT, 0
2678 CLA
2679 JMS OPRTST /TEST FOR OPR & IOT
2680 JMP OPRS / OPR
2681 JMS IOPRNT / IOT
2682SYMS, 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
2696REFS1, 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
2705REFS2, JMS I OCTI /OUTPUT IN OCTAL
2706SYMEND, JMP I PDPOUT /DONE, RETURN
2707
2708/
2709IOTS, TADICAD /USE ONLY LAST 9 BITS
2710 AND (777
2711 JMP REFS2 /AND OUTPUT IN OCTAL
2712/
2713OPRS, 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
2724OPRS1, 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
2738EAE, 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
2755EAETMP, 0
2756/
2757/DO THE DECODING FOR THE OPR1 MICRO-INSTRUCTIONS
2758OPR1A, 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
2778PAGE
2779\f/OCTAL & 'FPP' (SYMBOLIC) DUMP ROUTINE
2780FPPDMP, 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
2789OPR2A, 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 "
2804OPR2B, 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
2812SYMLIM, 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/
2824OPEND, 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
2833BITS, 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
2843OPRTYP, 0 /OUTPUT AN OPR SYMBOL
2844 JMS SYMTYP /OUTPUT THE SYMBOL
2845BITPNT, 0 /ADDRESS
2846 -2
2847 ISZ CNT /SET SWITCH
2848 JMP I OPRTYP
2849
2850SYMTYP, 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
2857SYMNXT, 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
2865SYMPNT, 0
2866
2867OPR2T, 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
2873BITVAL, 0
2874
2875
2876IOPRNT, 0 /OUTPUT I/O NAMES
2877 TAD (IOTTAB /SET UP POINTER
2878IOPRN1, 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/
2892IOPRN2, IAC /WORD FOLLOWS CODE
2893 JMS SYMTYP /OUTPUT THE MNEMONIC
2894IOPNT, 0
2895 -3
2896 JMP SYMEND / & RETURN
2897
2898
2899OPRTST, 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
2912PAGE
2913\f/'FPP' (SYMBOLIC) INSTRUCTION DECODING
2914FPPOUT, 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
2923FPLEA, 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
2932BASE, 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/
2940INDIR, 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/
2948LONG, JMS I TWOCI /OUTPUT "# "
2949 4340
2950 JMS FLDOUT /AND FIELD AND "*"
2951XRPLUS, 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/
2961SPECIAL,JMS GETOP /GET OP-CODE
2962 JMS I SORTI / & BRANCH ON IT
2963 FPPMO0-1
2964 FPPMOJ-FPPMO0
2965SPCOP0, 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
2970SPOP00, TADICAD /FALLS THRU ON 0, USE AS
2971 AND N7 / INDEX INTO LAST LIST
2972 IAC
2973SPOP04, 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/
2979SPOP05, CLL STA /= -1
2980 JMP SPOP04 /OUTPUT "STARTE"
2981/
2982SPNUSE, CLL STA RAL /= -2
2983 JMP SPOP04 /OUTPUT "UNUSED"
2984/
2985SPO123, 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/
2992SPOP10, TAD (4 /"LDX *,X"
2993SPOP11, JMS SYMTYP /"ADDX *,X"
2994 FPXR2S
2995 -4
2996XROUT, TADICAD /GET XR FIELD
2997 AND N7
2998 DIGIT / & OUTPUT AS DIGIT
2999 JMP I FPPOUT
3000/
3001SPCOP1, 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
3011SPCOP3, IAC / 1: TRAP3
3012SPCOP4, JMS MULT3 / 0: TRAP4
3013 JMS SYMTYP /GO DO ONE OF THESE
3014 FOP134
3015 -3
3016 JMP DOFLD /FINISH WITH FIELD
3017/
3018SPOP1J, JMS CONDIT /CONDITIONAL JUMPS
3019 1200 / "J--"
3020 SPACE2
3021DOFLD, JMS FLDOUT /OUTPUT FIELD & "*"
3022 JMP I FPPOUT
3023/
3024SPCOP2, JMS I TYPSI /OUTPUT "JNX "
3025 MSJNX
3026 JMP XRPLUS-1 / & HANDLE ADDRESS
3027/
3028/ SPCOP3 & SPCOP4
3029/
3030SPCOP5, 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/
3038SPCOP7, IAC / "LEA" INDIRECT, SET SWITCH
3039SPCOP6, DCA TEMP2 / "LEA" LONG, SET SWITCH
3040 CLL STA
3041 JMP FPLEA / & GO DO OUTPUT
3042
3043
3044PAGE
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
3070YRTEST, 0 /-(THIS YEAR) FOR TESTING
3071YRBASE, 0 /BASE YEAR FOR DATE + THIS YEAR
3072
3073
3074TYPEA, 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/
3082TYPEX, ISZ NCNT /BUMP LINE POSITION
3083 JMP I TYPEA / & EXIT
3084
3085CRLF, 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
3095TYPEC, 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
3102TYPE, 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
3115TYPC, JMS TYPEA /NOW OUTPUT CHAR
3116TCHAR, 0
3117 JMP I TYPE
3118/
3119TYPALT, JMS TYPEA /OUTPUT "$" FOR ALT-MODES
3120 "$
3121 JMP I TYPE
3122/
3123TYPCR, JMS CRLF /C.R. TO OUTPUT
3124 JMP I TYPE
3125/
3126TYPTAB, 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/
3137TYPCTL, JMS TYPEA /CONTROL-CHAR, OUTPUT AS
3138 "^
3139 TAD C100 / "^","CHAR+100"
3140 JMP TYPC
3141C100, 100
3142
3143
3144CTRL, 0 /CHECK FOR CTRL-C, CTRL-S, CTRL-Q & CTRL-P
3145 DCA CTRLQS /CLEAR HANG FLAG
3146CTRL0, 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
3152BCTRLC, 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
3158CTRL1, 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/
3164CTRL2, 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/
3175XEXIT,
3176CTRLC, DCA DSWIT /RESET DUMP SWITCH
3177 JMP I M200 / & GO TO SYSTEM
3178CTRLCI, XERR4+1 /*** CTRL-C ABORTS JOB STREAM! ***
3179/
3180CTRLX, 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
3185CTRLQS, 0 /CTRL-S, CTRL-Q FLAG
3186
3187
3188PAGE
3189\f/INPUT AN UNSIGNED 24 BIT NUMBER
3190ACCEPT, 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
3196ACCPT1, 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/
3202ACCNUM, 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
3209ERC09, ERROR / NO, ILLEGAL DIGIT!
3210ACCMUL, 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
3222ACCPT3, TAD DADD /TERMINATING CHAR RECEIVED
3223 SNA CLA /CHECK FOR LEGAL INPUT
3224ERCR, ERROR /YOU CAN'T OUT-SMART ME!
3225 JMP I ACCEPT
3226ACBASE, 10
3227/
3228/
3229DQUOTE, JMS QUOTEC / " - GET SINGLE CHAR
3230 DCA OCTSET / SAVE VALUE
3231 JMP ACCMUL / & USE IT AS A "DIGIT"
3232/
3233SQUOTE, 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/
3242CTRLD, TAD (2 / ^D - SET RADIX TO DECIMAL
3243CTRLK, 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.
3249OCTSET, 0 /SET UP FOR OCTAL/DECIMAL INPUT
3250 TAD (10 /ENTER WITH AC= 2 FOR DECIMAL
3251 DCA ACBASE
3252 JMP I OCTSET
3253
3254QUOTEC, 0 /GET A QUOTED CHARACTER
3255 JMS CGTEST /GET & TEST FOR A CR
3256ERC13, 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'.
3263GARGS, 0
3264 TAD TEMPST /GET BUFFER ADDRESS
3265 DCA DPNT
3266 DCA TEMP /ZERO THE NUMBER OF ARGS
3267GAR1, STA
3268 DCA TEMP1 /SET BLK TO -1
3269 STA
3270 DCA CNT /RESET SWITCH
3271GAR2, 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
3276ERCS, ERROR /ILLEGAL TERMIN., FLAME OUT
3277/
3278GAR3, JMS GPUT /CR FOUND, END
3279 TAD TEMPST /SET UP POINTER FOR
3280 DCA DPNT / GETTING RESULTS
3281 JMP I GARGS
3282/
3283GAR4, JMS I GETNI /SKIP OVER "."
3284 TAD ACC1 /.= TERMIN (BLOCK PART)
3285 JMP GAR1+1 /SET BLOCK & GET NEXT
3286/
3287GAR5, TAD ACC1 /-= TERMIN (LOC PART)
3288 DCA TEMP2
3289 JMS I GETNI /SKIP OVER "-"
3290 JMP GAR2-1 /GO SET SWITCH
3291/
3292GAR6, 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]
3311GPUT, 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
3318GPUT1, 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
3333XS240O, 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
3343GETN, 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
3351PAGE
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
3367EVAL, 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
3375EVAL1, JMS I SORTI /CHECK LEGAL TERMS
3376 EVLST1-1 /"+","-" & "("
3377 EVOPS1-EVLST1
3378ERCT, ERROR /SORRY ABOUT THAT
3379
3380EVAL2, JMS I LPARI /IS CHAR "("?
3381ERCU, ERROR /YES,ILLEGAL (NO OP FIRST)
3382EVMIN, 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
3388EVAL3, 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
3407EVOP, 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
3416EVPAR, 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
3426EVNEXT, JMS I TERMTI /GET NEXT & TEST FOR TERM.
3427 JMP EVLPAR /TERM, MUST BE A "("
3428ENUM, 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
3435ENUMX, TAD ACC1
3436 DCA OPER1 /LO ORDER PART
3437 TAD ACC2
3438 DCA OPER2 /HI ORDER PART
3439 JMP EVOPN /GO CHECK TERMINATOR
3440/
3441EVDATE, CDF 10 /"D" -- USE DATE WORD
3442 TAD I (7666 /GET DATE WORD
3443 CDF 0
3444 JMP EVBLK+1
3445EVREM, TAD ACCX1 /"R" -- USE REMAINDER
3446 DCA ACC1
3447 TAD ACCX2 / AS NEXT "INPUT".
3448 JMP EVBLK+2
3449EVTEMP, TAD TEMPV1 /"T" -- USE 'TEMP' STORAGE
3450 DCA ACC1
3451 TAD TEMPV2
3452 JMP EVBLK+2
3453EVSR, LAS SKP /"S" -- USE SWITCHES
3454 TADICAD /"C" -- USE CONTENTS
3455 JMP EVBLK+1
3456EVFIL, TAD FILLER /"F" -- USE FILLER
3457 JMP EVBLK+1
3458EVLOC, TAD LOCL /"L" -- USE LOCATION
3459 DCA ACC1
3460 TAD LOCH
3461 JMP EVBLK+2
3462EVBLK, 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
3467EVLPAR, JMS I LPARI /IS CHAR "("?
3468 SKP
3469ERCV, ERROR /NO, DIE! (ILLEGAL OPERATOR)
3470EVPAR2, TAD LASTOP /PUSH DOWN LASTOP
3471 PUSH
3472 TAD EVAL /PREPARE TO RE-CALL
3473 PUSH
3474 JMS EVAL /RECURSIVE CALL
3475ERCW, ERROR /TERM = CR, NOT ENOUGH PARENS
3476 POP
3477 DCA EVAL /RESTORE RETURN ADDR
3478 POP
3479 DCA LASTOP /RESTORE LASTOP
3480EVOPN, JMS I TERMTI /GET NEXT & TEST FOR TERM.
3481 JMP EVAL2 /OK
3482 JMP EVPAR2-1 /GARBAGE, GIVE SAME ERROR
3483
3484EVALX, 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
3490LPARI, LPAR
3491TERMTI, TERMT
3492
3493EVTAB, 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
3503PAGE
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
3511POPX, 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
3521LPAR, 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.
3530TERMT, 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
3537TERMT1, 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
3548TERMTE, ISZ TERMT /DIDN'T FIND IT, TO
3549 JMP I TERMT / CALL+2
3550
3551/DOUBLE-PRECISION ROUTINES
3552
3553DADD, 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
3564DSUB, 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
3570DAND, 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
3579DIOR, 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.
3596ARG, 0
3597 STA
3598ARG1, 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
3603ERCQ, ERROR /ILLEGAL TERMINATOR
3604/
3605ARG2, JMS I GETNI /SKIP OVER "."
3606 TAD ACC1 /TERM = ".", SET 'BLOK'
3607 JMP ARG1
3608/
3609ARG3, 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'.
3615EXPRIN, 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/
3622EXPRI1, JMS I EVALI /YES, GO EVALUATE EXPRESSION
3623ERC08, 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
3631SCANER, 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
3646PAGE
3647\f/SIGNED MULTIPLY AND DIVIDE ROUTINES
3648
3649DMUL, 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
3653DMUL1, 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
3661DMUL4, 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/
3667DMUL2, 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
3675DMUL3, TAD ACCX2 /AND BEGIN SHIFTING OUT
3676 RAR
3677 DCA ACCX2
3678 TAD ACCX1
3679 RAR
3680 DCA ACCX1
3681 JMP DMUL1
3682
3683DDIV, 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)
3690ERCX, ERROR / YES, YOU LOST
3691 ISZ DPSGN /CORRECT FOR SIGN DIF IN * & /
3692DDIV1, 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
3703DDIV2, CLA
3704 TAD OPER1 /RESET LO ORDER PART
3705 CIA
3706 TAD ACCX1
3707 DCA ACCX1
3708 CLL /RESET LINK
3709DDIV3, 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
3726MDCOM, 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
3739MULNEG, 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
3751DPNEG, 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
3764BLKTST, 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
3773DICAD, 0 /"DCA I CAD" IN FIELD 1
3774 CDF 10
3775 DCA I CAD
3776 CDF 0
3777 JMP I DICAD
3778
3779TICAD, 0 /"TAD I CAD" IN FIELD 1
3780 CDF 10
3781 TAD I CAD
3782 CDF 0
3783 JMP I TICAD
3784
3785
3786PAGE
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
3800WCHEK, 0
3801 JMS I GWORDI /COM BUF BEGIN WITH A WORD?
3802 JMP WCHEK2 /NO, TEST FOR PARENS, ETC.
3803WCHEK1, 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/
3810WCHEK2, STA
3811 TAD COMOUT /SET UP ANOTHER A-XR
3812 DCA DPNT
3813 DCA CNT /RESET (OR SET) PAREN COUNT
3814WCHEK3, 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/
3820WCHEK4, 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/
3825WCHEK5, 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/
3830WCHEK6, JMS WCHONE / ' -- 2 CHARACTERS
3831 JMS WCHONE / " -- 1 CHARACTER
3832 JMP WCHEK3 /OK, CONTINUE SCAN
3833
3834WCHONE, 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
3842GETOP, 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
3849GET678, 0 /GET BITS 678 TO BITS 9-11
3850 TADICAD
3851 CLL RTR
3852 RAR
3853 AND N7
3854 JMP I GET678
3855
3856MULT3, 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
3863CONDIT, 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
3872SYMTYI, SYMTYP
3873
3874FLDOUT, 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
3886TEMPL= . /ARGUMENT BUFFER
3887 /L(TEMPL)=180(10)
3888F0END= TEMPL+180
3889 DMPHAN-F0END /(SHOW SPACE LEFT)
3890
3891 OCTAL
3892
3893PAGE /****** MUST BE NO LITERALS! ******
3894
3895DMPHAN= 06600 /DUMP HANDLER AREA, 2 FIELD 0 PAGES
3896
3897DEVHAN= 07200 /DEVICE HANDLER AREA, 2 FIELD 0 PGS
3898
3899
3900IFNZRO 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
3908INIMSG, 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
3915INISCO, 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/
3921INIDAT, 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
3954PAGE /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
3958START, 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?)
3980STDEV, 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
4015STSWIT, 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/
4030STSWO, 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/
4040STSWS, 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
4050STSWEX, CDF 0
4051 ISZ TEMP /FILE NAME SPECIFIED?
4052 JMP I (201 / NO, JUST START
4053 DCA CRSWT /YES, SET SWITCH TO CR,
4054STTLS, 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/
4066STERR, TLS /START UP OUTPUT *** BATCH OPER.
4067 JMP ERCY / & GIVE ERROR!
4068
4069
4070PAGE
4071\f/INITIALIZATION CODE FOR BATCH OPERATION
4072
4073BATSET, 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.
4086BATMOV, TAD I SCANX1 /GET NEXT STORAGE ADDRESS
4087 SNA
4088 JMP I BATSET / 0 = ALL DONE!
4089 DCA DPNT /SET UP POINTER
4090BATLUP, TAD I SCANX1 /GET A PATCH WORD
4091 SNA
4092 JMP BATMOV / 0 = GROUP END
4093BATPAT, 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
4105SCOPLS, 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
4121RUBO2, 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
4128TYPEAI, TYPEA
4129 0
4130
4131 RELOC
4132
4133
4134BATLS, /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
4155BATINI, 5400 /IN THE BATCH FIELD
4156RM214, -214
4157R2, 2
4158RLAST, 215 /!!! CR OF ".R FUTIL" HAS AN LF !!
4159 0
4160
4161 RKEY+1-1
4162 RELOC /TO PUT 'CBATI' ON THIS PAGE
4163CBATI= .+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
4168ERC17, 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
4200CBATE= . /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
4214CBATO= .+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
4230PAGE
4231
4232FIELD 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
4298EMSEND, ERMS17
4299 ERMS99
4300
4301
4302/ERROR MESSAGES:
4303
4304ERMSA, TEXT &ILLEGAL SINGLE-WORD COMMAND&
4305
4306ERMSB, TEXT &ILLEGAL MULTI-WORD COMMAND&
4307
4308ERMSC, TEXT &TOO MANY ")"S&
4309
4310ERMSD, TEXT &ILLEGAL FORMAT WORD&
4311
4312ERMSE, TEXT &BAD FORMAT SYNTAX&
4313
4314ERMSF, TEXT &NO FILE FOR C.C.B./HEADER REQUEST&
4315
4316ERMSGC, TEXT &BAD C.C.B (NOT A SAVE FILE)&
4317
4318ERMSHD, TEXT &BAD HEADER (NOT A LOAD MODULE)&
4319
4320ERMSG, TEXT &ILLEGAL ITEM TO SHOW&
4321
4322ERMSH, TEXT &ILLEGAL SEARCH MODIFIER&
4323
4324ERMSI, TEXT &BAD SEARCH SYNTAX&
4325
4326ERMSJ, TEXT &ILLEGAL MODE&
4327
4328ERMSK, TEXT &SET OPTION FOLLOWED BY A CR, BAD SYNTAX&
4329
4330ERMSXO, TEXT &NUMBER OR ILLEGAL SET OPTION&
4331
4332ERMSL, TEXT &NUMBER OR ILLEGAL OUTPUT OPTION&
4333
4334ERMSM, TEXT &ILLEGAL "." IN NAME (FILE OR DEVICE)&
4335
4336ERMSO, TEXT &ILLEGAL MODIFY FORMAT&
4337
4338ERMSP, TEXT &PROGRAM OR HARDWARE PROBLEM&
4339
4340ERMSQ, TEXT &BAD TERMINATOR IN SINGLE ARGUMENT&
4341
4342ERMSR, TEXT &TERMINATOR BEFORE LEGAL NUMBER INPUT&
4343
4344ERMSS, TEXT &BAD TERMINATOR IN MULTIPLE ARGUMENT&
4345
4346ERMST, TEXT &ILLEGAL CHARACTER IN EXPRESSION&
4347
4348ERMSU, TEXT &ILLEGAL USE OF "(" IN EXPRESSION&
4349
4350ERMSV, TEXT &ILLEGAL OPERATOR IN EXPRESSION&
4351
4352ERMSW, TEXT &TOO FEW ")"S IN EXPRESSION&
4353
4354ERMSX, TEXT &DIVISION BY 0 ATTEMPTED&
4355
4356ERMSY, TEXT &UNKNOWN HANDLER NAME&
4357
4358ERMSZ, TEXT &NUMBER OR ILLEGAL ERROR OPTION&
4359
4360ERMS01, TEXT &NON-&
4361 *.-1
4362
4363ERMS00, TEXT &FATAL READ ERROR&
4364
4365ERMS03, TEXT &NON-&
4366 *.-1
4367
4368ERMS02, TEXT &FATAL WRITE ERROR&
4369
4370ERMS04, TEXT &ODD START LOC OR COUNT IN OS/8 MODIFY&
4371
4372ERMS05, TEXT &BAD ADDRESS/OVERLAY (ODT COMMANDS)&
4373
4374/ERMS06,
4375
4376ERMS07, TEXT &BAD ADDRESS/OVERLAY (MODIFY)&
4377
4378ERMS08, TEXT &ARGUMENT EXPRESSION NOT TERMINATED BY ")"&
4379
4380ERMS09, TEXT &ILLEGAL DIGIT&
4381
4382ERMS10, TEXT &DUMP HANDLER ERROR&
4383
4384ERMS11, TEXT &NUMBER OR ILLEGAL DMODE OPTION&
4385
4386/ERMS12,
4387
4388ERMS13, TEXT &ILLEGAL USE OF ' OR "&
4389
4390ERMS14, TEXT &MAPPED MODE--USE LIST, NOT DUMP&
4391
4392ERMS15, TEXT &NO ERROR MESSAGES&
4393
4394ERMS16, TEXT &INPUT ERROR ON MESSAGES&
4395
4396ERMS17, TEXT &EOF ON BATCH INPUT&
4397
4398ERMS18, TEXT &ENTER FAILED&
4399
4400ERMS19, TEXT &CLOSE FAILED&
4401
4402ERMS20, TEXT &DUMP FILE OVERRUN&
4403
4404ERMS99, 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
4414GCCB, 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
4430GCCERR, 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
4434GCCB1, 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/
4445GCCB2, DCA GETSWX /BE SURE SWITCH STAYS CLEAR
4446 TAD I SEGNI /GET -# SEGMENTS
4447GCCCDF, CDF CIF 0
4448 JMP I GCCB /OK, RETURN VALUE
4449
4450GHDR, 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
4475HDRERR, JMS ERROR1
4476GHDR1, 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
4481CCBHDR, 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
4489ERCF, 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
4498SEGNI, CCBB /BUFFER IS HERE
4499GCCBLK, 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/
4506RDERX, CDF CIF 0 /RETURN TO FIELD 0
4507 JMP I (RERROR / FOR READ ERROR
4508
4509DEVADX, 0
4510GETSWX, 0
4511
4512
4513MSMOD, TEXT " MOD"
4514
4515MSBAD, TEXT " BAD BLOCK"
4516
4517
4518PAGE
4519\f/CONTINUATION OF OUTPUT COMMANDS AND ROUTINES FROM FIELD 0
4520
4521/CONTINUATION OF 'SET' 'DDEV' HANDLER
4522
4523XDDEV1, 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
4545XOPEN1, 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"
4558XOPEN2, 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
4569XOBLK, 0 /NAME POINTER, BECOMES START BLK
4570XOSIZ, 0 / BECOMES -# BLOCKS CAN USE
4571ERC18, 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
4576XOCEX, CDF CIF 0
4577 JMP MAIN1 /TRY NEXT COMMAND
4578
4579DDEVAD, 7607 /INIT ADDRESS TO "SYS:" (SEE ABOVE)
4580DDEVNO, 1 /INIT THIS TO "SYS:" ALSO.
4581DDCWPT, 7760 / THIS ALSO
4582
4583DNAM, 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
4591XCLOS1, 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
4596XCTLZ, "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
4605XCLNAM, DNAM /POINTER TO FILE NAME
4606XCLSIZ, 0 /SIZE OF NEW FILE
4607ERC19, JMS ERROR1 /OH NO! CLOSE FAILED!
4608 DCA DNAM /OK, ZAP KNOWLEDGE OF FILE
4609 JMP XOCEX
4610
4611
4612DMPOUT, 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!)
4616DMPNUL, 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/
4629DMPIT, CIF 0
4630 JMS I DDEVAD /CALL DUMP FILE HANDLER
4631 4210 /WRITE, 2 PAGES, FIELD 1
4632DMPADR, DMPBUF
4633DMPBLK, 1 /BLOCK NUMBER
4634ERC10, 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
4641ERC20, JMS ERROR1 / AND DIE!
4642DMPCHR, 0
4643DMPPTR, 0 /CHARACTER OUTPUT POINTER
4644
4645
4646PAGE
4647\f/CONTINUATION OF ROUTINE TO OUTPUT A CHAR TO A DEVICE
4648
4649TYPE1, 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
4654TYPEB, NOP /*** CDF 10 /*** BATCH
4655 TSF /*** CIF BAT /*** CHANGES
4656 JMP .-1 /*** JMS I .+1 /*** LOG
4657 TLS /*** 7400 /*** OUTPUT
4658 CLA /*** CDF 0
4659TYPE2, 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
4673DDEVS, 0 /TEST: 0=FILE, 212= NON-FILE
4674TYPE3, CDF CIF 0
4675 JMP TYPEX /BACK AND OUT
4676
4677
4678ERROR1, 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
4686XDDEV2, 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
4694MSDDEV, TEXT "@DDEV = SYS@"
4695XDDNAM= .-3
4696
4697MSDEV, TEXT "@DEVICE = SYS@"
4698
4699XDNAM= .-3 /ADDR OF 1ST WORD OF DEVICE NAME
4700
4701/CONTINUATION OF CODE FROM FIELD 0
4702
4703XDEVM, 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
4714MSERR, 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
4721MSVER, TEXT "VERSION = ???" /VERS = 2 DIGITS, PATCH = 1
4722 *.-2
4723VERTEN= VERSION%12 /TENS DIGIT
4724VERONE= -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
4730MONTHS, TEXT " 00@JAN@FEB@MAR@APR@MAY@JUN@JUL"
4731 TEXT "AUG@SEP@OCT@NOV@DEC@ 13@ 14@ 15"
4732
4733
4734PAGE
4735\f/SYMBOLICS FOR PDP-8 INSTRUCTIONS:
4736INSLST, TEXT "AND TAD ISZ DCA JMS JMP IOT NOP "
4737 *.-1
4738
4739/ GROUP 1 MICRO-INSTS.:
4740OP1LST, TEXT "CLL CMA CML IAC BSW RAL RTL RAR RTR "
4741 *.-1
4742
4743
4744/ GROUP 2 MICRO-INST'S:
4745OP2LST, TEXT "SMA SZA SNL SKP SPA SNA SZL OSR HLT "
4746 *.-1
4747
4748/ EAE MICRO-INST'S:
4749EAELST, TEXT "MQA MQL SCL MUY DVI NMI SHL ASR LSR SCA "
4750 *.-1
4751 TEXT "DAD DST SWBADPSZDPICDCM SAM "
4752 *.-1
4753
4754CLANAM, 0314 /"CLA "
4755 0140
4756
4757OPRMES, 1720 /"OPR "
4758 2240
4759\f/ IOT INSTRUCTIONS:
4760
4761IOTTAB, 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
4983NXTIOT, 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
4998MSBASE, TEXT " B+"
4999
5000MSINDI, TEXT "% B+"
5001
5002MSJNX, 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
5008FPPINS, TEXT "FLDA@@FADD@@FSUB@@FDIV"
5009 TEXT "FMUL@@FADDM@FSTA@@FMULM"
5010
5011 TEXT "UNUSEDSTARTE"
5012 *.-1
5013FPOP00, TEXT "FNOP@@FEXIT@FPAUSEFCLA@@FNEG"
5014 TEXT "FNORM@STARTFSTARTDJAC@@"
5015
5016FPXR1S, TEXT "ALN ATX XTA "
5017
5018FPXR2S, TEXT "ADDX *,@LDX *,@"
5019
5020FOP134, TEXT "TRAP4 TRAP3 SETX SETB JSA @JSR "
5021
5022FPCOND, TEXT "EQGELEA@NELTGTAL"
5023
5024
5025/CONTROL TABLES FOR FPP INSTRUCTION DECODING
5026
5027FPPMO0, 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
5036FPPMOJ, SPCOP7
5037 SPCOP6
5038 SPCOP5
5039 SPCOP4
5040 SPCOP3
5041 SPCOP2
5042 SPCOP1
5043
5044FPPOP0, 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
5061FPPOPJ, 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
5078MS01, TEXT " = "
5079
5080MS07, 0023 /"SMASK = "
5081MS02, TEXT "MASK = "
5082
5083MS03, TEXT "ABS. LOC = "
5084
5085MS04, TEXT "UPPER = "
5086
5087MS05, TEXT "LOWER = "
5088
5089MS06, TEXT "FORMAT = "
5090
5091MS08, TEXT "DIRECTORY"
5092
5093MS09, TEXT "OFFSET = "
5094
5095MS10, TEXT "MODE = "
5096
5097MS11, TEXT "CCB:"
5098
5099MS12, TEXT "ODT LOC = "
5100
5101MS13, TEXT ": "
5102
5103MS14, TEXT " CORE SEGS: "
5104
5105MS15, TEXT "LOOKUP FAILED"
5106
5107MS16, TEXT "FPP"
5108
5109MS17, TEXT " AT "
5110
5111MS18, TEXT " SA = "
5112
5113MS19, TEXT ", JSW = "
5114
5115MS20, TEXT "REL. LOC = "
5116
5117MS21, TEXT "PACKED"
5118
5119MS22, TEXT "ASCII"
5120
5121MS23, TEXT "OS/8"
5122
5123MS24, 2516 /"UNSIGNED"
5124
5125MS25, TEXT "SIGNED"
5126
5127MS26, TEXT "OCTAL"
5128
5129MS27, TEXT "OFFSET"
5130
5131MS28, TEXT "SAVE"
5132
5133MS29, TEXT "NORMAL"
5134
5135MS30, TEXT "OUTPUT = "
5136
5137MS31, TEXT "PDP"
5138
5139MS32, TEXT "BLOCK = "
5140
5141MS33, TEXT ") "
5142
5143MS34, TEXT "LOAD"
5144
5145MS35, TEXT "BCD"
5146
5147MS36, TEXT "BYTE"
5148
5149MS37, TEXT "FILLER = "
5150
5151MS38, TEXT "HEADER:"
5152
5153MS39, TEXT ", NEXT WORD = "
5154
5155MS40, TEXT ", LOAD V "
5156
5157MS41, TEXT ", E.P. REQ'D"
5158
5159MS42, TEXT " OVLYS START BLOCK LENGTH"
5160
5161MS43, TEXT "XS240"
5162\f/MAIN LOOP CHARACTER LIST
5163CCHARL, "#
5164 "$
5165 "%
5166 "&
5167 ":
5168 "<
5169 "=
5170 ">
5171 "?
5172 "@
5173 "[
5174 "\
5175 "]
5176 "/
5177 "!
5178 "+
5179 "-
5180 ";
5181 "^
5182 "_
5183/'TYPE' COMMAND LIST
5184TYPEL, 211 /TAB
5185 233 /ALT MODES
5186 375
5187 376
5188/'XMODIF' CHECK LIST
5189TYPEM, 215 /CR
5190 212 /LF
5191 0
5192
5193/ADDRESSES FOR 'OMODES'
5194OTABLE, 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
5209COPSL, 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
5237TYPEOP, TYPTAB
5238 TYPALT
5239 TYPALT
5240 TYPALT
5241 TYPCR
5242 TYPCR+1
5243
5244/COMMAND WORD LIST FOR COMMANDS NOT FOLLOWED BY CR
5245CWORDL, TEXT "EVE@DUD@LIL@FIF@OPSCSTSMWOW@MOM@SHSES@WRIFEXCOC@"
5246
5247/MAIN LOOP JUMP LIST - EXECUTE A COMMAND
5248WOPSL, 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.
5274CWORL2, TEXT "REWRENEXCLCOC@"
5275
5276WOPSLL, 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----
5284FORML, TEXT "PAP@ASA@OSOSXSX@UNU@SIS@OCO@BCB@BYBYPDPDFPF@DID@"
5285
5286FOPSL, 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
5313FTABLE, 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
5327FMTLS, 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
5342MODIFL, TEXT "PAP@ASA@OSXSNUN@"
5343
5344/'XMODIF' JUMP LIST
5345MODIFO, XPAC0 /PACKED
5346 XPAC0
5347 XASC1 /ASCII
5348 XASC1
5349 XOPS1 /OS/8
5350 XXS20 /XS240
5351 XNUM2 /NUMERIC
5352 XNUM2
5353
5354MODADS, XMOD0 /MODIFL TEST LIST
5355 XMOD0
5356 XMOD0
5357 XMOD0
5358 XMOD0
5359 XMOD0
5360 XMOD0
5361 XMOD0
5362 XMOD0
5363
5364MODDLS, TEXT "PAASOSXSNUNUNUNUNUNUNUNU" /DEFAULT LIST
5365
5366/'XMODIF' CHARACTER JUMP LIST
5367MCHARO, XMODCR /CR, END
5368 RENEXT /LF, IGNORE
5369
5370/'XIF' CHARACTER JUMP LIST
5371IFSKPO, XIFCR /CR, END OF LINE
5372 RENEXT /LF, IGNORE
5373
5374/XNUM JUMP LIST
5375NUMOPS, XNUM1 /,
5376 ERCQ /:
5377 ERCQ /.
5378 XNUM1+1 /SPACE
5379 XNUM3 /CR
5380\f/'XSHOW' COMMAND LIST
5381SHOWL, TEXT "BLB@ODCCC@HEH@ABA@RER@SMVE"
5382 *.-1
5383/'XSET' COMMAND LIST
5384SETLST, TEXT "DDFOF@OUO@ERE@OFUPLOTEDEDMMOFIMAM@
5385
5386/'XSHOW' JUMP LIST
5387SHOWOP, 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
5419SETJMP, 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
5438XELST, TEXT "SHS@LOL@"
5439
5440/'XEMODE' BRANCH LIST
5441XEOPS, XEMOD1 /SHORT
5442 XEMOD1
5443 XEMOD1+1 /LONG
5444 XEMOD1+1
5445
5446/'XOUTS' LISTS
5447XOLST, TEXT "FPF@PDP@OCO@"
5448
5449XOOPS, 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
5457MODLST, TEXT "OFO@SAS@LOL@NON@"
5458
5459/'XMODE' JUMP LIST
5460MODOPS, 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
5470XDMLST, TEXT "ALPANO"
5471
5472XDMOPS, 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"
5480MODELS, 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)"
5488OUTLS, MS26 / 0 = "OCTAL"
5489 MS31 /+1 = "PDP (SYMBOLIC)"
5490
5491
5492/'XWORD' COMMAND LIST
5493XWORCL, TEXT "UNU@"
5494 *.-1
5495/'XSTRIN' COMMAND LIST
5496STRLST, TEXT "FRF@TOT@ABA@MAM@ME"
5497
5498
5499/'XWORD' JUMP LIST
5500XWOROP, 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
5513STROPS, 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'
5523TERMS, "! /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
5535GWLST1, "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 "(
5550GWLST2, 240 /SPACE
5551 215 /CR
5552 0
5553
5554/'GWORD' JUMP LISTS
5555GWOPS1, 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
5570GWOPS2, GWD2 /SPACE - TERMINATOR
5571 GWD3 / CR - "
5572
5573/'ACCEPT' JUMP LIST
5574ACOPS, 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
5593GAROPS, 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
5601GARLST, "-
5602 ",
5603GETLST, ":
5604ARGLST, ".
5605 240 /SPACE
5606 215 /CR
5607 0
5608
5609/'GETNT' LISTS
5610GETOPS, GETCOL
5611 GETPER
5612 GETEND
5613 GETEND+1
5614
5615/'ARG' JUMP LIST
5616ARGOPS, ARG2
5617 ARG3
5618 ARG3
5619
5620/'WCHEK' LISTS
5621WCKLST, "(
5622 ")
5623 ""
5624 "'
5625 215
5626 0
5627
5628WCKOPS, WCHEK5+1
5629 WCHEK5
5630 WCHEK6+1
5631 WCHEK6
5632 WCHEK4
5633
5634/'EVAL' JUMP LIST 1
5635EVOPS1, EVNEXT /+
5636 EVMIN /-
5637 EVLPAR /(
5638
5639/'EVAL' COMMAND LISTS
5640EVLST1, "+
5641 "-
5642 "(
5643 0
5644
5645EVLST2, "L
5646 "B
5647 "S
5648 "C
5649 "F
5650 "R
5651 "T
5652 "D
5653 0
5654
5655/'EVAL' JUMP LIST 2
5656EVOPS2, 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
5666REACTL, "R-100 /CTRL-R = RE-ECHO
5667 "U-100 /CTRL-U = ERASE LINE
5668 0
5669
5670REACTS, RECHO
5671 RERASE
5672\f/ERROR ROUTINE ADDRESS LIST:
5673
5674ERLIST, 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
5726SMASKB, -1 /STRING SEARCH MASK BUFFER
5727 /L(SMASKB)=66(10)
5728COMB= SMASKB+66 /COMMAND INPUT BUFFER
5729 /L(COMB)= 140(10)
5730PDLB= COMB+140 /PUSH-DOWN-LIST BUFFER
5731 /**** ALSO REWIND BUFFER! ****
5732 CCBB-PDLB /SHOW PDL SPACE
5733
5734 OCTAL
5735
5736
5737CCBB= 16400 /CORE-CONTROL-BLOCK BUFFER AND HEADER
5738 / BUFFER FOR LOAD MODULES, 1 PAGE FIELD 1
5739
5740DMPBUF= 16600 /DUMP OUTPUT BUFFER, 2 PAGES FIELD 1
5741
5742IOBUF= 17200 /DEVICE I/O DUFFER, 2 PAGES FIELD 1
5743
5744
5745$$$$
5746\f
My complete PDP-8 universe