File: FUTIL5.PA of Disk: V50/Build/Build-Test
(Source file text)
/FUTIL - FILE UTILITY - V50A
DECIMAL
VERSION=50
OCTAL
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.
/ VERSION 7 PATCHES:
/ 1.CTRL/U CRASH & OVERLAY MAPPING IN SAVE MODE(7A TO 7B)
/ 2.FIXED SHOW CCB PROBLEM(7B TO 7C)
/ 3.ODT MAPPING ON LD. MODULES(7C TO 7D)
/ 4.ADDED SHOW CCB SUPPORT FOR KT8A SAVE IMAGES(7D TO 7E)
/ 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
/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
/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
/ROUTINE TO HANDLE SEMICOLON, LINE FEED & EXCLAMATION.
SEMIC, DCA I TYPEI /SET NO-OUTPUT SWITCH-V7B
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 TYPEI / ANY OUTPUT?-V7B
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
/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
/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
/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
/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
JMS I (FPRNTX /FIRST PRINT BANK BITS
RTR /MOVE TO BITS 9-11
RAR
AND N7 /MASK TO 1 DIGIT
DIGIT / & OUTPUT IN ASCII
JMP I FPRNT
PAGE
/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
JMS I (ADFLD /ADJUST BANK AND FIELD FOR 128K
TAD TEMP1 / & START ADDR
JMS I OCTI
JMS I TYPECI / & A "-"
"-
/ TAD TEMP2 /OUTPUT FIELD AGAIN
/ JMS FPRNT
JMS I (ADFLD /ADJUST BANK AND FIELD (128K)
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
/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
/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
/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
/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
/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 (-237 /XS237**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
/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
/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
/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 UPCBLK /V7B
TAD UPCBLK /V7B-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 GETORG / TO (LVLS-1)*LENGTH-V7B
TAD CBLK
DCA CBLK / TO OVERLAY START BLOCK
ISZ UPCBLK /[MULTIPLY BY ADDING]-V7B
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
/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
/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
/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
RKEY, 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
/'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
/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
/'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
PDATE, 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
CIA
TAD YRTEST / TEST IF .GT. THIS YEAR
SPA / WAS 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
/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 /REALLY XS237** XS240 FORMAT PACKED ASCII
JMS I RTR6I /HIGH 6 BITS
AND N77
JMS I (XSCONV /XS237** SPACE1 / PLUS A SPACE
TADICAD /THEN LOW 6 BITS,
AND N77
JMS I (XSCONV /XS237** 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
/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
PUSHX, 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
XSCONV, 0 /TYPES XS237**
SNA /IS IT NULL?
TAD (100 /YES: CONVERT TO _
TAD M1
SPACE1 /TYPES SPACE + AC
JMP I XSCONV /0=_,1=SPACE,40=?,41=@,77=^
PAGE
/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
/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
/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
TAD I M1 /NOW GET EXTENDED YEAR BITS
AND (1600 / FROM "B.I.P." WORD AND
CLL RTR / MOVE TO BITS 6,7,8 (*8)
RTR
/TAD (106 /ADD TO A STARTING BASE OF 70[10]
/CIA
TAD YRTEST /AND ADD THIS YEAR ALSO
/CIA
TAD (-36 /ABOVE 2000? 70-100
SPA
TAD (144 /NO - ADD TO A STARTING BASE OF 70[10]
DCA YRBASE /= (70 OR 0) + 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!
/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
/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
*7000
/NEW CODE TO HANDLE 128K SUPPORT
ADFLD, 0 /ADJUSTS BANK AND FIELD FOR CCB PRINTING
TAD TEMP2
AND (76
CLL RTR
SZL
TAD (20
CLL RTL
JMS I (FPRNT
JMP I ADFLD
FPRNTX, 0 /ROUTINE TO PRINT BANK BITS
AND (174 /ISOLATE BANK AND FIELD BITS
DCA FLD
TAD FLD
AND (104 /ISOLATE BANK BITS
CLL RTR /SSWITCH THEM AROUND
RAR
SZL
TAD (4
CLL RTR
DIGIT /PRINT BANK BITS
TAD FLD
JMP I FPRNTX
FLD, 0
FIELD 1 /THE END OF FIELD 0!
*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&
*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
CLL RAL /ADJUSTS FOR 128K INDICATOR BIT
STL RAR
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 (7603
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-1 /YES, POINT TO OVERLAY TABLE-1
DCA GHDR /TO CHANGE PAGES TO BLOCKS AND ADJUST FIELDS
GCCB1, ISZ GHDR
ISZ GHDR /POINT TO CONTROL WORD
TAD I GHDR /V40A
AND (7 /MOVE FIELDS TO CORRECT POSITION
CLL RAL
RTL
TAD I GHDR /MERGE IN PAGES AS WAS
AND (7770
DCA I GHDR
ISZ GHDR /V40A
ISZ GHDR /SKIP RELATIVE BLOCK
TAD I GHDR /V7C
IAC /ROUND DOWN IN 2 STEPS FOR PDP-8
CLL RAR
DCA I GHDR /STORE A WORD - BLOCKS
TAD GHDR /CHECK FOR END
TAD (-CCBB-177 /V40A
SZA CLA / 0 = DONE
JMP GCCB1
GCCB2, DCA GETSWX /BE SURE SWITCH STAYS CLEAR
TAD I SEGNI /GET -# SEGMENTS
CLL RAL
STL RAR /ADJUSTS FOR 128K INDICATOR BIT
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
NOP /AC NON-ZERO FOR OK-V7C
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
PAGE
/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
MSBAD, TEXT " BAD BLOCK" /V40A
PAGE
/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
MSMOD, TEXT " MOD"
MSERR, TEXT "ERRORS: FUTIL " /V40A
*.-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
/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
/ 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. ****
/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
/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 "XS237" /WAS** TEXT "XS240"
/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 /& /IS XS237**
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
/'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 /XS237** 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 /XS237**
DPRT
SGNDP
OPRT
BPRT
BYTEO
PDPDMP
FPPDMP
DIRDMP
/'XSHFMT' DESCRIPTOR ADDRESS LIST
FMTLS, MS21 /PACKED ASCII
MS22 /ASCII
MS23 /OS/8 ASCII
MS43 /XS237** 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 /XS237** 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
/'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!
/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
/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
FIELD 0
*6400
$$$$