--- /dev/null
+/FUTIL - FILE UTILITY - V07A
+
+VERSION=07
+PATCH="A&77
+
+/ OS/8 FILE UTILITY PROGRAM. ALLOWS EXAMINATION AND
+/ MODIFICATION OF OS/8 MASS STORAGE DEVICES FROM THE CON-
+/ SOLE. DUMPING OF BLOCKS, LISTING OF WORDS AND MODIFICA-
+/ TION OF WORDS CAN BE DONE IN 7 FORMATS: OCTAL; SIGNED AND
+/ UNSIGNED DECIMAL; UNPACKED, 6-BIT PACKED, XS240 PACKED AND
+/ OS/8 PACKED ASCII. LISTING AND DUMPING CAN ALSO BE DONE
+/ IN 5 MORE FORMATS: BCD, BYTE (OCTAL CHARACTER), 2 PSEUDO-
+/ SYMBOLIC FORMATS [PDP-8 & FPP-12/8A], AND A COMBINATION
+/ FORMAT FOR DIRECTORY DUMPING. PROGRAM USES BOTH COMMAND
+/ WORDS AND COMMAND CHARACTERS (LIKE ODT) FOR DIRECTION.
+
+/BY: JIM CRAPUCHETTES
+/ MENLO COMPUTER ASSOCIATES, INC.
+/ (FORMERLY: FRELAN ASSOCIATES)
+/ P.O. BOX 298
+/ MENLO PARK, CALIF. 94025
+/
+/
+/VERSIONS 1 THRU 4 - "XTAPE" FOR THE XSYSTEM,
+/ LAST REVISION--APRIL 1970.
+/
+/VERSION 5 - OS/8 OPERATION, JULY 1972 THRU JUNE 1976
+/ "(...)", "C & 'CC AS NUMBERS, IOT DECODING, LIST
+/ & DUMP FORMATS, OUTPUT TO LPT:, FILE DATE & LOC
+/ IN DIRECTORY, "WORD MEMREF...", BCD OUTPUT,
+/ ADDITIONAL ODT OUTPUTS, "BYTE" OUTPUT.
+/VERSION 6 - EXPANSION OF OS/8 OPERATION, JUNE 1976:
+/ "FILLER" FOR "MODIFY", SEARCH LIMITS CHANGE, "WRITE"
+/ WITH AN ARGUMENT, FPP INSTRUCTION DECODING, CHAINING
+/ SUPPORT (FOR CCL CALLS), LOAD MODULE HANDLING AND
+/ "SHOW HEADER", MULTIPLE DEFAULT EXTENSIONS, ^R FOR
+/ RETYPE, SET REPLACES OPTION, NEW OUTPUT ROUTINE FOR
+/ "DIRECTORY" FORMAT, LINK OVERLAY HANDLING, ODT CHANGES,
+/ EXIT, SCAN, WRITE LOCKED OPERATION, SPEED UP SEARCHES,
+/ XS240 FORMATS
+/VERSION 6.17 - APR 1, 1977; BATCH OPERATION, COMMENT
+/VERSION 6.20 - MAY 16, 1977; NEW DATE, FULL FILE OUTPUT
+/ (SET/SHOW DDEV, OPEN ..., CLOSE), OPT ":" ON DEVICES.
+/VERSION 6.21 - JUN 4, 1977; NEW INPUT ROUTINE, TEMP STORAGE
+/VERSION 6.22 - JUL 13, 1977; CRTL-Q & -S, SCOPE MODE,
+/ IF/END COMMANDS, ALPHA DATE.
+/
+/PREVIOUS VERSIONS HAVE BEEN AVAILABLE THROUGH DECUS,
+/ DEC SUPPORT BEGINS WITH VERSION 7 - 20-JUL-77.
+\f/ SOME ROUTINES AND IDEAS USED IN THIS PROGRAM WERE
+/ DERIVED FROM EDIT-8 AND FOCAL, BY RICK MERRILL, DEC.
+/ THE ODT COMMAND SET IS NEARLY IDENTICAL TO THE OS/8
+/ ODT COMMAND SET EXCEPT THAT 15 BIT ADDRESSES ARE USED
+/ EVERYWHERE AND THERE ARE NO COMMANDS FOR PROGRAM EXECU-
+/ TION.
+/ THE DOUBLE PRECISION ARITHMETIC ROUTINES ARE A MUCH
+/ MODIFIED VERSION OF DECUS 8-115A.
+
+
+/ ASSEMBLY INFORMATION:
+/
+/ .R PAL8 [VERSION 9]
+/ *FUTIL<FUTIL/L/K/P=6400$
+/ .SA ... FUTIL
+/
+/ THE LISTING FILE REQUIRES ABOUT 725 BLOCKS, THE BIN-
+/ ARY FILE ABOUT 35 BLOCKS AND THE CREF LISTING FILE ABOUT
+/ 960 BLOCKS. CREFING REQUIRES EITHER "/M" OR "/X" FOR
+/ CREF V3.
+
+
+/MEMORY ALLOCATION:
+/
+/00000-06310 PROGRAM PROPER
+/06310-06577 ARGUMENT STRING BUFFER
+/06400-06777 --- ONCE ONLY CODE FOR CHAIN ---
+/06600-07177 DDEV HANDLER AREA, 2 PAGES
+/07200-07577 DEVICE HANDLER AREA, 2 PAGES
+/
+/10000-11777 USR AREA & ERROR MESSAGES (SWAPPED)
+/12000-12377 CCB/HEADER CODE, OPEN, CLOSE & OUTPUT
+/12600-15700 TEXT STRINGS, LISTS
+/15700-16377 STRING MASK, COMMAND BUFFERS, PDL
+/16400-16577 CCB BUFFER, 1 PAGE
+/16600-17177 DDEV BUFFER, 2 PAGES
+/17200-17577 I/O BUFFER, 2 PAGES
+\f/PAGE 0: POINTERS, CONSTANTS, VARIABLES, SWITCHES, ADDRESSES
+
+
+*0
+
+OVLFLG, 0 /OVERLAY FLAG FOR SAVE FILES
+
+DPSGN, 0
+LASTOP, 0
+THISOP, 0
+
+ZBLOCK 3 /USED BY ODT
+
+/VARIABLES & SWITCHES
+PDLPT, 0 /P.D.L. POINTER
+DPNT, RUBO-1 /USED UNIVERSALLY (SCOPE INITIALIZATION)
+SPNT, SCOPLS-1 /USED BY 'XSTRIN', 'XSMASK', 'READ', 'TERMT'
+SCANX1, BATLS-1 /USED BY 'SORTJ' (BATCH INITIALIZATION)
+SCANX2, 0 /USED BY 'XSTRIN'
+GETPNT, 0 /USED BY 'GET' & 'BKLOC'
+COMIR, 0 /USED FOR USER LINE INPUT
+COMOUT, COMB-1 /USED FOR USER LINE SCAN
+TYPSW, 0 /ODT COMMAND OCT-SYM SWITCH (0=OCT)
+ERMODE, 0 /ERROR MESSAGE MODE SWITCH (0=LONG)
+
+TEMP, 0
+TEMP1, 0
+TEMP2, 0
+TEMP3, 0
+ACC1, 0 /24 BIT ACCUMULATORS
+ACC2, 0
+ACCX1, 0
+ACCX2, 0
+
+NAM1= ACC1 /DEFINITIONS FOR NAME BUFFER:
+NAM2= ACC1+1 / THESE LOCATIONS ARE USED FOR A
+NAM3= ACC1+2 / 6 CHARACTER FILE (OR DEVICE)
+NAM4= ACC1+3 / NAME & A 2 CHAR EXTENSION.
+
+OPER1, 0
+OPER2, 0
+
+TEMPV1, 0 /24 BIT TEMPORARY STORAGE FOR
+TEMPV2, 0 / "SET TEMP ..." & "EVAL T"
+
+CHAR, 0
+CNT, 0
+CNTR, 0
+CNTRA, 0
+NCNT, 0 /LINE POSITION COUNTER
+FCNT, 0 /FORMAT NUMBER (INIT TO PACKED ASCII)
+OUTPNT, PACOUT /POINTER TO DEFAULT OUTPUT ROUTINE
+MODSW, 0 /MODES: NORMAL=0,MAPPED=+,OFFSET=-.
+CHARSW, 0 /CHARACTER PACK & UNPACK SWITCH
+CRSWT, 0 /= -1 IF GWORD TERMINATOR WAS A SPACE
+SHUT, 0 /= -1 IF SOMETHING OPEN
+MODIF, 0 /= -1 IF SOMETHING WAS MODIFIED
+ABSSW, 0 /ABSOLUTE OR RELATIVE LOCATION FOR SEARCHES
+DSWIT, 0 /DUMP SWITCH: "DUMP","LIST" & "SHOW ERR" -> 1
+DMODE, 0 /DUMP MODE: NONE=0,PART=1,ALL=4000
+
+CBLK, 0 /= CURRENT BLOCK
+ 0 /DUMMY FOR "SHOW ABS"
+CAD, 0 /= CURRENT ADDRESS (0 -> 377)+IOBUF
+BLK, 0 /= "BLOCK"
+LOCH, 0
+LOCL, 0 /= "LOCATION" (DISPLACEMENT)
+UBLK, 0 /UPPER LIMIT FOR SEARCHES
+ULOCH, 1
+ULOCL, 7577
+LBLK, 0 /LOWER LIMIT FOR SEARCHES
+LLOCH, 0
+LLOCL, 200
+SBLK, 0 /"LOCATION" FOR "ODT" ROUTINES
+SLOCH, 0
+SLOCL, 0
+
+OFFSET, 0 /OFFSET
+FILLER, 0 /FILLER CONSTANT FOR "MODIFY"
+MASK, -1 /MASK FOR WORD SEARCH
+SMASKL, -1 /= -(LENGTH OF SMASK)
+RBLK1, 0 /START BLOCK OF FILE
+DEVAD, 7607 /DEVICE ENTRY ADDR (INIT TO "SYS")
+DEVNO, 1 /DEVICE NUMBER (INIT TO "SYS")
+USRAD, 7700 /USR ADDRESS, INITIALIZED TO OUT
+ /7700=MSGS IN; 0=NONE IN; 200=USR IN
+
+/CONSTANTS
+M400, -400
+M240, -240
+M215, -215
+M200, -200
+M100, -100
+M20, -20
+M10, -10
+M1, -1
+N7, 7
+N15, 15
+N20, 20
+N77, 77
+N177, 177
+N200, 200
+N377, 377
+N7000, 7000
+N7400= M400
+
+/ADDRESSES
+READLN= JMS I . /GET NEXT INPUT LINE, WITH
+ READ / SPECIAL TERMINATORS
+TYPSTI, TYPSTR
+TYPSI, TYPES
+TYPECI, TYPEC
+TWOCI, TWOCS
+CRLFI, CRLF
+DIGIT= JMS I . /OUTPUT AN ASCII DIGIT
+ DODIG
+SPACE1= JMS I . /OUTPUT 1 SPACE OR ...
+ DO1SP
+SPACE2= JMS I . /OUTPUT 2 SPACES
+ DO2SP
+CTRLI, CTRL
+TWOT, PACOUT
+TYPEI, TYPE
+DECI, DPRT
+OCTI, OPRT
+DEC2I, DEC2
+PDATEI, PDATE
+RTL6I, RTL6
+RTR6I, RTR6
+SOCTI, OCTSET
+BKLOCI, BKLOC
+EVALI, EVAL
+
+PUSH= JMS I . /PUSH AC ON P.D.L.
+ PUSHX
+POP= JMS I . /POP P.D.L. INTO AC
+ POPX
+CALUSR= JMS I . /DO USR FUNCTION
+ USEUSR
+TADIDP= JMS I . /"TAD I DPNT" IN FIELD 1
+ TIDPNT
+TADICAD= JMS I . /"TAD I CAD" IN FIELD 1
+ TICAD
+DCAICAD= JMS I . /"DCA I CAD" IN FIELD 1
+ DICAD
+
+GWORDI, GWORD
+GARGI, GARGS
+ARGI, ARG
+GETI, GET
+ODGETI, ODGET
+GETNI, GETN
+SSKIPI, SSKIP
+LIMITI, LIMITS
+INCI, INC
+SORTI, SORTJ
+ENDCI, ENDC
+RECRLF, MAIN1-1
+RESTAR, MAIN1
+
+ERROR= JMS I .
+ XERROR
+
+COMST, COMB-1
+TEMPST, TEMPL-1
+MASKBS, SMASKB-1
+
+
+PAGE
+\f/PROGRAM MAIN LOOP AND DRIVER. COLLECTS CHARACTERS
+/INTO COMMAND BUFFER UNTIL END IS REACHED.
+
+ DCA USRAD /CLEAR ON RESTART (NOTHING IN)!
+ TLS /RAISE TELETYPE FLAG
+ DCA SHUT /NOTHING IS OPEN
+ JMS I CRLFI /OUTPUT CR-LF.
+MAIN1, JMS I SOCTI /SET INPUT TO OCTAL; EXEC 'COMMENT'
+ DCA DSWIT /RESET DUMP OUTPUT SWITCH
+ TAD COMST /INIT COMMAND BUFFER.
+ DCA COMIR
+ TAD (PDLB+1 /INIT PUSH-DOWN-LIST
+ DCA PDLPT
+MAIN2, READLN /GET A LINE FROM INPUT.
+ CCHARL-1 /CR LF ; ! / ALT-
+ COPSL-CCHARL / MODES ETC...
+ JMP MAIN1 /BUFFER WAS EMPTIED.
+
+
+/ROUTINE TO HANDLE CARRIAGE RETURN.
+CRCR, JMS I ENDCI /PUT A CR IN BUFFER
+ JMP CRCRC /ONLY A CR IN BUFFER
+ JMS I GWORDI /GET COMMAND WORD
+ JMP CRCRN /BUFFER BEGINS WITH A #
+ ISZ CRSWT /WORD ENDED BY A CR?
+ JMP CRCR1 /YES, ONLY A FEW ARE OK
+ JMS I SORTI /NO, LOOK UP COMMAND
+ CWORDL-1
+ WOPSL-CWORDL
+ERCB, ERROR /NOT A LEGAL COMMAND
+/
+CRCR1, JMS I SORTI /"WRITE","REWIND","EXIT" & "COMMENT"
+ CWORL2-1
+ WOPSLL-CWORL2
+ERCA, ERROR /SOMETHING NOT LEGAL
+/
+CRCRN, JMS CLOSE /CLOSE THE OPEN LOCATION IF OPEN
+CRCRC, DCA SHUT / MARK LOCATION CLOSED
+ JMP MAIN1
+
+/ROUTINE TO HANDLE SLASH
+SLASH, JMS I ENDCI /END BUFFER WITH A CR
+ JMP SLA1 /OPEN LAST, CR ONLY
+ JMS WCHEK /DOES LINE START W. A WORD?
+ JMS I LIMITI /NO, GET ARG--
+ SBLK / & SLOCH & SLOCL
+SLA1, SPACE1 /OUTPUT SPACE
+SLO1, JMS ODTOUT /GET THE WORD & OUTPUT
+SLO2, SPACE1 /FOLLOWED BY 2 SPACES
+ SPACE1 /(FOR ";"--OUTPUT ONLY 1 SPACE AND
+ JMS I ODGETI / THEN FORCE ACTION & IGNORE VALUE)
+ STA
+ JMP CRCRC /GO MARK LOCATION OPEN
+
+/ROUTINE TO HANDLE ALT MODE & ESCAPE KEYS
+ALTMOD, TAD OUTPNT /USE OUTPUT ROUTINE 'SET' BY
+ JMP ALTM1 / 'FORMAT' OPTION.
+
+/ROUTINE TO CLOSE A LOCATION, OUTPUT ITS (NEW) CONTENTS IN A
+/ SPECIFIED FORMAT AND THEN RE-OPEN. THE ROUTINE HANDLES:
+/ # (BCD), $ (OS/8 ASCII), % (BYTE OCTAL), & (XS240 ASCII),
+/ : (SIGNED DECIMAL), < (OCTAL), = (UNSIGNED DECIMAL),
+/ > (PDP SYMBOLIC), @ (DATE), [ (ASCII), \ (FPP SYMBOLIC),
+/ ] (PACKED ASCII) AND ? (DIRECTORY).
+/
+OMODES, TAD SCANX1 /'SORTJ' POINTER TO CHAR LIST
+ TAD (OTABLE-1-CCHARL
+ DCA DPNT /POINT INTO ADDR TABLE,
+ TADIDP / GET OUTPUT ROUTINE ADDR,
+ALTM1, DCA OMODPT / & SET POINTER TO ROUTINE.
+ JMS ECLOSE /CLOSE THIS LOCATION
+ SPACE1 /OUTPUT SPACE
+ DCA CHARSW /RESET UNPACK SWITCH
+ JMS I ODGETI /GET WORD
+ JMS I OMODPT /OUTPUT IN DESIRED FORMAT
+ JMP SLO2 /AND GO REOPEN.
+OMODPT, 0
+
+/ROUTINE TO HANDLE BACKARROW.
+BACKAR, JMS ECLOSE /CLOSE THIS LOCATION
+ TADICAD /GET THE CONTENTS,
+ JMP UPARR1 /AND USE THEM AS THE ADDR
+
+/ROUTINE TO HANDLE UPARROW.
+UPARR, JMS ECLOSE /CLOSE THIS LOCATION
+ TADICAD /IS THIS A 'PAGE 0' REF.?
+ AND N200
+ SZA CLA
+ TAD SLOCL /YES, USE PAGE BITS
+ AND M200 / MASK PAGE OR 0 TO PAGE #
+ DCA SLOCL / & SAVE IT
+ TADICAD /GET THE CONTENTS,
+ AND N177 /AND USE THE ADDRESS BITS.
+ TAD SLOCL / ALONG WITH PAGE BITS
+UPARR1, DCA SLOCL /THIS IS 12 BIT ADDR
+ JMP EXCL2 /NOW GO FINISH
+\f/ROUTINE TO HANDLE SEMICOLON, LINE FEED & EXCLAMATION.
+
+SEMIC, DCA I READLN-4400 /SET NO-OUTPUT SWITCH
+LFLF, STA /LINE-FEED - CLOSE,INCREMENT,OUTPUT
+EXCL, DCA OMODPT /EXCLAMATION - CLOSE,DECREMENT,OUTPUT
+ JMS ECLOSE /CLOSE THIS LOCATION
+ IAC
+ DCA ACC1 /SET UP D.P. INCREMENT
+ DCA ACC2
+EXCL1, DCA DPSGN /(FOR SAFETY)
+ ISZ OMODPT /INCREMENT OR DECREMENT?
+ JMS DPNEG / DECREMENT, NEGATE VALUE
+ CLL
+ TAD ACC1
+ TAD SLOCL /UPDATE LOCATION TO 15 BITS
+ DCA SLOCL
+ RAL
+ TAD ACC2
+ TAD SLOCH
+ AND N7 / (BUT ONLY 15 BITS)
+ DCA SLOCH
+ TAD I READLN-4400 / ANY OUTPUT?
+ SNA CLA
+ JMP SLO2+1 / NO, WAS ";" DO ONE SPACE
+EXCL2, JMS I CRLFI /GIVE CR/LF FOR NEXT LINE
+ JMS I BKLOCI /OUTPUT ADDRESS
+ SBLK-1
+ JMS I TWOCI /OUTPUT "\ "
+ 3440
+ JMP SLO1 /NOW GO OPEN NEXT LOCATION
+
+/ROUTINE TO HANDLE PLUS & MINUS.
+PLUS, STA /"+", SET SWITCH
+MINUS, DCA OMODPT /"-", CLEAR SWITCH
+ JMS I ENDCI /END BUFFER, TEST
+ JMP EXCL2 /NO ARG, DO SAME AGAIN
+ JMS WCHEK /LINE START WITH A COMMAND?
+ JMS I ARGI /NO, GET AN ARG
+ JMP EXCL1 /UPDATE LOC & GO OPEN
+
+
+ECLOSE, 0 /SUB. TO CLOSE THE LOCATION IF ARG.
+ JMS I ENDCI /END BUFFER WITH A CR.
+ JMP I ECLOSE /ONLY A CR IN BUFFER, DONE
+ JMS WCHEK /DOES LINE START W. A WORD?
+ JMS CLOSE /ARG IN BUFFER, USE IT
+ JMP I ECLOSE /DONE
+
+CLOSE, 0 /SUBROUTINE TO CLOSE A LOCATION
+ JMS I ARGI /GET ONE ARG
+ ISZ SHUT /ANYTHING OPEN?
+ JMP I CLOSE /NO, RETURN
+ JMS I ODGETI /YES, SET UP THINGS RIGHT
+ STA
+ DCA MODIF /SET MODIFY FLAG
+ TAD ACC1 /USE "LOC" AS DATA
+ DCAICAD /STORE IT
+ JMP I CLOSE
+
+
+PAGE
+\f/ROUTINE TO 'EVALUATE' A SIGNED DOUBLE PRECISION ARITHMETIC
+/ EXPRESSION & OUTPUT THE RESULTS IN OCTAL & D.P. SIGNED
+/ DECIMAL.
+XVAL, JMS I EVALI /GO EVALUATE
+ SKP /TERMINATED BY A CR
+ERCC, ERROR / SORRY!--TOO MANY ")"S
+ JMS I TWOCI /"= "
+ 7540
+ TAD ACC2
+ JMS I OCTI /OUTPUT HIGH ORDER IN OCTAL
+ TAD ACC1
+ JMS I OCTI /OUTPUT LOW ORDER IN OCTAL
+ TAD ACCX1 /SAVE REMAINDER FOR LATER
+ DCA COMIR
+ TAD ACCX2
+ DCA COMOUT
+ TAD (-7
+ DCA XERROR /MUST DEVELOP 7 DIGITS
+ JMS I TWOCI /OUTPUT " ("
+ 4050
+ TAD ACC2 /IS DPAC NEG?
+ SMA CLA
+ JMP DLOOP1-1 /NO, OUTPUT " "
+ JMS DPNEG /YES, MAKE IT POSITIVE
+ TAD N15 / AND OUTPUT "-".
+ SPACE1
+DLOOP1, TAD (12 /RESET DIVISOR TO 10(10)
+ DCA OPER1
+ DCA OPER2
+ JMS DDIV /GO DIVIDE DPAC BY 10(10)
+ TAD ACCX1 / GET REMAINDER
+ PUSH /PUT IT ON PUSH-DOWN-LIST
+ ISZ XERROR /DONE YET?
+ JMP DLOOP1
+ TAD COMOUT /YES, RESTORE REMAINDER
+ DCA ACCX2
+ TAD COMIR
+ DCA ACCX1
+ TAD (-7
+ DCA XERROR /NOW SET UP TO OUTPUT 7 DIGITS
+DLOOP2, POP / IN REVERSE ORDER!
+ DIGIT /MAKE REMAIN A DIGIT
+ ISZ XERROR /DONE?
+ JMP DLOOP2
+ JMS I TYPECI /YES, OUTPUT ")"
+ ")
+ JMP I RECRLF / AND CR/LF
+
+
+/ERROR ROUTINE
+XERROR, 0
+ CLA /CLEAR POSSIBLE JUNK FROM AC
+ DCA DSWIT /RESET IN CASE DUMP MODE
+ CDF 0
+ JMS I TYPECI /OUTPUT "?"
+ "?
+ TAD (ERLIST-1 /INIT LIST POINTER
+ DCA DPNT
+ DCA TEMP /SET CODE TO 0
+XERR1, ISZ TEMP /BUMP ERROR CODE
+ TADIDP /GET AN ADDRESS
+ SNA
+ JMP XERR2 /(FOR DEBUGGING)
+ CMA /= -(ADDR+1)
+ TAD XERROR /DOES IT MATCH THE CALL?
+ SZA CLA
+ JMP XERR1 /NO
+XERR2, TAD TEMP /YES, OUTPUT ERROR CODE
+ JMS I DEC2I / AS 2 DECIMAL DIGITS
+ JMS I TYPSI /NOW OUTPUT " AT "
+ MS17
+ TAD (-COMB+1 /CALCULATE POSITION IN
+ TAD COMOUT / COMMAND BUFFER,
+ JMS I DEC2I / & OUTPUT AS 2 DIGITS.
+ TAD ERMODE /LONG/SHORT MESSAGES? [NOTE: THIS ->
+XERR3, SZA CLA / "7600" (A CLA) IF 'USROUT' ERROR!]
+ JMP XERR4 /SHORT, GO DO CR/LF
+ JMS USROUT /LONG, BE SURE MESSAGES ARE IN
+ SPACE2 /OUTPUT 2 SPACES
+ TAD TEMP /CODE = ADDRESS-1 OF ADDRESS
+ DCA DPNT / OF MESSAGE
+ TADIDP /GET MESSAGE ADDR
+ JMS I TYPSTI / OUTPUT MESSAGE
+XERR4, JMS I CRLFI /OUTPUT A CR,LF PAIR
+ JMP I .+1 /*** CIF BAT /BATCH OPER.
+ MAIN1 /*** JMP I N7000 /'BATABT'!
+
+
+USEUSR, 0 /USR CALLER SUBROUTINE (FROM EITHER FIELD!)
+ DCA USRSAV /SAVE CONTENTS OF AC
+ RDF
+ TAD UCDF0 /SET UP RETURN FIELD (FOR 2ND USR CALL)
+ DCA USRCDF
+UCDF0, CDF 0 /SET TO HERE FOR 1ST CALL
+ TAD USRAD /IS USR IN OR OUT?
+ SMA SZA CLA
+ JMP USRIN /IN, GO TO IT
+ CIF 10
+ JMS I M100 /OUT, DO "USRIN" FUNCTION
+ 10
+ TAD N200
+ DCA USRAD / & SO INDICATE
+USRIN, CDF CIF 10
+ TAD USEUSR /MOVE RETURN ADDRESS TO THE
+ DCA I N200 / USR ENTRY POINT
+USRCDF, CDF /SET UP D.F. FOR RETURN
+ TAD USRSAV /RESTORE AC CONTENTS
+ JMP I (201 / & FAKE A CALL TO IT
+USRSAV,
+
+USROUT, 0 /SUBROUTINE TO REMOVE USR BY RECALLING
+ERC15, TAD USRAD / ERROR MESSAGES FROM SCRATCH
+ SPA CLA / BLOCKS ON SYS.
+ JMP I USROUT /JUST EXIT IF PRESENT...
+ TAD M100
+ DCA USRAD /SET USR TO "OUT"
+ JMS I (7607 /READ IN THE MESSAGES
+ 610 / 6 PAGES TO FIELD 1
+ 0 / STARTING AT LOC 10000
+ 27 / FROM SCRATCH BLKS
+ SKP CLA /!!! ERROR !!!
+ JMP I USROUT /OK, JUST EXIT
+ TAD M200
+ DCA XERR3 /NO MORE MESSAGES ON ERROR!
+ TAD ERC16
+ DCA ERC15 /AND NO MORE "SHOW ERROR"!
+ERC16, ERROR /TELL THE HORRIBLE STORY!
+
+
+PAGE
+\f/ROUTINE TO EXECUTE THE BLOCK 'SCAN' COMMAND
+XSCAN, JMS I GARGI /GET ARGS CONVERTED
+ TAD (SCANER / & SET UP FOR SCANNING
+ JMP XDUM0
+
+/ROUTINE TO EXECUTE THE BLOCK 'DUMP' COMMAND
+XDUMP, TAD MODSW /MAPPED MODE?
+ SMA SZA CLA
+ERC14, ERROR /YES, DUMP IS MEANINGLESS!
+ JMS XDLCOM /DO COMMON STUFF
+ TAD (LLIST / & SET UP FOR DUMPING
+XDUM0, DCA XGFORM /SET OUTPUT ROUTINE--DUMP/SCAN
+XDUM1, ISZ DPNT /SKIP FIRST WORD
+ ISZ DPNT /SKIP A WORD
+ TAD I DPNT /GET NEXT START BLOCK.
+ JMS BLKTST
+ TAD I DPNT /GET NEXT -(# BLOCKS)
+ DCA TEMP1
+XDUM2, JMS I CTRLI /TEST HERE FOR 'SCAN' TERMINATE
+ DCA LOCL /SET LOC TO 0
+ DCA LOCH
+ TAD M400 /SET TO -400(8) [1 BLOCK]
+ JMS I XGFORM /DUMP OR SCAN A BLOCK
+ ISZ BLK /INCREMENT BLOCK NUMBER
+ ISZ TEMP1 /DONE?
+ JMP XDUM2 /NO, DO NEXT BLOCK
+ ISZ TEMP /YES, ARE ALL ARGS DONE?
+ JMP XDUM1 /NO, DO NEXT
+ JMP XLIS2 /YES, DONE--RESET SWITCH
+
+/ROUTINE TO EXECUTE THE LOCATION 'LIST' COMMAND
+XLIST0, JMS XDLCOM /DO COMMON STUFF
+XLIS1, TAD I DPNT /GET BLOCK #
+ JMS BLKTST /TEST & SET BLK
+ TAD I DPNT /GET & SET LOCATION
+ DCA LOCH
+ TAD I DPNT
+ DCA LOCL
+ TAD I DPNT /GET -(# WORDS)
+ JMS LLIST /NOW GO DO IT
+ ISZ TEMP /ARE ALL ARGS USED?
+ JMP XLIS1 /NO, CONTINUE
+XLIS2, DCA DSWIT /RESET DUMP SWITCH
+ JMP I RECRLF / DO CR/LF & CONTINUE
+
+/COMMON SUBROUTINE FOR 'XDUMP'&'XLIST0'
+XDLCOM, 0
+ TAD OUTPNT /INITIALIZE DEFAULTS
+ DCA LISTPT
+ TAD OUTSW
+ DCA LOUTSW
+ JMS XGFORM /GET FORMAT, IF ANY
+ NOP /RETURN FOR NO FORMAT
+ JMS I GARGI /GET ARGS
+ ISZ DSWIT /SET DUMP SWITCH
+ JMP I XDLCOM
+
+/SUBROUTINE TO OUTPUT -[C(AC)] WORDS FROM THE DEVICE
+/BEGINNING AT BLK.LOC IN THE SPECIFIED FORMAT
+LLIST, 0
+ DCA CNTRA /SET UP -# WORDS TO LIST
+ DCA CHARSW /RESET UNPACK SWITCH
+LLIS1, JMS I CRLFI
+ TAD LOCL
+ AND N7 /SET UP # ON THIS LINE
+ DCA CNTR
+ TAD LOUTSW /IF CHARACTER OUTPUT,
+ SNA CLA
+ TAD M10 / DOUBLE # WORDS/LINE
+ TAD CNTR
+ TAD M10
+ DCA CNTR
+ JMS I BKLOCI /OUTPUT LOCATION
+ BLK-1
+ JMS I TYPSI /OUTPUT ": "
+ MS13
+LLIS2, JMS I GETI /GET A WORD
+ JMP LLIS3 /FILE MODE, NO SUCH ADDR..
+ JMS I LISTPT /OUTPUT IT
+ TAD LOUTSW /TEST MODE SWITCH
+ SPA
+ JMP LLIS5 /"SYMBOLIC", CR/LF NOW
+ SZA CLA /CHARACTERS, NO SPACES
+ SPACE2 /NUMBERS, TWO SPACES
+LLIS3, JMS I INCI /INCREMENT LOC
+ ISZ CNTRA /ALL WORDS DONE?
+ JMP LLIS4 /NO
+ JMS I CRLFI
+ JMP I LLIST /YES, RETURN
+/
+LLIS4, ISZ CNTR /ALL DONE WITH THIS LINE?
+ JMP LLIS2 /NOT YET
+ JMP LLIS1 /YES, OUTPUT CR/LF & CONTINUE
+/
+LLIS5, STA
+ DCA CNTR /FORCE A CR/LF
+ JMP LLIS3
+LISTPT, 0
+LOUTSW, 0
+
+
+/SUBROUTINE TO GET A FORMAT FOR 'XFORM' & 'XDLCOM'
+XGFORM, 0
+ JMS I GWORDI /GET A WORD
+ JMP I XGFORM /NOT FOLLOWED BY A WORD
+ JMS I SORTI /LOOK UP WORD
+ FORML-1
+ FOPSL-FORML
+ERCD, ERROR /WORD NOT RECOGNIZED
+/
+XFSYM, STL RAR /"SYMBOLIC"; SWITCH NEG
+XFNUM, IAC /NUMERIC; SWITCH POS
+XFCHR, DCA LOUTSW /CHARACTER; SWITCH 0
+ TAD SCANX1 /'SORTJ' POINTER TO CHAR
+ TAD (-FORML /CALCULATE FORMAT #
+ CLL RAR /(DIVIDE BY 2)
+ DCA TEMP1 / & SAVE IT.
+ TAD TEMP1
+ TAD (FTABLE-1
+ DCA DPNT
+ TADIDP
+ DCA LISTPT /SET UP OUTPUT POINTER
+ ISZ XGFORM /BUMP RETURN ADDRESS
+ JMP I XGFORM
+
+/ROUTINE TO 'SET' THE 'FORMAT' OPTION
+XFORM, JMS XGFORM /GET FORMAT WORD
+ERCE, ERROR /NUMBER?! SORRY ABOUT THAT!
+ TAD LOUTSW /OK, SET UP DEFAULTS:
+ DCA OUTSW / SWITCH,
+ TAD LISTPT
+ DCA OUTPNT / ROUTINE POINTER,
+ TAD TEMP1
+ DCA FCNT / & FORMAT #
+ JMP XSETN
+OUTSW, 0 /MODE:0=NOTHING,+=SPACES,-=CR/LF
+
+
+PAGE
+\f/ROUTINE TO EXECUTE THE 'OPEN' COMMAND.
+XOPEN, STA /"." LEGAL IN FILE NAME
+ JMS GNAME /GET FILE NAME FOR OUTPUT
+ CIF 10
+ JMP XOPEN1 /NOW GO TO FIELD 1 TO HANDLE
+
+
+/ROUTINE TO EXECUTE THE 'CLOSE' COMMAND.
+XCLOSE, CDF CIF 10
+ JMP XCLOS1 /ALL CODE IS IN FIELD 1
+
+
+/ROUTINE TO EXECUTE THE 'FILE' COMMAND.
+XFIERR, TAD TEMP1 /MADE ALL POSSIBLE ATTEMPTS
+ SMA CLA / AT EXTENSION RETRIES?
+ JMP XFIOUT / YES, ALL TRIES DONE!
+ ISZ DPSGN /THIS WILL SKIP ON 1ST FAIL
+ ISZ TEMP1 /THIS WILL SKIP ON 2ND FAIL
+ TAD (1404 / 2ND TRY--USE "LD" EXTEN
+ DCA NAM4 / 3RD TRY--USE NULL EXTEN
+ JMP XFICHN+2 / 3RD TRY IS FINAL FAILURE
+/
+XFIOUT, JMS PNAME /OUTPUT FILE NAME &
+ JMS I TYPSI /"LOOKUP FAILED"
+ MS15
+/
+XFILEN, JMS I CRLFI /OUTPUT CR/LF
+ ISZ CRSWT /WAS LAST ENDED BY A CR?
+ JMP I RESTAR /YES, DONE
+XFILE, STA /"." LEGAL IN FILE NAME
+ JMS GNAME /GET NEXT FILE NAME
+XFICHN, STA
+ DCA DPSGN /SET TRY AGAIN SWITCH
+ TAD (NAM1 /INIT POINTER TO NAME
+ DCA FSTBLK
+ TAD DEVNO /GET DEVICE #
+ CALUSR
+ 2 /LOOKUP
+FSTBLK, 0 /NAME PNTR, BECOMES ST BLK
+FBKLEN, 0 / BECOMES -(FILE LENGTH)
+ JMP XFIERR /LOOKUP FAILED
+ TAD FSTBLK
+ DCA RBLK1 /SET UP PAGE 0 ST BLK
+ CDF 10
+ DCA I (CCBB / & RESET CCBB
+ TAD I (1404 /GET # ADD'L INFO WORDS
+ DCA GDEV2 / (NEGATIVE) & SAVE IT
+ TAD GDEV2
+ TAD I (17 /POINT TO FIRST OF THEM
+ DCA GDEV3 / (THE DATE, IF PRESENT)
+ TAD I N7 /GET THE NUMBER OF THE
+ AND N7 / DIRECTORY SEGMENT IN
+ DCA CNTR / CORE & SAVE IT.
+ TAD GDEV2 /WAS # OF ADD'L WRDS = 0?
+ SZA CLA
+ TAD I GDEV3 / NO, GET THE DATE WORD
+ CDF 0
+ DCA GDEV1 /STORE DATE OR 0 (NO DATE)
+ JMS PNAME /OUTPUT FILE NAME
+ TAD FSTBLK
+ JMS I OCTI /OUTPUT ST. BLK. IN OCTAL
+ JMS I TYPECI
+ "-
+ TAD FBKLEN /CALCULATE LAST BLK #
+ CMA
+ TAD FSTBLK
+ JMS I OCTI / & OUTPUT IN OCTAL
+ SPACE2 /OUTPUT 2 SPACES
+ TAD FBKLEN
+ CIA
+ JMS I OCTI /OUTPUT LENGTH IN OCTAL
+ JMS I TWOCI /" ("
+ 4050
+ TAD FBKLEN
+ CIA
+ JMS I DECI / & AGAIN IN DECIMAL
+ JMS I TYPSI /") "
+ MS33
+ TAD CNTR /GET SEGMENT #
+ JMS I RTL6I / & PUT IN BITS 3-5
+ JMS I TWOCI / TO OUTPUT IT & "."
+ 6056
+ TAD GDEV3 /GET ADDR OF 1ST ADD'L WRD
+ TAD (-1400-4 / FOR OFFSET OF NAME START
+ JMS OCT3 /OUTPUT LOCATION IN SEG
+ SPACE2 / & TWO SPACES
+ TAD GDEV1 /GET DATE WORD
+ SZA /IS IT = 0?
+ JMS I PDATEI /NO, OUTPUT DATE
+ JMP XFILEN /NOW OUTPUT CR/LF & CONTINUE
+
+
+/ROUTINE TO 'SET' THE 'DEVICE' OPTION
+XDEV, JMS GDEVICE /GET & FETCH DEVICE HANDLER
+ DEVHAN+1 / (2 PAGE HANDLER IS OK)
+ DCA DEVAD /SET UP HANDLER ADDRESS
+ TAD GDEV2 /SAVE DEVICE #
+ DCA DEVNO
+ DCA RBLK1 / & NO FILE KNOWN
+ DCA SHUT / & NOTHING OPENED
+ DCA MODIF / & NOTHING MODIFIED
+ TAD NAM1
+ CIF 10
+ JMP XDEVM /GO FINISH SETUP IN FIELD 1
+
+
+/ROUTINE TO 'SET' THE 'DDEV' OPTION
+XDDEV, JMS GDEVICE /GET & FETCH DEVICE HANDLER
+ DMPHAN+1 / (2 PAGE HANDLER IS OK)
+ CIF 10
+ JMP XDDEV1 /GO TO FIELD 1 TO FINISH SETUP
+
+GDEVICE,0 /SUBROUTINE TO GET DEVICE NAME & FETCH HANDLER
+ JMS GNAME /GET DEV NAME ("." ILLEGAL)
+ TAD NAM1 /MOVE NAME TO CALL
+ DCA GDEV1
+ TAD NAM2
+ DCA GDEV2
+ TAD I GDEVICE /GET HANDLER SPACE ADDRESS
+ ISZ GDEVICE
+ DCA GDEV3
+ CALUSR
+ 1 /FETCH HANDLER
+GDEV1, 0
+GDEV2, 0
+GDEV3, 0
+ERCY, ERROR /NO SUCH HANDLER
+ TAD GDEV3 /RETURN HANDLER ADDRESS
+ JMP I GDEVICE
+
+
+PAGE
+\f/ROUTINE TO EXECUTE THE 'SHOW' COMMAND
+XSHBLK, JMS I TYPSI /"BLOCK = "
+ MS32
+ TAD RBLK1 /OUTPUT BLOCK IN OCTAL
+XSTYPE, JMS I OCTI
+XSHCR, JMS I CRLFI /GIVE A CR & LF
+ DCA DSWIT /BE SURE SWITCH IS RESET
+ ISZ CRSWT /LAST WORD ENDED BY CR?
+ JMP I RESTAR /YES, DONE
+XSHOW, JMS I GWORDI /GET A WORD
+ JMP ERCG /NUMBERS NOT RECOGNIZED
+ JMS I SORTI /LOOK IT UP
+ SHOWL-1
+ SHOWOP-SHOWL
+ERCG, ERROR /NOT FOLLOWED BY LEGAL WORD
+
+XSHVER, JMS I TYPSI /"VERSION = <VERSION><PATCH>"
+ MSVER
+ JMP XSHCR
+
+XSHMSK, JMS I TYPSI /"MASK = "
+ MS02
+ TAD MASK
+ JMP XSTYPE
+
+XSHOFF, JMS I TYPSI /"OFFSET = "
+ MS09
+ TAD OFFSET
+ CIA
+ JMP XSTYPE
+
+XSHFIL, JMS I TYPSI /"FILLER = "
+ MS37
+ TAD FILLER
+ JMP XSTYPE
+
+XSHODL, JMS I TYPSI /"ODT LOC = "
+ MS12
+ JMS I BKLOCI /OUTPUT IT
+ SBLK-1
+ JMP XSHBKS
+
+XSHREL, JMS I TYPSI /"REL. LOC = "
+ MS20
+ JMS I BKLOCI / & OUTPUT IT
+ BLK-1
+ JMP XSHBKS
+
+XSHABS, JMS I TYPSI /"ABS. LOC = "
+ MS03
+ TAD CAD /OUTPUT LOCATION IN BLOCK
+ TAD (-IOBUF
+ DCA CAD
+ JMS I BKLOCI
+ CBLK-1
+XSHBKS, TAD MODIF /HAS BLOCK BEEN MODIFIED?
+ SMA CLA
+ JMP XSHCR / NO, SAY NOTHING!
+ JMS I TYPSI / YES, SAY " MOD"
+ MSMOD
+ JMP XSHCR
+
+XSHUPP, JMS I TYPSI /"UPPER = "
+ MS04
+ JMS I BKLOCI /OUTPUT IN BLOCK.LOC FORM
+ UBLK-1
+ JMP XSHCR
+
+XSHLOW, JMS I TYPSI /"LOWER = "
+ MS05
+ JMS I BKLOCI
+ LBLK-1
+ JMP XSHCR
+
+XSHFMT, JMS I TYPSI /"FORMAT = "
+ MS06
+ TAD FCNT
+ TAD (FMTLS-1 /SET UP FOR CORRECT TITLE
+XSHFM, DCA DPNT
+ TADIDP /GET MESSAGE ADDRESS
+ JMS I TYPSTI /OUTPUT DESCRIPTOR
+ JMP XSHCR
+
+XSHMOD, JMS I TYPSI /"MODE = "
+ MS10
+ TAD MODSW /GET CORRECT MESSAGE
+ TAD (MODELS-1 /(OFFSET INTO TABLE)
+ JMP XSHFM /GET ADDRESS & OUTPUT
+
+XSHOUT, JMS I TYPSI /"OUTPUT = "
+ MS30
+ TAD TYPSW /SET UP MESSAGE ADDRESS
+ TAD (OUTLS-1 /(OFFSET INTO TABLE)
+ JMP XSHFM
+
+XSHSMS, JMS I TYPSI /"SMASK = "
+ MS07
+ TAD SMASKL
+ DCA TEMP /-# TO OUTPUT
+ TAD MASKBS
+ DCA DPNT /SET UP TO OUTPUT
+ TAD M10 /SET LINE LENGTH
+ DCA TEMP1
+ JMP XSHSM2
+XSHSM1, JMS I TWOCI /OUTPUT ", "
+ 5440
+ ISZ TEMP1 /ENOUGH ON THIS LINE?
+ JMP XSHSM2 /NO, OK
+ JMS I CRLFI /YES, OUTPUT CR-LF
+ SPACE2 / & 2 SPACES
+ STA /MAKE LINE 1 LONGER
+ JMP XSHSM1-3 /AND RESET LENGTH
+/
+XSHSM2, TADIDP /GET NEXT VALUE
+ JMS I OCTI / & OUTPUT IT
+ ISZ TEMP /ENOUGH?
+ JMP XSHSM1
+ JMP XSHCR /OK, GET NEXT WORD
+
+XSHDEV, JMS I TYPSI /"DEVICE = XXXX"
+ MSDEV
+ JMS I TWOCI /NOW OUTPUT " ("
+ 4050
+ TAD DEVNO /GET THE DEVICE #
+ JMS I DEC2I / & OUTPUT AS 2 DIGITS
+ JMS I TYPECI /FINALLY OUTPUT ")"
+ ")
+ JMP XSHCR
+
+XSHDDEV,JMS I TYPSI /"DDEV = XXXX"
+ MSDDEV
+ JMP XSHCR
+
+
+FPRNT, 0 /PRINT FIELD DIGIT FROM BITS 6-8
+ RTR /MOVE TO BITS 9-11
+ RAR
+ AND N7 /MASK TO 1 DIGIT
+ DIGIT / & OUTPUT IN ASCII
+ JMP I FPRNT
+
+
+PAGE
+\f/CONTINUATION OF 'SHOW' COMMAND
+
+/SHOW 'CCB' HANDLER
+XSHCCB, CDF CIF 10
+ JMS GCCB /SET UP CCB FOR FILE
+ DCA DPSGN / & SET UP SEGMENTS
+ JMS I TYPSI /"CCB:"
+ MS11
+ JMS CCHDST /DO SETUP, OUTPUT START
+ JMS I TYPSI /", JSW = "
+ MS19
+ JMS NXTOCT /OUTPUT J.S.W. IN OCTAL
+ JMS I CRLFI
+ JMS I TYPSI /" CORE SEGS: "
+ MS14
+XSHCC1, TAD (-4
+ DCA CNTR /-#/LINE
+XSHCC2, TADIDP /GET ORIGIN WORD
+ DCA TEMP1
+ TADIDP / & COUNT WORD
+ DCA TEMP2
+ TAD TEMP2 /GO OUTPUT START FIELD
+ JMS FPRNT
+ TAD TEMP1 / & START ADDR
+ JMS I OCTI
+ JMS I TYPECI / & A "-"
+ "-
+ TAD TEMP2 /OUTPUT FIELD AGAIN
+ JMS FPRNT
+ TAD TEMP2 / PAGE COUNT -> PAGES
+ CLL RAL
+ AND M200 /MASK OFF FIELD DATA
+ TAD TEMP1 /ADD ORIGIN ADDR
+ TAD M1 / & SUBTRACT 1 FOR END
+ JMS I OCTI /OUTPUT END ADDR IN OCTAL
+ ISZ DPSGN /DONE?
+ JMP XSHCC4 /NO
+ TAD OVLFLG /YES, OVERLAYS? (LINK OUTPUT)
+ SNA
+ JMP XSHCR / NO, DONE
+ DCA DPNT / YES, RESET POINTER
+ JMP XSHHD1 / & CONTINUE
+/
+XSHCC4, JMS I TWOCI /OUTPUT SEPARATOR
+ 5440
+ ISZ CNTR /DONE ON THIS LINE?
+ JMP XSHCC2 /NO
+ JMS I CRLFI /YES
+ SPACE2 /ADD 2 SPACES
+ STA /AND 1 MORE ITEM PER LINE
+ JMP XSHCC1
+
+/SHOW 'HEADER' HANDLER
+XSHHDR, CDF CIF 10
+ JMS GHDR /SET UP HEADER FOR MODULE
+ JMS I TYPSI /"HEADER:"
+ MS38
+ JMS CCHDST /DO SETUP, OUTPUT START
+ JMS I TYPSI /", NEXT WORD = "
+ MS39
+ TADIDP /GET FIELD DIGIT
+ DIGIT / & OUTPUT
+ JMS NXTOCT /FOLLOWED BY ADDRESS
+ JMS I TYPSI /", LOAD VER = "
+ MS40
+ JMS NXTOCT / & OUTPUT VERSION
+ TADIDP /GET E.P. FLAG
+ SNA CLA
+ JMP XSHHD1 / NO E.P.
+ JMS I TYPSI /", EP REQ'D"
+ MS41
+XSHHD1, JMS I CRLFI /TO THE NEXT LINE
+ JMS I TYPSI /" OVLYS START...
+ MS42
+XSHHD2, TADIDP /GET NUMBER OF OVERLAYS
+ SNA / FOR THIS LEVEL
+ JMP XSHCR / 0 = END, DONE
+ DCA TEMP1 /SAVE IT
+ JMS I CRLFI /OUTPUT A CR/LF
+ SPACE2 / AND 4 SPACES
+ SPACE2
+ TAD TEMP1
+ JMS I DEC2I /# OVLYS IN DECIMAL
+ SPACE2
+ TADIDP /GET MEMORY START WORD
+ DCA TEMP2
+ TAD TEMP2
+ JMS FPRNT /OUTPUT START FIELD
+ TAD TEMP2
+ AND M400 / & DOUBLE-PAGE
+ JMS I OCTI
+ SPACE2
+ JMS NXTOCT /OUTPUT RELATIVE BLOCK
+ SPACE2
+ JMS NXTOCT /OUTPUT OVERLAY LENGTH
+ JMP XSHHD2 /AND DO ANOTHER ROUND!
+
+/SHOW 'ERRORS' HANDLER
+XSHERR, JMS USROUT /BE SURE MESSAGES ARE IN
+ ISZ DSWIT /SET DUMP SWITCH
+ JMS I TYPSI /"ERRORS: FUTIL VERSION ..."
+ MSERR
+ JMS I CRLFI
+ CLA IAC
+ DCA DPNT /SET POINTER & CODE
+XSHER1, JMS I CRLFI /DO ANOTHER CR/LF
+ TAD DPNT /TEST FOR LAST REAL MESSAGE
+ TAD (-EMSEND /(NOT DEBUG MESSAGE!)
+ SNA CLA
+ JMP XSHCR
+ TAD DPNT /OUTPUT ERROR CODE
+ JMS I DEC2I / AS 2 DIGITS
+ JMS I TYPSI /THEN " = "
+ MS01
+ TADIDP /GET ADDR OF MESSAGE AND
+ JMS I TYPSTI / OUTPUT IT
+ JMP XSHER1
+
+
+CCHDST, 0
+ JMS I CRLFI
+ JMS I TYPSI /" SA = "
+ MS18
+ TAD (CCBB
+ DCA DPNT /SET UP POINTER TO DATA
+ TADIDP /GET 2ND WORD FROM CCB/HDR
+ JMS FPRNT /IT HAS START FIELD SO OUTPUT
+ JMS NXTOCT / FOLLOWED BY START ADDR
+ JMP I CCHDST
+
+
+PAGE
+\f/ROUTINE TO EXECUTE THE 'SET' COMMAND
+XSETN, ISZ CRSWT /WAS LAST INFO ENDED BY CR?
+ JMP I RESTAR /YES, DONE
+XSET, JMS I GWORDI /GET OPTION WORD
+ JMP XSET1 /NO NUMBERS PLEASE!
+ ISZ CRSWT /WAS WORD ENDED BY A CR?
+ERCK, ERROR /YES, ILLEGAL HERE
+ JMS I SORTI /LOOK UP WORD
+ SETLST-1
+ SETJMP-SETLST
+XSET1, ERROR /WHAT???
+
+
+/ROUTINE TO 'SET' THE 'DMODE' (DUMP MODE)
+XDMODE, JMS I GWORDI /GET A WORD
+ JMP ERC11 /NO NUMBERS HERE!
+ JMS I SORTI /LOOK IT UP
+ XDMLST-1
+ XDMOPS-XDMLST
+ERC11, ERROR /NO LIKEE!!
+/
+ CLL STA RAR /4000: 'ALL' (ECHO TO TTY & FILE)
+XDMODS, IAC / 1: 'PART' (ONLY DUMP,LIST,ETC)
+ DCA DMODE / 0: 'NONE' (TTY ONLY)
+ JMP XSETN
+
+
+/ROUTINE TO 'SET' THE 'OUTPUT' OPTION
+XOUTS, JMS I GWORDI /GET OPTION WORD
+ JMP ERCL / # IN THE BUFFER
+ JMS I SORTI /LOOK IT UP
+ XOLST-1
+ XOOPS-XOLST
+ERCL, ERROR /NOT FOLLOWED BY LEGAL WORD
+/
+ CLL STA RAL /-1: 'FPP' (SYMBOLIC)
+XOUTS1, IAC /+1: 'PDP' (SYMBOLIC)
+ DCA TYPSW / 0: 'OCTAL'
+ JMP XSETN
+
+
+/ROUTINE TO 'SET' THE 'MASK' OPTION
+XMASK, JMS I ARGI /GET ONE ARG
+ TAD ACC1 /GET 'LOC'
+ DCA MASK / & SET MASK
+ JMP XSETN
+
+
+/ROUTINE TO 'SET' THE 'OFFSET' OPTION
+XOFFS, JMS I ARGI /GET ONE ARG
+ TAD ACC1 /GET #
+ CIA
+ DCA OFFSET /SET IT
+ JMP XSETN
+
+
+/ROUTINE TO 'SET' THE 'ERROR' (MODE) OPTION
+XEMODE, JMS I GWORDI /GET WORD
+ JMP ERCZ /NO NUMBERS ALLOWED!!!
+ JMS I SORTI /LOOK IT UP
+ XELST-1
+ XEOPS-XELST
+ERCZ, ERROR /ILLEGAL SOMETHING
+/
+XEMOD1, IAC /'SHORT'
+ DCA ERMODE /'LONG'
+ JMP XSETN
+
+
+/ROUTINE TO 'SET' THE 'UPPER' LIMITS OPTION
+XUPP, JMS I LIMITI /UPPER, GET ARGS
+ UBLK
+ JMP XSETN
+
+/ROUTINE TO 'SET' THE 'LOWER' LIMITS OPTION
+XLOW, JMS I LIMITI /LOWER, GET ARGS
+ LBLK
+ JMP XSETN
+
+/ROUTINE TO 'SET' THE 'MODE' OPTION
+XMODE, JMS I GWORDI /GET OPTION WORD
+ JMP ERCJ /NUMBER IN BUFFER, BAIL OUT
+ JMS I SORTI /LOOK IT UP
+ MODLST-1
+ MODOPS-MODLST
+ERCJ, ERROR /NOT RECOGNIZED
+/
+ CLL STA RTL /-1: OFFSET
+XMODS, IAC /+2: LOAD (MODULE)
+ IAC /+1: SAVE (FILE)
+ DCA MODSW / 0: NORMAL
+ JMP XSETN
+
+/ROUTINE TO 'SET' THE 'FILLER' OPTION
+XFILL, JMS I ARGI /GET ONE ARG
+ TAD ACC1
+ DCA FILLER / & SET AS FILLER
+ JMP XSETN
+
+/ROUTINE TO 'SET' THE 'TEMP' STORAGE
+XTEMP, JMS I ARGI /GET THE 24 BIT ARG (EXPRESSION!)
+ TAD ACC1 /NOW SAVE THE 24 BITS FOR LATER
+ DCA TEMPV1
+ TAD ACC2 /GET IT BACK WITH "EVAL T"
+ DCA TEMPV2 / (OR IN AN EXPRESSION)
+ JMP XSETN
+
+
+/ROUTINE TO EXECUTE THE 'IF' COMMAND
+XIF, JMS I EVALI /EVALUATE THE EXPRESSION
+ SKP / TERMIN = CR, OK
+ JMP ERCC / TOO MANY PARENS
+ TAD ACC1 /TEST THE 24-BIT VALUE FOR ZERO
+ SNA
+ TAD ACC2
+ SNA CLA
+ JMP I RESTAR /OK, JUST CONTINUE
+XIFSKP, TAD COMST /NOT ZERO, BEGIN SKIPPING FOR
+ DCA COMIR / LINE STARTING WITH "END"
+ READLN /GET A LINE FROM THE INPUT
+ TYPEM-1 / WITH THESE TERMINATORS
+ IFSKPO-TYPEM
+ JMP XIFSKP /BUFFER EMPTIED
+/
+XIFCR, JMS I ENDCI /CR FOUND, TIDY THINGS UP
+ JMP XIFSKP / CR ONLY
+ JMS I GWORDI /GET 1ST WORD ON LINE
+ JMP XIFSKP / NO WORD
+ TAD (-0516 /IS THE WORD "EN..."?
+ SZA CLA
+ JMP XIFSKP / NO, KEEP LOOKING!
+ JMP I RESTAR /YES! BEGIN EXECUTION AGAIN!
+
+
+/ROUTINE TO OUTPUT LOCATION THAT SATISFIED ONE
+/OF THE SEARCH COMMANDS. IF ABSSW=0, OUTPUT
+/AS RELATIVE LOCATION.
+ABKLOC, 0
+ TAD ABSSW /IS IT 0?
+ SZA CLA
+ JMP ABK2 /NO, OUTPUT AS ABSOLUTE
+ JMS I BKLOCI /OUTPUT LOCATION
+ BLK-1
+ABK1, JMS I TWOCI /OUTPUT ": "
+ 7240
+ JMS I TWOT
+ JMP I ABKLOC
+/
+ABK2, TAD LOCL /MAKE ABSOLUTE
+ AND N377
+ DCA CAD
+ JMS I BKLOCI /NOW OUTPUT IT
+ CBLK-1
+ JMP ABK1
+
+TWOCS, 0 /OUTPUT 2-CHARACTER ARG
+ TAD I TWOCS /GET ARG
+ ISZ TWOCS /SKIP IT
+ JMS I TWOT /OUTPUT IT
+ JMP I TWOCS
+
+NXTOCT, 0
+ TADIDP /GET NEXT WORD FROM BLOCK
+ JMS I OCTI / & OUTPUT IN OCTAL
+ JMP I NXTOCT
+
+
+PAGE
+\f/ROUTINE TO EXECUTE THE 'WORD' SEARCH COMMAND
+XWORD, JMS SSET /INITIALIZE SEARCH
+ TAD CNOP /SET UP FOR NORMAL,
+ DCA CNOP+1
+ TAD M10 / EQUAL SEARCH
+XWOR2, TAD (SNA CLA /"UNEQUAL" WORD SEARCH
+ DCA XWORC
+XWOR1, JMS I GWORDI /GET POSSIBLE WORD
+ JMP XWOR3 /NUMBERS IN BUFFER
+ ISZ CRSWT /WAS IT ENDED BY A CR?
+ERCI, ERROR /YES, VELLY SOLLY!
+ JMS I SORTI /LOOK UP COMMAND: UN, ME,
+ XWORCL-1 / AB, FR, TO
+ XWOROP-XWORCL
+ERCH, ERROR /COMMAND NOT RECOGNIZED
+/
+XWOR7, TAD XWOR4+1 /"MEMREF", ONLY MEMORY-
+ DCA CNOP+1 / REFERENCE OP-CODES CAN
+ JMP XWOR1 / EVER BE OUTPUT.
+/
+XWOR3, JMS I ARGI /GET AN ARG
+ TAD ACC1 /GET THE VALUE
+ AND MASK
+ CIA
+ DCA CNT /LOOK FOR THIS WORD
+ JMS LSETUP /SET UP COUNT OF WORDS TO DO
+XWOR4, JMS I GETI /GET A WORD
+ JMP XWOR5 /FILE MODE, NO SUCH ADDRESS
+ AND MASK
+ TAD CNT
+XWORC, HLT /WILL BE "SZA CLA" OR "SNA CLA"
+ JMP XWOR5 /DID NOT MATCH
+ JMS OPRTST /TEST FOR OP-CODES 6 & 7
+CNOP, NOP / 7--OPR
+ NOP / 6--IOT;"NOP" OR "JMP XWOR5"
+ JMS ABKLOC /DID MATCH, OUTPUT LOC
+ JMS I GETI /GET THAT WORD
+ JMP ERCP / OH I HOPE NOT!!!
+ JMS I OCTI /AND OUTPUT IT IN OCTAL
+ JMS I CRLFI
+XWOR5, JMS LCHEK /DONE YET?
+ JMP XWOR4 /NO
+
+/SUBROUTINE TO INITIALIZE THE SEARCH COMMANDS
+SSET, 0
+ DCA ABSSW /RESET ABSOLUTE SWITCH
+ TAD LBLK /SET UP START BLK & LOC
+ DCA BLK
+ TAD LLOCH
+ DCA LOCH
+ TAD LLOCL
+ DCA LOCL
+ TAD UBLK /SET UP END BLK & LOC
+ DCA EBLK
+ TAD ULOCH
+ DCA ELOCH
+ TAD ULOCL
+ DCA ELOCL
+ JMP I SSET
+
+/COMMON OPTIONS FOR 'WORD' AND 'STRING' SEARCHES
+
+XWSABS, STA
+ DCA ABSSW /'ABSOLUTE'--SET SWITCH
+ JMP XWSRET
+/
+XWSFRM, JMS I LIMITI /'FROM'--GET LOWER LIMITS
+ BLK
+ JMP XWSRET
+/
+XWSTO, TAD UBLK /'TO'--SET UP IF NEEDED
+ DCA EBLK
+ JMS I LIMITI / & GET UPPER LIMITS
+ EBLK
+XWSRET, STA CLL RAL /= -2, CALCULATE RETURN ADDRESS AS
+ TAD I GWORDI / LAST CALL TO "GWORD" TO ALLOW
+ DCA LCHEK / THESE TO BE COMMON TO BOTH
+ JMP I LCHEK / 'WORD' AND 'STRING' SEARCHES.
+EBLK, 0
+ELOCH, 0
+ELOCL, 0
+
+
+LSETUP, 0 /SET SEARCH WORD-COUNTERS **** SEE NOTE ****
+ DCA ACC1 /INITIALIZE THESE TO 0
+ DCA ACC2
+ TAD MODSW /IN A MAPPED MODE?
+ SMA SZA CLA
+ JMP LSETL / YES, IGNORE BLOCK PARTS
+ TAD BLK / NO, SET UP FOR 24 BIT
+ DCA ACC1
+ TAD EBLK / BLK-EBLK
+ DCA OPER1
+ DCA OPER2
+ JMS DSUB /DO THE SUBTRACTION
+ TAD (400 /NOW SET UP MULTIPLY BY 400
+ DCA OPER1
+ DCA OPER2
+ JMS DMUL /GIVES: (BLK-EBLK)*400
+LSETL, CLL IAC
+ TAD ELOCL
+ DCA OPER1 /NOW SET UP ELOC+1
+ RAL
+ TAD ELOCH
+ DCA OPER2
+ JMS DSUB /AND SUBTRACT IT
+ TAD LOCL /NOW ADD LOC TO GIVE:
+ DCA OPER1 / (BLK-EBLK)*400+(LOC-ELOC-1)
+ TAD LOCH / WHICH IS 24-BIT COUNT OF
+ DCA OPER2 / WORDS TO SEARCH.
+ JMS DADD
+ TAD ACC2 /IF NOT NEGATIVE, ALREADY TOO
+ SMA CLA
+ JMP I RECRLF / FAR, SO JUST QUIT NOW!
+ JMP I LSETUP
+
+/**** NOTE: COUNT LEFT SET UP IN ACC1 & ACC2 ****
+
+LCHEK, 0 /CHECK IF SEARCH RANGE EXHAUSTED
+ JMS I INCI /INCREMENT LOC
+ ISZ ACC1 /COUNT WORDS TO DO
+ JMP I LCHEK
+ ISZ ACC2 / (24-BIT)
+ JMP I LCHEK
+ JMP I RECRLF /DO CR/LF & STOP!
+
+
+TIDPNT, 0 /"TAD I DPNT" IN FIELD 1
+ CDF 10
+ TAD I DPNT
+ CDF 0
+ JMP I TIDPNT
+
+
+ASCII, 0 /ASCII OUTPUT FORMAT FROM DEVICE
+ AND N177 /MAKE CHARS INTO "STANDARD"
+ TAD N200 / FORM: 7 BITS + PARITY ON
+ JMS I TYPEI / TO CAUSE CORRECT PRINTING
+ JMP I ASCII
+
+
+PAGE
+\f/ROUTINE TO 'REWIND' THE DEVICE
+XREWIN, CDF 10
+ TAD USRAD /RESET DIRECTORY SEGMENT KEY
+ SMA CLA
+ DCA I N7 / IN USR IF IT IS IN MEMORY.
+ CDF 0
+ JMS I DEVAD /CALL HANDLER
+ 0110 /READ, 1 PAGE, FIELD 1
+ PDLB /DUMMY BUFFER (ZAP P.D.L.)
+ 1 /BLK 1
+ JMP RERROR /READ ERROR!
+ JMP I RESTAR
+
+/READ ERROR--TEST TYPE & OUTPUT MESSAGE
+
+RERROR, SPA CLA /BIT 0 = 1 IF FATAL
+ERC00, ERROR /FATAL
+ERC01, ERROR /NON-FATAL
+
+
+/ROUTINE TO EXECUTE THE 'STRING' SEARCH COMMAND
+XSTRIN, JMS SSET /INITIALIZE
+ TAD (STJMP-STCDF /RESET MASKING SWITCH
+XSTR0, TAD XREWIN / OR SET MASKING SWITCH
+ DCA SMSKSW
+ JMS I GWORDI /GET POSSIBLE WORD
+ JMP XSTR1 /NUMBERS ONLY
+ ISZ CRSWT /FOLLOWED BY A CR?
+ JMP ERCI / YES, KICK OUT*****
+ JMS I SORTI /LOOK UP OPTION: MA,
+ STRLST-1 / AB, FR, TO
+ STROPS-STRLST
+ JMP ERCH /NO LIKEE!
+/
+XSTR1, JMS I GARGI /GET ARGS - THEN REPACK INTO BUFFER
+ TAD TEMP / MASKING THEM IF SPECIFIED
+ DCA CNTR /SET UP LENGTH
+ TAD TEMPST
+ DCA SCANX2 /STORING DONE IN NEG. FORM
+ JMP XSTR2+2 /GO SET UP MASK
+/
+XSTR2, ISZ TEMP3 /MASK END?
+ JMP XSTR3
+ TAD MASKBS /YES, RESET MASK
+ DCA SPNT
+ TAD SMASKL /SET UP LENGTH
+ DCA TEMP3
+XSTR3, ISZ DPNT /SKIP 2 EXTRA WORDS
+ ISZ DPNT
+ TAD I DPNT /GET A WORD
+ JMS STRMSK /TEST & MASK
+ CIA /NEGATE
+ DCA I SCANX2 /STORE
+ ISZ DPNT /BUMP POINTER
+ ISZ CNTR /DONE?
+ JMP XSTR2
+ JMS LSETUP /YES, SET UP COUNT OF WORDS
+XSTR4, TAD TEMPST /SET UP FOR SEARCH:
+ DCA DPNT / STRING,
+ TAD TEMP
+ DCA CNTR / & STRING LENGTH.
+ TAD LOCL
+ DCA XLOCL /SAVE CURRENT LOCATION
+ TAD LOCH
+ DCA XLOCH
+ TAD BLK
+ DCA XBLK
+ TAD ACC1 / & COUNT FOR RESET
+ DCA OPER1
+ TAD ACC2
+ DCA OPER2
+ JMP XSTR6 /NOW SET UP MASK
+/
+XSTR5, JMS LCHEK /DONE?
+ ISZ TEMP3 /NO, AT MASK END?
+ JMP XSTR7
+XSTR6, TAD MASKBS / YES, RESET MASK
+ DCA SPNT
+ TAD SMASKL
+ DCA TEMP3
+XSTR7, JMS I GETI /GET NEXT WORD
+ JMP XSTR10 /MAPPED MODE, NO SUCH ADDRESS
+ JMS STRMSK /TEST & MASK
+ TAD I DPNT /COMPARE?
+ SZA CLA
+ JMP XSTR10 /NO, GO RESET & CONTINUE
+ ISZ CNTR /MATCHED ENOUGH?
+ JMP XSTR5 /NOT YET
+ JMS XRSET /YES, RESET LOCATION & COUNT
+ TAD TEMP /AND LENGTH
+ DCA CNTR
+XSTR8, TAD M10
+ DCA ACCX1 / -(#/LINE)
+ JMS ABKLOC /OUTPUT THIS LOCATION
+XSTR9, JMS I GETI /GET A WORD
+ JMP ERCP /BAD,BAD,BAD!!!
+ JMS I OCTI /AND OUTPUT IN OCTAL
+ JMS I INCI /INCREMENT LOC
+ ISZ CNTR /DONE?
+ JMP XSTR11 /NO, CONTINUE
+ JMS I CRLFI /YES, OUTPUT CR/LF
+XSTR10, JMS XRSET /RESET LOCATION & COUNT
+ JMS LCHEK /DONE?
+ JMP XSTR4 /NO, LOC INC'D, TRY NEXT
+/
+XSTR11, SPACE2 /OUTPUT " "
+ ISZ ACCX1 /DONE ON THIS LINE?
+ JMP XSTR9 /NO, NOT YET
+ JMS I CRLFI /YES
+ JMP XSTR8
+
+XRSET, 0 /RESET BLK & LOC FROM XBLK & XLOC
+ TAD XLOCL /LOC
+ DCA LOCL
+ TAD XLOCH
+ DCA LOCH
+ TAD XBLK /BLK
+ DCA BLK
+ TAD OPER1 /WORDS LEFT TO SEARCH
+ DCA ACC1
+ TAD OPER2
+ DCA ACC2
+ JMP I XRSET
+
+STRMSK, 0 /STRING MASKING *** NEXT WORD MODIFIED ***
+SMSKSW, CDF 10 /"CDF 10" OR "JMP I STRMSK"
+ AND I SPNT /OK, MASK IN FIELD 1
+ CDF 0
+ JMP I STRMSK
+STJMP= JMP I STRMSK
+STCDF= CDF 10
+
+XBLK, 0
+XLOCH, 0
+XLOCL, 0
+
+
+PAGE
+\f/ROUTINE TO EXECUTE THE BLOCK 'WRITE' COMMAND
+XWRARG, JMS I ARGI /GET ONE ARG
+ TAD ACC1 /USE IT AS THE BLOCK
+ SKP
+XWRITE, TAD WBLK /SET BLOCK
+ DCA XWBLK
+ JMS I DEVAD /CALL HANDLER
+ 4210 /WRITE, 2 PAGES, FIELD 1
+ IOBUF
+XWBLK, 0 /[** COUNTER FOR MODIFY **]
+ JMP WERROR /WRITE ERROR
+ DCA MODIF /CLEAR SOMETHING-CHANGED FLAG
+ JMP I RESTAR
+
+/WRITE ERROR--TEST TYPE & OUTPUT MESSAGE
+
+WERROR, SPA CLA /BIT 0 = 1 IF FATAL
+ERC02, ERROR /FATAL
+ERC03, ERROR /NON-FATAL
+
+
+/ROUTINE TO EXECUTE THE 'MODIFY' COMMAND
+XMODIF, JMS I GWORDI /GET FORMAT WORD IF ONE
+ JMP XMODEF /NONE, GET DEFAULT
+ DCA MODTMP /SAVE FOR LATER
+ ISZ CRSWT /TERMINATED BY A CR?
+ JMP ERCO / YES, SAVE USER FROM HIMSELF!
+ TAD MODTMP /TEST FORMAT FOR RECOGNITION
+ JMS I SORTI
+ MODIFL-1
+ MODADS-MODIFL
+ERCO, ERROR / I THEENK YOU USE BAD WORD!
+/
+/NO FORMAT DESCRIPTOR GIVEN, USE DEFAULT
+XMODEF, TAD FCNT /USE CURRENT FORMAT,
+ TAD (MODDLS-1 / WITH A LITTLE DIFFERENCE
+ DCA DPNT
+ TADIDP /GET THE ONE TO USE
+ DCA MODTMP / AND SAVE IT
+/
+XMOD0, JMS I GARGI /OK, NOW GET ARGS
+ TAD TEMP /MOVE COUNT TO A SAFE PLACE
+ DCA XWBLK
+XMOD1, TAD I DPNT /GET BLOCK #
+ JMS BLKTST /TEST & SET BLK
+ TAD I DPNT /GET LOC
+ DCA LOCH
+ TAD I DPNT
+ DCA LOCL
+ TAD I DPNT /GET -(# LOCS)
+ DCA CNTR
+XMOD2, TAD COMST /INIT COMM. BUFF. FOR MODS
+ DCA COMIR
+ DCA CHARSW /RESET HALF SWITCH
+ JMS I SOCTI /INITIALIZE INPUT TO OCTAL
+ JMS I BKLOCI /OUTPUT START LOC
+ BLK-1
+ JMS I TWOCI /AND ": "
+ 7240
+ READLN /GET A LINE (TEST: RUBOUT, ^U & ^R)
+ TYPEM-1 /IGNORE LF'S
+ MCHARO-TYPEM
+ JMP XMOD2 /BUFFER EMPTIED!
+
+
+/CR TYPED, END
+XMODCR, JMS I ENDCI /END BUFFER WITH A CR.
+ JMP XMOD2 /ONLY A CR IN BUFFER-RETRY!
+ TAD MODTMP /NOW LOOK UP FORMAT
+ JMS I SORTI
+ MODIFL-1
+ MODIFO-MODIFL
+ERCP, ERROR /ILLEGAL (EXTRA BAD IF HERE)
+
+XMODDN, ISZ XWBLK /RETURN HERE, ALL ARGS DONE?
+ JMP XMOD1 /NO
+ JMP I RESTAR /YES
+MODTMP, 0
+
+XGET, 0 /SUB. TO SET CURRENT LOC & FLAG
+ JMS I GETI /SET LOCATION
+ERC07, ERROR /MAPPED MODE, NO SUCH ADDRESS
+ STA
+ DCA MODIF /SET FLAG
+ JMP I XGET
+
+/NUMERIC FORMATS HERE
+XNUM0, JMS I SORTI /TEST TERMINATOR
+ GETLST-1-1 /SPACE, COMMA, CR
+ NUMOPS-GETLST+1
+ JMP ERCQ /ILLEGAL TERMIN
+/
+XNUM1, JMS I GETNI /COMMA, SKIP IT
+ JMS I SSKIPI / SPACE, IGNORE IT
+XNUM2, JMS EXPRIN /GET NEXT ARG--EXPRESSION
+ JMS XGET /SET UP LOCATION
+ TAD ACC1
+ DCAICAD / & STORE VALUE
+ JMS I INCI /INCREMENT LOCATION
+ ISZ CNTR /ALL MODS DONE?
+ JMP XNUM0 /NO, TEST TERMIN
+ JMP XMODDN /YES, TEST NEXT SET
+/
+XNUM3, TAD CNTR /DONE?
+ SNA CLA
+ JMP XMODDN /YES
+ JMS XGET /NO, SET UP LOC
+ TAD FILLER
+ DCAICAD /AND FILL WITH 'FILLER'
+ JMS I INCI /INCREMENT LOC
+ ISZ CNTR /DONE?
+ JMP XNUM3 /NO
+ JMP XMODDN /YES
+
+/ASCII FORMAT HERE
+ JMS CGET /GET A CHAR & CHECK FOR CR
+XASC1, JMS XGET /SET UP LOC & SET FLAG
+ TAD CHAR
+ DCAICAD /STORE THIS CHAR
+ JMS I INCI /INCREMENT LOC
+ ISZ CNTR /MODS DONE?
+ JMP XASC1-1 /NO
+ JMP XMODDN /YES
+
+CGET, 0 /GET NEXT CHAR. IF CR, MODS DONE
+ JMS CGTEST /GET & TEST NEXT
+ JMP XNUM3 /CR, FILL REST WITH 'FILLER'
+ JMP I CGET
+
+CGTEST, 0 /SUB. TO GET A CHAR & CHECK FOR CR
+ JMS I GETNI /GET NEXT CHARACTER
+ TAD CHAR /IS IT A CR?
+ TAD M215
+ SZA CLA
+ ISZ CGTEST /RETURN TO CALL+2 IF NOT
+ JMP I CGTEST
+
+
+DO1SP, 0 /OUTPUT " " + AC
+ JMS I TYPECI
+ "
+ JMP I DO1SP /ANOTHER TUFFIE
+
+DO2SP, 0 /OUTPUT " " + AC (PACKED ASCII)
+ JMS I TWOCI
+ 4040
+ JMP I DO2SP /FAST & SWEET!
+
+
+PAGE
+\f/ROUTINE TO EXECUTE THE 'SMASK' (STRING MASK) COMMAND
+XSMASK, JMS I GARGI /GET ARGS
+ TAD TEMP
+ DCA SMASKL /SAVE -(MASK LENGTH)
+ TAD MASKBS /SET UP TO STORE WORDS
+ DCA SPNT
+XSMAS1, ISZ DPNT /SKIP 2 WORDS
+ ISZ DPNT
+ TAD I DPNT /GET & STORE ONE
+ CDF 10
+ DCA I SPNT
+ CDF 0
+ ISZ DPNT /SKIP 1 MORE
+ ISZ TEMP /DONE ?
+ JMP XSMAS1 /NO
+ JMP I RESTAR
+
+
+/XS240 PACKED ASCII FORMAT HERE
+XXS20, TAD M240 /SET OFFSET
+/PACKED ASCII FORMAT HERE
+XPAC0, DCA PNAME /CLEAR OFFSET
+XPAC1, TAD M240 /IS CHAR < 240?
+ TAD CHAR
+ SMA CLA
+ JMP XPAC2 /NO, JUST PACK CHAR
+ CMA
+ JMS PACK /YES, PACK A FLAG (77) FIRST
+XPAC2, TAD CHAR /NOW GO PACK CHAR
+ TAD PNAME /(WITH DESIRED OFFSET)
+ JMS PACK
+ JMS CGET /NOW GET & TEST NEXT
+ JMP XPAC1 / OK, CONTINUE
+
+/OS/8 ASCII HERE
+XOPS1, TAD LOCL /TEST START & COUNT FOR EVEN
+ RAR /(LOW BIT TO LINK &
+ CLA / CLEAR AC)
+ TAD CNTR
+ RAR /(LOW TO LINK, LINK TO AC0)
+ SZL SPA CLA /BOTH L=0 & AC0=0 FOR OK
+ERC04, ERROR /START OR COUNT NOT EVEN
+XOPS2, TAD CHARSW /GET SWITCH
+ ISZ CHARSW / & BUMP IT
+ CLL RAR /ROTATE AC 11 INTO LINK
+ SZL SNA CLA /CHARACTER 3?
+ JMP XOPS5 /NO, CHAR 1 OR CHAR 2
+ STA
+ TAD CAD /YES, BACK UP POINTER
+ DCA CAD
+ STA CLL RAL / & SET LOOP COUNT TO -2
+ DCA CHARSW
+XOPS3, TAD CHAR /GET REST OF CHAR
+ CLL RTL /4 BITS LEFT
+ RTL
+ DCA CHAR /SAVE IT
+ TAD CHAR /NOW MERGE 4 BITS WITH
+ AND N7400 / A PREVIOUS CHAR
+ TADICAD
+ DCAICAD /4 BITS OF 3RD + 1ST OR 2ND
+ ISZ CAD /BUMP POINTER
+ ISZ CHARSW /DONE?
+ JMP XOPS3
+ TAD CNTR /YES, DONE ALL MODS?
+ SNA CLA
+ JMP XMODDN /YES, TEST FOR DONE
+XOPS4, JMS CGET /GET & TEST NEXT CHAR
+ JMP XOPS2 /OK, DO NEXT
+/
+XOPS5, JMS XGET /SET UP CURRENT LOC
+ TAD CHAR
+ DCAICAD /AND STORE CHARACTER
+ JMS I INCI /INCREMENT LOC
+ ISZ CNTR /BUMP COUNTER FOR LATER
+ JMP XOPS4 / SO IGNORE SKIP NOW
+ JMP XOPS4
+
+PACK, 0 /SUB. TO PACK CHARACTERS
+ AND N77 /USE ONLY 6 BITS
+ ISZ CHARSW /CHECK HALF
+ JMP PACK1
+ TADICAD /RIGHT HALF, ADD TO LEFT
+ DCAICAD
+ TAD CNTR /ALL MODS DONE?
+ SZA CLA
+ JMP I PACK /NO
+ JMP XMODDN /YES
+/
+PACK1, JMS I RTL6I /LEFT HALF, ROTATE INTO IT
+ DCA CHARSW /SAVE IT
+ JMS XGET /SET UP CURRENT LOC
+ TAD CHARSW
+ DCAICAD /STORE WORD
+ JMS I INCI /INCREMENT LOC
+ ISZ CNTR /BUMP COUNTER FOR LATER
+ NOP / SO DON'T SKIP NOW
+ STA
+ DCA CHARSW /RESET SWITCH
+ JMP I PACK
+
+
+PNAME, 0 /PRINT A FILE NAME, PADDED W. SPACES
+ TAD NAM1
+ JMS I TWOT / OUTPUT UP TO
+ TAD NAM2
+ JMS I TWOT / 6 CHARACTERS
+ TAD NAM3
+ JMS I TWOT / OF FILE NAME,
+ JMS I TYPECI / A "."
+ ".
+ TAD NAM4 / & UP TO 2 CHARS
+ JMS I TWOT / OF EXTENSION.
+PNAME1, SPACE1 /OUTPUT A " "
+ TAD NCNT /11(10) CHARS ON LINE YET?
+ TAD (-13
+ SPA CLA
+ JMP PNAME1 /NO, OUTPUT ANOTHER SPACE
+ JMP I PNAME
+
+
+/SUBROUTINE TO GET A NUMERIC ARGUMENT FROM THE
+/ COMMAND BUFFER AND RETURN IT TO THE 3 WORDS
+/ POINTED TO BY CALL+1. THE FIRST WORD (BLOCK
+/ NUMBER) IS NOT CHANGED IF NO BLOCK PART WAS
+/ GIVEN IN THE COMMAND.
+
+LIMITS, 0
+ TAD I LIMITS /GET ADDRESS OF 3 WORDS
+ ISZ LIMITS
+ DCA PNAME / & SAVE IT
+ JMS I ARGI /GET COMMAND DATA
+ TAD TEMP1 /GET BLOCK NUMBER PART
+ ISZ TEMP1 /WAS A BLOCK PART SPEC'D?
+ DCA I PNAME / YES, STORE IT
+ CLA /(CLEAR IN CASE NOT!)
+ ISZ PNAME /BUMP POINTER
+ TAD ACC2
+ AND N7
+ DCA I PNAME /STORE HIGH 3 BITS
+ ISZ PNAME
+ TAD ACC1
+ DCA I PNAME / & LOW 12 BITS OF ADDR.
+ JMP I LIMITS
+
+
+PAGE
+\f/SUBROUTINE TO 'GET' A WORD FROM THE DEVICE.
+/
+/ THE ACTUAL WORD ON THE DEVICE THAT IS ACCESSED
+/ IS DEPENDENT ON THE MODE SWITCH, AS FOLLOWS:
+/
+/ MODE ACTION
+/
+/ 0 = NORMAL THE HIGH 7 BITS OF THE 15 BIT ADDRESS
+/ ARE ADDED TO THE SPECIFIED BLOCK #
+/ TO GET THE ACTUAL BLOCK & THE LOW 8
+/ BITS OF THE 15 BIT ADDR ARE USED TO
+/ SPECIFY THE WORD WITHIN THE BLOCK.
+/
+/ -1 = OFFSET THE 12 BIT "OFFSET" (WHICH IS NEGATED)
+/ IS ADDED TO THE LOW 12 BITS OF THE
+/ ADDRESS, AND THEN THE NEW ADDRESS IS
+/ HANDLED AS ABOVE.
+/ THIS MODE IS USED PRIMARILY WHEN
+/ WORKING WITH THE OPERATING SYSTEM
+/ WITH OVERLAYS WHOSE REAL START BLOCK
+/ AND LOCATION WITHIN A FIELD ARE KNOWN.
+/ BY SETTING THE "OFFSET" TO THE START
+/ ADDRESS OF THE OVERLAY, ITS REAL
+/ ADDRESSES CAN BE USED AND THE PROPER
+/ LOCATIONS WILL BE ACCESSED.
+/
+/ +1 = SAVE THIS MODE IS USED WITH CORE IMAGE
+/ "SAVE" FILES ONLY. THE FILE'S CCB
+/ (CORE CONTROL BLOCK) IS USED TO
+/ DETERMINE THE REAL LOCATION ON THE
+/ DEVICE OF THE SPECIFIED 15 BIT ADDR-
+/ ESS. THE START BLOCK OF THE FILE
+/ IS USED, AND ANY SPECIFIED "BLOCK"
+/ PART IS USED TO SPECIFY THE OVERLAY
+/ WANTED AT THAT ADDRESS. FOR FILES
+/ WITHOUT OVERLAYS (GENERATED BY THE
+/ MONITOR "SAVE" COMMAND), THIS PART
+/ MUST BE ZERO (0) OR NO MATCH WILL
+/ OCCUR. FOR FILES WITH OVERLAYS
+/ (GENERATED BY THE PROGRAM "LINK"),
+/ A LEGAL OVERLAY AT THE SPECIFIED
+/ ADDRESS MUST BE SPECIFIED FOR A
+/ MATCH TO OCCUR. THIS MODE CAN ONLY
+/ BE USED AFTER A "FILE" COMMAND.
+/
+/ +2 = LOAD THIS MODE IS USED WITH OS/8 FORTRAN
+/ IV LOAD MODULES. THE FILE'S HEADER
+/ BLOCK IS USED TO DETERMINE THE REAL
+/ LOCATION ON THE DEVICE OF THE SPECI-
+/ FIED 15 BIT ADDRESS AND THE "BLOCK"
+/ PART IS USED TO SPECIFY THE OVERLAY
+/ WANTED AT THAT ADDRESS. THIS MODE CAN
+/ ONLY BE USED AFTER A "FILE" COMMAND.
+
+
+/CALLING SEQUENCE:
+/
+/ JMS I GETI
+/ RETURN1 /MODE=MAPPED, NO SUCH ADDRESS
+/ NORMAL RETURN /'CAD' SET, DATA IN AC
+\f/SUBROUTINE 'GET'--PART OF THIS PAGE & ALL OF NEXT
+
+GET, 0
+ JMS I CTRLI /GO TEST FOR CONTROL-CHARS
+ TAD MODSW /OK, TEST MODE
+ SNA
+ JMP GET0 /NORMAL MODE, NO CHANGES
+ SMA CLA
+ JMP GET4 /SAVE MODE, DO MAPPING
+ TAD OFFSET /OFFSET MODE, ADD IT
+GET0, JMS DBLPGS /NOW ADD 'DOUBLE PAGES'
+ TAD BLK / OF LOC TO BLK TO SET
+ DCA CBLK /'CURRENT BLOCK'
+GET1, JMS GETIO /OUTPUT CURREN (IF NEEDED), GET NEXT
+ JMP RERROR / READ ERROR, GO TELL ABOUT IT
+ TAD MODSW /TEST AGAIN FOR OFFSET
+ SPA CLA
+ TAD OFFSET /YES, ADD IT AGAIN
+ TAD LOCL /USE 8 ADDRESS BITS FROM LOC
+ AND N377
+ TAD BUFST /INTO BUFFER, TO SET
+ DCA CAD /'CURRENT ADDRESS'
+ TADICAD /NOW GET THE WORD
+ ISZ GET /RETURN TO CALL+2 WITH IT
+GETX, JMP I GET /[EXIT TO CALL+1 FOR MAP FAIL]
+
+GETIO, 0 /DO I/O FOR 'GET' & 'SCANER'
+ TAD CBLK /IS THIS SAME BLOCK AS IS IN
+ CIA /CORE CURRENTLY?
+ TAD RBLK
+ SNA CLA
+ JMP GETIO2 /YES, USE IT.
+ ISZ MODIF /NO, ANY CHANGES IN THIS BLK?
+ JMP GETIO1 /NO, DEVICE OK AS IS
+ JMS I DEVAD /CALL DEVICE HANDLER
+ 4210 /WRITE, 2 PAGES, FIELD 1
+BUFST, IOBUF
+WBLK, 0
+ JMP WERROR /WRITE ERROR
+GETIO1, TAD CBLK /NOW UPDATE OUTPUT BLOCK
+ DCA WBLK
+ TAD CBLK / AND INPUT BLOCK #
+ DCA RBLK
+ DCA MODIF / AND RESET SWITCH
+ TAD CBLK /SHOW BLOCK NUMBER IN LIGHTS
+ MQL / (IF THERE ARE ANY!)
+ CLA
+ JMS I DEVAD /CALL DEVICE HANDLER
+ 0210 /READ, 2 PAGES, FIELD 1
+ IOBUF
+RBLK, -1 /(NOTHING IN CORE-ILLEGAL BLK #)
+ JMP I GETIO /READ ERROR
+GETIO2, ISZ GETIO /OK, DO NORMAL RETURN
+ JMP I GETIO
+
+
+DBLPGS, 0 /CONVERT LOCATION TO DOUBLE-PAGES
+ TAD LOCL
+ AND M400 /HIGH 4 BITS HERE
+ CLL RAL /BECOME LOW 4 BITS
+ TAD LOCH /FOR A 7 BIT VALUE
+ RTL
+ RTL
+ JMP I DBLPGS
+
+
+/GET WORD ROUTINE FOR "ODT" COMMANDS
+
+ODGET, 0
+ TAD SBLK /SET UP BLOCK
+ DCA BLK
+ TAD SLOCH
+ DCA LOCH
+ TAD SLOCL
+ DCA LOCL /SET UP LOCATION
+ JMS I GETI /NOW GET WORD
+ERC05, ERROR /MAPPED MODE, NO SUCH ADDRESS
+ JMP I ODGET / & RETURN WITH IT
+
+
+/OUTPUT 12 BIT BLOCK # & 15 BIT ADDRESS IN OCTAL
+
+BKLOC, 0
+ TAD I BKLOC /GET ARGUMENT (ADDR-1)
+ ISZ BKLOC
+ DCA GETPNT / & SET UP A-XR
+ TAD I GETPNT /GET BLOCK PART
+ JMS I OCTI / & OUTPUT IT
+ TAD I GETPNT /GET FIELD
+ AND N7
+ JMS I TWOCI / & OUTPUT "." & IT
+ 5660 / (".0")
+ TAD I GETPNT /GET ADDRESS
+ JMS I OCTI / & OUTPUT IT
+ JMP I BKLOC
+
+
+/SUBROUTINE TO GET A COMMAND WORD OR CHARACTER
+/FROM THE COMMAND BUFFER. IF THE BUFFER CONTAINS
+/ONLY NUMERIC ITEMS, RETURN TO CALL+1. TERMINATOR
+/IS SPACE OR CR
+GWORD, 0
+ JMS I SSKIPI /GET NEXT NON-SPACE
+ TAD CHAR
+ AND N77 /USE THIS CHAR AS LEFT
+ JMS I RTL6I / 6 BITS.
+ DCA CHARSW /SAVE IT
+ JMS I SORTI /CHECK FOR ^K, ^D, (, ", ',
+ GWLST1-1 / DIGITS, SPACE & CR
+ GWOPS1-GWLST1
+ JMS I GETNI /NONE, IS NEXT A SPACE
+ JMS I SORTI / OR A C.R.?
+ GWLST2-1
+ GWOPS2-GWLST2
+ TAD CHAR /NONE, USE AS LOWER 6 BITS
+ AND N77
+ TAD CHARSW
+ DCA CHARSW /SAVE IT
+GWD1, JMS I GETNI /LOOK FOR SPACE OR C.R.
+ JMS I SORTI
+ GWLST2-1
+ GWOPS2-GWLST2
+ JMP GWD1 /NEITHER, KEEP LOOKING
+/
+GWD2, STA /SPACE FOUND, SET SWITCH
+GWD3, DCA CRSWT /CR FOUND, RESET SWITCH
+ TAD CHARSW /RETURN WITH WORD
+ ISZ GWORD / TO CALL+2
+GWD4, JMP I GWORD
+/EXIT TO CALL+1 IF ANY NUMERIC ITEM FOUND--
+/ ^K, ^D, (, ", ', DIGITS
+
+
+/"DIRECTORY" FORMAT OUTPUT ROUTINE
+DIRDMP, 0
+ JMS I OCTI /OUTPUT IN OCTAL FIRST
+ SPACE2
+ TADICAD
+ JMS DIROUT / THEN 3 OTHERS
+ JMP I DIRDMP
+
+/"?" ODT OUTPUT ROUTINE
+DIROUT, 0
+ CIA /ASSUME WAS NEGATIVE
+ JMS I DECI / & OUTPUT IN DECIMAL
+ SPACE2
+ TADICAD
+ JMS I PDATEI /OUTPUT AGAIN AS DATE
+ SPACE2
+ TADICAD
+ JMS I TWOT /OUTPUT LAST TIME AS PACKED ASCII
+ JMP I DIROUT
+
+
+PAGE
+\f/CONTINUATION OF 'GET' -- MAPPING FOR "SAVE" AND "LOAD"
+/ MODES DONE HERE.
+
+GET4, JMS DBLPGS /GET # DOUBLE-PAGES
+ DCA CAD / & SAVE IT
+ STA
+ TAD MODSW /TEST FOR SAVE OR LOAD MODE
+ SZA CLA
+ JMP GETL1 / LOAD MODE
+ CDF CIF 10
+ JMS GCCB /SAVE MODE, GET CCB
+ DCA SEGCNT / & SET UP # SEGMENTS
+ TAD RBLK1 /SET UP ACTUAL FIRST BLOCK
+ IAC
+ DCA CBLK / FOR MAPPING.
+GETS1, CDF 10
+ TAD I GETPNT /GET AN ORIGIN WORD
+ DCA GETORG
+ TAD I GETPNT / & A CONTROL WORD.
+ CDF 0
+ DCA GETCW
+ TAD GETCW /TEST FOR FIELD MATCH
+ CLL RTR
+ RAR
+ AND N7 /(MASK OFF COUNT)
+ CIA
+ TAD LOCH /SAME?
+ SZA CLA
+ JMP GETS2 /NO, TRY NEXT SEGMENT
+ TAD LOCL /YES, NOW TEST ADDRESSES
+ AND M200 /(MASK TO PAGE)
+ STL CIA
+ TAD GETORG /[ORIG PAGE]-[ADDR PAGE]
+ SZA SNL /ABOVE THE ORIGIN?
+ JMP GETS2 /NO, TRY NEXT
+ RAR /OK, DIVIDE BY 2 (WITH SIGN)
+ DCA GETORG / & SAVE IT.
+ TAD GETCW /BEYOND TOP OF SEGMENT?
+ AND M100 /(MASK OFF FIELD AND MAKE)
+ SNA
+ STL RAR / 0 => 40, THEN SUBTRACT
+ TAD M100 / ONE PAGE)
+ TAD GETORG
+ SPA CLA
+ JMP GETS2 /NO, TRY NEXT
+ TAD GETORG /YES, UPDATE CBLK TO RIGHT
+ CIA
+ JMS UPCBLK / ACTUAL BLOCK
+ TAD BLK /MUST BE IN "LVL 0" OR
+ SZA CLA
+ JMP GETX / RETURN AS BAD
+ JMP GET1 /NOW GO GET THE DATA
+/
+GETS2, CLA
+ TAD GETCW /UPDATE CBLK
+ AND M100
+ SNA
+ STL RAR /(MAKING 0 => 40)
+ TAD (100 /(ROUND UP PAGE COUNT)
+ JMS UPCBLK
+ ISZ SEGCNT /ALL SEGMENTS DONE?
+ JMP GETS1 /NO, TRY NEXT
+ TAD OVLFLG /YES, OVERLAYS? (LINK OUTPUT)
+ SNA
+ JMP GETX / NO, RETURN TO CALL+1
+ TAD (4 / YES, RESET POINTER
+ DCA GETPNT / TO SKIP OVER LVL 0
+ JMP GETL2 / & CONTINUE
+/
+GETL1, CDF CIF 10
+ JMS GHDR /GET & TEST HEADER
+GETL2, CDF 10
+ TAD I GETPNT /GET NUMBER OF OVERLAYS
+ DCA SEGCNT
+ TAD I GETPNT /GET PAGE & FIELD
+ DCA GETCW
+ TAD I GETPNT /GET REL BLK NUMBER
+ TAD RBLK1 / + START BLOCK
+ DCA CBLK / = ABS START BLK, THIS LEVEL
+ TAD I GETPNT /GET LENGTH, THESE OVERLAYS
+ CDF 0
+ DCA GETORG
+ TAD GETCW /GET DBL-PAGE & FIELD
+ SNA
+ JMP GETX / 0 = THE END!!!
+ AND M400 /CONVERT TO DBL-PAGE #
+ CLL RTL
+ RTL
+ TAD GETCW / IN BITS 5-11
+ RAL
+ AND N177
+ CIA /-(DBL-PG # OF OVLY START)
+ TAD CAD /+(DBL-PG # OF DESIRED)
+ SPA
+ JMP GETL3 / GONE TOO FAR, MISSED IT!
+ DCA GETCW /= RELATIVE BLOCK NUMBER
+ TAD GETCW /IS THIS WITHIN THIS OVLY?
+ CIA
+ TAD GETORG
+ SPA SNA CLA
+ JMP GETL2 / NO, TRY NEXT OVERLAY
+ TAD BLK /OK, SET UP -(#LVL +1)
+ CMA
+ DCA GETORG
+ TAD GETORG /ADDR IS OK, IS THERE A
+ TAD SEGCNT / LEVEL WANTED?
+GETL3, SPA CLA
+ JMP GETX /ILLEGAL LEVEL; TOO FAR--EXIT
+ TAD GETCW /ALL OK! ADD RELATIVE BLK
+ SKP
+GETL4, TAD SEGCNT / TO (LVLS-1)*LENGTH
+ TAD CBLK
+ DCA CBLK / TO OVERLAY START BLOCK
+ ISZ GETORG /[MULTIPLY BY ADDING]
+ JMP GETL4
+ JMP GET1
+GETORG, 0
+GETCW, 0
+SEGCNT, 0
+
+UPCBLK, 0
+ JMS I RTR6I /MOVE COUNT TO BITS 6-11
+ CLL RAR /DIVIDE FOR DOUBLE PAGES
+ TAD CBLK /UPDATE
+ DCA CBLK
+ JMP I UPCBLK
+
+
+
+PAGE
+\f/NUMERIC OUTPUT SUBROUTINES, NO ZERO SUPPRESSION:
+
+OPRT, 0 /4-DIGIT OCTAL
+ JMS NUMOUT
+ -1000
+ -100
+ -10
+ 0
+ JMP I OPRT
+
+OCT3, 0 /3-DIGIT OCTAL
+ JMS NUMOUT
+ -100
+ -10
+ 0
+ JMP I OCT3
+
+BPRT, 0 /3-DIGIT BCD
+ JMS NUMOUT
+ -400
+ -20
+ 0
+ JMP I BPRT
+
+
+SGNDP, 0 /4-DIGIT DECIMAL, SIGNED
+ DCA NUMB
+ TAD NUMB
+ SPA CLA
+ TAD N15
+ SPACE1 /OUTPUT "-" OR " "
+ TAD NUMB /NOW OUTPUT IN DECIMAL
+ SPA
+ CIA
+ JMS DPRT
+ JMP I SGNDP
+
+DECIMAL
+
+DPRT, 0 /4-DIGIT DECIMAL, UNSIGNED
+ JMS NUMOUT
+ -1000
+ -100
+ -10
+ 0
+ JMP I DPRT
+
+DEC2, 0 /2-DIGIT DECIMAL, UNSIGNED
+ AND N177 /MASK IT FIRST
+ JMS NUMOUT
+ -10
+ 0
+ JMP I DEC2
+
+OCTAL
+
+NUMOUT, 0 /THE REAL OUTPUT SUBROUTINE
+ DCA NUMB /SAVE THE NUMBER
+NUMO1, DCA NUMDGT /RESET "DIGIT" TO 0
+ CLA CLL
+ TAD NUMB /GET CURRENT VALUE
+ TAD I NUMOUT /SUBTRACT DIGIT BASE
+ SNL /DID IT OVERFLOW?
+ JMP NUMO2 /NO, TOO FAR!
+ ISZ NUMDGT /YES, BUMP DIGIT
+ DCA NUMB / & UPDATE VALUE
+ JMP NUMO1+1
+/
+NUMO2, CLA CLL
+ TAD NUMDGT /OUTPUT THE "DIGIT"
+ DIGIT
+ ISZ NUMOUT /BUMP TO NEXT ARG
+ TAD I NUMOUT /DONE ENOUGH?
+ SZA CLA
+ JMP NUMO1
+ TAD NUMB /YES, SO OUTPUT THE LAST
+ DIGIT / ONE.
+ JMP I NUMOUT /AND RETURN
+NUMB, 0
+NUMDGT, 0
+
+SSKIP, 0 /SKIP SPACES IN COMMAND BUFFER.
+ TAD CHAR
+ TAD M240 /IS THIS A SPACE?
+ SZA CLA
+ JMP I SSKIP /NO, DONE
+ JMS I GETNI /YES, GET NEXT CHAR
+ JMP SSKIP+1 / & GO TRY IT
+
+
+/OS/8 ASCII OUTPUT SUBROUTINE. OUTPUTS 1 CHAR
+/ FOR EVEN WORD & 2 CHARS FOR ODD WORD.
+
+OSTYPE, 0
+ JMS OSSET /DO SETUP FOR UNPACKING
+ JMS I (ASCII /OUTPUT CHARS TO "STANDARD"
+ ISZ CHARSW /UNPACK 2ND CHARACTER?
+ JMP OSUNPK / YES, & RETURN TO OSSET CALL!
+ JMP I OSTYPE /DONE, RETURN TO CALLER
+
+
+/OS/8 "BYTE" OUTPUT SUBROUTINE. OUTPUT ONE
+/ 8-BIT OCTAL NUMBER FOR EVEN WORD AND TWO 8-
+/ BIT OCTAL NUMBERS FOR ODD WORD. USED FOR
+/ DUMPING OS/8 ".BN" FILES OR ASCII IN OCTAL.
+
+BYTEO, 0
+ JMS OSSET /DO SETUP FOR UNPACKING
+ JMS OCT3 /3 DIGIT OCTAL OUTPUT
+ ISZ CHARSW /UNPACK 2ND "CHAR"?
+ SKP
+ JMP I BYTEO / DONE, RETURN
+ SPACE2 /YES, BUT OUTPUT 2 SPACES
+ JMP OSUNPK / BEFORE DOING UNPACKING
+
+
+/OS/8 FORMAT UNPACKING ROUTINES FOR 'OSTYPE' AND
+/ 'BYTEO'. THE SUBROUTINE SETS UP THE COUNTER
+/ FOR NUMBER OF OUTPUTS TO DO, SAVING & RESTORING
+/ THE AC. THE ROUTINE WILL BE CALLED ONLY IF 2
+/ OUTPUTS BEING DONE AND DOES THE UNPACK OF THE
+/ 2ND "CHARACTER", RETURNING TO THE CALLER OF THE
+/ SUBROUTINE!
+
+OSSET, 0 /ENTER HERE TO INITIALIZE
+ DCA INC /SAVE AC
+ IAC
+ AND LOCL /AC = 0 OR 1
+ CMA /AC = -1 OR -2 (-# TO DO)
+ DCA CHARSW /SET UP UNPACK COUNT
+OSRETN, TAD INC /GET VALUE TO AC
+ AND N377 /MASK TO 8 BITS
+ JMP I OSSET
+/
+OSUNPK, STA /JUMP HERE IF 2ND CHAR TO GET
+ TAD CAD
+ DCA SGNDP /POINT TO HIGH WORD
+ CDF 10
+ TAD I CAD /GET LOW BITS OF "CHAR"
+ AND N7400 / MASK TO 4 BITS AND
+ JMS I RTR6I / MOVE TO BITS 8-11
+ RTR
+ DCA INC /SAVING IT HERE FOR LATER!
+ TAD I SGNDP /NOW GET HIGH BITS OF "CHAR"
+ AND N7400 / MASK TO 4 BITS AND
+ CDF 0
+ CLL RTR / MOVE TO BITS 4-7
+ RTR
+ JMP OSRETN /GET OTHER BITS & RETURN!
+
+
+/SUBROUTINE TO INCREMENT THE "CURRENT LOCATION"
+
+INC, 0
+ ISZ LOCL /INCREMENT LOW 12 ADDR BITS
+ JMP I INC /OK AS IS
+ CLL
+ TAD LOCH /LOW OVERFLOW, INCR. HIGH
+ TAD (7771 / 3 ADDRESS BITS (& TEST)
+ AND N7
+ DCA LOCH
+ SZL /DID HIGH OVERFLOW ALSO?
+ TAD N200 / YES, THEN BUMP BLK ALSO
+ TAD BLK
+ DCA BLK
+ JMP I INC
+
+
+PAGE
+\f/OUTPUT PACKED STRING, ADDRESS IN CALL+1,
+/ TERMINATOR IS XX00.
+TYPES, 0
+ TAD I TYPES
+ ISZ TYPES
+ JMS TYPSTR
+ JMP I TYPES
+
+/OUTPUT PACKED STRING, ADDRESS IN AC, TERMIN IS XX00
+TYPSTR, 0
+ DCA GETNT
+TTAGN, CDF 10
+ TAD I GETNT
+ CDF 0
+ ISZ GETNT
+ JMS PACOUT
+ TAD GNAME
+ AND N77
+ SNA CLA
+ JMP I TYPSTR
+ JMP TTAGN
+
+/PACKED ASCII OUTPUT ROUTINE
+PACOUT, 0
+ DCA GNAME
+ TAD GNAME /USE LEFT 6 BITS
+ JMS I RTR6I
+ JMS ONECHR
+ TAD GNAME /USE RIGHT 6 BITS
+ JMS ONECHR
+ JMP I PACOUT
+
+/OUTPUT TRIMMED OR UNTRIMMED ASCII IN THE AC
+ONECHR, 0 /NO CODE FOR CR/LF
+ AND N77
+ SNA
+ JMP I ONECHR /IGNORE "@"
+ TAD (-40
+ SMA
+ TAD M100
+ JMS I TYPECI
+ 340
+ JMP I ONECHR
+
+
+/SUBROUTINE TO MATCH CHAR AGAINST LIST1 AND JUMP
+/THROUGH LIST2 WHEN MATCH FOUND. BOTH LISTS IN
+/FIELD 1.
+
+SORTJ, 0
+ SNA
+ TAD CHAR /USE CHAR IF AC = 0
+ DCA SORTEM /ITEM TO LOOK UP
+ TAD I SORTJ
+ ISZ SORTJ /GET LIST1 ADDRESS
+ DCA SCANX1
+SORT1, CDF 10
+ TAD I SCANX1 /COMPARE WITH SORTEM
+ CDF 0
+ SNA /0 ?
+ JMP SORT2 /END OF LIST
+ CIA STL
+ TAD SORTEM
+ SZA CLA /DOES IT MATCH?
+ JMP SORT1 /NO, TRY NEXT
+ TAD SCANX1 /YES, GET ADDRESS...
+ TAD I SORTJ
+ DCA SORTJ /...OF JUMP ADDRESS
+ CDF 10
+ TAD I SORTJ
+ DCA SORTJ
+ CDF 0
+ JMP I SORTJ /GO TO ROUTINE
+SORT2, ISZ SORTJ /MATCH NOT FOUND,
+ JMP I SORTJ /EXIT TO CALL+3
+SORTEM, 0
+
+
+/SUBROUTINE TO GET A NAME FOR 'XOPEN', 'XFILE', 'XDEV' & 'XDDEV'
+
+GNAME, 0 /GET A FILE OR DEVICE NAME
+ DCA TEMP1 /SET UP "." SWITCH AND
+ TAD TEMP1 / FILE/DEVICE SWITCH
+ DCA TEMP2
+ DCA NAM1
+ DCA NAM2 /CLEAR NAME AREA
+ DCA NAM3
+ TAD (2326 / & INIT EXTENSION TO "SV"
+ DCA NAM4
+ TAD (NAM1 / & INIT POINTER FOR NAME
+ DCA TEMP
+ JMS I SSKIPI /SKIP LEADING SPACES
+ STA
+ TAD COMOUT /BACK UP THE POINTER
+ DCA COMOUT
+ JMS GPAIR /1ST & 2ND CHAR
+ JMS GPAIR /3RD & 4TH
+GETSCN, JMS GPAIR /5TH & 6TH OR 1ST & 2ND EXT.
+ JMS GETNT /SCAN FOR TERMINATOR
+ CLA
+ JMP .-2
+/
+GETCOL, TAD TEMP2 /":" SEEN, DEVICE OR FILE NAME?
+ SZA CLA
+ JMP GETNTC / FILE, JUST USE THE ":"
+ ISZ TEMP2 / DEVICE, FLAG ":" SEEN
+ JMP GETSCN+1 / AND SCAN TO TERMIN.
+/
+GETPER, ISZ TEMP1 /"." FOUND, FIRST ONE?
+ERCM, ERROR /NO, THE END...
+ DCA NAM4 /YES, RESET EXT,
+ TAD (NAM4 / SET POINTER
+ DCA TEMP
+ JMP GETSCN / & GO GET IT
+/
+GETEND, STA /TERM = SPACE, SET SWITCH
+ DCA CRSWT /TERM = CR, RESET SWITCH
+ JMP I GNAME /..DONE....
+
+GETNT, 0 /GET & TEST A CHAR
+ JMS I GETNI /GET NEXT CHAR
+ JMS I SORTI /TEST IT
+ GETLST-1
+ GETOPS-GETLST
+GETNTC, TAD CHAR /OK, USE CHAR
+ AND N77 /MASK TO 6 BITS
+ JMP I GETNT / & EXIT WITH IT
+
+GPAIR, 0 /GET RIGHT/LEFT-HALF-CHARS
+ JMS GETNT
+ JMS I RTL6I /TO LEFT HALF
+ DCA I TEMP / & STORE IT
+ JMS GETNT
+ TAD I TEMP /MERGE WITH LAST LEFT
+ DCA I TEMP
+ ISZ TEMP /BUMP POINTER
+ JMP I GPAIR
+
+RTL6, 0 /ROTATE AC 6 LEFT
+ CLL RTL
+ RTL
+ RTL
+ JMP I RTL6
+
+RTR6, 0 /ROTATE AC 6 RIGHT
+ CLL RTR
+ RTR
+ RTR
+ JMP I RTR6
+
+
+PAGE
+\f/SUBROUTINE TO READ A "LINE" FROM THE USER. IT CHECKS FOR
+/ RUBOUT, ^U AND ^R FIRST, THEN CHECKS FOR ONE OF A LIST OF
+/ TERMINATORS PASSED BY THE CALLER. AS WITH OS/8, RUBOUT
+/ DELETES CHARACTES AND ^U DELETES THE CURRENT LINE. ^R
+/ (FOR RETYPE) ECHOES THE CURRENT COMMAND BUFFER IN THE SAME
+/ MANNER AS LINE-FEED DOES FOR OS/8. IF THE CHARACTER IS A
+/ TERMINATOR, CONTROL PASSES DIRECTLY TO THE CORRESPONDING
+/ CALLER ROUTINE (OUT OF THIS ROUTINE). INPUT CHARACTERS
+/ ARE ALSO TRANSLATED FROM LOWER CASE TO UPPER CASE. EXIT
+/ IN THE NORMAL MANNER OCCURS ONLY ON BUFFER EMPTY FROM
+/ RUBOUT OR ^U.
+
+READ, 0 /READ AND ECHO INPUT CHARACTER
+ TAD I READ /GET TWO LIST ADDRESS PARAMETERS
+ ISZ READ
+ DCA RETERM / FROM CALLER AND SET UP IN
+ TAD I READ / SORT ROUTINE CALL
+ ISZ READ
+ DCA RETERM+1
+RENEXT, JMS RKEY /GET A CHAR
+ JMP RUBO /RUBOUT, GO BEGIN DELETIONS
+REKEY, DCA CHAR
+ JMS I SORTI /CHECK FOR CTRL-R & CTRL-U
+ REACTL-1
+ REACTS-REACTL
+ TAD CHAR
+ JMS I TYPEI
+ JMS I SORTI /CHECK FOR CALLER TERMINATORS
+RETERM, 0 / PARAMETERS HERE
+ 0
+ TAD CHAR /NONE, JUST STORE IN BUFFER
+ SKP
+RESPC, TAD (" /FOR CAMMAND INPUT, TAB -> SPACE!
+ CDF 10
+ DCA I COMIR /COMMAND (LINE) INPUT BUFFER
+ CDF 0
+ JMP RENEXT
+/
+/+++ FOR SCOPE OPERATION, RUBOUTS CAUSE OUTPUT OF THE
+/+++ SEQUENCE BACKSPACE, SPACE, BACKSPACE TO CLEAR THE
+/+++ PREVIOUS CHARACTER FROM THE SCREEN. IF "SCOPE
+/+++ MODE" IS SET, RUBO IS OVERLAID ON STARTUP.
+
+/*** FOR BATCH OPERATION, RUBOUTS ARE IGNORED BY 'RKEY'
+/*** AND 'RUBO' IS OVERLAID WITH CODE TO IGNORE A LINE-
+/*** FEED THAT FOLLOWS A CARRIAGE-RETURN.
+/
+RUBO, JMS BTEST /RUBOUT TYPED,TEST FOR EMPTY
+ JMP RUBOF / INPUT BUFFER EMPTY!
+ JMS I TYPECI /OK, OUTPUT 1ST "\"
+ "\
+RUBO1, JMS BTEST /NOW EMPTY?
+ JMP RUBOE / YES, LINE END
+ TAD COMIR /ECHO LAST CHAR IN BUFFER
+ DCA ENDC
+ CDF 10
+ TAD I ENDC
+ CDF 0
+ JMS I TYPEI
+ STA
+ TAD COMIR /NOW BACK UP POINTER
+ DCA COMIR
+ JMS RKEY /GET A CHAR
+ JMP RUBO1 /ANOTHER RUBOUT, GO HANDLE
+ DCA BTEST /SAVE THE CHAR
+ JMS I TYPECI / DO CLOSING "\"
+ "\
+ TAD BTEST
+ JMP REKEY /& GO USE NEW CHAR
+/
+RUBOE, JMS I TYPECI /BUFFER WAS EMPTIED,
+ "\ /OUTPUT CLOSING "\"
+RUBOF, JMS I CRLFI / & A CR/LF
+ JMP I READ
+/
+RECHO, JMS I TYPECI /ECHO "^R" & THEN
+ "R-100
+ JMS I CRLFI /ECHO CURRENT LINE
+ TAD COMST /INIT AUTO-XR
+ DCA COMOUT
+RECHO1, TAD COMOUT /DONE?
+ CIA
+ TAD COMIR
+ SNA CLA
+ JMP RENEXT /YES, MORE INPUT
+ JMS I GETNI /NO, GET NEXT CHAR
+ JMS I TYPEI / & OUTPUT IT
+ JMP RECHO1 / & CONTINUE
+/
+RERASE, JMS I TYPECI /OUTPUT "^U"
+ "U-100
+ JMP RUBOF /GO OUTPUT CR/LF & EXIT
+
+BTEST, 0 /TEST FOR COMM. BUFFER EMPTY
+ TAD COMIR
+ CIA
+ TAD COMST
+ SZA CLA /EMPTY?
+ ISZ BTEST /NO, STILL OK, TO CALL+2
+ JMP I BTEST / OTHERWISE TO CALL+1
+\fRKEY, 0 /GET A NON-NULL CHAR, TEST & TRANSLATE
+ KSF /*** JMS I CTRLI /CHECK KEYBOARD
+ JMP .-1 /*** CIF BAT /BATCH OPER.
+ JMS I CTRLI /*** JMS I BATINI
+ KSF /*** ERROR /EOF!!
+ JMP RKEY+1 /*** NOP /MUST USE SPECIAL CARE
+ KRB /*** NOP / TO HANDLE CTRL-Q!
+ AND N177 /MASK OFF PARITY
+ SNA
+ JMP RKEY+1 /NULL CHAR
+ TAD (-177 /IS IT A RUBOUT?
+ SNA
+RKEY0, JMP I RKEY /YES, EXIT TO CALL+1 /*** BATCH
+ ISZ RKEY /NO, EXIT TO CALL+2 /*** OPER.
+ TAD (2 /TEST FOR ALT-MODES
+ SMA
+ JMP RKEY1 / 375 OR 376
+ TAD (35 /IS IT LOWER CASE?
+ SMA
+ TAD (-40 /YES, MAKE UPPER CASE
+ TAD (-35
+RKEY1, TAD (375 /RESTORE CHAR & ADD PARITY
+ JMP I RKEY / & EXIT WITH IT
+
+
+/SUBROUTINE TO TERMINATE COMMAND BUFFER WITH A C.R.
+/RETURN TO CALL+1 IF ONLY A CR (EXCLUDING LEADING
+/SPACES) IN BUFFER, TO CALL+2 IF ANYTHING ELSE.
+ENDC, 0
+ TAD (215 /PUT A CR IN BUFFER
+ CDF 10
+ DCA I COMIR
+ CDF 0
+ TAD COMST /INIT'L BUFFER UNLOAD
+ DCA COMOUT
+ TAD CHAR /SAVE CHAR FOR POSSIBLE
+ DCA TEMP / USE BY 'WCHEK'
+ JMS I GETNI /GET FIRST CHARACTER
+ JMS I SSKIPI /SKIP LEADING SPACES
+ TAD CHAR /GET 1ST NON-SPACE
+ TAD M215 /IS IT A CR?
+ SZA CLA /YES, NOTHING IN BUFFER
+ ISZ ENDC /OTHERWISE RETURN TO CALL+2
+ JMP I ENDC
+
+
+DODIG, 0 /OUTPUT AC AS AN ASCII DIGIT
+ JMS I TYPECI
+ "0
+ JMP I DODIG
+
+
+PAGE
+\f/'FPP'/OCTAL/'PDP' OUTPUT ROUTINE FOR ODT
+ODTOUT, 0
+ TAD TYPSW /-1, 0, +1
+ TAD (TAD ODTOL /GENERATE ADDRESS OF DESIRED
+ DCA ODTOPT / OUTPUT ROUTINE
+ODTOPT, HLT /[USED TWICE!]
+ DCA ODTOPT
+ JMS I ODGETI /GET SPECIFIED WORD
+ JMS I ODTOPT / & OUTPUT IT
+ JMP I ODTOUT
+
+ FPPDMP /-1 = OCTAL + FPP
+ODTOL, OPRT / 0 = OCTAL
+ PDPDMP /+1 = OCTAL + PDP
+
+
+/OCTAL & 'PDP' (SYMBOLIC) DUMP ROUTINE
+PDPDMP, 0
+ JMS I OCTI /FIRST OUTPUT IN OCTAL
+ SPACE2 /FOLLOWED BY 2 SPACES,
+ JMS PDPOUT / & THEN AS 'PDP'
+ JMP I PDPDMP
+
+
+/'PDP' (SYMBOLIC) INSTRUCTION DECODING
+PDPOUT, 0
+ CLA
+ JMS OPRTST /TEST FOR OPR & IOT
+ JMP OPRS / OPR
+ JMS IOPRNT / IOT
+SYMS, JMS GETOP /GET OP-CODE TO BITS 9-11
+ RAL / * 2
+ JMS SYMTYP /OUTPUT 3 CHAR SYMBOL & SPACE
+ INSLST /(TABLE FOR INDEXING)
+ -2 /(- # WORDS)
+ JMS OPRTST /TEST FOR OPR & IOT
+ JMP SYMEND / OPR, DONE
+ JMP IOTS / IOT
+ TADICAD /MEMORY REF., INDIRECT?
+ AND (400
+ SNA CLA
+ JMP REFS1 /NO
+ JMS I TWOCI /YES, OUTPUT "I "
+ 1140
+REFS1, TADICAD /SET UP ADDR BITS
+ AND N177
+ DCA BITVAL /SAVE THEM
+ TADICAD /IS THIS A 'PAGE 0 REF'?
+ AND N200
+ SZA CLA
+ TAD LOCL /NO, USE PAGE BITS
+ AND M200
+ TAD BITVAL /OK, NOW ADD ADDR BITS
+REFS2, JMS I OCTI /OUTPUT IN OCTAL
+SYMEND, JMP I PDPOUT /DONE, RETURN
+
+/
+IOTS, TADICAD /USE ONLY LAST 9 BITS
+ AND (777
+ JMP REFS2 /AND OUTPUT IN OCTAL
+/
+OPRS, TADICAD /IS THIS A NOP?
+ AND (777
+ SNA
+ JMP SYMS /YES, OUTPUT "NOP "
+ AND N200 /IS THERE A CLA IN IT?
+ SNA CLA
+ JMP OPRS1 /NO, CONTINUE
+ JMS SYMTYP /YES, OUTPUT "CLA "
+ CLANAM
+ -2
+ IAC
+OPRS1, DCA CNT /SET ANYTHING OUTPUT SWITCH
+ TADICAD /SET UP WORD FOR DECODE
+ JMS I RTL6I
+ RAR
+ DCA BITVAL /SAVE IT
+ TADICAD /CHECK FOR OPR1, OPR2 OR EAE
+ CLL RAR
+ AND N200
+ SNA
+ JMP OPR1A /OPR1 MICRO-INSTRUCTION
+ SNL CLA
+ JMP OPR2A /OPR2 MICRO-INSTRUCTION
+/
+/DO THE DOCODING FOR THE EAE MICRO-INSTRUCTIONS
+EAE, TAD (EAELST-2 /SET UP EAE LIST POINTER
+ DCA BITPNT
+ JMS BITS /SHIFT & CHECK BIT 5
+ JMS OPRTYP /IF = 1, "MQA "
+ TAD BITVAL /CHECK BIT 6
+ CLL RAL /("SCA" IN "A" MODE OF 8/E
+ DCA BITVAL / 'MODE BIT' IN "B" MODE)
+ SZL
+ TAD N20 /IF ON, USE OTHER WORDS
+ DCA EAETMP
+ JMS BITS /CHECK BIT 7
+ JMS OPRTYP / "MQL "
+ TADICAD
+ AND (16
+ TAD EAETMP /(ADD SWITCH WORD)
+ JMS SYMLIM /CHECK FOR & OUTPUT LAST INST.
+ -36 /UPPER LIMIT
+EAETMP, 0
+/
+/DO THE DECODING FOR THE OPR1 MICRO-INSTRUCTIONS
+OPR1A, TAD (OP1LST-2 /SET OPR1 LIST
+ DCA BITPNT
+ JMS BITS /SHIFT & CHECK BIT 5
+ JMS OPRTYP /IF = 1, OUTPUT "CLL "
+ JMS BITS /CHECK BIT 6
+ JMS OPRTYP / "CMA "
+ JMS BITS /CHECK BIT 7
+ JMS OPRTYP / "CML "
+ ISZ BITPNT /BUMP POINTER
+ ISZ BITPNT
+ TADICAD /LOOK FOR IAC
+ RAR
+ SZL CLA
+ JMS OPRTYP /OUTPUT "IAC "
+ TADICAD /SET UP TO CHECK FOR ROTATES
+ AND (16
+ JMS SYMLIM /CHECK & OUTPUT
+ -12 /UPPER LIMIT
+
+
+PAGE
+\f/OCTAL & 'FPP' (SYMBOLIC) DUMP ROUTINE
+FPPDMP, 0
+ JMS I OCTI /FIRST OUTPUT IN OCTAL
+ SPACE2 / THEN 2 SPACES
+ JMS FPPOUT / & THEN AS FPP
+ JMP I FPPDMP
+
+/THE FOLLOWING ROUTINES ARE USED BY 'PDPOUT'
+
+/DO THE DECODING FOR THE OPR2 MICROINSTRUCTIONS
+OPR2A, TAD (OP2LST-2 /SET UP LIST POINTER
+ DCA BITPNT
+ JMS BITS /SHIFT & CHECK BIT 5
+ JMS OPR2T /IF 1, OUTPUT "SMA " OR "SPA "
+ JMS BITS /CHECK BIT 6
+ JMS OPR2T / "SZA " OR "SNA "
+ JMS BITS /CHECK BIT 7
+ JMS OPR2T / "SNL " OR "SZL "
+ JMS BITS /CHECK BIT 8
+ SKP
+ JMP OPR2B /IT WAS 0
+ TADICAD /MUST CHECK FOR "SKP "
+ AND (160
+ SNA CLA /ARE ALL SKIP SENSES = 0?
+ JMS OPRTYP /YES, SO OUTPUT "SKP "
+OPR2B, TAD (OP2LST+14 /SET UP CHECK FOR OSR & HLT
+ DCA BITPNT
+ JMS BITS /CHECK BIT 9
+ JMS OPRTYP / "OSR "
+ JMS BITS /CHECK BIT 10
+ JMS OPRTYP / "HLT "
+ JMP OPEND /CHECK FOR ANY DONE
+
+SYMLIM, 0 /CHECK LAST SYMBOL AGAINST LIMIT
+ DCA CHAR /SAVE AC
+ TAD CHAR
+ SPA SNA /IS IT > 0?
+ JMP OPEND /NO, TEST IF ANY OUTPUT DONE
+ TAD I SYMLIM /IT IS > UPPER LIMIT?
+ SMA SZA CLA
+ JMP OPEND /NO, GO CHECK AGAIN
+ TAD CHAR /CALCULATE ADDRESS
+ JMS OPRTYP / & OUTPUT LAST
+ JMP SYMEND /...DONE
+/
+OPEND, CLA
+ TAD CNT /ANYTHING OUTPUT?
+ SZA CLA
+ JMP SYMEND /YES, DONE WITH OUTPUT
+ JMS SYMTYP /NO, OUTPUT "OPR "
+ OPRMES
+ -2
+ JMP IOTS /NOW GO OUTPUT LAST 9 BITS
+
+BITS, 0 /DECODE A WORD ONE BIT AT A TIME
+ TAD BITVAL /SHIFT A BIT INTO LINK
+ CLL RAL
+ DCA BITVAL /SAVE FOR LATER
+ ISZ BITPNT /BUMP SYMBOL POINTER
+ ISZ BITPNT
+ SNL
+ ISZ BITS /TO CALL+2 IF L = 0
+ JMP I BITS
+
+OPRTYP, 0 /OUTPUT AN OPR SYMBOL
+ JMS SYMTYP /OUTPUT THE SYMBOL
+BITPNT, 0 /ADDRESS
+ -2
+ ISZ CNT /SET SWITCH
+ JMP I OPRTYP
+
+SYMTYP, 0 /OUTPUT A SYMBOL
+ TAD I SYMTYP /ADD TABLE ADDR TO ANY INDEX
+ ISZ SYMTYP
+ DCA SYMPNT /SAVE POINTER
+ TAD I SYMTYP /GET COUNT OF WORDS
+ ISZ SYMTYP
+ DCA BITS / & SAVE IT
+SYMNXT, CDF 10 /"SYMBOL"S IN FIELD 1
+ TAD I SYMPNT
+ CDF 0
+ JMS I TWOT /OUTPUT A PAIR OF LETTERS
+ ISZ SYMPNT
+ ISZ BITS /DONE?
+ JMP SYMNXT
+ JMP I SYMTYP
+SYMPNT, 0
+
+OPR2T, 0 /OUTPUT AN OPR2 SYMBOL
+ TADICAD
+ AND (10 /IF BIT IS ON, REVERSE THE
+ JMS OPRTYP /SENSE OF THE SKIP
+ JMP I OPR2T
+
+BITVAL, 0
+
+
+IOPRNT, 0 /OUTPUT I/O NAMES
+ TAD (IOTTAB /SET UP POINTER
+IOPRN1, DCA IOPNT /SET (OR UPDATE) POINTER
+ CDF 10
+ TAD I IOPNT /GET NEXT IOT
+ CDF 0
+ SNA /AT END OF TABLE?
+ JMP I IOPRNT /YES, CODE NOT FOUND
+ CIA
+ TADICAD /NO, DO THEY MATCH?
+ SNA CLA
+ JMP IOPRN2 /YES, OUTPUT NAME
+ TAD (4 /NO, UPDATE POINTER
+ TAD IOPNT
+ JMP IOPRN1 / & TRY AGAIN
+/
+IOPRN2, IAC /WORD FOLLOWS CODE
+ JMS SYMTYP /OUTPUT THE MNEMONIC
+IOPNT, 0
+ -3
+ JMP SYMEND / & RETURN
+
+
+OPRTST, 0 /TEST "INSTRUCTION" FOR OPR & IOT
+ TADICAD /GET WORD
+ AND N7000 /MASK OFF OP CODE
+ TAD (1000 /IS IT AN OPR?
+ SNA
+ JMP I OPRTST /YES, EXIT TO CALL+1
+ ISZ OPRTST
+ TAD (1000 /IS IT AN IOT?
+ SZA CLA
+ ISZ OPRTST /NO, EXIT TO CALL+3
+ JMP I OPRTST / YES, TO CALL+2
+
+
+PAGE
+\f/'FPP' (SYMBOLIC) INSTRUCTION DECODING
+FPPOUT, 0
+ CLA /HARD TO TELL WHAT MIGHT COME!
+ TADICAD /GET THE WORD
+ AND (600 /MASK OFF MODE BITS
+ SNA
+ JMP SPECIAL / NON-ARITHMETIC
+ TAD M400 /GIVES: -=BASE, 0=LONG, +=INDIR.
+ DCA TEMP2
+ JMS GETOP /GET OP-CODE TO BITS 9-11
+FPLEA, JMS MULT3 /MULTIPLY BY 3 (WORDS/OP OUT)
+ JMS SYMTYP /OUTPUT 6 CHAR OPR SYMBOL
+ FPPINS /(INCLUDING "LEA")
+ -3
+ TAD TEMP2 /NOW HANDLE MODE
+ SNA
+ JMP LONG / LONG INDEXED
+ SMA CLA
+ JMP INDIR / INDIRECT INDEXED
+BASE, JMS I TYPSI / BASE - OUTPUT " B+"
+ MSBASE
+ TADICAD /GET WORD AGAIN
+ AND N177 / MASK OFF OFFSET
+ JMS MULT3 / MULTIPLY IT BY 3
+ JMS OCT3 / & OUTPUT IN OCTAL
+ JMP I FPPOUT
+/
+INDIR, JMS I TYPSI /OUTPUT "% B+"
+ MSINDI
+ TADICAD /GET WORD AGAIN
+ AND N7 / MASK OFF OFFSET
+ JMS MULT3 / MULTIPLY IT BY 3
+ JMS OCT3 / & OUTPUT IT IN OCTAL
+ JMP XRPLUS /FINALLY DO XR OUTPUT
+/
+LONG, JMS I TWOCI /OUTPUT "# "
+ 4340
+ JMS FLDOUT /AND FIELD AND "*"
+XRPLUS, JMS GET678 /GET XR FIELD
+ JMS I TWOCI / & OUTPUT ",X" WHERE
+ 5460 / "X" IS A DIGIT
+ TADICAD /GET WORD THE LAST TIME
+ AND (100 / AND CHECK "+" BIT
+ SZA CLA
+ JMS I TYPECI /OUTPUT "+" OR SKIP
+ "+ /[A NOP]
+ JMP I FPPOUT
+/
+SPECIAL,JMS GETOP /GET OP-CODE
+ JMS I SORTI / & BRANCH ON IT
+ FPPMO0-1
+ FPPMOJ-FPPMO0
+SPCOP0, TADICAD /FALLS THRU ON 0, GET
+ AND (170 / SUB-OP-CODE
+ JMS I SORTI / & BRANCH ON IT
+ FPPOP0-1
+ FPPOPJ-FPPOP0
+SPOP00, TADICAD /FALLS THRU ON 0, USE AS
+ AND N7 / INDEX INTO LAST LIST
+ IAC
+SPOP04, JMS MULT3 /THREE WORDS/SYMBOL
+ JMS SYMTYP /OUTPUT ONE OF SEVERAL
+ FPOP00 / SYMBOLS IN THIS LIST
+ -3
+ JMP I FPPOUT
+/
+SPOP05, CLL STA /= -1
+ JMP SPOP04 /OUTPUT "STARTE"
+/
+SPNUSE, CLL STA RAL /= -2
+ JMP SPOP04 /OUTPUT "UNUSED"
+/
+SPO123, JMS GET678 /"ALN X", "ATX X", "XTA X"
+ CLL RAL /(2 WORDS PER)
+ JMS SYMTYP /OUTPUT SYMBOL
+ FPXR1S-2
+ -2
+ JMP XROUT / & XR VALUE
+/
+SPOP10, TAD (4 /"LDX *,X"
+SPOP11, JMS SYMTYP /"ADDX *,X"
+ FPXR2S
+ -4
+XROUT, TADICAD /GET XR FIELD
+ AND N7
+ DIGIT / & OUTPUT AS DIGIT
+ JMP I FPPOUT
+/
+SPCOP1, TADICAD /GROUP 0 OR 1?
+ AND (100
+ SNA CLA
+ JMP SPOP1J / 1 = CONDITIONAL JUMPS
+ JMS GET678 / 0 = SETS, ETC.
+ TAD (-4 /SUB-OP-CODES 0 THRU 3?
+ SMA CLA
+ JMP SPNUSE / NO, 4 THRU 7 = UN-USED
+ JMS GET678 /0 THRU 3: SETX,SETB,JSA,JSR
+ IAC / +1+1 => 2 THRU 5
+SPCOP3, IAC / 1: TRAP3
+SPCOP4, JMS MULT3 / 0: TRAP4
+ JMS SYMTYP /GO DO ONE OF THESE
+ FOP134
+ -3
+ JMP DOFLD /FINISH WITH FIELD
+/
+SPOP1J, JMS CONDIT /CONDITIONAL JUMPS
+ 1200 / "J--"
+ SPACE2
+DOFLD, JMS FLDOUT /OUTPUT FIELD & "*"
+ JMP I FPPOUT
+/
+SPCOP2, JMS I TYPSI /OUTPUT "JNX "
+ MSJNX
+ JMP XRPLUS-1 / & HANDLE ADDRESS
+/
+/ SPCOP3 & SPCOP4
+/
+SPCOP5, TADICAD /GET WORD AGAIN
+ AND (100
+ SZA CLA
+ JMP SPNUSE /BIT 5 ON IS UNUSED OP
+ JMS CONDIT /LOAD TRUTH
+ 1424 / "LT--"
+ JMP I FPPOUT
+/
+SPCOP7, IAC / "LEA" INDIRECT, SET SWITCH
+SPCOP6, DCA TEMP2 / "LEA" LONG, SET SWITCH
+ CLL STA
+ JMP FPLEA / & GO DO OUTPUT
+
+
+PAGE
+\fPDATE, 0 /ROUTINE TO OUTPUT AN EXTENDED DATE WORD
+ DCA CRLF /SAVE IT
+ TAD CRLF /GET WORD & MASK
+ AND N377
+ CLL RTR /DAY (4-8) TO 7-11
+ RAR
+ JMS I DEC2I / OUTPUT AS 2 DIGITS (MASKED)
+ JMS I TYPECI / AND A SEPARATOR
+ "-
+ TAD CRLF /GET WORD A SECOND TIME
+ JMS I RTR6I /MONTH (0-3) TO 7-10
+ RAR / FOR MONTH*2
+ AND (36 / MASK IT AND USE AS AN INDEX
+ JMS I TYPSI / TO OUTPUT MONTH IN ALPHA
+ MONTHS / FORM (WITH SAFETY...)
+ JMS I TYPECI /FOLLOWED BY "-"
+ "-
+ TAD CRLF /GET LAST TIME
+ AND N7 / MASK OFF YEAR
+ TAD YRTEST / TEST IF .GT. THIS YEAR
+ SMA SZA
+ TAD (-10 / YES, SUBTRACT 8
+ TAD YRBASE / ADD TO BASE YEAR
+ JMS I DEC2I / & OUTPUT IT
+ JMP I PDATE
+YRTEST, 0 /-(THIS YEAR) FOR TESTING
+YRBASE, 0 /BASE YEAR FOR DATE + THIS YEAR
+
+
+TYPEA, 0 /OUTPUT ASCII CHARACTER IN THE AC
+ TAD I TYPEA /GET ARG, IF ANY
+ ISZ TYPEA
+ DCA I RTL6I /SAVE THE CHAR HERE FOR FIELD 1
+ JMS I CTRLI
+ CIF 10
+ JMP TYPE1 /GO TO FIELD 1 TO DO THE OUTPUT
+/
+TYPEX, ISZ NCNT /BUMP LINE POSITION
+ JMP I TYPEA / & EXIT
+
+CRLF, 0 /OUTPUT CARRIAGE RETURN, LINE FEED
+ CLA
+ JMS TYPEA
+ 215
+ JMS TYPEA
+ 212
+ DCA NCNT /RESET LINE POSITION
+ JMP I CRLF
+
+
+TYPEC, 0 /OUTPUT A SINGLE CHAR ARG
+ TAD I TYPEC /GET IT
+ ISZ TYPEC
+ JMS TYPE /OUTPUT IT
+ JMP I TYPEC
+
+
+TYPE, 0 /CHARACTER OUTPUT ROUTINE
+ AND N377 /BE SURE ONLY 8 BITS
+ SNA
+ TAD CHAR /USE CHAR IF AC = 0
+ DCA TCHAR /CHAR TO OUTPUT
+ TAD TCHAR
+ JMS I SORTI /CHECK FOR SPECIALS
+ TYPEL-1
+ TYPEOP-TYPEL
+ TAD TCHAR /IS TCHAR < 240?
+ TAD M240
+ SPA CLA
+ JMP TYPCTL /NO, OUTPUT AS CTRL-CHAR
+TYPC, JMS TYPEA /NOW OUTPUT CHAR
+TCHAR, 0
+ JMP I TYPE
+/
+TYPALT, JMS TYPEA /OUTPUT "$" FOR ALT-MODES
+ "$
+ JMP I TYPE
+/
+TYPCR, JMS CRLF /C.R. TO OUTPUT
+ JMP I TYPE
+/
+TYPTAB, JMS TYPEA /SPACE OVER FOR TAB
+ "
+ TAD NCNT /TAB TO OUTPUT
+ TAD M10
+ SNA
+ JMP I TYPE
+ SMA
+ JMP TYPTAB+3 /REDUCE BY TAB SIZE
+ CLA
+ JMP TYPTAB
+/
+TYPCTL, JMS TYPEA /CONTROL-CHAR, OUTPUT AS
+ "^
+ TAD C100 / "^","CHAR+100"
+ JMP TYPC
+C100, 100
+
+
+CTRL, 0 /CHECK FOR CTRL-C, CTRL-S, CTRL-Q & CTRL-P
+ DCA CTRLQS /CLEAR HANG FLAG
+CTRL0, KSF /HAS A KEY BEEN HIT?
+ JMP CTRLX /NO, TEST IF HANGING
+ KRS
+ AND N177 /YES, MASK OFF PARITY BIT
+ TAD (-"C+300 /IS IT A CTRL-C (ABORT PROGRAM)?
+ SNA
+BCTRLC, JMP CTRLC /*** JMP I CTRLCI /== ABORT ==
+ TAD M20 /IS IT A CTRL-S (STOP OUTPUT)?
+ SZA
+ JMP CTRL1
+ ISZ CTRLQS / YES, SET HANG FLAG
+ KCC / & CLEAR HARDWARE FLAG
+CTRL1, TAD (2 /IS IT A CTRL-Q (START OUTPUT)?
+ SZA
+ JMP CTRL2
+ KCC / YES, CLEAR THE HARDWARE
+ JMP I CTRL / & JUST EXIT
+/
+CTRL2, IAC /IS IT A CTRL-P (STOP PROGRAM)?
+ SZA CLA
+ JMP CTRLX /NO, TEST IF HANGING
+ KCC
+ DCA DSWIT /YES, RESET DUMP SWITCH
+ JMS I TYPECI /OUTPUT "^P"
+ "P-100
+ JMP I RECRLF / THEN CR/LF & RESTART
+/
+/ROUTINE TO EXECUTE THE 'EXIT' COMMAND
+/
+XEXIT,
+CTRLC, DCA DSWIT /RESET DUMP SWITCH
+ JMP I M200 / & GO TO SYSTEM
+CTRLCI, XERR4+1 /*** CTRL-C ABORTS JOB STREAM! ***
+/
+CTRLX, TAD CTRLQS /HANGING BECAUSE OF CTRL-S?
+ SZA CLA
+ JMP CTRL0 / YES, BACK FOR ANOTHER ROUND
+ JMP I CTRL / NO, OUT WE GO!
+
+CTRLQS, 0 /CTRL-S, CTRL-Q FLAG
+
+
+PAGE
+\f/INPUT AN UNSIGNED 24 BIT NUMBER
+ACCEPT, 0
+ DCA ACC1 /CLEAR LO
+ DCA ACC2 / & HI WORDS
+ DCA DADD / & LEGAL INPUT SWITCH
+ JMS I SSKIPI /GET FIRST NON-SPACE
+ SKP
+ACCPT1, JMS I GETNI /DON'T IGNORE SPACES
+ JMS I SORTI /CHECK FOR ^D, ^K, (, ", ',
+ GWLST1-1 / DIGITS, SPACE
+ ACOPS-GWLST1
+ JMP ACCPT3 /NONE OF THE ABOVE
+/
+ACCNUM, TAD CHAR
+ TAD (-"0 /MAKE A DIGIT
+ DCA OCTSET
+ TAD OCTSET /IS DIGIT LEGAL?
+ CIA
+ TAD ACBASE
+ SPA SNA CLA
+ERC09, ERROR / NO, ILLEGAL DIGIT!
+ACCMUL, TAD ACBASE /SET UP MULTIPLY OF PREVIOUS
+ DCA OPER1 / BY BASE
+ DCA OPER2
+ JMS DMUL / DO MULTIPLY
+ TAD OCTSET /SET UP ADD OF NEXT "DIGIT"
+ DCA OPER1
+ DCA OPER2
+ JMS DADD /OK, DO THE ADD (& SET SWITCH)
+ JMP ACCPT1
+/
+ STA / SPACE HERE
+ DCA CRSWT /SET SWITCH: CR HERE
+ACCPT3, TAD DADD /TERMINATING CHAR RECEIVED
+ SNA CLA /CHECK FOR LEGAL INPUT
+ERCR, ERROR /YOU CAN'T OUT-SMART ME!
+ JMP I ACCEPT
+ACBASE, 10
+/
+/
+DQUOTE, JMS QUOTEC / " - GET SINGLE CHAR
+ DCA OCTSET / SAVE VALUE
+ JMP ACCMUL / & USE IT AS A "DIGIT"
+/
+SQUOTE, JMS QUOTEC / ' - PACKED ASCII, GET 1ST
+ AND N77 /MASK TO 6 BITS
+ JMS I RTL6I /MOVE TO LEFT HALF
+ DCA OCTSET / & SAVE IT
+ JMS QUOTEC /GET 2ND CHAR
+ AND N77 /MASK
+ TAD OCTSET /MERGE
+ JMP DQUOTE+1 / & USE THIS AS A "DIGIT"
+/
+CTRLD, TAD (2 / ^D - SET RADIX TO DECIMAL
+CTRLK, JMS OCTSET / ^K - SET RADIX TO OCTAL
+ JMP ACCPT1
+
+
+/SUB. TO SET UP FOR OCTAL/DECIMAL INPUT. CALLED FROM
+/ COMMAND INPUT & MODIFY & IF AN "^K"/"^D" IN INPUT.
+OCTSET, 0 /SET UP FOR OCTAL/DECIMAL INPUT
+ TAD (10 /ENTER WITH AC= 2 FOR DECIMAL
+ DCA ACBASE
+ JMP I OCTSET
+
+QUOTEC, 0 /GET A QUOTED CHARACTER
+ JMS CGTEST /GET & TEST FOR A CR
+ERC13, ERROR / ILLEGAL USE OF " OR '
+ TAD CHAR /OK, RETURN WITH IT
+ JMP I QUOTEC
+
+
+/SUBROUTINE TO DEVELOP ARGUMENTS FROM THE COMMAND
+/BUFFER, AND RETURN WITH -(#) OF ARGS IN 'TEMP'.
+GARGS, 0
+ TAD TEMPST /GET BUFFER ADDRESS
+ DCA DPNT
+ DCA TEMP /ZERO THE NUMBER OF ARGS
+GAR1, STA
+ DCA TEMP1 /SET BLK TO -1
+ STA
+ DCA CNT /RESET SWITCH
+GAR2, JMS EXPRIN /GET NEXT ARG
+ JMS I SSKIPI /IGNORE TRAILING SPACES
+ JMS I SORTI /BRANCH ON TERMINATOR
+ GARLST-1
+ GAROPS-GARLST
+ERCS, ERROR /ILLEGAL TERMIN., FLAME OUT
+/
+GAR3, JMS GPUT /CR FOUND, END
+ TAD TEMPST /SET UP POINTER FOR
+ DCA DPNT / GETTING RESULTS
+ JMP I GARGS
+/
+GAR4, JMS I GETNI /SKIP OVER "."
+ TAD ACC1 /.= TERMIN (BLOCK PART)
+ JMP GAR1+1 /SET BLOCK & GET NEXT
+/
+GAR5, TAD ACC1 /-= TERMIN (LOC PART)
+ DCA TEMP2
+ JMS I GETNI /SKIP OVER "-"
+ JMP GAR2-1 /GO SET SWITCH
+/
+GAR6, JMS GPUT /,= TERMIN
+ JMS I GETNI /SKIP OVER ","
+ JMP GAR1
+
+
+/SUBROUTINE TO PUT THE DEVELOPED ARGS IN THE ARG
+/BUFFER. ALL ARGUMENTS ARE STORED IN 4 WORDS IN
+/THE BUFFER, AS SPECIFIED BY:
+/ BLOCK.LOC1-LOC2 (TERMINATED BY , OR C.R.)
+/AS:
+/I-------I-------I-------I-------I-----
+/I WORD1 I WORD2 I WORD3 I WORD4 I ETC.
+/I-------I-------I-------I-------I-----
+/WHERE:
+/ WORD1= BLOCK (OR -1 IF NONE SPECIFIED)
+/ WORD2= LOC (HIGH) [ONLY 3 BITS, LOC2 IF SPEC'D]
+/ WORD3= LOC1 (LOW)
+/ WORD4= LOC2-LOC1-1 (LOC2=LOC1 IF NOT
+/ SPECIFIED) [ONLY 12 LOW BITS USED]
+GPUT, 0
+ TAD TEMP1
+ DCA I DPNT /SET BLOCK
+ ISZ CNT /WAS A LOC2 SPECIFIED?
+ JMP GPUT1 /YES, OK
+ TAD ACC1
+ DCA TEMP2 /NO, MAKE ARGS SAME
+GPUT1, TAD ACC2 /STORE HIGH ADDR
+ AND N7 /MASKED TO 3 BITS
+ DCA I DPNT
+ TAD TEMP2 /USE 1ST ARG
+ DCA I DPNT
+ TAD ACC1
+ CMA
+ TAD TEMP2
+ DCA I DPNT /DIFF= (TEMP2-ACC1-1)
+ STA
+ TAD TEMP /ANOTHER ENTRY
+ DCA TEMP
+ JMP I GPUT
+
+
+XS240O, 0 /XS240 FORMAT PACKED ASCII
+ JMS I RTR6I /HIGH 6 BITS
+ AND N77
+ SPACE1 / PLUS A SPACE
+ TADICAD /THEN LOW 6 BITS,
+ AND N77
+ SPACE1 / PLUS A SPACE
+ JMP I XS240O
+
+
+GETN, 0 /GET NEXT CHAR FROM COMM. BUFF.
+ CDF 10
+ TAD I COMOUT
+ CDF 0
+ DCA CHAR
+ JMP I GETN
+
+
+PAGE
+\f/ROUTINE TO EVALUATE THE PARENTHESIZED EXPRESSION
+/OF DOUBLE PRECISION INTEGERS IN THE COMMAND BUFFER.
+/IT CALLS ITSELF RECURSIVELY TO EVALUATE EXPRESSIONS
+/IN "(...)", PLACING INFORMATION ON A PUSH-DOWN-LIST
+/OR DOING ARITHMETIC ACCORDING TO OPERATOR PRECIDENCE.
+/
+/OPERATIONS (IN ORDER OF PRECIDENCE):
+/ OR AND ADD SUB DIV MPY
+/ ! & + - / *
+
+/ALL ARITHMETIC IS DONE IN DOUBLE-PRECISION SIGNED
+/INTEGER. OVERFLOW ON MULTIPLY, ADD OR SUBTRACT IS
+/IGNORED BUT DIVIDE BY 0 WILL CAUSE AN ERROR.
+
+
+EVAL, 0
+ DCA OPER2 /0 => D.P. TEMP (NEW NUMBER
+ DCA OPER1 / OR LAST RESULT).
+ DCA LASTOP /0 => LASTOP
+ JMS I TERMTI /GET NEXT & TEST FOR TERM.
+ JMP EVAL1 /TERM, CHECK IT
+ JMP ENUM / IT MUST BE A NUMBER
+
+EVAL1, JMS I SORTI /CHECK LEGAL TERMS
+ EVLST1-1 /"+","-" & "("
+ EVOPS1-EVLST1
+ERCT, ERROR /SORRY ABOUT THAT
+
+EVAL2, JMS I LPARI /IS CHAR "("?
+ERCU, ERROR /YES,ILLEGAL (NO OP FIRST)
+EVMIN, TAD CNTRA /SEQN # OF TERMINATOR
+ DCA THISOP /SET UP THISOP
+ TAD CNTRA /IS IT ")" OR "CR"?
+ TAD M10
+ SMA CLA
+ DCA THISOP /YES, 0 => THISOP
+EVAL3, TAD THISOP /CHECK PRIORITIES
+ CIA
+ TAD LASTOP /IS LASTOP < THISOP?
+ SPA CLA
+ JMP EVPAR /YES, CONTINUE SCAN
+ TAD THISOP / IS THISOP+LASTOP=0?
+ TAD LASTOP
+ SNA CLA
+ JMP EVALX /YES, DONE
+ TAD LASTOP /NO, DO THIS OP NOW
+ TAD EVTAB
+ DCA EVOP /SET UP OPERATION
+ TAD LASTOP /IS THIS =0?
+ SNA CLA
+ JMP EVOP /YES, DO OP
+ POP /NO, POP LAST OFF LIST
+ DCA ACC2 / INTO D.P.AC.
+ POP
+ DCA ACC1
+EVOP, HLT /JMS TO OPERATION ROUTINE
+ TAD ACC2
+ DCA OPER2 /DUPLICATE D.P.AC. INTO
+ TAD ACC1
+ DCA OPER1 / D.P. TEMP
+ POP
+ DCA LASTOP /POP UP ANOTHER OLD OPERATOR
+ JMP EVAL3 /AND GO DO IT
+
+EVPAR, JMS I LPARI /IS CHAR A "("?
+ JMP EVLPAR /YES, GO DO A SUB-EXPRESSION
+ TAD LASTOP /NO, PUSH DOWN OLD OP
+ PUSH
+ TAD OPER1 / & D.P. TEMP (LAST
+ PUSH
+ TAD OPER2 / RESULT OR NEW NUMBER).
+ PUSH
+ TAD THISOP /UPDATE LASTOP
+ DCA LASTOP
+EVNEXT, JMS I TERMTI /GET NEXT & TEST FOR TERM.
+ JMP EVLPAR /TERM, MUST BE A "("
+ENUM, JMS I SORTI /CHECK FOR "C","B", ETC...
+ EVLST2-1
+ EVOPS2-EVLST2
+ JMS ACCEPT /GET A # OR BOMB OUT!
+ STA
+ TAD COMOUT /BACK UP POINTER
+ DCA COMOUT
+ENUMX, TAD ACC1
+ DCA OPER1 /LO ORDER PART
+ TAD ACC2
+ DCA OPER2 /HI ORDER PART
+ JMP EVOPN /GO CHECK TERMINATOR
+/
+EVDATE, CDF 10 /"D" -- USE DATE WORD
+ TAD I (7666 /GET DATE WORD
+ CDF 0
+ JMP EVBLK+1
+EVREM, TAD ACCX1 /"R" -- USE REMAINDER
+ DCA ACC1
+ TAD ACCX2 / AS NEXT "INPUT".
+ JMP EVBLK+2
+EVTEMP, TAD TEMPV1 /"T" -- USE 'TEMP' STORAGE
+ DCA ACC1
+ TAD TEMPV2
+ JMP EVBLK+2
+EVSR, LAS SKP /"S" -- USE SWITCHES
+ TADICAD /"C" -- USE CONTENTS
+ JMP EVBLK+1
+EVFIL, TAD FILLER /"F" -- USE FILLER
+ JMP EVBLK+1
+EVLOC, TAD LOCL /"L" -- USE LOCATION
+ DCA ACC1
+ TAD LOCH
+ JMP EVBLK+2
+EVBLK, TAD BLK /"B" -- USE BLOCK
+ DCA ACC1 /INTO LO ORDER PART
+ DCA ACC2 /0 HIGH ORDER PART
+ JMP ENUMX /CHECK NEXT CHARACTER
+
+EVLPAR, JMS I LPARI /IS CHAR "("?
+ SKP
+ERCV, ERROR /NO, DIE! (ILLEGAL OPERATOR)
+EVPAR2, TAD LASTOP /PUSH DOWN LASTOP
+ PUSH
+ TAD EVAL /PREPARE TO RE-CALL
+ PUSH
+ JMS EVAL /RECURSIVE CALL
+ERCW, ERROR /TERM = CR, NOT ENOUGH PARENS
+ POP
+ DCA EVAL /RESTORE RETURN ADDR
+ POP
+ DCA LASTOP /RESTORE LASTOP
+EVOPN, JMS I TERMTI /GET NEXT & TEST FOR TERM.
+ JMP EVAL2 /OK
+ JMP EVPAR2-1 /GARBAGE, GIVE SAME ERROR
+
+EVALX, TAD CNTRA /WAS CHAR CR OR ")"?
+ TAD M10
+ SNA CLA
+ ISZ EVAL / ")", RETURN TO CALL+2
+ JMP I EVAL / CR, RETURN TO CALL+1
+
+LPARI, LPAR
+TERMTI, TERMT
+
+EVTAB, JMS I . /JMS THRU TABLE TO OPERATIONS
+
+ DIOR /INCLUSIVE OR
+ DAND /AND
+ DADD /ADD
+ DSUB /SUBTRACT
+ DDIV /DIVIDE
+ DMUL /MULTIPLY
+
+
+PAGE
+\fPUSHX, 0 /PUSH AC ONTO LIST
+ CDF 10
+ DCA I PDLPT
+ CDF 0
+ ISZ PDLPT /BUMP POINTER
+ JMP I PUSHX
+
+POPX, 0 /POP LIST INTO AC
+ STA STL /SET LINK SO IT WILL BE 0
+ TAD PDLPT /BACK UP POINTER
+ DCA PDLPT
+ CDF 10
+ TAD I PDLPT
+ CDF 0
+ JMP I POPX
+
+
+LPAR, 0 /CHECK IF CHAR = "("
+ TAD CHAR
+ TAD (-"(
+ SZA CLA
+ ISZ LPAR /IF IT IS NOT, TO CALL+2
+ JMP I LPAR / ELSE TO CALL+1
+
+/COMPARE CHAR AGAINST LIST OF TERMINATORS. IF IT
+/IS ONE, RETURN TO CALL+1, ELSE TO CALL+2.
+TERMT, 0
+ CLA CLL
+ JMS I GETNI /GET NEXT CHARACTER
+ JMS I SSKIPI /IGNORE SPACES
+ TAD (TERMS-1 /SET UP POINTER
+ DCA SPNT
+ DCA CNTRA /SET CNTRA TO 0
+TERMT1, CDF 10
+ TAD I SPNT /GET AN ITEM
+ CDF 0
+ ISZ CNTRA /ADD 1 TO ITEM #
+ SNA
+ JMP TERMTE /WAS 0, END
+ CIA
+ TAD CHAR /SAME AS THIS?
+ SNA CLA
+ JMP I TERMT /YES, TO CALL+1
+ JMP TERMT1
+TERMTE, ISZ TERMT /DIDN'T FIND IT, TO
+ JMP I TERMT / CALL+2
+
+/DOUBLE-PRECISION ROUTINES
+
+DADD, 0 /D.P. ADD
+ CLL
+ TAD OPER1
+ TAD ACC1 /ADD LOW ORDER PARTS
+ DCA ACC1
+ RAL /GET CARRY TO AC11
+ TAD OPER2 /ADD HIGH ORDER PARTS
+ TAD ACC2
+ DCA ACC2 /STORE HIGH ORDER PART
+ JMP I DADD
+
+DSUB, 0 /D.P. SUBTRACT
+ DCA DPSGN /ZERO IT FOR SAFETY
+ JMS MULNEG /NEGATE OPERAND
+ JMS DADD / & ADD
+ JMP I DSUB
+
+DAND, 0 /D.P. LOGICAL AND
+ TAD ACC2 /AND HIGH ORDER PARTS
+ AND OPER2
+ DCA ACC2
+ TAD ACC1 /AND LOW ORDER PARTS
+ AND OPER1
+ DCA ACC1
+ JMP I DAND /RETURN
+
+DIOR, 0 /D.P. LOGICAL INCLUSIVE OR
+ TAD ACC2 /IOR HIGH ORDER PARTS
+ CMA
+ AND OPER2
+ TAD ACC2
+ DCA ACC2
+ TAD ACC1 /IOR LOW ORDER PARTS
+ CMA
+ AND OPER1
+ TAD ACC1
+ DCA ACC1
+ JMP I DIOR
+
+
+/SUBROUTINE TO GET SINGLE ARGS FROM THE COMMAND
+/BUFFER. MUST BE IN 'BLOK.LOC' FORM. ONLY ".",
+/SPACE AND CR ARE ALLOWED OTHER THAN DIGITS.
+ARG, 0
+ STA
+ARG1, DCA TEMP1 /SET 'BLOK' [INIT TO -1]
+ JMS EXPRIN / GET AN ARG
+ JMS I SORTI /LOOK UP TERMINATOR
+ ARGLST-1
+ ARGOPS-ARGLST
+ERCQ, ERROR /ILLEGAL TERMINATOR
+/
+ARG2, JMS I GETNI /SKIP OVER "."
+ TAD ACC1 /TERM = ".", SET 'BLOK'
+ JMP ARG1
+/
+ARG3, JMP I ARG /TERM = " " OR CR
+
+
+/GET NEXT ARG FROM COMM. BUFF. IF NEXT CHAR IS
+/ A "(", USE 'EVAL' TO GET IT, OTHERWISE USE
+/ 'ACCEPT'.
+EXPRIN, 0
+ JMS I SSKIPI /IGNORE SPACES
+ JMS LPAR /IS CHAR A "("?
+ JMP EXPRI1
+ JMS ACCEPT /NO, MUST BE A NUMBER
+ JMP I EXPRIN
+/
+EXPRI1, JMS I EVALI /YES, GO EVALUATE EXPRESSION
+ERC08, ERROR /CR = ILLEGAL TERMINATOR
+ JMS CGTEST /OK, SKIP OVER ")" & TEST FOR CR
+ SKP
+ STA /NO, SET SWITCH
+ DCA CRSWT /YES, RESET IT
+ JMP I EXPRIN / & LEAVE...
+
+
+SCANER, 0 /EXECUTION SUBROUTINE FOR 'SCAN' COMMAND
+ CLA
+ TAD BLK /SET UP DESIRED BLOCK
+ DCA CBLK
+ JMS GETIO /DO NECESSARY I/O
+ SKP CLA / READ ERROR!
+ JMP I SCANER /THIS BLOCK IS OK!
+ TAD BLK
+ JMS I OCTI /OUTPUT BLOCK NUMBER
+ JMS I TYPSI / & TELL IT'S BAD
+ MSBAD
+ JMS I CRLFI / TO ANOTHER LINE
+ JMP I SCANER
+
+
+PAGE
+\f/SIGNED MULTIPLY AND DIVIDE ROUTINES
+
+DMUL, 0
+ JMS MDCOM /MAKE DPAC POS, INITIALIZE
+ SPA CLA /MAKE SURE MULTIPLIER IS POSITIVE
+ JMS MULNEG / IT WAS NEG, MAKE POS & SET SIGN
+DMUL1, TAD ACC2 /SHIFT RIGHT & OUT
+ RAR
+ DCA ACC2 /THRU HI OF LO
+ TAD ACC1
+ RAR
+ DCA ACC1 /THRU LO OF LO INTO LINK
+ ISZ DPNEG /DONE YET?
+ JMP DMUL2 /NO, CONTINUE
+DMUL4, TAD DPSGN /YES, CHECK SIGN OF RESULT
+ RAR
+ SZL CLA /SKIP IF SIGN OK
+ JMS DPNEG /NOT OK, NEGATE
+ JMP I DMUL
+/
+DMUL2, SNL /ADD IN THIS TIME?
+ JMP DMUL3 /NO, BIT OUT WAS 0
+ CLA CLL /YES, BIT WAS 1
+ TAD OPER1 /START WITH LOW
+ TAD ACCX1
+ DCA ACCX1
+ CLA RAL /GET CARRY
+ TAD OPER2 /ADD HIGH PARTS
+DMUL3, TAD ACCX2 /AND BEGIN SHIFTING OUT
+ RAR
+ DCA ACCX2
+ TAD ACCX1
+ RAR
+ DCA ACCX1
+ JMP DMUL1
+
+DDIV, 0
+ TAD DDIV /MOVE RETURN ADDRESS
+ DCA DMUL
+ JMS MDCOM /MAKE DPAC POS, INITIALIZE
+ SMA CLA /IS DIVISOR NEGATIVE?
+ JMS MULNEG / NO, NEGATE IT & SET SIGN
+ SZL / IS IT 0? (CARRY OUT ON NEGATE)
+ERCX, ERROR / YES, YOU LOST
+ ISZ DPSGN /CORRECT FOR SIGN DIF IN * & /
+DDIV1, TAD ACCX1 /SUBTRACT LO OF LO
+ TAD OPER1
+ DCA ACCX1
+ CLA RAL /CARRY TO AC
+ TAD ACCX2 /SUBTRACT HI OF LO
+ TAD OPER2
+ SPA /TOO FAR?
+ JMP DDIV2 /YES
+ CLL CML /NO, SET LINK
+ DCA ACCX2
+ JMP DDIV3
+DDIV2, CLA
+ TAD OPER1 /RESET LO ORDER PART
+ CIA
+ TAD ACCX1
+ DCA ACCX1
+ CLL /RESET LINK
+DDIV3, TAD ACC1 /BEGIN SHIFTING
+ RAL
+ DCA ACC1
+ TAD ACC2
+ RAL
+ DCA ACC2
+ ISZ DPNEG /DONE YET?
+ SKP
+ JMP DMUL4 /YES, CHECK SIGN & RETURN
+ TAD ACCX1 /NO, KEEP SHIFTING
+ RAL
+ DCA ACCX1
+ TAD ACCX2
+ RAL
+ DCA ACCX2
+ JMP DDIV1
+
+MDCOM, 0 /COMMON ROUTINE FOR MULTIPLY & DIVIDE
+ DCA DPSGN /RESET SIGN
+ TAD ACC2 /IS DPAC POS?
+ SPA CLA
+ JMS DPNEG /NO, NEGATE
+ DCA ACCX2 / 0 => DPACX
+ DCA ACCX1
+ TAD (-31 /INITIALIZE COUNTER
+ DCA DPNEG
+ CLL
+ TAD OPER2 /RETURN W. HIGH OPERAND
+ JMP I MDCOM
+
+MULNEG, 0 /NEGATE THE MULTIPLIER/DIVISOR
+ TAD OPER1 /DO LO-ORDER PART
+ CLL CIA
+ DCA OPER1
+ TAD OPER2 /DO HI-ORDER PART
+ CMA
+ SZL /CARRY?
+ CLL IAC /YES, ADD IT IN
+ DCA OPER2
+ ISZ DPSGN /SIGN CHANGE MADE
+ JMP I MULNEG
+
+DPNEG, 0 /NEGATE THE D.P.AC.
+ TAD ACC1 /DO LO-ORDER PART
+ CLL CIA
+ DCA ACC1
+ TAD ACC2 /DO HI-ORDER PART
+ CMA
+ SZL /CARRY?
+ CLL IAC /YES, ADD IT IN
+ DCA ACC2
+ ISZ DPSGN /SIGN CHANGE MADE
+ JMP I DPNEG
+
+
+BLKTST, 0 /TEST & SET BLK
+ DCA DPNEG /SAVE DATA
+ TAD DPNEG /GET IT BACK AGAIN
+ ISZ DPNEG /LEGAL BLOCK NUMBER?
+ DCA BLK / YES IF NOT 7777 (-1)
+ CLA / IF NOT, CLEAR JUNK
+ JMP I BLKTST
+
+
+DICAD, 0 /"DCA I CAD" IN FIELD 1
+ CDF 10
+ DCA I CAD
+ CDF 0
+ JMP I DICAD
+
+TICAD, 0 /"TAD I CAD" IN FIELD 1
+ CDF 10
+ TAD I CAD
+ CDF 0
+ JMP I TICAD
+
+
+PAGE
+\f/CHECK IF THE COMMAND BUFFER STARTS WITH A WORD. IF
+/IT DOES, RETURN TO 'MAIN3' WITH THE SPECIAL CHAR-
+/ACTER AND JUST USE IT AS PART OF THE COMMAND STRING.
+/IF IT DOES NOT, TEST FOR EXPRESSIONS [IN "(...)",
+/TO ALLOW CHARACTERS IN THE EXPRESSIONS TO NOT BE
+/TAKEN AS COMMAND CHARACTERS] AND SINGLE & DOUBLE
+/QUOTES [THE FOLLOWING CHARACTER OR CHARACTERS ARE
+/LITERALS, NOT COMMANDS]. IF THE PARENS MATCH AND
+/THE QUOTES ARE FOLLOWED BY THE CORRECT NUMBER OF
+/CHARACTERS, THEN THE LAST CHARACTER WAS AN "ODT"
+/COMMAND TO BE EXECUTED SO RETURN TO CALL+1. OTHER-
+/WISE RETURN TO 'MAIN3' AS ABOVE.
+
+WCHEK, 0
+ JMS I GWORDI /COM BUF BEGIN WITH A WORD?
+ JMP WCHEK2 /NO, TEST FOR PARENS, ETC.
+WCHEK1, STA
+ TAD COMIR /YES, BACK UP COMIR
+ DCA COMIR
+ TAD TEMP /AND USE THE SPECIAL CHAR AS
+ JMP I .+1 / PART OF THE COMMAND STRING
+ RESPC+1
+/
+WCHEK2, STA
+ TAD COMOUT /SET UP ANOTHER A-XR
+ DCA DPNT
+ DCA CNT /RESET (OR SET) PAREN COUNT
+WCHEK3, TADIDP /GET A CHAR FROM COMM. BUFF.
+ JMS I SORTI / & GO TEST IT
+ WCKLST-1
+ WCKOPS-WCKLST
+ JMP WCHEK3 /NONE, CONTINUE SCAN
+/
+WCHEK4, TAD CNT /CR, DO PARENS MATCH?
+ SZA CLA
+ JMP WCHEK1 /NO, CONTINUE COMMAND INPUT
+ JMP I WCHEK /YES, INPUT IS DONE
+/
+WCHEK5, STA CLL RAL /SET TO -2
+ IAC /AC = +1 OR -1
+ TAD CNT / UPDATE PAREN COUNT
+ JMP WCHEK3-1 / & CONTINUE SCAN
+/
+WCHEK6, JMS WCHONE / ' -- 2 CHARACTERS
+ JMS WCHONE / " -- 1 CHARACTER
+ JMP WCHEK3 /OK, CONTINUE SCAN
+
+WCHONE, 0
+ TADIDP /GET NEXT CHAR
+ TAD M215 /IS IT A CR?
+ SNA CLA
+ JMP WCHEK1 /YES, DON'T EXECUTE SPECIAL
+ JMP I WCHONE /NO, OK
+\f/FPP INSTRUCTION DECODING SUPPORT SUBROUTINES
+
+GETOP, 0 /GET OP-CODE (BITS 0-3) TO BITS 9-11
+ TADICAD
+ AND N7000
+ CLL RTL
+ RTL
+ JMP I GETOP
+
+GET678, 0 /GET BITS 678 TO BITS 9-11
+ TADICAD
+ CLL RTR
+ RAR
+ AND N7
+ JMP I GET678
+
+MULT3, 0 /MULTIPLY AC BY THREE
+ DCA GETOP
+ TAD GETOP
+ CLL RAL
+ TAD GETOP /WORKS FOR POS OR NEG!
+ JMP I MULT3
+
+CONDIT, 0 /OUTPUT CONDITIONAL FPP INSTRUCTION
+ TAD I CONDIT /GET LEADING 1 OR 2 CHARS
+ ISZ CONDIT
+ JMS I TWOT / & OUTPUT THEM
+ JMS GET678 /GET CONDITION CODE
+ JMS I SYMTYI / AS INDEX TO TABLE
+ FPCOND
+ -1
+ JMP I CONDIT
+SYMTYI, SYMTYP
+
+FLDOUT, 0 /OUTPUT FIELD DIGIT & "*"
+ TADICAD
+ AND N7 /GET FIELD
+ JMS I RTL6I / TO BITS 3-5
+ JMS I TWOCI / & OUTPUT "F*"
+ 6052 / WHERE "F" IS DIGIT
+ JMP I FLDOUT
+
+
+
+ DECIMAL /SET RADIX TO DECIMAL
+
+TEMPL= . /ARGUMENT BUFFER
+ /L(TEMPL)=180(10)
+F0END= TEMPL+180
+ DMPHAN-F0END /(SHOW SPACE LEFT)
+
+ OCTAL
+
+PAGE /****** MUST BE NO LITERALS! ******
+
+DMPHAN= 06600 /DUMP HANDLER AREA, 2 FIELD 0 PAGES
+
+DEVHAN= 07200 /DEVICE HANDLER AREA, 2 FIELD 0 PGS
+
+
+IFNZRO DMPHAN-F0END&4000 <BADERR,__CAN'T RUN>
+
+/IF THE ABOVE ASSEMBLES, THE BUFFERS ARE OVER-
+/ RUNNING THE DUMP DEVICE HANDLER.
+
+
+*TEMPL /ADD INITIALIZATION CODE WHICH IS OVERLAID
+
+INIMSG, 0 /INITIALIZE ERROR MESSAGES ON SCRATCH BLKS
+ CDF 10
+ TAD I (7726 /BUT FIRST CHECK FOR "SCOPE MODE"
+ CDF 0
+ AND N200 / (BIT 4 OF 17726)
+ SNA CLA
+ JMP INIDAT / NOT SET, GO SET UP DATE
+INISCO, TAD I SPNT /SET, CHANGE RUBOUT HANDLER TO
+ SNA
+ JMP INIDAT / ERASE CHARACTERS FROM SCREEN
+ DCA I DPNT / AND FROM BUFFER (MUCH EASIER
+ JMP INISCO / THAN ON HARD COPY!)
+/
+INIDAT, CDF 10 /NOW INIT EXTENDED DATE
+ TAD I (7666 /GET SYSTEM DATE WORD
+ CDF 0
+ AND N7 /PICK OFF THIS YEAR PART
+ CIA
+ DCA YRTEST / AND SET TEST YEAR (NEG)
+ TAD I M1 /NOW GET EXTENDED YEAR BITS
+ AND (600 / FROM "B.I.P." WORD AND
+ CLL RTR / MOVE TO BITS 7,8 (*8)
+ RTR
+ TAD (106 /ADD TO A STARTING BASE OF 70[10]
+ CIA
+ TAD YRTEST /AND ADD THIS YEAR ALSO
+ CIA
+ DCA YRBASE /= 70 + EXTEND*8 + THIS YEAR
+ TAD I (7746 /GET JSW
+ AND (6777 /CLEAR BIT 2 (CAN RESTART!)
+ CLL RAR
+ STL RAL /SET BIT 11 (DON'T SAVE FIELD 1)
+ DCA I (7746 /& PUT IT BACK
+ JMS I (7607 /WRITE ERROR MESSAGES
+ 4610 / 6 PAGES, FIELD 1
+ 0 / FROM LOC 10000
+ 27 / NORMAL SAVE AREA!
+ SKP CLA
+ JMP I INIMSG /OK, JUST EXIT
+ TAD M200
+ DCA XERR3 /FAILED, ASSUME WRITE LOCKED
+ TAD (ERROR / SO NO ERROR MESSAGES ON
+ DCA ERC15 / ERROR OR "SHOW ERRORS"
+ JMP I INIMSG
+
+
+PAGE /LITERALS HERE ARE OK!
+\f/INITIALIZATION CODE--RESIDES IN BUFFER AREA AND IS WIPED
+/ OUT DURING EXECUTION. HANDLES CHAINED AND NORMAL STARTS.
+
+START, CLA SKP /NORMAL
+ STA /CHAINED (FROM CCL!)
+ DCA TEMP
+ CDF 10
+ DCA I (CCBB /ZAP CCB SWITCH
+ CDF 0
+ TAD N200
+ DCA I (7745 /RESET START ADDRESS
+ JMS INIMSG /INIT SCOPE, DATE & ERROR MESSAGES
+ JMS BATSET /TEST & SET UP FOR BATCH
+ ISZ TEMP /CHAINED?
+ JMP I (201 / NO, START IT UP!
+ CDF 10
+ TAD I M200 /YES, 1ST OUTPUT DEVICE?
+ CDF 0
+ AND (17 /(IGNORE LENGTH SPEC)
+ SNA
+ JMP STSWIT / NO, LEAVE AS SYS
+ DCA DEVNO /YES, SET DEVICE NUMBER
+ TAD DEVNO
+ CALUSR /NOW DO HANDLER FETCH BY
+ 1 / NUMBER (PAINTING?)
+STDEV, DEVHAN+1 /--2 PAGES--
+ JMP STERR /ARGGGG! FAILED!!!
+ TAD STDEV
+ DCA DEVAD /SET UP HANDLER ENTRY
+ TAD M200
+ DCA DPNT /SET UP FIELD 1 POINTER
+ TADIDP /GET NAME OF FILE
+ DCA NAM1
+ TADIDP
+ DCA NAM2
+ TADIDP
+ DCA NAM3
+ TADIDP /GET EXTENSION
+ DCA NAM4
+ TAD NAM1 /WAS THERE REALLY A NAME?
+ SZA CLA
+ STA / YES, SET NAME SWITCH
+ DCA TEMP / NO, RESET
+ CDF 10
+ DCA I (XDNAM /CLEAR DEVICE NAME WORDS
+ DCA I (XDNAM+1
+ TAD I DPNT /GET NEXT WORD & TEST FOR ZERO
+ SZA CLA
+ JMP STSWIT / SOMETHING NOT RIGHT!
+ TAD I DPNT /OK, ASSUME CCL CHAIN & SET
+ DCA I (XDNAM / UP DEVICE NAME
+ TAD I DPNT
+ DCA I (XDNAM+1
+ TAD I (XDNAM /EMPTY?
+ SZA CLA
+ JMP STSWIT
+ TAD (0423 /YES, MUST BE DEFAULT NAME--
+ DCA I (XDNAM / "DSK"
+ TAD (1300
+ DCA I (XDNAM+1
+STSWIT, CDF 10
+ TAD I (7643 /TEST SWITCHES
+ AND N200 / "/E"?
+ DCA ERMODE / 0= LONG, NON-0= SHORT
+ IAC
+ AND I (7643 / "/L"? [LOAD]
+ SNA CLA
+ JMP STSWO /NO, CHECK NEXT
+ TAD NAM4 /YES, SET DEFAULT EXTENSION
+ SNA
+ TAD (1404 / TO ".LD"
+ DCA NAM4
+ IAC
+ JMP STSWEX-2 / & GO SET MODE
+/
+STSWO, TAD I (7644
+ AND (1000 / "/O"? [OFFSET]
+ SNA CLA
+ JMP STSWS /NO, GO CHECK LAST
+ TAD I (7646 /YES, GET LOW 12 BITS OF
+ CIA / "=NNNN" AS OFFSET AND
+ DCA OFFSET / IT UP
+ STA
+ JMP STSWEX-1 / & GO SET MODE
+/
+STSWS, TAD I (7644 / "/S"? [SAVE]
+ AND (40
+ SNA CLA
+ JMP STSWEX /NO, WAS NOT ANY THAT COUNT
+ TAD NAM4 /YES, SET DEFAULT EXTENSION
+ SNA
+ TAD (2326 / TO ".SV"
+ DCA NAM4
+ IAC / & SET MODE
+ DCA MODSW /-1=OFF,0=NOR,+1=SV,+2=LD
+STSWEX, CDF 0
+ ISZ TEMP /FILE NAME SPECIFIED?
+ JMP I (201 / NO, JUST START
+ DCA CRSWT /YES, SET SWITCH TO CR,
+STTLS, TLS / START TTY *** BATCH OPER.
+ JMS I CRLFI / & DO CR/LF
+ TAD NAM4 /ANY EXTENSION SPECIFIED?
+ SNA CLA
+ STA / NO--ALLOW 3 TRIES: SV, LD, NULL
+ DCA TEMP1 / ELSE ALLOW ONLY 1 TRY
+ TAD NAM4 /IF NO EXTENSION SET YET,
+ SNA
+ TAD (2326 / SET TO START DEFAULTS WITH SV
+ DCA NAM4
+ JMP XFICHN /NOW GO DO FILE LOOKUP
+/
+STERR, TLS /START UP OUTPUT *** BATCH OPER.
+ JMP ERCY / & GIVE ERROR!
+
+
+PAGE
+\f/INITIALIZATION CODE FOR BATCH OPERATION
+
+BATSET, 0
+ TAD I M1 /TEST BIT 1 OF 07777 FOR "BIP"
+ RAL / (BATCH-IN-PROGRESS)
+ SMA CLA
+ JMP I BATSET / NO, INTERACTIVE MODE
+ TAD I M1 / YES, GET FIELD BITS OF BATCH
+ AND (70 / TO GENERATE A "CIF BAT"
+ TAD (CIF / AND SET UP 3 CALLS:
+ DCA CBATI / INPUT,
+ TAD CBATI
+ DCA CBATO / OUTPUT AND
+ TAD CBATI
+ DCA CBATE / ERROR.
+BATMOV, TAD I SCANX1 /GET NEXT STORAGE ADDRESS
+ SNA
+ JMP I BATSET / 0 = ALL DONE!
+ DCA DPNT /SET UP POINTER
+BATLUP, TAD I SCANX1 /GET A PATCH WORD
+ SNA
+ JMP BATMOV / 0 = GROUP END
+BATPAT, CDF 0 /CHANGED FOR "TYPEB"!!
+ DCA I DPNT /PATCH THE WORD
+ CDF 0
+ JMP BATLUP /DO IT AGAIN!
+
+
+/"SCOPE MODE" PATCHES FOR RUBOUT HANDLER. INITIAL-
+/ IZATION CODE FIRST CHECKS FOR SCOPE AND THEN FOR
+/ BATCH. THUS, IF BOTH ARE SET, FIRST THINGS WILL BE
+/ SET UP FOR SCOPE AND THEN THEY WILL BE RESET FOR
+/ BATCH. THIS SEQUENCE IS REQUIRED!
+
+SCOPLS, RELOC RUBO
+ JMS BTEST /BUFFER NOW EMPTY?
+ JMP RENEXT / YES, JUST IGNORE RUBOUT
+ STA
+ TAD COMIR /NO, BACK UP POINTER
+ DCA COMIR
+ TAD COMIR /SET UP POINTER FOR TESTING, ALSO
+ DCA COMOUT
+ JMS RUBO2 /OUTPUT BACKSPACE, SPACE, BACKSPACE
+ JMS I GETNI /GET RUBBED OUT CHAR AND TEST
+ TAD CHAR
+ TAD M240 / FOR A CONTROL CHAR
+ SPA CLA
+ JMS RUBO2 /YES, ERASE "^" ALSO!
+ JMP RENEXT /TRY FOR ANOTHER CHAR
+
+RUBO2, HLT /MUST BE NON-ZERO!!!
+ JMS I TYPEAI /OUTPUT A BACKSPACE,
+ "H-100 /(CTRL-H)
+ SPACE1 / SPACE,
+ JMS I TYPEAI / BACKSPACE SEQUENCE TO
+ "H-100 / CLEAR OFF SCREEN CHAR
+ JMP I RUBO2
+TYPEAI, TYPEA
+ 0
+
+ RELOC
+
+
+BATLS, /PATCHES--ADDRESS-1, CODE, 0 WITH EXTRA 0 FOR END.
+
+ RUBO-1 /==== INPUT PATCHES ====
+ RELOC RUBO
+ DCA CHAR /SAVE NEW CHAR INPUT
+ TAD CHAR /IS THIS A FORM-FEED?
+ TAD RM214
+ SNA
+ JMP RKEY+1 / YES, JUST IGNORE IT!
+ TAD R2 /NO, THEN IS IT A LINE-FEED?
+ SNA CLA
+ TAD RLAST / YES, WAS LAST A CARRIAGE-RETURN?
+ TAD M215
+ SZA CLA
+ TAD CHAR /NO TO ONE OR OTHER, USE CHAR.
+ DCA RLAST / YES TO BOTH, SET TO 0!
+ TAD RLAST /OK, WAS IT A CR-LF PAIR?
+ SNA CLA
+ JMP RKEY+1 / YES, JUST IGNORE LF!
+ JMP REKEY+1 / NO, GO USE THIS CHAR
+
+BATINI, 5400 /IN THE BATCH FIELD
+RM214, -214
+R2, 2
+RLAST, 215 /!!! CR OF ".R FUTIL" HAS AN LF !!
+ 0
+
+ RKEY+1-1
+ RELOC /TO PUT 'CBATI' ON THIS PAGE
+CBATI= .+1 /REALLY ON "CIF BAT"
+ RELOC RKEY+1
+ JMS I CTRLI /CHECK FOR CONTROL KEYS
+ CIF /*** CIF BAT
+ JMS I BATINI /GET A BATCH CHARACTER
+ERC17, ERROR /!!! EOF ON INPUT !!!
+ NOP /FILLER FOR INTERACTIVE CTRL-Q
+ NOP
+ 0
+
+ RKEY0-1
+ RELOC RKEY0
+ JMP RKEY+1 /IGNORE RUBOUT UNDER BATCH
+ NOP / & RETURN TO CALL+1!
+ 0
+
+ BCTRLC-1
+ RELOC BCTRLC
+ JMP I CTRLCI /CTRL-C, ABORT JOB STREAM!
+ 0
+
+ RELOC /==== OUTPUT PATCHES ====
+ 201-1
+ NOP
+ 0
+
+ STTLS-1
+ NOP /ZAP 3 "TLS"S USED FOR STARTUP
+ 0
+
+ STERR-1
+ NOP
+ 0
+
+ RELOC /==== ERROR PATCH ====
+
+ XERR4-1
+CBATE= . /REALLY ON "CIF BAT"
+ RELOC XERR4
+ CIF /*** CIF BAT
+ JMP I N7000 /ABORT TO BATCH FIELD!
+ 0
+
+ RELOC
+
+ BATPAT-1
+ CDF 10 /*** NEXT CODE IN FIELD 1 ***
+ 0
+
+ TYPEB-1
+ RELOC
+CBATO= .+1 /REALLY ON "CIF BAT"
+ IFDEF TYPEB </NO PASS1 ERROR!
+ RELOC TYPEB /*** REALLY IN FIELD 1 ***
+ >
+ CDF 10 /*** SET UP RETURN D.F.
+ CIF /*** CIF BAT
+ JMS I .+1 /OUTPUT A CHARACTER TO LOG
+ 7400 /BATOUT, IN THE BATCH FIELD
+ CDF 0 /*** RESET D.F.
+ 0
+
+ RELOC
+
+ 0
+
+
+PAGE
+
+FIELD 1 /THE END OF FIELD 0!
+\f*10000 /PUT A POINTER HERE!
+
+ NXTIOT /ADDR OF NEXT FREE SPACE IN TABLE
+
+
+/ERROR MESSAGES AND ADDRESS LIST. THESE ITEMS RESIDE
+/ UNDER THE USR, REQUIRING THAT THE USR SWAP THEM
+/ WHEN IT IS USED AND THAT THE PROGRAM KICK OUT THE
+/ USR WHEN AN ERROR OCCURS IN LONG ERROR MESSAGE MODE
+/ OR WHEN A "SHOW ERRORS" COMMAND IS GIVEN. IT IS
+/ TO THE ADVANTAGE OF DECTAPE (AND PROBABLY ALSO
+/ FLOPPY DISK) SYSTEMS TO USE SHORT ERROR MESSAGE
+/ MODE TO REDUCE USR SWAPPING IF DOING MANY "FILE"
+/ OR "SET DEVICE ...DDEV..." COMMANDS.
+
+*10002 /MESSAGE ADDRESS AT ERROR CODE NUMBER +1 (AUTO-XR)
+
+/LIST OF ADDRESSES OF ERROR MESSAGES
+
+ ERMSA
+ ERMSB
+ ERMSC
+ ERMS14
+ ERMSD
+ ERMSE
+ ERMSG
+ ERMSH
+ ERMSI
+ ERMSK
+ ERMSJ
+ ERMSXO
+ ERMSL
+ ERMSZ
+ ERMSO
+ ERMS11
+ ERMS04
+ ERMSP
+ ERMSQ
+ ERMSR
+ ERMS09
+ ERMS08
+ ERMS13
+ ERMSS
+ ERMST
+ ERMSU
+ ERMSV
+ ERMSW
+ ERMSX
+ ERMSY
+ ERMSM
+ ERMS00
+ ERMS01
+ ERMS02
+ ERMS03
+ ERMS10
+ ERMSF
+ ERMSGC
+ ERMSHD
+ ERMS05
+ ERMS07
+ ERMS18
+ ERMS19
+ ERMS20
+ ERMS15
+ ERMS16
+EMSEND, ERMS17
+ ERMS99
+
+
+/ERROR MESSAGES:
+
+ERMSA, TEXT &ILLEGAL SINGLE-WORD COMMAND&
+
+ERMSB, TEXT &ILLEGAL MULTI-WORD COMMAND&
+
+ERMSC, TEXT &TOO MANY ")"S&
+
+ERMSD, TEXT &ILLEGAL FORMAT WORD&
+
+ERMSE, TEXT &BAD FORMAT SYNTAX&
+
+ERMSF, TEXT &NO FILE FOR C.C.B./HEADER REQUEST&
+
+ERMSGC, TEXT &BAD C.C.B (NOT A SAVE FILE)&
+
+ERMSHD, TEXT &BAD HEADER (NOT A LOAD MODULE)&
+
+ERMSG, TEXT &ILLEGAL ITEM TO SHOW&
+
+ERMSH, TEXT &ILLEGAL SEARCH MODIFIER&
+
+ERMSI, TEXT &BAD SEARCH SYNTAX&
+
+ERMSJ, TEXT &ILLEGAL MODE&
+
+ERMSK, TEXT &SET OPTION FOLLOWED BY A CR, BAD SYNTAX&
+
+ERMSXO, TEXT &NUMBER OR ILLEGAL SET OPTION&
+
+ERMSL, TEXT &NUMBER OR ILLEGAL OUTPUT OPTION&
+
+ERMSM, TEXT &ILLEGAL "." IN NAME (FILE OR DEVICE)&
+
+ERMSO, TEXT &ILLEGAL MODIFY FORMAT&
+
+ERMSP, TEXT &PROGRAM OR HARDWARE PROBLEM&
+
+ERMSQ, TEXT &BAD TERMINATOR IN SINGLE ARGUMENT&
+
+ERMSR, TEXT &TERMINATOR BEFORE LEGAL NUMBER INPUT&
+
+ERMSS, TEXT &BAD TERMINATOR IN MULTIPLE ARGUMENT&
+
+ERMST, TEXT &ILLEGAL CHARACTER IN EXPRESSION&
+
+ERMSU, TEXT &ILLEGAL USE OF "(" IN EXPRESSION&
+
+ERMSV, TEXT &ILLEGAL OPERATOR IN EXPRESSION&
+
+ERMSW, TEXT &TOO FEW ")"S IN EXPRESSION&
+
+ERMSX, TEXT &DIVISION BY 0 ATTEMPTED&
+
+ERMSY, TEXT &UNKNOWN HANDLER NAME&
+
+ERMSZ, TEXT &NUMBER OR ILLEGAL ERROR OPTION&
+
+ERMS01, TEXT &NON-&
+ *.-1
+
+ERMS00, TEXT &FATAL READ ERROR&
+
+ERMS03, TEXT &NON-&
+ *.-1
+
+ERMS02, TEXT &FATAL WRITE ERROR&
+
+ERMS04, TEXT &ODD START LOC OR COUNT IN OS/8 MODIFY&
+
+ERMS05, TEXT &BAD ADDRESS/OVERLAY (ODT COMMANDS)&
+
+/ERMS06,
+
+ERMS07, TEXT &BAD ADDRESS/OVERLAY (MODIFY)&
+
+ERMS08, TEXT &ARGUMENT EXPRESSION NOT TERMINATED BY ")"&
+
+ERMS09, TEXT &ILLEGAL DIGIT&
+
+ERMS10, TEXT &DUMP HANDLER ERROR&
+
+ERMS11, TEXT &NUMBER OR ILLEGAL DMODE OPTION&
+
+/ERMS12,
+
+ERMS13, TEXT &ILLEGAL USE OF ' OR "&
+
+ERMS14, TEXT &MAPPED MODE--USE LIST, NOT DUMP&
+
+ERMS15, TEXT &NO ERROR MESSAGES&
+
+ERMS16, TEXT &INPUT ERROR ON MESSAGES&
+
+ERMS17, TEXT &EOF ON BATCH INPUT&
+
+ERMS18, TEXT &ENTER FAILED&
+
+ERMS19, TEXT &CLOSE FAILED&
+
+ERMS20, TEXT &DUMP FILE OVERRUN&
+
+ERMS99, TEXT &DEBUG&
+\f*12000 /BEGIN ABOVE THE USR AREA
+
+/GCCB & GHDR--ROUTINES TO READ IN THE FIRST BLOCK OF THE
+/ LAST FILE SPECIFIED BY THE LAST "FILE" COMMAND, ASSUM-
+/ ING THAT IT WAS A SAVE FILE OR LOAD MODULE, AND DO THE
+/ FEW CHECKS THAT ARE AVAILABLE TO TEST FOR A CCB (CORE-
+/ CONTROL-BLOCK) OR HEADER BLOCK BEFORE LETTING THE DATA
+/ BE USED FOR THE APPROPRIATE PURPOSE.
+
+GCCB, 0 /GET CORE-CONTROL-BLOCK
+ JMS CCBHDR /DO COMMON TEST & READ-IN
+ SMA CLA /1ST WORD (-# SEGS) NEG?
+ JMP GCCERR / NO, CAN'T BE CCB
+ TAD I (CCBB+3 /GET JOB STATUS WORD
+ AND (200 /OVERLAY BIT SET (LINK)?
+ SZA CLA / 0 = NO
+ TAD (CCBB+140-1 / 1 = YES, START ADDR-1
+ CDF 0
+ DCA I (OVLFLG /NO = 0; YES = ADDR-1
+ CDF 10
+ TAD I (CCBB+1 /2ND WORD A "CDF CIF X0"?
+ AND (7707
+ CIA
+ TAD GCCCDF
+ SZA CLA
+GCCERR, JMS ERROR1 /LOOKS BAD, JUST EXIT NOW!
+ ISZ GETSWX /LOOKS OK, 1ST TIME SINCE READ?
+ JMP GCCB2 /NO, DON'T CHANGE THINGS AGAIN
+ TAD (CCBB+140+3 /YES, POINT TO LENGTH WORDS
+GCCB1, DCA GHDR / TO CHANGE PAGES TO BLOCKS
+ TAD I GHDR /GET A WORD - PAGES
+ SNA
+ JMP GCCB2 / 0 = DONE
+ IAC /ROUND DOWN IN 2 STEPS FOR PDP-8
+ CLL RAR
+ DCA I GHDR /STORE A WORD - BLOCKS
+ TAD GHDR /UPDATE POINTER TO NEXT
+ TAD (4
+ JMP GCCB1
+/
+GCCB2, DCA GETSWX /BE SURE SWITCH STAYS CLEAR
+ TAD I SEGNI /GET -# SEGMENTS
+GCCCDF, CDF CIF 0
+ JMP I GCCB /OK, RETURN VALUE
+
+GHDR, 0 /GET HEADER BLOCK (FORTRAN IV)
+ TAD (3 /TO SET UP CCBB+6
+ JMS CCBHDR /DO COMMON TEST & READ-IN
+ TAD (-2 /1ST WORD MUST BE EXACTLY 2
+ SZA CLA
+ JMP HDRERR / NO, CAN'T BE A HEADER
+ ISZ GETSWX /1ST TIME THRU SINCE READ?
+ JMP GHDR1 / NO, DON'T CHANGE ANYTHING
+ DCA I (CCBB+47 /YES, BE SURE THESE WORDS
+ DCA I (CCBB+50 / ARE 0 FOR USERS
+ TAD I (CCBB+1 /GET START FIELD WORD
+ SNA
+ JMP HDRERR / SHOULD BE 1 THRU 7
+ CLL RTL /LOOKS OK, MOVE FIELD TO BITS
+ RAL / 6-8 TO HELP "SHOW HEAD"
+ DCA I (CCBB+1
+ TAD I (CCBB+1 /ARE THESE ONLY BITS SET?
+ AND (7707
+ SZA CLA
+ JMP HDRERR / NO, SOMETHING MUST BE BAD
+ TAD I (CCBB+3 /OK, TEST FIELD OF NEXT FREE
+ SNA
+ JMP HDRERR / SHOULD BE 1 THRU 7
+ AND (7770
+ SZA CLA
+HDRERR, JMS ERROR1
+GHDR1, DCA GETSWX /MAKE SURE THIS IS 0
+ CMA /AC NON-ZERO FOR OK
+ CDF CIF 0
+ JMP I GHDR /OK, BACK TO USER
+
+CCBHDR, 0
+ TAD (CCBB+3 /CCBB+6 FOR GHDR
+ CDF 0
+ DCA I (GETPNT /SET UP POINTER FOR 'GET'
+ TAD I (DEVAD /GET ADDR OF DEVICE
+ DCA DEVADX / HANDLER & SAVE HERE
+ TAD I (RBLK1 /GET START BLOCK NUMBER
+ SNA
+ERCF, JMS ERROR1 / NO FILE!!! GIVE ERROR
+ CDF 10
+ DCA GCCBLK /OK, SET UP 1ST BLOCK
+ TAD I SEGNI /IS SOMETHING IN MEMORY?
+ SZA
+ JMP I CCBHDR / YES, RETURN 1ST WORD
+ CIF 0
+ JMS I DEVADX /NO, READ 1ST BLOCK OF FILE
+ 0110 /READ; 1 PAGE; FIELD 1
+SEGNI, CCBB /BUFFER IS HERE
+GCCBLK, 0 /BLOCK NUMBER
+ JMP RDERX /...BAD NEWS...
+ STA
+ DCA GETSWX /OK, SET "JUST READ" SWITCH
+ TAD I SEGNI /AND GET 1ST WORD
+ JMP I CCBHDR
+/
+RDERX, CDF CIF 0 /RETURN TO FIELD 0
+ JMP I (RERROR / FOR READ ERROR
+
+DEVADX, 0
+GETSWX, 0
+
+
+MSMOD, TEXT " MOD"
+
+MSBAD, TEXT " BAD BLOCK"
+
+
+PAGE
+\f/CONTINUATION OF OUTPUT COMMANDS AND ROUTINES FROM FIELD 0
+
+/CONTINUATION OF 'SET' 'DDEV' HANDLER
+
+XDDEV1, DCA DDEVAD /SET UP HANDLER ADDRESS
+ TAD I (GDEV2
+ DCA DDEVNO / AND DEVICE NUMBER
+ CDF 10
+ TAD DDEVNO /LOOK AT DCW FOR SPECIFIED
+ TAD (7760-1 / DEVICE TO SEE IF FILE
+ DCA DDCWPT / STRUCTURED.
+ TAD I DDCWPT /BIT 0 = 1 FOR FILES
+ SMA CLA
+ TAD (212 / NO, LINE-AT-A-TIME
+ DCA DDEVS / YES, BLOCK-AT-A-TIME
+ TAD DMPADR /OK, INITIALIZE OUTPUT POINTER
+ DCA DMPPTR
+ DCA XOSIZ / AND ZERO BLOCK COUNTER
+ DCA DNAM / AND CLEAR ANY FILE NAME
+ IAC
+ DCA DMPBLK / AND SET BLOCK NUMBER TO 1
+ JMP XDDEV2 /LAST, GO SET UP NAME FOR OUTPUT
+
+
+/CONTINUATION OF EXECUTION OF 'OPEN' COMMAND
+
+XOPEN1, TAD (NAM1-1 /SET UP POINTER TO FIELD 0 FILE
+ DCA DPNT / NAME (NOTE: XR IN FIELD 1!!!)
+ TAD I DPNT /MOVE THE FILE NAME UP HERE
+ DCA DNAM
+ TAD I DPNT
+ DCA DNAM+1
+ TAD I DPNT
+ DCA DNAM+2
+ TAD I DPNT /GET THE EXTENSION PART
+ ISZ I (TEMP1 / WAS ANYTHING REALLY SPECIFIED?
+ JMP XOPEN2
+ CLA
+ TAD (0425 / NO, DEFAULT TO ".DU"
+XOPEN2, DCA DNAM+3
+ TAD XCLNAM /SET UP POINTER TO NAME FOR USR
+ DCA XOBLK
+ CDF 10 /SET UP RETURN FIELD
+ TAD I DDCWPT /CLEAR ANY OPEN FILE ON
+ AND (7770 / THIS DEVICE SO "OPEN"
+ DCA I DDCWPT / CAN BE DONE WHENEVER!
+ CIF 0 /SET UP SUBROUTINE FIELD
+ TAD DDEVNO /GET DUMP DEVICE NUMBER
+ JMS USEUSR / AND GO GET USR & CALL IT.
+ 3 /ENTER
+XOBLK, 0 /NAME POINTER, BECOMES START BLK
+XOSIZ, 0 / BECOMES -# BLOCKS CAN USE
+ERC18, JMS ERROR1 /THE ENTER FAILED!
+ TAD XOBLK /OK! SET UP FILE START BLOCK
+ DCA DMPBLK
+ TAD DMPADR /INITIALIZE POINTER
+ DCA DMPPTR
+XOCEX, CDF CIF 0
+ JMP MAIN1 /TRY NEXT COMMAND
+
+DDEVAD, 7607 /INIT ADDRESS TO "SYS:" (SEE ABOVE)
+DDEVNO, 1 /INIT THIS TO "SYS:" ALSO.
+DDCWPT, 7760 / THIS ALSO
+
+DNAM, 0 /DUMP FILE NAME, INIT TO NULL
+ 0
+ 0
+ 0 /(EXTENSION HERE)
+
+
+/CONTINUATION OF EXECUTION OF 'CLOSE' COMMAND
+
+XCLOS1, TAD DNAM /IS ANY FILE OPEN?
+ SNA CLA
+ JMP XOCEX / NO, IGNORE COMMAND
+ TAD XCTLZ / YES, OUTPUT A CTRL-Z
+ JMS DMPOUT / AND FILL TO END
+XCTLZ, "Z-100
+ TAD XOBLK /OK, CALCULATE FILE SIZE
+ CIA
+ TAD DMPBLK /= NEXT - START
+ DCA XCLSIZ /= FILE SIZE IN BLOCKS
+ TAD DDEVNO /GET DUMP DEVICE NUMBER
+ CIF 0
+ JMS USEUSR /GET USR AND CALL IT
+ 4 /CLOSE
+XCLNAM, DNAM /POINTER TO FILE NAME
+XCLSIZ, 0 /SIZE OF NEW FILE
+ERC19, JMS ERROR1 /OH NO! CLOSE FAILED!
+ DCA DNAM /OK, ZAP KNOWLEDGE OF FILE
+ JMP XOCEX
+
+
+DMPOUT, 0 /DUMP FILE CHARACTER OUTPUT ROUTINE
+ DCA DMPCHR /SAVE THE CHARACTER
+ TAD DMPCHR /PUT IT INTO FILE BUFFER
+ CDF 10 /(MUST BE SURE!)
+DMPNUL, DCA I DMPPTR /INSERT AN 8 BIT CHAR
+ ISZ DMPPTR
+ TAD DMPPTR /NOW AT END OF BUFFER?
+ TAD (-DMPBUF-400
+ SNA CLA
+ JMP DMPIT / YES, DUMP BUFFER NOW
+ TAD DMPCHR /NO, FILL FOLLOWING THIS CHAR?
+ CIA
+ TAD I DMPOUT /(THE TEST CHAR @ CALL+1)
+ SNA CLA
+ JMP DMPNUL / YES, FILL WITH NULLS!
+ JMP I DMPOUT / NO, EXECUTE FILL CHAR
+/
+DMPIT, CIF 0
+ JMS I DDEVAD /CALL DUMP FILE HANDLER
+ 4210 /WRITE, 2 PAGES, FIELD 1
+DMPADR, DMPBUF
+DMPBLK, 1 /BLOCK NUMBER
+ERC10, JMS ERROR1 /ERROR ON OUTPUT FILE!
+ TAD DMPADR /NOW RESET OUTPUT POINTER
+ DCA DMPPTR
+ ISZ DMPBLK /INCREMENT BLOCK NUMBER
+ ISZ XOSIZ /ANY MORE SPACE LEFT?
+ JMP I DMPOUT / YES, EXIT NOW
+ DCA DNAM / NO! ZAP DUMP FILE
+ERC20, JMS ERROR1 / AND DIE!
+DMPCHR, 0
+DMPPTR, 0 /CHARACTER OUTPUT POINTER
+
+
+PAGE
+\f/CONTINUATION OF ROUTINE TO OUTPUT A CHAR TO A DEVICE
+
+TYPE1, TAD I (DMODE /TTY= NONE, PART&-DSWIT, ALL
+ AND I (DSWIT / SO TEST FOR PART&DSWIT
+ SZA CLA
+ JMP TYPE2 /NO OUTPUT TO TTY
+ TAD I (RTL6 /GET CHARACTER TO OUTPUT
+TYPEB, NOP /*** CDF 10 /*** BATCH
+ TSF /*** CIF BAT /*** CHANGES
+ JMP .-1 /*** JMS I .+1 /*** LOG
+ TLS /*** 7400 /*** OUTPUT
+ CLA /*** CDF 0
+TYPE2, STL CLA RAR /=4000 (SET AC BIT 0 FOR TEST)
+ TAD I (DSWIT /=4000 OR 4001 (DSWIT=1)
+ AND I (DMODE /FILE= PART&DSWIT OR ALL
+ SNA CLA
+ JMP TYPE3 / OUTPUT TO TTY ONLY
+ TAD DDEVS /FILE STRUCTURED OUTPUT?
+ CDF 10
+ SNA
+ TAD I (DNAM / YES, FILE OPEN?
+ CDF 0
+ SNA CLA
+ JMP TYPE3 / NO TO EITHER
+ TAD I (RTL6 /OK, GET CHARACTER TO OUTPUT
+ JMS DMPOUT /OUTPUT IT & TEST FOR END
+DDEVS, 0 /TEST: 0=FILE, 212= NON-FILE
+TYPE3, CDF CIF 0
+ JMP TYPEX /BACK AND OUT
+
+
+ERROR1, 0 /FIELD 1 ERROR ROUTINE HEAD
+ CLA /CLEAR POSSIBLE JUNK IN AC
+ TAD ERROR1 /MOVE RETURN ADDR TO FIELD 0
+ CDF CIF 0
+ DCA I (XERROR
+ JMP I (XERROR+1
+
+
+XDDEV2, CDF 0 /NAME IS OVER THERE
+ TAD I (NAM1 /MOVE DEVICE NAME INTO STRING
+ DCA XDDNAM / IN THIS FIELD FOR "SHOW DDEV"
+ TAD I (NAM2
+ DCA XDDNAM+1
+ CDF CIF 0
+ JMP XSETN /BACK TO 'SET'
+
+MSDDEV, TEXT "@DDEV = SYS@"
+XDDNAM= .-3
+
+MSDEV, TEXT "@DEVICE = SYS@"
+
+XDNAM= .-3 /ADDR OF 1ST WORD OF DEVICE NAME
+
+/CONTINUATION OF CODE FROM FIELD 0
+
+XDEVM, DCA XDNAM /SET 4 DEVICE NAME CHARS IN
+ TAD I (NAM2 / OUTPUT MESSAGE
+ DCA XDNAM+1
+ CDF 10
+ DCA I (CCBB /NO C.C.B. OR HEADER PRESENT
+ CDF CIF 0
+ STA
+ DCA I (RBLK /RESET BLOCK NUMBER
+ JMP XSETN /GO DO NEXT OPTION
+
+
+MSERR, TEXT " ERROR CODES: FUTIL "
+ *.-1
+
+/VERSION NUMBER MESSAGE--THE FOLLOWING CODE INSERTS THE
+/ VERSION NUMBER AND PATCH LEVEL SET NEAR THE START OF
+/ THE SOURCE INTO THE VERSION MESSAGE.
+
+MSVER, TEXT "VERSION = ???" /VERS = 2 DIGITS, PATCH = 1
+ *.-2
+VERTEN= VERSION%12 /TENS DIGIT
+VERONE= -VERTEN^12+VERSION /ONES DIGIT
+ VERTEN^100+VERONE+6060 /INSERT TWO DIGITS
+ PATCH^100 /INSERT PATCH + NULL TERM
+
+/ALPHA MONTH NAMES PLUS DUMMIES FOR PDATE SUBROUTINE
+
+MONTHS, TEXT " 00@JAN@FEB@MAR@APR@MAY@JUN@JUL"
+ TEXT "AUG@SEP@OCT@NOV@DEC@ 13@ 14@ 15"
+
+
+PAGE
+\f/SYMBOLICS FOR PDP-8 INSTRUCTIONS:
+INSLST, TEXT "AND TAD ISZ DCA JMS JMP IOT NOP "
+ *.-1
+
+/ GROUP 1 MICRO-INSTS.:
+OP1LST, TEXT "CLL CMA CML IAC BSW RAL RTL RAR RTR "
+ *.-1
+
+
+/ GROUP 2 MICRO-INST'S:
+OP2LST, TEXT "SMA SZA SNL SKP SPA SNA SZL OSR HLT "
+ *.-1
+
+/ EAE MICRO-INST'S:
+EAELST, TEXT "MQA MQL SCL MUY DVI NMI SHL ASR LSR SCA "
+ *.-1
+ TEXT "DAD DST SWBADPSZDPICDCM SAM "
+ *.-1
+
+CLANAM, 0314 /"CLA "
+ 0140
+
+OPRMES, 1720 /"OPR "
+ 2240
+\f/ IOT INSTRUCTIONS:
+
+IOTTAB, 6000
+ TEXT "SKON"
+ 6001
+ TEXT "ION@"
+ 6002
+ TEXT "IOF@"
+ 6003
+ TEXT "SRQ@"
+ 6004
+ TEXT "GTF@"
+ 6005
+ TEXT "RTF@"
+ 6006
+ TEXT "SGT@"
+ 6007
+ TEXT "CAF@"
+ 6010
+ TEXT "RPE@"
+ 6011
+ TEXT "RSF@"
+ 6012
+ TEXT "RRB@"
+ 6014
+ TEXT "RCF@"
+ 6016
+ TEXT "RCC@"
+ 6020
+ TEXT "PCE@"
+ 6021
+ TEXT "PSF@"
+ 6022
+ TEXT "PCF@"
+ 6024
+ TEXT "PPC@"
+ 6026
+ TEXT "PLS@"
+ 6030
+ TEXT "KCF@"
+ 6031
+ TEXT "KSF@"
+ 6032
+ TEXT "KCC@"
+ 6034
+ TEXT "KRS@"
+ 6035
+ TEXT "KIE@"
+ 6036
+ TEXT "KRB@"
+ 6040
+ TEXT "TFL@"
+ 6041
+ TEXT "TSF@"
+ 6042
+ TEXT "TCF@"
+ 6044
+ TEXT "TPC@"
+ 6045
+ TEXT "TSK@"
+ 6046
+ TEXT "TLS@"
+ 6100
+ TEXT "DPI@"
+ 6101
+ TEXT "SMP@"
+ 6102
+ TEXT "SPL@"
+ 6103
+ TEXT "EPI@"
+ 6104
+ TEXT "CMP@"
+ 6105
+ TEXT "S,CMP"
+ 6106
+ TEXT "CEP@"
+ 6107
+ TEXT "SPO@"
+ 6110
+ TEXT "RCTV"
+ 6111
+ TEXT "RCRL"
+ 6112
+ TEXT "RCRH"
+ 6113
+ TEXT "RCCV"
+ 6114
+ TEXT "RCGB"
+ 6115
+ TEXT "RCLC"
+ 6116
+ TEXT "RCCB"
+ 6130
+ TEXT "CLZE"
+ 6131
+ TEXT "CLSK"
+ 6132
+ TEXT "CLOE"
+ 6133
+ TEXT "CLAB"
+ 6134
+ TEXT "CLEN"
+ 6135
+ TEXT "CLSA"
+ 6136
+ TEXT "CLBA"
+ 6137
+ TEXT "CLCA"
+ 6201
+ TEXT "CDF 00"
+ *.-1
+ 6211
+ TEXT "CDF 10"
+ *.-1
+ 6221
+ TEXT "CDF 20"
+ *.-1
+ 6231
+ TEXT "CDF 30"
+ *.-1
+ 6241
+ TEXT "CDF 40"
+ *.-1
+ 6251
+ TEXT "CDF 50"
+ *.-1
+ 6261
+ TEXT "CDF 60"
+ *.-1
+ 6271
+ TEXT "CDF 70"
+ *.-1
+ 6202
+ TEXT "CIF 00"
+ *.-1
+ 6212
+ TEXT "CIF 10"
+ *.-1
+ 6222
+ TEXT "CIF 20"
+ *.-1
+ 6232
+ TEXT "CIF 30"
+ *.-1
+ 6242
+ TEXT "CIF 40"
+ *.-1
+ 6252
+ TEXT "CIF 50"
+ *.-1
+ 6262
+ TEXT "CIF 60"
+ *.-1
+ 6272
+ TEXT "CIF 70"
+ *.-1
+ 6203
+ TEXT "CDIF00"
+ *.-1
+ 6213
+ TEXT "CDIF10"
+ *.-1
+ 6223
+ TEXT "CDIF20"
+ *.-1
+ 6233
+ TEXT "CDIF30"
+ *.-1
+ 6243
+ TEXT "CDIF40"
+ *.-1
+ 6253
+ TEXT "CDIF50"
+ *.-1
+ 6263
+ TEXT "CDIF60"
+ *.-1
+ 6273
+ TEXT "CDIF70"
+ *.-1
+ 6204
+ TEXT "CINT"
+ 6214
+ TEXT "RDF@"
+ 6224
+ TEXT "RIF@"
+ 6234
+ TEXT "RIB@"
+ 6244
+ TEXT "RMF@"
+ 6254
+ TEXT "SINT"
+ 6264
+ TEXT "CUF@"
+ 6274
+ TEXT "SUF@"
+ 6550
+ TEXT "FFST"
+ 6551
+ TEXT "FPINT"
+ 6552
+ TEXT "FPICL"
+ 6553
+ TEXT "FPCOM"
+ 6554
+ TEXT "FPHLT"
+ 6555
+ TEXT "FPST"
+ 6556
+ TEXT "FPRST"
+ 6557
+ TEXT "FPIST"
+ 6561
+ TEXT "FMODE"
+ 6563
+ TEXT "FMRB"
+ 6564
+ TEXT "FMRP"
+ 6565
+ TEXT "FMDO"
+ 6567
+ TEXT "FPEP"
+
+
+NXTIOT, ZBLOCK 200 /LEAVE ROOM FOR EXPANSION
+
+ 0 /TABLE TERMINATOR
+
+
+/CODES MAY BE ADDED TO THE TABLE IN THE SPACE LEFT BY THE
+/ "ZBLOCK 200". SINCE EACH ENTRY REQUIRES 4 WORDS (THE
+/ ACTUAL CODE IN THE FIRST WORD AND UP TO 6 PACKED ASCII
+/ CHARACTERS IN THE NEXT THREE WORDS, PADDED WITH TRAIL-
+/ ING 0'S), THERE IS ROOM FOR 40 OCTAL (32 DECIMAL) IOTS
+/ AND THEIR NAMES. THESE CAN BE PATCHED IN DIRECTLY
+/ USING THE PROGRAM ITSELF. **** NOTE THAT THE CONTENTS
+/ OF LOCATION 10000 POINT TO THE FIRST FREE ENTRY. ****
+\f/SYMBOLICS FOR FPP-12/8A INSTRUCTIONS
+
+MSBASE, TEXT " B+"
+
+MSINDI, TEXT "% B+"
+
+MSJNX, TEXT "JNX "
+
+/THE FOLLOWING STRINGS ARE PADDED WITH "@"S IN PROPER
+/ PLACES TO FORCE WORD ALIGNMENT AS NEEDED.
+
+ TEXT "LEA@" /+1 WORD 0000
+FPPINS, TEXT "FLDA@@FADD@@FSUB@@FDIV"
+ TEXT "FMUL@@FADDM@FSTA@@FMULM"
+
+ TEXT "UNUSEDSTARTE"
+ *.-1
+FPOP00, TEXT "FNOP@@FEXIT@FPAUSEFCLA@@FNEG"
+ TEXT "FNORM@STARTFSTARTDJAC@@"
+
+FPXR1S, TEXT "ALN ATX XTA "
+
+FPXR2S, TEXT "ADDX *,@LDX *,@"
+
+FOP134, TEXT "TRAP4 TRAP3 SETX SETB JSA @JSR "
+
+FPCOND, TEXT "EQGELEA@NELTGTAL"
+
+
+/CONTROL TABLES FOR FPP INSTRUCTION DECODING
+
+FPPMO0, 7 /MAJOR SUB-OP-CODE OF SPECIALS
+ 6
+ 5
+ 4
+ 3
+ 2
+ 1
+ 0 /END & FALL-OUT POINT
+
+FPPMOJ, SPCOP7
+ SPCOP6
+ SPCOP5
+ SPCOP4
+ SPCOP3
+ SPCOP2
+ SPCOP1
+
+FPPOP0, 170 /MINOR SUB-OP-CODE OF SUB-OP-CODE
+ 160 / 0 SPECIALS
+ 150
+ 140
+ 130
+ 120
+ 110
+ 100
+ 70
+ 60
+ 50
+ 40
+ 30
+ 20
+ 10
+ 00
+
+FPPOPJ, SPNUSE /ALL UNUSED POSSIBILITIES
+ SPNUSE
+ SPNUSE
+ SPNUSE
+ SPNUSE
+ SPNUSE
+ SPOP11
+ SPOP10
+ SPNUSE
+ SPNUSE
+ SPOP05
+ SPOP04
+ SPO123
+ SPO123
+ SPO123
+\f/MESSAGES:
+
+MS01, TEXT " = "
+
+MS07, 0023 /"SMASK = "
+MS02, TEXT "MASK = "
+
+MS03, TEXT "ABS. LOC = "
+
+MS04, TEXT "UPPER = "
+
+MS05, TEXT "LOWER = "
+
+MS06, TEXT "FORMAT = "
+
+MS08, TEXT "DIRECTORY"
+
+MS09, TEXT "OFFSET = "
+
+MS10, TEXT "MODE = "
+
+MS11, TEXT "CCB:"
+
+MS12, TEXT "ODT LOC = "
+
+MS13, TEXT ": "
+
+MS14, TEXT " CORE SEGS: "
+
+MS15, TEXT "LOOKUP FAILED"
+
+MS16, TEXT "FPP"
+
+MS17, TEXT " AT "
+
+MS18, TEXT " SA = "
+
+MS19, TEXT ", JSW = "
+
+MS20, TEXT "REL. LOC = "
+
+MS21, TEXT "PACKED"
+
+MS22, TEXT "ASCII"
+
+MS23, TEXT "OS/8"
+
+MS24, 2516 /"UNSIGNED"
+
+MS25, TEXT "SIGNED"
+
+MS26, TEXT "OCTAL"
+
+MS27, TEXT "OFFSET"
+
+MS28, TEXT "SAVE"
+
+MS29, TEXT "NORMAL"
+
+MS30, TEXT "OUTPUT = "
+
+MS31, TEXT "PDP"
+
+MS32, TEXT "BLOCK = "
+
+MS33, TEXT ") "
+
+MS34, TEXT "LOAD"
+
+MS35, TEXT "BCD"
+
+MS36, TEXT "BYTE"
+
+MS37, TEXT "FILLER = "
+
+MS38, TEXT "HEADER:"
+
+MS39, TEXT ", NEXT WORD = "
+
+MS40, TEXT ", LOAD V "
+
+MS41, TEXT ", E.P. REQ'D"
+
+MS42, TEXT " OVLYS START BLOCK LENGTH"
+
+MS43, TEXT "XS240"
+\f/MAIN LOOP CHARACTER LIST
+CCHARL, "#
+ "$
+ "%
+ "&
+ ":
+ "<
+ "=
+ ">
+ "?
+ "@
+ "[
+ "\
+ "]
+ "/
+ "!
+ "+
+ "-
+ ";
+ "^
+ "_
+/'TYPE' COMMAND LIST
+TYPEL, 211 /TAB
+ 233 /ALT MODES
+ 375
+ 376
+/'XMODIF' CHECK LIST
+TYPEM, 215 /CR
+ 212 /LF
+ 0
+
+/ADDRESSES FOR 'OMODES'
+OTABLE, BPRT /#
+ OSTYPE /$
+ BYTEO /%
+ XS240O /&
+ SGNDP /:
+ OPRT /<
+ DPRT /=
+ PDPOUT />
+ DIROUT /?
+ PDATE /@
+ ASCII /[
+ FPPOUT /\
+ PACOUT /]
+
+/MAIN LOOP JUMP LIST - RESPOND TO SPECIAL CHAR
+COPSL, OMODES
+ OMODES
+ OMODES
+ OMODES
+ OMODES
+ OMODES
+ OMODES /SEE ABOVE LIST
+ OMODES
+ OMODES
+ OMODES
+ OMODES
+ OMODES
+ OMODES
+ SLASH
+ EXCL
+ PLUS
+ MINUS
+ SEMIC
+ UPARR
+ BACKAR
+ RESPC
+ ALTMOD
+ ALTMOD
+ ALTMOD
+ CRCR
+ LFLF
+
+/'TYPE' JUMP LIST
+TYPEOP, TYPTAB
+ TYPALT
+ TYPALT
+ TYPALT
+ TYPCR
+ TYPCR+1
+
+/COMMAND WORD LIST FOR COMMANDS NOT FOLLOWED BY CR
+CWORDL, TEXT "EVE@DUD@LIL@FIF@OPSCSTSMWOW@MOM@SHSES@WRIFEXCOC@"
+
+/MAIN LOOP JUMP LIST - EXECUTE A COMMAND
+WOPSL, XVAL
+ XVAL
+ XDUMP
+ XDUMP
+ XLIST0
+ XLIST0
+ XFILE
+ XFILE
+ XOPEN
+ XSCAN
+ XSTRIN
+ XSMASK
+ XWORD
+ XWORD
+ XMODIF
+ XMODIF
+ XSHOW
+ XSET
+ XSET
+ XWRARG
+ XIF
+ XEXIT
+ MAIN1 /COMMENT
+ MAIN1
+
+/LISTS FOR COMMANDS FOLLOWED BY A CR.
+CWORL2, TEXT "REWRENEXCLCOC@"
+
+WOPSLL, XREWIN /REWIND
+ XWRITE /WRITE
+ MAIN1 /END
+ XEXIT /EXIT
+ XCLOSE /CLOSE
+ MAIN1 /COMMENT
+ MAIN1
+\f/'XFORM' LISTS ----ORDER IS CRITICAL----
+FORML, TEXT "PAP@ASA@OSOSXSX@UNU@SIS@OCO@BCB@BYBYPDPDFPF@DID@"
+
+FOPSL, XFCHR /PACKED (ASCII)
+ XFCHR
+ XFCHR /ASCII
+ XFCHR
+ XFCHR /OS/8 (ASCII, PACKED)
+ XFCHR
+ XFCHR /XS240 (ASCII, PACKED)
+ XFCHR
+ XFNUM /UNSIGNED (DECIMAL)
+ XFNUM
+ XFNUM /SIGNED (DECIMAL)
+ XFNUM
+ XFNUM /OCTAL
+ XFNUM
+ XFNUM /BCD
+ XFNUM
+ XFNUM /BYTE (OCTAL)
+ XFNUM
+ XFSYM /PDP (SYMBOLIC)
+ XFSYM
+ XFSYM /FPP (SYMBOLIC)
+ XFSYM
+ XFSYM /DIRECTORY
+ XFSYM
+
+/ ROUTINE ADDRESS LIST
+
+FTABLE, PACOUT
+ ASCII
+ OSTYPE
+ XS240O
+ DPRT
+ SGNDP
+ OPRT
+ BPRT
+ BYTEO
+ PDPDMP
+ FPPDMP
+ DIRDMP
+
+/'XSHFMT' DESCRIPTOR ADDRESS LIST
+FMTLS, MS21 /PACKED ASCII
+ MS22 /ASCII
+ MS23 /OS/8 ASCII
+ MS43 /XS240 ASCII
+ MS24 /UNSIGNED DECIMAL
+ MS25 /SIGNED DECIMAL
+ MS26 /OCTAL
+ MS35 /BCD
+ MS36 /BYTE
+ MS31 /PDP SYMBOLIC
+ MS16 /FPP SYMBOLIC
+ MS08 /DIRECTORY
+
+
+/'XMODIF' COMMAND LIST
+MODIFL, TEXT "PAP@ASA@OSXSNUN@"
+
+/'XMODIF' JUMP LIST
+MODIFO, XPAC0 /PACKED
+ XPAC0
+ XASC1 /ASCII
+ XASC1
+ XOPS1 /OS/8
+ XXS20 /XS240
+ XNUM2 /NUMERIC
+ XNUM2
+
+MODADS, XMOD0 /MODIFL TEST LIST
+ XMOD0
+ XMOD0
+ XMOD0
+ XMOD0
+ XMOD0
+ XMOD0
+ XMOD0
+ XMOD0
+
+MODDLS, TEXT "PAASOSXSNUNUNUNUNUNUNUNU" /DEFAULT LIST
+
+/'XMODIF' CHARACTER JUMP LIST
+MCHARO, XMODCR /CR, END
+ RENEXT /LF, IGNORE
+
+/'XIF' CHARACTER JUMP LIST
+IFSKPO, XIFCR /CR, END OF LINE
+ RENEXT /LF, IGNORE
+
+/XNUM JUMP LIST
+NUMOPS, XNUM1 /,
+ ERCQ /:
+ ERCQ /.
+ XNUM1+1 /SPACE
+ XNUM3 /CR
+\f/'XSHOW' COMMAND LIST
+SHOWL, TEXT "BLB@ODCCC@HEH@ABA@RER@SMVE"
+ *.-1
+/'XSET' COMMAND LIST
+SETLST, TEXT "DDFOF@OUO@ERE@OFUPLOTEDEDMMOFIMAM@
+
+/'XSHOW' JUMP LIST
+SHOWOP, XSHBLK /BLOCK
+ XSHBLK
+ XSHODL /ODT LOC
+ XSHCCB /CCB (CORE CONTROL BLOCK)
+ XSHCCB
+ XSHHDR /HEADER (F4 LOAD MODULE)
+ XSHHDR
+ XSHABS /ABS. LOC
+ XSHABS
+ XSHREL /REL. LOC
+ XSHREL
+ XSHSMS /SMASK
+ XSHVER /VERSION
+ XSHDDEV /DDEV
+ XSHFMT /FORMAT
+ XSHFMT
+ XSHOUT /OUTPUT
+ XSHOUT
+ XSHERR /ERRORS
+ XSHERR
+ XSHOFF /OFFSET
+ XSHUPP /UPPER
+ XSHLOW /LOWER
+ ERCG /TEMP--NOT ALLOWED FOR SHOW
+ XSHDEV /DEVICE
+ ERCG /DMODE--NOT ALLOWED FOR SHOW
+ XSHMOD /MODE
+ XSHFIL /FILLER
+ XSHMSK /MASK
+ XSHMSK
+
+/'XSET' JUMP LIST
+SETJMP, XDDEV /DDEV (DUMP DEVICE)
+ XFORM /FORMAT
+ XFORM
+ XOUTS /OUTPUT
+ XOUTS
+ XEMODE /ERROR (MODE)
+ XEMODE
+ XOFFS /OFFSET
+ XUPP /UPPER
+ XLOW /LOWER
+ XTEMP /TEMP
+ XDEV /DEVICE
+ XDMODE /DMODE (DUMP MODE)
+ XMODE /MODE
+ XFILL /FILLER
+ XMASK /MASK
+ XMASK
+
+/'XEMODE' COMMAND LIST
+XELST, TEXT "SHS@LOL@"
+
+/'XEMODE' BRANCH LIST
+XEOPS, XEMOD1 /SHORT
+ XEMOD1
+ XEMOD1+1 /LONG
+ XEMOD1+1
+
+/'XOUTS' LISTS
+XOLST, TEXT "FPF@PDP@OCO@"
+
+XOOPS, XOUTS1-1 /FPP SYMBOLIC
+ XOUTS1-1
+ XOUTS1 /PDP SYMBOLIC
+ XOUTS1
+ XOUTS1+1 /OCTAL
+ XOUTS1+1
+
+/'XMODE' COMMAND LIST
+MODLST, TEXT "OFO@SAS@LOL@NON@"
+
+/'XMODE' JUMP LIST
+MODOPS, XMODS-1 /OFFSET
+ XMODS-1
+ XMODS+1 /SAVE FILE
+ XMODS+1
+ XMODS /LOAD MODULE
+ XMODS
+ XMODS+2 /NORMAL
+ XMODS+2
+
+/'XDMODE' LISTS
+XDMLST, TEXT "ALPANO"
+
+XDMOPS, XDMODS-1 /ALL
+ XDMODS /PART
+ XDMODS+1 /NONE
+
+
+/LIST OF DESCRIPTOR ADDRESSES FOR "SHOW MODE"
+
+ MS27 /-1 = "OFFSET"
+MODELS, MS29 / 0 = "NORMAL"
+ MS28 /+1 = "SAVE"
+ MS34 /+2 = "LOAD"
+
+
+/LIST OF DESCRIPTOR ADDRESSES FOR "SHOW OUTPUT"
+
+ MS16 /-1 = "FPP (SYMBOLIC)"
+OUTLS, MS26 / 0 = "OCTAL"
+ MS31 /+1 = "PDP (SYMBOLIC)"
+
+
+/'XWORD' COMMAND LIST
+XWORCL, TEXT "UNU@"
+ *.-1
+/'XSTRIN' COMMAND LIST
+STRLST, TEXT "FRF@TOT@ABA@MAM@ME"
+
+
+/'XWORD' JUMP LIST
+XWOROP, XWOR2 /UNEQUAL
+ XWOR2
+ XWSFRM /FROM
+ XWSFRM
+ XWSTO /TO
+ XWSTO
+ XWSABS /ABSOLUTE
+ XWSABS
+ ERCH /MASKED--NO!
+ XWOR7 /MEMREF
+ XWOR7
+
+/'XSTRIN' JUMP LIST
+STROPS, XWSFRM /FROM
+ XWSFRM
+ XWSTO /TO
+ XWSTO
+ XWSABS /ABSOLUTE
+ XWSABS
+ XSTR0 /MASKED
+ XSTR0
+ ERCH /MEMREF--NO!
+\f/LIST OF TERMINATORS, IN ORDER, FOR 'EVAL'
+TERMS, "! /1
+ "& /2
+ "+ /3
+ "- /4
+ "/ /5
+ "* /6
+ "( /7
+ ") /10
+ 215 /CR: 11
+ 0
+
+/'GWORD' & 'ACCEPT' COMMAND LISTS
+GWLST1, "9
+ "8
+ "7
+ "6
+ "5
+ "4
+ "3
+ "2
+ "1
+ "0
+ 204 /^D
+ 213 /^K
+ ""
+ "'
+ "(
+GWLST2, 240 /SPACE
+ 215 /CR
+ 0
+
+/'GWORD' JUMP LISTS
+GWOPS1, GWD4 / 9 - A NUMBER
+ GWD4 / 8 - A NUMBER
+ GWD4 / 7 - A NUMBER
+ GWD4 / 6 - A NUMBER
+ GWD4 / 5 - A NUMBER
+ GWD4 / 4 - A NUMBER
+ GWD4 / 3 - A NUMBER
+ GWD4 / 2 - A NUMBER
+ GWD4 / 1 - A NUMBER
+ GWD4 / 0 - A NUMBER
+ GWD4 /^D - A NUMBER
+ GWD4 /^K - A NUMBER
+ GWD4 / " - A NUMBER
+ GWD4 / ' - A NUMBER
+ GWD4 / ( - A NUMBER
+GWOPS2, GWD2 /SPACE - TERMINATOR
+ GWD3 / CR - "
+
+/'ACCEPT' JUMP LIST
+ACOPS, ACCNUM / 9 - A DIGIT
+ ACCNUM / 8 - A DIGIT
+ ACCNUM / 7 - A DIGIT
+ ACCNUM / 6 - A DIGIT
+ ACCNUM / 5 - A DIGIT
+ ACCNUM / 4 - A DIGIT
+ ACCNUM / 3 - A DIGIT
+ ACCNUM / 2 - A DIGIT
+ ACCNUM / 1 - A DIGIT
+ ACCNUM / 0 - A DIGIT
+ CTRLD / ^D SWITCH
+ CTRLK / ^K SWITCH
+ DQUOTE / " - SINGLE ASCII
+ SQUOTE / ' - PACKED ASCII
+ ERCR / ( - ILLEGAL HERE
+ ACCPT3-2 /SPACE - END
+ ACCPT3-1 /CR - END
+
+/'GARGS' JUMP LIST - TERMINATORS
+GAROPS, GAR5 /-
+ GAR6 /,
+ ERCS /:, SHOULDN'T SEE, WILL DO ERROR
+ GAR4 /.
+ ERCS /SPACE, SHOULDN'T SEE, WILL DO 'ERROR'
+ GAR3 /CR
+
+/'GARGS' & 'ARG' COMMAND LISTS
+GARLST, "-
+ ",
+GETLST, ":
+ARGLST, ".
+ 240 /SPACE
+ 215 /CR
+ 0
+
+/'GETNT' LISTS
+GETOPS, GETCOL
+ GETPER
+ GETEND
+ GETEND+1
+
+/'ARG' JUMP LIST
+ARGOPS, ARG2
+ ARG3
+ ARG3
+
+/'WCHEK' LISTS
+WCKLST, "(
+ ")
+ ""
+ "'
+ 215
+ 0
+
+WCKOPS, WCHEK5+1
+ WCHEK5
+ WCHEK6+1
+ WCHEK6
+ WCHEK4
+
+/'EVAL' JUMP LIST 1
+EVOPS1, EVNEXT /+
+ EVMIN /-
+ EVLPAR /(
+
+/'EVAL' COMMAND LISTS
+EVLST1, "+
+ "-
+ "(
+ 0
+
+EVLST2, "L
+ "B
+ "S
+ "C
+ "F
+ "R
+ "T
+ "D
+ 0
+
+/'EVAL' JUMP LIST 2
+EVOPS2, EVLOC /L (LOC)
+ EVBLK /B (BLK)
+ EVSR /S (S.R.)
+ EVSR+1 /C (CONTENTS)
+ EVFIL /F (FILLER)
+ EVREM /R (REMAINDER)
+ EVTEMP /T (TEMP)
+ EVDATE /D (DATE)
+
+/ACTION CHARS FOR "READLN" SUBROUTINE
+REACTL, "R-100 /CTRL-R = RE-ECHO
+ "U-100 /CTRL-U = ERASE LINE
+ 0
+
+REACTS, RECHO
+ RERASE
+\f/ERROR ROUTINE ADDRESS LIST:
+
+ERLIST, ERCA
+ ERCB
+ ERCC
+ ERC14
+ ERCD
+ ERCE
+ ERCG
+ ERCH
+ ERCI
+ ERCK
+ ERCJ
+ XSET1
+ ERCL
+ ERCZ
+ ERCO
+ ERC11
+ ERC04
+ ERCP
+ ERCQ
+ ERCR
+ ERC09
+ ERC08
+ ERC13
+ ERCS
+ ERCT
+ ERCU
+ ERCV
+ ERCW
+ ERCX
+ ERCY
+ ERCM
+ ERC00
+ ERC01
+ ERC02
+ ERC03
+ ERC10
+ ERCF
+ GCCERR
+ HDRERR
+ ERC05
+ ERC07
+ ERC18
+ ERC19
+ ERC20
+ ERC15
+ ERC16
+ ERC17
+ 0
+
+
+ DECIMAL
+
+SMASKB, -1 /STRING SEARCH MASK BUFFER
+ /L(SMASKB)=66(10)
+COMB= SMASKB+66 /COMMAND INPUT BUFFER
+ /L(COMB)= 140(10)
+PDLB= COMB+140 /PUSH-DOWN-LIST BUFFER
+ /**** ALSO REWIND BUFFER! ****
+ CCBB-PDLB /SHOW PDL SPACE
+
+ OCTAL
+
+
+CCBB= 16400 /CORE-CONTROL-BLOCK BUFFER AND HEADER
+ / BUFFER FOR LOAD MODULES, 1 PAGE FIELD 1
+
+DMPBUF= 16600 /DUMP OUTPUT BUFFER, 2 PAGES FIELD 1
+
+IOBUF= 17200 /DEVICE I/O DUFFER, 2 PAGES FIELD 1
+
+
+$$$$
+\f
projects / pdp8.git / blobdiff