/FUTIL - FILE UTILITY - V07A

VERSION=07
PATCH="A&77

/	OS/8 FILE UTILITY PROGRAM.  ALLOWS EXAMINATION AND
/  MODIFICATION OF OS/8 MASS STORAGE DEVICES FROM THE CON-
/  SOLE.  DUMPING OF BLOCKS, LISTING OF WORDS AND MODIFICA-
/  TION OF WORDS CAN BE DONE IN 7 FORMATS: OCTAL; SIGNED AND
/  UNSIGNED DECIMAL; UNPACKED, 6-BIT PACKED, XS240 PACKED AND
/  OS/8 PACKED ASCII.  LISTING AND DUMPING CAN ALSO BE DONE
/  IN 5 MORE FORMATS: BCD, BYTE (OCTAL CHARACTER), 2 PSEUDO-
/  SYMBOLIC FORMATS [PDP-8 & FPP-12/8A], AND A COMBINATION
/  FORMAT FOR DIRECTORY DUMPING. PROGRAM USES BOTH COMMAND
/  WORDS AND COMMAND CHARACTERS (LIKE ODT) FOR DIRECTION.

/BY:	JIM CRAPUCHETTES
/	MENLO COMPUTER ASSOCIATES, INC.
/	(FORMERLY: FRELAN ASSOCIATES)
/	P.O. BOX 298
/	MENLO PARK, CALIF. 94025
/
/
/VERSIONS 1 THRU 4 - "XTAPE" FOR THE XSYSTEM,
/  LAST REVISION--APRIL 1970.
/
/VERSION 5 - OS/8 OPERATION, JULY 1972 THRU JUNE 1976
/  "(...)", "C & 'CC AS NUMBERS, IOT DECODING, LIST
/  & DUMP FORMATS, OUTPUT TO LPT:, FILE DATE & LOC
/  IN DIRECTORY, "WORD MEMREF...", BCD OUTPUT,
/  ADDITIONAL ODT OUTPUTS, "BYTE" OUTPUT.
/VERSION 6 - EXPANSION OF OS/8 OPERATION, JUNE 1976:
/  "FILLER" FOR "MODIFY", SEARCH LIMITS CHANGE, "WRITE"
/  WITH AN ARGUMENT, FPP INSTRUCTION DECODING, CHAINING
/  SUPPORT (FOR CCL CALLS), LOAD MODULE HANDLING AND
/  "SHOW HEADER", MULTIPLE DEFAULT EXTENSIONS, ^R FOR
/  RETYPE, SET REPLACES OPTION, NEW OUTPUT ROUTINE FOR
/  "DIRECTORY" FORMAT, LINK OVERLAY HANDLING, ODT CHANGES,
/  EXIT, SCAN, WRITE LOCKED OPERATION, SPEED UP SEARCHES,
/  XS240 FORMATS
/VERSION 6.17 - APR 1, 1977; BATCH OPERATION, COMMENT
/VERSION 6.20 - MAY 16, 1977; NEW DATE, FULL FILE OUTPUT
/   (SET/SHOW DDEV, OPEN ..., CLOSE), OPT ":" ON DEVICES.
/VERSION 6.21 - JUN 4, 1977; NEW INPUT ROUTINE, TEMP STORAGE
/VERSION 6.22 - JUL 13, 1977; CRTL-Q & -S, SCOPE MODE,
/  IF/END COMMANDS, ALPHA DATE.
/
/PREVIOUS VERSIONS HAVE BEEN AVAILABLE THROUGH DECUS,
/  DEC SUPPORT BEGINS WITH VERSION 7 - 20-JUL-77.
/	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 READLN-4400	/SET NO-OUTPUT SWITCH
LFLF,	STA		/LINE-FEED - CLOSE,INCREMENT,OUTPUT
EXCL,	DCA OMODPT	/EXCLAMATION - CLOSE,DECREMENT,OUTPUT
	JMS ECLOSE	/CLOSE THIS LOCATION
	IAC
	DCA ACC1	/SET UP D.P. INCREMENT
	DCA ACC2
EXCL1,	DCA DPSGN	/(FOR SAFETY)
	ISZ OMODPT	/INCREMENT OR DECREMENT?
	JMS DPNEG	/ DECREMENT, NEGATE VALUE
	CLL
	TAD ACC1
	TAD SLOCL	/UPDATE LOCATION TO 15 BITS
	DCA SLOCL
	RAL
	TAD ACC2
	TAD SLOCH
	AND N7		/ (BUT ONLY 15 BITS)
	DCA SLOCH
	TAD I READLN-4400	/ ANY OUTPUT?
	SNA CLA
	JMP SLO2+1	/  NO, WAS ";" DO ONE SPACE
EXCL2,	JMS I CRLFI	/GIVE CR/LF FOR NEXT LINE
	JMS I BKLOCI	/OUTPUT ADDRESS
	  SBLK-1
	JMS I TWOCI	/OUTPUT "\ "
	  3440
	JMP SLO1	/NOW GO OPEN NEXT LOCATION

/ROUTINE TO HANDLE PLUS & MINUS.
PLUS,	STA		/"+", SET SWITCH
MINUS,	DCA OMODPT	/"-", CLEAR SWITCH
	JMS I ENDCI	/END BUFFER, TEST
	  JMP EXCL2	/NO ARG, DO SAME AGAIN
	JMS WCHEK	/LINE START WITH A COMMAND?
	JMS I ARGI	/NO, GET AN ARG
	JMP EXCL1	/UPDATE LOC & GO OPEN


