A large commit.

[pdp8.git] / sw / os8 / v3d / sources / extensions / dectapes / dectape3 / teco.pa

/10 OS/8 TECO VERSION 5
/
/
/
/
/
/
/
/
/
/COPYRIGHT  (C)  1974,1975,1976,1977 BY DIGITAL EQUIPMENT CORPORATION
/
/
/
/
/
/
/
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/
/
/
/
/
/
/
/
\f/BROUGHT TO YOU BY: RUSS HAMM, O.M.S.I., AND RICHARD LARY (IN THAT ORDER)
/WITH ASSISTANCE FROM MARIO DENOBILI OF THE P?S
/PATCHES INCORPORATED BY S.R. ON 5-AUGUST-75 FOR OS/8 V3C:

/1.	UPDATED VERSION # TO V4
/2.	INCORPORATED PATCHES #S 1 & 2 (V302 AND V303)
/	PREVENTS \ FROM GOING OUTSIDE OF BUFFER
/	RESETS CFLAG TO PREVENT ARGUMENT ERROR EVERY 4096 TIMES IN LOOP

/	CHANGES FOR V5: -S.R.-

/3.	ADDED OVERLAYS
/4.	EXPANDED ERROR MESSAGES
/5.	DOCUMENTED CORE LAYOUT
/6.	ADDED "T, "S, "F, "U, AND "R
/7.	FIXED EG BUG
/8.	MADE DEFAULT ITERATION COUNT TRULY INFINITE
/9.	ADDED N^T
/10.	ADDED :=
/11.	ADDED SOME SAFETY ERROR MESSAGES
/	(I)	ERROR IF Y HAS A NUMERIC ARGUMENT
/	(II)	ERROR IF TWO ARGUMENTS ARE SPECIFIED TO D
/12.	REMOVE ^R (OBSOLETE COMMAND)
/13.	REMOVE "A AND "B (AFTER AND BEFORE)
/14.	ADDED 13-BIT ARITHMETIC
/15.	MADE = AND \ GIVE SIGNED RESULTS (DECIMAL ONLY)
/16.	ALLOW 13-BIT NUMERIC Q-REGISTERS.
/	THIS IS ACCOMPLISHED BY RESERVING THE HIGH ORDER BIT
/	OF THE LENGTH WORD.  STRING PORTION OF Q-REGISTER
/	NOW RESTRICTED TO 2047 CHARACTERS.  IT GETS CHECKED BY
/	^U AND X.  BELL RINGS WITHIN 12 CHARACTERS OF FILLING
/	UP COMMAND STRING Q-REGISTER.
/17.	STORED LINK AS LOW ORDER BIT IN NLINK IN CASE WE EVER
/	WANT TO GO TO 24-BIT ARITHMETIC.
/18.	ERROR ON A,B,C
/19.	P DOESN'T CREATE FORM FEEDS
/20.	ALLOW @ MODIFIER WITH ER, EW, EB.
/21.	EK
/22.	^S FREEZE
/23.	EGTEXT$
/24.	GOT RID OF F_
/25.	F IS ILLEGAL IF NOT FOLLOWED BY S OR N
/26.	W IS NOW AN ILLEGAL COMMAND (EXCEPT ON -12)
/27.	ADDED :G
/28.	Y AND _ GIVE ERRORS IF DATA IS GOING TO BE LOST
/	(IF OUTPUT FILE IS OPEN AND BUFFER IS NOT EMPTY)
/29.	CASE FLAGGING IMPLEMENTED
/30.	"< AND "> ARE SYNONYMOUS WITH "L AND "G
/31.	^G<SPACE> AND ^G*
/32.	SCOPE RUBOUTS
/33.	== NOW PRINTS NUMBER IN OCTAL
/34.	EUFLAG AND ETFLAG IMPLEMENTED
/35.	CASE FLAGGING WORKS
/36.	IMAGE MODE (ET BIT 11) APPLIES TO T, ^A, AND N^T
/	IT DOES NOT APPLY TO :G
/37.	ERROR IF TRY TO DO AN EB TO A .BK FILE (IT DOES AN ER)
/38.	VT AND FF ARE NOW LINE TERMINATORS
/39.	BELL ECHOES AS ^G AS WELL AS RINGING BELL
/40.	^K IS AN ERROR
/41.	REMOVED ^Z COMMAND
/42.	CHANGED ^V TO EO
/43.	CHANGED ^W TO W
/44.	MEMORY RESIDENT OVERLAYS IF MORE THAN 12K
/45.	LONG FORM ERROR MESSAGES ON 1EH
/46.	ET FLAG 8'S BIT AFFECTS ECHOING OF ^T
/47.	NEGATIVE OR 0 ITERATION SKIPS
/48.	CTRL/N
/49.	CTRL/C TRAP

/KNOWN BUGS
/1.	LARGE T OR X AND ONLY 1 BLOCK LEFT IN OUT DEV
/2.	^S DOESN'T KEEP SCREEN ON
/3.	FIX BATCH INTERRACTION
/4.	MAKE VT AND FF SIMULATION INDEPENDENT OF TAB

	DECIMAL
VERSN=	5	/ VERSION NUMBER - CHANGE WITH EVERY EDIT 
	OCTAL	/ LAST EDIT  12-FEB-76  
\fIN=	6200		/INPUT BUFFER AT 06200
OUT=	5200		/OUTPUT BUFFER AT 05200
ZMAX=	7640		/MAX 4000[10] CHARACTERS IN TEXT BUFFER
QMAX=	3720		/MAX 2000[10] Q-REGISTER CHARS IN 8K
Q12MAX=	5600		/MAX 2944[10] Q-REGISTER CHARS IN 12K
CHNSTR=	46		/38 CHARACTER STRING PASSED ON CHAIN

TWO=	CLA CLL CML RTL
MTWO=	CLA CLL CMA RAL
MTHREE=	CLA CLL CMA RTL
AC3777=	CLL STA RAR
SCPBIT=	7726
\f/THINGS WE WOULD LIKE TO ADD:

