<div id='wikitext'>
<pre><b> File: TECO.PA of Tape: Sources/Focal/fc3</b></pre>
<pre><b>(Source file text) </b></pre>
<hr />
<pre>
	/PS/8 TECO

IN=	6200		/INPUT BUFFER AT 06200
OUT=	6600		/OUTPUT BUFFER AT 06600
ZMAX=	7640		/ABOUT 4000 [10] CHARACTERS IN TEXT BUFFER
APMAX=	ZMAX-310	/=ZMAX-200[10]
QMAX=	3720		/ABOUT 2000[10]CHARACTERS IN Q-REGS
DMAX=	0600		/NUMBER OF CHARACTERS IN I/O BUFFERS

INHNDL=	7200		/ADDRESS OF INPUT HANDLER
OUHNDL=	7400		/OUTPUT HANDLER LOAD POINT


	/TECO USES LOCS 12-17

	*20		/TECO PSEUDO-OPERATIONS:
PUSH=	JMS I .;	PUSHXX
POP=	JMS I .;	POPXX
PUSHJ=	JMS I .;	PUSHJY
POPJ=	JMP I .;	POPJXX
PUSHL=	JMS I .;	PUSHLX
POPL=	JMS I .;	POPLX
ERR=	JMS I .;	ERRXX
SORT=	JMS I .;	SORTB
RESORT=	JMP I .;	SORTA2
SCAN=	JMS I .;	SGET
RESCAN=	JMS I .;	SREGET
LISTEN=	JMS I .;	TYI
TYPE=	JMS I .;	TYO
CTLTYP=	JMS I .;	TYPCTL
CTVTYP=	JMS I .;	TYPCTV
CRLF=	JMS I .;	TYCRLF
QGET=	JMS I .;	GETX
QPUT=	JMS I .;	PUTX
SKPSET=	JMS I .;	SETSKP
NCHK=	JMS I .;	CHKNF
CCHK=	JMS I .;	CHKCF
BZCHK=	JMS I .;	CHKBZ
QCHK=	JMS I .;	CHKQF
QSKP=	JMS I .;	QOVER
CLNCHK=	JMP I .;	CHKCLN
QREF=	JMS I .;	QREFER
QSUM=	JMS I .;	QSUMR
QSTUFF=	JMS I .;	QPUTS


SFAIL,	0	/SEARCH FAIL FLAG
CFLG,	0	/COMMA FLAG
CLNF,	0	/COLON FLAG
NFLG,	0	/NUMBER FLAG
OFLG,	0	/OPERATOR FLAG
QFLG,	0	/QUOTED STRING FLAG
M,	0	/NUMBER ARGS
N,	0
CHAR,	0	/CHARACTER BUFFER
CSAVE,	0	/FOR PACKING ROUTINES
ITRST,	0	/ITERATION FLAG
TFLG,	0	/TRACE MODE
MPDL,	0	/MACRO FLAG
SCHAR,	0	/LAST CHAR SORTED
	INPUT=	JMS I .
INR,	ERRXX	/INPUT ROUTINE
ICHAR,	0	/INPUT ROUTINE TEMPORARY
REND,	0	/INPUT END-OF-FILE FLAG
	OUTPUT=	JMS I .
OUTR,	ERRXX	/OUTPUT ROUTINE
OCHAR,	0	/OUTPUT ROUTINE TEMPORARY
WEND,	0	/OUTPUT END-OF-FILE FLAG
SCANP,	0	/COMMAND LINE EXECUTION POINTER
PDLP,	0	/PUSH-DOWN-LIST POINTER
QNMBR,	0	/LAST Q-REG REFERENCED
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
R,	0
APPLST=	.
CASP,	40	/SPACE
	14	/FORM FEED
	12	/LINE FEED
CTLZ,	32	/^Z
YFLG,	7777	/IN MODE SW: BRIEF
	MASK=.	/ASCII CHARACTER MASK
CARO,	177	/RUBOUT
XFLG,	7777	/OUT MODE SW: EXPANDED
QP,	0	/Q REGISTER POINTER
QR,	0	/EXTRA Q-REG POINTER
QZ,	0	/END OF Q-REG POINTER
KFLG,	7777	/ECHO MODE SWITCH: ON
QREGS,	QPNTR	/Q-REG POINTER ARRAY
SERR,	ERR	/ILLEGAL COMMAND ENCOUNTERED
OUTLST,	14	/FF: END OF PAGE
CALF,	12	/LF
CACR,	15	/CR
CAHT,	11	/HT
CAAM,	33	/ALT MODE
APM12,	-12	/END OF LIST
MQLMUY=	JMS I .;MUYMQL
CLAMQA=	JMS I .;MQACLA
MQLDVI=	JMS I .;DVIMQL
NAME,	ZBLOCK 4	/NAME BUILD BUFFER
ODEV,	0	/OUTPUT DEVICE NUMBER
OMAXLN,	0	/SIZE OF HOLE
OUTHND,	0
INHND,	0
EBFLG,	0	/EDIT BACKUP FLAG
USR,	7700	/MONITOR CALL LOCATION
	PAGE
TECO,	JMS IOSTRT	/INITIALIZE I/O
	DCA P		/RESET POINTERS
	DCA ZZ
	DCA TCASE	/SET TO UPPER CASE