ECLOSE,	0	/SUB. TO CLOSE THE LOCATION IF ARG.
	JMS I ENDCI	/END BUFFER WITH A CR.
	  JMP I ECLOSE	/ONLY A CR IN BUFFER, DONE
	JMS WCHEK	/DOES LINE START W. A WORD?
	JMS CLOSE	/ARG IN BUFFER, USE IT
	JMP I ECLOSE	/DONE

CLOSE,	0	/SUBROUTINE TO CLOSE A LOCATION
	JMS I ARGI	/GET ONE ARG
	ISZ SHUT	/ANYTHING OPEN?
	JMP I CLOSE	/NO, RETURN
	JMS I ODGETI	/YES, SET UP THINGS RIGHT
	STA
	DCA MODIF	/SET MODIFY FLAG
	TAD ACC1	/USE "LOC" AS DATA
	DCAICAD		/STORE IT
	JMP I CLOSE


PAGE
/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
	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
	TAD TEMP1	/ & START ADDR
	JMS I OCTI
	JMS I TYPECI	/ & A "-"
	  "-
	TAD TEMP2	/OUTPUT FIELD AGAIN
	JMS FPRNT
	TAD TEMP2	/ PAGE COUNT -> PAGES
	CLL RAL
	AND M200	/MASK OFF FIELD DATA
	TAD TEMP1	/ADD ORIGIN ADDR
	TAD M1		/ & SUBTRACT 1 FOR END
	JMS I OCTI	/OUTPUT END ADDR IN OCTAL
	ISZ DPSGN	/DONE?
	JMP XSHCC4	/NO
	TAD OVLFLG	/YES, OVERLAYS? (LINK OUTPUT)
	SNA
	JMP XSHCR	/ NO, DONE
	DCA DPNT	/ YES, RESET POINTER
	JMP XSHHD1	/  & CONTINUE
/
XSHCC4,	JMS I TWOCI	/OUTPUT SEPARATOR
	  5440
	ISZ CNTR	/DONE ON THIS LINE?
	JMP XSHCC2	/NO
	JMS I CRLFI	/YES
	SPACE2		/ADD 2 SPACES
	STA		/AND 1 MORE ITEM PER LINE
	JMP XSHCC1

/SHOW 'HEADER' HANDLER
XSHHDR,	CDF CIF 10
	JMS GHDR	/SET UP HEADER FOR MODULE
	JMS I TYPSI	/"HEADER:"
	  MS38
	JMS CCHDST	/DO SETUP, OUTPUT START
	JMS I TYPSI	/", NEXT WORD = "
	  MS39
	TADIDP		/GET FIELD DIGIT
	DIGIT		/ & OUTPUT
	JMS NXTOCT	/FOLLOWED BY ADDRESS
	JMS I TYPSI	/", LOAD VER = "
	  MS40
	JMS NXTOCT	/ & OUTPUT VERSION
	TADIDP		/GET E.P. FLAG
	SNA CLA
	JMP XSHHD1	/ NO E.P.
	JMS I TYPSI	/", EP REQ'D"
	  MS41
XSHHD1,	JMS I CRLFI	/TO THE NEXT LINE
	JMS I TYPSI	/"  OVLYS START...
	  MS42
XSHHD2,	TADIDP		/GET NUMBER OF OVERLAYS
	SNA		/ FOR THIS LEVEL
	JMP XSHCR	/ 0 = END, DONE
	DCA TEMP1	/SAVE IT
	JMS I CRLFI	/OUTPUT A CR/LF
	SPACE2		/ AND 4 SPACES
	SPACE2
	TAD TEMP1
	JMS I DEC2I	/# OVLYS IN DECIMAL
	SPACE2
	TADIDP		/GET MEMORY START WORD
	DCA TEMP2
	TAD TEMP2
	JMS FPRNT	/OUTPUT START FIELD
	TAD TEMP2
	AND M400	/ & DOUBLE-PAGE
	JMS I OCTI
	SPACE2
	JMS NXTOCT	/OUTPUT RELATIVE BLOCK
	SPACE2
	JMS NXTOCT	/OUTPUT OVERLAY LENGTH
	JMP XSHHD2	/AND DO ANOTHER ROUND!

/SHOW 'ERRORS' HANDLER
XSHERR,	JMS USROUT	/BE SURE MESSAGES ARE IN
	ISZ DSWIT	/SET DUMP SWITCH
	JMS I TYPSI	/"ERRORS:  FUTIL VERSION ..."
	  MSERR
	JMS I CRLFI
	CLA IAC
	DCA DPNT	/SET POINTER & CODE