/:ER
/:EB
/NV
/@^A
/FR
/-S
/::S
/^EQ
/M,NS
/[Q
/]Q
/NON-EXACT SEARCH MODE
/*N
/ERFILESPEC/S FOR SUPERTECO
/^N
/CHECK FOR $ ON NI$
/CHECK INTO SEARCHES IN ITERATIONS
/ERR MSG ON EA, EP
/NV=(1-N)TNT
/^C TRAP
/:X

/THINGS FOR -11:
/^R
/3EH
/M,ND
/ET BIT 15 SHOULD BE LOWER
/ECHO OF NULL
\f/*****************************************
/	TECO ERROR MESSAGES:
/*****************************************

/	TECO ERROR MESSAGES CONSIST OF A QUESTION MARK AND THREE LETTERS
/	TYPING "?" IMMEDIATELY AFTER AN ERROR MESSAGE PRINTOUT PRINTS
/	THE CURRENT COMMAND LINE UP TO THE ERROR CHARACTER.

/1	?ILL	ILLEGAL COMMAND
/2	?UTC	INCOMPLETE COMMAND (PDL NOT EMPTY AT END OF COMMAND STRING)
/3	?IQN	NON-ALPHANUMERIC Q-REGISTER NAME
/4	?PDO	PUSHDOWN OVERFLOW (MACROS & ITERATIONS NESTED TOO DEEPLY)
/5	?MEM	TEXT BUFFER OVERFLOW
/6	?STL	SEARCH STRING TOO LARGE ( >31 CHARS)
/7	?ARG	NUMBER MISSING BEFORE COMMA
/		OR TWO ARGUMENTS SPECIFIED TO D
/		OR 3 NUMERIC ARGUMENTS
/8	?IFN	ILLEGAL FILE NAME IN "ER","EW" OR "EB" COMMAND
/9	?SNI	SEMICOLON ON COMMAND LEVEL
/10	?BNI	ITERATION CLOSE (>) WITHOUT MATCHING OPEN (<)
/11	?POP	ATTEMPT TO MOVE POINTER OUTSIDE OF TEXT BUFFER
/12	?QMO	Q-REGISTER STORAGE OVERFLOW
/13	?UTM	INCOMPLETE COMMAND (PDL NOT EMPTY AT END OF MACRO)
/14	?OUT	OUTPUT FILE TOO BIG OR OUTPUT PARITY ERROR
/15	?INP	PARITY ERROR ON INPUT FILE
/16	?FER	FILE ERROR: CAN MEAN EITHER
/		A)	INPUT FILE NOT FOUND ON "ER" COMMAND
/		B)	CANNOT ENTER OUTPUT FILE ON "EW" OR "EB" COMMAND
/		C)	DEVICE SPECIFIED FOR FILE DOES NOT EXIST
/		D)	"EB" COMMAND GIVEN ON NON-FILE-STRUCTURED DEVICE
/17	?FUL	OUTPUT COMMAND WOULD HAVE OVERFLOWED OUTPUT FILE
/		[PANIC MODE]
/18	?NAY	NUMERIC ARGUMENT SPECIFIED WITH Y COMMAND
/19	?IEC	E FOLLOWED BY AN ILLEGAL CHARACTER
/20	?IQC	" FOLLOWED BY AN ILLEGAL CHARACTER
/21	?NAE	NO NUMERIC ARGUMENT TO THE LEFT OF AN =
/22	?NAU	NO NUMERIC ARGUMENT TO THE LEFT OF A U
/23	?NAQ	NO NUMERIC ARGUMENT TO THE LEFT OF A "
/24	?SRH	FAILING SEARCH AT COMMAND LEVEL
/25	?NAP	NEGATIVE OR ZERO ARGUMENT TO P
/26	?NAC	NEGATIVE ARGUMENT TO COMMA
/27	?NYI	CASE SUPPORT NOT IMPL (USE W FOR WATCH)
/28	?
/29	?NAS	NEGATIVE OR ZERO ARGUMENT WITH A SEARCH
/30	?WLO	WRITE LOCKED SYSTEM DEVICE
/31	?IFC	F FOLLOWED BY AN ILLEGAL CHARACTER
/32	?YCA	Y (OR _) COMMAND ABORTED BECAUSE DATA WOULD BE LOST
/33	?CCL	CCL NOT FOUND OR EG ARGUMENT TOO LONG
/34	?XAB	EXECUTION ABORTED BY ^C
/35	?NYI	CASE SUPPORT NOT IMPL (USE EO FOR VERSION)
/36	?NFO	ATTEMPT TO OUTPUT WITHOUT OPENING AN OUTPUT FILE
\f/	CORE LAYOUT AND OVERLAY STRUCTURE

/	BUFFER STRUCTURE:

/BUFFER		8K VERSION	12K VERSION

/INPUT  BUFFER	06200-07200	25600-27600
/OUTPUT BUFFER	05200-06200	05200-07200
/Q-REG STORAGE	OVER TEXT BFR	20000-25600

/	HANDLER LOCATIONS:

/HANDLER	PDP-8 VERSION	PDP-12 VERSION

/INPUT  HANDLER	7200-7600	7200-7400
/OUTPUT HANDLER	4000-4400	7400-7600
/SIZE OF HNDLR	2-PAGES		1-PAGE
/DISPLAY CODE	NONE		4000-4400

/	OVERLAY STRUCTURE

/ALL OVERLAYS ARE TWO PAGES LONG AND RESIDE IN CORE
/AT LOCATIONS 3200-3600 WHEN RUNNING.  THE I-OVERLAY
/INITIALLY RESIDES IN THESE LOCATIONS.

/OVERLAY	BLOCK	INITIAL LOCATION	CONTENTS

/  I-OVERLAY	40	3200-3600	ER,EW,EB
/  Q-OVERLAY	41	5600-6200	", O, SKPSET
/  E-OVERLAY	42	6200-6600	ERROR MESSAGE PROCESSOR
/  X-OVERLAY	43	6600-7200	EX,EC,EG,EK,EF (EA,EI,EN,EP)
/  F-OVERLAY	44	7200-7600	ED,EH,EO,ES,ET,EU (EV)

	IOVRLC=40
	QOVRLC=41
	EOVRLC=42
	XOVRLC=43
	FOVRLC=44

	IOVRLY=3200
	QOVRLY=3201
	EOVRLY=3202
	XOVRLY=3203
	FOVRLY=3204

/EACH OVERLAY IS ASSIGNED A LOCATION AT THE BEGINNING OF PAGE 3200.
/IF THIS LOCATION IS 0 (AS IT ALWAYS IS), THEN THAT OVERLAY IS NOT
/IN CORE.  IF IT IS NOT 0, THEN THIS LOCATION CONTAINS THE
/BLOCK NUMBER TO READ IN THAT OVERLAY.
/THUS EACH OVERLAY HAS POINTERS TO ALL THE OTHER OVERLAYS.
\f	MEMLOC=2000

/IN 16K MACHINES, FIELD 3 IS USED TO HOLD OVERLAYS

/NAME	BLOCK	MEMORY

/I	40	2000
/Q	41	2400
/E	42	3000
/X	43	3400
/F	44	4000


/INITIAL MEMORY LAYOUT

/0000-3177	TECO
/3200-3577	OVERLAY AREA (INITIALLY I-OVERLAY)
/3600-3777	TECO
/4000-4377	PDP-12 DISPLAY ROUTINE
/4400-5177	TECO
/5200-5577	INITIALIZATION CODE
/5600-6177	Q-OVERLAY CODE
/6200-6577	E-OVERLAY CODE
/6600-7177	X-OVERLAY CODE
/7200-7577	F-OVERLAY CODE

/FIELD 1:

/4400-7377	EXTENDED ERROR MESSAGES
/		MOVES TO FIELD 3
\f/**  TECO KLUDGES **		/7/27/73
/ONE OF THE REASONS WHY TECO GETS SO MANY OPERATIONS
/INTO SUCH A SMALL AMOUNT OF CORE IS THAT IT
/IS FULL OF *K*L*U*D*G*E*S*.  THESE SHOULD BE KEPT IN MIND WHEN
/MODIFYING THE PROGRAM.  SOME OF THEM ARE:

/	THE "SORT" ROUTINE COMPARE LIST MUST END WITH A NEGATIVE NUMBER.
/	USUALLY A FORTITUOUS JMS OR OPR INSTRUCTION IS USED

/	THE "SORT" JUMP LIST ENTRIES ARE TREATED AS JUMP ADDRESSES
/	IF THEY ARE POSITIVE AND SUBSTITUTE VALUES IF THEY ARE
/	NEGATIVE - THEREFORE ALL LOCS JUMPED TO MUST BE BELOW 4000
/	ANOTHER CONSEQUENCE IS THAT "QUOTST" CANNOT BE CALLED FROM
/	ABOVE 4000

/	THERE ARE OTHER LOCALIZED KLUDGES - THEY CAN GENERALLY
/	BE IDENTIFIED BY THE APPEARANCE OF A DOUBLE-ASTERISK IN THE
/	COMMENTS FIELD ALONG WITH A TERSE DESCRIPTIVE COMMENT



/	OS/8 EQUIVALENCES:

JSBITS=	7746	/JOB STATUS BITS - IN FIELD 0
OSHNDT=	7647	/OS/8 DEVICE HANDLER TABLE - IN FIELD 1
OSDCBT=	7760	/OS/8 DEVICE CONTROL TABLE - IN FIELD 1
CCLADR=	400	/CCL OVERLAY LOAD ADDRESS
CCLOVL=	67	/BLOCK OF CCL OVERLAY
CCLOST=	602	/CCL OVERLAY SECONDARY START ADDRESS
\f	*0
NAME,	ZBLOCK	4	/NAME BUILD BUFFER - MUST BE AT LOCATION 0
			/LOCS 4,5&6 ARE RESERVED SO WE CAN USE OS/8 ODT

	*10	/CONSTANTS & NON-INDIRECT TEMPS STORED IN AUTO-XRS!
QUOTE,	33	/QUOTE CHAR - SINGLE WORD SORT LIST
ERR01,
SERR,	ERR	/END OF LIST
INRSIZ,	2	/4 IF 12K MACHINE
NUMLNS,	3	/NUMBER OF LINES (+ AND -) TO DISPLAY ON VR12 SCOPE
DX,	7577	/DISPLAY XR
SXR,	QPUT12-1/XR USED BY SEARCH PROCESSOR
INXR,	ASR33-1	/XR USED TO UNPACK INPUT BUFFER
XR,	ASR35-1	/WORK XR

NMT,	0	/USED  AS NUMBER TEMP AND SEARCH FAIL FLAG
CFLG,	0	/COMMA FLAG
CLNF,	0	/COLON FLAG
TFLG,	0	/TRACE FLAG
NFLG,	0	/NUMBER FLAG
QFLG,	0	/QUOTED STRING FLAG
M,	0	/NUMBER ARGS
N,	0
NLINK,	0	/LINK AFTER ARITH OPERATIONS - TESTED BY "A AND "B
CHAR,	0	/CHARACTER BUFFER
ITRST,	0	/ITERATION FLAG
ITRCNT,	0	/ITERATION COUNT
MPDL,	0	/MACRO FLAG
SCHAR,	0	/LAST CHAR SORTED
FFFLAG,	0	/FORM FEED FLAG - 7777 IF FORM FEED SEEN ON THIS READ
REND,	0	/INPUT END-OF-FILE FLAG
SCANP,	0	/COMMAND LINE EXECUTION POINTER
OSCANP,	0	/BACKUP FOR SCANP
PDLP,	PDLBEG	/PUSH-DOWN-LIST POINTER
QCMND,	0	/COMM LINE OR MACRO POINTER
P,	0	/CURRENT PNTR TO TEXT BUFFER
ZZ,	0	/END OF TEXT BUFFER POINTER
Q,	0	/EXTRA BUFFER POINTERS
	IFNZRO .-47 <_ERROR_>
R,	0
QP,	0	/Q REGISTER POINTER
QZ,	CHNSTR	/END OF Q-REG POINTER
Z7,
CTLBEL,	7
CACR,	15	/CR
CAHT,	11	/HT
CAAM,	33	/ALT MODE
CAFF,	14	/FF: END OF PAGE
	13	/VT
CALF,	12	/LF
ERR07,
NERR,	ERR	/END OF LIST
RADIX,	DRAD	/RADIX TABLE POINTER - DRAD OR ORAD
\fMQ,	0
DVT1,	0
ODEV,	0	/OUTPUT DEVICE NUMBER
OUTHND,	0
INHND,	0
EBFLG,	0	/EDIT BACKUP FLAG
QNMBR,	0	/LAST Q-REG REFERENCED
QBASE,	0	/BASE OF CURRENT COMMAND LINE
QLENGT,	0	/LENGTH OF CURRENT COMMAND LINE
QPTR,	0	/POINTER TO Q-REGISTER CONTROL BLOCK
ICRCNT,	0	/INPUT DOUBLEWORD COUNTER
OCRCNT,	0	/OUTPUT "
OPTR2,	0	/OUTPUT BUFFER POINTER
INRCNT,	0	/NUMBER OF INPUT RECORDS LEFT
OCMDLN,	0	/LENGTH OF OLD COMMAND LINE
CDT,	0
KTYPE,	TYPE		/*ET SET TO PUTT IF NO CONVERSION
TEMPT,	0		/TEMP.  GET RID OF WHEN FIND ROOM ON PAGE
MEMSIZ,	0		/HIGHEST MEMORY FIELD IN BITS 9-11
LASTC,	0		/LAST CHARACTER GOTTEN OUT OF COMMAND LINE

/NFLG:	0'ED BY COMMANDS WHICH EAT ARGUMENTS OR DON'T RETURN
/	VALUES; SUCH AS C,R,J,L,^A,X,$,',>,'U,G,O AND
/	NON-COLON MODIFIED SEARCHES
/	SET TO -1 TO INDICATE THATWWE'VE SEEN A NUMBER
\f	/TECO PSEUDO-OPERATIONS

PUSH=	JMS I	.;	PUSHXX
POP=	JMS I	.;	POPXX	/** MUST BE ONE MORE THAN "PUSH"
PUSHJ=	JMS I	.;	PUSHJY
POPJ=	JMP I	.;	POPJXX
PUSHL=	JMS I	.;	PUSHLX
POPL=	PUSHL			/** POPL CALLED WITH POSITIVE AC

ERR=	JMS I	.;ERROR,ERRXX
SORT=	JMS I	.;	SORTB
RESORT=	JMP I	.;	SORTA2
SCAN=	JMS I	.;	SGET
LISTEN=	JMS I	.;	TYI
TYPE=	JMS I	.;	TYPCTV
OUTPUT=	JMS I	.;OUTR,	ERRXX	/** MUST BE ONE MORE THAN "TYPE"
				/PROBABLY NOT ANY MORE (19-JUN-77)
CRLF=	JMS I	.;	TYCRLF
GETQ=	JMS I	.;	GETQX
SKPSET=	JMS I	.;	SETSKP
NCHK=	ISZ	NFLG		/USED TO BE A SUBROUTINE CALL
CTCCHK=	JMS I	.;	CHKCTC
BZCHK=	JMS I	.;	CHKBZ
QCHK=	JMS I	.;	CHKQF
QSKP=	JMS I	.;	QOVER
QREF=	JMS I	.;	QREFER
\fQSUM=	JMS I	.;	QSUMR
QPUT=	JMS I	.;	QPUTS
QUOTST=	JMS I	.;	QTST
SETCMD=	JMS I	.;	CMDSET
GETN=	JMS I	.;	NGET
ADJQ=	JMS I	.;	QADJ
MQLDVI=	JMS I	.;	DVIMQL
UPPERC=	JMS I	.;	CUPPER
SCANUP=	JMS I	.;	SCUPPR
TSTSEP=	JMS I	.;	SCHSRT
DISPLY=	JMS I	.;	DSPLAY
NOTRCE=	JMS I	.;	SAVTRA
ENTRCE=	JMS I	.;	RESTRA
OVRLAY=	JMS I	.;	OVERLY
GETNUM=	JMS I	.;	NUMGET	/GET 13 BIT NUMBER INTO L,AC
PUTT=	JMS I	.;	TPUT
	PAGE
\f/ENTER HERE TO USE AN ASR33 AS THE TELETYPE

TECO,	ISZ I	SPUT	/IF CALLED BY "R" OR "RUN" - CHANGED TO TLS
TECO1,	JMP I	COMPAR	/IF CALLED VIA "CHAIN" - CHANGED TO "JMP T0A"
TBEL,	JMS	COMPAR	/HERE ON ^G - 2 ^G'S KILL ENTIRE COMMAND

T0,	CRLF
T0A,	TAD	(PDLBEG
	DCA	PDLP	/INITIALIZE PUSHDOWN LIST
T1,	TAD	PDLP
	TAD	(-PDLBEG
	SZA CLA
ERR02,	ERR		/ERROR - PUSHDOWN LIST DID NOT BALANCE
	TAD	(45
	QREF		/SET UP POINTERS TO COMMAND LINE
	TAD I	[QPNTR
	DCA	OCMDLN	/SAVE OLD COMMAND LINE LENGTH
			/** SAVE ONLY IF < 20?
	ADJQ		/REDUCE COMMAND LINE LENGTH TO 0
	CLL
	PUSHJ
		NRET	/CLEAR NUMBER AND LAST OPERATOR
	DCA	CFLG
	DCA	MPDL	/DELETE MACRO FLAG
	DCA	ITRST	/ALSO ITERATION FLAG,
	DCA	CLNF	/AND COLON FLAG
	PUSHJ		/KILL QUOTE FLAG
		ZROSPN	/KILL QUOTE AND NUMBER FLAGS AND SCAN POINTER
	KCC		/KILL ^O IF IN KEYBOARD BUFFER
	DCA I	(CHOOPS	/KILL FATAL ERROR RETURN
	TAD	[52
	SKP
ROCMND,	JMS I	(BACKUP	/BACK UP AND GET LAST CHAR
	TYPE
T2M1,	DCA	CHAR	/KILL CHAR TO PREVENT SPURIOUS DOUBLE CHARACTERS
T2,	LISTEN		/BUILD COMMAND LINE
	SORT
		COMLST
		COMTAB-COMLST
T2A,	DCA	CHAR
	JMS	SPUT	/PUT INTO C.L. BUFFER
	JMP	T2	/GO GET ANOTHER
\fTCTLU,	TAD	SCHAR
	TYPE		/PRINT "^U"
TCTLUP,	JMS I	(BACKUP
	TAD	[-12	/CHECK FOR LF
	SZA CLA
	JMP	TCTLUP	/LOOP UNTIL LF
	IAC
	JMP I	(TSP9

TCRLF,	TAD	CACR	/CR IN COMM LINE
	DCA	CHAR
	JMS	SPUT	/PUT INTO COMM LINE
	TAD	CALF	/THEN PUT IN A LF
	JMP	T2A	/AND GET SOME MORE
\f	/COMMAND EXECUTION LOOP

TALTM,	JMS	COMPAR	/2ND ALTM STARTS EXECUTION
	CRLF		/START COMM EXECUTION
CHTECO,	TAD	(45	/NUMBER OF INPUT COMMAND Q-REGISTER
	SETCMD		/SET UP THE INPUT LINE AS THE CURRENT COMMAND LINE
T6,	SCANUP
T6A,	DCA	CHAR	/SAVE COMMAND CHAR
	TAD	CHAR
	TAD	(CDSP	/ADD BASE OF DISPATCH TABLE
	DCA	T7	/LOOK UP ENTRY IN
	TAD I	T7	/COMMAND DISPATCH TABLE
	DCA	T7	/CALL RECURSIVELY
	CLL
	PUSHJ
T7,		0	/CALL TO ROUTINE
	CTCCHK		/CHECK FOR ^C - ** AC MAY NOT BE 0 HERE **
	CLA		/CTCCHK LEAVES AC NON-ZERO
	TAD	NFLG
	SPA CLA
	JMP	T6
	DCA	N	/IF WE ARE NOT ENTERING A NUMBER
	DCA	NLINK	/SET 13-BIT N TO 0
	JMP	T6	/KEEP INTERPRETING
TQMK,	TAD I	ERROR
	SNA CLA		/ERROR ROUTINE ENTRY POINT NON-ZERO?
	RESORT		/NO
	STA		/AN ERROR PRINTOUT
	DCA	QLENGT	/SET QLENGT BIG SO WE CAN ACCESS ENTIRE LINE
	NOTRCE		/TURN TRACE OFF
	SCAN
	TYPE		/PRINT OUT THE LINE WHICH CAUSED THE ERROR
	ISZ I	ERROR	/UP TO THE ERROR CHAR ITSELF
	JMP	.-3
	JMP	T0	/RE-INITIALIZE

CHUA,	POP		/^ COMMAND - POP OFF RETURN ADDRESS
	SCANUP		/GET THE NEXT CHARACTER IN UPPER CASE
	AND	[77	/MAKE IT A CONTROL CHARACTER
	JMP	T6A	/USE IT INSTEAD OF THE ^
\fCOMPAR,	TCINIT		/LOOK FOR DOUBLED COMM LINE CHARS
	TAD	SCHAR	/MOST RECENT
	CIA
	TAD	CHAR	/PREVIOUS
	SZA CLA
	RESORT		/NOT THE SAME
	JMS	SPUT	/PUT THE CHAR INTO THE COMMAND LINE AND ECHO IT
	JMP I	COMPAR	/SAME-SPECIAL HANDLING

SPUT,	JTECO		/PUT CHAR INTO COMM LINE
	TAD	QZ
	DCA	QP
	TAD	CHAR
	QPUT		/STORE CHARACTER AWAY
	TAD I	[QPNTR
	IAC
	ADJQ		/ADJUST COMMAND LINE REGISTER LENGTH
	DCA I	ERROR	/CLEAR "ERROR JUST OCCURRED" FLAG
	TAD	CHAR
	TYPE		/TYPE THE INSERTED CHARACTER
	TAD I	[QPNTR
	TAD	CALF	/12
	SPA CLA
	JMP	EMERG	/TYPE BELL IF WITHIN 12 CHARACTERS OF 2048
	CLL
	TAD	QZ
	TAD	QLIMIT
	SNL CLA		/TYPE A BELL IF THE LINE IS
	JMP I	SPUT	/ WITHIN 12 CHARS OF OVERFLOW
EMERG,	TAD	Z7
	TYPE
	JMP I	SPUT
QLIMIT,	12-QMAX
	PAGE
\f	/Q REGISTER PACK AND UNPACK
	/THE Q-REGISTERS ARE STORED IN THE UPPER 4 BITS OF THE WORDS
	/WHICH HAVE THE TEXT BUFFER CHARACTERS IN THEIR LOWER 8 BITS.
	/THEREFORE EACH Q-REGISTER CHARACTER TAKES 2 WORDS.

QPUTS,	0		/STORE THROUGH POINTER "QP" AND BUMP POINTER
	CLL RTL
	RTL
	DCA	GETQX	/SAVE CHARACTER
	TAD	QP
	CLL RAL
	DCA	CHKCTC	/COMPUTE CORE POINTER = 2*QP
	CDF 10
	TAD	GETQX
	JMS	ST4BTS	/STORE HIGH ORDER 4 BITS
	ISZ	CHKCTC
	TAD	GETQX
	CLL RTL
	RTL
	JMS	ST4BTS	/STORE LOW ORDER 4 BITS
	CDF 0
	ISZ	QP	/BUMP POINTER
	JMP I	QPUTS

GETQX,	0
	CLL RAL
	DCA	CHKCTC	/COMPUTE CORE POINTER = 2*AC
	CDF 10
	TAD I	CHKCTC
	AND	[7400	/FETCH HIGH ORDER
	ISZ	CHKCTC
	DCA	QPUTS
	TAD I	CHKCTC
	AND	[7400	/FETCH LOW ORDER
	CLL RTR
	RTR
	TAD	QPUTS	/COMBINE TO FORM CHARACTER
	RTR
	RTR
	CDF 0
	JMP I	GETQX

ST4BTS,	0
	AND	[7400
	DCA	POPXX
	TAD I	CHKCTC
	AND	[377
	TAD	POPXX
	DCA I	CHKCTC	/STORE HIGH ORDER
	JMP I	ST4BTS
\fCHKCTC,	0		/SUBROUTINE TO CHECK FOR ^C IN KEYBOARD
	CLA OSR		/** AC MAY NOT BE 0 ON ENTRY
	DCA	QPUTS	/GET LOCATION FROM SWITCH REGISTER
	TAD I	QPUTS
	7421		/DISPLAY INDICATED LOCATION IN MQ
C7600,	7600		/JUST IN CASE THERE IS NO MQ
	KSF
	JMP I	CHKCTC	/NO CHAR IN KEYBOARD BUFFER - EXIT
	KRS
	AND	[177	/KILL PARITY BIT
	TAD	[-20	/^P OUGHT TO GO AWAY
	SZA
	TAD	CACR
	SZA		/^C?
	JMP I	CHKCTC	/NO - RESUME WITH NON-ZERO AC
ERR34,	ERR		/^C, EXECUTION ABORTED

CTLC,	TSF
	JMP	CTLC	/WAIT FOR TELETYPE TO DIE DOWN
	JMP I	C7600	/RETURN TO OS/8


POPJXX,	DCA	GETQX	/POPJ ROUTINE
	POP
POPJXY,	DCA	POPXX
	TAD	GETQX
	JMP I	POPXX
\f	/PUSH DOWN LIST ROUTINES

POPXX,	0		/POP ROUTINE
	CLA CMA
	TAD	PDLP
	DCA	PDLP
	TAD I	PDLP
	JMP I	POPXX

PUSHXX,	0		/PUSH ROUTINE (DOESN'T AFFECT LINK)
	DCA I	PDLP
	ISZ	PDLP	/BUMP PUSHDOWN POINTER
	TAD	PDLP	/CHECK FOR EXACTLY FULL - THIS ALLOWS THE
	TAD	(-PDLEND
	SNA CLA		/** ERROR ROUTINE TO DO A PUSHJ
ERR04,	ERR		/FULL - REPORT IT
	JMP I	PUSHXX

PUSHJY,	0		/PUSHJ ROUTINE (DOESN'T AFFECT LINK)
	DCA	GETQX
	IAC		/** LINK SHOULD BE PRESERVED ON EXIT
	TAD	PUSHJY
	PUSH
	TAD I	PUSHJY
	JMP	POPJXY

PUSHLX,	0		/PUSH AND CLEAR A LIST
	CLL
	SMA		/PUSH LIST IF AC<0, POP IT IF >=0
	CMA STL
	DCA	PUSHJY	/SET COUNTER
	RAL		/** DEPENDS ON FACT THAT POP=PUSH+1 **
	TAD	PUSHYY
	DCA	PUSHYX	/STORE EITHER A "PUSH" OR A "POP"
	POP		/SAVE RETURN POINTER
	DCA	CHKCTC
PUSHLP,	TAD I	PUSHLX
	DCA	GETQX
	TAD I	GETQX
PUSHYX,	PUSH		/PUSH OR POP
	DCA I	GETQX	/IF PUSHYX=PUSH, THIS ZEROES THE PUSHED LOCATION
	ISZ	PUSHLX
	ISZ	PUSHJY
	JMP	PUSHLP
	TAD	CHKCTC	/RESTORE RETURN POINTER
PUSHYY,	PUSH
	JMP I	PUSHLX
\fTPUT,	0		/TELETYPE OUTPUT
	DCA	TEMPT
TPUTX,	CTCCHK		/CHECK FOR ^C OR ^P
	TAD	(3-17	/INHIBIT PRINTING AS LONG AS THERE
	SNA		/IS A ^O IN THE KEYBOARD BUFFER.
	JMP I	TPUT
	TAD	(17-23	/CHECK FOR ^S
	SNA CLA
	JMP	TPUTX
	TSF		/WAIT FOR TELETYPE FLAG
TSFWT,	JMP	.-1	/WHILE WAITING, DISPLAY TEXT ON SCOPE
	TAD	TEMPT
	TLS
	CLA
	JMP I	TPUT
	PAGE
\f/POINTER MOVING COMMANDS - C,R,J,L

CHRJ,	DCA	NFLG	/COMMAND J
	GETNUM		/CAUSE NEG ARGUMENT TO GIVE A POP
	JMP	CLOQ

CHRR,	GETN		/GET LAST NUMBER, DEFAULT=(+ OR -)1
CHR1,	CML CIA		/NEGATE 13-BIT NUMBER
	SKP
CHRC,	GETN		/GET LAST NUMBER, DEFAULT=(+ OR -)1
	TAD	P	/OFFSET RELATIVE TO .
/
/	*** LINK NOT ALWAYS SET RIGHT
/
CLOQ,	BZCHK		/SEE IF IN RANGE B,Z
	DCA	P	/IN RANGE
DNN3,	CDF 0
	POPJ

CHRL,	GETN		/GET LAST NUMBER, DEFAULT=(+ OR -)1
CHRL1,	CDF 10
	SZL SNA
	JMP	LNEG
	CIA
	DCA	CDT
CHRLP,	TAD	P
	CIA
	TAD	ZZ
	SNA CLA		/IF WE ARE AT THE END OF THE BUFFER,
	JMP	DNN3	/RETURN
	JMS I	(CHLCMP	/COMPARE CHARACTER AGAINST LINE FEED
	ISZ	P
	JMP	CHRLP	/KEEP GOING UNTIL WE GET THERE OR OVERFLOW BUFFER
LNEG,	TAD	(-1
	DCA	CDT
CHRLM,	CLA CMA CLL
	TAD	P
	DCA	P	/MOVE POINTER BACKWARD 1
	SNL
	JMP I	(CHRLI	/OOPS - PAST THE BEGINNING OF THE BUFFER - RETURN
	JMS I	(CHLCMP	/COMPARE CHARACTER AGAINST LINE FEED
	JMP	CHRLM	/NOT SATISFIED YET - KEEP LOOPING

NUMGET,	0		/PUT 13-BIT NUMBER IN L,AC
	TAD	NLINK
	CLL RAR
	TAD	N
	JMP I	NUMGET
\f/D COMMAND AND PART OF ADJUST ROUTINE

CHRD,	ISZ	CFLG	/WAS THERE A COMMA?
	SKP		/NO
	JMP	NERR	/YES, 2 ARGS TO D
	GETN		/GET LAST NUMBER, DEFAULT=(+ OR -)1
	SNL		/SIGN BIT OF 13-BIT NUMBER IS IN LINK
	JMP	PLUSND	/+ND
	CLL CIA
	DCA	CDT	/-ND
	TAD	CDT
	PUSHJ		/DO (-)NC(+)ND
		CHR1
	TAD	CDT
	JMP	PLUSND

ADJ,	SNA		/ADJUST BUFFER + OR - N CHARS
			/TEST FOR NOTHING
	POPJ		/GO AWAY
	STL		/MOVE UP N CHARACTERS
	TAD	ZZ	/ADD TO MAX CHARACTER
	DCA	R	/NEW HIGHEST
	TAD	R	/SEE IF TOO HIGH
	TAD	(-ZMAX
	SNL SZA CLA	/TWO PLACES FOR OVERFLOW THERE
ERR05,	ERR
	TAD	ZZ
	DCA	Q
	TAD	R
	DCA	ZZ
	CDF 10
UPNL,	TAD	Q
	CIA
	TAD	P
	SNA CLA		/FINISHED?
	JMP	DNN3	/YES
	CMA
	TAD	Q
	DCA	Q
	CMA
	TAD	R
	DCA	R
	TAD I	Q	/GET A CHAR
L12K1,	AND	[377	/JMP .+5  IF 12K
	DCA	CHLTMP
	TAD I	R	/BE CAREFUL NOT TO
	AND	[7400	/DESTROY THE HIGH-
	TAD	CHLTMP	/ORDER 4 BITS
J12K1=	JMP	.
	DCA I	R	/AND PUT IT IN THE LOW PART OF THE TARGET WORD
	JMP	UPNL
\f/K COMMAND AND MORE OF ADJUST ROUTINE

CHRK,	JMS I	(NLINES	/CONVERT LINES TO CHARS
	DCA	CDT
	TAD	M	/SET POINTER
	DCA	P	/LOWER ARG
	TAD	CDT
PLUSND,	SNA
	POPJ		/IGNORE 0D
ADJ2,	CLL
	TAD	P	/MOVE DOWN N CHARACTERS
	SZL
	CLA CMA		/DETECT GROSS OVERFLOWS
			/** CHECK
	BZCHK
	DCA	Q	/N IN AC
	TAD	P
	DCA	R
	CDF 10
DNN1,	TAD	ZZ
	CIA
	TAD	Q
	SNA CLA		/FINISHED?
	JMP	DNN2
	TAD I	Q	/GET A CHAR
L12K2,	AND	[377	/JMP .+5  IF 12K
	DCA	CHLTMP
	TAD I	R	/BE CAREFUL NOT TO
	AND	[7400	/DESTROY THE HIGH-
	TAD	CHLTMP	/ORDER 4 BITS
J12K2=	JMP	.
	DCA I	R	/AND PUT IT IN THE LOW PART OF THE TARGET WORD
	ISZ	Q
	ISZ	R
	JMP	DNN1
DNN2,	TAD	R
	DCA	ZZ
	JMP	DNN3

CHLTMP,	0

/GO TO ADJ TO MOVE UP TEXT
/GOTO ADJ2 TO MOVE DOWN TEXT
/IN EITHER CASE, AC CONTAINS NUMBER OF CHARS TO MOVE (0-4095)

ERR27,	ERR		/^W
ERR35,	ERR		/^V
	PAGE
\f/SEARCH SUBROUTINE - CALLED BY N, S, AND _ COMMANDS

SEARCH,	0
	DCA	REPFLG	/AC MAY BE NON-0 TO ALLOW A REPLACE
	GETN
	SZL SNA
ERR29,	ERR		/NEG OR 0 ARG TO SEARCH
	CIA
	DCA	CSN	/GET NUMBER OF OCCURRANCES TO SEARCH FOR
	QCHK		/GET REPLACEMENT FOR ALTMODE, IF ANY
	TAD	(STABLE-1
	DCA	SXR	/INITIALIZE XR
	TAD	[-40
	DCA	CSP
SGTLP,	QUOTST		/GET A CHARACTER FROM THE SEARCH STRING
	JMP	SCHQUO	/OOPS- NO MORE
	SORT		/SEE IF ITS SPECIAL
		SCHLST
		SCHTAB-SCHLST
SSTCHR,	DCA I	SXR	/STORE THE CHAR IN THE SEARCH BUFFER
	ISZ	CSP
	JMP	SGTLP	/LOOP
ERR06,	ERR		/OOPS - SEARCH BUFFER FULL!

SCHQUO,	TAD	CSP
	TAD	[40	/A NULL SEARCH STRING MEANS USE THE
	SZA CLA		/PREV CONTENTS OF THE SEARCH BUFFER, ELSE
	DCA I	SXR	/STORE TERMINATING 0 AND BEGIN THE SEARCH
CSST,	TAD	P
	DCA	CSP
	JMP	CSF1
SCHINV,	TAD	CSNCL	/^N, INVERT SKIP SENSE
	DCA	CSWT

CSL,	TAD I	SXR	/GET A CHAR FROM THE SEARCH BUFFER
	SPA SNA
	JMP	SCCOMD	/NEGATIVE CHARS AND 0 ARE SPECIAL
	CIA
	CDF 10
	TAD I	P
	AND	[377
CSWT1,	CDF 0
CSWT,	SZA CLA
	JMP	CSF	/FAIL TO MATCH ON THIS CHARACTER
	ISZ	P
CSG,	TAD	CSZCL
	DCA	CSWT	/RESTORE SEARCH TEST
	TAD	ZZ
	CMA
	TAD	P
CSZCL,	SZA CLA		/CHECK FOR END OF BUFFER
	JMP	CSL	/NO
	DCA	P
CSZ,	DCA	NMT
	JMP I	SEARCH
\f/SEARCH SUBROUTINE - CONTINUED

SCCOMD,	DCA	.+1	/SPECIAL CHARACTERS ARE JUMPS OR 0
	HLT		/0 FALLS THROUGH INTO TERMINATION CODE
	ISZ	CSN	/GET NTH OCCURRENCE
	JMP	CSF	/MORE TO GO
	CMA
	JMP	CSZ	/GOT IT
CSF,	ISZ	CSP	/INDEX P
CSF1,	TAD	(STABLE-1
	DCA	SXR	/INITIALIZE AUTO - INDEX
	TAD	CSP
	DCA	P
	JMP	CSG

/SEARCH STRING MODIFIERS ^N,^Q,^S, AND ^X

SCHTAB,	JMP	SCHINV	/^N: ANYTHING BUT
	SCHCTQ		/^Q: LITERALLY
	JMP	SCHSEP	/^S: ANY SEPARATOR
	JMP	CSWT1	/^X: ANYTHING

SCHCTQ,	SCAN		/GET THE NEXT CHARACTER
	JMP	SSTCHR	/AND STORE IT IN PLACE OF THE ^Q

SCHSEP,	CDF 10		/^S, LOOK FOR SEPARATOR
	TAD I	P
	AND	[377
	TSTSEP		/SHARED SORTING ROUTINE
	SKP
	CMA		/SET AC = -1 IF NON-SEPARATOR
	JMP	CSWT1	/GO CHECK RESULTS

FN,	DCA	CNXT
	STA
	JMP	CHRN1
\f/S,N AND _ COMMANDS (ALSO FS AND FN)

FS,	STA		/CHANGE S TO FS
CHRS,	JMS	SEARCH	/S COMMAND - DO A SEARCH
CHKREP,	ISZ	REPFLG	/WAS THERE A REPLACE SPECIFIED?
	JMP	CHKCLN	/NO - CHECK FOR COLON
	QSKP		/COUNT UP STRING 2
	TAD	NMT
	SMA CLA
	JMP	CHKCLN	/FAILED, SET VALUE & EXIT
	TAD	CSP	/FIGURE OUT OFFSET TO FAKE OUT "I" ROUTINE
	CIA		/SO THAT WE HAVE THE RIGHT INSERTION COUNT
	TAD	P	/BUT THE SIZE OF THE HOLE WE NEED
	DCA	DVT1	/IS DECREASED BY THE LENGTH OF THE SEARCH STRING.
	TAD	CSP	/RESET
	DCA	P	/TEXT POINTER
	PUSHJ		/INSERT
		CIL2	/STRING 2
CHKCLN,	DCA	REPFLG	/CLEAR REPLACE FLAG
	TAD	NMT
	PUSHJ		/FORM NUMBER FROM "NMT"
		NNEW13	/(APPLYING OPERATOR, IF NECESSARY)
	ISZ	CLNF	/WAS THERE A COLON ON THIS SEARCH?
	SKP		/NO
	JMP I	[IREST	/YES - GO AWAY REGARDLESS OF RESULTS
	DCA	CLNF	/RESET COLON FLAG TO 0
	ISZ	N	/DID WE SUCCEED?
	JMP I	(CFSI	/NO - SIMULATE A SEMICOLON
	DCA	NFLG	/YES - HOWEVER, NO COLON MEANS NO RESULT
	JMP I	[IREST

CHBA,	CLA IAC		/_ COMMAND
CHRN,	DCA	CNXT	/N COMMAND - SET OUTPUT FLAG
CHRN1,	JMS	SEARCH	/DO A SEARCH
	TAD	REND
	CIA
	TAD	ZZ
CSNCL,	SNA CLA		/HAVE WE REACHED END-OF-FILE?
	JMP	CHKREP	/YES - STOP AND ASSIGN VALUE
	TAD	NMT
	SZA CLA		/HAVE WE SUCCEEDED?
	JMP	CHKREP	/YES - STOP AND ASSIGN VALUE
	TAD	CNXT
	JMS I	[NXTBUF	/GET NEXT BUFFER
	JMP	CSST	/KEEP SEARCHING - RETURN TO CHRN+2
CNXT,	0		/OUTPUT FLAG
CSP,	0		/TEMP P
CSN,	0
REPFLG,	0		/REPLACE FLAG (-1 MEANS REPLACE)
	PAGE
\f/NUMBER PROCESSORS:
/COMMANDS B,H,Z,. AND DIGITS


NMBR,	TAD	CHAR	/NUMBER FOUND IN COMMAND STRING
	TAD	[-60
NMBR2,	DCA	NMT
	CLL
	NCHK		/CHECK NUMBER FLAG
	JMP	NNEW	/NOT UP, NEW OPERAND
	TAD	DOPR
	DCA	NOPR	/USE SAME OPERATOR AS FOR THE PREVIOUS DIGITS
	TAD	NP	/MULTIPLY PREV DIGITS BY 10
	CLL RTL
NMRBAS,	TAD	NP	/REPLACED BY "NOP" FOR OCTAL
	CLL RAL		/** COULD CHECK FOR OVERFLOW IN THIS AREA
NNEW,	TAD	NMT
NCOM,	DCA	NP	/CURRENT NUMBER
/	RAL
/	DCA	NEWLNK
/	TAD	NEWLNK	/GET NEW LINK
/	CLL RAR		/INTO LINK
NCOM2,	TAD	NP

NOPR,	SKP		/DISPATCH JUMP FOR OPERATOR
	CML CIA
	TAD	NACC	/CURRENT EXPRESSION VALUE
	DCA N
	RAL
	TAD	NACCLK	/ADD IN OLD LINK
	RAR
	SKP CLA
NRET,	DCA	N
	RAL
	DCA	NLINK	/SAVE LINK FOR POSSIBLE COMPARISON TEST
	TAD	NOPR
	DCA	DOPR
	TAD	NULLOP
	DCA	NOPR	/SET OPERATOR TO NULL OP
	STA
	JMP	DCPOPJ	/SET NUMBER FLAG AND EXIT
\fCCPR,	STL CLA RTL	/2
	POPL
		NOPR
		NACC
		NACCLK
	GETNUM
	JMP	NCOM	/COMBINE OLD NUMBER AND PARENTHESIZED RESULT

COPR,	MTHREE
	PUSHL
		NACCLK
		NACC
		NOPR
	DCA	N
	DCA	NLINK
	JMP	CPLS	/CLEAN OUT INSIDE PARENS

CDOT,	TAD	P	/COMMAND .
/** COULD CAUSE ERROR IF NFLG SET
	JMP	NCOMCL
/NEWLNK,	0
\f	/COMMANDS &,#,/,*,-,+,(,)

CAMP,	MTWO				/*K* LOGICAL AND **
CNBS,	TAD	(NIOR-NDIV		/LOGICAL OR
CVIR,	TAD	(NDIV-NMPY		/DIVISION
CAST,	TAD	(NMPY&177+5200-7400	/MULTIPLICATION
CMIN,	TAD	[7400-SKP		/SUBTRACTION
CPLS,	TAD	(SKP			/ADDITION
	DCA	NOPR	/COMMON TO ALL NUMERIC OPERATORS
	TAD	N
	DCA	NACC
	TAD	NLINK
	DCA	NACCLK
	DCA	NP
DCPOPJ,	DCA	NFLG	/CLEAR NUMBER FLAG
	POPJ

NAND,	AND	NACC	/BITWISE AND OF BINARY NUMBERS
	JMP	NRET	/** KEEP THESE TWO OPNS TOGETHER
NIOR,	CMA		/BITWISE OR OF BINARY VALUES
	AND	NACC
	TAD	NP
NULLOP,	JMP	NRET

NACCLK,	0		/LINK OF EXPRESSION WITHOUT NP
NMPY,	CIA		/*** REALLY OUGHT TO IMPLEMENT 13-BIT MULTIPLY
	DCA	ND
	TAD	NACCLK
	RAR		/SET UP OLD LINK
	TAD	NACC
	ISZ	ND
	JMP	.-2
	JMP	NRET
NACC,	0		/VALUE OF EXPRESSION WITHOUT NP
NDIV,	DCA	ND
	TAD	NACC
	MQLDVI
ND,	0
	JMP	NRET
\f/COMMANDS ^F,^^,^Z,^V, Q AND %, ^D, ^O

CTLF,	CLA OSR SKP	/^F COMMAND - VALUE OF CONSOLE SWITCHES
CTUA,	SCAN		/^^ COMMAND - VALUE OF NEXT CHAR IN COMMAND LINE
NCOMCL,	CLL
	JMP	NCOM	/GO INTO NUMBER PROCESSOR

/CTLZ,	TAD	QZ	/COMMAND ^Z
/	JMP	NCOM	/RETURN NUMBER OF CHARACTERS IN ALL Q-REGS.
/CTLV,	TAD	(VERSN	/^V COMMAND - RETURNS THE CURRENT VERSION NUMBER
/NCOM14,	CLL
/	JMP	NCOM

CTLD,	TAD	[4	/SET RADIX DECIMAL
CTLO,	TAD	(ORAD	/SET RADIX OCTAL
	DCA	RADIX
	TAD I	RADIX
	DCA	NMRBAS	/EITHER "NOP"(8) OR "TAD NP"(10)
	POPJ

DOPR,	0		/PREVIOUS OPERATOR
NP,	0		/VALUE OF CURRENT NUMBER

SCPTAB,	BBELL
	BCR
	BCR		/TAB
	EASYRO		/ALT
	BFF
	BVT
	BLF

CTLN,	TAD	REND
	CMA
	JMP I	(NNEW13

CQSM,	TAD	TFLG
	CMA		/TRACE FLAG ALTERNATES BETWEEN 0 AND 7777
	DCA	TFLG
	POPJ
\fFTAB,	FN
	FS
FLST,	116		/FN
	123		/FS

CHRF,	SCANUP		/COMMAND F
	SORT
		FLST
		FTAB-FLST
ERR31,	ERR		/BAD F COMMAND

CCLN,	STA		/: COMMAND - SET VALUE FLAG
	DCA	CLNF
	POPJ		/SO NEXT SEARCH WILL HAVE A NUMERIC VALUE
	PAGE
\f/CURSOR RIGHT IS $C
/CURSOR UP IS $A
/ERASE LINE IS $K

BUGFLG,	0		/-1 MEANS MUST RETYPE LINE ON NEXT RUBOUT

BSP,	0
	TAD	TTY10
	PUTT		/TYPE BS, SPACE, BS
	TAD	TTY40
	PUTT
	TAD	TTY10
	PUTT
	STA
	TAD I	(COLCT	/FIX UP COLUMN COUNTER
	DCA I	(COLCT
	JMP I	BSP
\fSCOPY,	JMS I	(BACKUP	/BACK UP ONE CHAR IN CMD LINE
	TAD	[-40	/LOOK AT CHAR WE BACKED OVER
	SMA
	JMP	EASYRO	/IT'S EASY TO RUB THIS ONE OUT
	TAD	[40	/RESTORE CHARACTER
	SORT
		CTLBEL
		SCPTAB-CTLBEL
BBELL,	CLA
	JMS	BSP	/^X NEEDS TWO RUB OUTS
EASYRO,	CLA
	ISZ	BUGFLG	/MAYBE WE REALLY SHOULD REPRINT LINE
TTY10,	SKP		/NOT NECESSARY
	JMP	BCR	/NECESSARY (PREVIOUS VERTICAL MOTION MAY
			/HAVE SCROLLED OFF TOP OF SCREEN)
	JMS	BSP	/RUB IT OUT
SCOPGO,	DCA	BUGFLG
	JMP I	(T2M1

BCR,	JMS	BELLSP	/REPRINT LINE
	JMS I	SCAPE
	113		/ERASE LINE
	JMP	SCOPGO

BLF,	TAD	CTLBEL	/CURSOR UP 1
BFF,	TAD	(-4	/CURSOR UP 8
BVT,	TAD	(-4	/CURSOR UP 4
	DCA	BSP
	JMS I	(ESCAPE
	101		/CURSOR UP
	ISZ	BSP
	JMP	.-3
TTY40,	STA
	JMP	SCOPGO
\fTSTAR,	DCA	BCHAR
TSPACE,	TAD	CHAR	/LOOK AT PREVIOUS CHARACTER
	TAD	(-7
	SZA CLA		/WAS IT ^G ?
	RESORT		/NO
	STA		/YES
TSP9,	TAD I	[QPNTR	/REDUCE CMD LINE BY 1 CHAR
	ADJQ		/I.E. GET RID OF ^G
	JMS	BELLSP
	JMP I	(T2M1

BELLSP,	0
BLSP1,	CRLF		/TAD	CACR
BLSP2,	NOP		/TYPE
	TAD	MQ
	DCA	SAVMQ
	DCA	MQ
	TAD	QZ	/START FROM END OF COMMAND LINE
LFBLP,	DCA	QP	/AND SEARCH FOR LF
	STA
	TAD	MQ	/COUNT HOW MANY
	DCA	MQ
	STA
	TAD	QP
	SPA
	JMP	LFSTAR	/AT BEGIN OF CMD LINE
	GETQ
	TAD	BCHAR	/LOOK FOR LF
	SNA CLA		/IS IT LF?
	JMP	LFB	/YES
	STA		/NO
	TAD	QP	/BUMP BACK ONE MORE CHAR
	JMP	LFBLP

LFSTAR,	CLA
	TAD	[52	/PRINT ANOTHER *
	TYPE
LFB,	PUSHJ
		COLG4	/REPRINT LINE TO END OF CMD LINE
	TAD	SAVMQ	/RESTORE MQ
	DCA	MQ
BLSP3,	NOP		/JMS I	SCAPE
BLSP4,	NOP		/113
	TAD	[-12
	DCA	BCHAR	/SET UP FOR NEXT TIME
	KCC		/CLEAR OUT ^O OR ^S
	JMP I	BELLSP

SAVMQ,	0
BCHAR,	-12		/CHAR WE'RE SEARCHING BACKWARDS FOR
SCAPE,	ESCAPE
\fSORTB,	0		/SORT AND BRANCH ROUTINE
	DCA	SCHAR	/SAVE SORT CHAR
	STA
	TAD I	SORTB	/GET POINTER TO LIST
	ISZ	SORTB
	DCA	XR
SORTA1,	TAD I	XR	/GET ITEM IN TEST LIST
	SPA		/END MARKED BY NEG VALUE
	JMP	SORTA2	/FELL OUT BOTTOM
	CIA STL
	TAD	SCHAR
	SZA CLA		/COMPARE SORT CHAR
	JMP	SORTA1	/NOT IT.
	TAD	XR	/GOT IT. NOW MAKE INDEX
	TAD I	SORTB	/TO JUMP TABLE
	DCA	COUNT	/THIS IS TABLE POINTER
	TAD I	COUNT	/GET JUMP ADDRESS FROM TABLE
	SPA		/IF IT IS NEGATIVE,
	JMP	SORTA3	/ITS NOT A JUMP ADDRESS - ITS A VALUE
	DCA	COUNT
	CLA CLL
	JMP I	COUNT
SORTA2,	CLA CLL		/FELL OUT BOTTOM
	TAD	SCHAR	/CARRY CHARACTER BACK TO
SORTA3,	ISZ	SORTB
	JMP I	SORTB	/DO SOMETHING ELSE

CSMC,	SCANUP		/GET NEXT CHARACTER IN UPPER CASE
	AND	[77	/MAKE IT A CONTROL CHARACTER
	DCA	SCHAR
	JMP	SORTA1	/SUBSTITUTE IT FOR THE UPARROW

COUNT,	0
	PAGE
\f	/COMMANDS P AND T

CHRP,	JMS	POKE	/LOOK AHEAD ONE CHARACTER
	UPPERC		/BUT IN UPPERCASE
	TAD	(-127	/SEE IF IT'S "W"
	DCA	TEMPT	/SAVE KNOWLEDGE AS FLAG
	TAD	TEMPT
	SNA CLA
	SCAN		/PASS UP W
	CLA		/CLEAR W FROM AC
	TAD	CFLG
	SPA CLA		/IS THIS COMMAND  M,NP?
	JMP	CHRW	/YES - TREAT LIKE M,NPW
	GETN		/COMMAND P - GET # OF PAGES
	SZL SNA
ERR25,	ERR		/NEG OR 0 ARG TO P
	CIA
	DCA	CPCT
CPOA,	PUSHJ
		CPOC	/DO N<HPY>
	TAD	TEMPT	/IS NEXT CHARACTER W?
	SNA CLA
	JMP	NOYANK	/YES
/	TAD	REND	/IF WANT P TO CREATE FF'S
/	SZA CLA		/WHEN NO MORE INPUT FILE
	ISZ	FFFLAG	/NO, SAW FF?
	JMP	NOFF	/NO
	TAD	CAFF	/YES
	OUTPUT		/OUTPUT FF
NOFF,	DCA	ZZ	/FORCE Y COMMAND TO WORK
	PUSHJ
		CHRY	/WHOEVER THOUGHT OF THE PW COMMAND SHOULD BE SHOT
YANKY,	ISZ	CPCT
	JMP	CPOA
	POPJ
CPCT,	0

POKE,	0		/RETURN NEXT CHARACTER (BY LOOKING AHEAD)
	TAD	QLENGT
	CIA CLL
	TAD	SCANP
	SZL CLA		/MAKE SURE WE HAVEN'T RUN OFF END OF COMMAND LINE
	JMP I	POKE	/RETURN 0 IF NO CHAR
	TAD	SCANP
	TAD	QBASE
	GETQ
	JMP I	POKE	/LEAVE CHAR IN AC

NOYANK,	TAD	CAFF	/NPW OUTPUTS FFS
	OUTPUT
	JMP	YANKY
\fCPOC,	PUSHJ
		CHRH
CHRW,	TAD	(OUTPUT
CHRT2,	DCA	CWOUT	/W AND T COMMANDS - SAME THING, DIFFERENT DEVICES
	JMS	NLINES	/CONVERT LINES TO CHARS
CWOA,	CMA
	DCA	NLINES	/SET CHARACTER COUNT
	TAD	NLINES
	CIA
	MQLDVI		/COMPUTE HOW MANY WORDS THIS OUTPUT WILL USE
	6		/(BY TAKING 2/3 OF THE NUMBER OF CHARACTERS,
	CLL CML RTL	/ BU THAT'S SLOW SO WE TAKE 4/6 AND ROUND)
	JMS I	(FITS	/DETERMINE WHETHER THE OUTPUT WILL FIT
ERR17,	ERR		/NO - TELL THE USER
	CLA		/CLEAR CRAP FROM AC
	JMP	CWOC
CWOB,	CDF 10
	TAD I	M
	AND	[177
	CDF 0
CWOUT,	0		/TYPE, OUTPUT, OR QPUT
	ISZ	M
CWOC,	ISZ	NLINES	/DONE?
	JMP	CWOB	/NO
	POPJ

CHRT,	TAD	KTYPE
	JMP	CHRT2
\f/X COMMAND AND LINES-TO-CHARACTER CONVERTOR

CHRX,	QREF		/COMMAND X
	JMS	NLINES	/CONVERT LINES TO CHARS
	ADJQ		/ADJUST Q-REGISTERS AND SET UP NEW LENGTH.
	TAD	(QPUT
	DCA	CWOUT	/SET OUTPUT ROUTINE TO STORE INTO Q REG
	TAD	MQ	/LOAD THE CHARACTER COUNT
	JMP	CWOA	/GO TO TEXT OUTPUTTER

NLINES,	0		/CONVERT + OR - N LINES AROUND . TO CHARS M,N
	ISZ	CFLG	/WAS THERE A COMMA?
	SKP		/NO
	JMP	MFROMN	/YES - DON'T CONVERT LINES TO CHARS
	TAD	P
	DCA	M
	DCA	CFLG	/V3C
	PUSHJ		/CHRL DOES A "GETN"
		CHRL	/TO GET THE DEFAULT VALUES OF N
	TAD	P
	DCA	N
	TAD	M
	DCA	P
MFROMN,	DCA	NFLG	/CLEAR NFLG IN CASE COMMA FLAG WAS ON
	CLL		/M AND N ARE KNOWN TO BE 12-BITS LONG
			/AND POSITIVE
	TAD	N
	BZCHK		/IS N OK?
	CMA CLL		/YES - COMPUTE N-M
	TAD	M	/BY COMPUTING M-N-1
	CMA		/AND COMPLEMENTING IT
	SNL		/IS M>N?
	JMP I	NLINES	/NO - RETURN N-M
	TAD	M	/N-M+M=N NOW IN AC.
	DCA	CPCT	/INTERCHANGE M AND N
	TAD	M
	DCA	N
	TAD	CPCT
	DCA	M
	JMP	MFROMN
\f/COMMANDS ; < AND >

CFSI,	TAD	ITRST
	SNA CLA
ERR24,	ERR		/FAILING SEARCH NOT IN ITERATION
CSEM,	OVRLAY
		QOVRLY
		CSEMO
\f/	^A ROUTINE

CTLA,	TAD	KTYPE
CEXP,	DCA	WHERTO
	TAD	CHAR
	DCA	QUOTE	/TERMINATING CHAR SAME AS COMMAND CHAR
	DCA	NFLG	/KILL NUMBER IF PRESENT
CTLALP,	QUOTST
	JMP I	[IREST
WHERTO,	0		/TYPE OR IGNORE THE CHARACTER
	CLA
	JMP	CTLALP
	PAGE
\f/COMMANDS A AND Y

CHRA,	NCHK		/COMMAND A
	JMP	CHAA
	GETNUM
	TAD	P
	DCA	R
	SZL
	JMP I	(ERR11	/ERROR IF POINTER OFF PAGE
	CDF 10
	TAD	R
	CMA CLL
	TAD	ZZ	/RETURN 'POP' IF POINTER OUTSIDE RANGE [0,Z-1]
	SNL CLA		/OTHERWISE VALUE OF CHARACTER AT POINTER POSITION
	JMP I	(ERR11	/POP
	TAD I	R
	AND	[377
	CDF 0
NCOM14,	CLL
	JMP I	(NCOM
\fCHRY,	TAD	NFLG
	SZA CLA
ERR18,	ERR		/NUMERIC ARGUMENT TO Y
	TAD	OUTR
	CIA
	TAD	ERROR
	SZA CLA
	TAD	ZZ
YSKP,	SZA CLA		/CHANGE TO SKP CLA TO NEVER ABORT Y COMMAND
ERR32,	ERR		/Y COMMAND ABORTED
	DCA	ZZ
	DCA	P	/WIPE OUT THE BUFFER
CHAA,	TAD	(ZMAX-1
	AND	REND
	CIA CLL
	TAD	ZZ	/IF WE HAVE ALREADY SEEN THE INPUT EOF,
	SZL CLA		/OR IF WE'RE ALREADY FULL (OR NEARLY SO)
	JMP	APLF	/GET OUT
DECGET,	ISZ	ICRCNT
	JMP	I2	/NO NEED TO READ
	CLL
	TAD	INRSIZ
	TAD	INRCNT
STECO1,	SNL		/"SKP!CLA" FOR SUPERTECO
	DCA	INRCNT	/UPDATE RECORD COUNT
LFTAB,	CLL CML CMA RTR	/IF WE OVERFLOWED THE END OF THE FILE,	!
	RTR		/5 ENTRY TABLE: MUST BE - - - + +	!
	RTR		/SHORTEN THE READ BY THE CORRECT AMOUNT	!
	TAD	INCTLW	/					!
	DCA	INCTRL	/SO THAT WE WILL NOT READ TOO FAR	!
	JMS I	INHND
I3,
INCTRL,	0400
BUFIN,	IN		/6200 IF 8K, 5600 IF 12K
IBLK,	0
	SMA CLA
	SKP
	JMP	INER	/IGNORE END-OF-FILE ERRORS, WE'LL SEE THE ^Z.
	TAD	IBLK
	TAD	INRSIZ	/BUMP RECORD NUMBER BY THE MAXIMUM NUMBER
	DCA	IBLK	/(IF WE READ SHORT ITS THE LAST ONE ANYWAY)
	CLA CMA
	TAD	BUFIN
	DCA	INXR	/SET UP INPUT XR
	TAD	INPCNT
	DCA	ICRCNT
	MTHREE
	DCA	I3
I2,	NOP		/CDF 20 IF 12K
	ISZ	I3
	JMP	I1	/NORMAL CHARACTER
	MTHREE		/WEIRD CHARACTER-RESET SWITCH
	DCA	I3
	MTWO
	TAD	INXR
	DCA	INXR	/MOVE INPUT XR BACK TO BEGINNING OF DBLWORD
	TAD I	INXR
	AND	[7400
	DCA	FFFLAG	/TEMP
	TAD I	INXR
	AND	[7400
	CLL RTR
	RTR
	TAD	FFFLAG
	CLL RTR
	RTR
	SKP
I1,	TAD I	INXR
IC,	NOP		/CDF 0  IF 12K
	AND	[177	/MASK OFF GARBAGE
	/INPUT CHARACTER IN AC
	SZA
	TAD	(-177
	SNA		/IGNORE BLANK TAPE AND RUBOUTS
	JMP	DECGET
	TAD	(177-32
STECO2,	SNA		/"SKP" FOR SUPERTECO
	JMP	APFS	/IT'S A ^Z
	TAD	(16
	SNA
	JMP	APFF	/ITS A FORM FEED
	TAD	CAFF	/RESTORE CHAR
	CDF 10
	DCA	MQ	/SAVE CHAR
	TAD I	ZZ	/PROTECT HIGH-
	AND	[7400	/ORDER BITS
	TAD	MQ	/OF TARGET
	DCA I	ZZ	/STORE CHAR IN BUFFER
	TAD	MQ
	CDF 0
	ISZ	ZZ
	TAD	[-12
	SNA CLA		/IF THE CHAR IS A LINE FEED,
	TAD	(-310	/CHECK THAT THE BUFFER IS NOT NEARLY FULL
	JMP	CHAA
APFS,	DCA	REND	/SIGNAL END OF FILE
	SKP
APFF,	STA
APLF,	DCA	FFFLAG	/SET FORM FEED FLAG
	POPJ
\fINER,	DCA	REND	/INHIBIT FUTURE INPUTS
ERR15,	ERR

INCTLW,	401		/1021 IF 12K MACHINE
INPCNT,	6400		/5000 IF 12K MACHINE
	PAGE
\f/TELETYPE ROUTINES

TYPCTV,	0		/TELETYPE STUFFER
	SORT
		CTLBEL
		CTLTAB-CTLBEL
	DCA	SCHAR	/STORE (POSSIBLY TRANSLATED) CHAR
OUTCC,	TAD	SCHAR
	ISZ	COLCT	/BUMP COLUMN COUNTER
	AND	[7740
	SZA CLA		/IS THE CHAR A CONTROL CHARACTER?
	JMP	NOCON	/NO
	TAD	(136
	PUTT		/OUTPUT "^"
	ISZ	COLCT
	TAD	[100
OUTLF,	TAD	SCHAR
OUTLF1,	PUTT
	JMP I	TYPCTV
\fCOLCT,	0

OUTCR,	DCA	COLCT	/RESET CHAR COUNT
	JMP	OUTLF
OUTVT,	TAD	[4
OUTFF,	TAD	[7770	/FORM FEED IS 8 LINE FEEDS, VERT TAB IS 4
	DCA	COLCT	/*** BUG
ASR33,	TAD	CALF	/SIMULATE FORMFEEDS AND VERT TABS WITH LINEFEEDS
	JMP	OUTCOM	/*K* 8 LOCS AT ASR33 OVERLAYED BY ASR35 CODE

OUTHT,	TAD	COLCT	/COLUMN COUNTER, MOD 8
	AND	[7
	TAD	[7770	/SIMULATE TABS WITH SPACES
	DCA	COLCT
	40		/TAKE UP SPACE SO ASR-35 ROUTINE WILL JUST FIT
	TAD	.-1	/USE SPACES FOR TABS
OUTCOM,	PUTT		/PUT ONE OUT THE
	ISZ	COLCT	/WINDOW
	JMP I	(TPUTX	/STILL MORE INSIDE
	JMP I	TYPCTV

NOCON,	TAD	SCHAR
	AND	[100
EU1,	SNA CLA		/*EU SET TO CLA IF EUFLAG < 0 (NO CASE FLAGGING)
	JMP	OUTLF	/NOT ALPHANUMERIC
EU2,	NOP		/*EU SET TO TAD [40 IF EUFLAG>0 (FLAG UPPER CASE)
	TAD	SCHAR
	AND	[40
	SNA CLA
	JMP	OUTLF
	TAD	SQUO
	PUTT
	ISZ	COLCT
	TAD	SCHAR
	AND	[137
	JMP	OUTLF1	/OUTPUT UPPER CASE VERSION

OUTBEL,	TAD	SCHAR
	PUTT
	JMP	OUTCC
\f	/ROUTINE TO MANIPULATE Q-REGISTER STORAGE

/*** ALLOW : TO MEAN APPEND TO Q-REGISTER
/APPLIES TO X AND ^U COMMANDS
/MAKE SURE CMD LINE AND ^S ZERO CLNF

QADJ,	0
	SPA
	JMP	ERR12	/STRING TOO LONG FOR Q-REGISTER
	DCA	MQ	/SAVE NEW LENGTH OF Q-REGISTER
	QSUM		/COMPUTE POINTER TO CURRENT Q-REGISTER
	AC3777
	AND I	QPTR
	TAD	QP
	DCA	R
	AC3777
	AND I	QPTR	/GET ITS CURRENT LENGTH
	CIA CLL
	TAD	MQ	/COMPUTE DIFFERENCE
	SNL		/ADJUST Q-REGS
	JMP	QDNN	/TO HOLD NEW STRING
	SNA		/CHECK FOR ZERO
	JMP	QADJDN	/NOTHING TO DO
	TAD	QZ	/MOVE Q-REGISTERS UP TO INSERT CHARS
	DCA	QP	/(LINK IS 1 FROM PREVIOUS SNL)
	TAD	QP
	TAD	MQMAX	/SEE IF OUT OF BOUNDS
	SNL CLA		/TWO PLACES TO TOGGLE LINK THERE
ERR12,	ERR		/GETTING TOO FULL
	TAD	QZ
	DCA	Q
	TAD	QP
	DCA	QZ
	ISZ	QP
QUPL,	TAD	Q
	CIA
SQUO,	TAD	R	/DOUBLES AS ASCII FOR '
	SNA CLA
	JMP	QADJDN
	CMA
	TAD	Q
	DCA	Q
	MTWO
	TAD	QP
	DCA	QP
	TAD	Q
	GETQ
	QPUT
	JMP	QUPL
\fQDNN,	TAD	R	/MOVE Q-REGS DOWN TO ABSORB CHARACTERS
	DCA	QP
QDNN1,	TAD	QZ
	CIA
	TAD	R	/-NUMBER OF CHARS TO MOVE
	SNA CLA		/DONE?
	JMP	QDNNF	/YES
	TAD	R
	GETQ
	QPUT
	ISZ	R
	JMP	QDNN1	/LOOP AGAIN
QDNNF,	TAD	QP	/SET NEW VALUE
	DCA	QZ	/OF HIGHEST CHAR
QADJDN,	STL CLA RAR	/4000
	AND I	QPTR	/SAVE HIGH ORDER PART
	TAD	MQ
	DCA I	QPTR	/SAVE NEW LENGTH OF Q-REGISTER IN Q-REG TABLE
	TAD	QCMND	/SET UP COMMAND LINE AGAIN
	SETCMD		/AS IT MAY HAVE BEEN SHUFFLED.
	QSUM		/RECOMPUTE POINTER TO BEGINNING OF NEW Q-REG
	JMP I	QADJ

MQMAX,	-QMAX

QOVER,	0		/SUBROUTINE TO SKIP TO END OF STRING
	QCHK		/GET THE QUOTE CHARACTER (IF ANY)
	TAD	SCANP
	DCA	OSCANP	/SAVE BACKUP SCAN POINTER
QOVERL,	QUOTST
	JMP I	QOVER	/FOUND AN ALTM OR EQUIVALENT - RETURN
	JMP	QOVERL	/NOT END - SKIP ANOTHER CHAR
	PAGE
\f	/Q-REGISTER SUBROUTINES

QSUMR,	0		/COMPUTE POINTER TO Q-REG
	SNA
	TAD	QNMBR	/NORMALLY USES QNMBR, BUT CAN BE OVERRIDDEN BY AC
	CIA
	DCA	QKNT
	DCA	QP
	TAD	(QARRAY	/BASE ADDR OF Q-REG POINTERS
	DCA	QPTR
	JMP	QSUMB
QSUML,	AC3777
	AND I	QPTR	/ADD # OF CHARS IN LOWER REG
	TAD	QP
	DCA	QP
	ISZ	QPTR	/SKIP VALUE WORD
	ISZ	QPTR	/POINT TO NEXT Q-REG
QSUMB,	ISZ	QKNT	/REACHED OUR Q-REGISTER YET?
	JMP	QSUML	/NO - ADD IN ANOTHER
	JMP I	QSUMR
QKNT,	0
\fSGET,	0		/SCAN COMMAND LINE OR MACRO
SGET1,	CLA		/** CALLED WITH AC NON-ZERO **
	TAD	QLENGT
	CIA CLL
	TAD	SCANP
	SZL CLA		/CHECK THAT WE ARE STILL INSIDE THE COMMAND LINE
	JMP	SGOVFL	/NO - COMMAND DONE
	TAD	SCANP	/GET CHARACTER POSITION IN LINE
	TAD	QBASE	/ADD IT TO THE ADDRESS OF THE LINE
	GETQ		/AND GET THAT CHARACTER.
	DCA	LASTC
	TAD	TFLG
	AND	LASTC	/IF THE TRACE FLAG IS ON,
	SZA
	TYPE		/PRINT THE CHAR
	TAD	LASTC
	ISZ	SCANP	/INCREMENT CHARACTER POINTER AFTER FETCH
	JMP I	SGET	/RETURN
SGOVFL,	TAD	MPDL	/"MPDL" IS THE PUSHDOWN POINTER ON ENTRY TO THIS
	SNA		/MACRO. IF IT IS 0, WE ARE NOT IN A MACRO
	JMP I	(T1	/SO RETURN TO THE USER
	TAD	PDLP	/CHECK THAT THE ENDING POINTER IS THE SAME
	IAC
	SZA CLA		/AS THE ENTRY ONE - OTHERWISE WE HAVE
ERR13,	ERR		/SCREWED UP SOMEHOW (EG WE ARE
	POP		/ IN THE MIDDLE OF A COMMAND)
	DCA	SCANP
	POP
	DCA	ITRST
	POP		/RESTORE THE PREVIOUS VALUES OF
	DCA	MPDL	/MPDL, THE SCAN POINTER AND THE COMMAND LINE
	POP		/POINTER FROM THE PUSHDOWN LIST
	SETCMD
	JMP	SGET1	/AND FETCH A CHARACTER FROM THE UPPER LEVEL.
\fCMDSET,	0		/SUBROUTINE TO SET UP COMMAND LINE POINTERS
	DCA	QCMND	/STORE IN COMMAND LINE NUMBER
	TAD	QCMND
	QSUM
	TAD	QP	/GET FIRST LOCATION IN COMMAND LINE
	DCA	QBASE	/AND STORE IN "QBASE"
	AC3777
	AND I	QPTR
	DCA	QLENGT	/STORE THE LINE LENGTH IN "QLENGT"
	JMP I	CMDSET	/RETURN

QREFER,	0		/SET UP POINTERS FOR Q-REG REFERENCE
	SZA
	JMP	QREFEX	/AHA - WE ALREADY HAVE THE Q-REGISTER
	SCANUP		/GET Q-REGISTER IDENTIFIER
	DCA	QNMBR
	TAD	QNMBR
	TSTSEP		/TEST FOR ALPHANUMERIC (LOWER CASE LEGAL)
ERR03,	ERR		/OOPS - BAD Q-REGISTER REFERENCE
	TAD	QNMBR
	TAD	[7700
	SPA		/NUMERIC?
	TAD	Z7	/YES - FORCE NUMBERS UP TO ABUT LETTERS
	TAD	CALF	/FORCE IDENTIFIER INTO THE RANGE 1-44 (OCTAL)
QREFEX,	DCA	QNMBR	/STORE AWAY NUMBER FOR FURTHER REFERENCE
	QSUM		/COMPUTE QP AND QPTR
	JMP I	QREFER	/RETURN

CDBQ,	OVRLAY
		QOVRLY	/READ IN Q-OVERLAY
		CDBQO

CHRO,	OVRLAY		/READ IN Q-OVERLAY
		QOVRLY
		CHROO
\fOVERLY,	0
	TAD I	OVERLY	/GET LOCATION TO CHECK
	ISZ	OVERLY
	DCA	TMP
	TAD I 	OVERLY
	DCA	OVERLY	/SET RETURN ADDRESS
	TAD I	TMP	/IS OUR OVERLAY IN CORE?
	SNA
	JMP I	OVERLY	/YES, BRANCH INTO IT
	DCA	TMP	/NO, SET BLOCK TO READ IN
/**	THE NEXT 5 WORDS ARE MODIFIED IF WE HAVE MORE THAN 12K
OVREAD,	JMS I	(7607	/CALL SYSTEM HANDLER
	0200		/READ 2 PAGES
	3200		/INTO 3200
TMP,	0		/FROM THIS BLOCK
	HLT		/ERROR READING OVERLAY
	JMP I	OVERLY	/GO TO NEXT SPOT

CTLTAB,	OUTBEL	/BELL
	OUTCR
POUTHT,	OUTHT
	4044		/$ WITH SIGN BIT ON
	OUTFF
	OUTVT
	OUTLF

ALTTAB,	4033
	4033		/ALTMODE WITH SIGN BIT ON

CATS,	STA		/@ COMMAND - FAKE OUT "IREST"
IREST,	DCA	QFLG	/RESET QUOTED STRING FLAG
	TAD	CAAM
	DCA	QUOTE	/RESET QUOTE CHAR TO ALTMODE
POPK,	POPJ		/RETURN

QTST,	0		/SUBROUTINE TO GET A CHAR AND TEST FOR ALTMODE
	SCAN
	SORT
		QUOTE
		QTST-QUOTE	/RETURN IF QUOTE FOUND
	ISZ	QTST
	JMP I	QTST	/SKIP-RETURN WITH AC INTACT IF NOT FOUND
\f	/COMMANDS ^U AND E - ALSO ERROR ROUTINE

CTLU,	OVRLAY
		FOVRLY
		CTLUO
	PAGE
\fERRXX,	ERR30+1		/ENTRY POINT ALSO SERVES AS A FLAG FOR "TQMK"
	KCC		/CLEARS AC
	CDF 0		/JUST IN CASE
	TAD I ERRXX	/GRAB SIGNAL '0' NOW
	DCA ERRTMP	/BEFORE OVERLAY MIGHT DESTROY IT
	OVRLAY		/GO TO ERROR OVERLAY
		EOVRLY
		ERRYY

ERRRET,	TAD ERRTMP	/GET THE LOCATION AFTER THE CALL
	SNA CLA		/IF IT'S ZERO AND WE WERE CHAINED TO,
CHOOPS,	NOP		/ITS A FATAL ERROR - JMP CTLC
FATALJ=	JMP I	(CTLC
CTRLP,	TAD	SCANP
	CIA
	DCA	ERRXX	/SET ERRXX TO CHAR POSITION OF ERROR CHAR.
	KCC		/ZAP KEYBOARD FLAG
	JMP I	(T0	/CONTINUE AS NORMAL UNLESS USER TYPES "?"

CHRE,	SCANUP		/COMMAND E
	DCA	TYI
	TAD	TYI
	SORT
		EFLST
		EFTAB-EFLST
	CLA
	OVRLAY
		FOVRLY
		CHRED
ERRTMP,	0		/MUST BE INITIALLY 0
\f	/COMMANDS I AND <TAB>

CHRI,	NCHK		/I COMMAND
	JMP	CIL1
	TAD	N	/INSERT CHAR WHOSE VALUE IS N
	JMS	UPOC
/*** CHECK FOR $
	POPJ
CTLI,	DCA	QFLG	/CANNOT BE QUOTED
/	CLA CMA		/FOR TAB INSERT
/	TAD	SCANP
/	DCA	SCANP	/BACK UP SCAN POINTER BY ONE
/			/*** THIS IS A BUG
	TAD	CAHT	/TAB
	JMS	UPOC
CIL1,	QSKP		/COUNT LENGTH OF INSERTION
	DCA	DVT1	/ZERO FUDGE USED BY FS COMMAND
CIL2,	TAD	OSCANP
	TAD	QBASE
	DCA	QP	/SET UP POINTER TO INSERTION STRING
	TAD	SCANP
	CIA CLL
	TAD	OSCANP
	DCA	MQ	/STORE CHAR COUNT TO INSERT (-1)
	TAD	MQ
	TAD	DVT1	/ADD FS FUDGE
	CMA
	SNL		/DID WE INSERT MORE THAN WE DELETED?
	JMP	EXPAND	/YES - IGNORE SIGN BIT OF COUNT
	CIA
	PUSHJ
		ADJ2	/COMPRESS OUT EXCESS DELETED STUFF
	JMP	CIL4
CIL3,	TAD	QP
	GETQ		/GET A CHAR
	DCA	TYI
	JMS	STOREC	/STORE A CHARACTER
	ISZ	QP
CIL4,	ISZ	MQ
	JMP	CIL3	/OF INSERTION
	JMP I	[IREST

STOREC,	0		/STORE CHAR IN "TYI" INTO TEXT BUFFER AT P
	CDF 10
	TAD I	P
	AND	[7400
	TAD	TYI
	DCA I	P
	CDF 0
	ISZ	P
	JMP I	STOREC
\f/G COMMAND

CHRG,	QREF		/G COMMAND - GET Q-REGISTER NUMBER
	DCA	NFLG
	AC3777
	AND I	QPTR	/GET COUNT OF CHARS IN REGISTER
	CMA
	DCA	MQ	/SAVE AS TRANSFER COUNT
	ISZ	CLNF
	SKP
	JMP	COLG4
	DCA	CLNF
	AC3777
	AND I	QPTR
EXPAND,	PUSHJ		/COME HERE FROM INSERT LOGIC
		ADJ	/INCREASE TEXT BUFFER SIZE ( Q-REG LENGTH MAY
	JMP	CIL4	/BE NEGATIVE) AND GO TRANSFER THE CHARS

TYI,	0		/TELETYPE INPUT
TYI1,	KSF		/WAIT FOR THE KEYBOARD FLAG
KSFWT,	JMP	.-1	/WHILE WAITING, DISPLAY TEXT ON SCOPE
	CTCCHK		/CHECK FOR ^C
	KRB		/WATCH OUT - AC MAY NOT BE 0!
	AND	[177
	SNA
	JMP	TYI1	/IGNORE NULL CHARS AND LEADER
	SORT
		ALTLST
		ALTTAB-ALTLST	/LOOK FOR NON-STANDARD ALTMODES
	AND	[177	/IN CASE WE RETURNED A NEGATIVE VALUE
	JMP I	TYI

UPOC,	0		/MOVE TEXT BUFFER UP ONE CHAR
	AND	[177
	DCA	TYI
	CLA IAC
	PUSHJ
		ADJ
	JMS	STOREC	/STORE CHAR IN THE HOLE WE MADE
	JMP I	UPOC

CUPPER,	0		/FORCE CHARACTER TO UPPER CASE
	TAD	[-100
	SMA		/IF ITS >100
	AND	(37	/REDUCE IT TO BE <140
	TAD	[100
	JMP I	CUPPER	/RETURN
\fCOLG3,	TAD	QP
	GETQ		/GET A CHAR
	TYPE
	ISZ	QP
COLG4,	ISZ	MQ
	JMP	COLG3
	POPJ
\fESCAPE,	0
	TAD	CAAM	/TYPE ESCAPE
	PUTT
	TAD I	ESCAPE
	PUTT		/TYPE ARGUMENT
	JMP I	ESCAPE	/OK TO RETURN TO ARGUMENT
	PAGE
\fTSAVE,	TAD I	[QPNTR
	SZA CLA		/IF WE ARE NOT AT THE BEGINNING OF THE C.L.
	RESORT		/TREAT THIS LIKE ANY OTHER ^S
	MTWO		/DROP OFF THE TWO BELLS OR ALTMODES
	TAD	OCMDLN
	ADJQ		/SET COMMAND STRING LENGTH TO OLD VALUE
	TAD	L44
	QREF		/SET UP POINTERS TO Q-REG Z
	ADJQ		/KILL CONTENTS OF Q-REG Z
	TAD I	[QPNTR
	DCA I	(QPNTR-2
	DCA I	[QPNTR	/DO A QUICK SHUFFLE OF Q-REG LENGTHS
	JMP I	(TCTLU
\fCHRQ,	QREF		/COMMAND Q
	CLL
	JMP	CQOA

CPCS,	QREF		/COMMAND %
	GETN
CQOA,	ISZ	QPTR	/POINT TO VALUE WORD
	TAD I	QPTR	/INCREMENT VALUE BY ARGUMENT
	DCA I	QPTR
/ADD LINKS
	STA
	TAD	QPTR	/GO BACK ONE
	DCA	QPTR2	/ALSO COMPL LINK
	CML RAR
	TAD I	QPTR2
	DCA I	QPTR2
	TAD I	QPTR2
	RAL
	CLA
	TAD I	QPTR
	JMP I	(NCOM	/MAKE A NUMBER

TYCRLF,	0		/TYPE A CR AND LF
	TAD	CACR	/CR
XTYPE,	TYPE
	TAD	CALF	/LF
	TYPE
	JMP I	TYCRLF	/RETURN

QPTR2,	0

CHGT,	OVRLAY
		QOVRLY
		CHGTO
CHLT,	OVRLAY
		QOVRLY
		CHLTO
\fCCMA,	NCHK		/COMMAND ,
	JMP	NERR	/NUMBER FLAG NOT SET
	TAD	NLINK
	SZA CLA
ERR26,	ERR		/NEG ARGUMENT TO ,
	ISZ	CFLG
	SKP
	JMP	NERR	/3 NUMERIC ARGUMENTS
	TAD	N	/MOVE N TO M
CCMA3,	DCA	M	/ENTERED HERE BY "H" COMMAND
	DCA	N	/AND CLEAR N
	STA
	DCA	CFLG	/SET COMMA FLAG
	POPJ
\f/RETURNS 13-BIT RESULT IN AC,LINK

NGET,	0		/SUBROUTINE TO GET LAST NUMBER, WITH
NGET1,	NCHK		/DEFAULT VALUES OF +1 (NO NUMBER),
	JMP	NGET2	/OR -1 (JUST A MINUS SIGN)
	GETNUM
	JMP I	NGET	/DIGITS SEEN - RETURN THEM
NGET2,	CLA CLL IAC	/NO DIGITS SEEN
	PUSHJ		/MAKE BELIEVE WE SAW THE DIGIT "1"
		NCOM	/AND CREATE A NUMBER FROM IT (TAKING ANY
	JMP	NGET1	/OPERATORS INTO ACCOUNT) AND USE IT

BACKUP,	0
	TAD I	[QPNTR	/SEE IF ANYTHING TO ERASE
	SNA CLA
	JMP I	(T0	/NO, START ALL OVER
	STA
	TAD I	[QPNTR	/THEN THE CHARACTER COUNT
	ADJQ		/REDUCE THE LENGTH OF THE COMMAND REGISTER BY 1
	TAD	QZ
	GETQ		/GET THE CHARACTER WE RUBBED OUT
	JMP I	BACKUP

CHLCMP,	0		/COMPARISON SUBROUTINE
	TAD I	P	/DATA FIELD IS 10
	AND	[377
	CDF	0
	SORT
		CAFF
		LFTAB-CAFF
	SPA CLA		/LINE TERMINATORS ARE CHANGED TO NEGATIVE NOS.
	ISZ	CDT	/IS COUNT EXHAUSTED?
	JMP	CHLRET	/NO
CHRLI,	ISZ	P
L44,	44
	CDF	0
	POPJ

CHRH,	PUSHJ		/COMMAND H
		CCMA3	/SET M=0 AND COMMA FLAG ON AND FALL INTO "Z"
			/** COULD CAUSE ERROR ON B AND H IF NFLG SET
CHRZ,	TAD	ZZ	/COMMAND Z
CTLH,			/^H COMMAND - TIME OF DAY - NOT IMPLEMENTED
CHRB,	JMP I	(NCOM14	/COMMAND B

CHLRET,	CDF	10
	JMP I	CHLCMP
\fEFTAB,	IOV
	XOV
	XOV
	XOV
	XOV
	IOV
	IOV
	XOV
\fXOV,	OVRLAY
		XOVRLY
		CHREX

IOV,	OVRLAY
		IOVRLY
		CHRER
\f/COMMANDS = AND \ DISPATCHER TO OVERLAY

CEQL,	OVRLAY
		FOVRLY
		CEQLO
CBSL,	OVRLAY
		FOVRLY
		CBSLO

ZROSPN,	DCA	SCANP	/RESET TO BEGINNING OF ITERATION
ZRON,	DCA	NFLG	/KILL NUMBER FLAG
	JMP I	[IREST
	PAGE
\f/	I/O-OVERLAY

/	IOVRLY	XOVRLY	FOVRLY
/	ER	EF	EU
/	EB	EC	ES
/	EW	EX	ET
/		EG	EV
/			EH
/			EO

	*3200

IOVRLY,	0
	QOVRLC
	EOVRLC
	XOVRLC
	FOVRLC

	/SUBROUTINE TO DO LOOKUPS AND ENTERS (LINK CRITICAL ON ENTRY)

OPEN,	0		/CALLED WITH MONITOR CODE - 2 IN AC
	DCA	RSTSW	/ENTER OR LOOKUP
	SZL CLA		/IF THIS IS THE OUTPUT SIDE OF AN "EB" COMMAND,
	JMP	DEVLOD	/SKIP THE STATEMENT SCAN
	QCHK
	TAD	DSKNAM	/PACKED SIXBIT FOR 'DSK:'
	DCA	DEVC
	TAD	(72	/RESTORE :
NGOM1,	DCA	DEVLST+1
NGO,	DCA	NAME	/CLEAR NAME
	DCA	NAME+1
	DCA	NAME+2
	MTWO
	DCA	PERDSW
NAMCM1,	DCA	NAMCNT
\fNAMEC,	QUOTST		/GET CHAR AND TEST FOR ALTM
	JMP	DEVQOT	/ALTM - END OF NAME
	SORT		/NO - CHECK SPECIAL CHARS
		DEVLST	/([,:,., AND SPACE
		DEVTAB-DEVLST
	TSTSEP		/NO, SEE IF ALPHANUMERIC
ERR08,	ERR		/ILLEGAL CHAR
	TAD	NAMCNT
	TAD	[-10
	SMA CLA		/MORE THAN 6 CHARS?
	JMP	NAMEC	/YES, IGNORE
	TAD	NAMCNT	/NO, PACK IT
	CLL RAR
	DCA	TEMP1	/*K* NOTE ASSUMPTION NAME STARTS AT LOC 0!
	TAD	SCHAR
	UPPERC		/** "UPPERC" ALWAYS COMPLEMENTS LINK
	AND	[77
	SNL
	JMP	.+4
	CLL RTL
	RTL
	RTL
	TAD I	TEMP1
	DCA I	TEMP1
	ISZ	NAMCNT
	JMP	NAMEC

PERD,	ISZ	PERDSW	/FOUND A PERIOD
	TAD	NAME
	SNA CLA		/ERROR IF WE HAVE
	JMP	ERR08	/DOUBLE PERIODS OR NO FILE NAME
	DCA	DEVLST+1	/DEVICE NO LONGER LEGAL
	DCA	NAME+3	/ZERO EXTENSION OUT
	TAD	[6	/AND SET POINTER TO 6TH CHARACTER
	JMP	NAMCM1

COLON,	TAD	NAME+1
	SNA		/WE MUST PACK THE NAME INTO ONE WORD OURSELVES
	JMP	.+5	/BECAUSE IF "OPEN" IS CALLED FROM THE OUTPUT
	TAD	NAME	/SIDE OF AN "EB" COMMAND, WE SKIP
	SMA CLA		/THE NAME COLLECTOR.(WITH GOOD REASON -
	CLL CML RAR	/THE USR OVERLAYS THE COMMAND LINE).
	TAD	NAME+1	/SINCE THE OS/8 "ASSIGN" CALL TO THE USR
	TAD	NAME	/REPLACES THE 2ND NAME WORD WITH THE DEVICE
	DCA	DEVC	/NUMBER, ALL NAME INFO MUST BE HELD IN WORD 1.
	JMP	NGOM1	/DEVICE NAME STORED - RESET FOR FILE NAME

DEVLST,	56		/.
	72		/:
DSKNAM,	5723		/=0423+1300+4000 - SERVES AS LIST TERMINATOR
\fDEVQOT,	ISZ	PERDSW	/IF WE NEVER SAW A PERIOD,
	DCA	NAME+3	/WIPE OUT THE EXTENSION
	JMS I	(GETUSR	/BRING USR INTO CORE

DEVLOD,	TAD I	OPEN	/MOVE HANDLER ADDRESS
	DCA	DEVHND
	ISZ	OPEN	/AND BUMP POINTER
	TWO
	TAD	RSTSW
	DCA	CODE	/ENTER OR LOOKUP
	CIF 10		/AND RESET TABLES
	JMS I	[200
	13
RSTSW,	0		/DON'T ZAP OPEN FILES ON INPUT
	DCA	DEVNO	/ZERO SECOND NAME WORD
	CIF 10
	JMS I	[200
	1		/ASSIGN HANDLER
DEVC,	0
DEVNO,	0
DEVHND,	0
	JMP	OPNERR	/ERROR - KICK USR OUT FIRST
	DCA	STBLK
	TAD	RSTSW	/GET LOOKUP-ENTER SWITCH
	TAD	NAME	/IF NAME IS NULL AND THIS IS A LOOKUP,
	SNA CLA
	JMP	OPSUCC	/IT JUST SUCCEEDED
	TAD	DEVNO	/DEVICE #
	CIF 10
	JMS I	[200
CODE,	0		/ENTER OR LOOKUP
STBLK,	0		/FILLED WITH STARTING BLOCK
TEMP1,
FLN,	0		/FILLED WITH -LENGTH
/**** CHECK IF AC MUST = 0
	JMP 	OPNERR	/ERROR
OPSUCC,	TAD	DEVHND	/HANDLER ADDRESS IN AC
	JMP I	OPEN
PERDSW,	7777		/FLIP FLOP FOR EXTENSION
NAMCNT,	0		/CHARACTER COUNT
\f/*** CHECK FOR : (SEE P.26) RETURN VALUE IF FNF, ALSO IF FOUND
OPNERR,	TAD	RSTSW	/WE SHOULD ONLY KILL THE OUTPUT FILE
	SNA CLA
	JMP	.+3	/IF THIS IS AN OUTPUT ERROR
EBERR,	TAD	ERROR
	DCA	OUTR
	PUSHJ
PECDSM,	ECDISM		/DISMISS THE USR
ERR16,	ERR
	0		/*K* TELLS ERR RTN TO EXIT IF WE WERE CHAINED TO

	PAGE
\fCHRER,	TAD I	(TYI
	SORT
		ERLST
		ERTAB-ERLST
	ERR		/CAN'T HAPPEN

ERTAB,	EBAK		/EB
	ROPEN		/ER
	WOPEN		/EW

ERLST,	102		/EB
	122		/ER
	127		/EW

	/FILE OPEN COMMMANDS:

EBAK,	CLA CMA CLL	/"EDIT BACKUP" COMMAND WITH LINK CLEAR
	PUSHJ		/USE 'ROPEN' TO SET POINTERS
		ROPEN	/WITHOUT KICKING OUT THE USR (AC=-1 ON ENTRY)
	TAD I	(DEVNO	/DEVICE #
	TAD	(OSDCBT-1
	DCA	R
	CDF 10
	TAD I	R	/GET DEVICE CODE FROM DCB TABLE
	CDF
	SMA CLA		/NEGATIVE IF FILE-STRUCTURED
	JMP I	(EBERR	/YOU CAN'T DO THAT!
	TAD	NAME+3	/EXTENSION
	TAD	(-213
	SNA
	JMP I	(EBERR	/CAN'T EB A .BK FILE
	TAD	DOTBK	/RESTORE EXTENSION
	DCA	R	/SAVE IT
	TAD	DOTBK	/.BK EXTENSION
	DCA	NAME+3
	CIF 10
	TAD I	(DEVNO	/DEVICE #
	JMS I	[200	/DELETE THE OLD BACKUP
	4
	NAME
	0
DOTBK,	213		/WHO CARES IF IT'S NOT THERE?
	TAD	R	/OLD EXTENSION
	DCA	NAME+3
	CLA CLL CML IAC	/SET EDIT BACKUP FLAG AND DO AN "ENTER"
			/LINK MUST BE SET HERE FOR OPEN
WOPEN,	DCA	EBFLG	/LINK NORMALLY 0 WHEN GOTTEN HERE
	CLA IAC		/OPEN OUTPUT FILE
	JMS I	(OPEN	/ENTER CODE IN AC
OUHNDL,		4001	/HANDLER ADDRESS
	DCA	OUTHND	/HANDLER ENTRY
	TAD I	(DEVNO
	DCA	ODEV	/SAVE DEV #
	DCA I	(OCNT	/CLEAR BLOCK COUNT
	TAD I	(FLN
	DCA I	(OMAXLN	/MAXIMUM FILE LENGTH
	TAD	NAME
	DCA I	(OUNAM
	TAD	NAME+1
	DCA I	(OUNAM+1
	TAD	NAME+2
	DCA I	(OUNAM+2
	TAD	NAME+3
	DCA I	(OUNAM+3
	TAD	(DECPUT
	DCA	OUTR	/ENABLE CHARACTER OUTPUT ROUTINE
	TAD	(ECDISM
	DCA I	(DECPUT	/FAKE RETURN FROM CHAR I/O ROUTINE
	TAD I	(STBLK
	JMP I	(OSETP	/SET UP BLOCK NUMBER AND POINTERS
\f/FILE OPEN ROUTINE

ROPEN,	DCA	QPTR	/ENTERED WITH AC=-1 IF MONITOR IS TO BE KEPT
			/ENTERED WITH LINK=0
	JMS I	(OPEN	/LOOKUP CODE IN AC
INHNDL,		7201	/HANDLER ADDRESS
	DCA	INHND	/SAVE HANDLER ENTRY
	STA
	DCA	ICRCNT	/POINTER
	STA
	DCA	REND	/CLEAR END-OF-FILE FLAG
	TAD I	(STBLK
	DCA I	(IBLK	/FIRST BLOCK
	TAD I	(FLN
	DCA	INRCNT	/SET UP INPUT FILE LENGTH
	ISZ	QPTR	/SHOULD WE DISMISS THE MONITOR?
	JMP I	(ECDISM	/YES - KICK THE USR OUT AND POPJ
	JMP I	[IREST	/EXIT

DEVTAB,	PERD		/.
	COLON		/:
	PAGE
\fNORMAL,	TAD	ODEV	/CLOSE FILE
	CIF 10
	JMS I	[200
	4
	OUNAM
OCNT,	0		/NUMBER OF BLOCKS
	HLT
	TAD	ERROR	/RESET OUTPUT SUBROUTINE POINTER
	DCA	OUTR	/TO ERROR
ECDISM,	CIF 10		/DISMISS OS/8 USR ROUTINE
	JMS I	[200
	11		/KICK USR OUT
	JMP I	[IREST

/*** REALLY SHOULD BREAK UP INTO 2 ROUTINES

SCHSRT,	0		/SORT LETTERS AND NUMBERS
	UPPERC		/CONVERT TO UPPER CASE TO REDUCE CASES
	CLL		/THE LINK WILL ALTERNATE EACH TIME
	TAD	[-60	/WE ADD ONE OF OUR NEGATIVE CONSTANTS.
	SMA		/THE LINK AT THE END WILL TELL WHETHER
	TAD	[-12	/THE CHARACTER WAS ALPHANUMERIC
	SMA		/(I.E. BETWEEN 60-71,101-132 OR 140-172)
	TAD	M7	/OR A SEPARATOR CHARACTER.
	SMA
	TAD	(-32
	SZL CLA		/WAS IT ALPHANUMERIC?
	ISZ	SCHSRT	/YES
	JMP I	SCHSRT	/SKIP RETURN IF ALPHANUMERIC

RT,	0		/ROUTINE TO PACK THIRD CHAR INTO OUTPUT BUFFER
	CLL RTL
	RTL
	DCA	DM	/CALLED TWICE - FIRST TIME WITH CHAR IN AC,
	TAD	DM	/SECOND TIME WITH "DM" IN AC
	AND	[7400
	TAD I	OPTR2
	DCA I	OPTR2
	ISZ	OPTR2
	JMP I	RT
\fDVIMQL,	0		/FAKE MQL DVI
	DCA	DVT1	/STORE DIVIDEND
	DCA	MQ	/INITIALIZE QUOTIENT
DV1,	TAD I	DVIMQL	/GET DIVISOR
	CIA
	CLL		/SET UP TO TAKE IMMEDIATE EXIT ON ZERODIVIDE
	TAD	DVT1	/SUBTRACT DIVISOR FROM DIVIDEND
	SNL		/OVERFLOWED YET?
	JMP	DV7200	/YES
	DCA	DVT1	/NO - STORE IT BACK
	ISZ	MQ	/BUMP QUOTIENT
	JMP	DV1	/AND LOOP
DV7200,	CLA
	TAD	MQ
	ISZ	DVIMQL	/SKIP PAST DIVISOR
	JMP I	DVIMQL	/RETURN WITH QUOTIENT IN AC

/SEARCH STRING MODIFIERS:

SCHLST,	16	/^N - ANYTHING BUT
	21	/^Q - LITERALLY
	23	/^S - ANY SEPARATOR
	30	/^X - ANYTHING
M7,	-7
\fDECPUT,	0		/DEVICE INDEPENDENT I/O
	TAD	[200	/ADD ON PARITY BIT
	ISZ	O3	/3RD CHAR OF 3?
	JMP	O2	/NO
	JMS	RT	/YES, SPECIAL HANDLING
	TAD	DM	/TEMP STORAGE
	JMS	RT
SETO3,	MTHREE		/RESET SWITCH
	DCA	O3
	ISZ	OCRCNT	/END OF BUFFER?
	JMP I	DECPUT	/NO
	JMS	FITS	/CHECK FOR OUTPUT OVERFLOW
	JMP	OERR	/YUP
	DCA	OCNT	/NO - UPDATE OUTPUT COUNT
	JMS I	OUTHND	/OUTPUT THE BUFFER
OUCTRL,	4400
BUFOUT,	OUT
OBLK,	0
	JMP	OERR
	TAD	OBLK
	TAD	INRSIZ	/BUMP THE OUTPUT RECORD NUMBER BY THE MAXIMUM
OSETP,	DCA	OBLK	/SINCE ALL WRITES EXCEPT THE LAST ARE MAXIMAL
	TAD	BUFOUT	/BUFFER POINTERS
	DCA	OPTR1
	TAD	BUFOUT
	DCA	OPTR2
	TAD	OUTSIZ
	DCA	OCRCNT	/DOUBLEWORD COUNT (7377 IF 8K, 6777 IF 12K)
	JMP	SETO3	/SET BYTE COUNTER AND RETURN
OERR,	CLA
	TAD	ERROR
	DCA	OUTR	/INHIBIT FUTURE OUTPUT
ERR14,	ERR
O2,	DCA I	OPTR1	/NORMAL HANDLING
	ISZ	OPTR1	/BUMP POINTER
	JMP I	DECPUT
OPTR1,	0
OMAXLN,	0		/SIZE OF HOLE FOR OUTPUT
OUTSIZ,	7377		/6777
O3,	0
\fFITS,	0		/SUBROUTINE TO CHECK FOR OUTPUT OVERFLOW
	TAD	OPTR1	/** AC MAY CONTAIN FUDGE ON INPUT **
	CIA
	TAD	BUFOUT	/COMPUTE NUMBER OF WORDS IN BUFFER
	AND	[7400	/ROUND "UP" TO NEXT BUFFERLOAD
	CIA		/MAKE POSITIVE
	CLL CML RAR
	DCA	OUCTRL	/AND SAVE IT AS A BUFFER CONTROL WORD
	TAD	OUCTRL
	CLL RAL
	CLL RTL		/ISOLATE THE BLOCK COUNT OF THE CONTROL WORD
	RTL		/IN THE LOW ORDER PART OF THE AC
	RAL
	TAD	OCNT	/ADD IT TO THE CURRENT OUTPUT COUNT
	CLL CML
	TAD	OMAXLN	/SEE THAT WE DIDN'T OVERFLOW
	SNL SZA		/THE ASSIGNED OUTPUT AREA
	JMP I	FITS	/OOPS - WE DID - ERROR RETURN
	CIA
	TAD	OMAXLN	/SUBTRACT OFF THE LIMIT
	CIA		/TO ARRIVE AT THE UPDATED BLOCK COUNT
	ISZ	FITS
	JMP I	FITS	/AND SKIP RETURN
OUNAM,	ZBLOCK	4	/NAME OF OPEN OUTPUT FILE GOES HERE
	PAGE
\f/DISPLAY ROUTINE FOR PDP-12 SCOPE

WASTE,	0		/** MUST BE AT MULTIPLE OF 2000
XPOS,	0		/PDP-12 BETA REGISTER 1
BETA2,	0		/PDP-12 BETA REGISTER 2

DSPLAY,	0		/TEXT DISPLAY ROUTINE FOR TECO
	MTHREE		/THIS ROUTINE DEPENDS ON THE FACT THAT THE
	TAD	DSPLAY	/HIGH ORDER BITS OF THE X-COORD ARE IGNORED
	DCA	DX	/BY THE VR12 HARDWARE
	TAD I	DX	/GET THE SKIP
	DCA	DLPTST	/PUT IT IN THE LOOP
	TAD	P
	DCA	DX
	TAD	NUMLNS
	STL CIA		/LOOK BACKWARD
	PUSHJ		/FOR BEGINNING OF DISPLAY AREA
		CHRL1
D360,	STA STL		/=7360
	TAD	P
	DCA	DM
	TAD	DX
	DCA	P	/RESTORE POSITION
	TAD	NUMLNS	/NOW SCAN FORWARD
	CLL IAC
	PUSHJ		/FOR THE END OF THE DISPLAY AREA
		CHRL1
	TAD	P
	CIA
	TAD	DM
	DCA	R	/*K* THIS NUMBER MUST GO IN R -
	TAD	DX	/THE ^W COMMAND NEEDS IT THERE
	DCA	P	/RESTORE ORIGINAL P
DSETUP,	TAD	P
	CIA
	TAD	DM
	DCA	DQ	/SAVE COUNT OF CHARS TO CURSOR POSITION
	TAD	DM
	DCA	DX
	TAD	R
	DCA	DR
	TAD	D360
	DCA	YPOS
DISCR,	TAD	DISLF
SETXPS,	DCA	XPOS	/SET X POSITION/COLUMN COUNTER
	JMP	DLPTST
\f	/DISPLAY LOOP

DGETCH,	CDF 10
	TAD I	DX
	CDF 0		/GET THE CHARACTER FROM FIELD 1
	AND	[177	/AND OFF THE HIGH ORDER BITS
	TAD	(-33
	SNA		/CHANGE ALTMODES
	TAD	CAHT	/TO DOLLAR SIGNS
	TAD	(-5
	SMA SZA		/IF NOT A CONTXRACTER
	JMP	DLOOP	/DISPLAY IT AND KEEP GOING
	SNA
	JMP	DBLANK	/DO BLANKS FAST
	TAD	(40-15
	SNA		/CR?
	JMP	DISCR	/YES - RESET X COORD
	STL
	TAD	[4
	SNA		/TAB?
	JMP	DTABB
	SNL
	JMP	DISLF	/LINE FEED, VERTICAL TAB, OR FORM FEED
	TAD	(51	/ORDINARY CONTROL CHAR - RESTORE IT + 40
	DCA	WASTE	/SAVE CHAR
	JMS	DISCHR	/DISPLAY ^
	TAD	WASTE	/NOW DISPLAY ALTERED CHAR
DLOOP,	JMS	DISCHR

DLPTST,	HLT		/EITHER KSF OR TSF OR "ISZ R"
	SKP
	JMP I	DSPLAY	/EXIT IMMEDIATELY IF TEST SKIPS
	ISZ	DQ	/ARE WE AT THE CURRENT POINTER POSITION?
	JMP	TSTEDS	/NO
	TAD	(-5
	TAD	XPOS
	DCA	XPOS	/BACK UP X POSITION A HALF-CHARACTER
	TAD	DM20
	TAD	YPOS
	6141		/ENTER LINC MODE
DM20,	1760		/DSC I
	2000
	1760		/DISPLAY A ^
	2076
	0002		/PDP
	MTHREE		/AND MOVE X POSITION BACK TO WHERE IT WAS
	JMP	DBLANK+1
TSTEDS,	ISZ	DR	/ARE WE THROUGH?
	JMP	DGETCH	/NO
	JMP	DSETUP	/YES - START OVER
\fDTABB,	TAD	XPOS	/DISPLAY TAB
	CMA
	AND	Z7
	DCA	WASTE	/GET NUMBER OF COLUMNS TO GO (-1)
	TAD	WASTE
	CLL RTL
	RAL
	TAD	WASTE	/MULTIPLY BY 9
DBLANK,	TAD	CAHT	/BUMP ONE MORE COLUMN
	TAD	XPOS
	SZA		/OVERFLOW?
	JMP	SETXPS	/NO - SET XPOS AND CONTINUE
	JMP	LINOFL	/YES - GO TO THE NEXT LINE

/SUBROUTINE TO DISPLAY A CHARACTER

DISCHR,	DLPTST		/*K* DISCHR MUST CONTAIN "DLPTST" WHEN WE
	CLL RAL		/ARE EXAMINING CHARACTERS **
	TAD	(DTABLE-1
	DCA	BETA2	/STORE ADDRESS OF TABLE ENTRY FOR CHAR -1
	TAD	YPOS

	6141		/ENTER LINC MODE
	1762		/DSC I 2
	1762		/DSC I 2
	0002		/RE-ENTER PDP-8 MODE

	CLA
	ISZ	XPOS	/BUMP THE X COORDINATE/COLUMN COUNTER
	JMP I	DISCHR	/RETURN
LINOFL,	TAD	(7054	/INDENT ALL CONTINUATION LINES
	DCA	XPOS
DISLF,	RAR		/*K* RAR=7010  AC MAY HAVE A SMALL NUMBER
	TAD	YPOS	/IN IT HERE - THATS OK AS LONG AS ITS SMALL,
	TAD	[-40	/SINCE ONLY THE HIGH 8 BITS OF YPOS COUNT.
	DCA	YPOS
	JMP I	DISCHR	/*K* THIS ALWAYS RETURNS TO DLPTST **

YPOS=	NAME		/USE SOME FREE PAGE ZERO LOCATIONS
DR=	NAME+1		/FOR OUR TEMPORARIES
DQ=	NAME+2
DM=	NAME+3
	PAGE
\fDTABLE,	2000;2076;	7500;0000;	7000;0070;	7714;1477
	5721;4671;	6661;4333;	5166;0526;	0000;0070
	3600;0041;	4100;0036;	2050;0050;	0404;0437
	0500;0006;	0404;0404;	0001;0000;	0601;4030
	4536;3651;	2101;0177;	4523;2151;	4122;2651
	2414;0477;	5172;0651;	1506;4225;	4443;6050
	5126;2651;	5122;3651;	2200;0000;	4601;0000
	1000;4224;	1212;1212;	2442;0010;	4020;2055
	4077;5751;	4477;7744;	5177;2651;	4136;2241
	4177;3641;	4577;4145;	4477;4044;	4136;2645
	1077;7710;	7741;0041;	4142;4076;	1077;4324
	0177;0301;	3077;7730;	3077;7706;	4177;7741
	4477;3044;	4276;0376;	4477;3146;	5121;4651
	4040;4077;	0177;7701;	0176;7402;	0677;7701
	1463;6314;	0770;7007;	4543;6151;	4177;0000
	3040;0106;	0000;7741;	2000;2076;	1604;0404
\fSTABLE,	ZBLOCK	40	/SEARCH BUFFER

CTLW,	NCHK		/^W COMMAND - IF THERE WAS A NUMBER BEFORE
	JMP	CTLW2	/THE ^W, SET THE NUMBER OF LINES TO DISPLAY
	TAD	N	/EQUAL TO THAT NUMBER.
	DCA	NUMLNS
			/DON'T WORRY ABOUT NEGATIVE N
CTLW2,	ISZ	R	/FAKE OUT! (MUST BE BEFORE CALL TO DISPLY)
	DISPLY		/IN ANY CASE, GO THROUGH ONE DISPLAY CYCLE
	POPJ		/THEN RETURN

SAVTRA,	0		/SAVE TRACE MODE
	TAD	TFLG
	DCA	TFGTMP
	DCA	TFLG
	JMP I	SAVTRA	/EXIT WITH TRACE OFF

RESTRA,	0		/RESTORE TRACE MODE
	TAD	TFGTMP
	DCA	TFLG
	JMP I	RESTRA
TFGTMP,	0

CHKQF,	0		/CHECK FOR EXPLICIT QUOTES
	ISZ	QFLG	/QUOTE FLAG SET?
	JMP	.+3	/NO
	SCAN		/GET QUOTING CHAR
	DCA	QUOTE	/PUT INTO SEARCH TABLE
	DCA	QFLG	/ZAP QUOTE FLAG
	JMP I	CHKQF	/RETURN
\fNXTBUF,	0
	SZA CLA
	JMP	NOWRIT	/READ-ONLY IF AC NOT 0 ON ENTRY
	PUSHJ
		CPOC	/HP
	DCA	ZZ	/FORCE Y TO WORK
	ISZ	FFFLAG	/IF WE DIDN'T SEE A FORM FEED ON INPUT
	JMP	NOWRIT	/DON'T OUTPUT ONE
	TAD	CAFF
	OUTPUT
NOWRIT,	PUSHJ
		CHRY	/READ NEW BUFFER
	CTCCHK		/CHECK FOR ^C AND ^P
	CLA		/*K* CTCCHK LEAVES AC NON-ZERO!
	JMP I	NXTBUF

GETUSR,	0		/ROUTINE TO LOCK THE USR INTO CORE
	CDF 0
	TAD	ZZ	/IF THE TEXT BUFFER IS EMPTY AND
	SNA CLA		/WE HAVE 12K, SO Q-REGS ARE IN FIELD 2,
NWRUSR,	NOP		/(CHANGED BY INIT CODE TO "TAD [4" IF 12K)
	STL RTR		/THEN WE SHOULD NOT SAVE CORE ON A USR CALL.
	DCA I	(JSBITS	/THIS STORES A 2000 OR A 2001
	CIF 10
	JMS I	[7700	/OK - NOW LOAD THE USR IN
	10
	JMP I	GETUSR
\f/E COMMAND MODIFIERS

EFLST,	102		/EB	I
	103		/EC	X
	106		/EF	X
	107		/EG	X
	113		/EK	X
	122		/ER	I
	127		/EW	I
	130		/EX	I

CHRU,	QREF		/COMMAND U
	NCHK
ERR22,	ERR		/U MUST BE PRECEDED BY A NUMBER
	TAD	NLINK
	CLL RTR
	DCA	NLINK
	AC3777
	AND I	QPTR
	TAD	NLINK
	DCA I	QPTR
	ISZ	QPTR
	TAD	N
	DCA I	QPTR
	POPJ

/RADIX TABLES:

ORAD,	NOP
	1000
	100
	10
DRAD,	NP&177+1200	/"TAD NP"
	1750
	144
	12
\f/DISPATCH TABLE FOR COMMAND INPUT

COMTAB,	TBEL		/^G
	TCRLF		/CR
RUBY,	ROCMND		/RUBOUT
	TCTLU		/^U
	TALTM		/ALTMODE
	TQMK		/?
	TSAVE		/^S
	TSTAR		/*
	TSPACE		/SPACE

EDFLAG,	0		/MUST BE KEPT TOGETHER
EHFLAG,	0
EOFLAG,	VERSN
ESFLAG,	0
ETFLAG,	0
EUFLAG,	0
/CXFLAG,	0
	PAGE
\f/COMMAND M
/AND Q-REGISTER STORAGE
COMLST,	7		/^G, COMMAND LINE EDIT LIST
	15		/CR, INSERT CR & LF
	177		/RUBOUT
	25		/^U - RUB OUT LINE
	33		/^[, ALT MODE
	77		/?
	23		/^S - SAVE OLD COMMAND LINE IN Q-REG Z
	52		/*
	40		/SPACE

CHRM,	QREF		/COMMAND M
	TAD	M4	/4 ITEMS PUSHED TO
	PUSHL		/SAVE CURRENT MACRO STATE
		QCMND
		MPDL
		ITRST	/SO THE "O" COMMAND WILL WORK IN MACROS
		SCANP	/ZEROED BY "PUSHL"
	TAD	PDLP	/MUST CHECK PDL AT END OF MACRO
	CIA
	DCA	MPDL
	TAD	QNMBR	/Q-REGISTER TO EXECUTE
	SETCMD		/SET COMMAND LINE TO THIS Q-REG
	POPJ		/LEAVE NUMBER FLAG ALONE AND EXIT

CHKBZ,	0		/SEE THAT B .LE. C(AC) .LE. ZZ
	SZL
	JMP	ERR11	/POP
	CIA		/ENTERED WITH LINK SET CORRECTLY
	TAD	ZZ
	SNL		/13-BIT ARITHMETIC
ERR11,	ERR		/C(AC)>ZZ
	CIA
	TAD	ZZ	/RESTORE ORIGINAL AC
	JMP I	CHKBZ

ALTLST,	175	/ALT MODE
	176	/ANOTHER ALTMODE
M4,	-4
\fSCUPPR,	0		/SCAN AND CONVERT TO UPPER CASE
	SCAN
	UPPERC
	JMP I	SCUPPR	/THAT'S ALL?

/Q-REGISTER STORAGE - EACH Q-REGISTER TAKES 2 WORDS.
/WD 1 CONTAINS THE LENGTH OF THE CHARACTER PART OF THE REGISTER (IF ANY)
/WD 2 CONTAINS THE VALUE  OF THE NUMERIC PART OF THE REGISTER (IF ANY)

QARRAY,	ZBLOCK	110	/36 Q-REGISTERS * 2 WORDS/REGISTER = 72 WORDS
QPNTR,	CHNSTR		/FAKE Q-REGISTER FOR INPUT LINE - LENGTH ONLY.
\fCTLT,	NCHK
	JMP	CTLT2	/NO ARG
	TAD	N
ET1,	TYPE		/TYPE CHAR REPRESENTED BY ARGUMENT
	POPJ
CTLT2,	LISTEN		/^T COMMAND - VALUE OF NEXT CHAR FROM TTY
ET8,	TYPE		/*ET	ECHO THE CHARACTER
	TAD	SCHAR	/GET THE CHARACTER
	JMP I	(NCOM14	/JUMP INTO NUMBER PROCESSOR

CTLE,	TAD	FFFLAG	/^E COMMAND - RETURNS FORM FEED FLAG
NNEW13,	CLL
	SPA
	STL		/EXTEND SIGN BIT TO LINK
	JMP I	(NCOM	/RETURN -1 IF F.F., 0 OTHERWISE
	PAGE
\f	*5000

/COMMAND DISPATCH TABLE	** ALLOW EVEN/ODD FOR NOVICE SUBSET?

CDSP,	POPK;CTLA;SERR;CTLC;CTLD;CTLE;CTLF;CTLC	/0-7
	CTLH;CTLI;POPK;SERR;POPK;POPK;CTLN;CTLO	/10-17
	  T0;SERR;SERR;SERR;CTLT;CTLU;ERR35;ERR27	/20-27
	SERR;SERR;SERR;ZRON;SERR;SERR;CTUA;SERR	/30-37
	POPK;CEXP;CDBQ;CNBS;SERR;CPCS;CAMP;ZRON	/40-47
	COPR;CCPR;CAST;CPLS;CCMA;CMIN;CDOT;CVIR	/50-57
	NMBR;NMBR;NMBR;NMBR;NMBR;NMBR;NMBR;NMBR	/60-67
	NMBR;NMBR;CCLN;CSEM;CHLT;CEQL;CHGT;CQSM	/70-77
	CATS;CHRA;CHRB;CHRC;CHRD;CHRE;CHRF;CHRG	/100-107
	CHRH;CHRI;CHRJ;CHRK;CHRL;CHRM;CHRN;CHRO	/110-117
	CHRP;CHRQ;CHRR;CHRS;CHRT;CHRU;SERR;SERR	/120-127
	CHRX;CHRY;CHRZ;SERR;CBSL;SERR;CHUA;CHBA	/130-137
	/END OF DISPATCH TABLE

PDLBEG,	ZBLOCK	11	/BEGINNING OF PUSHDOWN LIST
QPUT12,	ZBLOCK	16	/ROUTINES INSERTED LATER - USED IN
ASR35,	ZBLOCK	10	/INITIALIZATION, OVERLAYED BY PUSHDOWN LIST
PDLEND,	0		/END OF PUSHDOWN LIST
	PAGE
\f	*5200

/	INITIALIZATION SECTION
/	ENTER HERE AT 5200 TO MODIFY TECO TO USE A MODEL 35 TELETYPE
/	SORRY - NO CURRENT PAGE LITERALS

TECO35,	ISZ	JTECO	/IF CALLED VIA "R" OR "RUN"
	TAD I	XR	/MOVE ASR-35 PATCH (WHICH OUTPUTS TABS AND
	DCA I	INXR	/ FORM FEEDS) OVER PRINT ROUTINE
	ISZ	ASRCNT
	JMP	.-3
	TAD	YOUTHTX
	DCA I	YPOUTHT
	TAD	[TECO
	DCA I	Y7745	/CHANGE STARTING ADDRESS IN CASE WE'RE RESTARTED
			/AND FALL INTO INITIALIZATION ROUTINE

TCINIT,	TLS		/INITIALIZATION ROUTINE - INITIALIZE THE TTY
	TAD	.-1
	DCA I	[TECO
	TAD	YT0A		/"JMP T0A"
	DCA I	PTECO1	/CHANGE THE ENTRY AT 200 SO WE'RE NOT CALLED AGAIN
	CLA STL
	6141		/ENTER LINC MODE (MAYBE)
	4		/ESF - SET SMALL CHARACTERS FOR SCOPE
	0261		/ROL I 1 - ROTATE LINK INTO AC11
	0002		/BACK TO PDP-8 MODE
	SNA CLA		/AC NON-ZERO IF WE ARE A PDP-12
	JMP	NOTA12	/NO, JUST AN ORDINARY 8
	TAD	YPDP12
	JMS	CHANGE	/TRADE OFF TWO PAGE HANDLERS FOR A SCOPE
NOTA12,	TAD I Y7777
	AND COR70
	SZA
	JMP	SOFCOR
COR0,	CDF 0		/NEEDED FOR PDP-8L
	TAD CORSIZ	/GET FIELD TO TEST
	RTL
	RAL
	AND COR70	/MASK USEFUL BITS
	TAD COREX
	DCA .+1		/SET UP CDF TO FIELD
COR1,	CDF /N		/N IS FIELD TO TEST
	TAD I CORLOC	/SAVE CURRENT CONTENTS
COR2,	NOP		/HACK FOR PDP-8!
	DCA COR1
	TAD COR2	/7000 IS A "GOOD" PATTERN
	DCA I CORLOC
COR70,	70		/HACK FOR PDP-8, NOP
	TAD I CORLOC	/TRY TO READ BACK 7000
CORX,	7400		/HACK FOR PDP-8, NOP
	TAD CORX	/GUARD AGAINST WRAP-AROUND
	TAD CORV	/TAD (1400
	SZA CLA
	JMP COREX	/NON-EXISTENT FIELD EXIT
	TAD COR1	/RESTORE CONTENTS DESTROYED
	DCA I CORLOC
	ISZ CORSIZ	/TRY NEXT HIGHER FIELD
	JMP COR0

COREX,	CDF 0		/LEAVE WITH DATA FIELD 0
	STA
	TAD CORSIZ	/HIGHEST EXISTING FIELD
COR999,	DCA	MEMSIZ
	TAD	MEMSIZ
	SNA CLA
	JMP	JTECOM	/8K
	TAD	YM7	/MORE THAN 8K
	JMS I	YMOVE
	CDF	0
	QPUT12-1
	CDF	0
	QPUTS-1
	TAD	YM7
	JMS I	YMOVE
	CDF	0
	QPUT12+7-1
	CDF	0
	GETQX-1
	TAD	YTWLVEK
	JMS	CHANGE	/AND CHANGE A WHOLE MESS OF LOCATIONS
JTECOM,	JMS I	YOVINIT	/WRITE OUT OVERLAYS
	CDF	10
	TAD I	YSCPBIT
	CDF	0
	AND	[200
	SNA CLA
	JMP	JTECO
	TAD	YSCOPE
	JMS	CHANGE
JTECO,	JMP I	.+1	/INCREMENTED IF WE WERE'NT CHAINED TO
	CHINIL
PTECO1,	TECO1

CORLOC,	CORX		/ADDRESS TO TEST IN EACH FIELD
CORV,	1400		/7000+7400+1400=0
CORSIZ,	1		/CURRENT FIELD TO TEST

SOFCOR,	CLL RAR
	RTR
	JMP	COR999
\f/CHAINED INIT CODE - MOVE 17600 INTO Q-REGISTER SPACE

CHINIL,	CDF 10
	TAD I	DX	/GET A COMMAND LINE CHAR
	CDF 0
	QPUT
	ISZ	INICT
	JMP	CHINIL
	TAD	YFATALJ	/SET UP THE FATAL ERROR EXIT
	DCA I	YCHOOPS	/IN THE ERROR ROUTINE
	JMP I	YCHTECO
INICT,	-CHNSTR

ASRCNT,
CHANGE,	-10		/ROUTINE TO CHANGE SPECIFIC LOCATIONS
	DCA	XR	/STORE TABLE POINTER
CHANGL,	TAD I	XR	/GET LOCATION
	SNA
	JMP I	CHANGE	/END OF LIST - RETURN
	DCA	TEMPT
	TAD I	XR	/GET CONTENTS
	DCA I	TEMPT	/ZAP!
	JMP	CHANGL

/CHECK FOR OS/8 SCOPE BIT, IF ON, PATCH TECO
/ALSO SEND ESC SEQ TO TERMINAL TO SEE IF VT05 OR VT5X.


YOUTHTX,	OUTHTX
YPOUTHT,POUTHT
Y7745,	7745
Y7777,	7777
YM7,	-7
YMOVE,	MOVE
YOVINIT,OVINIT
YSCPBIT,SCPBIT
YFATALJ,FATALJ
YCHOOPS,CHOOPS
YCHTECO,CHTECO
YPDP12,	PDP12-1
YTWLVEK,TWLVEK-1
YSCOPE,	SCOPE-1
YT0A,	T0A&177+5200
/FLOW INTO NEXT PAGE
\fSCOPE,	RUBY;	SCOPY		/MAKE SCOPE RUBOUTS WORK
	BLSP1;	TAD CACR	/MAKE BELL SPACE WORK
	BLSP2;	TYPE		/AND MORE RUBOUTS
	BLSP3;	SCAPE&177+4600	/JMS I (ESCAPE
	BLSP4;	113		/MORE BELL SPACE
	EUFLAG;	-1		/SET EU TO -1
	EU1;	CLA
	EU2;	TAD [40
	0
\f/LOCATIONS TO CHANGE MUST BE CHANGED IN OVERLAY IMAGE
/BEFORE OVERLAY IS WRITTEN OUT

/LOCATIONS TO CHANGE IF WE HAVE 12K OF CORE

TWLVEK,	INRSIZ;	4	/INPUT BUFFER GROWS TO 4 BLOCKS LONG
	INCTLW;	1021	/AND LIVES IN FIELD 2
	INPCNT;	5000
	I2;	CDF 20
	IC;	CDF 0	/THIS WAS A NOP TO SPEED UP RTS-8 OPERATION
	L12K1;	J12K1	/SPEED UP TEXT MOVE ROUTINES,
	L12K2;	J12K2	/SINCE Q-REGISTERS DON'T SIT ON TOP OF TEXT.
	OUTSIZ;	6777	/OUTPUT BUFFER TAKES OVER OLD INPUT BUFFER SPACE
	BUFIN;	5600
	NWRUSR;	TAD [4	/LET USR BE CALLED WITHOUT SAVING CORE
	MQMAX;	-Q12MAX	/ALLOW MORE Q-REGISTER STORAGE
	QLIMIT;	12-Q12MAX
	0


/LOCATIONS TO CHANGE IF WE'RE RUNNING ON A PDP-12

PDP12,	KSFWT;	DISPLY	/FIX KEYBOARD AND PRINTER WAITS
	TSFWT;	DISPLY	/SO THEY DISPLAY WHILE WAITING
	CDSP+127;CTLW	/ENABLE W COMMAND
	INHNDL;	7200	/ONE PAGE INPUT HANDLER ONLY
	OUHNDL;	7400	/DITTO OUTPUT HANDLER
			/VALUE MUST BE 0 INITIALLY TO END LIST
OVINIT,	0		/WRITE OUT OVERLAYS
/IF MORE THAN 12K, MOVE OVERLAYS TO FIELD 3
	MTHREE
	TAD	MEMSIZ
	SPA CLA
	JMP	L16K	/LESS THAN 16K
	TAD	[-400
	JMS	MOVE
	CDF	0
	3200-1
	CDF 30
	MEMLOC-1
	TAD	M2000
	JMS	MOVE
	CDF	0
	5600-1
	CDF	30
	MEMLOC+400-1
	TAD	M5
	JMS	MOVE
	CDF	10
	NEWERR-1
	CDF	0
	OVREAD-1
/	TAD	(COREAD-COREND-1
	TAD	M3000
	JMS	MOVE
	CDF	10
	4400-1		/	COREAD-1
	CDF	30
	4400-1
	JMP	G16K
L16K,	JMS I	(7607
	4200
	3200		/WRITE OUT I/O-OVERLAY
	IOVRLC
	JMP	OVERR	/ERROR WRITING OVERLAY
M3000,	JMS I	(7607
	5400		/4 OVERLAYS
	5600		/WRITE OUT Q-OVERLAY AND E-OVERLAY
	QOVRLC
	JMP	OVERR	/ERROR WRITING OUT OVERLAY
G16K,	DCA I	(ERRXX
	JMP I	OVINIT	/RETURN

OVERR,	TAD	[-400	/SWAP IN ERROR OVERLAY FROM CORE AND MAKE SURE
	JMS	MOVE	/WE RETURN TO MONITOR
	CDF	0
	6200-1
	CDF	0
	3200-1
/	DCA I	(ERRTMP	/SET FATAL SWITCH
	TAD	(FATALJ
	DCA I	(CHOOPS
ERR30,	JMP I	(ERRYY	/CALL ERROR MESSAGE PROCESSOR

M2000,	-2000
M5,	-5
\fMOVE,	0
	DCA	MQ
	TAD I	MOVE
	DCA	MOVEL
	ISZ	MOVE
	TAD I	MOVE
	DCA	INXR
	ISZ	MOVE
	TAD I	MOVE
	DCA	MOVEC
	ISZ	MOVE
	TAD I	MOVE
	DCA	XR
	ISZ	MOVE
MOVEL,	HLT
	TAD I	INXR
MOVEC,	HLT
	DCA I	XR
	CDF	0
	ISZ	MQ
	JMP	MOVEL
	JMP I	MOVE
\f	/ROUTINES TO BE (POSSIBLY) SWAPPED INTO TECO

	*QPUT12
	RELOC QPUTS
QPUTS,	0		/12K Q-REGISTER PUT ROUTINE
	AND	[377
	CDF 20
	DCA I	QP
	CDF 0
	ISZ	QP
	JMP I	QPUTS

	RELOC GETQX
GETQX,	0		/12K Q-REGISTER GET ROUTINE
	DCA	CHKCTC
	CDF 20
	TAD I	CHKCTC
	CDF 0
	AND	[377
	JMP I	GETQX

	RELOC ASR33
	JMP	OUTCMX	/ FORM FEED/VERT. TAB - USE 8/4 FILLERS
OUTHTX,	TAD	COLCT	/GET COLUMN COUNTER
	RTR
	RAR
	CLA CMA RAL	/OUTPUT 2 FILLERS IF MORE THAN 4 CHARS TO TAB
	DCA	COLCT	/OTHERWISE 1 (COLCT IS A MODULO 8 COUNTER)
OUTCMX,	TAD	SCHAR	/GET CONTROL CHAR TO TYPE
	PUTT		/AND TYPE IT - WE WILL NOW FILL WITH NULLS
	RELOC
	PAGE
\f/	Q-OVERLAY

	*5600

	RELOC 3200

	IOVRLC
QOVRLY,	0
	EOVRLC
	XOVRLC
	FOVRLC

/O COMMAND

CHROO,	TAD	SCANP	/O COMMAND
	DCA	COOQ	/SAVE CURRENT SCAN POINTER
	DCA	NFLG
/???	DCA	QFLG	/QUOTED "O" COMMAND NOT ALLOWED
	QSKP		/CHECK THAT THERE IS REALLY A STRING HERE
			/BECAUSE WE WILL NOT USE "SCAN" TO GET CHARACTERS
			/FROM THIS STRING IN THE SEARCH LOOP.
	TAD	ITRST	/"O" ONLY SCANS FROM THE BEGINNING OF THE
	DCA	SCANP	/CURRENT ITERATION LOOP.
			/(JUMPS BACKWARD OUT OF ITERATIONS ARE VERBOTEN)
	SKPSET
CS41,		41	/SEARCH FOR !
	TAD	CS41
	DCA	QUOTE	/SET QUOTE CHAR TO !
	TAD	COOQ
	TAD	QBASE
	DCA	QP	/SET UP PTR TO ACCESS GOTO STRING
COOC,	TAD	QP
	GETQ		/GET CHAR FROM GOTO STRING
	CIA
	DCA	MQ	/SAVE IT
	QUOTST		/GET CHAR FROM LABEL
	JMP	COOB	/LABEL EXHAUSTED
	TAD	MQ
	SZA CLA		/MATCH?
	JMP	CSMQ	/NO - REJOIN SEARCH ROUTINE FOR ANOTHER !
	ISZ	QP
	JMP	COOC
COOB,	TAD	MQ
	TAD	CAAM	/IS GOTO STRING EXHAUSTED TOO?
	SZA CLA
	JMP	CSMQ+1	/NO - REJOIN ! SEARCH ROUTINE
	ENTRCE		/RE-ENABLE TRACE
	JMP I	[IREST
COOQ,	0
\f/ROUTINE TO SKIP COMMANDS UP TO A CHARACTER

SETSKP,	0		/SET UP TO SKIP COMMANDS
	TAD I	SETSKP
	DCA	SKPLST	/CHAR TO TRAP ON
	NOTRCE		/DISABLE TRACE MODE
CSML1,	DCA	BRACKS	/INITIALIZE BRACKET LEVEL
CSML,	SCANUP		/GET A COMMAND CHAR
	SORT
		SKPLST
		SKPTAB-SKPLST
	JMP	CSML	/NOTHING SPECIAL - KEEP GOING
CSMD,	SCAN		/CLEAR OUT MODIFIER
	JMP	CSML

CSMU,	SCAN		/SKIP ^U COMMAND
	SKP CLA		/GET RID OF Q-REG NUMBER
CSMFS,	QSKP		/FS COMMAND - SKIP FIRST STRING
CSMQ,	QSKP		/SKIP OVER A QUOTED STRING
CSMQ1,	PUSHJ
		IREST	/FIX UP QUOTE CHAR
	JMP	CSML	/KEEP GOING

CSMY,	TAD	SCHAR	/SKIP ROUTINE FOR ^A AND !
	DCA	QUOTE	/WE MUST SCAN UNTIL WE FIND
	JMP	CSMQ	/A COPY OF THE COMMAND CHARACTER.
\f	/SORT LIST FOR " COMMAND

CNDLST,	103		/C
	107		/G
	116		/N
	114		/L
	105		/E
	124		/T
	123		/S
	106		/F
	125		/U
	122		/R
	74		/<
	76		/>

CSME,	SCANUP		/FOUND E COMMAND
	SORT
		ESKLST		/LOOK FOR ER & EW & EG
		ESKTAB-ESKLST	/USE CSMQ TO SKIP
	JMP	CSML	/NO STRING

CSMF,	SCAN		/F COMMAND - BETTER BE FOLLOWED BY S,N, OR _
	CLA
	JMP	CSMFS	/SCAN OFF TWO STRINGS

CSMI,	ISZ	BRACKS	/INCREMENT BRACKET LEVEL
	JMP	CSML

CSMO,	STA
	TAD	BRACKS	/DECREMENT BRACKET LEVEL
	SPA
	JMS I	(POPITR	/IF WE EXIT <> POP OFF ITERATION VALUES
	JMP	CSML1

SKPRTN,	TAD	BRACKS	/WE HAVE FOUND THE DESIRED CHARACTER
	SZA CLA		/BUT IF THE BRACKET LEVEL IS NON-ZERO,
	JMP I	XSORTA1	/WE CANNOT ACCEPT IT - KEEP SORTING
	JMP I	SETSKP	/EVERYTHING IS OK - RETURN

BRACKS,	0
\f/SORT LIST FOR SKIPPING OVER COMMANDS

SKPLST,	0	/TRAP CHAR
	41	/!
	76	/>
	74	/<
	42	/"
	136	/^
	100	/@
	1	/^A
	11	/TAB
	25	/^U
	36	/^^
	105	/E
	106	/F
	111	/I
	116	/N
	117	/O
	123	/S
	137	/_
	121	/Q
	125	/U
	130	/X
	107	/G
	115	/M
	45	/%
\f/	SKIP LIST FOR E'S
ESKLST,	122		/R
	127		/W
	102		/B
	107		/G

CSMA,	STA		/LIST TERMINATOR
	JMP	CSMQ1	/FOUND @ - SET QUOTE FLAG AND CONTINUE


XSORTA1,SORTA1
	PAGE
\f/DISPATCH TABLE FOR SKIPPING OVER COMMANDS:

SKPTAB,	SKPRTN	/DESIRED CHARACTER - RETURN
	CSMY	/!
	CSMO	/>
	CSMI	/<
	CNDI	/"
	CSMC	/^
	CSMA	/@
	CSMY	/^A
	CSMQ	/TAB
	CSMU	/^U
	CSMD	/^^
	CSME	/E
	CSMF	/F
ESKTAB,	CSMQ	/I OR ER
	CSMQ	/N OR EW
	CSMQ	/O OR EB
	CSMQ	/S OR EG
	CSMQ	/_
	CSMD	/Q
	CSMD	/U
	CSMD	/X
	CSMD	/G
	CSMD	/M
	CSMD	/%
\fSEMO,	SKPSET		/PLOD THRU
		76	/LOOKING FOR >
	ENTRCE		/IT'S THE RIGHT ONE, TURN TRACE BACK ON
	JMP I ZCGSG
ZCGSG,	CGSG

CNDTAB,	TSTSEP		/LEGAL CONSTITUENT OF SYMBOL FOR ASSEMBLER
	SZL SNA CLA	/GT 0
	SNA CLA		/NE 0
	SNL CLA		/LT 0
	SZA CLA		/EQ 0
	SNL CLA		/TRUE
	SNL CLA		/SUCCESSFUL
	SZA CLA		/FALSE
	SZA CLA		/UNSUCCESSFUL
	TSTSEP		/ALPHANUMERIC
	SNL CLA		/<
	SZL SNA CLA	/>

/THIS TABLE PRESUPPOSES 1000000000000 IS ILLEGAL
\f	/COMMANDS " AND '

CDBQO,	NCHK		/COMMAND "
ERR23,	ERR		/NO NUMBER TO TEST
	SCANUP
	SORT
		CNDLST
		CNDTAB-CNDLST
	SMA		/CHECK THAT CHAR WAS TRANSLATED
ERR20,	ERR		/NO - NO SUCH TEST
	DCA	SKIP	/STORE TEST INSTRUCTION
	GETNUM		/PERFORM THE TEST
SKIP,	HLT		/TEST SKIPS IF TRUE
	SKP CLA
	POPJ		/CONDITION SATISFIED
	STA		/NOT SATISFIED
	DCA	SKIP	/BEGINNING SKIPPING COMMANDS
	SKPSET		/CALL SKIPPING ROUTINE
		47	/FIND A '
	ISZ	SKIP	/FOUND A '
	RESORT		/NEED ANOTHER: BACK TO CSML
	ENTRCE		/RE-ENABLE TRACE
	JMP I	[IREST	/COMMAND ' NO ACTION TO TAKE

CNDI,	SCAN		/HIT ANOTHER "
	STA		/SO SKIP MATCHING '
	TAD	SKIP
	DCA	SKIP
	RESORT		/GO BACK TO CSML
\f/COMMANDS ; AND >

CSEMO,	TAD	ITRST	/COMMAND ; - ALSO HERE ON FAILING NON-COLON SEARCH
	SNA CLA
ERR09,	ERR		/IF NOT IN ITERATION
CSEM2,	TAD	NLINK
	SNA CLA
	NCHK
	JMP I	(ZRON	/NO NUMBER - IGNORE IT, WE DID IT ALREADY
	JMP	SEMO	/SEARCH FOR >

CHGTO,	TAD	ITRCNT
	SNA CLA
	JMP	CGTC	/0 MEANS INFINITY
	ISZ	ITRCNT	/LOOK FOR COUNT EXHAUSTED
	JMP	CGTC	/NO, CONTINUE
CGSG,	JMS	POPITR	/POP UP OLD ITERATION PARAMETERS
	JMP I	[IREST
CGTC,	TAD	ITRST
	SNA
ERR10,	ERR		/IF NOT IN ITERATION
	JMP I	(ZROSPN	/BACK TO ROOT

POPITR,	0
	CLA IAC		/** AC NOT NECESSARILY 0 ON ENTRY
	POPL
		ITRCNT
		ITRST
	JMP I	POPITR
\fCHLTO,	MTWO		/COMMAND <
	PUSHL
		ITRST
		ITRCNT
	TAD	NFLG
	SNA CLA		/WAS A NUMBER SPECIFIED?
	JMP	INF	/NO, ASSUME INFINITY
	TAD	NLINK
	SNA CLA
	TAD	N
	SNA
	JMP	SEMO	/0 OR NEGATIVE MEANS SKIP ITERATION
	CIA		/MAKE NEGATIVE
INF,	DCA	ITRCNT	/SET UP TERMINATION
	TAD	SCANP	/SAVE CURRENT SCAN PNTR
	DCA	ITRST	/ALWAYS .GE. 1 IN ITERATION
	DCA	NFLG	/CLEAR NUMBER FLAG
	POPJ

/SHOULD WE TREAT 0<> SPECIAL?
	PAGE
	RELOC
\f/	ERROR-OVERLAY

	*6200

	RELOC 3200

	IOVRLC
	QOVRLC
EOVRLY,	0
	XOVRLC
	FOVRLC

ERRYY,	DCA	N
	TAD	(ERLIST-1
	DCA	XR
ERLOOP,	ISZ	N	/BUMP ERROR NUMBER
	TAD I	XR
	SZA		/END OF LIST?
	TAD I	(ERRXX	/NO - CHECK FOR MATCH
Z40,	SZA CLA		/FOUND WHAT WE WANTED?
	JMP	ERLOOP	/NO - KEEP LOOKING
	TAD	N
	CLL RAL		/MULTIPLY BY 2
	TAD	(ERBASE-2
	DCA	PTR
	TAD I	PTR	/GET FIRST WORD OF ERR MSG
	SPA CLA
	JMP	CTCT	/^C TRAP
ERL2,	TAD	[77
	TYPE
	TAD I	PTR
	RTR
	RTR
	RTR
	JMS I	(SIXTYP	/TYPE LEFT CHARACTER
	TAD I	PTR
	JMS I	(SIXTYP	/TYPE RIGHT CHARACTER
	ISZ	PTR
	TAD I	PTR
	RTR
	RTR
	RTR
	JMS I	(SIXTYP	/TYPE 3RD CHARACTER
	CLA IAC
	AND I	(EHFLAG
	SZA CLA
	JMP I	(ERRRET
	MTHREE
	TAD	MEMSIZ
	SPA CLA
	JMP I	(ERRRET	/NO LONG ERROR MESSAGE UNLESS 16K OOR MORE
	TAD	Z40	/TYPE EXTENDED ERROR MESSAGE
	TYPE
	TAD	Z40
	TYPE
/	TAD	Z40
/	TYPE
	TAD	N
	TAD	(XERBAS-1
	DCA	PTR	/GET PTR TO PTR TO ERROR MSG
	CDF	30
	TAD I	PTR	/GET PTR TO ERROR MESSAGE
	DCA	PTR
XLUP,	TAD I	PTR
	CDF	0
	SNA
	JMP I	(ERRRET
	SPA
	JMS	NEGCHR	/NEGATIVE CHAR IS FLAG FOR ERRONEOUS CHARACTER
	PUTT
	ISZ	PTR
	CDF	30
	JMP	XLUP

CTCT,	KRS		/CTRL/C ERROR MESSAGE
	AND	[177	/ISOLATE ^C OR ^P INTO 7-BIT
	TYPE		/READ CTRL/C FROM BUFFER
	CRLF		/ECHO IT AND CR LF
	TAD I	[QPNTR
	SZA CLA
	JMP	ERL2	/PRINT XAB ERROR MESSAGE
/	MTHREE
/	TAD	CHAR	/LOOK AT PREVIOUS CHARACTER
/	SZA CLA
/	JMP I	(ERRRET	/ONE ^C DO NOTHING
	JMP I	(CTLC	/TWO ^C'S, ABORT
\fNEGCHR,	0
	CLA
	TAD	LASTC
	SORT
		CACR
		ERPTAB-CACR
	SPA
	DCA	LASTC	/SAVE $ FOR ALTMODE
	CLA
	TAD	(""
	PUTT
	TAD	LASTC
	AND	[7740
	SNA CLA
	JMS	WOW	/USE CARRET FORM FOR CONTROL CHARS
	TAD	LASTC	/AC MAY BE NON-0
	PUTT
	TAD	(""
	JMP I	NEGCHR

WOW,	0
	TAD	("^
	PUTT
	TAD	[100
	JMP I	WOW

SPY,	TAD	LASTC
	TAD	(-11+CNVTAB
	DCA	WOW
	TAD	("<
	PUTT
	TAD I	WOW
	RTR
	RTR
	RTR
	JMS I	(SIXTYP
	TAD I	WOW
	JMS I	(SIXTYP
	TAD	(">
	JMP I	NEGCHR
\fPTR,	0

	PAGE
\fSIXTYP,	0
	AND	[137	/IGNORE SIGN BIT OF BYTE
	TAD	[40
	AND	[77
	TAD	[40
	PUTT
	JMP I	SIXTYP
\fERLIST,	-ERR01-1	/LIST OF POINTERS TO ALL POSSIBLE
	-ERR02-1	/CALLS TO THE ERROR ROUTINE.
	-ERR03-1
	-ERR04-1
	-ERR05-1
	-ERR06-1
	-ERR07-1
	-ERR08-1
	-ERR09-1
	-ERR10-1
	-ERR11-1
	-ERR12-1
	-ERR13-1
	-ERR14-1
	-ERR15-1
	-ERR16-1
	-ERR17-1
	-ERR18-1
	-ERR19-1
	-ERR20-1
	-ERR21-1
	-ERR22-1
	-ERR23-1
	-ERR24-1
	-ERR25-1
	-ERR26-1
	-ERR27-1
ERR28,	-ERR28-1
	-ERR29-1
	-ERR30-1
	-ERR31-1
	-ERR32-1
	-ERR33-1
	-ERR34-1
	-ERR35-1
	0		/ERROR 36 - UNLABELED ERROR - NAMELY "JMS I OUTR"
			/** MUST BE LAST ERROR MESSAGE
\fERBASE,	TEXT	/ILL/	/1	ILLEGAL COMMAND
	TEXT	/UTC/	/2	UNTERMINATED COMMAND
	TEXT	/IQN/	/3	ILLEGAL Q-REGISTER NAME
	TEXT	/PDO/	/4	INTERNAL PUSH DOWN OVERFLOW (RECURSION)
	TEXT	/MEM/	/5	MEMORY OVERFLOW
	TEXT	/STL/	/6	SEARCH STRING TOO LONG
	TEXT	/ARG/	/7	ARGUMENT ERROR
	TEXT	/IFN/	/8	ILLEGAL FILE NAME
	TEXT	/SNI/	/9	SEMICOLON NOT IN ITERATION
	TEXT	/BNI/	/10	CLOSE BRACKET NOT IN ITERATION
	TEXT	/POP/	/11	POINTER OFF PAGE
	TEXT	/QMO/	/12	Q-REGISTER MEMORY OVERFLOW
	TEXT	/UTM/	/13	UNTERMINATED MACRO
	TEXT	/OUT/	/14	OUTPUT ERROR
	TEXT	/INP/	/15	INPUT ERROR
	TEXT	/FER/	/16	FILE ERROR
	TEXT	/FUL/	/17	OUTPUT COMMAND WOULD HAVE OVERFLOWED
	TEXT	/NAY/	/18	NEGATIVE ARGUMENT TO Y
	TEXT	/IEC/	/19	ILLEGAL E CHARACTER
	TEXT	/IQC/	/20	ILLEGAL " CHARACTER
	TEXT	/NAE/	/21	NO ARGUMENT BEFORE =
	TEXT	/NAU/	/22	NO ARGUMENT BEFORE U
	TEXT	/NAQ/	/23	NO ARGUMENT BEFORE "
	TEXT	/SRH/	/24	FAILING SEARCH
	TEXT	/NAP/	/25.	NEGATIVE OR 0 ARGUMENT TO P
	TEXT	/NAC/	/26.	NEGATIVE ARGUMENT TO ,
	TEXT	/NYI/	/27.	^W NOT IMPLEMENTED
	TEXT	/DMY/	/28.	NOT USED
	TEXT	/NAS/	/29.	NEGATIVE OR 0 COUNT TO SEARCH
	TEXT	/WLO/	/30.	CAN'T WRITE OUT ERROR MESSAGE OVERLAY
	TEXT	/IFC/	/31.	ILLEGAL F CHARACTER
	TEXT	/YCA/	/32.	Y COMMAND ABORTED
	TEXT	/CCL/	/33.	CCL NOT FOUND OR EG TOO BIG
/	TEXT	/XAB/	/34.	EXECUTION ABORTED BY ^C
	7001;0200
	TEXT	/NYI/	/35.	^V NOT IMPLEMENTED
	TEXT	/NFO/	/36.	NO FILE FOR OUTPUT
\fCNVTAB,	TEXT	/HTLFVTFFCR/
	*.-1
ERPTAB,	SPY		/CR
	SPY		/HT
	4044		/$
	SPY		/FF
	SPY		/VT
	SPY		/LF
	PAGE
	RELOC
\f/	X-OVERLAY

	*6600

	RELOC 3200

	IOVRLC
	QOVRLC
	EOVRLC
XOVRLY,	0
	FOVRLC

CHREX,	TAD I	(TYI
	SORT
		XLIS
		XTAB-XLIS
	ERR		/CAN'T HAPPEN

XLIS,	103		/EC
	106		/EF
	107		/EG
	113		/EK
	130		/EX

	/"EX" AND "EC" COMMANDS
EXIT,	PUSHJ		/"EX" COMMAND
		EXITC	/CLOSE OUT THE FILES
	JMP I	(CTLC	/AND GO AWAY

EXITC,	TAD	OUTR	/"EC" COMMAND
	CIA		/CHECK FOR OPEN OUTPUT FILE
	TAD	ERROR
	SNA CLA
	POPJ		/NOPE, EXIT ALREADY
EXLOOP,	JMS I	[NXTBUF	/GET NEXT BUFFER
	TAD	REND
	CIA
	TAD	ZZ	/CHECK FOR END-OF-FILE AND
	SZA CLA		/TEXT BUFFER EMPTY
	JMP	EXLOOP	/NOT YET
			/ENDFILE PROCESSOR
ENDFIL,	TAD	OCRCNT
	CMA		/REDUCE THE OUTPUT DOUBLEWORD COUNT
	AND	[177	/TO REFLECT ONLY THOSE WORDS REMAINING
	CMA		/UNTIL THE NEXT BLOCK BOUNDARY
	DCA	OCRCNT
	TAD	(7200	/USED TO BE 'DV7200'
	DCA	MQ	/SET COUNTER FOR ONE BLOCK WORTH OF STUFF
	TAD	(32	/^Z END-OF-FILE
	OUTPUT
	ISZ	MQ
	JMP	.-2	/FILL AT LEAST THE CURRENT BUFFER AND OUTPUT IT
	TAD	ODEV	/MAKE SURE THE USR KNOWS THE HANDLER
	TAD	(OSHNDT-1	/*K* - POINTER INTO
	DCA	TY	/ OS/8 DEVICE RESIDENCY TABLE
	CDF 10
	TAD	OUTHND
	DCA I	TY	/MARK THE HANDLER AS IN CORE
	JMS I	(GETUSR	/LOCK THE USR INTO CORE
	TAD	EBFLG	/IS THIS AN EDIT BACKUP?
	SNA CLA
	JMP I	(NORMAL	/NO, JUST CLOSE FILE
	TAD I	(OCNT-1	/YES, LOOKUP OLD FILE TO CHANGE NAME
	DCA	TY-1
	CIF 10
	TAD	ODEV	/INPUT AND OUTPUT ARE ON SAME DEVICE
	JMS I	[200
	2
	OUNAM
TY,	0		/USELESS LENGTH--USE IT FOR TEMPORARY
	JMP I	(NORMAL	/ERROR-JUST CLOSE FILE AND DON'T TELL ANYBODY
	CDF 10		/ALL THAT WAS JUST TO GET THE DIRECTORY IN CORE
	STA		/SO WE COULD FIDDLE WITH IT
	TAD I	(17	/FORM POINTER TO DIRECTORY ENTRY
	TAD I	(1404
	DCA	TY
	TAD	(213	/CHANGE EXTENSION TO .BK
	DCA I	TY
	TAD I	Z7	/DIRECTORY BLOCK IT CAME FROM
	AND	Z7
	DCA	ACI
	CDF 0
	JMS I	OUTHND
	4210		/WRITE IT BACK OUT
	1400
ACI,	0
	JMP	.-4	/ERROR! KEEP TRYING-THIS CAN BLOW A DIRECTORY
	JMP I	(NORMAL
\fXTAB,	EXITC		/EC
	ENDFIL		/EF
	EXITGO		/EG
	EKILL		/EK
	EXIT		/EX
\fEKILL,	TAD	ERROR
	DCA	OUTR
	POPJ
	PAGE
\fEXITGO,	PUSHJ		/DO AN EC TO CLOSE OUT FILE
		EXITC
	QCHK		/ALLOW @
	DCA	STOCD	/MAKE REUSABLE IN CASE .START
	TAD	(7600
	DCA	CDPTR
	TAD	(-47	/47 ENTRIES IN CD TABLE
	DCA	EGCNT
EG1,	QUOTST
	JMP	EG2
	TAD	[200	/TURN ON PARITY BIT FOR OS/8
	JMS	STOCD
	JMP	EG1

STOCD,	0
	ISZ	EGCNT
	SKP
ERR33,	ERR		/EG ARG TOO BIG
	CDF	10
	DCA I	CDPTR
	CDF	0
	ISZ	CDPTR
	JMP I	STOCD

CDPTR,	7600
EGCNT,	-41

EG2,	TAD	STOCD
	SNA CLA		/ANYTHING IS ARG
	JMP	REGEG	/NO
	JMS	STOCD	/STORE 0 AT END
	JMS I	(GETUSR
	TAD	(CCLNAM
	DCA	ARG1		/JUST IN CASE PREVIOUS EG FAILED
	CLA IAC		/SYS
	CIF 10
	JMS I	[200
	2		/LOOKUP
ARG1,	CCLNAM
	0
	JMP	CCLERR
	TAD	(2001
	DCA I	(JSBITS	/KEEP USR IN CORE
	TAD	ARG1
	DCA	CHNBLK
	CIF 10
	JMS I	[200
	6		/CHAIN
CHNBLK,	0
\fCCLERR,	PUSHJ
		ECDISM
	JMP	ERR33

CCLNAM,	FILENAME CCL.SV
\fREGEG,			/EDIT AND GO - A CCL SPECIAL
	JMS I	(7607	/CALL THE OS/8 SYSTEM HANDLER
	0200		/TO READ IN THE CCL OVERLAY
	CCLADR
	CCLOVL
	JMP	ERR33	/ERROR ON SYSTEM DEVICE!
	JMP I	.+1	/GO TO THE OVERLAY
	CCLOST		/AT OUR "SPECIAL" LOCATION
	RELOC
\f/	F-OVERLAY

	*7200

	RELOC 3200

	IOVRLC
	QOVRLC
	EOVRLC
	XOVRLC
FOVRLY,	0

CHRED,	TAD I	(TYI
	SORT
		DLIS
		DTAB2-DLIS	/CHECK FOR LEGALITY
ERR19,	ERR		/BAD CHAR AFTER E
DTOK,	TAD I 	(TYI
	SORT
		DLIS
		DTAB-DLIS
	DCA	XXFLAG
	NCHK		/ANY ARGUMENT?
	JMP	XXNO	/NO, RETURN VALUE
	TAD	N	/YES
	DCA I	XXFLAG	/SET NEW VALUE
	TAD	XXFLAG
	TAD	(-EDFLAG+XXSUBS
	DCA	XXSUB
	TAD I	XXSUB
	DCA	XXSUB
	JMS I	XXSUB	/CALL IT
	POPJ		/RETURN
XXNO,	TAD I	XXFLAG	/GET VALUE
	JMP I	(NNEW13	/MAKE NEW 13-BIT VALUE

DLIS,	104		/ED
	110		/EH
	117		/EO
	123		/ES
	124		/ET
	125		/EU
DTAB,	EDFLAG		/MUST BE NEGATIVE
	EHFLAG		/TO CAUSE SUBSTITUTION
	EOFLAG
	ESFLAG
	ETFLAG
	EUFLAG
\fXXFLAG,	0		/POINTS TO FLAG IN MEMORY ABOVE 4000

DTAB2,	DTOK
	DTOK
	DTOK
	DTOK
	DTOK
	DTOK

XXSUB,	0
\f/	MASK;SKIP;LOC;VALUE IF SKIPS;VALUE IF NO SKIP

EUSUB,	0
	JMS	FIXUP
	7777;	SMA CLA;	EU1;	CLA;	SNA CLA
	7777;	SPA SNA CLA;	EU2;	TAD [40;NOP
	0
	JMP I	EUSUB

ETSUB,	0
	JMS	FIXUP
	1;	SNA CLA;	KTYPE;	PUTT;	TYPE
	1;	SNA CLA;	ET1;	PUTT;	TYPE
	10;	SNA CLA;	ET8;	CLA;	TYPE
	0
	JMP I	ETSUB

\fLOC,	0
MASK,	0

FIXUP,	0
FIXLUP,	TAD I	FIXUP
	SNA
	JMP I	FIXUP	/DONE, RETURN TO 0
	DCA	MASK	/SAVE MASK
	ISZ	FIXUP
	TAD I	FIXUP
	DCA	SKIPY	/SAVE SKIP CONDITION
	ISZ	FIXUP
	TAD I	FIXUP
	DCA	LOC	/SAVE LOC TO CHANGE
	ISZ	FIXUP
	TAD I	XXFLAG	/LOOK AT FLAG
	AND	MASK	/'AND' WITH MASK
SKIPY,	HLT
	JMP	SKPF
	TAD I	FIXUP
	DCA I	LOC
	ISZ	FIXUP
SKPT,	ISZ	FIXUP
	JMP	FIXLUP
SKPF,	ISZ	FIXUP
	TAD I	FIXUP
	DCA I	LOC
	JMP	SKPT
\fCTLUO,	QREF		/COMMAND ^U
	QSKP		/COUNT UP STRING
	TAD	OSCANP
	CMA
	TAD	SCANP	/LENGTH OF STRING
/
/	*** PROHIBIT STRING > 2047 CHARS
/
	ADJQ		/ADJUST Q-REGISTERS AND SET NEW LENGTH
	TAD	OSCANP	/RESET SCAN POINTER
	DCA	SCANP
	DCA	NFLG
	NOTRCE
CCUB,	QUOTST
	JMP	CTLUND
	QPUT
	JMP	CCUB
CTLUND,	ENTRCE
	JMP I	[IREST
	PAGE
\f/NUMERICAL OUTPUT ROUTINE

ZEROD,	0
	DCA	ZERFLG	/INITIALIZE "LEADING ZEROS" FLAG
	TAD I	ZEROD
	ISZ	ZEROD
	DCA	OUTDEV	/SAVE OUTPUT ROUTINE ADDRESS
	TAD	NLINK	/POS OR NEGATIVE?
	SNA CLA
	JMP	ZER2	/POSITIVE
	TAD	RADIX
	TAD	(-ORAD
	SNA CLA
	JMP	PUTSGN	/OCTAL
	TAD	N	/DECIMAL
	CIA
	DCA	N	/NEGATE
	SKP
PUTSGN,	TAD	["1-"-
	TAD	("-
	JMS I	OUTDEV	/OUTPUT MINUS SIGN
ZER2,	MTHREE
	DCA	ZCOUNT	/ITERATION COUNT
	TAD	RADIX
	DCA	RXR
ZDIGIT,	ISZ	RXR
	TAD I	RXR
	DCA	DIV1	/GET DIVISOR
	TAD	N
	MQLDVI		/DIVIDE BY A POWER OF THE BASE
DIV1,	0
	TAD	ZERFLG
	SNA
	JMP	LZ	/IGNORE LEADING ZEROS
	TAD	(60
	JMS I	OUTDEV
	STL RAR
	DCA	ZERFLG	/SET LEADING ZEROS FLAG
LZ,	TAD	DVT1	/GET REMAINDER
	DCA	N
	ISZ	ZCOUNT	/GO AROUND AGAIN?
	JMP	ZDIGIT	/WHY NOT?
	TAD	N
	TAD	(60
	JMS I	OUTDEV	/OUTPUT LAST DIGIT NO MATTER WHAT
	JMP I	ZEROD

OUTDEV,	0		/WHERE WE'RE SENDING THE DIGITS
ZERFLG,	0
ZCOUNT,	0
RXR,	0
\f/COMMANDS = AND \

/COMMANDS = AND \ - NUMERICAL OUTPUT

CEQLO,	NCHK		/COMMAND =
ERR21,	ERR		/NO NUMBER
	TAD	RADIX
	DCA	RADTMP
	JMS I	(POKE	/LOOK AHEAD ONE CHARACTER
	TAD	(-75	/CHECK FOR = SIGN
	SZA CLA
	JMP 	SETRAD	/SINGLE =
	SCAN		/DOUBLE = (PASS UP SECOND ONE)
	SKP CLA		/CLEAR AC
SETRAD,	TAD	[4
	TAD	(ORAD
	DCA	RADIX	/SET OCTAL RADIX TEMPORARILY
	JMS	ZEROD
	TPUT
	TAD	RADTMP
	DCA	RADIX	/RESTORE ORIGINAL RADIX
	ISZ	CLNF	/: SEEN?
	CRLF		/NO, END WITH CRLF
	DCA	CLNF
	POPJ

CBSLO,	NCHK		/COMMAND \
	JMP	CBSN
	JMS	ZEROD
	UPOC
	POPJ

RADTMP,	0
\fCBSN,	PUSHJ
		NMBR2	/INITIALIZE RESULT TO 0
	JMS	PTCH
	TAD I	P
	AND	[377	/GET CURRENT CHARACTER
	CDF 0
	TAD	(-55	/CHECK FOR MINUS SIGN
	SZA
	JMP	.+3	/NOT MINUS
	PUSHJ
		CMIN	/RECORD MINUS SIGN
	CIA
	CLL RTR
	SNA CLA		/CHECK FOR PLUS SIGN
CBSNP,	ISZ	P	/BUMP POINTER PAST SIGN
	JMS	PTCH
	TAD I	P	/GET A CHAR
	AND	[377
	CDF 0
	TAD	(-72
	CLL
	TAD	CALF
	SNL		/IS IT A DIGIT?
	POPJ		/NO
	PUSHJ
		NMBR2	/YES - ACCUMULATE IT
	JMP	CBSNP	/AND LOOP
\fPTCH,	0
	TAD P		/V3C
	STL CIA		/CHECK FOR END OF BUFFER
	TAD ZZ
	SZL SNA CLA
	POPJ
	CDF 10
	JMP I PTCH

XXSUBS,	EDSUB
	EHSUB
	EOSUB
	ESSUB
	ETSUB
	EUSUB
/	CXSUB

/CXSUB,
EDSUB,
EHSUB,
ESSUB,
EOSUB,	0
	JMP I	EOSUB
	PAGE
	RELOC
\f	FIELD 1

	*4400

XERBAS,	XER1
	XER2
	XER3
	XER4
	XER5
	XER6
	XER7
	XER8
	XER9
	XER10
	XER11
	XER12
	XER13
	XER14
	XER15
	XER16
	XER17
	XER18
	XER19
	XER20
	XER21
	XER22
	XER23
	XER24
	XER25
	XER26
	XER27
	XER28
	XER29
	XER30
	XER31
	XER32
	XER33
	XER34
	XER35
	XER36
\fXER1,
"I;"l;"l;"e;"g;"a;"l;" ;"C;"o;"m;"m;"a;"n;"d;" ;4000;0
XER2,
"U;"n;"t;"e;"r;"m;"i;"n;"a;"t;"e;"d;" ;"C;"o;"m;"m;"a;"n;"d;0
XER3,
"I;"l;"l;"e;"g;"a;"l;" ;"Q;"-;"r;"e;"g;"i;"s;"t;"e;"r;" ;"N;"a;"m;"e;" ;4000;0
XER4,
"I;"n;"t;"e;"r;"n;"a;"l;" ;"P;"u;"s;"h;" ;"D;"o;"w;"n;" ;"O;"v;"e;"r
"f;"l;"o;"w;0
XER5,
"S;"t;"o;"r;"a;"g;"e;" ;"C;"a;"p;"a;"c;"i;"t;"y;" ;"E;"x;"c;"e;"e;"d;"e;"d;0
XER6,
"S;"e;"a;"r;"c;"h;" ;"S;"t;"r;"i;"n;"g;" ;"t;"o;"o;" ;"L;"o;"n;"g;0
XER7,
"I;"m;"p;"r;"o;"p;"e;"r;" ;"A;"r;"g;"u;"m;"e;"n;"t;"s;0
XER8,
"I;"l;"l;"e;"g;"a;"l;" ;"C;"h;"a;"r;"a;"c;"t;"e;"r;" ;4000
" ;"i;"n;" ;"F;"i;"l;"e;"n;"a;"m;"e;0
XER9,
";;" ;"n;"o;"t;" ;"i;"n;" ;"a;"n;" ;"I;"t;"e;"r;"a;"t;"i;"o;"n;0
XER10,
">;" ;"n;"o;"t;" ;"i;"n;" ;"a;"n;" ;"I;"t;"e;"r;"a;"t;"i;"o;"n;0
XER11,
"A;"t;"t;"e;"m;"p;"t;" ;"t;"o;" ;"M;"o;"v;"e;" ;"P;"o;"i;"n;"t;"e;"r
" ;"O;"f;"f;" ;"P;"a;"g;"e;0
XER12,
"Q;"-;"r;"e;"g;"i;"s;"t;"e;"r;" ;"M;"e;"m;"o;"r;"y;" ;"O;"v;"e;"r;"f;"l;"o;"w;0
XER13,
"U;"n;"t;"e;"r;"m;"i;"n;"a;"t;"e;"d;" ;"M;"a;"c;"r;"o;0
XER14,
"O;"u;"t;"p;"u;"t;" ;"E;"r;"r;"o;"r;0
XER15,
"I;"n;"p;"u;"t;" ;"E;"r;"r;"o;"r;0
XER16,
"F;"i;"l;"e;" ;"E;"r;"r;"o;"r;0
XER17,
"O;"u;"t;"p;"u;"t;" ;"C;"o;"m;"m;"a;"n;"d;" ;"w;"o;"u;"l;"d;" ;"h;"a;"v;"e
" ;"O;"v;"e;"r;"f;"l;"o;"w;"e;"d;0
XER18,
"N;"u;"m;"e;"r;"i;"c;" ;"A;"r;"g;"u;"m;"e;"n;"t;" ;"t;"o;" ;"Y;0
XER19,
"I;"l;"l;"e;"g;"a;"l;" ;"C;"h;"a;"r;"a;"c;"t;"e;"r;" ;4000
" ;"a;"f;"t;"e;"r;" ;"E;0
XER20,
"I;"l;"l;"e;"g;"a;"l;" ;"C;"h;"a;"r;"a;"c;"t;"e;"r;" ;4000
" ;"a;"f;"t;"e;"r;" ;"";0
XER21,
"N;"o;" ;"A;"r;"g;"u;"m;"e;"n;"t;" ;"b;"e;"f;"o;"r;"e;" ;"=;0
XER22,
"N;"o;" ;"A;"r;"g;"u;"m;"e;"n;"t;" ;"b;"e;"f;"o;"r;"e;" ;"U;0
XER23,
"N;"o;" ;"A;"r;"g;"u;"m;"e;"n;"t;" ;"b;"e;"f;"o;"r;"e;" ;"q;"u;"o;"t;"e;0
XER24,
"S;"e;"a;"r;"c;"h;" ;"f;"a;"i;"l;"e;"d;0
XER25,
"N;"e;"g;"a;"t;"i;"v;"e;" ;"o;"r;" ;"Z;"e;"r;"o
" ;"A;"r;"g;"u;"m;"e;"n;"t;" ;"t;"o;" ;"P;0
XER26,
"N;"e;"g;"a;"t;"i;"v;"e;" ;"a;"r;"g;"u;"m;"e;"n;"t;" ;"t;"o;" ;",;0
XER27,
"C;"a;"s;"e;" ;"S;"u;"p;"p;"o;"r;"t;" ;"n;"o;"t
" ;"I;"m;"p;"l;"e;"m;"e;"n;"t;"e;"d;215;212;211;177;177 
"[;"u;"s;"e;" ;"W;" ;"f;"o;"r;" ;"W;"a;"t;"c;"h;" ;"C;"o;"m;"m;"a;"n;"d;"];0
/XER28,
/"N;"e;"g;"a;"t;"i;"v;"e;" ;"o;"r;" ;"Z;"e;"r;"o;" 
/"I;"t;"e;"r;"a;"t;"i;"o;"n;" ;"C;"o;"u;"n;"t;0
XER28,
0
XER29,
"N;"e;"g;"a;"t;"i;"v;"e;" ;"o;"r;" ;"Z;"e;"r;"o;" 
"A;"r;"g;"u;"m;"e;"n;"t;" ;"t;"o;" ;"S;0
XER30,
"C;"a;"n;"n;"o;"t;" ;"W;"r;"i;"t;"e;" ;"O;"u;"t;" ;"E;"r;"r;"o;"r
" ;"M;"e;"s;"s;"a;"g;"e;" ;"O;"v;"e;"r;"l;"a;"y;0
XER31,
"I;"l;"l;"e;"g;"a;"l;" ;"C;"h;"a;"r;"a;"c;"t;"e;"r;" ;4000
" ;"a;"f;"t;"e;"r;" ;"F;0
XER32,
"Y;" ;"C;"o;"m;"m;"a;"n;"d;" ;"A;"b;"o;"r;"t;"e;"d;0
XER33,
"C;"C;"L;".;"S;"V;" ;"n;"o;"t;" ;"f;"o;"u;"n;"d;" ;"o;"r;" 
"E;"G;" ;"a;"r;"g;"u;"m;"e;"n;"t;" ;"t;"o;"o;" ;"b;"i;"g;0
XER34,
"E;"x;"e;"c;"u;"t;"i;"o;"n;" ;"a;"b;"o;"r;"t;"e;"d;0
XER35,
"C;"a;"s;"e;" ;"S;"u;"p;"p;"o;"r;"t;" ;"n;"o;"t;" 
"I;"m;"p;"l;"e;"m;"e;"n;"t;"e;"d;215;212;211;177;177
"[;"u;"s;"e;" ;"E;"O;" ;"f;"o;"r
" ;"V;"e;"r;"s;"i;"o;"n;" ;"n;"u;"m;"b;"e;"r;"];0
XER36,
"N;"o;" ;"F;"i;"l;"e;" ;"f;"o;"r;" ;"O;"u;"t;"p;"u;"t;0
	PAGE
\fCOREAD,	0
	ISZ	COREAD
	TAD I	COREAD	/GET BLOCK #
	AND	CO7
	CLL RTR
	RTR
	RAR		/MULTIPLY BY 400
	TAD	KMEM
	DCA	FLO
	TAD	M400
	DCA	FLCNT
	TAD	K3200
	DCA	FTO
FLOO,	CDF	30
	TAD I	FLO
	CDF	0
	DCA I	FTO
	ISZ	FLO
	ISZ	FTO
	ISZ	FLCNT
	JMP	FLOO
	ISZ	COREAD
	CIF CDF	0
	JMP I	COREAD

FLCNT,	0
CO7,	7
M400,	-400
K3200,	3200
KMEM,	MEMLOC
FLO,	0
FTO,	0
COREND=.
\fNEWERR,	RELOC OVREAD
	CIF 30	/NEW CODE TO READ OVERLAY
	JMS I .+1	/MUST BE 5 LOCS LONG
	COREAD
TMP,	0		/BLOCK #
	NOP
	RELOC
	PAGE
\f