T1,	TAD (PDLBEG	/RESET THE PUSHDOWN LIST
	DCA PDLP
	DCA QCMND	/POINT TO COMMAND LINE
	DCA QNMBR	/ANOTHER Q-REG POINTER
	TAD I QREGS	/# OF CHARS IN PREV COMM LINE
	CIA		/SUBTRACT FROM
	TAD QZ		/Q-REG CONTENTS
	DCA QZ		/NEW MAXIMUM
	DCA I QREGS	/ZERO CHARS IN COMM LINE
	TAD (SFAIL-INR	/CLEAR SEVERAL PAGE 0
	DCA TSIG	/REGISTERS
	TAD (SFAIL-1
	DCA 10		/USING AUTO-INDEX
	DCA I 10	/OF COURSE
	ISZ TSIG
	JMP .-2
	PUSHJ		/RESTORE ALTM &amp; $ AS
		IREST	/STRING TERMINATORS
	PUSHJ		/UNDO A FIX
		CNDO+2
	JMS TSIG
T2,	LISTEN		/BUILD COMMAND LINE
	SORT
		COMLST
		COMTAB-COMLST
	TAD (-100	/TEST FOR LETTERS
	SMA
	TAD TCASE	/ADD CASE BIT
	TAD (100	/RESTORE
	DCA CHAR
	CTLTYP		/ECHO COMMAND CHARACTER
	JMS SPUT	/PUT INTO C.L. BUFFER
	JMP T2		/GO GET ANOTHER

TALTM,	TAD CAAM	/ALTM IN COMM LINE
	DCA SCHAR	/MAKE EVERY ALTM INTO 33
	JMS COMPAR	/2ND ALTM STARTS EXECUTION
	JMS SPUT	/PUT IN EXTRA ALTM AT END
	CRLF		/START COMM EXECUTION
	DCA SCANP	/RESET TO BEGINNING
T6,	SCAN
	DCA CHAR	/SAVE COMMAND CHAR
	TAD TFLG	/SEE IF TRACE ON
M140,	SZA CLA		/-140, LOC USED AS CONSTANT
	CTLTYP		/YES, TYPE OUT COMM CHAR
	TAD CHAR
T6A,	TAD M140	/SEE IF LOWER CASE
	SMA
	TAD (-40	/MAKE LC INTO UPPER CASE
	TAD (140+CDSP	/ADD BASE OF DISPATCH TABLE
	DCA T7		/LOK UP ENTRY IN
	TAD I T7	/COMMAND DISPATCH TABLE
	DCA T7		/CALL RECURSIVELY
	PUSHJ
T7,		0	/CALL TO ROUTINE
	CLA		/FINALLY FINISHED THAT ONE
	JMS BRKCHK	/BREAK?
	TAD ITRST	/INSIDE ITERATION?
	SZA CLA		/LEGAL FOR SEARCHES TO FAIL?
	JMP T6		/YES, CONTINUE
	TAD SFAIL	/NO, SEE IF IT DID
	SNA CLA
	JMP T6		/NO, CONTINUE
	JMP RECOUP	/YES, STOP EXECUTION
TQMK,	JMS COMPAR	/? IN COMM LINE
	JMS CLDO	/2ND ? ERASES 1ST ?
	PUSHJ		/AND RETYPES
		TQMF	/COMMAND LINE SO FAR
	JMP T2		/TAKE IN MORE COMMANDS
TSIG,	0		/RESET SCAN POINTER AND SIGNAL
	DCA SCANP	/BEGINNING OF COMM LINE
	CRLF
	TAD (52		/*
	TYPE
	JMP I TSIG	/RETURN

ROCMND,	TAD SCANP	/SEE IF ANYTHING TO ERASE
	SNA CLA
	JMP T1		/NO, START ALL OVER
	RESCAN		/YES
	CTVTYP		/ECHO SCRUBBED CHAR
	JMS CLDO	/REMOVE IT
	RESCAN		/GET CHAR BEFORE
	DCA CHAR	/MAKE IT PREV CHAR
	JMP T2		/PROCEED
CLDO,	0		/COMM LINE DOWN ONE CHAR
	TAD SCANP	/IF THERE ARE ANY CHARS
	SNA CLA
	JMP I CLDO	/THERE WEREN&#039;T, SO GO BACK
	STA
	TAD QZ		/FIRST BACK UP THE
	DCA QZ		/Q-REGISTER COUNT
	STA
	TAD SCANP	/NOW BACK UP SCAN POINTER
	DCA SCANP
	STA
	TAD I QREGS	/AND CHARACTER COUNT
	DCA I QREGS
	JMP I CLDO
TQMF,	TAD SCANP	/TYPE COMM LINE UP TO SCANP
	CMA		/SAVE FOR COUNTING
	DCA CLDO	/MORE TIGHT CODING
	JMS TSIG	/FLAG BEGINNING OF COMM LINE
TBA1,	ISZ CLDO	/DONE?
	SKP		/NO
	POPJ		/YES, RETURN
	SCAN		/GET A CHAR
	DCA CHAR
	CTLTYP		/CTRL CHARS GET ^
	JMP TBA1	/TYPE ANOTHER
TCASE,	0		/LOWER CASE BIT: 0 OR 40
	PAGE
	/Q-REGISTER OPERATORS

GETX,	0		/GET A Q-CHARACTER
	TAD I GETX	/POINTER TO POINTER FOLLOWS
	DCA PUTX	/WHY NOT?
	TAD I PUTX	/INDIRECT INDIRECT
	CLL RAL		/CHARACTERS PACKED 1/2 PER WORD
	DCA PUTX
	CDF 10		/PACKED IN FIELD ONE
	TAD I PUTX	/GET FIRST HALF
	AND [7400	/MASK OFF TEXT BUFFER
	CLL RTL
	RTL
	DCA CSAVE	/TEMP CHARACTER SAVE
	ISZ PUTX	/GET SECOND HALF
	TAD I PUTX
	CDF
	AND [7400
	TAD CSAVE	/GET FIRST HALF
	RTL
	RTL
	RAL
	ISZ GETX	/SKIP OVER POINTER
	JMP I GETX

PUTX,	0		/FILL A Q-REGISTER
	AND MASK	/JUST TO BE SURE
	CLL RTL		/SHIFT LEFT
	RTL
	DCA CSAVE
	TAD I PUTX	/GET POINTER
	ISZ PUTX
	DCA GETX
	TAD I GETX
	CLL RAL
	DCA GETX
	CDF 10
	TAD I GETX
	AND MASK
	DCA PTEMP
	TAD CSAVE
	AND [7400
	TAD PTEMP
	DCA I GETX
	ISZ GETX
	TAD I GETX
	AND MASK
	DCA PTEMP
	TAD CSAVE
	CLL RTL
	RTL
	AND [7400
	TAD PTEMP
	DCA I GETX
	CDF
	JMP I PUTX
PTEMP,	0

	/&quot;EX&quot; AND &quot;EC&quot; COMMANDS

EXITC,	CMA		/&#039;EC&#039; COMMAND
EXIT,	DCA EXITFG	/&#039;EX&#039; COMMAND
	TAD WEND	/CHECK FOR OPEN OUTPUT FILE
	SNA CLA
	JMP EXITG	/NOPE, EXIT ALREADY
EXLOOP,	TAD REND	/EOF?
	SNA CLA
	JMP EXOUT	/YES, WRITE OUT LAST PAGE
	CMA		/NO, DO A &#039;P&#039; COMMAND
	DCA NLINES
	PUSHJ
		CPOA
	JMP EXLOOP
EXOUT,	PUSHJ		/WRITE OUT LAST BUFFER
		CHRW
	PUSHJ		/AND CLOSE FILE
		ENDFIL
EXITG,	ISZ EXITFG	/EC OR EX?
	JMP CTLC	/EXIT RETURNS TO MONITOR
	JMP CKALL	/EC STAYS IN TECO!

EXITFG,	0

IOSTRT,	0		/INITIAL I/O SELECTION
	TAD ERR-4400	/MUST SET UP I/O
	DCA OUTR	/WITHIN PROGRAM
	TAD ERR-4400
	DCA INR
	TAD (TPUT+6&amp;177+5200	/JMP TPUT+6
	DCA TPUT+1
	JMP I IOSTRT

BRKCHK,	0
	KSF
	JMP I BRKCHK
	KRS
	AND MASK
	SZA CLA
	JMP I BRKCHK
	KCC
	ERR		/STEAL CONTROL

POPXX,	0		/POP ROUTINE
	CLA
	TAD PDLP
	TAD (-PDLBEG	/CHECK FOR UNDERFILL
	SPA SNA CLA
	ERR		/SPRUNG OUT THE TOP
	CLA CMA		/LET POINTER
	TAD PDLP	/BACK OUT OF
	DCA PDLP	/THE BOX
	TAD I PDLP
	JMP I POPXX

	PAGE
/PUSH DOWN AND CHARACTER MOVE ROUTINES
PUSHXX,	0		/PUSH ROUTINE
	DCA ACXX
	TAD PDLP
	TAD [-PDLEND-1	/CHECK FOR OVERFILL
	SMA CLA
	ERR		/POKED OUT THE BOTTOM
	TAD ACXX
	DCA I PDLP
	ISZ PDLP	/SQUISH POINTER
	JMP I PUSHXX

POPJXX,	DCA ACXY	/POPJ ROUTINE
	POP
	DCA PUSHXX
POPJXY,	TAD ACXY
	JMP I PUSHXX

PUSHJY,	0		/PUSHJ ROUTINE
	DCA ACXY
	IAC
	TAD PUSHJY
	PUSH
	TAD I PUSHJY
	DCA PUSHXX
	KSF		/CHECK FOR BREAK
	JMP POPJXY
	JMS BRKCHK	/BREAK?
	JMP POPJXY	/CONTINUE POPJ

ACXX,	0		/STORAGE FOR
ACXY,	0		/PUSH-DOWN
ACXZ,	0		/ROUTINES

PUSHLX,	0		/PUSH AND CLEAR A LIST
	DCA POPLX	/SET COUNTER
	POP		/SAVE RETURN POINTER
	DCA ACXZ
	TAD I PUSHLX
	DCA ACXY
	TAD I ACXY
	PUSH
	DCA I ACXY
	ISZ PUSHLX
	ISZ POPLX
	JMP PUSHLX+4
	TAD ACXZ	/RESTORE RETURN POINTER
	PUSH
	JMP I PUSHLX
POPLX,	0		/POP A LIST
	DCA PUSHLX	/SET COUNTER
	POP		/SAVE RETURN POINTER
	DCA ACXZ
	TAD I POPLX
	DCA ACXY
	POP
	DCA I ACXY
	ISZ POPLX
	ISZ PUSHLX
	JMP POPLX+4
	TAD ACXZ	/RESTORE RETURN POINTER
	PUSH
	JMP I POPLX

ADJ,	SPA		/ADJUST BUFFER + OR - N CHARS
	JMP DNNC-1	/-N CHARACTERS
UPPN,	SNA		/TEST FOR NOTHING
	POPJ		/GO AWAY
	CLL		/MOVE UP N CHARACTERS
	TAD ZZ		/ADD TO MAX CHARACTER
	DCA R		/NEW HIGHEST
	TAD R		/SEE IF TOO HIGH
	TAD [-ZMAX
	SZL CLA		/TWO PLACES FOR OVERFLOW THERE
	ERR
	TAD ZZ
	DCA Q
	TAD R
	DCA ZZ
UPNL,	TAD R
	CIA
	TAD P
	SNA CLA		/FINISHED?
	POPJ		/YES
	CMA
	TAD Q
	DCA Q
	CMA
	TAD R
	DCA R
	CDF 10
	TAD I Q
	AND MASK
	DCA CSAVE
	TAD I R
	AND [7400
	TAD CSAVE
	DCA I R
	CDF
	JMP UPNL

	CIA		/REACHED FROM ADJ
DNNC,	TAD P		/MOVE DOWN N CHARACTERS
	BZCHK		/CHECK FOR OVERFLOW
	DCA Q		/N IN AC
	TAD P
	DCA R
	CDF 10
DNN1,	TAD ZZ
	CIA
	TAD Q
	SNA CLA		/FINISHED?
	JMP UPNEND	/YES
	TAD I Q
	AND MASK
	DCA CSAVE
	TAD I R
	AND [7400
	TAD CSAVE
	DCA I R
	ISZ Q
	ISZ R
	JMP DNN1
UPNEND,	CDF
	TAD R
	DCA ZZ
	POPJ
	PAGE
/COMMANDS C,D,J,K,L
CHRJ,	TAD N		/COMMAND J
	NCHK
	CLA		/ASSUME BJ
	JMP CLOQ
CHRC,	TAD N		/COMMAND C
	NCHK
	STA		/ASSUME -1C
	TAD P		/OFFSET RELATIVE TO .
CLOQ,	BZCHK		/SEE IF IN RANGE B,Z
	DCA P		/IN RANGE
	POPJ
CHRD,	CCHK		/COMMAND D
	JMP CDN		/ONE ARG
	DCA NFLG	/CLEAR NUMBER FLAG
	PUSHJ
		MFROMN	/COMPUTE N-M
	SNA		/ANYTHING TO DELETE?
	POPJ		/NO
	CIA
	DCA CDT
	TAD M		/SET POINTER
	DCA P		/LOWER ARG
	JMP CDMN
CDN,	TAD N
	NCHK		/SEE IF NUMBER FLAG UP
	STA		/SET TO -1D IF NOT
	SNA		/CHECK FOR 0D
	POPJ		/0D IS IGNORED
	SMA
	JMP DNNC	/+ND
	DCA CDT		/-ND
	TAD CDT
	PUSHJ		/DO (-)NC(+)ND
		CHRC+3
CDMN,	TAD CDT
	JMP DNNC-1
CKALL,	DCA ZZ		/KILL WHOLE BUFFER
	JMP CLOQ+1	/RESET POINTER

CHRL,	TAD N		/COMMAND L
	NCHK
	CLA		/L MEANS 0L
	CIA CLL		/MAKE NEGATIVE
	SMA		/DID IT?
CLCMA,	CMA STL		/NO, MAKE MORE NEGATIVE
	DCA SREGET	/SAVE IN SUBR ENTRY
	TAD CLCMA	/COMPUTE SWITCH
	SNL		/WHICH DIRECTION?
	TAD (IAC-CMA	/FORWARD
	DCA CLCH	/CMA FOR -NL
CLCH,	JMP .		/OR IAC FOR +NL
	TAD P		/GET .
	DCA P		/NEW . = OLD + OR - 1
	CLA STL IAC	/LOOK OUT FOR .=-1
	TAD P		/CLAMP AT ENDS OF BUFFER
	CIA CML		/SEE IF AT HEAD

	SNA SZL CLA
	JMP CHRJ+2	/YES, EXIT
	TAD ZZ
	CIA CLL
	TAD P		/SEE IF AT END
	SNA SZL CLA
	JMP CHRC+3	/YES, EXIT
CLP,	CDF 10
	TAD I P
	CDF
	AND MASK
	TAD APM12	/CHECK FOR LINE FEED
	SNA CLA
	ISZ SREGET	/FOUND ONE. ENOUGH?
	JMP CLCH	/NO
	ISZ P		/MOVE PAST LF
	POPJ
CKT,	0		/TEMPORARY
CDT,	0		/TEMPORARY
SREGET,	0		/RESCAN LAST CHAR
	STA
	TAD SCANP
	SPA		/ZEROTH CHARACTER?
	JMP I SREGET	/YES, CALL IT NULL
	DCA SCANP
	SCAN
	JMP I SREGET	/RETURN

CHRK,	CCHK		/K COMMAND
	JMP CKN		/1 ARG
	PUSHJ		/CONVERT LNE
		LINES	/#&#039;S TO CHARS
	JMP CHRD+2	/DO M,ND
CKN,	NCHK		/WHAT ARGS?
	JMP CKALL	/K MEANS EVERYTHING
	JMS NLINES	/CONVERT N LINES TO M,N
	JMP CHRD+2	/DO .,(NL).D
LINES,	TAD P		/SAVE .
	PUSH
	PUSHJ		/COMPUTE
		MFROMN	/N-M
	PUSH		/SAVE IT
	TAD M
	PUSH		/SAVE IT
	PUSHJ
		CHRB
	PUSHJ		/DOING BJML
		CHRJ
	POP		/RETRIEVE M
	PUSHJ
		CHRL+3	/FIND LINE M
	TAD P
	DCA M
	POP		/RETRIEVE N-M
	PUSHJ
		CHRL+3
	TAD P
	DCA N
	POP		/RETRIEVE ORIGINAL .
	DCA P
	POPJ
TYCRLF,	0		/TYPE A CR AND LF
	TAD CACR	/CR
	TYPE
	TAD CALF	/LF
	TYPE
	JMP I TYCRLF	/RETURN
	PAGE
/COMMANDS ^D,^K,,,N,R,S, AND _
CSCH,	QCHK		/SEARCH ROUTINE
	TAD SCANP
	DCA CST
	TAD P
	DCA CSP
	JMP CSG
CSL,	SCAN
	SORT
		SCHLST
		SCHTAB-SCHLST
CSQ,	CIA
	DCA CSNB
	CDF 10
	TAD I P
	CDF
	AND MASK
	TAD CSNB
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
	QSKP		/SKIP OVER SEARCH STRING
	DCA P
	CMA		/SET SEARCH FAIL FLAG
CSZ,	DCA SFAIL
	POPJ
CSK,	ISZ CSN		/GET NTH OCCURRENCE
	JMP CSF		/MORE TO GO
	JMP CSZ		/GOT IT
CSF,	TAD CST		/RESET SCANP
	DCA SCANP
	ISZ CSP		/INDEX P
	TAD CSP
	DCA P
	JMP CSG

CHRS,	JMS CSNB	/COMMAND S
	PUSHJ
		CSCH
	CLNCHK		/ASSIGN VALUE, IF ANY
CHBA,	TAD CHIRPY	/COMMAND _
CHRN,	TAD CHIRP	/COMMAND N
	DCA CNXT
	JMS CSNB
	QCHK		/SNAG QUOTING CHAR
CNJ,	TAD SCANP
	DCA RADIX	/SAVE SCAN POINTER
	PUSHJ
		CSCH+1	/DO A SEARCH
	TAD SFAIL
	SMA CLA		/SUCCESS?
	CLNCHK		/YES, ASSIGN VALUE
	TAD REND	/SEE IF FILE END
	SNA CLA
	CLNCHK		/FAILED, ASSIGN VALUE
	TAD RADIX	/OTHERWISE RESET SCANP
	DCA SCANP
	PUSHJ
CNXT,		0	/CHRP OR CHRY
	JMP CNJ
CSNB,	0		/SET # OF TIMES TO FINE
	TAD N
	NCHK
	IAC		/ASSUME 1
	CIA
	DCA CSN
	JMP I CSNB
CSN,	0		/COUNTER
CST,	0		/TEMP SCANP
CSP,	0		/TEMP P
CHIRPY,	CHRY-CHRP	/POINTER TO Y COMMAND
CHIRP,	CHRP		/POINTER TO P COMMAND

CHRR,	JMS CSNB	/COMMAND R
	PUSHJ
		CSCH	/DO SEARCH PART
	TAD SCANP	/SAVE SCAN POINTER
	DCA CSNB
	QSKP		/COUNT UP STRING 2
	TAD SFAIL
	SPA CLA
	CLNCHK		/FAILED, SET VALUE &amp; EXIT
	TAD CSNB	/GET START OF STRING 2
	TAD P		/AND END OF STRING 1
	CMA
	TAD SCANP	/FROM END OF STRING 2
	TAD CSP		/AND START OF STRING 1
	DCA CSN		/NET CHANGE IN BUFFER SIZE
	TAD CSP		/RESET
	DCA P		/TEXT POINTER
	TAD CSNB	/AND
	DCA SCANP	/COMMAND POINTER
	TAD CSN
	PUSHJ
		ADJ	/ADJUST BUFFER SIZE
	PUSHJ		/INSERT
		CIL2	/STRING 2
	CLNCHK		/SET VALUE AND EXIT

CTLK,	TAD (ORAD-DRAD	/COMMAND ^K
CTLD,	TAD (DRAD	/COMMAND ^D
	DCA RADIX
	TAD I RADIX	/FETCH 1000 OR 1750
	DCA PRAD	/TO &quot;=&quot; COMMAND
	ISZ RADIX
	TAD I RADIX	/FETCH 10 OR 12
	DCA PRAD+1	/TO &quot;=&quot; COMMAND
	TAD I RADIX	/FETCH 10 OR 12
	DCA NMRBAS	/TO NUMBER PROCESSOR
	POPJ
RADIX,	0		/SHARED WITH SEARCH ROUTINES
CCMA,	NCHK		/COMMAND ,
	ERR		/NUMBER FLAG NOT SET
	TAD N		/MOVE N TO M
	DCA M
	DCA N		/AND CLEAR N
	STA
	DCA CFLG	/SET COMMA FLAG
	POPJ
	PAGE
/NUMBER PROCESSORS:
/COMMANDS B,F,H,Z,+,-,.,#,&amp;,*,/,(, AND )
NMBR,	TAD CHAR	/NUMBER FOUND IN COMMAND STRING
	TAD (-60
	DCA NMT
	NCHK		/CHECK NUMBER FLAG
	JMP NNEW	/NOT UP, NEW OPERAND
	TAD NP		/MULTIPLY PREV DIGITS BY 10
	MQLMUY
NMRBAS,	12		/CHANGE TO 10 FOR OCTAL RADIX
	CLAMQA
NMR,	TAD NMT
	DCA NP		/CURRENT NUMBER
	TAD NP
NOPR,	SKP		/DISPATCH JUMP FOR OPERATOR
	CIA
	TAD NACC	/CURRENT EXPRESSION VALUE
NRET,	DCA N
	CLA CMA		/SET NUMBER FLAG
	DCA NFLG
	DCA OFLG	/CLEAR OPERATOR FLAG
	POPJ
CHRH,	PUSHJ		/COMMAND H
		CHRB
	PUSHJ
		CCMA	/DO B AND , THEN Z
CHRZ,	TAD ZZ		/COMMAND Z
CHRB,			/COMMAND B
NCOM,	DCA NMT		/COMMON TO ALL NUMBER ROUTINES
NNEW,	TAD OFLG	/CHECK OPERATOR FLAG
	SZA CLA		/MIDDLE OF EXPRESSION?
	JMP NMR		/YES
	DCA NACC	/NO, CLEAR ACCUMULATOR
	TAD NSKP	/ASSUME +
	DCA NOPR
	JMP NMR
NMT,	0		/TEMP
NP,	0		/VALUE OF CURRENT NUMBER
NACC,	0		/VALUE OF EXPRESSION WITHOUT NP

CDOT,	TAD P		/COMMAND .
	JMP NCOM
CPLS,	NCHK		/COMMAND +
	DCA N
	TAD NSKP
CMIP,	DCA NOPR	/COMMON TO ALL NUMERIC OPERATORS
	TAD N
	DCA NACC
	DCA NP
	STA		/SET OPERATOR FLAG
	DCA OFLG
	DCA NFLG	/CLEAR NUMBER FLAG
	POPJ
CMIN,	NCHK		/COMMAND -
	DCA N		/UNARY MINUS
	TAD (NOP
	JMP CMIP
CAST,	NCHK		/COMMAND *
	JMP CLINE	/WANTS CURRENT LINE NUMBER
	TAD [-2		/MAKE MQLMUY
	JMP .+3
CVIR,	NCHK		/COMMAND /
	JMP LLINE	/WANTS LAST LINE NUMBER
	TAD (MQLDVI
	DCA NMC
	TAD (JMP NMLDV
	JMP CMIP
CAMP,	TAD [-2		/COMMAND &amp;
CNBS,	TAD (JMP NIOR	/COMMAND #
	JMP CMIP
NAND,	AND NACC	/BITWISE .AND. OF BINARY NUMBERS
	JMP NRET	/KEEP THESE TWO OPNS TOGETHER
NIOR,	CMA		/BITWISE .IOR. OF BINARY VALUES
	AND NACC	/USE VENN DIAGRAM TO PROVE IT
	TAD NP
	JMP NRET
NMLDV,	DCA NMC+1	/MUL &amp; DIV OPNS
	TAD NACC	/DIVIDE IS ONLY 12-BIT UNSIGNED
NMC,	MQLMUY		/OR MQLDVI
	0		/MULTIPLIER OR DIVISOR
	CLAMQA		/TRUNCATE
	JMP NRET

CHRF,	PUSHJ		/COMMAND F
		NCOM	/MAKE A 0
	PUSHJ
		CCMA	/DO 0 AND , THEN /
LLINE,	TAD ZZ		/FIND LAST LINE #
NSKP,	SKP
CLINE,	TAD P		/FIND CURRENT LINE #
	CLL CMA
	DCA NP
	DCA NMT
	DCA R		/USE AUX BUFFER POINTERS
	JMP LINA2
LINA1,	CDF 10
	TAD I R
	CDF
	AND MASK
	TAD APM12	/-LF
	SNA CLA		/END OF LINE?
	ISZ NMT		/YES, COUNT IT
	ISZ R
LINA2,	ISZ NP		/FINISHED?
	JMP LINA1	/NO
	JMP NNEW	/MAKE A NUMBER
COPR,	TAD OFLG	/COMMAND (
	SZA CLA		/SEE IF OPENING OF EXPRESSION
	JMP .+3		/NO
	PUSHJ		/YES, SO CLEAN UP FIRST
		NCOM	/RECURSION IS NICE!
	TAD [-3		/PUSH 3 QUANTITIES
	PUSHL
		N
		NOPR
		NMC
	DCA NMT
	JMP CMIP-1	/CLEAN OUT INSIDE PARENS
CCPR,	TAD N		/COMMAND )
	DCA NMT
	TAD [-3		/POP 3 QUANTITIES FROM BEFORE
	POPL
		NMC
		NOPR
		NACC	/OLD N
	JMP NMR		/TREAT (...) AS A NUMBER
	PAGE
/COMMANDS =,?, AND \
/NUMERICAL OUTPUTS &amp; DISPATCH SORT
OPRNT,	0		/OCTAL PRINT
	JMS ZEROD
ORAD,	1000
	10
DECTYO,	TPUT		/TYPE OUT
	JMP I OPRNT
CEQL,	NCHK		/COMMAND =
	ERR		/NO NUMBER
	TAD DECTYO	/TYPE OUT
	JMP DPRNT
CBSL,	NCHK		/COMMAND \
	JMP CBSN
	TAD (UPOC
DPRNT,	DCA DECDEV
	TAD N
	JMS ZEROD
PRAD,	1750		/OR 1000 AND 10
	12		/FOR OCTAL RADIX
DECDEV,	0
	POPJ
CQSM,	TAD TFLG	/COMMAND ?
	CMA		/CHANGE TRACE FLAG
	DCA TFLG
	POPJ
UPOC,	0		/MOVE TEXT BUFFER UP ONE CHAR
	DCA OPRNT
	CLA IAC
	PUSHJ
		UPPN
	CDF 10
	TAD I P
	AND [7400
	TAD OPRNT
	DCA I P
	CDF
	ISZ P
	JMP I UPOC

ZEROD,	0		/BINARY TO OCTAL OR DECIMAL
	DCA PTSAVE	/CONVERSION WITH LEADING
	STA		/ZEROS DELETED
	DCA LEADZ
	TAD [-3		/-MAX # OF DIGITS DELETED
	DCA ZCOUNT
	TAD (JMP I ZPNT
	DCA ZSWT	/SET LEADING-ZERO SWITCH
	TAD I ZEROD	/GET 8^3 OR 10^3
	DCA DIV1
	ISZ ZEROD
	TAD I ZEROD	/GET 8 OR 10
	DCA DIV2
	ISZ ZEROD
	TAD I ZEROD	/GET POINTER TO ROUTINE WHICH
	DCA DEVOUT	/GETS DIGITS WE MAKE HERE.
	ISZ ZEROD	/BUMP RETURN POINTER
ZAGAIN,	TAD PTSAVE	/GET NUMBER TO BE CONVERTED
	MQLDVI
DIV1,	0		/SUCCESSIVELY REDUCED BY 8 OR 10
	DCA PTSAVE	/RESIDUE
	CLAMQA
	SNA		/IS DIGIT A ZERO?
ZSWT,	JMP I ZPNT	/YES, SO JUMP THRU DISPATCH
	ISZ LEADZ	/NO, IS IT FIRST NON-ZERO
	SKP		/NO
	ISZ ZSWT	/YES ALTER DISPPATCH
NLZ,	TAD (60		/ADD CONSTANT TO MAKE ASCII
	JMS I DEVOUT	/PUT OUT DIGIT
LZ,	TAD DIV1	/REDUCE DIVISOR
	MQLDVI
DIV2,	0
	CLAMQA
	DCA DIV1
	ISZ ZCOUNT	/ENOUGH DIGITS?
	JMP ZAGAIN	/NO
	TAD PTSAVE	/YES , PUT OUT UNITS DIGIT
	TAD (60		/ZERO ALWAYS PRINTS OUT HERE
	JMS I DEVOUT	/PUT IT OUT
	JMP I ZEROD	/RETURN
PTSAVE,	0
LEADZ,	-1
ZCOUNT,	0
DEVOUT,	0
ZPNT,	LZ
	NLZ

SORTB,	0		/SORT AND BRANCH ROUTINE
	DCA SCHAR	/SAVE SORT CHAR
	STA
	TAD I SORTB	/GET POINTER TO LIST
	ISZ SORTB
	DCA 16
SORTA1,	TAD I 16	/GET ITEM IN TEST LIST
	SPA		/END MARKED BY NEG VALUE
	JMP SORTA2	/FELL OUT BOTTOM
	CIA
	TAD SCHAR
	SZA CLA		/COMPARE SORT CHAR
	JMP SORTA1	/NOT IT.
	TAD 16		/GOT IT. NOW MAKE INDEX
	TAD I SORTB	/TO JUMP TABLE
	DCA SORTC	/THIS IS TABLE POINTER
	TAD I SORTC	/GET JUMP ADDRESS FROM TABLE
	DCA SORTC	/AND GO THERE
	CLA CLL
	JMP I SORTC

SORTA2,	CLA CLL		/FELL OUT BOTTOM
	ISZ SORTB	/SO CHARACTER NOT IN LIST
	TAD SCHAR	/CARRY IT BACK TO
	JMP I SORTB	/DO SOMETHING ELSE

SORTC,	0

	PAGE
/COMMANDS ^V,P,T,V, AND W
NLINES,	0		/CONVERT
	TAD P		/- OR + N LINES AROUND .
	DCA M		/TO CHARS M,N
	STA
	DCA NFLG	/SET NUMBER FLAG
	PUSHJ
		CHRL
	TAD P
	DCA N
	TAD M
	DCA P
	JMP I NLINES	/RETURN
CHRP,	TAD N		/COMMAND P
	NCHK		/HOW MANY PAGES?
	IAC		/P MEANS 1P
	CIA
	DCA NLINES
CPOA,	PUSHJ
		CHRW	/DO N&lt;WY&gt;
	PUSHJ
		CHRY
	ISZ NLINES
	JMP CPOA
	POPJ
CPOC,	PUSHJ
		CHRH
	PUSHJ
		CTLV+2	/CLEAR COMMA &amp; NUMBER FLAGS
	TAD OUTLST	/PUT OUT A FORM FEED
	JMP CWOUT	/AND POP FROM W ROUTINE

CHRT,	TAD (TYPE-OUTPUT	/COMMAND T
CHRW,	TAD (OUTPUT	/COMMAND W
	DCA CWOUT
	NCHK		/ANY ARGS?
	JMP CPOC	/NO, DO WHOLE BUFFER
	CCHK
	JMP .+4		/+N OR -N LINES AROUND .
	PUSHJ
		LINES	/COMVERT LINES TO CHARS
	SKP
	JMS NLINES
CWOA,	DCA NFLG	/CLEAR NUMBER FLAG
	PUSHJ
		MFROMN	/COMPUTE N-M
CSNCL,	SNA CLA		/LOCATION USED AS CONSTANT
	POPJ		/NOTHING TO PUT OUT
	TAD M		/STARTING CHAR
	DCA Q
CWOB,	CDF 10
	TAD I Q
	CDF
	AND MASK
CWOUT,	0		/TYPE, OUTPUT, CTVTYP, OR QPUT
	ISZ Q
	TAD Q
	CMA CLL
	TAD N
	SZL CLA		/DONE?
	JMP CWOB	/NO
	POPJ
CHRV,	TAD (TYPE-CTVTYP	/COMMAND V
CTLV,	TAD (CTVTYP	/COMMAND ^V
	DCA CWOUT
	CCHK
	SKP
	JMP CWOA	/TYPE CHARS M+1 THRU N
	TAD N
	NCHK
	STA		/V MEANS -1V
	TAD P
	BZCHK		/SEE IF B&lt;#&lt;ZZ
	DCA N
	TAD P
	DCA M
	JMP CWOA	/DO .,.+NV

/SEARCH STRING MODIFIERS ^N,^Q,^S, AND ^X
SCHTAB,	SCHINV		/^N: ANYTHING BUT
	SCHLIT		/^Q: LITERALLY
	SCHSEP		/^S: ANY SEPARATOR
SCHSWT,	CSWT		/^X: ANYTHING
	CSK		/ALTM OR QUOTE
	CSK		/$ OR QUOTE
SCHLIT,	SCAN		/^Q, GET NEXT CHARACTER
	SORT		/EXCEPT ALTM OR QUOTE
		QUOTE
		SCHERR-QUOTE	/^Q$ IS UNNECESSARY AND SOME
	JMP CSQ		/ROUTINES CAN&#039;T RECOGNIZE IT
SCHINV,	TAD CSNCL	/^N, INVERT SKIP SENSE
	DCA I SCHSWT	/IN MATCHING CHAIN
	JMP CSL
SCHSEP,	CDF 10		/^S, LOOK FOR SEPARATOR
	TAD I P
	CDF
	AND MASK
	JMS SCHSRT	/SHARED SORTING ROUTINE
	JMP I SCHSWT	/TEST AC FOR 0 OR NOT-0
SCHSRT,	0		/SORT LETTERS AND NUMBERS
	TAD (-173	/TEST FOR LOWER CASE, TOO
	SMA		/BRACES AND VERT BAR
	JMP SCHS	/SUCCESS
	TAD (32		/LOWER CASE LETTERS
	SMA
	JMP SCHF	/AREN&#039;T SEPARATORS
	TAD (7		/BRACKETS, CARET, UNDERSCORE, ETC
	SMA SZA
	JMP SCHS	/ARE SEPARATORS
	TAD (32		/UPPER CASE LETTERS
	SMA SZA
	JMP SCHF	/AREN&#039;T
	TAD (7)		/:,;,&lt;,=,&gt;,?,@
	SMA SZA
	JMP SCHS	/ARE
	TAD (12		/1,2,3,4,5,6,7,8,9,0 AREN&#039;T
	CIA
SCHS,	SPA CLA		/EVERYTHING ELSE IS SEPARATOR
SCHF,	STA		/LETTERS AND NUMBERS COME HERE
	JMP I SCHSRT	/TEST AC FOR 0 OR NOT-0
	PAGE
/COMMANDS A,I, AND Y
CHRA,	NCHK		/COMMAND A
	SKP		/APPEND TO BUFFER
	JMP CHNA	/(N)A:ASCII VALUE OF CHAR AT (N)
	TAD P
	DCA CAPP	/SAVE CURRENT P
	TAD ZZ		/APPEND AT END OF BUFFER
	DCA P
	JMP CALP-3
CHRY,	TAD N		/COMMAND Y
	NCHK
	IAC		/ASSUME 1
	CIA
	DCA CISP
COYA,	PUSHJ
		CKALL	/KILL BUFFER
	DCA CAPP	/SAVE B AS P
	PUSHJ
		CALP-3
	ISZ CISP	/DONE?
	JMP COYA	/NO
	POPJ
	TAD ZZ
	CIA
	DCA CYMZ	/SAVE -CURRENT END
CALP,	INPUT		/CALL INPUT ROUTINE
	SORT
		APPLST
		APPTAB-APPLST
CANP,	JMS UPOC	/PUT IT AWAY
	JMP CALP
CAPP,	0		/TEMP P
CYMZ,	0		/-CURRENT END OF TEXT BUFF

APSP,	TAD YFLG	/APPENDING A SPACE
	SZA CLA		/EXPAND MODE?
	JMP APHT	/YES, TAKE IT
	DCA SPCNT	/ZERO SPACE COUNTER
	ISZ SPCNT
	INPUT
	TAD (-40
	SNA		/ANOTHER SPACE?
	JMP .-4		/YES
	STA		/NO, COMPUTE TABS
	TAD SPCNT
	SNA		/MORE THAN ONE SPACE
	JMP APSP2	/NO, TAKE IN SPACE
	MQLDVI
INHTC,	10		/TAB INCREMENT
	CLAMQA
	CMA		/-(#TABS+1)
	DCA SPCNT
	TAD CAHT	/TAB
	JMS UPOC
	ISZ SPCNT
	JMP .-3
APSP1,	TAD ICHAR
	JMP CALP+1
APSP2,	TAD CASP
	JMS UPOC	/APPEND THE SPACE
	JMP APSP1	/AND CHAR FOLLOWING
SPCNT,	0

APHT,	TAD ICHAR	/INPUT CHAR
	JMP CANP
APLF,	TAD ICHAR	/LINE FEED - SAVE IT FIRST
	JMS UPOC
	CLA CLL
	TAD (-APMAX	/SEE IF BUFFER NEARLY FULL
	TAD ZZ
	SNL CLA
	JMP CALP	/SPACE STILL AVAILABLE
CAFF,	TAD CYMZ	/COMPARE PREVIOUS END
	TAD ZZ		/WITH PRESENT
	SNA CLA		/DIFFERENT?
	JMP CALP	/NO, SO NOTHING CAME IN
	TAD CAPP	/YES, RESTORE POINTER
	DCA P
	POPJ		/EXIT

CHRI,	NCHK		/I COMMAND
	JMP CIL1
	TAD N		/INSERT CHAR WHOSE VALUE IS N
	AND MASK
	JMS UPOC
	POPJ
CTLI,	CLA CLL CMA	/FOR TAB INSERT
	SKP		/CANNOT BE QUOTED
CIL1,	QCHK		/SEE IF QUOTED STRING
	TAD SCANP
	DCA CISP	/SAVE SCAN POINTER
	QSKP		/COUNT LENGTH OF INSERTION
	TAD CISP
	CMA
	TAD SCANP
	SNA		/ANYTHING TO INSERT?
	JMP I QUOTAB	/NO, RESTORE ALTM AS TERMINATOR
	PUSHJ		/YES, OPEN A HOLE
		UPPN
	TAD CISP	/RESET TO BEGINNING OF INSERTION
	DCA SCANP
CIL2,	SCAN		/STICK CHARS INTO BUFFER
	SORT
		QUOTE
		QUOTAB-QUOTE
	DCA CSAVE
	CDF 10
	TAD I P
	AND [7400
	TAD CSAVE
	DCA I P
	CDF
	ISZ P		/POINTER WINDS UP AT END
	JMP CIL2	/OF INSERTION
CISP,	0
QUOTAB,	IREST
	IREST
	PAGE
	/COMMANDS &lt;,&gt;,; AND PART OF COMMAND DISPATCH TABLE
CHLT,	TAD [-3		/COMMAND &lt;
	PUSHL
		ITRST
		ITRFIN
		ITRCNT
	TAD N
	NCHK		/CHECK FOR ARG
	CLA
	CIA		/MAKE NEGATIVE
	DCA ITRCNT	/SET UP TERMINATION
	TAD SCANP	/SAVE CURRENT SCAN PNTR
	DCA ITRST	/ALWAYS .GE. 1 IN ITERATION
	POPJ
CHGT,	TAD SCANP	/COMMAND &gt;
	DCA ITRFIN	/SET UP QUICK EXIT
	ISZ ITRCNT	/LOOK FOR COUNT EXHAUSTED
	JMP CGTC	/NO, CONTINUE
CGSG,	SZA		/SCAN POINTER?
	DCA SCANP	/YES, CATCH UP
	TAD [-3
	POPL
		ITRCNT
		ITRFIN
		ITRST
	POPJ
CGTC,	TAD ITRST
	SNA
	ERR		/IF NOT IN ITERATION
	DCA SCANP	/RESET TO BEGINNING OF ITERATION
	POPJ

CSEM,	TAD ITRST	/COMMAND ;
	SNA CLA
	ERR		/IF NOT IN ITERATION
	TAD N
	NCHK
	JMP CSMF
	SPA CLA
	POPJ
	JMP .+3
CSMF,	ISZ SFAIL	/CHECK FOR TERMINATION
	POPJ		/NO
	TAD ITRFIN	/LOOK FOR QUICK EXIT
	SZA
	JMP CGSG	/YES, DUCK OUT
	SKPSET		/NO, PLOD THROUGH
		76	/LOOKING FOR &gt;
		CGSG	/GO THERE WHEN FOUND
	ERR		/OOPS! RAN OFF END
	SCAN		/SKIP ^U COMMAND
	SKP CLA		/GET RID OF Q-REG #
	QSKP		/SKIP AN R COMMAND
CSMQ,	QSKP		/SKIP OVER QUOTED STRING
	PUSHJ
		IREST	/FIX UP QUOTE CHAR
	JMP I .+1	/OK, PLOD FORWARD SOME MORE
	CSMK		/STRING SKIP ROUTINE
ITRFIN,	0		/QUICK EXIT LOCATION
ITRCNT,	0		/ITERATION COUNTER

/COMMAND DISPATCH TABLE - OVERLAPS ONTO PAGE 13
CDSP,	POPK;CTLA;CTLB;CTLC;CTLD;SERR;CTLF;CTLG	/0-7
	POPK;CTLI;ECHO;CTLK;ECHO;ECHO;SERR;SERR	/10-17
	SERR;SERR;SERR;SERR;CTLT;CTLU;CTLV;SERR	/20-27
	SERR;SERR;SERR;CALT;SERR;CTBR;CTUA;SERR	/30-37
	ECHO;CEXP;CDBQ;CNBS;CALT;CPCS;CAMP;CSGQ	/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;CHRV;CHRW	/120-127
	CHRX;CHRY;CHRZ;SERR;CBSL;SERR;CHUA;CHBA	/130-137
	/END OF DISPATCH TABLE
	/COMMAND ^U
CTLU,	QREF		/COMMAND ^U
	DCA CCUQ	/SAVE Q-REG POINTER
	QCHK		/SEE IF QUOTED
	TAD SCANP
	DCA CCUS	/SAVE SCAN POINTER
	QSKP		/COUNT UP STRING
	TAD CCUS
	CMA
	TAD SCANP	/LENGTH OF STRING
	SNA
	JMP CCUC	/NO STRING
	DCA CCUN
	TAD I CCUQ	/# OF CHAR ALREADY THERE
	CLL CIA
	TAD CCUN	/DIFFERENCE
	PUSHJ		/ADJUST TO HOLD
		QADJ	/NEW STRING
CCUA,	TAD CCUN	/LENGTH OF NEW STRING
	DCA I CCUQ
	QSUM
	DCA QR
	TAD CCUS	/RESET SCAN POINTER
	DCA SCANP
CCUB,	SCAN
	SORT
		QUOTE
		QUOTAB-QUOTE
	QPUT
		QR
	ISZ QR
	JMP CCUB
CCUC,	TAD I CCUQ	/DELETE C(Q-REG)
	CLL CIA
	PUSHJ
		QADJ
	DCA I CCUQ	/SET LENGTH TO 0
	JMP IREST	/RESTORE STRING TERM &amp; POP
CCUN,	0		/LENGTH OF STRING
CCUQ,	0		/POINTER TO Q-REG
	CCUS=.		/TEMP SCANP
TYPCTL,	0		/ADD ^ TO CTRL CHARS
	TAD CHAR
	SORT
		CACR
		CTLTAB-CACR
	TAD (-40	/SEPARATE CTRL CHARS
	SPA		/IS IT CTRL CHAR?
	JMP .+4		/YES
TYCTL1,	TAD CASP
	TYPE
	JMP I TYPCTL
	TAD (100	/CONVERT TO UPPER CASE
	DCA CCUN	/SAVE IT
	TAD (136	/TYPE THE &#039;^&#039;
	TYPE
	TAD CCUN
	JMP TYCTL1	/NOW ADD BACK IN 40
CTLCR,	CRLF
	JMP I TYPCTL
CTLALT,	TAD CAAM	/44=33+11
CTLHT,	TAD CAHT	/11
	JMP TYCTL1+1
ERRXX,	0
	DCA CCUS	/SAVE C(AC)
	CRLF
	CTLTYP
	TAD (72		/&#039;:&#039; SEPARATOR
	TYPE
	STA
	TAD ERRXX	/GET TRAP ADDRESS
	JMS OPRNT	/TYPE IN OCTAL
	TAD (57		/&#039;/&#039; SEPARATOR
	TYPE
	TAD CCUS	/GET C(AC)
	JMS OPRNT	/TYPE IN OCTAL
RECOUP,	TAD (77		/? ERROR FLAG
	TYPE
	LISTEN		/SEE WHAT HE WANTS TO DO
	SORT
		RECLST
		RECTAB-RECLST
	CLA		/DEFAULT: NOTHING
	JMP T1		/RESTART COMMAND LINE

CHNA,	TAD N		/ASCII VALUE OF CHAR AT N
	BZCHK		/MAKE SURE IN BUFFER
	DCA R
	CDF 10
	TAD I R
	CDF
	AND MASK
	JMP NCOM	/MAKE IT A NUMBER
	PAGE
/COMMANDS ^A,^B,HT,LF,FF,CR,^T,SPACE,!,E, AND ^
CTLA,	TAD (TYPE-OUTPUT	/COMMAND ^A
CTLB,	TAD (OUTPUT	/COMMAND ^B
	DCA CTLB2
	QCHK		/SEE IF QUOTED
CTLB1,	SCAN		/GET A CHARACTER
	SORT
		QUOTE	/SEE IF END
		QUOTAB-QUOTE
CTLB2,	JMP .		/TYPE OR OUTPUT
	JMP CTLB1	/GET ANOTHER
ECHO,	TAD KFLG	/COMMANDS CR,LF,HT,FF, &amp; SPACE
	SNA CLA		/TURNED ON?
	POPJ		/NO
	TAD TFLG	/TRACE MODE ON?
	SZA CLA
	POPJ		/YES, DON&#039;T REPEAT
	TAD CHAR	/GET THE COMMAND
	TYPE		/NOTE: THIS ISN&#039;T CTLTYP
	POPJ
CHUA,	POP		/COMMAND ^
	CLA		/MAKE NEXT LETTER A CTRL CHAR
	PUSHJ
		CHUA1	/CONVERSION ROUTINE
	JMP T6A		/GO BACK TO COMM EXEC
CHUA1,	SCAN
	TAD (-100	/LOWER CASE BARELY ACCEPTABLE
	SPA
	ERR		/WASN&#039;T LETTER AT ALL
	AND (37		/MASK IT
	POPJ
CHRE,	SCAN		/COMMAND E
	AND (137	/MASK OUT LC BIT
	SORT
		ENBLST
		ENBTAB-ENBLST
	ERR		/NO SUCH COMMAND

OUTTAB,	OUTFF		/DISPATCH TABLE FOR XFIX
	OUTLF
	OUTCR
	OUTHT
	SORTA2		/ALTM--NO CHANGE
CTLTAB,	CTLCR		/DISPATCH TABLE FOR CTLTYP
	CTLHT
	CTLALT
QPUTS,	0		/Q-REGISTER STUFFER
	QPUT
		QP
	ISZ QP
	JMP I QPUTS
TYO,	0		/TELETYPE STUFFER
	JMS XFIX	/TWIDDLE SOME CTRL CHARS
		TPUT	/ACTUAL OUTPUT ROUTINE
		0	/CHAR COUNT ON LINE
		-10	/LINE COUNT, 54[10] IN 9 INCHES
	JMP I TYO
MFROMN, TAD N		/COMPUTE N-M
	BZCHK		/SEE IF N OK
	CLA CLL		/OK
	TAD M
	BZCHK		/SEE IF M OK
	CIA CLL
	TAD N
	SZL		/IS M&gt;N?
	POPJ		/NO, SO CARRY BACK DIFF
	CLA		/YES, INTERCHANGE
	TAD N		/AND RECOMPUTE
	DCA QPUTS
	TAD M
	DCA N
	TAD QPUTS
	DCA M
	JMP MFROMN+3

CEXP,	QCHK		/COMMAND !
	QSKP		/PASS OVER HERE
	POPJ		/RESUME EXECUTION
CTLT,	JMS TTYIN	/COMMAND ^T
	CTVTYP		/ECHO CHAR TYPED IN
	TAD ICHAR	/GET IT BACK
	JMP NCOM	/MAKE IT A NUMBER
CHKQF,	0		/CHECK FOR EXPLICIT QUOTES
	TAD QFLG
	SNA CLA
	JMP I CHKQF	/FLAG NOT SET
	SCAN		/GET QUOTING CHAR
	DCA QUOTE	/PUT INTO SEARCH TABLE
	TAD QUOTE
	DCA QUOTE+1	/ALSO FIX OUT DOLLAR SIGN
	JMP I CHKQF
TTYIN,	0		/TO APPEND FROM TTY READER
	LISTEN
	DCA ICHAR	/DEPOSIT AS INPUT CHAR
	TAD ICHAR
	JMP I TTYIN
COMTAB, TBEL		/DISPATCH TABLE FOR COMMAND EDIT
	TCRLF
	ROCMND
	TLOWER
	TUPPER
	TCTLC
	TALTM
	TALTM
	TALTM
	TQMK
	PAGE
	/COMMANDS ^F,^^

CTLF,	CLA OSR		/COMMAND ^F
	JMP I IREST-2	/VALUE OF SWITCH REG.
CTUA,	SCAN		/COMMAND ^^
	JMP I IREST-2	/VALUE OF FOLL. CHAR
	/E COMMAND MODIFIERS
ENBLST,	130		/X: EXIT
	103		/C: CLOSE FILE
	111		/I: SET INPUT MODE
	117		/O: SET OUTPUT MODE
	124		/T: WRITE GROUP MARK
	106		/F: WRITE FILE MARK
	115		/M: SET ECHO MODE
	113		/K: KILL ECHO MODE
ESKLST, 122		/R: OPEN INPUT FILE
	127		/W: OPEN OUTPUT FILE
	102		/B: EDIT BACKUP
	7777		/FOR EXPANSION
	7777
	7777
CATS,	STA		/COMMAND @
	DCA QFLG	/NEXT STRING WILL BE QUOTED
	POPJ
	/SEARCH STRING MODIFIERS:
SCHLST, 16		/^N: ANYTHING BUT
	21		/^Q: LITERALLY
	23		/^S: ANY SEPARATOR
	30		/^X: ANYTHING
QUOTE,	33		/ALTM OR QUOTE CHAR
	44		/$ OR QUOTE CHAR
CCLN,	STA		/COMMAND :
	DCA CLNF	/NEXT SEARCH WILL HAVE
	POPJ		/NUMERIC VALUE

	102		/B: BRIEF
	130		/X: EXPANDED
EIN,	CLA CLL CMA RAL	/TERMINATES LIST
EOUT,	TAD (DCA XFLG	/COMPUTE INSTRUCTION
	DCA EIO
	PUSHJ
		CHUA1	/CLEAR CASE AND ALPHA BITS
	TAD (100	/RESTORE ALPHA
	SORT
	EIN-2		/B OR X
	.+2-EIN+2	/ABOUT 14[8]
	ERR		/INCOMPLETE COMMAND
	.+3
	.+1
	STA
EIO,	JMP .		/DCA XFLG OR DCA YFLG
	POPJ

CHKCLN,	ISZ CLNF	/SEARCH MODIFIED BY :?
	JMP IREST	/NO, JUST RESTORE ALTM &amp; $
	ISZ SFAIL	/YES, CHECK FAIL FLAG
	STA		/AND ASSIGN VALUE
	PUSHJ		/CALL NUMBER PROCESSOR
		NCOM
	DCA SFAIL	/CLEAR FAIL FLAG
IREST,	TAD CAAM	/ALT MODE
	DCA QUOTE
	TAD CDOL	/$
	DCA QUOTE+1
	DCA QFLG	/CLEAR FLAG
	POPJ
	/Q-REGISTER POINTERS:
	0;0	/Q-REG 0
	0;0	/Q-REG 1
	0;0
	0;0
	0;0
	0;0
	0;0
	0;0
	0;0
	0;0	/Q-REG 9
QPNTR,	0		/# OF CHARS IN COMM LINE
CDOL,	44		/OTHERWISE UNUSED

	/DISPATCH TABLE FOR SKIPPING OVER COMMANDS:
SKPTAB,	0	/TRAP ROUTINE
	CSMQ	/!
	CSMO	/&gt;
	CSMI	/&lt;
	CSMD	/&quot;
	CSMC	/^
	CSMA	/@
	CSMQ	/^A
	CSMQ	/^B
	CSMQ	/TAB
	CSMQ-3	/^U
	CSMD	/^^
	CSME	/E
ESKTAB,	CSMQ	/I
	CSMQ	/N
	CSMQ	/O
	CSMQ-1	/R
	CSMQ	/_
	CSMZ	/ALTM
	CSMZ	/$
	PAGE
/UTILITIES
RECSTK,	TAD PDLP	/PRINT OUT STACK REMNANTS
	CIA
	IAC
	DCA COMPAR
	TAD (PDLBEG-1
	DCA 17
RECST1,	CRLF
	TAD 17
	TAD COMPAR
	SNA CLA
	JMP RECCML+2
	TAD I 17
	JMS OPRNT
	JMP RECST1
RECCML,	PUSHJ		/PRINT OUT COMMAND LINE
		TQMF
	CRLF
	JMP RECOUP
RECTAB,	CTLC		/DISPATCH TABLE FOR RECOUP
	RECSTK
	RECSTK
	RECSTK
	RECCML
COMPAR,	0		/LOOK FOR DOUBLED COMM LINE CHARS
	TAD SCHAR	/MOST RECENT
	CIA
	TAD CHAR	/PREVIOUS
	SZA CLA
	RESORT		/NOT THE SAME
	CTLTYP		/TYPE THE CHARACTER
	JMP I COMPAR	/SAME-SPECIAL HANDLING
TCTLC,	JMS COMPAR	/^C IN COMMAND LINE
	JMP CTLC	/2ND ^C CALLS MONITOR
TBEL,	JMS COMPAR	/^G IN COMMAND LINE
	JMP T1		/2ND ^G KILLS COMMAND LINE

CHKBZ,	0		/SEE THAT B .LE. C(AC) .LE. ZZ
	DCA CHKCF	/SAVE
	TAD CHKCF	/PICK UP C(AC)
	CIA CLL
	TAD ZZ
	SNL CLA		/13-BIT ARITHMETIC
	ERR		/C(AC)&gt;ZZ
	TAD CHKCF	/O.K.
	JMP I CHKBZ
CHKCF,	0		/SEE IF COMMA FLAG SET
	ISZ CFLG
	SKP CLA		/C(AC):=0 IF FLAG NOT SET
	ISZ CHKCF	/RETURN TO CALL+2 IF SET
	JMP I CHKCF	/OR CALL+1 IF NOT
APFS,	DCA REND	/MARK END-OF-FILE
	TAD ERR-4400	/GET ERRXX POINTER
	DCA INR		/FURTHER INPUT IS ERROR
	JMP CAFF+4	/GO MAKE N &amp; _ FAIL
APGS=	CAFF
ENBTAB,	EXIT		/X-DISPATCH TABLE FOR E COMMANDS
	EXITC		/C
	EIN		/I
	EOUT		/O
	ENDGRP		/T
	ENDFIL		/F
	EKON		/M
	EKOFF		/K
	ROPEN		/R
	WOPEN		/W
	EBAK		/B
	0		/FOR EXPANSION
	0
	0

TLOWER,	JMS COMPAR	/^L IN COMMAND LINE
	TAD (40		/2ND ^L SETS LOWER CASE
	SKP
TUPPER,	JMS COMPAR	/^U IN COMMAND LINE
	DCA TCASE	/2ND ^U SETS UPPER CASE
	JMP ROCMND	/EXECUTE RUBOUT
DEVTAB,	PERD		/DISPATCH TABLE FOR NAME PROCESSOR
	COLON
	NAMEC		/IGNORE SPACES
SYMTAB,	CNDP		/SYMBOLS FOR
	CNDP		/CONDITIONAL
	CNDP		/JUMP COMMAND
	PAGE
/COMMANDS ^C,^G, AND ^]
CTBR,	TAD N		/COMMAND ^]
	NCHK		/SET TABS TO N OR 8
	TAD (10		/RESTORE TO 8
	DCA CHKNF	/SAVE
	TAD CHKNF
	DCA OUTHTC	/CONSTANT IN XFIX
	TAD CHKNF
	DCA OUTHTD	/CONSTANT IN XFIX
	TAD CHKNF
	DCA INHTC	/CONSTANT IN APPEND
	POPJ
EKON,	STA		/COMMAND EM
EKOFF,	DCA KFLG	/COMMAND EK
	POPJ
TYPCTV,	0		/FAKE OUT SUBROUTINE TYPCTL
	CIA		/BY SUBTRACTING C(CHAR)
	TAD CHAR	/FROM AD
	CIA
	CTLTYP		/CALL TYPCTL
	JMP I TYPCTV	/PRESERVE C(CHAR)
CHKNF,	0		/CHECK AND RESET NUMBER FLAG
	ISZ NFLG
	SKP CLA		/AC:=0 IF NO NUMBER
	ISZ CHKNF	/SKP RETURN IF NUMBER
	JMP I CHKNF
CTLG=	.
CTLC,	7600		/COMMAND ^C, OPERATE 2 CLA
	TSF		/WAIT FOR FLAG
	JMP .-1		/THIS IS THE EVER-LOVIN&#039; END!
	JMP I CTLC	/GO TO MONITOR
SPUT,	0		/PUT CHAR INTO COMM LINE
	CLA CLL IAC
	TAD QZ		/TOTAL Q-REG CHARS
	DCA R
	TAD R
	TAD (-QMAX	/LIMIT OF Q-REGS
	SZL CLA		/TWO PLACES TO TRIP LINK
	ERR		/TOO MUCH STUFF!
	TAD QZ		/STICK ONTO END
	DCA QP		/Q-REG POINTER
	TAD CHAR	/LATEST COMM LINE CHAR
	QPUT
		QP
	ISZ QZ		/INCREMENT Q-REG COUNT
	ISZ SCANP	/POINT TO NEXT
	ISZ I QREGS	/INCREMENT CHAR COUNT
	JMP I SPUT
DRAD,	1750		/CONSTANTS FOR DECIMAL RADIX
	12
SCHERR,	NOP		/^Q[ALTM] IN SEARCH STRING
	ERR		/^Q$ IN SEARCH STRING

PDLBEG,	ZBLOCK 40	/BEGINNING OF PUSH-DOWN LIST
PDLEND=PDLBEG+37	/END OF PUSH-DOWN LIST
	PAGE
/TELETYPE ROUTINES

TPUT,	0
	JMP .+5		/DON&#039;T WAIT FIRST TIME
	JMS BRKCHK	/BREAK?
	TSF		/TELEPRINTER READY?
	JMP .-2		/NO, WAIT
	TAD TYI		/GET THE CHAR BACK
	TAD (200
	TLS
	CLA CLL
	TAD (DCA TYI
	DCA TPUT+1
	JMP I TPUT

TYI,	0		/KEYBOARD INPUT
	KSF
	JMP .-1
	KRB
	AND MASK
	JMP I TYI

XFIX,	0		/OUTPUT MANIPULATIONS
	DCA TYP
	TAD I XFIX
	DCA OUTP
	ISZ XFIX
	TAD TYP
	SORT
		OUTLST
		OUTTAB-OUTLST
	ISZ I XFIX	/INCREMENT CHAR COUNT
	NOP		/IT MIGHT SKIP
XFIX1,	ISZ XFIX
	ISZ XFIX
	JMS I OUTP	/PUT AWAY CHAR
	JMP I XFIX
OUTP,	0
LFCT,	0
NULLS,	0
TYP,	0
OUTCR,	DCA I XFIX	/RESET CHAR COUNT
	TAD TYP		/CR
	JMP XFIX1
OUTLF,	ISZ XFIX	/LINE FEED
	ISZ I XFIX	/INCREASE LINE COUNT
	JMP OUTLF1	/NOT END OF PAGE
	TAD (-66	/RESET LINE COUN
	DCA I XFIX	/FOR NEXT PAGE
	JMP OUTLF1	/TYPE LINE FEED
OUTFF,	ISZ XFIX	/FORM FEED
	TAD I XFIX	/HOW MANY LINES LEFT?
	TAD (-14	/2 INCHES FOR MARGINS
	DCA LFCT	/# OF LINES TO FEED
	TAD (-66	/RESET LINE COUNT
	DCA I XFIX	/FOR NEXT PAGE
	TAD XFLG	/EXPAND MODE?
	SNA CLA
	JMP FORM1	/NO
	TAD CALF	/YES, DO LINE FEEDS
	JMP FORM3
OUTLF1,	TAD TYP		/LF
	JMP XFIX1+1

OUTHT,	TAD I XFIX	/CHAR COUNT
	TAD OUTHTC	/ADD 1 TAB INCR
	MQLDVI
OUTHTC,	10
	CIA		/SUBTRACT FROM
	TAD OUTHTC	/WHOLE TAB
	CIA		/MAKE NEGATIVE
	DCA LFCT
	CLAMQA
	MQLMUY		/ADJUST CHAR COUNT
OUTHTD,	10
	CLAMQA
	DCA I XFIX	/NEW CHAR COUNT
	ISZ XFIX
	TAD XFLG
	SNA CLA
	JMP TABU1	/COMPRESSED MODE
	TAD CASP	/EXPAND MODE, SPACES
	JMP FORM3
FORM1,	TAD OUTLST	/FORM FEED
	DCA TYP		/ADJUST CHAR
	SKP		/FF GOES TWICE AS FAST AS
TABU1,	TAD LFCT	/TABULATION
	TAD LFCT	/X+X=2*X!
	CIA		/MAKE POSITIVE TO DIVIDE
	MQLDVI
	6		/1 IDLE PER 3 SPACES OR 6 LINES
	CLAMQA
	CIA		/MAKE NEGATIVE AGAIN
	SNA		/ANY IDLES?
	STA		/AT LEAST ONE
FORM2,	DCA LFCT	/# OF IDLES
	TAD TYP		/PUT OUT ORIGINAL CHAR
	JMS I OUTP
	TAD CASP+1	/IDLE
FORM3,	DCA NULLS	/IDLES, SPACES &amp; LINE FEEDS
	TAD NULLS
	JMS I OUTP	/PUT ONE OUT THE
	ISZ LFCT	/WINDOW
	JMP FORM3+1	/STILL MORE INSIDE
	ISZ XFIX	/DONE WITH THEM
	JMP I XFIX	/RETURN

	PAGE
/Q-REGISTER MANIPULATIONS
/COMMANDS G,M,$, AND ALTM
CHRM,	QREF		/COMMAND M
	CLA CLL		/THROW AWAY POINTER
	TAD [-4		/4 ITEMS PUSHED TO
	PUSHL		/SAVE CURRENT MACRO STATE
		QCMND
		SCANP
		CMON
		MPDL
	TAD PDLP	/MUST CHECK PDL AT END OF MACRO
	CIA
	DCA MPDL
	TAD N
	NCHK
	IAC		/ASSUME 1
	CIA
	DCA CMON	/NUMBER OF TIMES TO EXECUTE
	TAD QNMBR	/Q-REGISTER TO EXECUTE
	DCA QCMND
CMOR,	DCA SCANP	/RESET TO BEGINNING OF REGISTER
	POPJ
CMON,	0		/NUMBER OF TIMES TO EXECUTE
CALT,	TAD QCMND	/COMMANDS $ AND ALTM
	SNA CLA		/IN MACRO?
	JMP I [T1		/NO, END OF COMMAND LINE
	TAD PDLP	/PDL IS CRUCIAL HERE
	TAD MPDL	/SEE IF SAME AS STARTED
	SZA
	ERR		/PDL FOULED UP
	ISZ CMON	/SEE IF ANOTHER ROUND WANTED
	JMP CMOR	/YES
	TAD [-4		/4 ITEMS POPPED TO
	POPL		/RESTORE PREVIOUS MACRO STATE
		MPDL
		CMON
		SCANP
		QCMND
	POPJ

CHRG,	QREF		/COMMAND G
	DCA CGOQ
	CCHK		/SEE IF M,NG
	JMP CGOB	/NO
	PUSHJ
		CHRD+2	/DELETE M,N
CGOA,	TAD I CGOQ	/NUMBER OF CHARS IN Q-REG
	PUSHJ
		UPPN	/MOVE TEXT BUFFER UP
	QSUM		/COMPUTE Q-REG POSITION
	CLA
	TAD I CGOQ
	CMA
	DCA CGOQ	/-# OF CHARS
	JMP QDNND
QLOOP,	QGET
		QP
	DCA CSAVE
	CDF 10
	TAD I P
	AND [7400
	TAD CSAVE
	DCA I P
	CDF
	ISZ QP
	ISZ P
QDNND,	ISZ CGOQ
	JMP QLOOP	/KEEP GOING TILL DONE
POPK,	POPJ		/END OF INSERTION
CGOB,	TAD N		/POINTER POSITION TO INSERT
	NCHK		/CONTENTS OF Q-REG
	TAD P		/NOT GIVEN, ASSUME P
	DCA P
	JMP CGOA
CGOP,	0		/TEXT BUFFER POINTER
CGOQ,	0		/POINTER TO Q-REGISTER

QADJ,	SNL		/ADJUST Q-REGS
	JMP QDNN-1	/TO HOLD NEW STRING
	SNA		/CHECK FOR ZERO
	POPJ		/NOTHING TO DO
QUPN,	CLL		/MOVE Q-REGS UP TO
	TAD QZ		/INSERT CHARS
	DCA R
	TAD R
	TAD [-QMAX	/SEE IF OUT OF BOUNDS
	SZL CLA		/TWO PLACES TO TOGGLE LINK THERE
	ERR		/GETTING TOO FULL
	QSUM		/COMPUTE POINTER TO Q-REG
	CLA CLL		/WE JUST NEED TO SET QP
	TAD QZ
	DCA Q
	TAD R
	DCA QZ
QPNL,	TAD R
	CIA
	TAD QP
	SNA CLA
	POPJ		/FINISHED
	CLA CMA
	TAD Q
	DCA Q
	CLA CMA
	TAD R
	DCA R
	QGET
		Q
	QPUT
		R
	JMP QPNL

	CIA		/REACHED FROM QADJ
QDNN,	DCA Q		/MOVE Q-REGS DOWN TO
	QSUM		/ABSORB CHARS
	TAD Q
	DCA Q		/TOP OF DELETION
	TAD QP
	DCA R		/BOTTOM OF DELETION
QDNN1,	TAD QZ
	CIA
	TAD Q		/-NUMBER OF CHARS TO MOVE
	SNA CLA		/DONE?
	JMP QDNNF	/YES
	QGET		/MOVE ANOTHER CHAR
		Q
	QPUT
		R
	ISZ Q
	ISZ R
	JMP QDNN1	/LOOP AGAIN
QDNNF,	TAD R		/SET NEW VALUE
	DCA QZ		/OF HIGHEST CHAR
	POPJ		/EXIT

	PAGE
/COMMANDS %,Q,U, AND X
QSUMR,	0		/COMPUTE POINTER TO Q-REG
	TAD (QPNTR-24	/BASE ADDR OF Q-REG POINTERS
	DCA QSUMP
	TAD QNMBR
	SNA		/IN COMMAND LINE?
	TAD (13		/YES, C.L. IS 11TH Q-REG
	CIA		/COUNT DOWN
	DCA QSUMC
QSUML,	ISZ QSUMC	/REACHED OUR REG?
	SKP		/NO
	JMP QSUMB	/YES, SET POINTER
	TAD I QSUMP	/ADD # OF CHARS IN LOWER REG
	ISZ QSUMP	/SKIP VALUE WORD
	ISZ QSUMP	/POINT TO NEXT Q-REG
	JMP QSUML	/ADD IN ANOTHER
QSUMB,	DCA QP		/Q-REGISTER POINTER
	TAD QP		/CARRY IT BACK
	JMP I QSUMR
QSUMC,	0		/COUNTER FOR Q-REGS
QSUMP,	0		/POINTER TO Q-REG POINTERS
CQOQ,	0		/LOCAL POINTER TO Q-REG
SGET,	0		/SCAN COMMAND LINE OR MACRO
	TAD QNMBR	/SAVE Q-REG PNTR
	DCA CXON
	TAD QCMND	/POINTER TO CMND LINE OR MACRO
	DCA QNMBR	/FOR QSUM
	QSUM		/GET BASE OF C.L. OR MACRO
	TAD SCANP	/ADD IN USED-UP C.L. CHARS
	DCA QP		/TO MAKE Q-REG POINTER
	TAD I QSUMP	/# OF CHARS IN THIS C.L. OR Q-REG
	CIA CLL
	TAD SCANP	/MAKE SURE STILL INSIDE!
	SZL CLA
	JMP CALT	/END OF THAT COMMAND, PRETEND ALTMODE
	TAD CXON	/RESTORE Q-REG PNTR
	DCA QNMBR
	QGET
		QP	/NEXT CHAR OF C.L. OR MACRO
	ISZ SCANP	/INCREMENT !AFTER! FETCH
	JMP I SGET	/RETURN

QREFER,	0		/SET UP POINTERS FOR Q-REG REFERENCE
	SCAN		/GET NUMBER OF Q-REG
	TAD (-72	/CHECK FOR GOODNESS
	SMA
	ERR		/BADNESS
	TAD (72-57	/Q-REGS ARE 0 THRU 9
	SPA SNA
	ERR		/REST OF BADNESS
	DCA QNMBR	/THIS IS (Q-REG#)+1
	STA		/SUBTRACT ONE
	TAD QNMBR
	CLL RAL		/TWO WORDS OF POINTERS PER Q-REG
	TAD (QPNTR-24	/ADD IN BASE OF POINTERS
	JMP I QREFER	/CARRY BACK POINTER TO POINTERS
CHRQ,	QREF		/COMMAND Q
	IAC		/POINT TO SECOND WORD
	DCA CQOQ	/SAVE POINTER
	NCHK		/SEE IF LOADING OR USING
	JMP CQOA	/USING
	TAD N		/LOADING VALUE OF N
	DCA I CQOQ	/PUT IT AWAY
	POPJ		/DONE
CHRU,	QREF		/COMMAND U
	DCA CQOQ	/SAVE POINTER
	NCHK		/SEE WHAT&#039;S HAPPENING
	JMP CXOA+2	/DELETING CONTENTS OF Q-REG
	CCHK		/ONE ARG OR TWO?
	SKP		/ONE: +N OR -N CHRS
	JMP CXOA	/TWO: CHARS M,N
	TAD N
	TAD P
	BZCHK		/SEE IF REASONABLE
	DCA N		/ONE LIMIT
	TAD P		/. IS
	DCA M		/OTHER LIMIT
	JMP CXOA
CPCS,	QREF		/COMMAND %
	IAC		/POINT TO VALUE WORD
	DCA CQOQ	/SAVE POINTER
	ISZ I CQOQ	/INCREMENT VALUE
CQOA,	TAD I CQOQ	/OK EVEN ON SKIP
	JMP NCOM	/MAKE A NUMBER

CHRX,	QREF		/COMMAND X
	DCA CQOQ	/SAVE POINTER
	NCHK		/SEE WHAT THEY WANT
	JMP CXOB	/WHOLE BAG
	CCHK
	JMP CXOA-1	/+N OR -N LINES
	PUSHJ
		LINES	/LINES M,N
	SKP
	JMS NLINES	/FIGURE LINES
CXOA,	PUSHJ
		MFROMN	/COMPUTE N-M
	DCA CXON	/LENGTH OF NEW STRING
	TAD I CQOQ
	CIA CLL
	TAD CXON	/HOW MUCH TO ADJUST Q-REG SIZE
	PUSHJ		/MAKE IT MORE OR LESS
		QADJ
	TAD CXON	/LENGTH OF NEW STRING
	DCA I CQOQ	/TO Q-REG POINTER
	TAD CXON	/LENGTH OF STRING
	SNA CLA		/IS THERE ANYTHING TO DO?
	POPJ		/NO, GO BACK
	QSUM		/ADD UP LOWER Q-REGS
	STA
	DCA CFLG	/SET COMMA FLAG
	TAD (QSTUFF	/CARRY POINTER FOR
	JMP CHRV+2	/TEXT OUTPUT ROUTINE
CXOB,	PUSHJ		/X ALONE MEANS ENTIRE TEXT BUFFER
		CHRH	/DO HU TO GET EVERYTHING
	JMP CHRU+2	/RESET COMMA &amp; NUMBER FLAGS
CXON,	0		/STRING LENGTH
	PAGE
/COMMAND O
CHRO,	DCA NFLG	/AVOID TROUBLE
	QCHK		/TEST FOR QUOTES
	TAD QUOTE	/MOVE TO LOCAL POINT
	DCA COOZ
	TAD QUOTE+1
	DCA COOZ+1
	STA		/SET ITERATION FLAG
	DCA COOL
	TAD QP		/POINTER TO GOTO STRING
	IAC
	DCA COOQ	/SAVE FOR RESTARTING
	TAD ITRST	/START AT BEGINNING OF
	SNA		/CURRENT ITERATION
	DCA COOL	/NOT ITERATING, CLEAR FLAG
	DCA SCANP	/RESET SCAN POINTER
COOA,	SKP CLA		/AVOID QSKP FIRST TIME
	QSKP		/SKIP A STRING COMMAND
	TAD COOQ	/RESET TO BEGINNING OF GOTO
	DCA QR
	SKPSET		/SKIP COMMANDS UNTIL
		41	/! ENCOUNTERED
		COOC	/WHERE TO PROCESS IT
	ISZ COOL	/HERE ON $ OR ALTM
	ERR		/TAG NOT MATCHED
	JMP COOA-1	/DO PART FROM BEGINNING
COOL,	0		/FLAG FOR ITERATION
COOQ,	0		/BEGINNING OF GOTO STRING
COOT,	0		/TEMPORARY
CSMI,	POP		/SAVE RETURN POINTER
	DCA CSPS
	PUSHJ		/FOUND &lt;
		CHLT	/PUSH DOWN INTO ITERATION
	JMP .+5
CSMO,	POP		/SAVE RETURN POINTER
	DCA CSPS
	PUSHJ		/FOUND &gt;
		CGSG	/POP OUT OF ITERATION
	TAD CSPS	/RESTORE RETURN
	PUSH		/POINTER
	JMP CSML	/CONTINUE

COOB,	.+2		/END OF TAG STRING FOUND
	.+1
	QGET
		QR	/CHECK FOR END OF GOTO STRING
	SORT
		COOZ
		QUOTAB-COOZ	/GO TO IREST IF IT IS
	JMP COOA	/NOT END SO NO MATCH
COOC,	SCAN		/FOUND TAG DEFINITION
	SORT
		QUOTE	/WATCH OUT FOR END
		COOB-QUOTE	/COOB IF END OF TAG
	CIA
	DCA COOT	/NOT END, SAVE
	QGET
		QR	/COMPARE WITH GOTO STRING
	ISZ QR
	SORT
		COOZ	/WATCH FOR END HERE, TOO
		COOY-COOZ	/START AGAIN IF END FOUND
	TAD COOT	/NOT END, COMPARE
	SZA CLA
	JMP COOA+1	/DIFFERENT, START OVER
	JMP COOC	/MATCH SO FAR
SETSKP,	0		/SET UP TO SKIP COMMANDS
	TAD I SETSKP
	DCA SKPLST	/CHAR TO TRAP ON
	ISZ SETSKP
	TAD I SETSKP	/LOCATION TO SERVICE
	DCA SKPTAB	/TRAP CHAR
CSML,	SCAN
	TAD (-100	/LOOK FOR LOWER CASE
	SMA
	AND CS137	/MASK TO UPPER CASE
	TAD CS100	/RESTORE 100
	SORT
		SKPLST
		SKPTAB-SKPLST
CSMK,	CLA		/NON-STRING COMMAND
	JMP CSML	/KEEP SKIPPING
CSMD,	SCAN		/CLEAR OUT MODIFIER
	JMP CSMK

CSMC,	PUSHJ		/FOUND ^
		CHUA1	/MAKE CTRL CHAR
	DCA SCHAR	/RETURN TO SORT ROUTINE
	JMP SORTA1	/AS IF NOTHING HAPPENED
CSME,	SCAN		/FOUND E COMMAND
	AND CS137	/MASK OUT LC BIT
	SORT
		ESKLST	/LOOK FOR ER &amp; EW
		ESKTAB-ESKLST	/USE CSMQ TO SKIP
	JMP CSMK	/NO STRING
CSMZ,	ISZ SETSKP	/FOUND $ OR ALTM
	JMP I SETSKP	/HOP BACK TO SEE IF ERROR
CSPS,	0		/SAVE RETURN POINTER
COOZ,	0
	0
COOY,	COOA+1
	COOA+1
SKPLST,	0		/TRAP CHAR
	41		/!
	76		/&gt;
	74		/&lt;
	42		/&quot;
	136		/^
CS100,	100		/@
	1		/^A
	2		/^B
	11		/TAB
	25		/^U
	36		/^^
	105		/E
	111		/I
	116		/N
	117		/O
	122		/R
	123		/S
CS137,	137		/_
	33		/ALTM
	44		/$
CSMA,	PUSHJ		/LIST TERMINATOR
		CATS	/FOUND @
	JMP CSML	/CONTINUE SKIPPING
	PAGE
/I/O UTILITIES
DECPUT,	0		/DEVICE INDEPENDENT I/O
	AND MASK
	TAD (200	/ADD ON PARITY BIT
	ISZ O3		/3RD CHAR OF 3?
	JMP O2		/NO
	JMS RT		/YES, SPECIAL HANDLING
	TAD DECGET	/TEMP STORAGE
	JMS RT
	TAD [-3		/RESET SWITCH
	DCA O3
	ISZ OCRCNT	/END OF BUFFER?
	JMP I DECPUT	/NO
	CLA CLL		/HAS HE GONE TOO FAR?
	TAD OCNT
	TAD OMAXLN
	SZL CLA
	JMP OERR	/YES, KILL HIM
	JMS I OUTHND
	4200
	OUT
OBLK,	0
	HLT
	ISZ OBLK	/BUMP RECORD POINTER
	ISZ OCNT	/AND COUNT
	JMS OSETP	/RESET POINTERS
	JMP I DECPUT	/AND RETURN

O2,	DCA I OPTR1	/NORMAL HANDLING
	ISZ OPTR1	/BUMP POINTER
	JMP I DECPUT

RT,	0		/HALF-CHAR PACK ROUTINE
	CLL RTL
	RTL
	DCA DECGET	/TEMPORARY STORAGE
	TAD DECGET
	AND (7400
	TAD I OPTR2	/ADD IT ON
	DCA I OPTR2
	ISZ OPTR2
	JMP I RT

OPTR1,	0
OPTR2,	0
OCRCNT,	0
O3,	0

OERR,	TAD (ERR-4400
	DCA OUTR
	ERR

OSETP,	0		/ROUTINE TO RESET OUTPUT POINTERS
	TAD [-3		/3-WAY SWITCH
	DCA O3
	TAD (OUT	/BUFFER POINTERS
	DCA OPTR1
	TAD (OUT
	DCA OPTR2
	TAD D7600	/=-200
	DCA OCRCNT	/CHARACTER COUNT
	JMP I OSETP

DECGET,	0		/PS/8 CHARACTER INPUT
D7600,	7600		/GROUP 2 CLA
	ISZ ICRCNT
	JMP I2		/NO NEED TO READ
	JMS I INHND	/NOTHING IN BUFFER, GET SOME MORE
	0200
	IN
IBLK,	0
	SMA CLA		/HALT ON FATAL ERROR
	SKP CLA		/NORMAL RETURN
	HLT		/YOU BLEW IT, DUMMY!
	ISZ IBLK	/BUMP RECORD POINTER
	TAD (IN		/AND RESET OTHER POINTERS
	DCA IPTR1
	TAD (IN
	DCA IPTR2
	TAD (-600
	DCA ICRCNT
	TAD [-3
	DCA I3
I2,	ISZ I3
	JMP I1		/NORMAL CHARACTER
	TAD [-3		/WEIRD CHARACTER-RESET SWITCH
	DCA I3
	TAD I IPTR2
	ISZ IPTR2
	AND (7400
	DCA ICHAR	/TEMP
	TAD I IPTR2
	ISZ IPTR2
	AND (7400
	CLL RTR
	RTR
	TAD ICHAR
	CLL RTR
	RTR
	JMP .+3
I1,	TAD I IPTR1
	ISZ IPTR1
	AND MASK	/MASK OFF GARBAGE
	DCA ICHAR
	TAD ICHAR
	JMP I DECGET	/AND EXIT

ICRCNT,	0
IPTR1,	0
IPTR2,	0
I3,	0

APPTAB,	APSP		/SPACE--MIGHT CONVERT TO TAB
	CAFF		/FORM FEED--END OF PAGE
	APLF		/LINE FEED--SEE IF TOO FULL
	APFS		/^Z--END OF FILE
	CALP		/NULL--IGNORE
	CALP		/RUBOUT--IGNORE
	ENDGRP=CHRP

GETUSR,	0		/SUBROUTINE TO LOCK MONITOR IN CORE
	IOF
	CIF 10
	JMS I USR
	10
	TAD (200
	DCA USR
	JMP I GETUSR

	PAGE
/FILE OPEN COMMMANDS:

ROPEN,	CLA CLL CML RTL	/OPEN INPUT FILE
	JMS OPEN	/LOOKUP CODE IN AC
		INHNDL	/HANDLER ADDRESS
	DCA INHND	/SAVE HANDLER ENTRY
	TAD STBLK
	DCA IBLK	/FIRST BLOCK
	TAD [DECGET	/DEVICE INDEPENDENT CODE
	DCA INR		/INPUT ROUTINE
	CLA CLL CMA
	DCA ICRCNT	/POINTER
	CLA CLL CMA
	DCA REND	/CLEAR END-OF-FILE FLAG
	JMS DISMISS	/KICK THE USR OUT
	JMP IREST	/EXIT

WOPEN,	TAD [3		/OPEN OUTPUT FILE
	JMS OPEN	/ENTER CODE IN AC
		OUHNDL	/HANDLER ADDRESS
	DCA OUTHND	/HANDLER ENTRY
	DCA EBFLG	/CLEAR BACKUP FLAG
	TAD FLN		/MAXIMUM FILE LENGTH
	DCA OMAXLN
	TAD STBLK	/STARTING BLOCK
	DCA OBLK
	TAD (DECPUT	/SETUP POINTER TO
	DCA OUTR	/OUTPUT ROUTINE
	JMS OSETP	/SET POINTERS
	CLA CLL CMA
	DCA WEND	/CLEAR END-OF-FILE FLAG
	TAD DEVC+1
	DCA ODEV	/SAVE DEV #
	DCA OCNT	/CLEAR BLOCK COUNT
	TAD NAME	/SAVE FILENAME FOR CLOSE
	DCA OUNAM
	TAD NAME+1
	DCA OUNAM+1
	TAD NAME+2
	DCA OUNAM+2
	TAD NAME+3
	DCA OUNAM+3
	JMS DISMISS	/KICK THE USR OUT
	JMP IREST	/EXIT

EBAK,	TAD DX		/EDIT BACKUP COMMAND
	DCA DISMISS+1	/KILL DISMISS SO USR STAYS IN CORE
	PUSHJ		/DO LOOKUP FAKE
		ROPEN
	TAD DEVC+1	/DEVICE #
	TAD (7757	/SDVHND-1
	DCA TX
	CDF 10
	TAD I TX	/DEVICE CODE
	CDF
X7700,	SMA CLA		/NEGATIVE IF FILE-STRUCTURED
	JMP EBERR	/YOU CAN&#039;T DO THAT!
	TAD NAME+3	/SAVE EXTENSION FOR ENTER
	DCA TX
	TAD (213	/.BK EXTENSION
	DCA NAME+3
	TAD DEVC+1	/DEVICE #
	CIF 10
	JMS I USR	/DELETE THE OLD BACKUP
	4
DELPT,	NAME
	0
	CLA CLL		/WHO CARES IF IT&#039;S NOT THERE?
	TAD TX		/RESTORE THE EXTENSION
	DCA NAME+3
	CIF 10		/CALL THE HANDLER INTO THE OUTPUT SLOT, TOO
	JMS I USR	/RESET SYSTEM TABLES
	13		/ZAP OPEN OUTPUT FILES
	TAD WOPEN+2	/PLACE TO LOAD HANDLER
	DCA .+5
	TAD DEVC+1	/OUTPUT TO SAME DEVICE AS INPUT
	CIF 10
	JMS I USR	/GET THE HANDLER
	1
	OUHNDL
	JMP EBERR	/(HOW DID THIS HAPPEN?)
	TAD .-2		/MOVE HANDLER ENTRY
	DCA OUTHND
	TAD DELPT	/SET UP POINTER FOR ENTER
	DCA EBLK
	TAD DEVC+1
	CIF 10		/ENTER THE OUTPUT FILE
	JMS I USR
	3
EBLK,	NAME
	0		/USELESS LENGTH
	JMP EBERR	/NO ROOM
	DCA DISMISS+1	/FIX DISMISS
	CLA CLL IAC	/SET FLAG TO SHOW WE&#039;RE DOING AN EB
	DCA EBFLG
	TAD EBLK+1	/MOVE OUTPUT POINTERS
	DCA OMAXLN	/OVERFLOW PROTECTION
	TAD EBLK	/MOVE STARTING BLOCK
	PUSHJ		/AND THE OTHER CRAP
		WOPEN+10
	JMP CHRY+2	/READ IN THE FIRST PAGE

EBERR,	DCA DISMISS+1	/FIX DISMISS
	JMS DISMISS	/KICK MONITOR OUT ON ERROR
	ERR
TX=.			/TEMPORARY
DISMISS,	0	/KICK USR OUT OF CORE (SOMETIMES)
	NOP
	CIF 10
	JMS I USR
	11
	TAD X7700	/RESET MONITOR POINTER
	DCA USR
DX,	JMP I DISMISS
OUNAM,	ZBLOCK 4

	PAGE
/COMMANDS &quot; AND &#039;
CNDLST,	103		/C
	143		/C
	76		/&gt;, OLD G
	53		/+, NO EQV: 0 OR +
	43		/#, OLD N
	55		/-, NO EQV: 0 OR -
	74		/&lt;, OLD L
	75		/=, OLD E
CDBQ,	NCHK		/COMMAND &quot;
	ERR		/NO NUMBER TO TEST
	SCAN
	SORT
		CNDLST
		CNDTAB-CNDLST
	ERR		/NO SUCH TEST
CNDI,	SCAN		/HIT ANOTHER &quot;
	STA		/SO SKIP MATCHING &#039;
	TAD CNDN
	DCA CNDN
	RESORT		/GO BACK TO CSML
CNDO,	ISZ CNDN	/FOUND A &#039;
	RESORT		/NEED ANOTHER: BACK TO CSML
	TAD (CSMD	/FIX UP SKIP TABLE
	DCA SKPTAB+4	/USED ELSEWHERE
CSGQ,	POPJ		/COMMAND &#039; NO ACTION TO TAKE
CNDN,	0		/COUNTER FOR &quot; NESTING
TCRLF,	TAD CACR	/CR IN COMM LINE
	DCA CHAR
	CTLTYP		/TYPE IT OUT
	JMS SPUT	/PUT INTO COMM LINE
	TAD CALF	/THEN PUT IN A LF
	DCA CHAR
	JMS SPUT
	JMP T2		/AND GET SOME MORE

CNDTAB,	CNDC		/LEGAL CONSTITUENT OF
	CNDC		/SYMBOL FOR ASSEMBLER
	.+6		/POSITIVE, NON-ZERO
	.+6		/POSITIVE OR ZERO
	.+6		/NON-ZERO
	.+6		/NEGATIVE OR ZERO
	.+6		/NEGATIVE
	.+6		/ZERO
	TAD [40		/SMA SZA-SMA
	TAD [40		/SMA-SZA
	TAD CNM110	/SZA-SPA SNA
	TAD [40		/SPA SNA-SPA
	TAD [40		/SPA-SNA
	TAD (SNA CLA
	DCA .+2		/COMPUTED INSTRUCTION
	TAD N		/PERFORM TEST
	JMP .		/INVERSE OF TEST SENSE
	POPJ		/CONDITION SATISFIED
CNDF,	STA		/NOT SATISFIED
	DCA CNDN	/BEGINNING SKIPPING COMMANDS
	TAD (CNDI	/TRAP OUT NESTED &quot;
	DCA SKPTAB+4
	SKPSET		/CALL SKIPPING ROUTINE
		47	/FIND A &#039;
		CNDO	/PROCESS IT THERE
	ERR		/NO MATCHING &#039;
CNDC,	TAD N		/TEST FOR SYMBOL
	JMS SCHSRT	/FIND LETTERS &amp; NUMBERS
	SZA CLA		/AC=0 IF NOT
CNDP,	POPJ		/N IS A SYMBOL
	TAD N
	SORT		/LOOK FOR $,%, AND .
		SYMLST
		SYMTAB-SYMLST
	JMP CNDF	/N IS NOT A SYMBOL
SYMLST,	44		/$
	45		/%
	56		/.
CNM110,	-110		/SZA-SPA SNA, END OF LIST

COMLST,	7		/^G, COMMAND LINE EDIT LIST
	15		/CR, INSERT CR &amp; LF
	177		/RUBOUT
	14		/^L, SET LOWER CASE
	25		/^U, SET UPPER CASE
RECLST,	3		/^C, ERROR RECOVERY AID LIST
	33		/^[, ALT MODE
	175		/ANOTHER ALT MODE
	176		/YET ANOTHER ALT MODE
	77		/?
CBSN0,	TAD (55-72	/SEE IF DIGIT
	SMA
	JMP CBSN2	/NO, STOP HERE
	TAD (72-60
	SPA
	JMP CBSN2	/NOT DIGIT EITHER
	PUSHJ
		NMBR+2	/CALL DIGIT PROCESSOR
	ISZ P		/POINT TO NEXT CHAR
	TAD (NOP-SZA	/DON&#039;T TAKE A -
CBSN,	TAD (SZA	/TAKE INITIAL -
	DCA CBSN1
	CDF 10		/TEST 1 CHAR
	TAD I P
	CDF
	AND MASK
	TAD (-55	/IS IT -?
CBSN1,	JMP .		/SZA OR NOP
	JMP CBSN0	/SEE IF DIGIT
	PUSHJ
		CMIN	/CALL - PROCESSOR
	JMP CBSN-2	/TEST NEXT CHAR
CBSN2,	CLA
	POPJ		/FINISHED
	JMP I QOVER	/TRICKY CODING HERE
	.-1		/TARGET OF A SORT LIST
QOVER,	0		/ENTRY POINT AND TARGET OF SORT
	SCAN
	SORT
		QUOTE	/SKIPPING OVER A STRING COMMAND
		QOVER-1-QUOTE
	CLA		/NOT END
	JMP QOVER+1	/SKIP ANOTHER CHAR
	PAGE
/FILE OPEN ROUTINE
OPEN,	0		/CALLED WITH MONITOR CODE IN AC
	DCA CODE	/ENTER OR LOOKUP
	QCHK		/CHECK FOR EXPLICIT QUOTE (@)
	TAD (5723	/PACKED SIXBIT FOR &#039;DSK:&#039;
	DCA DEVC
	DCA DEVC+1	/CLEAR SECOND WORD
	TAD (72		/RESTORE :
	DCA DEVLST+1
NGO,	DCA NAME	/CLEAR NAME
	DCA NAME+1
	DCA NAME+2
	TAD (2001	/ASSUMED .PA EXTENSION
	DCA NAME+3
	TAD (NAME	/INITIALIZE POINTERS
	DCA NBASE
	CLA CLL CMA
	DCA PERDSW
	DCA NAMCNT
NAMEC,	SCAN
	SORT		/END OF STRING?
		QUOTE
		DEVQOT-QUOTE
	SORT		/NO - CHECK SPECIAL CHARS
		DEVLST	/([,:,., AND SPACE
		DEVTAB-DEVLST
	TAD (-&quot;9+177	/NO, SEE IF A-Z, 0-9
	CLL
	TAD (&quot;9+1-&quot;0
	SZL
	JMP DCDYES
	TAD (&quot;0-&quot;Z-1
	CLL CML
	TAD CTLZ	/=(&quot;Z-&quot;A+1
	SZL
	ERR		/NO, BOMBED OUT
DCDYES,	SZL		/YES, RESTORE CHAR
	TAD (57
	IAC
	DCA TEMP
	TAD NAMCNT
	TAD (-6
D7700,	SMA CLA		/MORE THAN 6 CHARS?
	JMP NAMEC	/YES, IGNORE
	TAD NAMCNT	/NO, PACK IT
	CLL RAR
	TAD NBASE
	DCA TEMP1
	TAD TEMP
	SZL
	JMP .+4
	CLL RTL
	RTL
	RTL
	TAD I TEMP1
	DCA I TEMP1
	ISZ NAMCNT
	JMP NAMEC
PERD,	TAD NAME	/PERIOD IN STRING
	SZA CLA
	ISZ PERDSW	/FLIP FLOP
	ERR		/DOUBLE PERIODS OR NO FILE NAME
	DCA NAME+3	/CLEAR EXTENSION
	DCA DEVLST+1	/DEVICE NO LONGER LEGAL
	ISZ NBASE	/BUMP POINTER
	TAD (4		/AND RESET COUNT
	JMP NAMEC-1
COLON,	TAD NAME	/DEVICE - MOVE NAME
	DCA DEVC
	TAD NAME+1
	DCA DEVC+1
	JMP NGO-1	/RESET FOR FILE NAME
DEVLST,	56		/.
	72		/:
	40		/SPACE
DEVQOT,	.+2
	.+1
	TAD I OPEN	/MOVE HANDLER ADDRESS
	DCA DEVHND
	ISZ OPEN	/AND BUMP POINTER
	CLA CLL CMA RAL	/COMPUTE RESET CODE (=0 FOR INPUT, 1 FOR OUTPUT)
	TAD CODE
	DCA RSTSW	/RESET SWITCH
	JMS GETUSR	/LOCK USR IN CORE
	CIF 10		/AND RESET TABLES
	JMS I USR
	13
RSTSW,	0		/DON&#039;T ZAP OPEN FILES ON INPUT
	CIF 10
	JMS I USR
	1		/ASSIGN HANDLER
DEVC,	0
	0
DEVHND,	0
	JMP MINCOR	/ERROR - KICK USR OUT FIRST
	TAD (NAME	/POINT TO NAME
	DCA STBLK
	TAD DEVC+1	/DEVICE #
	CIF 10
	JMS I USR
CODE,	0		/ENTER OR LOOKUP
	TEMP=.
STBLK,	0		/FILLED WITH STARTING BLOCK
	TEMP1=.
FLN,	0		/FILLED WITH -LENGTH
	JMP MINCOR	/ERROR
	TAD DEVHND	/HANDLER ADDRESS IN AC
	JMP I OPEN
MINCOR,	DCA DISMISS+1	/FIX DISMISS IF NECESSARY
	JMS DISMISS	/KICK USR OUT BEFORE GIVING ERROR
	ERR
PERDSW,	7777		/FLIP FLOP FOR EXTENSION
NAMCNT,	0		/CHARACTER COUNT
NBASE,	NAME		/POINTER
	PAGE
/EAE SUBROUTINES (FOR UNLUCKY PEOPLE)

MQACLA,	0
	CLA		/FAKE CLA MQA
	TAD MQ
	JMP I MQACLA	/EASY!!

MUYMQL,	0		/FAKE MQL MUY
	DCA MQ
	DCA MQACLA	/FAKE ACCUMULATOR
	TAD (-15
	DCA STPCNT
	JMP MUYA2
MUYA1,	TAD I MUYMQL
	SNL
	CLA CML
	TAD MQACLA
	CML RAR
	DCA MQACLA
MUYA2,	TAD MQ
	RAR
	DCA MQ
	ISZ STPCNT
	JMP MUYA1	/DO IT AGAIN
	TAD MQACLA
	ISZ MUYMQL	/BUMP POINTER
	JMP I MUYMQL	/RETURN WITH H.O. PRODUCT

DVIMQL,	0		/FAKE MQL DVI
	DCA MQ
	DCA MQACLA	/FAKE AC
	TAD I DVIMQL
	ISZ DVIMQL
	CIA CLL
	DCA MUYMQL	/DIVISOR
	TAD (-15
	DCA STPCNT
	JMP DVIA2
DVIA1,	TAD MQACLA
	RAL
	DCA MQACLA	/PARTIAL REMAINDER
	TAD MQACLA
	TAD MUYMQL	/COMPARE
	SZL
	DCA MQACLA	/NEW REMAINDER
	CLA		/IN CASE OF SKIP
DVIA2,	TAD MQ
	RAL
	DCA MQ		/PARTIAL QUOTIENT
	ISZ STPCNT
	JMP DVIA1	/DO IT AGAIN
	TAD MQACLA	/REMAINDER
	JMP I DVIMQL

MQ,	0		/FAKE M-Q REGISTER

ENDFIL,	TAD WEND	/OPEN OUTPUT FILE?
	SNA CLA
	ERR		/NO, THEN YOU CAN&#039;T CLOSE ONE!
	DCA WEND	/CLEAR FLAG
	TAD CTLZ	/^Z END-OF-FILE
	OUTPUT
	TAD OCRCNT	/OUTPUT CHARACTER COUNT
	TAD (200	/=-200 WHEN CLEAR
	SZA CLA
	JMP .-4		/FILL BUFFER WITH ZEROS
	JMS GETUSR	/LOCK USR IN
	TAD [OUHNDL	/SETUP POINTERS
	DCA .+5
	TAD ODEV	/MAKE SURE THE USR KNOWS THE HANDLER
	CIF 10		/IS IN CORE (&#039;ER&#039; MIGHT HAVE RESET
	JMS I USR	/THE HANDLER TABLES)
	1
	OUHNDL		/INTO OUTPUT SLOT (NATCH)
	HLT		/HUH?
	TAD EBFLG	/IS THIS AN EDIT BACKUP?
	SNA CLA
	JMP NORMAL	/NO, JUST CLOSE FILE
	TAD OCNT-1	/YES, LOOKUP OLD FILE TO CHANGE NAME
	DCA ENDT
	TAD ODEV	/INPUT AND OUTPUT ARE ON SAME DEVICE
	CIF 10
	JMS I USR
	2
	STPCNT=.
ENDT,	OUNAM
TY,	0		/USELESS LENGTH--USE IT FOR TEMPORARY
	JMP NORMAL	/ERROR-JUST CLOSE FILE AND DON&#039;T TELL ANYBODY
	CDF 10		/ALL THAT WAS JUST TO GET THE DIRECTORY IN CORE
	CLA CLL CMA	/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 (7	/DIRECTORY BLOCK IT CAME FROM
	AND (7
	DCA .+5
	CDF
	JMS I OUTHND
	4210		/WRITE IT BACK OUT
	1400
	0
	JMP .-4		/ERROR! KEEP TRYING-THIS CAN BLOW A DIRECTORY
NORMAL,	TAD ODEV	/CLOSE FILE
	CIF 10
	JMS I USR
	4
	OUNAM
OCNT,	0		/NUMBER OF BLOCKS
	HLT
	TAD ERR-4400	/RESET OUTPUT SUB POINTER
	DCA OUTR
	JMS DISMISS	/KICK THE MONITOR OUT
	POPJ		/ALL DONE

	PAGE
	$
</pre>
<hr/>
</div>