1 /FUTIL - FILE UTILITY - V07A
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.
18 / MENLO COMPUTER ASSOCIATES, INC.
19 / (FORMERLY: FRELAN ASSOCIATES)
21 / MENLO PARK, CALIF. 94025
24 /VERSIONS 1 THRU 4 - "XTAPE" FOR THE XSYSTEM,
25 / LAST REVISION--APRIL 1970.
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,
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.
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-
56 / THE DOUBLE PRECISION ARITHMETIC ROUTINES ARE A MUCH
57 / MODIFIED VERSION OF DECUS 8-115A.
60 / ASSEMBLY INFORMATION:
63 / *FUTIL<FUTIL/L/K/P=6400$
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
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
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
92 OVLFLG, 0 /OVERLAY FLAG FOR SAVE FILES
100 /VARIABLES & SWITCHES
101 PDLPT, 0 /P.D.L. POINTER
102 DPNT, RUBO-1 /USED UNIVERSALLY (SCOPE INITIALIZATION)
103 SPNT, SCOPLS-1 /USED BY 'XSTRIN', 'XSMASK', 'READ', 'TERMT'
104 SCANX1, BATLS-1 /USED BY 'SORTJ' (BATCH INITIALIZATION)
105 SCANX2, 0 /USED BY 'XSTRIN'
106 GETPNT, 0 /USED BY 'GET' & 'BKLOC'
107 COMIR, 0 /USED FOR USER LINE INPUT
108 COMOUT, COMB-1 /USED FOR USER LINE SCAN
109 TYPSW, 0 /ODT COMMAND OCT-SYM SWITCH (0=OCT)
110 ERMODE, 0 /ERROR MESSAGE MODE SWITCH (0=LONG)
116 ACC1, 0 /24 BIT ACCUMULATORS
121 NAM1= ACC1 /DEFINITIONS FOR NAME BUFFER:
122 NAM2= ACC1+1 / THESE LOCATIONS ARE USED FOR A
123 NAM3= ACC1+2 / 6 CHARACTER FILE (OR DEVICE)
124 NAM4= ACC1+3 / NAME & A 2 CHAR EXTENSION.
129 TEMPV1, 0 /24 BIT TEMPORARY STORAGE FOR
130 TEMPV2, 0 / "SET TEMP ..." & "EVAL T"
136 NCNT, 0 /LINE POSITION COUNTER
137 FCNT, 0 /FORMAT NUMBER (INIT TO PACKED ASCII)
138 OUTPNT, PACOUT /POINTER TO DEFAULT OUTPUT ROUTINE
139 MODSW, 0 /MODES: NORMAL=0,MAPPED=+,OFFSET=-.
140 CHARSW, 0 /CHARACTER PACK & UNPACK SWITCH
141 CRSWT, 0 /= -1 IF GWORD TERMINATOR WAS A SPACE
142 SHUT, 0 /= -1 IF SOMETHING OPEN
143 MODIF, 0 /= -1 IF SOMETHING WAS MODIFIED
144 ABSSW, 0 /ABSOLUTE OR RELATIVE LOCATION FOR SEARCHES
145 DSWIT, 0 /DUMP SWITCH: "DUMP","LIST" & "SHOW ERR" -> 1
146 DMODE, 0 /DUMP MODE: NONE=0,PART=1,ALL=4000
148 CBLK, 0 /= CURRENT BLOCK
149 0 /DUMMY FOR "SHOW ABS"
150 CAD, 0 /= CURRENT ADDRESS (0 -> 377)+IOBUF
153 LOCL, 0 /= "LOCATION" (DISPLACEMENT)
154 UBLK, 0 /UPPER LIMIT FOR SEARCHES
157 LBLK, 0 /LOWER LIMIT FOR SEARCHES
160 SBLK, 0 /"LOCATION" FOR "ODT" ROUTINES
165 FILLER, 0 /FILLER CONSTANT FOR "MODIFY"
166 MASK, -1 /MASK FOR WORD SEARCH
167 SMASKL, -1 /= -(LENGTH OF SMASK)
168 RBLK1, 0 /START BLOCK OF FILE
169 DEVAD, 7607 /DEVICE ENTRY ADDR (INIT TO "SYS")
170 DEVNO, 1 /DEVICE NUMBER (INIT TO "SYS")
171 USRAD, 7700 /USR ADDRESS, INITIALIZED TO OUT
172 /7700=MSGS IN; 0=NONE IN; 200=USR IN
194 READLN= JMS I . /GET NEXT INPUT LINE, WITH
195 READ / SPECIAL TERMINATORS
201 DIGIT= JMS I . /OUTPUT AN ASCII DIGIT
203 SPACE1= JMS I . /OUTPUT 1 SPACE OR ...
205 SPACE2= JMS I . /OUTPUT 2 SPACES
220 PUSH= JMS I . /PUSH AC ON P.D.L.
222 POP= JMS I . /POP P.D.L. INTO AC
224 CALUSR= JMS I . /DO USR FUNCTION
226 TADIDP= JMS I . /"TAD I DPNT" IN FIELD 1
228 TADICAD= JMS I . /"TAD I CAD" IN FIELD 1
230 DCAICAD= JMS I . /"DCA I CAD" IN FIELD 1
256 \f/PROGRAM MAIN LOOP AND DRIVER. COLLECTS CHARACTERS
257 /INTO COMMAND BUFFER UNTIL END IS REACHED.
259 DCA USRAD /CLEAR ON RESTART (NOTHING IN)!
260 TLS /RAISE TELETYPE FLAG
261 DCA SHUT /NOTHING IS OPEN
262 JMS I CRLFI /OUTPUT CR-LF.
263 MAIN1, JMS I SOCTI /SET INPUT TO OCTAL; EXEC 'COMMENT'
264 DCA DSWIT /RESET DUMP OUTPUT SWITCH
265 TAD COMST /INIT COMMAND BUFFER.
267 TAD (PDLB+1 /INIT PUSH-DOWN-LIST
269 MAIN2, READLN /GET A LINE FROM INPUT.
270 CCHARL-1 /CR LF ; ! / ALT-
271 COPSL-CCHARL / MODES ETC...
272 JMP MAIN1 /BUFFER WAS EMPTIED.
275 /ROUTINE TO HANDLE CARRIAGE RETURN.
276 CRCR, JMS I ENDCI /PUT A CR IN BUFFER
277 JMP CRCRC /ONLY A CR IN BUFFER
278 JMS I GWORDI /GET COMMAND WORD
279 JMP CRCRN /BUFFER BEGINS WITH A #
280 ISZ CRSWT /WORD ENDED BY A CR?
281 JMP CRCR1 /YES, ONLY A FEW ARE OK
282 JMS I SORTI /NO, LOOK UP COMMAND
285 ERCB, ERROR /NOT A LEGAL COMMAND
287 CRCR1, JMS I SORTI /"WRITE","REWIND","EXIT" & "COMMENT"
290 ERCA, ERROR /SOMETHING NOT LEGAL
292 CRCRN, JMS CLOSE /CLOSE THE OPEN LOCATION IF OPEN
293 CRCRC, DCA SHUT / MARK LOCATION CLOSED
296 /ROUTINE TO HANDLE SLASH
297 SLASH, JMS I ENDCI /END BUFFER WITH A CR
298 JMP SLA1 /OPEN LAST, CR ONLY
299 JMS WCHEK /DOES LINE START W. A WORD?
300 JMS I LIMITI /NO, GET ARG--
301 SBLK / & SLOCH & SLOCL
302 SLA1, SPACE1 /OUTPUT SPACE
303 SLO1, JMS ODTOUT /GET THE WORD & OUTPUT
304 SLO2, SPACE1 /FOLLOWED BY 2 SPACES
305 SPACE1 /(FOR ";"--OUTPUT ONLY 1 SPACE AND
306 JMS I ODGETI / THEN FORCE ACTION & IGNORE VALUE)
308 JMP CRCRC /GO MARK LOCATION OPEN
310 /ROUTINE TO HANDLE ALT MODE & ESCAPE KEYS
311 ALTMOD, TAD OUTPNT /USE OUTPUT ROUTINE 'SET' BY
312 JMP ALTM1 / 'FORMAT' OPTION.
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).
321 OMODES, TAD SCANX1 /'SORTJ' POINTER TO CHAR LIST
323 DCA DPNT /POINT INTO ADDR TABLE,
324 TADIDP / GET OUTPUT ROUTINE ADDR,
325 ALTM1, DCA OMODPT / & SET POINTER TO ROUTINE.
326 JMS ECLOSE /CLOSE THIS LOCATION
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.
334 /ROUTINE TO HANDLE BACKARROW.
335 BACKAR, JMS ECLOSE /CLOSE THIS LOCATION
336 TADICAD /GET THE CONTENTS,
337 JMP UPARR1 /AND USE THEM AS THE ADDR
339 /ROUTINE TO HANDLE UPARROW.
340 UPARR, JMS ECLOSE /CLOSE THIS LOCATION
341 TADICAD /IS THIS A 'PAGE 0' REF.?
344 TAD SLOCL /YES, USE PAGE BITS
345 AND M200 / MASK PAGE OR 0 TO PAGE #
346 DCA SLOCL / & SAVE IT
347 TADICAD /GET THE CONTENTS,
348 AND N177 /AND USE THE ADDRESS BITS.
349 TAD SLOCL / ALONG WITH PAGE BITS
350 UPARR1, DCA SLOCL /THIS IS 12 BIT ADDR
351 JMP EXCL2 /NOW GO FINISH
352 \f/ROUTINE TO HANDLE SEMICOLON, LINE FEED & EXCLAMATION.
354 SEMIC, DCA I READLN-4400 /SET NO-OUTPUT SWITCH
355 LFLF, STA /LINE-FEED - CLOSE,INCREMENT,OUTPUT
356 EXCL, DCA OMODPT /EXCLAMATION - CLOSE,DECREMENT,OUTPUT
357 JMS ECLOSE /CLOSE THIS LOCATION
359 DCA ACC1 /SET UP D.P. INCREMENT
361 EXCL1, DCA DPSGN /(FOR SAFETY)
362 ISZ OMODPT /INCREMENT OR DECREMENT?
363 JMS DPNEG / DECREMENT, NEGATE VALUE
366 TAD SLOCL /UPDATE LOCATION TO 15 BITS
371 AND N7 / (BUT ONLY 15 BITS)
373 TAD I READLN-4400 / ANY OUTPUT?
375 JMP SLO2+1 / NO, WAS ";" DO ONE SPACE
376 EXCL2, JMS I CRLFI /GIVE CR/LF FOR NEXT LINE
377 JMS I BKLOCI /OUTPUT ADDRESS
379 JMS I TWOCI /OUTPUT "\ "
381 JMP SLO1 /NOW GO OPEN NEXT LOCATION
383 /ROUTINE TO HANDLE PLUS & MINUS.
384 PLUS, STA /"+", SET SWITCH
385 MINUS, DCA OMODPT /"-", CLEAR SWITCH
386 JMS I ENDCI /END BUFFER, TEST
387 JMP EXCL2 /NO ARG, DO SAME AGAIN
388 JMS WCHEK /LINE START WITH A COMMAND?
389 JMS I ARGI /NO, GET AN ARG
390 JMP EXCL1 /UPDATE LOC & GO OPEN
393 ECLOSE, 0 /SUB. TO CLOSE THE LOCATION IF ARG.
394 JMS I ENDCI /END BUFFER WITH A CR.
395 JMP I ECLOSE /ONLY A CR IN BUFFER, DONE
396 JMS WCHEK /DOES LINE START W. A WORD?
397 JMS CLOSE /ARG IN BUFFER, USE IT
400 CLOSE, 0 /SUBROUTINE TO CLOSE A LOCATION
401 JMS I ARGI /GET ONE ARG
402 ISZ SHUT /ANYTHING OPEN?
403 JMP I CLOSE /NO, RETURN
404 JMS I ODGETI /YES, SET UP THINGS RIGHT
406 DCA MODIF /SET MODIFY FLAG
407 TAD ACC1 /USE "LOC" AS DATA
413 \f/ROUTINE TO 'EVALUATE' A SIGNED DOUBLE PRECISION ARITHMETIC
414 / EXPRESSION & OUTPUT THE RESULTS IN OCTAL & D.P. SIGNED
416 XVAL, JMS I EVALI /GO EVALUATE
417 SKP /TERMINATED BY A CR
418 ERCC, ERROR / SORRY!--TOO MANY ")"S
422 JMS I OCTI /OUTPUT HIGH ORDER IN OCTAL
424 JMS I OCTI /OUTPUT LOW ORDER IN OCTAL
425 TAD ACCX1 /SAVE REMAINDER FOR LATER
430 DCA XERROR /MUST DEVELOP 7 DIGITS
431 JMS I TWOCI /OUTPUT " ("
433 TAD ACC2 /IS DPAC NEG?
435 JMP DLOOP1-1 /NO, OUTPUT " "
436 JMS DPNEG /YES, MAKE IT POSITIVE
437 TAD N15 / AND OUTPUT "-".
439 DLOOP1, TAD (12 /RESET DIVISOR TO 10(10)
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?
447 TAD COMOUT /YES, RESTORE REMAINDER
452 DCA XERROR /NOW SET UP TO OUTPUT 7 DIGITS
453 DLOOP2, POP / IN REVERSE ORDER!
454 DIGIT /MAKE REMAIN A DIGIT
457 JMS I TYPECI /YES, OUTPUT ")"
459 JMP I RECRLF / AND CR/LF
464 CLA /CLEAR POSSIBLE JUNK FROM AC
465 DCA DSWIT /RESET IN CASE DUMP MODE
467 JMS I TYPECI /OUTPUT "?"
469 TAD (ERLIST-1 /INIT LIST POINTER
471 DCA TEMP /SET CODE TO 0
472 XERR1, ISZ TEMP /BUMP ERROR CODE
473 TADIDP /GET AN ADDRESS
475 JMP XERR2 /(FOR DEBUGGING)
477 TAD XERROR /DOES IT MATCH THE CALL?
480 XERR2, TAD TEMP /YES, OUTPUT ERROR CODE
481 JMS I DEC2I / AS 2 DECIMAL DIGITS
482 JMS I TYPSI /NOW OUTPUT " AT "
484 TAD (-COMB+1 /CALCULATE POSITION IN
485 TAD COMOUT / COMMAND BUFFER,
486 JMS I DEC2I / & OUTPUT AS 2 DIGITS.
487 TAD ERMODE /LONG/SHORT MESSAGES? [NOTE: THIS ->
488 XERR3, SZA CLA / "7600" (A CLA) IF 'USROUT' ERROR!]
489 JMP XERR4 /SHORT, GO DO CR/LF
490 JMS USROUT /LONG, BE SURE MESSAGES ARE IN
491 SPACE2 /OUTPUT 2 SPACES
492 TAD TEMP /CODE = ADDRESS-1 OF ADDRESS
493 DCA DPNT / OF MESSAGE
494 TADIDP /GET MESSAGE ADDR
495 JMS I TYPSTI / OUTPUT MESSAGE
496 XERR4, JMS I CRLFI /OUTPUT A CR,LF PAIR
497 JMP I .+1 /*** CIF BAT /BATCH OPER.
498 MAIN1 /*** JMP I N7000 /'BATABT'!
501 USEUSR, 0 /USR CALLER SUBROUTINE (FROM EITHER FIELD!)
502 DCA USRSAV /SAVE CONTENTS OF AC
504 TAD UCDF0 /SET UP RETURN FIELD (FOR 2ND USR CALL)
506 UCDF0, CDF 0 /SET TO HERE FOR 1ST CALL
507 TAD USRAD /IS USR IN OR OUT?
509 JMP USRIN /IN, GO TO IT
511 JMS I M100 /OUT, DO "USRIN" FUNCTION
514 DCA USRAD / & SO INDICATE
516 TAD USEUSR /MOVE RETURN ADDRESS TO THE
517 DCA I N200 / USR ENTRY POINT
518 USRCDF, CDF /SET UP D.F. FOR RETURN
519 TAD USRSAV /RESTORE AC CONTENTS
520 JMP I (201 / & FAKE A CALL TO IT
523 USROUT, 0 /SUBROUTINE TO REMOVE USR BY RECALLING
524 ERC15, TAD USRAD / ERROR MESSAGES FROM SCRATCH
525 SPA CLA / BLOCKS ON SYS.
526 JMP I USROUT /JUST EXIT IF PRESENT...
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
536 DCA XERR3 /NO MORE MESSAGES ON ERROR!
538 DCA ERC15 /AND NO MORE "SHOW ERROR"!
539 ERC16, ERROR /TELL THE HORRIBLE STORY!
543 \f/ROUTINE TO EXECUTE THE BLOCK 'SCAN' COMMAND
544 XSCAN, JMS I GARGI /GET ARGS CONVERTED
545 TAD (SCANER / & SET UP FOR SCANNING
548 /ROUTINE TO EXECUTE THE BLOCK 'DUMP' COMMAND
549 XDUMP, TAD MODSW /MAPPED MODE?
551 ERC14, ERROR /YES, DUMP IS MEANINGLESS!
552 JMS XDLCOM /DO COMMON STUFF
553 TAD (LLIST / & SET UP FOR DUMPING
554 XDUM0, DCA XGFORM /SET OUTPUT ROUTINE--DUMP/SCAN
555 XDUM1, ISZ DPNT /SKIP FIRST WORD
556 ISZ DPNT /SKIP A WORD
557 TAD I DPNT /GET NEXT START BLOCK.
559 TAD I DPNT /GET NEXT -(# BLOCKS)
561 XDUM2, JMS I CTRLI /TEST HERE FOR 'SCAN' TERMINATE
562 DCA LOCL /SET LOC TO 0
564 TAD M400 /SET TO -400(8) [1 BLOCK]
565 JMS I XGFORM /DUMP OR SCAN A BLOCK
566 ISZ BLK /INCREMENT BLOCK NUMBER
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
573 /ROUTINE TO EXECUTE THE LOCATION 'LIST' COMMAND
574 XLIST0, JMS XDLCOM /DO COMMON STUFF
575 XLIS1, TAD I DPNT /GET BLOCK #
576 JMS BLKTST /TEST & SET BLK
577 TAD I DPNT /GET & SET LOCATION
581 TAD I DPNT /GET -(# WORDS)
582 JMS LLIST /NOW GO DO IT
583 ISZ TEMP /ARE ALL ARGS USED?
584 JMP XLIS1 /NO, CONTINUE
585 XLIS2, DCA DSWIT /RESET DUMP SWITCH
586 JMP I RECRLF / DO CR/LF & CONTINUE
588 /COMMON SUBROUTINE FOR 'XDUMP'&'XLIST0'
590 TAD OUTPNT /INITIALIZE DEFAULTS
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
600 /SUBROUTINE TO OUTPUT -[C(AC)] WORDS FROM THE DEVICE
601 /BEGINNING AT BLK.LOC IN THE SPECIFIED FORMAT
603 DCA CNTRA /SET UP -# WORDS TO LIST
604 DCA CHARSW /RESET UNPACK SWITCH
607 AND N7 /SET UP # ON THIS LINE
609 TAD LOUTSW /IF CHARACTER OUTPUT,
611 TAD M10 / DOUBLE # WORDS/LINE
615 JMS I BKLOCI /OUTPUT LOCATION
617 JMS I TYPSI /OUTPUT ": "
619 LLIS2, JMS I GETI /GET A WORD
620 JMP LLIS3 /FILE MODE, NO SUCH ADDR..
621 JMS I LISTPT /OUTPUT IT
622 TAD LOUTSW /TEST MODE SWITCH
624 JMP LLIS5 /"SYMBOLIC", CR/LF NOW
625 SZA CLA /CHARACTERS, NO SPACES
626 SPACE2 /NUMBERS, TWO SPACES
627 LLIS3, JMS I INCI /INCREMENT LOC
628 ISZ CNTRA /ALL WORDS DONE?
631 JMP I LLIST /YES, RETURN
633 LLIS4, ISZ CNTR /ALL DONE WITH THIS LINE?
635 JMP LLIS1 /YES, OUTPUT CR/LF & CONTINUE
638 DCA CNTR /FORCE A CR/LF
644 /SUBROUTINE TO GET A FORMAT FOR 'XFORM' & 'XDLCOM'
646 JMS I GWORDI /GET A WORD
647 JMP I XGFORM /NOT FOLLOWED BY A WORD
648 JMS I SORTI /LOOK UP WORD
651 ERCD, ERROR /WORD NOT RECOGNIZED
653 XFSYM, STL RAR /"SYMBOLIC"; SWITCH NEG
654 XFNUM, IAC /NUMERIC; SWITCH POS
655 XFCHR, DCA LOUTSW /CHARACTER; SWITCH 0
656 TAD SCANX1 /'SORTJ' POINTER TO CHAR
657 TAD (-FORML /CALCULATE FORMAT #
658 CLL RAR /(DIVIDE BY 2)
659 DCA TEMP1 / & SAVE IT.
664 DCA LISTPT /SET UP OUTPUT POINTER
665 ISZ XGFORM /BUMP RETURN ADDRESS
668 /ROUTINE TO 'SET' THE 'FORMAT' OPTION
669 XFORM, JMS XGFORM /GET FORMAT WORD
670 ERCE, ERROR /NUMBER?! SORRY ABOUT THAT!
671 TAD LOUTSW /OK, SET UP DEFAULTS:
674 DCA OUTPNT / ROUTINE POINTER,
676 DCA FCNT / & FORMAT #
678 OUTSW, 0 /MODE:0=NOTHING,+=SPACES,-=CR/LF
682 \f/ROUTINE TO EXECUTE THE 'OPEN' COMMAND.
683 XOPEN, STA /"." LEGAL IN FILE NAME
684 JMS GNAME /GET FILE NAME FOR OUTPUT
686 JMP XOPEN1 /NOW GO TO FIELD 1 TO HANDLE
689 /ROUTINE TO EXECUTE THE 'CLOSE' COMMAND.
691 JMP XCLOS1 /ALL CODE IS IN FIELD 1
694 /ROUTINE TO EXECUTE THE 'FILE' COMMAND.
695 XFIERR, TAD TEMP1 /MADE ALL POSSIBLE ATTEMPTS
696 SMA CLA / AT EXTENSION RETRIES?
697 JMP XFIOUT / YES, ALL TRIES DONE!
698 ISZ DPSGN /THIS WILL SKIP ON 1ST FAIL
699 ISZ TEMP1 /THIS WILL SKIP ON 2ND FAIL
700 TAD (1404 / 2ND TRY--USE "LD" EXTEN
701 DCA NAM4 / 3RD TRY--USE NULL EXTEN
702 JMP XFICHN+2 / 3RD TRY IS FINAL FAILURE
704 XFIOUT, JMS PNAME /OUTPUT FILE NAME &
705 JMS I TYPSI /"LOOKUP FAILED"
708 XFILEN, JMS I CRLFI /OUTPUT CR/LF
709 ISZ CRSWT /WAS LAST ENDED BY A CR?
710 JMP I RESTAR /YES, DONE
711 XFILE, STA /"." LEGAL IN FILE NAME
712 JMS GNAME /GET NEXT FILE NAME
714 DCA DPSGN /SET TRY AGAIN SWITCH
715 TAD (NAM1 /INIT POINTER TO NAME
717 TAD DEVNO /GET DEVICE #
720 FSTBLK, 0 /NAME PNTR, BECOMES ST BLK
721 FBKLEN, 0 / BECOMES -(FILE LENGTH)
722 JMP XFIERR /LOOKUP FAILED
724 DCA RBLK1 /SET UP PAGE 0 ST BLK
726 DCA I (CCBB / & RESET CCBB
727 TAD I (1404 /GET # ADD'L INFO WORDS
728 DCA GDEV2 / (NEGATIVE) & SAVE IT
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?
737 TAD I GDEV3 / NO, GET THE DATE WORD
739 DCA GDEV1 /STORE DATE OR 0 (NO DATE)
740 JMS PNAME /OUTPUT FILE NAME
742 JMS I OCTI /OUTPUT ST. BLK. IN OCTAL
745 TAD FBKLEN /CALCULATE LAST BLK #
748 JMS I OCTI / & OUTPUT IN OCTAL
749 SPACE2 /OUTPUT 2 SPACES
752 JMS I OCTI /OUTPUT LENGTH IN OCTAL
757 JMS I DECI / & AGAIN IN DECIMAL
760 TAD CNTR /GET SEGMENT #
761 JMS I RTL6I / & PUT IN BITS 3-5
762 JMS I TWOCI / TO OUTPUT IT & "."
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
770 JMS I PDATEI /NO, OUTPUT DATE
771 JMP XFILEN /NOW OUTPUT CR/LF & CONTINUE
774 /ROUTINE TO 'SET' THE 'DEVICE' OPTION
775 XDEV, JMS GDEVICE /GET & FETCH DEVICE HANDLER
776 DEVHAN+1 / (2 PAGE HANDLER IS OK)
777 DCA DEVAD /SET UP HANDLER ADDRESS
778 TAD GDEV2 /SAVE DEVICE #
780 DCA RBLK1 / & NO FILE KNOWN
781 DCA SHUT / & NOTHING OPENED
782 DCA MODIF / & NOTHING MODIFIED
785 JMP XDEVM /GO FINISH SETUP IN FIELD 1
788 /ROUTINE TO 'SET' THE 'DDEV' OPTION
789 XDDEV, JMS GDEVICE /GET & FETCH DEVICE HANDLER
790 DMPHAN+1 / (2 PAGE HANDLER IS OK)
792 JMP XDDEV1 /GO TO FIELD 1 TO FINISH SETUP
794 GDEVICE,0 /SUBROUTINE TO GET DEVICE NAME & FETCH HANDLER
795 JMS GNAME /GET DEV NAME ("." ILLEGAL)
796 TAD NAM1 /MOVE NAME TO CALL
800 TAD I GDEVICE /GET HANDLER SPACE ADDRESS
808 ERCY, ERROR /NO SUCH HANDLER
809 TAD GDEV3 /RETURN HANDLER ADDRESS
814 \f/ROUTINE TO EXECUTE THE 'SHOW' COMMAND
815 XSHBLK, JMS I TYPSI /"BLOCK = "
817 TAD RBLK1 /OUTPUT BLOCK IN OCTAL
819 XSHCR, JMS I CRLFI /GIVE A CR & LF
820 DCA DSWIT /BE SURE SWITCH IS RESET
821 ISZ CRSWT /LAST WORD ENDED BY CR?
822 JMP I RESTAR /YES, DONE
823 XSHOW, JMS I GWORDI /GET A WORD
824 JMP ERCG /NUMBERS NOT RECOGNIZED
825 JMS I SORTI /LOOK IT UP
828 ERCG, ERROR /NOT FOLLOWED BY LEGAL WORD
830 XSHVER, JMS I TYPSI /"VERSION = <VERSION><PATCH>"
834 XSHMSK, JMS I TYPSI /"MASK = "
839 XSHOFF, JMS I TYPSI /"OFFSET = "
845 XSHFIL, JMS I TYPSI /"FILLER = "
850 XSHODL, JMS I TYPSI /"ODT LOC = "
852 JMS I BKLOCI /OUTPUT IT
856 XSHREL, JMS I TYPSI /"REL. LOC = "
858 JMS I BKLOCI / & OUTPUT IT
862 XSHABS, JMS I TYPSI /"ABS. LOC = "
864 TAD CAD /OUTPUT LOCATION IN BLOCK
869 XSHBKS, TAD MODIF /HAS BLOCK BEEN MODIFIED?
871 JMP XSHCR / NO, SAY NOTHING!
872 JMS I TYPSI / YES, SAY " MOD"
876 XSHUPP, JMS I TYPSI /"UPPER = "
878 JMS I BKLOCI /OUTPUT IN BLOCK.LOC FORM
882 XSHLOW, JMS I TYPSI /"LOWER = "
888 XSHFMT, JMS I TYPSI /"FORMAT = "
891 TAD (FMTLS-1 /SET UP FOR CORRECT TITLE
893 TADIDP /GET MESSAGE ADDRESS
894 JMS I TYPSTI /OUTPUT DESCRIPTOR
897 XSHMOD, JMS I TYPSI /"MODE = "
899 TAD MODSW /GET CORRECT MESSAGE
900 TAD (MODELS-1 /(OFFSET INTO TABLE)
901 JMP XSHFM /GET ADDRESS & OUTPUT
903 XSHOUT, JMS I TYPSI /"OUTPUT = "
905 TAD TYPSW /SET UP MESSAGE ADDRESS
906 TAD (OUTLS-1 /(OFFSET INTO TABLE)
909 XSHSMS, JMS I TYPSI /"SMASK = "
912 DCA TEMP /-# TO OUTPUT
914 DCA DPNT /SET UP TO OUTPUT
915 TAD M10 /SET LINE LENGTH
918 XSHSM1, JMS I TWOCI /OUTPUT ", "
920 ISZ TEMP1 /ENOUGH ON THIS LINE?
922 JMS I CRLFI /YES, OUTPUT CR-LF
924 STA /MAKE LINE 1 LONGER
925 JMP XSHSM1-3 /AND RESET LENGTH
927 XSHSM2, TADIDP /GET NEXT VALUE
928 JMS I OCTI / & OUTPUT IT
931 JMP XSHCR /OK, GET NEXT WORD
933 XSHDEV, JMS I TYPSI /"DEVICE = XXXX"
935 JMS I TWOCI /NOW OUTPUT " ("
937 TAD DEVNO /GET THE DEVICE #
938 JMS I DEC2I / & OUTPUT AS 2 DIGITS
939 JMS I TYPECI /FINALLY OUTPUT ")"
943 XSHDDEV,JMS I TYPSI /"DDEV = XXXX"
948 FPRNT, 0 /PRINT FIELD DIGIT FROM BITS 6-8
949 RTR /MOVE TO BITS 9-11
951 AND N7 /MASK TO 1 DIGIT
952 DIGIT / & OUTPUT IN ASCII
957 \f/CONTINUATION OF 'SHOW' COMMAND
961 JMS GCCB /SET UP CCB FOR FILE
962 DCA DPSGN / & SET UP SEGMENTS
965 JMS CCHDST /DO SETUP, OUTPUT START
966 JMS I TYPSI /", JSW = "
968 JMS NXTOCT /OUTPUT J.S.W. IN OCTAL
970 JMS I TYPSI /" CORE SEGS: "
974 XSHCC2, TADIDP /GET ORIGIN WORD
976 TADIDP / & COUNT WORD
978 TAD TEMP2 /GO OUTPUT START FIELD
980 TAD TEMP1 / & START ADDR
982 JMS I TYPECI / & A "-"
984 TAD TEMP2 /OUTPUT FIELD AGAIN
986 TAD TEMP2 / PAGE COUNT -> PAGES
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
994 TAD OVLFLG /YES, OVERLAYS? (LINK OUTPUT)
997 DCA DPNT / YES, RESET POINTER
998 JMP XSHHD1 / & CONTINUE
1000 XSHCC4, JMS I TWOCI /OUTPUT SEPARATOR
1002 ISZ CNTR /DONE ON THIS LINE?
1005 SPACE2 /ADD 2 SPACES
1006 STA /AND 1 MORE ITEM PER LINE
1009 /SHOW 'HEADER' HANDLER
1011 JMS GHDR /SET UP HEADER FOR MODULE
1012 JMS I TYPSI /"HEADER:"
1014 JMS CCHDST /DO SETUP, OUTPUT START
1015 JMS I TYPSI /", NEXT WORD = "
1017 TADIDP /GET FIELD DIGIT
1019 JMS NXTOCT /FOLLOWED BY ADDRESS
1020 JMS I TYPSI /", LOAD VER = "
1022 JMS NXTOCT / & OUTPUT VERSION
1023 TADIDP /GET E.P. FLAG
1025 JMP XSHHD1 / NO E.P.
1026 JMS I TYPSI /", EP REQ'D"
1028 XSHHD1, JMS I CRLFI /TO THE NEXT LINE
1029 JMS I TYPSI /" OVLYS START...
1031 XSHHD2, TADIDP /GET NUMBER OF OVERLAYS
1032 SNA / FOR THIS LEVEL
1033 JMP XSHCR / 0 = END, DONE
1035 JMS I CRLFI /OUTPUT A CR/LF
1036 SPACE2 / AND 4 SPACES
1039 JMS I DEC2I /# OVLYS IN DECIMAL
1041 TADIDP /GET MEMORY START WORD
1044 JMS FPRNT /OUTPUT START FIELD
1046 AND M400 / & DOUBLE-PAGE
1049 JMS NXTOCT /OUTPUT RELATIVE BLOCK
1051 JMS NXTOCT /OUTPUT OVERLAY LENGTH
1052 JMP XSHHD2 /AND DO ANOTHER ROUND!
1054 /SHOW 'ERRORS' HANDLER
1055 XSHERR, JMS USROUT /BE SURE MESSAGES ARE IN
1056 ISZ DSWIT /SET DUMP SWITCH
1057 JMS I TYPSI /"ERRORS: FUTIL VERSION ..."
1061 DCA DPNT /SET POINTER & CODE
1062 XSHER1, JMS I CRLFI /DO ANOTHER CR/LF
1063 TAD DPNT /TEST FOR LAST REAL MESSAGE
1064 TAD (-EMSEND /(NOT DEBUG MESSAGE!)
1067 TAD DPNT /OUTPUT ERROR CODE
1068 JMS I DEC2I / AS 2 DIGITS
1069 JMS I TYPSI /THEN " = "
1071 TADIDP /GET ADDR OF MESSAGE AND
1072 JMS I TYPSTI / OUTPUT IT
1078 JMS I TYPSI /" SA = "
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
1089 \f/ROUTINE TO EXECUTE THE 'SET' COMMAND
1090 XSETN, ISZ CRSWT /WAS LAST INFO ENDED BY CR?
1091 JMP I RESTAR /YES, DONE
1092 XSET, JMS I GWORDI /GET OPTION WORD
1093 JMP XSET1 /NO NUMBERS PLEASE!
1094 ISZ CRSWT /WAS WORD ENDED BY A CR?
1095 ERCK, ERROR /YES, ILLEGAL HERE
1096 JMS I SORTI /LOOK UP WORD
1099 XSET1, ERROR /WHAT???
1102 /ROUTINE TO 'SET' THE 'DMODE' (DUMP MODE)
1103 XDMODE, JMS I GWORDI /GET A WORD
1104 JMP ERC11 /NO NUMBERS HERE!
1105 JMS I SORTI /LOOK IT UP
1108 ERC11, ERROR /NO LIKEE!!
1110 CLL STA RAR /4000: 'ALL' (ECHO TO TTY & FILE)
1111 XDMODS, IAC / 1: 'PART' (ONLY DUMP,LIST,ETC)
1112 DCA DMODE / 0: 'NONE' (TTY ONLY)
1116 /ROUTINE TO 'SET' THE 'OUTPUT' OPTION
1117 XOUTS, JMS I GWORDI /GET OPTION WORD
1118 JMP ERCL / # IN THE BUFFER
1119 JMS I SORTI /LOOK IT UP
1122 ERCL, ERROR /NOT FOLLOWED BY LEGAL WORD
1124 CLL STA RAL /-1: 'FPP' (SYMBOLIC)
1125 XOUTS1, IAC /+1: 'PDP' (SYMBOLIC)
1126 DCA TYPSW / 0: 'OCTAL'
1130 /ROUTINE TO 'SET' THE 'MASK' OPTION
1131 XMASK, JMS I ARGI /GET ONE ARG
1133 DCA MASK / & SET MASK
1137 /ROUTINE TO 'SET' THE 'OFFSET' OPTION
1138 XOFFS, JMS I ARGI /GET ONE ARG
1145 /ROUTINE TO 'SET' THE 'ERROR' (MODE) OPTION
1146 XEMODE, JMS I GWORDI /GET WORD
1147 JMP ERCZ /NO NUMBERS ALLOWED!!!
1148 JMS I SORTI /LOOK IT UP
1151 ERCZ, ERROR /ILLEGAL SOMETHING
1153 XEMOD1, IAC /'SHORT'
1158 /ROUTINE TO 'SET' THE 'UPPER' LIMITS OPTION
1159 XUPP, JMS I LIMITI /UPPER, GET ARGS
1163 /ROUTINE TO 'SET' THE 'LOWER' LIMITS OPTION
1164 XLOW, JMS I LIMITI /LOWER, GET ARGS
1168 /ROUTINE TO 'SET' THE 'MODE' OPTION
1169 XMODE, JMS I GWORDI /GET OPTION WORD
1170 JMP ERCJ /NUMBER IN BUFFER, BAIL OUT
1171 JMS I SORTI /LOOK IT UP
1174 ERCJ, ERROR /NOT RECOGNIZED
1176 CLL STA RTL /-1: OFFSET
1177 XMODS, IAC /+2: LOAD (MODULE)
1178 IAC /+1: SAVE (FILE)
1179 DCA MODSW / 0: NORMAL
1182 /ROUTINE TO 'SET' THE 'FILLER' OPTION
1183 XFILL, JMS I ARGI /GET ONE ARG
1185 DCA FILLER / & SET AS FILLER
1188 /ROUTINE TO 'SET' THE 'TEMP' STORAGE
1189 XTEMP, JMS I ARGI /GET THE 24 BIT ARG (EXPRESSION!)
1190 TAD ACC1 /NOW SAVE THE 24 BITS FOR LATER
1192 TAD ACC2 /GET IT BACK WITH "EVAL T"
1193 DCA TEMPV2 / (OR IN AN EXPRESSION)
1197 /ROUTINE TO EXECUTE THE 'IF' COMMAND
1198 XIF, JMS I EVALI /EVALUATE THE EXPRESSION
1199 SKP / TERMIN = CR, OK
1200 JMP ERCC / TOO MANY PARENS
1201 TAD ACC1 /TEST THE 24-BIT VALUE FOR ZERO
1205 JMP I RESTAR /OK, JUST CONTINUE
1206 XIFSKP, TAD COMST /NOT ZERO, BEGIN SKIPPING FOR
1207 DCA COMIR / LINE STARTING WITH "END"
1208 READLN /GET A LINE FROM THE INPUT
1209 TYPEM-1 / WITH THESE TERMINATORS
1211 JMP XIFSKP /BUFFER EMPTIED
1213 XIFCR, JMS I ENDCI /CR FOUND, TIDY THINGS UP
1214 JMP XIFSKP / CR ONLY
1215 JMS I GWORDI /GET 1ST WORD ON LINE
1216 JMP XIFSKP / NO WORD
1217 TAD (-0516 /IS THE WORD "EN..."?
1219 JMP XIFSKP / NO, KEEP LOOKING!
1220 JMP I RESTAR /YES! BEGIN EXECUTION AGAIN!
1223 /ROUTINE TO OUTPUT LOCATION THAT SATISFIED ONE
1224 /OF THE SEARCH COMMANDS. IF ABSSW=0, OUTPUT
1225 /AS RELATIVE LOCATION.
1229 JMP ABK2 /NO, OUTPUT AS ABSOLUTE
1230 JMS I BKLOCI /OUTPUT LOCATION
1232 ABK1, JMS I TWOCI /OUTPUT ": "
1237 ABK2, TAD LOCL /MAKE ABSOLUTE
1240 JMS I BKLOCI /NOW OUTPUT IT
1244 TWOCS, 0 /OUTPUT 2-CHARACTER ARG
1245 TAD I TWOCS /GET ARG
1247 JMS I TWOT /OUTPUT IT
1251 TADIDP /GET NEXT WORD FROM BLOCK
1252 JMS I OCTI / & OUTPUT IN OCTAL
1257 \f/ROUTINE TO EXECUTE THE 'WORD' SEARCH COMMAND
1258 XWORD, JMS SSET /INITIALIZE SEARCH
1259 TAD CNOP /SET UP FOR NORMAL,
1261 TAD M10 / EQUAL SEARCH
1262 XWOR2, TAD (SNA CLA /"UNEQUAL" WORD SEARCH
1264 XWOR1, JMS I GWORDI /GET POSSIBLE WORD
1265 JMP XWOR3 /NUMBERS IN BUFFER
1266 ISZ CRSWT /WAS IT ENDED BY A CR?
1267 ERCI, ERROR /YES, VELLY SOLLY!
1268 JMS I SORTI /LOOK UP COMMAND: UN, ME,
1269 XWORCL-1 / AB, FR, TO
1271 ERCH, ERROR /COMMAND NOT RECOGNIZED
1273 XWOR7, TAD XWOR4+1 /"MEMREF", ONLY MEMORY-
1274 DCA CNOP+1 / REFERENCE OP-CODES CAN
1275 JMP XWOR1 / EVER BE OUTPUT.
1277 XWOR3, JMS I ARGI /GET AN ARG
1278 TAD ACC1 /GET THE VALUE
1281 DCA CNT /LOOK FOR THIS WORD
1282 JMS LSETUP /SET UP COUNT OF WORDS TO DO
1283 XWOR4, JMS I GETI /GET A WORD
1284 JMP XWOR5 /FILE MODE, NO SUCH ADDRESS
1287 XWORC, HLT /WILL BE "SZA CLA" OR "SNA CLA"
1288 JMP XWOR5 /DID NOT MATCH
1289 JMS OPRTST /TEST FOR OP-CODES 6 & 7
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
1297 XWOR5, JMS LCHEK /DONE YET?
1300 /SUBROUTINE TO INITIALIZE THE SEARCH COMMANDS
1302 DCA ABSSW /RESET ABSOLUTE SWITCH
1303 TAD LBLK /SET UP START BLK & LOC
1309 TAD UBLK /SET UP END BLK & LOC
1317 /COMMON OPTIONS FOR 'WORD' AND 'STRING' SEARCHES
1320 DCA ABSSW /'ABSOLUTE'--SET SWITCH
1323 XWSFRM, JMS I LIMITI /'FROM'--GET LOWER LIMITS
1327 XWSTO, TAD UBLK /'TO'--SET UP IF NEEDED
1329 JMS I LIMITI / & GET UPPER LIMITS
1331 XWSRET, STA CLL RAL /= -2, CALCULATE RETURN ADDRESS AS
1332 TAD I GWORDI / LAST CALL TO "GWORD" TO ALLOW
1333 DCA LCHEK / THESE TO BE COMMON TO BOTH
1334 JMP I LCHEK / 'WORD' AND 'STRING' SEARCHES.
1340 LSETUP, 0 /SET SEARCH WORD-COUNTERS **** SEE NOTE ****
1341 DCA ACC1 /INITIALIZE THESE TO 0
1343 TAD MODSW /IN A MAPPED MODE?
1345 JMP LSETL / YES, IGNORE BLOCK PARTS
1346 TAD BLK / NO, SET UP FOR 24 BIT
1351 JMS DSUB /DO THE SUBTRACTION
1352 TAD (400 /NOW SET UP MULTIPLY BY 400
1355 JMS DMUL /GIVES: (BLK-EBLK)*400
1358 DCA OPER1 /NOW SET UP ELOC+1
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.
1368 TAD ACC2 /IF NOT NEGATIVE, ALREADY TOO
1370 JMP I RECRLF / FAR, SO JUST QUIT NOW!
1373 /**** NOTE: COUNT LEFT SET UP IN ACC1 & ACC2 ****
1375 LCHEK, 0 /CHECK IF SEARCH RANGE EXHAUSTED
1376 JMS I INCI /INCREMENT LOC
1377 ISZ ACC1 /COUNT WORDS TO DO
1381 JMP I RECRLF /DO CR/LF & STOP!
1384 TIDPNT, 0 /"TAD I DPNT" IN FIELD 1
1391 ASCII, 0 /ASCII OUTPUT FORMAT FROM DEVICE
1392 AND N177 /MAKE CHARS INTO "STANDARD"
1393 TAD N200 / FORM: 7 BITS + PARITY ON
1394 JMS I TYPEI / TO CAUSE CORRECT PRINTING
1399 \f/ROUTINE TO 'REWIND' THE DEVICE
1401 TAD USRAD /RESET DIRECTORY SEGMENT KEY
1403 DCA I N7 / IN USR IF IT IS IN MEMORY.
1405 JMS I DEVAD /CALL HANDLER
1406 0110 /READ, 1 PAGE, FIELD 1
1407 PDLB /DUMMY BUFFER (ZAP P.D.L.)
1409 JMP RERROR /READ ERROR!
1412 /READ ERROR--TEST TYPE & OUTPUT MESSAGE
1414 RERROR, SPA CLA /BIT 0 = 1 IF FATAL
1416 ERC01, ERROR /NON-FATAL
1419 /ROUTINE TO EXECUTE THE 'STRING' SEARCH COMMAND
1420 XSTRIN, JMS SSET /INITIALIZE
1421 TAD (STJMP-STCDF /RESET MASKING SWITCH
1422 XSTR0, TAD XREWIN / OR SET MASKING SWITCH
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
1433 XSTR1, JMS I GARGI /GET ARGS - THEN REPACK INTO BUFFER
1434 TAD TEMP / MASKING THEM IF SPECIFIED
1435 DCA CNTR /SET UP LENGTH
1437 DCA SCANX2 /STORING DONE IN NEG. FORM
1438 JMP XSTR2+2 /GO SET UP MASK
1440 XSTR2, ISZ TEMP3 /MASK END?
1442 TAD MASKBS /YES, RESET MASK
1444 TAD SMASKL /SET UP LENGTH
1446 XSTR3, ISZ DPNT /SKIP 2 EXTRA WORDS
1448 TAD I DPNT /GET A WORD
1449 JMS STRMSK /TEST & MASK
1452 ISZ DPNT /BUMP POINTER
1455 JMS LSETUP /YES, SET UP COUNT OF WORDS
1456 XSTR4, TAD TEMPST /SET UP FOR SEARCH:
1459 DCA CNTR / & STRING LENGTH.
1461 DCA XLOCL /SAVE CURRENT LOCATION
1466 TAD ACC1 / & COUNT FOR RESET
1470 JMP XSTR6 /NOW SET UP MASK
1472 XSTR5, JMS LCHEK /DONE?
1473 ISZ TEMP3 /NO, AT MASK END?
1475 XSTR6, TAD MASKBS / YES, RESET MASK
1479 XSTR7, JMS I GETI /GET NEXT WORD
1480 JMP XSTR10 /MAPPED MODE, NO SUCH ADDRESS
1481 JMS STRMSK /TEST & MASK
1482 TAD I DPNT /COMPARE?
1484 JMP XSTR10 /NO, GO RESET & CONTINUE
1485 ISZ CNTR /MATCHED ENOUGH?
1487 JMS XRSET /YES, RESET LOCATION & COUNT
1488 TAD TEMP /AND LENGTH
1491 DCA ACCX1 / -(#/LINE)
1492 JMS ABKLOC /OUTPUT THIS LOCATION
1493 XSTR9, JMS I GETI /GET A WORD
1494 JMP ERCP /BAD,BAD,BAD!!!
1495 JMS I OCTI /AND OUTPUT IN OCTAL
1496 JMS I INCI /INCREMENT LOC
1498 JMP XSTR11 /NO, CONTINUE
1499 JMS I CRLFI /YES, OUTPUT CR/LF
1500 XSTR10, JMS XRSET /RESET LOCATION & COUNT
1502 JMP XSTR4 /NO, LOC INC'D, TRY NEXT
1504 XSTR11, SPACE2 /OUTPUT " "
1505 ISZ ACCX1 /DONE ON THIS LINE?
1506 JMP XSTR9 /NO, NOT YET
1510 XRSET, 0 /RESET BLK & LOC FROM XBLK & XLOC
1517 TAD OPER1 /WORDS LEFT TO SEARCH
1523 STRMSK, 0 /STRING MASKING *** NEXT WORD MODIFIED ***
1524 SMSKSW, CDF 10 /"CDF 10" OR "JMP I STRMSK"
1525 AND I SPNT /OK, MASK IN FIELD 1
1537 \f/ROUTINE TO EXECUTE THE BLOCK 'WRITE' COMMAND
1538 XWRARG, JMS I ARGI /GET ONE ARG
1539 TAD ACC1 /USE IT AS THE BLOCK
1541 XWRITE, TAD WBLK /SET BLOCK
1543 JMS I DEVAD /CALL HANDLER
1544 4210 /WRITE, 2 PAGES, FIELD 1
1546 XWBLK, 0 /[** COUNTER FOR MODIFY **]
1547 JMP WERROR /WRITE ERROR
1548 DCA MODIF /CLEAR SOMETHING-CHANGED FLAG
1551 /WRITE ERROR--TEST TYPE & OUTPUT MESSAGE
1553 WERROR, SPA CLA /BIT 0 = 1 IF FATAL
1555 ERC03, ERROR /NON-FATAL
1558 /ROUTINE TO EXECUTE THE 'MODIFY' COMMAND
1559 XMODIF, JMS I GWORDI /GET FORMAT WORD IF ONE
1560 JMP XMODEF /NONE, GET DEFAULT
1561 DCA MODTMP /SAVE FOR LATER
1562 ISZ CRSWT /TERMINATED BY A CR?
1563 JMP ERCO / YES, SAVE USER FROM HIMSELF!
1564 TAD MODTMP /TEST FORMAT FOR RECOGNITION
1568 ERCO, ERROR / I THEENK YOU USE BAD WORD!
1570 /NO FORMAT DESCRIPTOR GIVEN, USE DEFAULT
1571 XMODEF, TAD FCNT /USE CURRENT FORMAT,
1572 TAD (MODDLS-1 / WITH A LITTLE DIFFERENCE
1574 TADIDP /GET THE ONE TO USE
1575 DCA MODTMP / AND SAVE IT
1577 XMOD0, JMS I GARGI /OK, NOW GET ARGS
1578 TAD TEMP /MOVE COUNT TO A SAFE PLACE
1580 XMOD1, TAD I DPNT /GET BLOCK #
1581 JMS BLKTST /TEST & SET BLK
1586 TAD I DPNT /GET -(# LOCS)
1588 XMOD2, TAD COMST /INIT COMM. BUFF. FOR MODS
1590 DCA CHARSW /RESET HALF SWITCH
1591 JMS I SOCTI /INITIALIZE INPUT TO OCTAL
1592 JMS I BKLOCI /OUTPUT START LOC
1594 JMS I TWOCI /AND ": "
1596 READLN /GET A LINE (TEST: RUBOUT, ^U & ^R)
1597 TYPEM-1 /IGNORE LF'S
1599 JMP XMOD2 /BUFFER EMPTIED!
1603 XMODCR, JMS I ENDCI /END BUFFER WITH A CR.
1604 JMP XMOD2 /ONLY A CR IN BUFFER-RETRY!
1605 TAD MODTMP /NOW LOOK UP FORMAT
1609 ERCP, ERROR /ILLEGAL (EXTRA BAD IF HERE)
1611 XMODDN, ISZ XWBLK /RETURN HERE, ALL ARGS DONE?
1616 XGET, 0 /SUB. TO SET CURRENT LOC & FLAG
1617 JMS I GETI /SET LOCATION
1618 ERC07, ERROR /MAPPED MODE, NO SUCH ADDRESS
1623 /NUMERIC FORMATS HERE
1624 XNUM0, JMS I SORTI /TEST TERMINATOR
1625 GETLST-1-1 /SPACE, COMMA, CR
1627 JMP ERCQ /ILLEGAL TERMIN
1629 XNUM1, JMS I GETNI /COMMA, SKIP IT
1630 JMS I SSKIPI / SPACE, IGNORE IT
1631 XNUM2, JMS EXPRIN /GET NEXT ARG--EXPRESSION
1632 JMS XGET /SET UP LOCATION
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
1640 XNUM3, TAD CNTR /DONE?
1643 JMS XGET /NO, SET UP LOC
1645 DCAICAD /AND FILL WITH 'FILLER'
1646 JMS I INCI /INCREMENT LOC
1652 JMS CGET /GET A CHAR & CHECK FOR CR
1653 XASC1, JMS XGET /SET UP LOC & SET FLAG
1655 DCAICAD /STORE THIS CHAR
1656 JMS I INCI /INCREMENT LOC
1657 ISZ CNTR /MODS DONE?
1661 CGET, 0 /GET NEXT CHAR. IF CR, MODS DONE
1662 JMS CGTEST /GET & TEST NEXT
1663 JMP XNUM3 /CR, FILL REST WITH 'FILLER'
1666 CGTEST, 0 /SUB. TO GET A CHAR & CHECK FOR CR
1667 JMS I GETNI /GET NEXT CHARACTER
1668 TAD CHAR /IS IT A CR?
1671 ISZ CGTEST /RETURN TO CALL+2 IF NOT
1675 DO1SP, 0 /OUTPUT " " + AC
1678 JMP I DO1SP /ANOTHER TUFFIE
1680 DO2SP, 0 /OUTPUT " " + AC (PACKED ASCII)
1683 JMP I DO2SP /FAST & SWEET!
1687 \f/ROUTINE TO EXECUTE THE 'SMASK' (STRING MASK) COMMAND
1688 XSMASK, JMS I GARGI /GET ARGS
1690 DCA SMASKL /SAVE -(MASK LENGTH)
1691 TAD MASKBS /SET UP TO STORE WORDS
1693 XSMAS1, ISZ DPNT /SKIP 2 WORDS
1695 TAD I DPNT /GET & STORE ONE
1699 ISZ DPNT /SKIP 1 MORE
1705 /XS240 PACKED ASCII FORMAT HERE
1706 XXS20, TAD M240 /SET OFFSET
1707 /PACKED ASCII FORMAT HERE
1708 XPAC0, DCA PNAME /CLEAR OFFSET
1709 XPAC1, TAD M240 /IS CHAR < 240?
1712 JMP XPAC2 /NO, JUST PACK CHAR
1714 JMS PACK /YES, PACK A FLAG (77) FIRST
1715 XPAC2, TAD CHAR /NOW GO PACK CHAR
1716 TAD PNAME /(WITH DESIRED OFFSET)
1718 JMS CGET /NOW GET & TEST NEXT
1719 JMP XPAC1 / OK, CONTINUE
1722 XOPS1, TAD LOCL /TEST START & COUNT FOR EVEN
1723 RAR /(LOW BIT TO LINK &
1726 RAR /(LOW TO LINK, LINK TO AC0)
1727 SZL SPA CLA /BOTH L=0 & AC0=0 FOR OK
1728 ERC04, ERROR /START OR COUNT NOT EVEN
1729 XOPS2, TAD CHARSW /GET SWITCH
1730 ISZ CHARSW / & BUMP IT
1731 CLL RAR /ROTATE AC 11 INTO LINK
1732 SZL SNA CLA /CHARACTER 3?
1733 JMP XOPS5 /NO, CHAR 1 OR CHAR 2
1735 TAD CAD /YES, BACK UP POINTER
1737 STA CLL RAL / & SET LOOP COUNT TO -2
1739 XOPS3, TAD CHAR /GET REST OF CHAR
1740 CLL RTL /4 BITS LEFT
1743 TAD CHAR /NOW MERGE 4 BITS WITH
1744 AND N7400 / A PREVIOUS CHAR
1746 DCAICAD /4 BITS OF 3RD + 1ST OR 2ND
1747 ISZ CAD /BUMP POINTER
1750 TAD CNTR /YES, DONE ALL MODS?
1752 JMP XMODDN /YES, TEST FOR DONE
1753 XOPS4, JMS CGET /GET & TEST NEXT CHAR
1754 JMP XOPS2 /OK, DO NEXT
1756 XOPS5, JMS XGET /SET UP CURRENT LOC
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
1764 PACK, 0 /SUB. TO PACK CHARACTERS
1765 AND N77 /USE ONLY 6 BITS
1766 ISZ CHARSW /CHECK HALF
1768 TADICAD /RIGHT HALF, ADD TO LEFT
1770 TAD CNTR /ALL MODS DONE?
1775 PACK1, JMS I RTL6I /LEFT HALF, ROTATE INTO IT
1777 JMS XGET /SET UP CURRENT LOC
1780 JMS I INCI /INCREMENT LOC
1781 ISZ CNTR /BUMP COUNTER FOR LATER
1782 NOP / SO DON'T SKIP NOW
1784 DCA CHARSW /RESET SWITCH
1788 PNAME, 0 /PRINT A FILE NAME, PADDED W. SPACES
1790 JMS I TWOT / OUTPUT UP TO
1792 JMS I TWOT / 6 CHARACTERS
1794 JMS I TWOT / OF FILE NAME,
1795 JMS I TYPECI / A "."
1797 TAD NAM4 / & UP TO 2 CHARS
1798 JMS I TWOT / OF EXTENSION.
1799 PNAME1, SPACE1 /OUTPUT A " "
1800 TAD NCNT /11(10) CHARS ON LINE YET?
1803 JMP PNAME1 /NO, OUTPUT ANOTHER SPACE
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.
1814 TAD I LIMITS /GET ADDRESS OF 3 WORDS
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
1825 DCA I PNAME /STORE HIGH 3 BITS
1828 DCA I PNAME / & LOW 12 BITS OF ADDR.
1833 \f/SUBROUTINE TO 'GET' A WORD FROM THE DEVICE.
1835 / THE ACTUAL WORD ON THE DEVICE THAT IS ACCESSED
1836 / IS DEPENDENT ON THE MODE SWITCH, AS FOLLOWS:
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.
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
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.
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.
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.
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
1896 JMS I CTRLI /GO TEST FOR CONTROL-CHARS
1897 TAD MODSW /OK, TEST MODE
1899 JMP GET0 /NORMAL MODE, NO CHANGES
1901 JMP GET4 /SAVE MODE, DO MAPPING
1902 TAD OFFSET /OFFSET MODE, ADD IT
1903 GET0, JMS DBLPGS /NOW ADD 'DOUBLE PAGES'
1904 TAD BLK / OF LOC TO BLK TO SET
1905 DCA CBLK /'CURRENT BLOCK'
1906 GET1, JMS GETIO /OUTPUT CURREN (IF NEEDED), GET NEXT
1907 JMP RERROR / READ ERROR, GO TELL ABOUT IT
1908 TAD MODSW /TEST AGAIN FOR OFFSET
1910 TAD OFFSET /YES, ADD IT AGAIN
1911 TAD LOCL /USE 8 ADDRESS BITS FROM LOC
1913 TAD BUFST /INTO BUFFER, TO SET
1914 DCA CAD /'CURRENT ADDRESS'
1915 TADICAD /NOW GET THE WORD
1916 ISZ GET /RETURN TO CALL+2 WITH IT
1917 GETX, JMP I GET /[EXIT TO CALL+1 FOR MAP FAIL]
1919 GETIO, 0 /DO I/O FOR 'GET' & 'SCANER'
1920 TAD CBLK /IS THIS SAME BLOCK AS IS IN
1921 CIA /CORE CURRENTLY?
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
1931 JMP WERROR /WRITE ERROR
1932 GETIO1, TAD CBLK /NOW UPDATE OUTPUT BLOCK
1934 TAD CBLK / AND INPUT BLOCK #
1936 DCA MODIF / AND RESET SWITCH
1937 TAD CBLK /SHOW BLOCK NUMBER IN LIGHTS
1938 MQL / (IF THERE ARE ANY!)
1940 JMS I DEVAD /CALL DEVICE HANDLER
1941 0210 /READ, 2 PAGES, FIELD 1
1943 RBLK, -1 /(NOTHING IN CORE-ILLEGAL BLK #)
1944 JMP I GETIO /READ ERROR
1945 GETIO2, ISZ GETIO /OK, DO NORMAL RETURN
1949 DBLPGS, 0 /CONVERT LOCATION TO DOUBLE-PAGES
1951 AND M400 /HIGH 4 BITS HERE
1952 CLL RAL /BECOME LOW 4 BITS
1953 TAD LOCH /FOR A 7 BIT VALUE
1959 /GET WORD ROUTINE FOR "ODT" COMMANDS
1962 TAD SBLK /SET UP BLOCK
1967 DCA LOCL /SET UP LOCATION
1968 JMS I GETI /NOW GET WORD
1969 ERC05, ERROR /MAPPED MODE, NO SUCH ADDRESS
1970 JMP I ODGET / & RETURN WITH IT
1973 /OUTPUT 12 BIT BLOCK # & 15 BIT ADDRESS IN OCTAL
1976 TAD I BKLOC /GET ARGUMENT (ADDR-1)
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
1983 JMS I TWOCI / & OUTPUT "." & IT
1985 TAD I GETPNT /GET ADDRESS
1986 JMS I OCTI / & OUTPUT IT
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
1995 JMS I SSKIPI /GET NEXT NON-SPACE
1997 AND N77 /USE THIS CHAR AS LEFT
1998 JMS I RTL6I / 6 BITS.
2000 JMS I SORTI /CHECK FOR ^K, ^D, (, ", ',
2001 GWLST1-1 / DIGITS, SPACE & CR
2003 JMS I GETNI /NONE, IS NEXT A SPACE
2004 JMS I SORTI / OR A C.R.?
2007 TAD CHAR /NONE, USE AS LOWER 6 BITS
2011 GWD1, JMS I GETNI /LOOK FOR SPACE OR C.R.
2015 JMP GWD1 /NEITHER, KEEP LOOKING
2017 GWD2, STA /SPACE FOUND, SET SWITCH
2018 GWD3, DCA CRSWT /CR FOUND, RESET SWITCH
2019 TAD CHARSW /RETURN WITH WORD
2020 ISZ GWORD / TO CALL+2
2022 /EXIT TO CALL+1 IF ANY NUMERIC ITEM FOUND--
2023 / ^K, ^D, (, ", ', DIGITS
2026 /"DIRECTORY" FORMAT OUTPUT ROUTINE
2028 JMS I OCTI /OUTPUT IN OCTAL FIRST
2031 JMS DIROUT / THEN 3 OTHERS
2034 /"?" ODT OUTPUT ROUTINE
2036 CIA /ASSUME WAS NEGATIVE
2037 JMS I DECI / & OUTPUT IN DECIMAL
2040 JMS I PDATEI /OUTPUT AGAIN AS DATE
2043 JMS I TWOT /OUTPUT LAST TIME AS PACKED ASCII
2048 \f/CONTINUATION OF 'GET' -- MAPPING FOR "SAVE" AND "LOAD"
2051 GET4, JMS DBLPGS /GET # DOUBLE-PAGES
2054 TAD MODSW /TEST FOR SAVE OR LOAD MODE
2056 JMP GETL1 / LOAD MODE
2058 JMS GCCB /SAVE MODE, GET CCB
2059 DCA SEGCNT / & SET UP # SEGMENTS
2060 TAD RBLK1 /SET UP ACTUAL FIRST BLOCK
2062 DCA CBLK / FOR MAPPING.
2064 TAD I GETPNT /GET AN ORIGIN WORD
2066 TAD I GETPNT / & A CONTROL WORD.
2069 TAD GETCW /TEST FOR FIELD MATCH
2072 AND N7 /(MASK OFF COUNT)
2076 JMP GETS2 /NO, TRY NEXT SEGMENT
2077 TAD LOCL /YES, NOW TEST ADDRESSES
2078 AND M200 /(MASK TO PAGE)
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)
2088 STL RAR / 0 => 40, THEN SUBTRACT
2089 TAD M100 / ONE PAGE)
2092 JMP GETS2 /NO, TRY NEXT
2093 TAD GETORG /YES, UPDATE CBLK TO RIGHT
2095 JMS UPCBLK / ACTUAL BLOCK
2096 TAD BLK /MUST BE IN "LVL 0" OR
2098 JMP GETX / RETURN AS BAD
2099 JMP GET1 /NOW GO GET THE DATA
2102 TAD GETCW /UPDATE CBLK
2105 STL RAR /(MAKING 0 => 40)
2106 TAD (100 /(ROUND UP PAGE COUNT)
2108 ISZ SEGCNT /ALL SEGMENTS DONE?
2109 JMP GETS1 /NO, TRY NEXT
2110 TAD OVLFLG /YES, OVERLAYS? (LINK OUTPUT)
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
2118 JMS GHDR /GET & TEST HEADER
2120 TAD I GETPNT /GET NUMBER OF OVERLAYS
2122 TAD I GETPNT /GET PAGE & FIELD
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
2130 TAD GETCW /GET DBL-PAGE & FIELD
2132 JMP GETX / 0 = THE END!!!
2133 AND M400 /CONVERT TO DBL-PAGE #
2136 TAD GETCW / IN BITS 5-11
2139 CIA /-(DBL-PG # OF OVLY START)
2140 TAD CAD /+(DBL-PG # OF DESIRED)
2142 JMP GETL3 / GONE TOO FAR, MISSED IT!
2143 DCA GETCW /= RELATIVE BLOCK NUMBER
2144 TAD GETCW /IS THIS WITHIN THIS OVLY?
2148 JMP GETL2 / NO, TRY NEXT OVERLAY
2149 TAD BLK /OK, SET UP -(#LVL +1)
2152 TAD GETORG /ADDR IS OK, IS THERE A
2153 TAD SEGCNT / LEVEL WANTED?
2155 JMP GETX /ILLEGAL LEVEL; TOO FAR--EXIT
2156 TAD GETCW /ALL OK! ADD RELATIVE BLK
2158 GETL4, TAD SEGCNT / TO (LVLS-1)*LENGTH
2160 DCA CBLK / TO OVERLAY START BLOCK
2161 ISZ GETORG /[MULTIPLY BY ADDING]
2169 JMS I RTR6I /MOVE COUNT TO BITS 6-11
2170 CLL RAR /DIVIDE FOR DOUBLE PAGES
2178 \f/NUMERIC OUTPUT SUBROUTINES, NO ZERO SUPPRESSION:
2180 OPRT, 0 /4-DIGIT OCTAL
2188 OCT3, 0 /3-DIGIT OCTAL
2195 BPRT, 0 /3-DIGIT BCD
2203 SGNDP, 0 /4-DIGIT DECIMAL, SIGNED
2208 SPACE1 /OUTPUT "-" OR " "
2209 TAD NUMB /NOW OUTPUT IN DECIMAL
2217 DPRT, 0 /4-DIGIT DECIMAL, UNSIGNED
2225 DEC2, 0 /2-DIGIT DECIMAL, UNSIGNED
2226 AND N177 /MASK IT FIRST
2234 NUMOUT, 0 /THE REAL OUTPUT SUBROUTINE
2235 DCA NUMB /SAVE THE NUMBER
2236 NUMO1, DCA NUMDGT /RESET "DIGIT" TO 0
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
2247 TAD NUMDGT /OUTPUT THE "DIGIT"
2249 ISZ NUMOUT /BUMP TO NEXT ARG
2250 TAD I NUMOUT /DONE ENOUGH?
2253 TAD NUMB /YES, SO OUTPUT THE LAST
2255 JMP I NUMOUT /AND RETURN
2259 SSKIP, 0 /SKIP SPACES IN COMMAND BUFFER.
2261 TAD M240 /IS THIS A SPACE?
2263 JMP I SSKIP /NO, DONE
2264 JMS I GETNI /YES, GET NEXT CHAR
2265 JMP SSKIP+1 / & GO TRY IT
2268 /OS/8 ASCII OUTPUT SUBROUTINE. OUTPUTS 1 CHAR
2269 / FOR EVEN WORD & 2 CHARS FOR ODD WORD.
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
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.
2285 JMS OSSET /DO SETUP FOR UNPACKING
2286 JMS OCT3 /3 DIGIT OCTAL OUTPUT
2287 ISZ CHARSW /UNPACK 2ND "CHAR"?
2289 JMP I BYTEO / DONE, RETURN
2290 SPACE2 /YES, BUT OUTPUT 2 SPACES
2291 JMP OSUNPK / BEFORE DOING UNPACKING
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
2302 OSSET, 0 /ENTER HERE TO INITIALIZE
2305 AND LOCL /AC = 0 OR 1
2306 CMA /AC = -1 OR -2 (-# TO DO)
2307 DCA CHARSW /SET UP UNPACK COUNT
2308 OSRETN, TAD INC /GET VALUE TO AC
2309 AND N377 /MASK TO 8 BITS
2312 OSUNPK, STA /JUMP HERE IF 2ND CHAR TO GET
2314 DCA SGNDP /POINT TO HIGH WORD
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
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
2324 CLL RTR / MOVE TO BITS 4-7
2326 JMP OSRETN /GET OTHER BITS & RETURN!
2329 /SUBROUTINE TO INCREMENT THE "CURRENT LOCATION"
2332 ISZ LOCL /INCREMENT LOW 12 ADDR BITS
2335 TAD LOCH /LOW OVERFLOW, INCR. HIGH
2336 TAD (7771 / 3 ADDRESS BITS (& TEST)
2339 SZL /DID HIGH OVERFLOW ALSO?
2340 TAD N200 / YES, THEN BUMP BLK ALSO
2347 \f/OUTPUT PACKED STRING, ADDRESS IN CALL+1,
2348 / TERMINATOR IS XX00.
2355 /OUTPUT PACKED STRING, ADDRESS IN AC, TERMIN IS XX00
2369 /PACKED ASCII OUTPUT ROUTINE
2372 TAD GNAME /USE LEFT 6 BITS
2375 TAD GNAME /USE RIGHT 6 BITS
2379 /OUTPUT TRIMMED OR UNTRIMMED ASCII IN THE AC
2380 ONECHR, 0 /NO CODE FOR CR/LF
2383 JMP I ONECHR /IGNORE "@"
2392 /SUBROUTINE TO MATCH CHAR AGAINST LIST1 AND JUMP
2393 /THROUGH LIST2 WHEN MATCH FOUND. BOTH LISTS IN
2398 TAD CHAR /USE CHAR IF AC = 0
2399 DCA SORTEM /ITEM TO LOOK UP
2401 ISZ SORTJ /GET LIST1 ADDRESS
2404 TAD I SCANX1 /COMPARE WITH SORTEM
2407 JMP SORT2 /END OF LIST
2410 SZA CLA /DOES IT MATCH?
2411 JMP SORT1 /NO, TRY NEXT
2412 TAD SCANX1 /YES, GET ADDRESS...
2414 DCA SORTJ /...OF JUMP ADDRESS
2419 JMP I SORTJ /GO TO ROUTINE
2420 SORT2, ISZ SORTJ /MATCH NOT FOUND,
2421 JMP I SORTJ /EXIT TO CALL+3
2425 /SUBROUTINE TO GET A NAME FOR 'XOPEN', 'XFILE', 'XDEV' & 'XDDEV'
2427 GNAME, 0 /GET A FILE OR DEVICE NAME
2428 DCA TEMP1 /SET UP "." SWITCH AND
2429 TAD TEMP1 / FILE/DEVICE SWITCH
2432 DCA NAM2 /CLEAR NAME AREA
2434 TAD (2326 / & INIT EXTENSION TO "SV"
2436 TAD (NAM1 / & INIT POINTER FOR NAME
2438 JMS I SSKIPI /SKIP LEADING SPACES
2440 TAD COMOUT /BACK UP THE POINTER
2442 JMS GPAIR /1ST & 2ND CHAR
2443 JMS GPAIR /3RD & 4TH
2444 GETSCN, JMS GPAIR /5TH & 6TH OR 1ST & 2ND EXT.
2445 JMS GETNT /SCAN FOR TERMINATOR
2449 GETCOL, TAD TEMP2 /":" SEEN, DEVICE OR FILE NAME?
2451 JMP GETNTC / FILE, JUST USE THE ":"
2452 ISZ TEMP2 / DEVICE, FLAG ":" SEEN
2453 JMP GETSCN+1 / AND SCAN TO TERMIN.
2455 GETPER, ISZ TEMP1 /"." FOUND, FIRST ONE?
2456 ERCM, ERROR /NO, THE END...
2457 DCA NAM4 /YES, RESET EXT,
2458 TAD (NAM4 / SET POINTER
2460 JMP GETSCN / & GO GET IT
2462 GETEND, STA /TERM = SPACE, SET SWITCH
2463 DCA CRSWT /TERM = CR, RESET SWITCH
2464 JMP I GNAME /..DONE....
2466 GETNT, 0 /GET & TEST A CHAR
2467 JMS I GETNI /GET NEXT CHAR
2468 JMS I SORTI /TEST IT
2471 GETNTC, TAD CHAR /OK, USE CHAR
2472 AND N77 /MASK TO 6 BITS
2473 JMP I GETNT / & EXIT WITH IT
2475 GPAIR, 0 /GET RIGHT/LEFT-HALF-CHARS
2477 JMS I RTL6I /TO LEFT HALF
2478 DCA I TEMP / & STORE IT
2480 TAD I TEMP /MERGE WITH LAST LEFT
2482 ISZ TEMP /BUMP POINTER
2485 RTL6, 0 /ROTATE AC 6 LEFT
2491 RTR6, 0 /ROTATE AC 6 RIGHT
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
2511 READ, 0 /READ AND ECHO INPUT CHARACTER
2512 TAD I READ /GET TWO LIST ADDRESS PARAMETERS
2514 DCA RETERM / FROM CALLER AND SET UP IN
2515 TAD I READ / SORT ROUTINE CALL
2518 RENEXT, JMS RKEY /GET A CHAR
2519 JMP RUBO /RUBOUT, GO BEGIN DELETIONS
2521 JMS I SORTI /CHECK FOR CTRL-R & CTRL-U
2526 JMS I SORTI /CHECK FOR CALLER TERMINATORS
2527 RETERM, 0 / PARAMETERS HERE
2529 TAD CHAR /NONE, JUST STORE IN BUFFER
2531 RESPC, TAD (" /FOR CAMMAND INPUT, TAB -> SPACE!
2533 DCA I COMIR /COMMAND (LINE) INPUT BUFFER
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.
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.
2546 RUBO, JMS BTEST /RUBOUT TYPED,TEST FOR EMPTY
2547 JMP RUBOF / INPUT BUFFER EMPTY!
2548 JMS I TYPECI /OK, OUTPUT 1ST "\"
2550 RUBO1, JMS BTEST /NOW EMPTY?
2551 JMP RUBOE / YES, LINE END
2552 TAD COMIR /ECHO LAST CHAR IN BUFFER
2559 TAD COMIR /NOW BACK UP POINTER
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 "\"
2567 JMP REKEY /& GO USE NEW CHAR
2569 RUBOE, JMS I TYPECI /BUFFER WAS EMPTIED,
2570 "\ /OUTPUT CLOSING "\"
2571 RUBOF, JMS I CRLFI / & A CR/LF
2574 RECHO, JMS I TYPECI /ECHO "^R" & THEN
2576 JMS I CRLFI /ECHO CURRENT LINE
2577 TAD COMST /INIT AUTO-XR
2579 RECHO1, TAD COMOUT /DONE?
2583 JMP RENEXT /YES, MORE INPUT
2584 JMS I GETNI /NO, GET NEXT CHAR
2585 JMS I TYPEI / & OUTPUT IT
2586 JMP RECHO1 / & CONTINUE
2588 RERASE, JMS I TYPECI /OUTPUT "^U"
2590 JMP RUBOF /GO OUTPUT CR/LF & EXIT
2592 BTEST, 0 /TEST FOR COMM. BUFFER 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
2608 JMP RKEY+1 /NULL CHAR
2609 TAD (-177 /IS IT A RUBOUT?
2611 RKEY0, JMP I RKEY /YES, EXIT TO CALL+1 /*** BATCH
2612 ISZ RKEY /NO, EXIT TO CALL+2 /*** OPER.
2613 TAD (2 /TEST FOR ALT-MODES
2615 JMP RKEY1 / 375 OR 376
2616 TAD (35 /IS IT LOWER CASE?
2618 TAD (-40 /YES, MAKE UPPER CASE
2620 RKEY1, TAD (375 /RESTORE CHAR & ADD PARITY
2621 JMP I RKEY / & EXIT WITH IT
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.
2628 TAD (215 /PUT A CR IN BUFFER
2632 TAD COMST /INIT'L BUFFER UNLOAD
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
2645 DODIG, 0 /OUTPUT AC AS AN ASCII DIGIT
2652 \f/'FPP'/OCTAL/'PDP' OUTPUT ROUTINE FOR ODT
2654 TAD TYPSW /-1, 0, +1
2655 TAD (TAD ODTOL /GENERATE ADDRESS OF DESIRED
2656 DCA ODTOPT / OUTPUT ROUTINE
2657 ODTOPT, HLT /[USED TWICE!]
2659 JMS I ODGETI /GET SPECIFIED WORD
2660 JMS I ODTOPT / & OUTPUT IT
2663 FPPDMP /-1 = OCTAL + FPP
2664 ODTOL, OPRT / 0 = OCTAL
2665 PDPDMP /+1 = OCTAL + PDP
2668 /OCTAL & 'PDP' (SYMBOLIC) DUMP ROUTINE
2670 JMS I OCTI /FIRST OUTPUT IN OCTAL
2671 SPACE2 /FOLLOWED BY 2 SPACES,
2672 JMS PDPOUT / & THEN AS 'PDP'
2676 /'PDP' (SYMBOLIC) INSTRUCTION DECODING
2679 JMS OPRTST /TEST FOR OPR & IOT
2682 SYMS, JMS GETOP /GET OP-CODE TO BITS 9-11
2684 JMS SYMTYP /OUTPUT 3 CHAR SYMBOL & SPACE
2685 INSLST /(TABLE FOR INDEXING)
2687 JMS OPRTST /TEST FOR OPR & IOT
2688 JMP SYMEND / OPR, DONE
2690 TADICAD /MEMORY REF., INDIRECT?
2694 JMS I TWOCI /YES, OUTPUT "I "
2696 REFS1, TADICAD /SET UP ADDR BITS
2698 DCA BITVAL /SAVE THEM
2699 TADICAD /IS THIS A 'PAGE 0 REF'?
2702 TAD LOCL /NO, USE PAGE BITS
2704 TAD BITVAL /OK, NOW ADD ADDR BITS
2705 REFS2, JMS I OCTI /OUTPUT IN OCTAL
2706 SYMEND, JMP I PDPOUT /DONE, RETURN
2709 IOTS, TADICAD /USE ONLY LAST 9 BITS
2711 JMP REFS2 /AND OUTPUT IN OCTAL
2713 OPRS, TADICAD /IS THIS A NOP?
2716 JMP SYMS /YES, OUTPUT "NOP "
2717 AND N200 /IS THERE A CLA IN IT?
2719 JMP OPRS1 /NO, CONTINUE
2720 JMS SYMTYP /YES, OUTPUT "CLA "
2724 OPRS1, DCA CNT /SET ANYTHING OUTPUT SWITCH
2725 TADICAD /SET UP WORD FOR DECODE
2729 TADICAD /CHECK FOR OPR1, OPR2 OR EAE
2733 JMP OPR1A /OPR1 MICRO-INSTRUCTION
2735 JMP OPR2A /OPR2 MICRO-INSTRUCTION
2737 /DO THE DOCODING FOR THE EAE MICRO-INSTRUCTIONS
2738 EAE, TAD (EAELST-2 /SET UP EAE LIST POINTER
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)
2746 TAD N20 /IF ON, USE OTHER WORDS
2748 JMS BITS /CHECK BIT 7
2752 TAD EAETMP /(ADD SWITCH WORD)
2753 JMS SYMLIM /CHECK FOR & OUTPUT LAST INST.
2757 /DO THE DECODING FOR THE OPR1 MICRO-INSTRUCTIONS
2758 OPR1A, TAD (OP1LST-2 /SET OPR1 LIST
2760 JMS BITS /SHIFT & CHECK BIT 5
2761 JMS OPRTYP /IF = 1, OUTPUT "CLL "
2762 JMS BITS /CHECK BIT 6
2764 JMS BITS /CHECK BIT 7
2766 ISZ BITPNT /BUMP POINTER
2768 TADICAD /LOOK FOR IAC
2771 JMS OPRTYP /OUTPUT "IAC "
2772 TADICAD /SET UP TO CHECK FOR ROTATES
2774 JMS SYMLIM /CHECK & OUTPUT
2779 \f/OCTAL & 'FPP' (SYMBOLIC) DUMP ROUTINE
2781 JMS I OCTI /FIRST OUTPUT IN OCTAL
2782 SPACE2 / THEN 2 SPACES
2783 JMS FPPOUT / & THEN AS FPP
2786 /THE FOLLOWING ROUTINES ARE USED BY 'PDPOUT'
2788 /DO THE DECODING FOR THE OPR2 MICROINSTRUCTIONS
2789 OPR2A, TAD (OP2LST-2 /SET UP LIST POINTER
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
2800 TADICAD /MUST CHECK FOR "SKP "
2802 SNA CLA /ARE ALL SKIP SENSES = 0?
2803 JMS OPRTYP /YES, SO OUTPUT "SKP "
2804 OPR2B, TAD (OP2LST+14 /SET UP CHECK FOR OSR & HLT
2806 JMS BITS /CHECK BIT 9
2808 JMS BITS /CHECK BIT 10
2810 JMP OPEND /CHECK FOR ANY DONE
2812 SYMLIM, 0 /CHECK LAST SYMBOL AGAINST LIMIT
2816 JMP OPEND /NO, TEST IF ANY OUTPUT DONE
2817 TAD I SYMLIM /IT IS > UPPER LIMIT?
2819 JMP OPEND /NO, GO CHECK AGAIN
2820 TAD CHAR /CALCULATE ADDRESS
2821 JMS OPRTYP / & OUTPUT LAST
2825 TAD CNT /ANYTHING OUTPUT?
2827 JMP SYMEND /YES, DONE WITH OUTPUT
2828 JMS SYMTYP /NO, OUTPUT "OPR "
2831 JMP IOTS /NOW GO OUTPUT LAST 9 BITS
2833 BITS, 0 /DECODE A WORD ONE BIT AT A TIME
2834 TAD BITVAL /SHIFT A BIT INTO LINK
2836 DCA BITVAL /SAVE FOR LATER
2837 ISZ BITPNT /BUMP SYMBOL POINTER
2840 ISZ BITS /TO CALL+2 IF L = 0
2843 OPRTYP, 0 /OUTPUT AN OPR SYMBOL
2844 JMS SYMTYP /OUTPUT THE SYMBOL
2850 SYMTYP, 0 /OUTPUT A SYMBOL
2851 TAD I SYMTYP /ADD TABLE ADDR TO ANY INDEX
2853 DCA SYMPNT /SAVE POINTER
2854 TAD I SYMTYP /GET COUNT OF WORDS
2856 DCA BITS / & SAVE IT
2857 SYMNXT, CDF 10 /"SYMBOL"S IN FIELD 1
2860 JMS I TWOT /OUTPUT A PAIR OF LETTERS
2867 OPR2T, 0 /OUTPUT AN OPR2 SYMBOL
2869 AND (10 /IF BIT IS ON, REVERSE THE
2870 JMS OPRTYP /SENSE OF THE SKIP
2876 IOPRNT, 0 /OUTPUT I/O NAMES
2877 TAD (IOTTAB /SET UP POINTER
2878 IOPRN1, DCA IOPNT /SET (OR UPDATE) POINTER
2880 TAD I IOPNT /GET NEXT IOT
2882 SNA /AT END OF TABLE?
2883 JMP I IOPRNT /YES, CODE NOT FOUND
2885 TADICAD /NO, DO THEY MATCH?
2887 JMP IOPRN2 /YES, OUTPUT NAME
2888 TAD (4 /NO, UPDATE POINTER
2890 JMP IOPRN1 / & TRY AGAIN
2892 IOPRN2, IAC /WORD FOLLOWS CODE
2893 JMS SYMTYP /OUTPUT THE MNEMONIC
2896 JMP SYMEND / & RETURN
2899 OPRTST, 0 /TEST "INSTRUCTION" FOR OPR & IOT
2901 AND N7000 /MASK OFF OP CODE
2902 TAD (1000 /IS IT AN OPR?
2904 JMP I OPRTST /YES, EXIT TO CALL+1
2906 TAD (1000 /IS IT AN IOT?
2908 ISZ OPRTST /NO, EXIT TO CALL+3
2909 JMP I OPRTST / YES, TO CALL+2
2913 \f/'FPP' (SYMBOLIC) INSTRUCTION DECODING
2915 CLA /HARD TO TELL WHAT MIGHT COME!
2916 TADICAD /GET THE WORD
2917 AND (600 /MASK OFF MODE BITS
2919 JMP SPECIAL / NON-ARITHMETIC
2920 TAD M400 /GIVES: -=BASE, 0=LONG, +=INDIR.
2922 JMS GETOP /GET OP-CODE TO BITS 9-11
2923 FPLEA, JMS MULT3 /MULTIPLY BY 3 (WORDS/OP OUT)
2924 JMS SYMTYP /OUTPUT 6 CHAR OPR SYMBOL
2925 FPPINS /(INCLUDING "LEA")
2927 TAD TEMP2 /NOW HANDLE MODE
2929 JMP LONG / LONG INDEXED
2931 JMP INDIR / INDIRECT INDEXED
2932 BASE, JMS I TYPSI / BASE - OUTPUT " B+"
2934 TADICAD /GET WORD AGAIN
2935 AND N177 / MASK OFF OFFSET
2936 JMS MULT3 / MULTIPLY IT BY 3
2937 JMS OCT3 / & OUTPUT IN OCTAL
2940 INDIR, JMS I TYPSI /OUTPUT "% B+"
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
2948 LONG, JMS I TWOCI /OUTPUT "# "
2950 JMS FLDOUT /AND FIELD AND "*"
2951 XRPLUS, JMS GET678 /GET XR FIELD
2952 JMS I TWOCI / & OUTPUT ",X" WHERE
2953 5460 / "X" IS A DIGIT
2954 TADICAD /GET WORD THE LAST TIME
2955 AND (100 / AND CHECK "+" BIT
2957 JMS I TYPECI /OUTPUT "+" OR SKIP
2961 SPECIAL,JMS GETOP /GET OP-CODE
2962 JMS I SORTI / & BRANCH ON IT
2965 SPCOP0, TADICAD /FALLS THRU ON 0, GET
2966 AND (170 / SUB-OP-CODE
2967 JMS I SORTI / & BRANCH ON IT
2970 SPOP00, TADICAD /FALLS THRU ON 0, USE AS
2971 AND N7 / INDEX INTO LAST LIST
2973 SPOP04, JMS MULT3 /THREE WORDS/SYMBOL
2974 JMS SYMTYP /OUTPUT ONE OF SEVERAL
2975 FPOP00 / SYMBOLS IN THIS LIST
2979 SPOP05, CLL STA /= -1
2980 JMP SPOP04 /OUTPUT "STARTE"
2982 SPNUSE, CLL STA RAL /= -2
2983 JMP SPOP04 /OUTPUT "UNUSED"
2985 SPO123, JMS GET678 /"ALN X", "ATX X", "XTA X"
2986 CLL RAL /(2 WORDS PER)
2987 JMS SYMTYP /OUTPUT SYMBOL
2990 JMP XROUT / & XR VALUE
2992 SPOP10, TAD (4 /"LDX *,X"
2993 SPOP11, JMS SYMTYP /"ADDX *,X"
2996 XROUT, TADICAD /GET XR FIELD
2998 DIGIT / & OUTPUT AS DIGIT
3001 SPCOP1, TADICAD /GROUP 0 OR 1?
3004 JMP SPOP1J / 1 = CONDITIONAL JUMPS
3005 JMS GET678 / 0 = SETS, ETC.
3006 TAD (-4 /SUB-OP-CODES 0 THRU 3?
3008 JMP SPNUSE / NO, 4 THRU 7 = UN-USED
3009 JMS GET678 /0 THRU 3: SETX,SETB,JSA,JSR
3010 IAC / +1+1 => 2 THRU 5
3011 SPCOP3, IAC / 1: TRAP3
3012 SPCOP4, JMS MULT3 / 0: TRAP4
3013 JMS SYMTYP /GO DO ONE OF THESE
3016 JMP DOFLD /FINISH WITH FIELD
3018 SPOP1J, JMS CONDIT /CONDITIONAL JUMPS
3021 DOFLD, JMS FLDOUT /OUTPUT FIELD & "*"
3024 SPCOP2, JMS I TYPSI /OUTPUT "JNX "
3026 JMP XRPLUS-1 / & HANDLE ADDRESS
3030 SPCOP5, TADICAD /GET WORD AGAIN
3033 JMP SPNUSE /BIT 5 ON IS UNUSED OP
3034 JMS CONDIT /LOAD TRUTH
3038 SPCOP7, IAC / "LEA" INDIRECT, SET SWITCH
3039 SPCOP6, DCA TEMP2 / "LEA" LONG, SET SWITCH
3041 JMP FPLEA / & GO DO OUTPUT
3045 \fPDATE, 0 /ROUTINE TO OUTPUT AN EXTENDED DATE WORD
3047 TAD CRLF /GET WORD & MASK
3049 CLL RTR /DAY (4-8) TO 7-11
3051 JMS I DEC2I / OUTPUT AS 2 DIGITS (MASKED)
3052 JMS I TYPECI / AND A SEPARATOR
3054 TAD CRLF /GET WORD A SECOND TIME
3055 JMS I RTR6I /MONTH (0-3) TO 7-10
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 "-"
3062 TAD CRLF /GET LAST TIME
3063 AND N7 / MASK OFF YEAR
3064 TAD YRTEST / TEST IF .GT. THIS YEAR
3066 TAD (-10 / YES, SUBTRACT 8
3067 TAD YRBASE / ADD TO BASE YEAR
3068 JMS I DEC2I / & OUTPUT IT
3070 YRTEST, 0 /-(THIS YEAR) FOR TESTING
3071 YRBASE, 0 /BASE YEAR FOR DATE + THIS YEAR
3074 TYPEA, 0 /OUTPUT ASCII CHARACTER IN THE AC
3075 TAD I TYPEA /GET ARG, IF ANY
3077 DCA I RTL6I /SAVE THE CHAR HERE FOR FIELD 1
3080 JMP TYPE1 /GO TO FIELD 1 TO DO THE OUTPUT
3082 TYPEX, ISZ NCNT /BUMP LINE POSITION
3083 JMP I TYPEA / & EXIT
3085 CRLF, 0 /OUTPUT CARRIAGE RETURN, LINE FEED
3091 DCA NCNT /RESET LINE POSITION
3095 TYPEC, 0 /OUTPUT A SINGLE CHAR ARG
3102 TYPE, 0 /CHARACTER OUTPUT ROUTINE
3103 AND N377 /BE SURE ONLY 8 BITS
3105 TAD CHAR /USE CHAR IF AC = 0
3106 DCA TCHAR /CHAR TO OUTPUT
3108 JMS I SORTI /CHECK FOR SPECIALS
3111 TAD TCHAR /IS TCHAR < 240?
3114 JMP TYPCTL /NO, OUTPUT AS CTRL-CHAR
3115 TYPC, JMS TYPEA /NOW OUTPUT CHAR
3119 TYPALT, JMS TYPEA /OUTPUT "$" FOR ALT-MODES
3123 TYPCR, JMS CRLF /C.R. TO OUTPUT
3126 TYPTAB, JMS TYPEA /SPACE OVER FOR TAB
3128 TAD NCNT /TAB TO OUTPUT
3133 JMP TYPTAB+3 /REDUCE BY TAB SIZE
3137 TYPCTL, JMS TYPEA /CONTROL-CHAR, OUTPUT AS
3139 TAD C100 / "^","CHAR+100"
3144 CTRL, 0 /CHECK FOR CTRL-C, CTRL-S, CTRL-Q & CTRL-P
3145 DCA CTRLQS /CLEAR HANG FLAG
3146 CTRL0, KSF /HAS A KEY BEEN HIT?
3147 JMP CTRLX /NO, TEST IF HANGING
3149 AND N177 /YES, MASK OFF PARITY BIT
3150 TAD (-"C+300 /IS IT A CTRL-C (ABORT PROGRAM)?
3152 BCTRLC, JMP CTRLC /*** JMP I CTRLCI /== ABORT ==
3153 TAD M20 /IS IT A CTRL-S (STOP OUTPUT)?
3156 ISZ CTRLQS / YES, SET HANG FLAG
3157 KCC / & CLEAR HARDWARE FLAG
3158 CTRL1, TAD (2 /IS IT A CTRL-Q (START OUTPUT)?
3161 KCC / YES, CLEAR THE HARDWARE
3162 JMP I CTRL / & JUST EXIT
3164 CTRL2, IAC /IS IT A CTRL-P (STOP PROGRAM)?
3166 JMP CTRLX /NO, TEST IF HANGING
3168 DCA DSWIT /YES, RESET DUMP SWITCH
3169 JMS I TYPECI /OUTPUT "^P"
3171 JMP I RECRLF / THEN CR/LF & RESTART
3173 /ROUTINE TO EXECUTE THE 'EXIT' COMMAND
3176 CTRLC, DCA DSWIT /RESET DUMP SWITCH
3177 JMP I M200 / & GO TO SYSTEM
3178 CTRLCI, XERR4+1 /*** CTRL-C ABORTS JOB STREAM! ***
3180 CTRLX, TAD CTRLQS /HANGING BECAUSE OF CTRL-S?
3182 JMP CTRL0 / YES, BACK FOR ANOTHER ROUND
3183 JMP I CTRL / NO, OUT WE GO!
3185 CTRLQS, 0 /CTRL-S, CTRL-Q FLAG
3189 \f/INPUT AN UNSIGNED 24 BIT NUMBER
3192 DCA ACC2 / & HI WORDS
3193 DCA DADD / & LEGAL INPUT SWITCH
3194 JMS I SSKIPI /GET FIRST NON-SPACE
3196 ACCPT1, JMS I GETNI /DON'T IGNORE SPACES
3197 JMS I SORTI /CHECK FOR ^D, ^K, (, ", ',
3198 GWLST1-1 / DIGITS, SPACE
3200 JMP ACCPT3 /NONE OF THE ABOVE
3203 TAD (-"0 /MAKE A DIGIT
3205 TAD OCTSET /IS DIGIT LEGAL?
3209 ERC09, ERROR / NO, ILLEGAL DIGIT!
3210 ACCMUL, TAD ACBASE /SET UP MULTIPLY OF PREVIOUS
3213 JMS DMUL / DO MULTIPLY
3214 TAD OCTSET /SET UP ADD OF NEXT "DIGIT"
3217 JMS DADD /OK, DO THE ADD (& SET SWITCH)
3221 DCA CRSWT /SET SWITCH: CR HERE
3222 ACCPT3, TAD DADD /TERMINATING CHAR RECEIVED
3223 SNA CLA /CHECK FOR LEGAL INPUT
3224 ERCR, ERROR /YOU CAN'T OUT-SMART ME!
3229 DQUOTE, JMS QUOTEC / " - GET SINGLE CHAR
3230 DCA OCTSET / SAVE VALUE
3231 JMP ACCMUL / & USE IT AS A "DIGIT"
3233 SQUOTE, JMS QUOTEC / ' - PACKED ASCII, GET 1ST
3234 AND N77 /MASK TO 6 BITS
3235 JMS I RTL6I /MOVE TO LEFT HALF
3236 DCA OCTSET / & SAVE IT
3237 JMS QUOTEC /GET 2ND CHAR
3240 JMP DQUOTE+1 / & USE THIS AS A "DIGIT"
3242 CTRLD, TAD (2 / ^D - SET RADIX TO DECIMAL
3243 CTRLK, JMS OCTSET / ^K - SET RADIX TO OCTAL
3247 /SUB. TO SET UP FOR OCTAL/DECIMAL INPUT. CALLED FROM
3248 / COMMAND INPUT & MODIFY & IF AN "^K"/"^D" IN INPUT.
3249 OCTSET, 0 /SET UP FOR OCTAL/DECIMAL INPUT
3250 TAD (10 /ENTER WITH AC= 2 FOR DECIMAL
3254 QUOTEC, 0 /GET A QUOTED CHARACTER
3255 JMS CGTEST /GET & TEST FOR A CR
3256 ERC13, ERROR / ILLEGAL USE OF " OR '
3257 TAD CHAR /OK, RETURN WITH IT
3261 /SUBROUTINE TO DEVELOP ARGUMENTS FROM THE COMMAND
3262 /BUFFER, AND RETURN WITH -(#) OF ARGS IN 'TEMP'.
3264 TAD TEMPST /GET BUFFER ADDRESS
3266 DCA TEMP /ZERO THE NUMBER OF ARGS
3268 DCA TEMP1 /SET BLK TO -1
3270 DCA CNT /RESET SWITCH
3271 GAR2, JMS EXPRIN /GET NEXT ARG
3272 JMS I SSKIPI /IGNORE TRAILING SPACES
3273 JMS I SORTI /BRANCH ON TERMINATOR
3276 ERCS, ERROR /ILLEGAL TERMIN., FLAME OUT
3278 GAR3, JMS GPUT /CR FOUND, END
3279 TAD TEMPST /SET UP POINTER FOR
3280 DCA DPNT / GETTING RESULTS
3283 GAR4, JMS I GETNI /SKIP OVER "."
3284 TAD ACC1 /.= TERMIN (BLOCK PART)
3285 JMP GAR1+1 /SET BLOCK & GET NEXT
3287 GAR5, TAD ACC1 /-= TERMIN (LOC PART)
3289 JMS I GETNI /SKIP OVER "-"
3290 JMP GAR2-1 /GO SET SWITCH
3292 GAR6, JMS GPUT /,= TERMIN
3293 JMS I GETNI /SKIP OVER ","
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.)
3302 /I-------I-------I-------I-------I-----
3303 /I WORD1 I WORD2 I WORD3 I WORD4 I ETC.
3304 /I-------I-------I-------I-------I-----
3306 / WORD1= BLOCK (OR -1 IF NONE SPECIFIED)
3307 / WORD2= LOC (HIGH) [ONLY 3 BITS, LOC2 IF SPEC'D]
3309 / WORD4= LOC2-LOC1-1 (LOC2=LOC1 IF NOT
3310 / SPECIFIED) [ONLY 12 LOW BITS USED]
3313 DCA I DPNT /SET BLOCK
3314 ISZ CNT /WAS A LOC2 SPECIFIED?
3317 DCA TEMP2 /NO, MAKE ARGS SAME
3318 GPUT1, TAD ACC2 /STORE HIGH ADDR
3319 AND N7 /MASKED TO 3 BITS
3321 TAD TEMP2 /USE 1ST ARG
3326 DCA I DPNT /DIFF= (TEMP2-ACC1-1)
3328 TAD TEMP /ANOTHER ENTRY
3333 XS240O, 0 /XS240 FORMAT PACKED ASCII
3334 JMS I RTR6I /HIGH 6 BITS
3336 SPACE1 / PLUS A SPACE
3337 TADICAD /THEN LOW 6 BITS,
3339 SPACE1 / PLUS A SPACE
3343 GETN, 0 /GET NEXT CHAR FROM COMM. BUFF.
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.
3358 /OPERATIONS (IN ORDER OF PRECIDENCE):
3359 / OR AND ADD SUB DIV MPY
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.
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
3375 EVAL1, JMS I SORTI /CHECK LEGAL TERMS
3376 EVLST1-1 /"+","-" & "("
3378 ERCT, ERROR /SORRY ABOUT THAT
3380 EVAL2, JMS I LPARI /IS CHAR "("?
3381 ERCU, ERROR /YES,ILLEGAL (NO OP FIRST)
3382 EVMIN, TAD CNTRA /SEQN # OF TERMINATOR
3383 DCA THISOP /SET UP THISOP
3384 TAD CNTRA /IS IT ")" OR "CR"?
3387 DCA THISOP /YES, 0 => THISOP
3388 EVAL3, TAD THISOP /CHECK PRIORITIES
3390 TAD LASTOP /IS LASTOP < THISOP?
3392 JMP EVPAR /YES, CONTINUE SCAN
3393 TAD THISOP / IS THISOP+LASTOP=0?
3396 JMP EVALX /YES, DONE
3397 TAD LASTOP /NO, DO THIS OP NOW
3399 DCA EVOP /SET UP OPERATION
3400 TAD LASTOP /IS THIS =0?
3402 JMP EVOP /YES, DO OP
3403 POP /NO, POP LAST OFF LIST
3404 DCA ACC2 / INTO D.P.AC.
3407 EVOP, HLT /JMS TO OPERATION ROUTINE
3409 DCA OPER2 /DUPLICATE D.P.AC. INTO
3411 DCA OPER1 / D.P. TEMP
3413 DCA LASTOP /POP UP ANOTHER OLD OPERATOR
3414 JMP EVAL3 /AND GO DO IT
3416 EVPAR, JMS I LPARI /IS CHAR A "("?
3417 JMP EVLPAR /YES, GO DO A SUB-EXPRESSION
3418 TAD LASTOP /NO, PUSH DOWN OLD OP
3420 TAD OPER1 / & D.P. TEMP (LAST
3422 TAD OPER2 / RESULT OR NEW NUMBER).
3424 TAD THISOP /UPDATE LASTOP
3426 EVNEXT, JMS I TERMTI /GET NEXT & TEST FOR TERM.
3427 JMP EVLPAR /TERM, MUST BE A "("
3428 ENUM, JMS I SORTI /CHECK FOR "C","B", ETC...
3431 JMS ACCEPT /GET A # OR BOMB OUT!
3433 TAD COMOUT /BACK UP POINTER
3436 DCA OPER1 /LO ORDER PART
3438 DCA OPER2 /HI ORDER PART
3439 JMP EVOPN /GO CHECK TERMINATOR
3441 EVDATE, CDF 10 /"D" -- USE DATE WORD
3442 TAD I (7666 /GET DATE WORD
3445 EVREM, TAD ACCX1 /"R" -- USE REMAINDER
3447 TAD ACCX2 / AS NEXT "INPUT".
3449 EVTEMP, TAD TEMPV1 /"T" -- USE 'TEMP' STORAGE
3453 EVSR, LAS SKP /"S" -- USE SWITCHES
3454 TADICAD /"C" -- USE CONTENTS
3456 EVFIL, TAD FILLER /"F" -- USE FILLER
3458 EVLOC, TAD LOCL /"L" -- USE LOCATION
3462 EVBLK, TAD BLK /"B" -- USE BLOCK
3463 DCA ACC1 /INTO LO ORDER PART
3464 DCA ACC2 /0 HIGH ORDER PART
3465 JMP ENUMX /CHECK NEXT CHARACTER
3467 EVLPAR, JMS I LPARI /IS CHAR "("?
3469 ERCV, ERROR /NO, DIE! (ILLEGAL OPERATOR)
3470 EVPAR2, TAD LASTOP /PUSH DOWN LASTOP
3472 TAD EVAL /PREPARE TO RE-CALL
3474 JMS EVAL /RECURSIVE CALL
3475 ERCW, ERROR /TERM = CR, NOT ENOUGH PARENS
3477 DCA EVAL /RESTORE RETURN ADDR
3479 DCA LASTOP /RESTORE LASTOP
3480 EVOPN, JMS I TERMTI /GET NEXT & TEST FOR TERM.
3482 JMP EVPAR2-1 /GARBAGE, GIVE SAME ERROR
3484 EVALX, TAD CNTRA /WAS CHAR CR OR ")"?
3487 ISZ EVAL / ")", RETURN TO CALL+2
3488 JMP I EVAL / CR, RETURN TO CALL+1
3493 EVTAB, JMS I . /JMS THRU TABLE TO OPERATIONS
3504 \fPUSHX, 0 /PUSH AC ONTO LIST
3508 ISZ PDLPT /BUMP POINTER
3511 POPX, 0 /POP LIST INTO AC
3512 STA STL /SET LINK SO IT WILL BE 0
3513 TAD PDLPT /BACK UP POINTER
3521 LPAR, 0 /CHECK IF CHAR = "("
3525 ISZ LPAR /IF IT IS NOT, TO CALL+2
3526 JMP I LPAR / ELSE TO CALL+1
3528 /COMPARE CHAR AGAINST LIST OF TERMINATORS. IF IT
3529 /IS ONE, RETURN TO CALL+1, ELSE TO CALL+2.
3532 JMS I GETNI /GET NEXT CHARACTER
3533 JMS I SSKIPI /IGNORE SPACES
3534 TAD (TERMS-1 /SET UP POINTER
3536 DCA CNTRA /SET CNTRA TO 0
3538 TAD I SPNT /GET AN ITEM
3540 ISZ CNTRA /ADD 1 TO ITEM #
3542 JMP TERMTE /WAS 0, END
3544 TAD CHAR /SAME AS THIS?
3546 JMP I TERMT /YES, TO CALL+1
3548 TERMTE, ISZ TERMT /DIDN'T FIND IT, TO
3549 JMP I TERMT / CALL+2
3551 /DOUBLE-PRECISION ROUTINES
3556 TAD ACC1 /ADD LOW ORDER PARTS
3558 RAL /GET CARRY TO AC11
3559 TAD OPER2 /ADD HIGH ORDER PARTS
3561 DCA ACC2 /STORE HIGH ORDER PART
3564 DSUB, 0 /D.P. SUBTRACT
3565 DCA DPSGN /ZERO IT FOR SAFETY
3566 JMS MULNEG /NEGATE OPERAND
3570 DAND, 0 /D.P. LOGICAL AND
3571 TAD ACC2 /AND HIGH ORDER PARTS
3574 TAD ACC1 /AND LOW ORDER PARTS
3579 DIOR, 0 /D.P. LOGICAL INCLUSIVE OR
3580 TAD ACC2 /IOR HIGH ORDER PARTS
3585 TAD ACC1 /IOR LOW ORDER PARTS
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.
3598 ARG1, DCA TEMP1 /SET 'BLOK' [INIT TO -1]
3599 JMS EXPRIN / GET AN ARG
3600 JMS I SORTI /LOOK UP TERMINATOR
3603 ERCQ, ERROR /ILLEGAL TERMINATOR
3605 ARG2, JMS I GETNI /SKIP OVER "."
3606 TAD ACC1 /TERM = ".", SET 'BLOK'
3609 ARG3, JMP I ARG /TERM = " " OR CR
3612 /GET NEXT ARG FROM COMM. BUFF. IF NEXT CHAR IS
3613 / A "(", USE 'EVAL' TO GET IT, OTHERWISE USE
3616 JMS I SSKIPI /IGNORE SPACES
3617 JMS LPAR /IS CHAR A "("?
3619 JMS ACCEPT /NO, MUST BE A NUMBER
3622 EXPRI1, JMS I EVALI /YES, GO EVALUATE EXPRESSION
3623 ERC08, ERROR /CR = ILLEGAL TERMINATOR
3624 JMS CGTEST /OK, SKIP OVER ")" & TEST FOR CR
3627 DCA CRSWT /YES, RESET IT
3628 JMP I EXPRIN / & LEAVE...
3631 SCANER, 0 /EXECUTION SUBROUTINE FOR 'SCAN' COMMAND
3633 TAD BLK /SET UP DESIRED BLOCK
3635 JMS GETIO /DO NECESSARY I/O
3636 SKP CLA / READ ERROR!
3637 JMP I SCANER /THIS BLOCK IS OK!
3639 JMS I OCTI /OUTPUT BLOCK NUMBER
3640 JMS I TYPSI / & TELL IT'S BAD
3642 JMS I CRLFI / TO ANOTHER LINE
3647 \f/SIGNED MULTIPLY AND DIVIDE ROUTINES
3650 JMS MDCOM /MAKE DPAC POS, INITIALIZE
3651 SPA CLA /MAKE SURE MULTIPLIER IS POSITIVE
3652 JMS MULNEG / IT WAS NEG, MAKE POS & SET SIGN
3653 DMUL1, TAD ACC2 /SHIFT RIGHT & OUT
3655 DCA ACC2 /THRU HI OF LO
3658 DCA ACC1 /THRU LO OF LO INTO LINK
3659 ISZ DPNEG /DONE YET?
3660 JMP DMUL2 /NO, CONTINUE
3661 DMUL4, TAD DPSGN /YES, CHECK SIGN OF RESULT
3663 SZL CLA /SKIP IF SIGN OK
3664 JMS DPNEG /NOT OK, NEGATE
3667 DMUL2, SNL /ADD IN THIS TIME?
3668 JMP DMUL3 /NO, BIT OUT WAS 0
3669 CLA CLL /YES, BIT WAS 1
3670 TAD OPER1 /START WITH LOW
3674 TAD OPER2 /ADD HIGH PARTS
3675 DMUL3, TAD ACCX2 /AND BEGIN SHIFTING OUT
3684 TAD DDIV /MOVE RETURN ADDRESS
3686 JMS MDCOM /MAKE DPAC POS, INITIALIZE
3687 SMA CLA /IS DIVISOR NEGATIVE?
3688 JMS MULNEG / NO, NEGATE IT & SET SIGN
3689 SZL / IS IT 0? (CARRY OUT ON NEGATE)
3690 ERCX, ERROR / YES, YOU LOST
3691 ISZ DPSGN /CORRECT FOR SIGN DIF IN * & /
3692 DDIV1, TAD ACCX1 /SUBTRACT LO OF LO
3695 CLA RAL /CARRY TO AC
3696 TAD ACCX2 /SUBTRACT HI OF LO
3700 CLL CML /NO, SET LINK
3704 TAD OPER1 /RESET LO ORDER PART
3709 DDIV3, TAD ACC1 /BEGIN SHIFTING
3715 ISZ DPNEG /DONE YET?
3717 JMP DMUL4 /YES, CHECK SIGN & RETURN
3718 TAD ACCX1 /NO, KEEP SHIFTING
3726 MDCOM, 0 /COMMON ROUTINE FOR MULTIPLY & DIVIDE
3727 DCA DPSGN /RESET SIGN
3728 TAD ACC2 /IS DPAC POS?
3730 JMS DPNEG /NO, NEGATE
3731 DCA ACCX2 / 0 => DPACX
3733 TAD (-31 /INITIALIZE COUNTER
3736 TAD OPER2 /RETURN W. HIGH OPERAND
3739 MULNEG, 0 /NEGATE THE MULTIPLIER/DIVISOR
3740 TAD OPER1 /DO LO-ORDER PART
3743 TAD OPER2 /DO HI-ORDER PART
3746 CLL IAC /YES, ADD IT IN
3748 ISZ DPSGN /SIGN CHANGE MADE
3751 DPNEG, 0 /NEGATE THE D.P.AC.
3752 TAD ACC1 /DO LO-ORDER PART
3755 TAD ACC2 /DO HI-ORDER PART
3758 CLL IAC /YES, ADD IT IN
3760 ISZ DPSGN /SIGN CHANGE MADE
3764 BLKTST, 0 /TEST & SET BLK
3765 DCA DPNEG /SAVE DATA
3766 TAD DPNEG /GET IT BACK AGAIN
3767 ISZ DPNEG /LEGAL BLOCK NUMBER?
3768 DCA BLK / YES IF NOT 7777 (-1)
3769 CLA / IF NOT, CLEAR JUNK
3773 DICAD, 0 /"DCA I CAD" IN FIELD 1
3779 TICAD, 0 /"TAD I CAD" IN FIELD 1
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.
3801 JMS I GWORDI /COM BUF BEGIN WITH A WORD?
3802 JMP WCHEK2 /NO, TEST FOR PARENS, ETC.
3804 TAD COMIR /YES, BACK UP COMIR
3806 TAD TEMP /AND USE THE SPECIAL CHAR AS
3807 JMP I .+1 / PART OF THE COMMAND STRING
3811 TAD COMOUT /SET UP ANOTHER A-XR
3813 DCA CNT /RESET (OR SET) PAREN COUNT
3814 WCHEK3, TADIDP /GET A CHAR FROM COMM. BUFF.
3815 JMS I SORTI / & GO TEST IT
3818 JMP WCHEK3 /NONE, CONTINUE SCAN
3820 WCHEK4, TAD CNT /CR, DO PARENS MATCH?
3822 JMP WCHEK1 /NO, CONTINUE COMMAND INPUT
3823 JMP I WCHEK /YES, INPUT IS DONE
3825 WCHEK5, STA CLL RAL /SET TO -2
3827 TAD CNT / UPDATE PAREN COUNT
3828 JMP WCHEK3-1 / & CONTINUE SCAN
3830 WCHEK6, JMS WCHONE / ' -- 2 CHARACTERS
3831 JMS WCHONE / " -- 1 CHARACTER
3832 JMP WCHEK3 /OK, CONTINUE SCAN
3835 TADIDP /GET NEXT CHAR
3836 TAD M215 /IS IT A CR?
3838 JMP WCHEK1 /YES, DON'T EXECUTE SPECIAL
3839 JMP I WCHONE /NO, OK
3840 \f/FPP INSTRUCTION DECODING SUPPORT SUBROUTINES
3842 GETOP, 0 /GET OP-CODE (BITS 0-3) TO BITS 9-11
3849 GET678, 0 /GET BITS 678 TO BITS 9-11
3856 MULT3, 0 /MULTIPLY AC BY THREE
3860 TAD GETOP /WORKS FOR POS OR NEG!
3863 CONDIT, 0 /OUTPUT CONDITIONAL FPP INSTRUCTION
3864 TAD I CONDIT /GET LEADING 1 OR 2 CHARS
3866 JMS I TWOT / & OUTPUT THEM
3867 JMS GET678 /GET CONDITION CODE
3868 JMS I SYMTYI / AS INDEX TO TABLE
3874 FLDOUT, 0 /OUTPUT FIELD DIGIT & "*"
3877 JMS I RTL6I / TO BITS 3-5
3878 JMS I TWOCI / & OUTPUT "F*"
3879 6052 / WHERE "F" IS DIGIT
3884 DECIMAL /SET RADIX TO DECIMAL
3886 TEMPL= . /ARGUMENT BUFFER
3889 DMPHAN-F0END /(SHOW SPACE LEFT)
3893 PAGE /****** MUST BE NO LITERALS! ******
3895 DMPHAN= 06600 /DUMP HANDLER AREA, 2 FIELD 0 PAGES
3897 DEVHAN= 07200 /DEVICE HANDLER AREA, 2 FIELD 0 PGS
3900 IFNZRO DMPHAN-F0END&4000 <BADERR,__CAN'T RUN>
3902 /IF THE ABOVE ASSEMBLES, THE BUFFERS ARE OVER-
3903 / RUNNING THE DUMP DEVICE HANDLER.
3906 *TEMPL /ADD INITIALIZATION CODE WHICH IS OVERLAID
3908 INIMSG, 0 /INITIALIZE ERROR MESSAGES ON SCRATCH BLKS
3910 TAD I (7726 /BUT FIRST CHECK FOR "SCOPE MODE"
3912 AND N200 / (BIT 4 OF 17726)
3914 JMP INIDAT / NOT SET, GO SET UP DATE
3915 INISCO, TAD I SPNT /SET, CHANGE RUBOUT HANDLER TO
3917 JMP INIDAT / ERASE CHARACTERS FROM SCREEN
3918 DCA I DPNT / AND FROM BUFFER (MUCH EASIER
3919 JMP INISCO / THAN ON HARD COPY!)
3921 INIDAT, CDF 10 /NOW INIT EXTENDED DATE
3922 TAD I (7666 /GET SYSTEM DATE WORD
3924 AND N7 /PICK OFF THIS YEAR PART
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)
3931 TAD (106 /ADD TO A STARTING BASE OF 70[10]
3933 TAD YRTEST /AND ADD THIS YEAR ALSO
3935 DCA YRBASE /= 70 + EXTEND*8 + THIS YEAR
3936 TAD I (7746 /GET JSW
3937 AND (6777 /CLEAR BIT 2 (CAN RESTART!)
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
3944 27 / NORMAL SAVE AREA!
3946 JMP I INIMSG /OK, JUST EXIT
3948 DCA XERR3 /FAILED, ASSUME WRITE LOCKED
3949 TAD (ERROR / SO NO ERROR MESSAGES ON
3950 DCA ERC15 / ERROR OR "SHOW ERRORS"
3954 PAGE /LITERALS HERE ARE OK!
3955 \f/INITIALIZATION CODE--RESIDES IN BUFFER AREA AND IS WIPED
3956 / OUT DURING EXECUTION. HANDLES CHAINED AND NORMAL STARTS.
3958 START, CLA SKP /NORMAL
3959 STA /CHAINED (FROM CCL!)
3962 DCA I (CCBB /ZAP CCB SWITCH
3965 DCA I (7745 /RESET START ADDRESS
3966 JMS INIMSG /INIT SCOPE, DATE & ERROR MESSAGES
3967 JMS BATSET /TEST & SET UP FOR BATCH
3969 JMP I (201 / NO, START IT UP!
3971 TAD I M200 /YES, 1ST OUTPUT DEVICE?
3973 AND (17 /(IGNORE LENGTH SPEC)
3975 JMP STSWIT / NO, LEAVE AS SYS
3976 DCA DEVNO /YES, SET DEVICE NUMBER
3978 CALUSR /NOW DO HANDLER FETCH BY
3979 1 / NUMBER (PAINTING?)
3980 STDEV, DEVHAN+1 /--2 PAGES--
3981 JMP STERR /ARGGGG! FAILED!!!
3983 DCA DEVAD /SET UP HANDLER ENTRY
3985 DCA DPNT /SET UP FIELD 1 POINTER
3986 TADIDP /GET NAME OF FILE
3992 TADIDP /GET EXTENSION
3994 TAD NAM1 /WAS THERE REALLY A NAME?
3996 STA / YES, SET NAME SWITCH
3997 DCA TEMP / NO, RESET
3999 DCA I (XDNAM /CLEAR DEVICE NAME WORDS
4001 TAD I DPNT /GET NEXT WORD & TEST FOR ZERO
4003 JMP STSWIT / SOMETHING NOT RIGHT!
4004 TAD I DPNT /OK, ASSUME CCL CHAIN & SET
4005 DCA I (XDNAM / UP DEVICE NAME
4008 TAD I (XDNAM /EMPTY?
4011 TAD (0423 /YES, MUST BE DEFAULT NAME--
4012 DCA I (XDNAM / "DSK"
4016 TAD I (7643 /TEST SWITCHES
4018 DCA ERMODE / 0= LONG, NON-0= SHORT
4020 AND I (7643 / "/L"? [LOAD]
4022 JMP STSWO /NO, CHECK NEXT
4023 TAD NAM4 /YES, SET DEFAULT EXTENSION
4025 TAD (1404 / TO ".LD"
4028 JMP STSWEX-2 / & GO SET MODE
4031 AND (1000 / "/O"? [OFFSET]
4033 JMP STSWS /NO, GO CHECK LAST
4034 TAD I (7646 /YES, GET LOW 12 BITS OF
4035 CIA / "=NNNN" AS OFFSET AND
4038 JMP STSWEX-1 / & GO SET MODE
4040 STSWS, TAD I (7644 / "/S"? [SAVE]
4043 JMP STSWEX /NO, WAS NOT ANY THAT COUNT
4044 TAD NAM4 /YES, SET DEFAULT EXTENSION
4046 TAD (2326 / TO ".SV"
4049 DCA MODSW /-1=OFF,0=NOR,+1=SV,+2=LD
4051 ISZ TEMP /FILE NAME SPECIFIED?
4052 JMP I (201 / NO, JUST START
4053 DCA CRSWT /YES, SET SWITCH TO CR,
4054 STTLS, TLS / START TTY *** BATCH OPER.
4055 JMS I CRLFI / & DO CR/LF
4056 TAD NAM4 /ANY EXTENSION SPECIFIED?
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,
4062 TAD (2326 / SET TO START DEFAULTS WITH SV
4064 JMP XFICHN /NOW GO DO FILE LOOKUP
4066 STERR, TLS /START UP OUTPUT *** BATCH OPER.
4067 JMP ERCY / & GIVE ERROR!
4071 \f/INITIALIZATION CODE FOR BATCH OPERATION
4074 TAD I M1 /TEST BIT 1 OF 07777 FOR "BIP"
4075 RAL / (BATCH-IN-PROGRESS)
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:
4083 DCA CBATO / OUTPUT AND
4086 BATMOV, TAD I SCANX1 /GET NEXT STORAGE ADDRESS
4088 JMP I BATSET / 0 = ALL DONE!
4089 DCA DPNT /SET UP POINTER
4090 BATLUP, TAD I SCANX1 /GET A PATCH WORD
4092 JMP BATMOV / 0 = GROUP END
4093 BATPAT, CDF 0 /CHANGED FOR "TYPEB"!!
4094 DCA I DPNT /PATCH THE WORD
4096 JMP BATLUP /DO IT AGAIN!
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!
4106 JMS BTEST /BUFFER NOW EMPTY?
4107 JMP RENEXT / YES, JUST IGNORE RUBOUT
4109 TAD COMIR /NO, BACK UP POINTER
4111 TAD COMIR /SET UP POINTER FOR TESTING, ALSO
4113 JMS RUBO2 /OUTPUT BACKSPACE, SPACE, BACKSPACE
4114 JMS I GETNI /GET RUBBED OUT CHAR AND TEST
4116 TAD M240 / FOR A CONTROL CHAR
4118 JMS RUBO2 /YES, ERASE "^" ALSO!
4119 JMP RENEXT /TRY FOR ANOTHER CHAR
4121 RUBO2, HLT /MUST BE NON-ZERO!!!
4122 JMS I TYPEAI /OUTPUT A BACKSPACE,
4125 JMS I TYPEAI / BACKSPACE SEQUENCE TO
4126 "H-100 / CLEAR OFF SCREEN CHAR
4134 BATLS, /PATCHES--ADDRESS-1, CODE, 0 WITH EXTRA 0 FOR END.
4136 RUBO-1 /==== INPUT PATCHES ====
4138 DCA CHAR /SAVE NEW CHAR INPUT
4139 TAD CHAR /IS THIS A FORM-FEED?
4142 JMP RKEY+1 / YES, JUST IGNORE IT!
4143 TAD R2 /NO, THEN IS IT A LINE-FEED?
4145 TAD RLAST / YES, WAS LAST A CARRIAGE-RETURN?
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?
4152 JMP RKEY+1 / YES, JUST IGNORE LF!
4153 JMP REKEY+1 / NO, GO USE THIS CHAR
4155 BATINI, 5400 /IN THE BATCH FIELD
4158 RLAST, 215 /!!! CR OF ".R FUTIL" HAS AN LF !!
4162 RELOC /TO PUT 'CBATI' ON THIS PAGE
4163 CBATI= .+1 /REALLY ON "CIF BAT"
4165 JMS I CTRLI /CHECK FOR CONTROL KEYS
4167 JMS I BATINI /GET A BATCH CHARACTER
4168 ERC17, ERROR /!!! EOF ON INPUT !!!
4169 NOP /FILLER FOR INTERACTIVE CTRL-Q
4175 JMP RKEY+1 /IGNORE RUBOUT UNDER BATCH
4176 NOP / & RETURN TO CALL+1!
4181 JMP I CTRLCI /CTRL-C, ABORT JOB STREAM!
4184 RELOC /==== OUTPUT PATCHES ====
4190 NOP /ZAP 3 "TLS"S USED FOR STARTUP
4197 RELOC /==== ERROR PATCH ====
4200 CBATE= . /REALLY ON "CIF BAT"
4203 JMP I N7000 /ABORT TO BATCH FIELD!
4209 CDF 10 /*** NEXT CODE IN FIELD 1 ***
4214 CBATO= .+1 /REALLY ON "CIF BAT"
4215 IFDEF TYPEB </NO PASS1 ERROR!
4216 RELOC TYPEB /*** REALLY IN FIELD 1 ***
4218 CDF 10 /*** SET UP RETURN D.F.
4220 JMS I .+1 /OUTPUT A CHARACTER TO LOG
4221 7400 /BATOUT, IN THE BATCH FIELD
4222 CDF 0 /*** RESET D.F.
4232 FIELD 1 /THE END OF FIELD 0!
4233 \f*10000 /PUT A POINTER HERE!
4235 NXTIOT /ADDR OF NEXT FREE SPACE IN TABLE
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.
4248 *10002 /MESSAGE ADDRESS AT ERROR CODE NUMBER +1 (AUTO-XR)
4250 /LIST OF ADDRESSES OF ERROR MESSAGES
4304 ERMSA, TEXT &ILLEGAL SINGLE-WORD COMMAND&
4306 ERMSB, TEXT &ILLEGAL MULTI-WORD COMMAND&
4308 ERMSC, TEXT &TOO MANY ")"S&
4310 ERMSD, TEXT &ILLEGAL FORMAT WORD&
4312 ERMSE, TEXT &BAD FORMAT SYNTAX&
4314 ERMSF, TEXT &NO FILE FOR C.C.B./HEADER REQUEST&
4316 ERMSGC, TEXT &BAD C.C.B (NOT A SAVE FILE)&
4318 ERMSHD, TEXT &BAD HEADER (NOT A LOAD MODULE)&
4320 ERMSG, TEXT &ILLEGAL ITEM TO SHOW&
4322 ERMSH, TEXT &ILLEGAL SEARCH MODIFIER&
4324 ERMSI, TEXT &BAD SEARCH SYNTAX&
4326 ERMSJ, TEXT &ILLEGAL MODE&
4328 ERMSK, TEXT &SET OPTION FOLLOWED BY A CR, BAD SYNTAX&
4330 ERMSXO, TEXT &NUMBER OR ILLEGAL SET OPTION&
4332 ERMSL, TEXT &NUMBER OR ILLEGAL OUTPUT OPTION&
4334 ERMSM, TEXT &ILLEGAL "." IN NAME (FILE OR DEVICE)&
4336 ERMSO, TEXT &ILLEGAL MODIFY FORMAT&
4338 ERMSP, TEXT &PROGRAM OR HARDWARE PROBLEM&
4340 ERMSQ, TEXT &BAD TERMINATOR IN SINGLE ARGUMENT&
4342 ERMSR, TEXT &TERMINATOR BEFORE LEGAL NUMBER INPUT&
4344 ERMSS, TEXT &BAD TERMINATOR IN MULTIPLE ARGUMENT&
4346 ERMST, TEXT &ILLEGAL CHARACTER IN EXPRESSION&
4348 ERMSU, TEXT &ILLEGAL USE OF "(" IN EXPRESSION&
4350 ERMSV, TEXT &ILLEGAL OPERATOR IN EXPRESSION&
4352 ERMSW, TEXT &TOO FEW ")"S IN EXPRESSION&
4354 ERMSX, TEXT &DIVISION BY 0 ATTEMPTED&
4356 ERMSY, TEXT &UNKNOWN HANDLER NAME&
4358 ERMSZ, TEXT &NUMBER OR ILLEGAL ERROR OPTION&
4363 ERMS00, TEXT &FATAL READ ERROR&
4368 ERMS02, TEXT &FATAL WRITE ERROR&
4370 ERMS04, TEXT &ODD START LOC OR COUNT IN OS/8 MODIFY&
4372 ERMS05, TEXT &BAD ADDRESS/OVERLAY (ODT COMMANDS)&
4376 ERMS07, TEXT &BAD ADDRESS/OVERLAY (MODIFY)&
4378 ERMS08, TEXT &ARGUMENT EXPRESSION NOT TERMINATED BY ")"&
4380 ERMS09, TEXT &ILLEGAL DIGIT&
4382 ERMS10, TEXT &DUMP HANDLER ERROR&
4384 ERMS11, TEXT &NUMBER OR ILLEGAL DMODE OPTION&
4388 ERMS13, TEXT &ILLEGAL USE OF ' OR "&
4390 ERMS14, TEXT &MAPPED MODE--USE LIST, NOT DUMP&
4392 ERMS15, TEXT &NO ERROR MESSAGES&
4394 ERMS16, TEXT &INPUT ERROR ON MESSAGES&
4396 ERMS17, TEXT &EOF ON BATCH INPUT&
4398 ERMS18, TEXT &ENTER FAILED&
4400 ERMS19, TEXT &CLOSE FAILED&
4402 ERMS20, TEXT &DUMP FILE OVERRUN&
4404 ERMS99, TEXT &DEBUG&
4405 \f*12000 /BEGIN ABOVE THE USR AREA
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.
4414 GCCB, 0 /GET CORE-CONTROL-BLOCK
4415 JMS CCBHDR /DO COMMON TEST & READ-IN
4416 SMA CLA /1ST WORD (-# SEGS) NEG?
4417 JMP GCCERR / NO, CAN'T BE CCB
4418 TAD I (CCBB+3 /GET JOB STATUS WORD
4419 AND (200 /OVERLAY BIT SET (LINK)?
4421 TAD (CCBB+140-1 / 1 = YES, START ADDR-1
4423 DCA I (OVLFLG /NO = 0; YES = ADDR-1
4425 TAD I (CCBB+1 /2ND WORD A "CDF CIF X0"?
4430 GCCERR, JMS ERROR1 /LOOKS BAD, JUST EXIT NOW!
4431 ISZ GETSWX /LOOKS OK, 1ST TIME SINCE READ?
4432 JMP GCCB2 /NO, DON'T CHANGE THINGS AGAIN
4433 TAD (CCBB+140+3 /YES, POINT TO LENGTH WORDS
4434 GCCB1, DCA GHDR / TO CHANGE PAGES TO BLOCKS
4435 TAD I GHDR /GET A WORD - PAGES
4437 JMP GCCB2 / 0 = DONE
4438 IAC /ROUND DOWN IN 2 STEPS FOR PDP-8
4440 DCA I GHDR /STORE A WORD - BLOCKS
4441 TAD GHDR /UPDATE POINTER TO NEXT
4445 GCCB2, DCA GETSWX /BE SURE SWITCH STAYS CLEAR
4446 TAD I SEGNI /GET -# SEGMENTS
4448 JMP I GCCB /OK, RETURN VALUE
4450 GHDR, 0 /GET HEADER BLOCK (FORTRAN IV)
4451 TAD (3 /TO SET UP CCBB+6
4452 JMS CCBHDR /DO COMMON TEST & READ-IN
4453 TAD (-2 /1ST WORD MUST BE EXACTLY 2
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
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"
4466 TAD I (CCBB+1 /ARE THESE ONLY BITS SET?
4469 JMP HDRERR / NO, SOMETHING MUST BE BAD
4470 TAD I (CCBB+3 /OK, TEST FIELD OF NEXT FREE
4472 JMP HDRERR / SHOULD BE 1 THRU 7
4476 GHDR1, DCA GETSWX /MAKE SURE THIS IS 0
4477 CMA /AC NON-ZERO FOR OK
4479 JMP I GHDR /OK, BACK TO USER
4482 TAD (CCBB+3 /CCBB+6 FOR GHDR
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
4489 ERCF, JMS ERROR1 / NO FILE!!! GIVE ERROR
4491 DCA GCCBLK /OK, SET UP 1ST BLOCK
4492 TAD I SEGNI /IS SOMETHING IN MEMORY?
4494 JMP I CCBHDR / YES, RETURN 1ST WORD
4496 JMS I DEVADX /NO, READ 1ST BLOCK OF FILE
4497 0110 /READ; 1 PAGE; FIELD 1
4498 SEGNI, CCBB /BUFFER IS HERE
4499 GCCBLK, 0 /BLOCK NUMBER
4500 JMP RDERX /...BAD NEWS...
4502 DCA GETSWX /OK, SET "JUST READ" SWITCH
4503 TAD I SEGNI /AND GET 1ST WORD
4506 RDERX, CDF CIF 0 /RETURN TO FIELD 0
4507 JMP I (RERROR / FOR READ ERROR
4515 MSBAD, TEXT " BAD BLOCK"
4519 \f/CONTINUATION OF OUTPUT COMMANDS AND ROUTINES FROM FIELD 0
4521 /CONTINUATION OF 'SET' 'DDEV' HANDLER
4523 XDDEV1, DCA DDEVAD /SET UP HANDLER ADDRESS
4525 DCA DDEVNO / AND DEVICE NUMBER
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
4532 TAD (212 / NO, LINE-AT-A-TIME
4533 DCA DDEVS / YES, BLOCK-AT-A-TIME
4534 TAD DMPADR /OK, INITIALIZE OUTPUT POINTER
4536 DCA XOSIZ / AND ZERO BLOCK COUNTER
4537 DCA DNAM / AND CLEAR ANY FILE NAME
4539 DCA DMPBLK / AND SET BLOCK NUMBER TO 1
4540 JMP XDDEV2 /LAST, GO SET UP NAME FOR OUTPUT
4543 /CONTINUATION OF EXECUTION OF 'OPEN' COMMAND
4545 XOPEN1, TAD (NAM1-1 /SET UP POINTER TO FIELD 0 FILE
4546 DCA DPNT / NAME (NOTE: XR IN FIELD 1!!!)
4547 TAD I DPNT /MOVE THE FILE NAME UP HERE
4553 TAD I DPNT /GET THE EXTENSION PART
4554 ISZ I (TEMP1 / WAS ANYTHING REALLY SPECIFIED?
4557 TAD (0425 / NO, DEFAULT TO ".DU"
4559 TAD XCLNAM /SET UP POINTER TO NAME FOR USR
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.
4569 XOBLK, 0 /NAME POINTER, BECOMES START BLK
4570 XOSIZ, 0 / BECOMES -# BLOCKS CAN USE
4571 ERC18, JMS ERROR1 /THE ENTER FAILED!
4572 TAD XOBLK /OK! SET UP FILE START BLOCK
4574 TAD DMPADR /INITIALIZE POINTER
4577 JMP MAIN1 /TRY NEXT COMMAND
4579 DDEVAD, 7607 /INIT ADDRESS TO "SYS:" (SEE ABOVE)
4580 DDEVNO, 1 /INIT THIS TO "SYS:" ALSO.
4581 DDCWPT, 7760 / THIS ALSO
4583 DNAM, 0 /DUMP FILE NAME, INIT TO NULL
4589 /CONTINUATION OF EXECUTION OF 'CLOSE' COMMAND
4591 XCLOS1, TAD DNAM /IS ANY FILE OPEN?
4593 JMP XOCEX / NO, IGNORE COMMAND
4594 TAD XCTLZ / YES, OUTPUT A CTRL-Z
4595 JMS DMPOUT / AND FILL TO END
4597 TAD XOBLK /OK, CALCULATE FILE SIZE
4599 TAD DMPBLK /= NEXT - START
4600 DCA XCLSIZ /= FILE SIZE IN BLOCKS
4601 TAD DDEVNO /GET DUMP DEVICE NUMBER
4603 JMS USEUSR /GET USR AND CALL IT
4605 XCLNAM, DNAM /POINTER TO FILE NAME
4606 XCLSIZ, 0 /SIZE OF NEW FILE
4607 ERC19, JMS ERROR1 /OH NO! CLOSE FAILED!
4608 DCA DNAM /OK, ZAP KNOWLEDGE OF FILE
4612 DMPOUT, 0 /DUMP FILE CHARACTER OUTPUT ROUTINE
4613 DCA DMPCHR /SAVE THE CHARACTER
4614 TAD DMPCHR /PUT IT INTO FILE BUFFER
4615 CDF 10 /(MUST BE SURE!)
4616 DMPNUL, DCA I DMPPTR /INSERT AN 8 BIT CHAR
4618 TAD DMPPTR /NOW AT END OF BUFFER?
4621 JMP DMPIT / YES, DUMP BUFFER NOW
4622 TAD DMPCHR /NO, FILL FOLLOWING THIS CHAR?
4624 TAD I DMPOUT /(THE TEST CHAR @ CALL+1)
4626 JMP DMPNUL / YES, FILL WITH NULLS!
4627 JMP I DMPOUT / NO, EXECUTE FILL CHAR
4630 JMS I DDEVAD /CALL DUMP FILE HANDLER
4631 4210 /WRITE, 2 PAGES, FIELD 1
4633 DMPBLK, 1 /BLOCK NUMBER
4634 ERC10, JMS ERROR1 /ERROR ON OUTPUT FILE!
4635 TAD DMPADR /NOW RESET OUTPUT POINTER
4637 ISZ DMPBLK /INCREMENT BLOCK NUMBER
4638 ISZ XOSIZ /ANY MORE SPACE LEFT?
4639 JMP I DMPOUT / YES, EXIT NOW
4640 DCA DNAM / NO! ZAP DUMP FILE
4641 ERC20, JMS ERROR1 / AND DIE!
4643 DMPPTR, 0 /CHARACTER OUTPUT POINTER
4647 \f/CONTINUATION OF ROUTINE TO OUTPUT A CHAR TO A DEVICE
4649 TYPE1, TAD I (DMODE /TTY= NONE, PART&-DSWIT, ALL
4650 AND I (DSWIT / SO TEST FOR PART&DSWIT
4652 JMP TYPE2 /NO OUTPUT TO TTY
4653 TAD I (RTL6 /GET CHARACTER TO OUTPUT
4654 TYPEB, NOP /*** CDF 10 /*** BATCH
4655 TSF /*** CIF BAT /*** CHANGES
4656 JMP .-1 /*** JMS I .+1 /*** LOG
4657 TLS /*** 7400 /*** OUTPUT
4659 TYPE2, STL CLA RAR /=4000 (SET AC BIT 0 FOR TEST)
4660 TAD I (DSWIT /=4000 OR 4001 (DSWIT=1)
4661 AND I (DMODE /FILE= PART&DSWIT OR ALL
4663 JMP TYPE3 / OUTPUT TO TTY ONLY
4664 TAD DDEVS /FILE STRUCTURED OUTPUT?
4667 TAD I (DNAM / YES, FILE OPEN?
4670 JMP TYPE3 / NO TO EITHER
4671 TAD I (RTL6 /OK, GET CHARACTER TO OUTPUT
4672 JMS DMPOUT /OUTPUT IT & TEST FOR END
4673 DDEVS, 0 /TEST: 0=FILE, 212= NON-FILE
4675 JMP TYPEX /BACK AND OUT
4678 ERROR1, 0 /FIELD 1 ERROR ROUTINE HEAD
4679 CLA /CLEAR POSSIBLE JUNK IN AC
4680 TAD ERROR1 /MOVE RETURN ADDR TO FIELD 0
4686 XDDEV2, CDF 0 /NAME IS OVER THERE
4687 TAD I (NAM1 /MOVE DEVICE NAME INTO STRING
4688 DCA XDDNAM / IN THIS FIELD FOR "SHOW DDEV"
4692 JMP XSETN /BACK TO 'SET'
4694 MSDDEV, TEXT "@DDEV = SYS@"
4697 MSDEV, TEXT "@DEVICE = SYS@"
4699 XDNAM= .-3 /ADDR OF 1ST WORD OF DEVICE NAME
4701 /CONTINUATION OF CODE FROM FIELD 0
4703 XDEVM, DCA XDNAM /SET 4 DEVICE NAME CHARS IN
4704 TAD I (NAM2 / OUTPUT MESSAGE
4707 DCA I (CCBB /NO C.C.B. OR HEADER PRESENT
4710 DCA I (RBLK /RESET BLOCK NUMBER
4711 JMP XSETN /GO DO NEXT OPTION
4714 MSERR, TEXT " ERROR CODES: FUTIL "
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.
4721 MSVER, TEXT "VERSION = ???" /VERS = 2 DIGITS, PATCH = 1
4723 VERTEN= VERSION%12 /TENS DIGIT
4724 VERONE= -VERTEN^12+VERSION /ONES DIGIT
4725 VERTEN^100+VERONE+6060 /INSERT TWO DIGITS
4726 PATCH^100 /INSERT PATCH + NULL TERM
4728 /ALPHA MONTH NAMES PLUS DUMMIES FOR PDATE SUBROUTINE
4730 MONTHS, TEXT " 00@JAN@FEB@MAR@APR@MAY@JUN@JUL"
4731 TEXT "AUG@SEP@OCT@NOV@DEC@ 13@ 14@ 15"
4735 \f/SYMBOLICS FOR PDP-8 INSTRUCTIONS:
4736 INSLST, TEXT "AND TAD ISZ DCA JMS JMP IOT NOP "
4739 / GROUP 1 MICRO-INSTS.:
4740 OP1LST, TEXT "CLL CMA CML IAC BSW RAL RTL RAR RTR "
4744 / GROUP 2 MICRO-INST'S:
4745 OP2LST, TEXT "SMA SZA SNL SKP SPA SNA SZL OSR HLT "
4749 EAELST, TEXT "MQA MQL SCL MUY DVI NMI SHL ASR LSR SCA "
4751 TEXT "DAD DST SWBADPSZDPICDCM SAM "
4754 CLANAM, 0314 /"CLA "
4757 OPRMES, 1720 /"OPR "
4759 \f/ IOT INSTRUCTIONS:
4983 NXTIOT, ZBLOCK 200 /LEAVE ROOM FOR EXPANSION
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
5004 /THE FOLLOWING STRINGS ARE PADDED WITH "@"S IN PROPER
5005 / PLACES TO FORCE WORD ALIGNMENT AS NEEDED.
5007 TEXT "LEA@" /+1 WORD 0000
5008 FPPINS, TEXT "FLDA@@FADD@@FSUB@@FDIV"
5009 TEXT "FMUL@@FADDM@FSTA@@FMULM"
5013 FPOP00, TEXT "FNOP@@FEXIT@FPAUSEFCLA@@FNEG"
5014 TEXT "FNORM@STARTFSTARTDJAC@@"
5016 FPXR1S, TEXT "ALN ATX XTA "
5018 FPXR2S, TEXT "ADDX *,@LDX *,@"
5020 FOP134, TEXT "TRAP4 TRAP3 SETX SETB JSA @JSR "
5022 FPCOND, TEXT "EQGELEA@NELTGTAL"
5025 /CONTROL TABLES FOR FPP INSTRUCTION DECODING
5027 FPPMO0, 7 /MAJOR SUB-OP-CODE OF SPECIALS
5034 0 /END & FALL-OUT POINT
5044 FPPOP0, 170 /MINOR SUB-OP-CODE OF SUB-OP-CODE
5061 FPPOPJ, SPNUSE /ALL UNUSED POSSIBILITIES
5080 MS07, 0023 /"SMASK = "
5081 MS02, TEXT "MASK = "
5083 MS03, TEXT "ABS. LOC = "
5085 MS04, TEXT "UPPER = "
5087 MS05, TEXT "LOWER = "
5089 MS06, TEXT "FORMAT = "
5091 MS08, TEXT "DIRECTORY"
5093 MS09, TEXT "OFFSET = "
5095 MS10, TEXT "MODE = "
5099 MS12, TEXT "ODT LOC = "
5103 MS14, TEXT " CORE SEGS: "
5105 MS15, TEXT "LOOKUP FAILED"
5113 MS19, TEXT ", JSW = "
5115 MS20, TEXT "REL. LOC = "
5123 MS24, 2516 /"UNSIGNED"
5135 MS30, TEXT "OUTPUT = "
5139 MS32, TEXT "BLOCK = "
5149 MS37, TEXT "FILLER = "
5151 MS38, TEXT "HEADER:"
5153 MS39, TEXT ", NEXT WORD = "
5155 MS40, TEXT ", LOAD V "
5157 MS41, TEXT ", E.P. REQ'D"
5159 MS42, TEXT " OVLYS START BLOCK LENGTH"
5162 \f/MAIN LOOP CHARACTER LIST
5183 /'TYPE' COMMAND LIST
5188 /'XMODIF' CHECK LIST
5193 /ADDRESSES FOR 'OMODES'
5208 /MAIN LOOP JUMP LIST - RESPOND TO SPECIAL CHAR
5215 OMODES /SEE ABOVE LIST
5244 /COMMAND WORD LIST FOR COMMANDS NOT FOLLOWED BY CR
5245 CWORDL, TEXT "EVE@DUD@LIL@FIF@OPSCSTSMWOW@MOM@SHSES@WRIFEXCOC@"
5247 /MAIN LOOP JUMP LIST - EXECUTE A COMMAND
5273 /LISTS FOR COMMANDS FOLLOWED BY A CR.
5274 CWORL2, TEXT "REWRENEXCLCOC@"
5276 WOPSLL, XREWIN /REWIND
5283 \f/'XFORM' LISTS ----ORDER IS CRITICAL----
5284 FORML, TEXT "PAP@ASA@OSOSXSX@UNU@SIS@OCO@BCB@BYBYPDPDFPF@DID@"
5286 FOPSL, XFCHR /PACKED (ASCII)
5290 XFCHR /OS/8 (ASCII, PACKED)
5292 XFCHR /XS240 (ASCII, PACKED)
5294 XFNUM /UNSIGNED (DECIMAL)
5296 XFNUM /SIGNED (DECIMAL)
5304 XFSYM /PDP (SYMBOLIC)
5306 XFSYM /FPP (SYMBOLIC)
5311 / ROUTINE ADDRESS LIST
5326 /'XSHFMT' DESCRIPTOR ADDRESS LIST
5327 FMTLS, MS21 /PACKED ASCII
5331 MS24 /UNSIGNED DECIMAL
5332 MS25 /SIGNED DECIMAL
5341 /'XMODIF' COMMAND LIST
5342 MODIFL, TEXT "PAP@ASA@OSXSNUN@"
5345 MODIFO, XPAC0 /PACKED
5354 MODADS, XMOD0 /MODIFL TEST LIST
5364 MODDLS, TEXT "PAASOSXSNUNUNUNUNUNUNUNU" /DEFAULT LIST
5366 /'XMODIF' CHARACTER JUMP LIST
5367 MCHARO, XMODCR /CR, END
5370 /'XIF' CHARACTER JUMP LIST
5371 IFSKPO, XIFCR /CR, END OF LINE
5380 \f/'XSHOW' COMMAND LIST
5381 SHOWL, TEXT "BLB@ODCCC@HEH@ABA@RER@SMVE"
5383 /'XSET' COMMAND LIST
5384 SETLST, TEXT "DDFOF@OUO@ERE@OFUPLOTEDEDMMOFIMAM@
5387 SHOWOP, XSHBLK /BLOCK
5390 XSHCCB /CCB (CORE CONTROL BLOCK)
5392 XSHHDR /HEADER (F4 LOAD MODULE)
5410 ERCG /TEMP--NOT ALLOWED FOR SHOW
5412 ERCG /DMODE--NOT ALLOWED FOR SHOW
5419 SETJMP, XDDEV /DDEV (DUMP DEVICE)
5424 XEMODE /ERROR (MODE)
5431 XDMODE /DMODE (DUMP MODE)
5437 /'XEMODE' COMMAND LIST
5438 XELST, TEXT "SHS@LOL@"
5440 /'XEMODE' BRANCH LIST
5441 XEOPS, XEMOD1 /SHORT
5447 XOLST, TEXT "FPF@PDP@OCO@"
5449 XOOPS, XOUTS1-1 /FPP SYMBOLIC
5451 XOUTS1 /PDP SYMBOLIC
5456 /'XMODE' COMMAND LIST
5457 MODLST, TEXT "OFO@SAS@LOL@NON@"
5460 MODOPS, XMODS-1 /OFFSET
5470 XDMLST, TEXT "ALPANO"
5472 XDMOPS, XDMODS-1 /ALL
5477 /LIST OF DESCRIPTOR ADDRESSES FOR "SHOW MODE"
5480 MODELS, MS29 / 0 = "NORMAL"
5485 /LIST OF DESCRIPTOR ADDRESSES FOR "SHOW OUTPUT"
5487 MS16 /-1 = "FPP (SYMBOLIC)"
5488 OUTLS, MS26 / 0 = "OCTAL"
5489 MS31 /+1 = "PDP (SYMBOLIC)"
5492 /'XWORD' COMMAND LIST
5495 /'XSTRIN' COMMAND LIST
5496 STRLST, TEXT "FRF@TOT@ABA@MAM@ME"
5500 XWOROP, XWOR2 /UNEQUAL
5513 STROPS, XWSFRM /FROM
5522 \f/LIST OF TERMINATORS, IN ORDER, FOR 'EVAL'
5534 /'GWORD' & 'ACCEPT' COMMAND LISTS
5555 GWOPS1, GWD4 / 9 - A NUMBER
5570 GWOPS2, GWD2 /SPACE - TERMINATOR
5574 ACOPS, ACCNUM / 9 - A DIGIT
5575 ACCNUM / 8 - A DIGIT
5576 ACCNUM / 7 - A DIGIT
5577 ACCNUM / 6 - A DIGIT
5578 ACCNUM / 5 - A DIGIT
5579 ACCNUM / 4 - A DIGIT
5580 ACCNUM / 3 - A DIGIT
5581 ACCNUM / 2 - A DIGIT
5582 ACCNUM / 1 - A DIGIT
5583 ACCNUM / 0 - A DIGIT
5586 DQUOTE / " - SINGLE ASCII
5587 SQUOTE / ' - PACKED ASCII
5588 ERCR / ( - ILLEGAL HERE
5589 ACCPT3-2 /SPACE - END
5592 /'GARGS' JUMP LIST - TERMINATORS
5595 ERCS /:, SHOULDN'T SEE, WILL DO ERROR
5597 ERCS /SPACE, SHOULDN'T SEE, WILL DO 'ERROR'
5600 /'GARGS' & 'ARG' COMMAND LISTS
5639 /'EVAL' COMMAND LISTS
5656 EVOPS2, EVLOC /L (LOC)
5659 EVSR+1 /C (CONTENTS)
5661 EVREM /R (REMAINDER)
5665 /ACTION CHARS FOR "READLN" SUBROUTINE
5666 REACTL, "R-100 /CTRL-R = RE-ECHO
5667 "U-100 /CTRL-U = ERASE LINE
5672 \f/ERROR ROUTINE ADDRESS LIST:
5726 SMASKB, -1 /STRING SEARCH MASK BUFFER
5728 COMB= SMASKB+66 /COMMAND INPUT BUFFER
5730 PDLB= COMB+140 /PUSH-DOWN-LIST BUFFER
5731 /**** ALSO REWIND BUFFER! ****
5732 CCBB-PDLB /SHOW PDL SPACE
5737 CCBB= 16400 /CORE-CONTROL-BLOCK BUFFER AND HEADER
5738 / BUFFER FOR LOAD MODULES, 1 PAGE FIELD 1
5740 DMPBUF= 16600 /DUMP OUTPUT BUFFER, 2 PAGES FIELD 1
5742 IOBUF= 17200 /DEVICE I/O DUFFER, 2 PAGES FIELD 1