XSHER1,	JMS I CRLFI	/DO ANOTHER CR/LF
	TAD DPNT	/TEST FOR LAST REAL MESSAGE
	TAD (-EMSEND	/(NOT DEBUG MESSAGE!)
	SNA CLA
	JMP XSHCR
	TAD DPNT	/OUTPUT ERROR CODE
	JMS I DEC2I	/ AS 2 DIGITS
	JMS I TYPSI	/THEN " =  "
	  MS01
	TADIDP		/GET ADDR OF MESSAGE AND
	JMS I TYPSTI	/ OUTPUT IT
	JMP XSHER1


CCHDST,	0
	JMS I CRLFI
	JMS I TYPSI	/"  SA = "
	  MS18
	TAD (CCBB
	DCA DPNT	/SET UP POINTER TO DATA
	TADIDP		/GET 2ND WORD FROM CCB/HDR
	JMS FPRNT	/IT HAS START FIELD SO OUTPUT
	JMS NXTOCT	/ FOLLOWED BY START ADDR
	JMP I CCHDST


PAGE
/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 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 GETORG
	TAD GETORG	/ADDR IS OK, IS THERE A
	TAD SEGCNT	/ LEVEL WANTED?
GETL3,	SPA CLA
	JMP GETX	/ILLEGAL LEVEL; TOO FAR--EXIT
	TAD GETCW	/ALL OK!  ADD RELATIVE BLK
	SKP
GETL4,	TAD SEGCNT	/ TO (LVLS-1)*LENGTH
	TAD CBLK
	DCA CBLK	/ TO OVERLAY START BLOCK
	ISZ GETORG	/[MULTIPLY BY ADDING]
	JMP GETL4
	JMP GET1
GETORG,	0
GETCW,	0
SEGCNT,	0

UPCBLK,	0
	JMS I RTR6I	/MOVE COUNT TO BITS 6-11
	CLL RAR		/DIVIDE FOR DOUBLE PAGES
	TAD CBLK	/UPDATE
	DCA CBLK
	JMP I UPCBLK



PAGE
/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
	TAD YRTEST	/  TEST IF .GT. THIS YEAR
	SMA SZA
	TAD (-10	/   YES, SUBTRACT 8
	TAD YRBASE	/ ADD TO BASE YEAR
	JMS I DEC2I	/ & OUTPUT IT
	JMP I PDATE
YRTEST,	0	/-(THIS YEAR) FOR TESTING
YRBASE,	0	/BASE YEAR FOR DATE + THIS YEAR


TYPEA,	0	/OUTPUT ASCII CHARACTER IN THE AC
	TAD I TYPEA	/GET ARG, IF ANY
	ISZ TYPEA
	DCA I RTL6I	/SAVE THE CHAR HERE FOR FIELD 1
	JMS I CTRLI
	CIF 10
	JMP TYPE1	/GO TO FIELD 1 TO DO THE OUTPUT
/
TYPEX,	ISZ NCNT	/BUMP LINE POSITION
	JMP I TYPEA	/ & EXIT

CRLF,	0	/OUTPUT CARRIAGE RETURN, LINE FEED
	CLA
	JMS TYPEA
	  215
	JMS TYPEA
	  212
	DCA NCNT	/RESET LINE POSITION
	JMP I CRLF


TYPEC,	0	/OUTPUT A SINGLE CHAR ARG
	TAD I TYPEC	/GET IT
	ISZ TYPEC
	JMS TYPE	/OUTPUT IT
	JMP I TYPEC


TYPE,	0	/CHARACTER OUTPUT ROUTINE
	AND N377	/BE SURE ONLY 8 BITS
	SNA
	TAD CHAR	/USE CHAR IF AC = 0
	DCA TCHAR	/CHAR TO OUTPUT
	TAD TCHAR
	JMS I SORTI	/CHECK FOR SPECIALS
	  TYPEL-1
	  TYPEOP-TYPEL
	TAD TCHAR	/IS TCHAR < 240?
	TAD M240
	SPA CLA
	JMP TYPCTL	/NO, OUTPUT AS CTRL-CHAR
TYPC,	JMS TYPEA	/NOW OUTPUT CHAR
TCHAR,	  0
	JMP I TYPE
/
TYPALT,	JMS TYPEA	/OUTPUT "$" FOR ALT-MODES
	  "$
	JMP I TYPE
/
TYPCR,	JMS CRLF	/C.R. TO OUTPUT
	JMP I TYPE
/
TYPTAB,	JMS TYPEA	/SPACE OVER FOR TAB
	  " 
	TAD NCNT	/TAB TO OUTPUT
	TAD M10
	SNA
	JMP I TYPE
	SMA
	JMP TYPTAB+3	/REDUCE BY TAB SIZE
	CLA
	JMP TYPTAB
/
TYPCTL,	JMS TYPEA	/CONTROL-CHAR, OUTPUT AS
	  "^
	TAD C100	/ "^","CHAR+100"
	JMP TYPC
C100,	100


CTRL,	0	/CHECK FOR CTRL-C, CTRL-S, CTRL-Q & CTRL-P
	DCA CTRLQS	/CLEAR HANG FLAG
CTRL0,	KSF		/HAS A KEY BEEN HIT?
	JMP CTRLX	/NO, TEST IF HANGING
	KRS
	AND N177	/YES, MASK OFF PARITY BIT
	TAD (-"C+300	/IS IT A CTRL-C (ABORT PROGRAM)?
	SNA
BCTRLC,	JMP CTRLC	/***	JMP I CTRLCI	/== ABORT ==
	TAD M20		/IS IT A CTRL-S (STOP OUTPUT)?
	SZA
	JMP CTRL1
	ISZ CTRLQS	/ YES, SET HANG FLAG
	KCC		/  & CLEAR HARDWARE FLAG
CTRL1,	TAD (2		/IS IT A CTRL-Q (START OUTPUT)?
	SZA
	JMP CTRL2
	KCC		/ YES, CLEAR THE HARDWARE
	JMP I CTRL	/  & JUST EXIT
/
CTRL2,	IAC		/IS IT A CTRL-P (STOP PROGRAM)?
	SZA CLA
	JMP CTRLX	/NO, TEST IF HANGING
	KCC
	DCA DSWIT	/YES, RESET DUMP SWITCH
	JMS I TYPECI	/OUTPUT "^P"
	  "P-100
	JMP I RECRLF	/ THEN CR/LF & RESTART
/
/ROUTINE TO EXECUTE THE 'EXIT' COMMAND
/
XEXIT,
CTRLC,	DCA DSWIT	/RESET DUMP SWITCH
	JMP I M200	/ & GO TO SYSTEM
CTRLCI,	XERR4+1		/*** CTRL-C ABORTS JOB STREAM! ***
/
CTRLX,	TAD CTRLQS	/HANGING BECAUSE OF CTRL-S?
	SZA CLA
	JMP CTRL0	/ YES, BACK FOR ANOTHER ROUND
	JMP I CTRL	/ NO, OUT WE GO!

CTRLQS,	0	/CTRL-S, CTRL-Q FLAG


PAGE
/INPUT AN UNSIGNED 24 BIT NUMBER
ACCEPT,	0
	DCA ACC1	/CLEAR LO
	DCA ACC2	/ & HI WORDS
	DCA DADD	/ & LEGAL INPUT SWITCH
	JMS I SSKIPI	/GET FIRST NON-SPACE
	SKP
ACCPT1,	JMS I GETNI	/DON'T IGNORE SPACES
	JMS I SORTI	/CHECK FOR ^D, ^K, (, ", ',
	  GWLST1-1	/ DIGITS, SPACE
	  ACOPS-GWLST1
	JMP ACCPT3	/NONE OF THE ABOVE
/
ACCNUM,	TAD CHAR
	TAD (-"0	/MAKE A DIGIT
	DCA OCTSET
	TAD OCTSET	/IS DIGIT LEGAL?
	CIA
	TAD ACBASE
	SPA SNA CLA
ERC09,	ERROR		/ NO, ILLEGAL DIGIT!
ACCMUL,	TAD ACBASE	/SET UP MULTIPLY OF PREVIOUS
	DCA OPER1	/ BY BASE
	DCA OPER2
	JMS DMUL	/ DO MULTIPLY
	TAD OCTSET	/SET UP ADD OF NEXT "DIGIT"
	DCA OPER1
	DCA OPER2
	JMS DADD	/OK, DO THE ADD (& SET SWITCH)
	JMP ACCPT1
/
	STA		/  SPACE HERE
	DCA CRSWT	/SET SWITCH: CR HERE
ACCPT3,	TAD DADD	/TERMINATING CHAR RECEIVED
	SNA CLA		/CHECK FOR LEGAL INPUT
ERCR,	ERROR		/YOU CAN'T OUT-SMART ME!
	JMP I ACCEPT
ACBASE,	10
/
/
DQUOTE,	JMS QUOTEC	/ " - GET SINGLE CHAR
	DCA OCTSET	/ SAVE VALUE
	JMP ACCMUL	/ & USE IT AS A "DIGIT"
/
SQUOTE,	JMS QUOTEC	/ ' - PACKED ASCII, GET 1ST
	AND N77		/MASK TO 6 BITS
	JMS I RTL6I	/MOVE TO LEFT HALF
	DCA OCTSET	/ & SAVE IT
	JMS QUOTEC	/GET 2ND CHAR
	AND N77		/MASK
	TAD OCTSET	/MERGE
	JMP DQUOTE+1	/ & USE THIS AS A "DIGIT"
/
CTRLD,	TAD (2		/ ^D - SET RADIX TO DECIMAL
CTRLK,	JMS OCTSET	/ ^K - SET RADIX TO OCTAL
	JMP ACCPT1


/SUB. TO SET UP FOR OCTAL/DECIMAL INPUT.  CALLED FROM
/  COMMAND INPUT & MODIFY & IF AN "^K"/"^D" IN INPUT.
OCTSET,	0	/SET UP FOR OCTAL/DECIMAL INPUT
	TAD (10		/ENTER WITH AC= 2 FOR DECIMAL
	DCA ACBASE
	JMP I OCTSET

QUOTEC,	0	/GET A QUOTED CHARACTER
	JMS CGTEST	/GET & TEST FOR A CR
ERC13,	  ERROR		/ ILLEGAL USE OF " OR '
	TAD CHAR	/OK, RETURN WITH IT
	JMP I QUOTEC


/SUBROUTINE TO DEVELOP ARGUMENTS FROM THE COMMAND
/BUFFER, AND RETURN WITH -(#) OF ARGS IN 'TEMP'.
GARGS,	0
	TAD TEMPST	/GET BUFFER ADDRESS
	DCA DPNT
	DCA TEMP	/ZERO THE NUMBER OF ARGS
GAR1,	STA
	DCA TEMP1	/SET BLK TO -1
	STA
	DCA CNT		/RESET SWITCH
GAR2,	JMS EXPRIN	/GET NEXT ARG
	JMS I SSKIPI	/IGNORE TRAILING SPACES
	JMS I SORTI	/BRANCH ON TERMINATOR
	  GARLST-1
	  GAROPS-GARLST
ERCS,	ERROR		/ILLEGAL TERMIN., FLAME OUT
/
GAR3,	JMS GPUT	/CR FOUND, END
	TAD TEMPST	/SET UP POINTER FOR
	DCA DPNT	/ GETTING RESULTS
	JMP I GARGS
/
GAR4,	JMS I GETNI	/SKIP OVER "."
	TAD ACC1	/.= TERMIN (BLOCK PART)
	JMP GAR1+1	/SET BLOCK & GET NEXT
/
GAR5,	TAD ACC1	/-= TERMIN (LOC PART)
	DCA TEMP2
	JMS I GETNI	/SKIP OVER "-"
	JMP GAR2-1	/GO SET SWITCH
/
GAR6,	JMS GPUT	/,= TERMIN
	JMS I GETNI	/SKIP OVER ","
	JMP GAR1


/SUBROUTINE TO PUT THE DEVELOPED ARGS IN THE ARG
/BUFFER.  ALL ARGUMENTS ARE STORED IN 4 WORDS IN
/THE BUFFER, AS SPECIFIED BY:
/   BLOCK.LOC1-LOC2  (TERMINATED BY , OR C.R.)
/AS:
/I-------I-------I-------I-------I-----
/I WORD1 I WORD2 I WORD3 I WORD4 I ETC.
/I-------I-------I-------I-------I-----
/WHERE:
/  WORD1=	BLOCK (OR -1 IF NONE SPECIFIED)
/  WORD2=	LOC (HIGH) [ONLY 3 BITS, LOC2 IF SPEC'D]
/  WORD3=	LOC1 (LOW)
/  WORD4=	LOC2-LOC1-1 (LOC2=LOC1 IF NOT
/		SPECIFIED) [ONLY 12 LOW BITS USED]
GPUT,	0
	TAD TEMP1
	DCA I DPNT	/SET BLOCK
	ISZ CNT		/WAS A LOC2 SPECIFIED?
	JMP GPUT1	/YES, OK
	TAD ACC1
	DCA TEMP2	/NO, MAKE ARGS SAME
GPUT1,	TAD ACC2	/STORE HIGH ADDR
	AND N7		/MASKED TO 3 BITS
	DCA I DPNT
	TAD TEMP2	/USE 1ST ARG
	DCA I DPNT
	TAD ACC1
	CMA
	TAD TEMP2
	DCA I DPNT	/DIFF= (TEMP2-ACC1-1)
	STA
	TAD TEMP	/ANOTHER ENTRY
	DCA TEMP
	JMP I GPUT


XS240O,	0	/XS240 FORMAT PACKED ASCII
	JMS I RTR6I	/HIGH 6 BITS
	AND N77
	SPACE1		/ PLUS A SPACE
	TADICAD		/THEN LOW 6 BITS,
	AND N77
	SPACE1		/ PLUS A SPACE
	JMP I XS240O


GETN,	0	/GET NEXT CHAR FROM COMM. BUFF.
	CDF 10
	TAD I COMOUT
	CDF 0
	DCA CHAR
	JMP I GETN


PAGE
/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


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 (NEG)
	TAD I M1	/NOW GET EXTENDED YEAR BITS
	AND (600	/ FROM "B.I.P." WORD AND
	CLL RTR		/  MOVE TO BITS 7,8 (*8)
	RTR
	TAD (106	/ADD TO A STARTING BASE OF 70[10]
	CIA
	TAD YRTEST	/AND ADD THIS YEAR ALSO
	CIA
	DCA YRBASE	/= 70 + EXTEND*8 + THIS YEAR
	TAD I (7746	/GET JSW
	AND (6777	/CLEAR BIT 2 (CAN RESTART!)
	CLL RAR
	STL RAL		/SET BIT 11 (DON'T SAVE FIELD 1)
	DCA I (7746	/& PUT IT BACK
	JMS I (7607	/WRITE ERROR MESSAGES
	  4610		/ 6 PAGES, FIELD 1
	  0		/ FROM LOC 10000
	  27		/ NORMAL SAVE AREA!
	  SKP CLA
	JMP I INIMSG	/OK, JUST EXIT
	TAD M200
	DCA XERR3	/FAILED, ASSUME WRITE LOCKED
	TAD (ERROR	/ SO NO ERROR MESSAGES ON
	DCA ERC15	/ ERROR OR "SHOW ERRORS"
	JMP I INIMSG


PAGE	/LITERALS HERE ARE OK!
/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

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
	SMA CLA		/1ST WORD (-# SEGS) NEG?
	JMP GCCERR	/ NO, CAN'T BE CCB
	TAD I (CCBB+3	/GET JOB STATUS WORD
	AND (200	/OVERLAY BIT SET (LINK)?
	SZA CLA		/ 0 = NO
	TAD (CCBB+140-1	/ 1 = YES, START ADDR-1
	CDF 0
	DCA I (OVLFLG	/NO = 0; YES = ADDR-1
	CDF 10
	TAD I (CCBB+1	/2ND WORD A "CDF CIF X0"?
	AND (7707
	CIA
	TAD GCCCDF
	SZA CLA
GCCERR,	JMS ERROR1	/LOOKS BAD, JUST EXIT NOW!
	ISZ GETSWX	/LOOKS OK, 1ST TIME SINCE READ?
	JMP GCCB2	/NO, DON'T CHANGE THINGS AGAIN
	TAD (CCBB+140+3	/YES, POINT TO LENGTH WORDS
GCCB1,	DCA GHDR	/ TO CHANGE PAGES TO BLOCKS
	TAD I GHDR	/GET A WORD - PAGES
	SNA
	JMP GCCB2	/ 0 = DONE
	IAC		/ROUND DOWN IN 2 STEPS FOR PDP-8
	CLL RAR
	DCA I GHDR	/STORE A WORD - BLOCKS
	TAD GHDR	/UPDATE POINTER TO NEXT
	TAD (4
	JMP GCCB1
/
GCCB2,	DCA GETSWX	/BE SURE SWITCH STAYS CLEAR
	TAD I SEGNI	/GET -# SEGMENTS
GCCCDF,	CDF CIF 0
	JMP I GCCB	/OK, RETURN VALUE

GHDR,	0	/GET HEADER BLOCK (FORTRAN IV)
	TAD (3		/TO SET UP CCBB+6
	JMS CCBHDR	/DO COMMON TEST & READ-IN
	TAD (-2		/1ST WORD MUST BE EXACTLY 2
	SZA CLA
	JMP HDRERR	/ NO, CAN'T BE A HEADER
	ISZ GETSWX	/1ST TIME THRU SINCE READ?
	JMP GHDR1	/ NO, DON'T CHANGE ANYTHING
	DCA I (CCBB+47	/YES, BE SURE THESE WORDS
	DCA I (CCBB+50	/ ARE 0 FOR USERS
	TAD I (CCBB+1	/GET START FIELD WORD
	SNA
	JMP HDRERR	/ SHOULD BE 1 THRU 7
	CLL RTL		/LOOKS OK, MOVE FIELD TO BITS
	RAL		/ 6-8 TO HELP "SHOW HEAD"
	DCA I (CCBB+1
	TAD I (CCBB+1	/ARE THESE ONLY BITS SET?
	AND (7707
	SZA CLA
	JMP HDRERR	/ NO, SOMETHING MUST BE BAD
	TAD I (CCBB+3	/OK, TEST FIELD OF NEXT FREE
	SNA
	JMP HDRERR	/ SHOULD BE 1 THRU 7
	AND (7770
	SZA CLA
HDRERR,	JMS ERROR1
GHDR1,	DCA GETSWX	/MAKE SURE THIS IS 0
	CMA		/AC NON-ZERO FOR OK
	CDF CIF 0
	JMP I GHDR	/OK, BACK TO USER

CCBHDR,	0
	TAD (CCBB+3	/CCBB+6 FOR GHDR
	CDF 0
	DCA I (GETPNT	/SET UP POINTER FOR 'GET'
	TAD I (DEVAD	/GET ADDR OF DEVICE
	DCA DEVADX	/ HANDLER & SAVE HERE
	TAD I (RBLK1	/GET START BLOCK NUMBER
	SNA
ERCF,	JMS ERROR1	/ NO FILE!!! GIVE ERROR
	CDF 10
	DCA GCCBLK	/OK, SET UP 1ST BLOCK
	TAD I SEGNI	/IS SOMETHING IN MEMORY?
	SZA
	JMP I CCBHDR	/ YES, RETURN 1ST WORD
	CIF 0
	JMS I DEVADX	/NO, READ 1ST BLOCK OF FILE
	  0110		/READ; 1 PAGE; FIELD 1
SEGNI,	  CCBB		/BUFFER IS HERE
GCCBLK,	  0		/BLOCK NUMBER
	  JMP RDERX	/...BAD NEWS...
	STA
	DCA GETSWX	/OK, SET "JUST READ" SWITCH
	TAD I SEGNI	/AND GET 1ST WORD
	JMP I CCBHDR
/
RDERX,	CDF CIF 0	/RETURN TO FIELD 0
	JMP I (RERROR	/ FOR READ ERROR

DEVADX,	0
GETSWX,	0


MSMOD,	TEXT "  MOD"

MSBAD,	TEXT " BAD BLOCK"


PAGE
/CONTINUATION OF OUTPUT COMMANDS AND ROUTINES FROM FIELD 0

/CONTINUATION OF 'SET' 'DDEV' HANDLER

XDDEV1,	DCA DDEVAD	/SET UP HANDLER ADDRESS
	TAD I (GDEV2
	DCA DDEVNO	/ AND DEVICE NUMBER
	CDF 10
	TAD DDEVNO	/LOOK AT DCW FOR SPECIFIED
	TAD (7760-1	/ DEVICE TO SEE IF FILE
	DCA DDCWPT	/ STRUCTURED.
	TAD I DDCWPT	/BIT 0 = 1 FOR FILES
	SMA CLA
	TAD (212	/ NO, LINE-AT-A-TIME
	DCA DDEVS	/ YES, BLOCK-AT-A-TIME
	TAD DMPADR	/OK, INITIALIZE OUTPUT POINTER
	DCA DMPPTR
	DCA XOSIZ	/ AND ZERO BLOCK COUNTER
	DCA DNAM	/ AND CLEAR ANY FILE NAME
	IAC
	DCA DMPBLK	/ AND SET BLOCK NUMBER TO 1
	JMP XDDEV2	/LAST, GO SET UP NAME FOR OUTPUT


/CONTINUATION OF EXECUTION OF 'OPEN' COMMAND

XOPEN1,	TAD (NAM1-1	/SET UP POINTER TO FIELD 0 FILE
	DCA DPNT	/ NAME (NOTE: XR IN FIELD 1!!!)
	TAD I DPNT	/MOVE THE FILE NAME UP HERE
	DCA DNAM
	TAD I DPNT
	DCA DNAM+1
	TAD I DPNT
	DCA DNAM+2
	TAD I DPNT	/GET THE EXTENSION PART
	ISZ I (TEMP1	/ WAS ANYTHING REALLY SPECIFIED?
	JMP XOPEN2
	CLA
	TAD (0425	/  NO, DEFAULT TO ".DU"
XOPEN2,	DCA DNAM+3
	TAD XCLNAM	/SET UP POINTER TO NAME FOR USR
	DCA XOBLK
	CDF 10		/SET UP RETURN FIELD
	TAD I DDCWPT	/CLEAR ANY OPEN FILE ON
	AND (7770	/ THIS DEVICE SO "OPEN"
	DCA I DDCWPT	/ CAN BE DONE WHENEVER!
	CIF 0		/SET UP SUBROUTINE FIELD
	TAD DDEVNO	/GET DUMP DEVICE NUMBER
	JMS USEUSR	/ AND GO GET USR & CALL IT.
	  3		/ENTER
XOBLK,	  0	/NAME POINTER, BECOMES START BLK
XOSIZ,	  0	/ BECOMES -# BLOCKS CAN USE
ERC18,	  JMS ERROR1	/THE ENTER FAILED!
	TAD XOBLK	/OK! SET UP FILE START BLOCK
	DCA DMPBLK
	TAD DMPADR	/INITIALIZE POINTER
	DCA DMPPTR
XOCEX,	CDF CIF 0
	JMP MAIN1	/TRY NEXT COMMAND

DDEVAD,	7607	/INIT ADDRESS TO "SYS:" (SEE ABOVE)
DDEVNO,	1	/INIT THIS TO "SYS:" ALSO.
DDCWPT,	7760	/ THIS ALSO

DNAM,	0	/DUMP FILE NAME, INIT TO NULL
	0
	0
	0	/(EXTENSION HERE)


/CONTINUATION OF EXECUTION OF 'CLOSE' COMMAND

XCLOS1,	TAD DNAM	/IS ANY FILE OPEN?
	SNA CLA
	JMP XOCEX	/ NO, IGNORE COMMAND
	TAD XCTLZ	/ YES, OUTPUT A CTRL-Z
	JMS DMPOUT	/  AND FILL TO END
XCTLZ,	  "Z-100
	TAD XOBLK	/OK, CALCULATE FILE SIZE
	CIA
	TAD DMPBLK	/= NEXT - START
	DCA XCLSIZ	/= FILE SIZE IN BLOCKS
	TAD DDEVNO	/GET DUMP DEVICE NUMBER
	CIF 0
	JMS USEUSR	/GET USR AND CALL IT
	  4		/CLOSE
XCLNAM,	  DNAM		/POINTER TO FILE NAME
XCLSIZ,	  0		/SIZE OF NEW FILE
ERC19,	  JMS ERROR1	/OH NO! CLOSE FAILED!
	DCA DNAM	/OK, ZAP KNOWLEDGE OF FILE
	JMP XOCEX


DMPOUT,	0	/DUMP FILE CHARACTER OUTPUT ROUTINE
	DCA DMPCHR	/SAVE THE CHARACTER
	TAD DMPCHR	/PUT IT INTO FILE BUFFER
	CDF 10		/(MUST BE SURE!)
DMPNUL,	DCA I DMPPTR	/INSERT AN 8 BIT CHAR
	ISZ DMPPTR
	TAD DMPPTR	/NOW AT END OF BUFFER?
	TAD (-DMPBUF-400
	SNA CLA
	JMP DMPIT	/ YES, DUMP BUFFER NOW
	TAD DMPCHR	/NO, FILL FOLLOWING THIS CHAR?
	CIA
	TAD I DMPOUT	/(THE TEST CHAR @ CALL+1)
	SNA CLA
	JMP DMPNUL	/ YES, FILL WITH NULLS!
	JMP I DMPOUT	/  NO, EXECUTE FILL CHAR
/
DMPIT,	CIF 0
	JMS I DDEVAD	/CALL DUMP FILE HANDLER
	  4210		/WRITE, 2 PAGES, FIELD 1
DMPADR,	  DMPBUF
DMPBLK,	  1		/BLOCK NUMBER
ERC10,	  JMS ERROR1	/ERROR ON OUTPUT FILE!
	TAD DMPADR	/NOW RESET OUTPUT POINTER
	DCA DMPPTR
	ISZ DMPBLK	/INCREMENT BLOCK NUMBER
	ISZ XOSIZ	/ANY MORE SPACE LEFT?
	JMP I DMPOUT	/ YES, EXIT NOW
	DCA DNAM	/  NO! ZAP DUMP FILE
ERC20,	JMS ERROR1	/   AND DIE!
DMPCHR,	0
DMPPTR,	0	/CHARACTER OUTPUT POINTER


PAGE
/CONTINUATION OF ROUTINE TO OUTPUT A CHAR TO A DEVICE

TYPE1,	TAD I (DMODE	/TTY= NONE, PART&-DSWIT, ALL
	AND I (DSWIT	/ SO TEST FOR PART&DSWIT
	SZA CLA
	JMP TYPE2	/NO OUTPUT TO TTY
	TAD I (RTL6	/GET CHARACTER TO OUTPUT
TYPEB,	NOP		/***	CDF 10		/*** BATCH
	TSF		/***	CIF BAT		/*** CHANGES
	JMP .-1		/***	JMS I .+1	/*** LOG
	TLS		/***	  7400		/*** OUTPUT
	CLA		/***	CDF 0
TYPE2,	STL CLA RAR	/=4000 (SET AC BIT 0 FOR TEST)
	TAD I (DSWIT	/=4000 OR 4001 (DSWIT=1)
	AND I (DMODE	/FILE= PART&DSWIT OR ALL
	SNA CLA
	JMP TYPE3	/ OUTPUT TO TTY ONLY
	TAD DDEVS	/FILE STRUCTURED OUTPUT?
	CDF 10
	SNA
	TAD I (DNAM	/ YES, FILE OPEN?
	CDF 0
	SNA CLA
	JMP TYPE3	/  NO TO EITHER
	TAD I (RTL6	/OK, GET CHARACTER TO OUTPUT
	JMS DMPOUT	/OUTPUT IT & TEST FOR END
DDEVS,	  0		/TEST: 0=FILE, 212= NON-FILE
TYPE3,	CDF CIF 0
	JMP TYPEX	/BACK AND OUT


ERROR1,	0	/FIELD 1 ERROR ROUTINE HEAD
	CLA		/CLEAR POSSIBLE JUNK IN AC
	TAD ERROR1	/MOVE RETURN ADDR TO FIELD 0
	CDF CIF 0
	DCA I (XERROR
	JMP I (XERROR+1


XDDEV2,	CDF 0		/NAME IS OVER THERE
	TAD I (NAM1	/MOVE DEVICE NAME INTO STRING
	DCA XDDNAM	/ IN THIS FIELD FOR "SHOW DDEV"
	TAD I (NAM2
	DCA XDDNAM+1
	CDF CIF 0
	JMP XSETN	/BACK TO 'SET'

MSDDEV,	TEXT "@DDEV = SYS@"
XDDNAM=	.-3

MSDEV,	TEXT "@DEVICE = SYS@"

XDNAM=	.-3	/ADDR OF 1ST WORD OF DEVICE NAME

/CONTINUATION OF CODE FROM FIELD 0

XDEVM,	DCA XDNAM	/SET 4 DEVICE NAME CHARS IN
	TAD I (NAM2	/ OUTPUT MESSAGE
	DCA XDNAM+1
	CDF 10
	DCA I (CCBB	/NO C.C.B. OR HEADER PRESENT
	CDF CIF 0
	STA
	DCA I (RBLK	/RESET BLOCK NUMBER
	JMP XSETN	/GO DO NEXT OPTION


MSERR,	TEXT " ERROR CODES: FUTIL "
	*.-1

/VERSION NUMBER MESSAGE--THE FOLLOWING CODE INSERTS THE
/  VERSION NUMBER AND PATCH LEVEL SET NEAR THE START OF
/  THE SOURCE INTO THE VERSION MESSAGE.

MSVER,	TEXT "VERSION = ???"	/VERS = 2 DIGITS, PATCH = 1
	*.-2
VERTEN=	VERSION%12		/TENS DIGIT
VERONE=	-VERTEN^12+VERSION	/ONES DIGIT
	VERTEN^100+VERONE+6060	/INSERT TWO DIGITS
	PATCH^100		/INSERT PATCH + NULL TERM

/ALPHA MONTH NAMES PLUS DUMMIES FOR PDATE SUBROUTINE

MONTHS,	TEXT " 00@JAN@FEB@MAR@APR@MAY@JUN@JUL"
	TEXT "AUG@SEP@OCT@NOV@DEC@ 13@ 14@ 15"


PAGE
/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 "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	/&
	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	/XS240 (ASCII, PACKED)
	XFCHR
	XFNUM	/UNSIGNED (DECIMAL)
	XFNUM
	XFNUM	/SIGNED (DECIMAL)
	XFNUM
	XFNUM	/OCTAL
	XFNUM
	XFNUM	/BCD
	XFNUM
	XFNUM	/BYTE (OCTAL)
	XFNUM
	XFSYM	/PDP (SYMBOLIC)
	XFSYM
	XFSYM	/FPP (SYMBOLIC)
	XFSYM
	XFSYM	/DIRECTORY
	XFSYM

/  ROUTINE ADDRESS LIST

FTABLE,	PACOUT
	ASCII
	OSTYPE
	XS240O
	DPRT
	SGNDP
	OPRT
	BPRT
	BYTEO
	PDPDMP
	FPPDMP
	DIRDMP

/'XSHFMT' DESCRIPTOR ADDRESS LIST
FMTLS,	MS21	/PACKED ASCII
	MS22	/ASCII
	MS23	/OS/8 ASCII
	MS43	/XS240 ASCII
	MS24	/UNSIGNED DECIMAL
	MS25	/SIGNED DECIMAL
	MS26	/OCTAL
	MS35	/BCD
	MS36	/BYTE
	MS31	/PDP SYMBOLIC
	MS16	/FPP SYMBOLIC
	MS08	/DIRECTORY


/'XMODIF' COMMAND LIST
MODIFL,	TEXT "PAP@ASA@OSXSNUN@"

/'XMODIF' JUMP LIST
MODIFO,	XPAC0	/PACKED
	XPAC0
	XASC1	/ASCII
	XASC1
	XOPS1	/OS/8
	XXS20	/XS240
	XNUM2	/NUMERIC
	XNUM2

MODADS,	XMOD0	/MODIFL TEST LIST
	XMOD0
	XMOD0
	XMOD0
	XMOD0
	XMOD0
	XMOD0
	XMOD0
	XMOD0

MODDLS,	TEXT "PAASOSXSNUNUNUNUNUNUNUNU" /DEFAULT LIST

/'XMODIF' CHARACTER JUMP LIST
MCHARO,	XMODCR	/CR, END
	RENEXT	/LF, IGNORE

/'XIF' CHARACTER JUMP LIST
IFSKPO,	XIFCR	/CR, END OF LINE
	RENEXT	/LF, IGNORE

/XNUM JUMP LIST
NUMOPS,	XNUM1	/,
	ERCQ	/:
	ERCQ	/.
	XNUM1+1	/SPACE
	XNUM3	/CR
/'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


$$$$

