Google
 

Trailing-Edge - PDP-10 Archives - tops20_v6_1_tcpip_distribution_tp_ft6 - 6-1-sources/tv.mac
There are 20 other files named tv.mac in the archive. Click here to see a list.
;Edit 527 to TV.MAC by MAYO on Wed 25-Jul-84
;		Make ;ESC work like ;<SP>
;Edit 526 to TV.MAC by MAYO on Fri 18-Nov-83
;		Add the ability to return the options word
;Edit 525 to TV.MAC by MAYO on Fri 18-Nov-83
;		Allow the BIGTV variant to be compiled without drawing the
;;		"this isn't supported" message.
;Edit 523 to TV.MAC by MAYO on Thu 19-May-83
;		Remove uneeded code at XSIR:, and clean up VT100 handling.
;Edit 522 to TV.MAC by MAYO on Wed 4-May-83 - Add VT102 and VT125
;Edit 521 to TV.MAC by MAYO on Wed 4-May-83
;		Add to edit 520, and get other stack overflow problems.
;Edit 520 by MAYO on Thu 21-Apr-83, for SPR #19103
;		Catch pushdown overflow when entering iterations
;Edit 519 by MAYO on Wed 23-Mar-83
;		Give TV's BIGTV avatar a bigger buffer.
;**Edit 518 by SM - Fix DDT handling, add BIG conditional
;**Edit 517 by SM - Add "No escape after nI" error message. No SPR.
;**Edit 516 by SM - 3:Rfoo$bar$ lost : flag. Fix. No SPR.
;**Edit 515 by SM - Type filename on failing GTJFN when rescanning. 18864.
;**Edit 514 by SM - Fix to prevent TEXTI echo from bouncing off cmd files.
;**Modify PERUSE so there is no default filename on a ;X -SMAYO
;TCO 6.1308- ALLOW THE "PERUSE" COMMAND
;**Edit 513 by SM - Stop <;Efile$> from giving stack overflow. 18173.
;**Edit 512 by SM - Add SETSN code at startup. Add WLIBRARY$. No SPR.
;**Edit 511 by SM - 502 broke n,mP; fix. No SPR.
;**Edit 510 by SM - :N,:R weren't returning values properly. No SPR.
;**Edit 509 by SM  - WFILE$ returns nothing after CREATE foo. Fix. No SPR.
;    Also S...^Ex...$ doing things at runtime that could be done at compile
;    time. Fix. No SPR.
;**Edit 508 by SM - Stack imbalance at OPNOUT. Fix. No SPR.
;**Edit 507 by SM - n,nK returns n. Fix. No SPR.
;**Edit 506 by SM - ARG2 not being cleared properly. Fix. No SPR.
;**Edit 505 by SM - Fix octal input; large values can get trashed. No SPR.
;**Edit 504 by SM - clean up code. V5. Fix comments. No SPR.
;**Edit 503 by SM - Fix edit 474 (make N and _ work) 17384
;**Edit 502 by SM - Large fix for arg passing and scanning.
;**Edit 501 by SM - Stop Y and A from stripping nulls
;**Edit 500 by SM - Have 0"N^I$' not insert tab. Also force version decimal.
;This software is furnished under a license and may only be used
;  or copied in accordance with the terms of such license.
;
;Copyright (C) 1976,1977,1978,1979,1980,1981,1982,1983,1984,1985,
; By DIGITAL EQUIPMENT CORPORATION, Maynard, Mass.

	TITLE TV - screen editor for TOPS-20 systems

	SEARCH MONSYM,MACSYM
	SALL			;MACROS TEND TO BE MESSY

	EXTERNAL .RLEND		;SYMBOL SHOWING END OF MACREL

	WHTV==0			;LAST EDITED BY DEC
	VRTV==5			;MAJOR VERSION #
	RVTV==1			;REVISION #

	.EDIT==VI%DEC+^D527	;EDIT NUMBER, decimal

	%%RVER==: .EDIT		 ;RHS FOR LINK
	%%LVER==: <WHTV>B20+<VRTV>B29+RVTV ;LHS

;IF DEFINED, LEAVE ALONE, IF UNDEFINED, DEFINE IT

	DEFINE ND(SYM,VAL),	<IFDEF SYM,<SYM=SYM>
				 IFNDEF SYM,<SYM=VAL> >

;COMPILATION "FALL-OVER-AND-DIE" MACRO

	DEFINE FOAD ($MSG)<
	 PRINTX ?'$MSG
	 PASS2
	 END>

;COMPILATION "PLEASE TAKE NOTE" MACRO

	DEFINE UH.OH ($MSG)<
	 IF1, <PRINTX $MSG> >

;CONSTANTS OF MERIT

	ND MAXWTH,^D255			;MAXIMUM VALUE ALLOWABLE FOR SWIDTH

	ND USARYL,^D200			;NUMBER OF CELLS IN USER ARRAY
	ND MAXSEC,7			;MAX # OF SECTS WE GIVE TO THE USER
					 ;SET TO 0 TO REMOVE EXTENDED COMMANDS
					 ;SET TO 0 ON 2020's
	ND FTRSC,0			;IF 0, ALWAYS RESCAN ON RESTART
	ND FTDEB,0			;ADDS RANDOM NNU'D ROUTINES

	ND FTUNS,0		;to get various interesting flavors of TV
				 ;you could override the 0 in ND FTUNS,0 with
				 ;below values.

	.CHTRM=.CHESC			;DEFAULT TERMINATOR IS ESCAPE
	 IFGE <.CHTRM-40>, FOAD <Illegal value of .CHTRM>

;The left half values are DEC supported features.
	FT.BIG==1B0		 ;BIGTV (large buffer, no DDT, small Qregs)

;If anything in the right half is on, THIS BECOMES UNSUPPORTED
	FT.ENC==1B18		 ;Coding algorithm included (WENCRYPT$)
	FT.CST==1B35		 ;if customized, light this bit
				 ;bits 25-34 for customer use

	FT.UNS==<0,,-1>		;if unsupported features are enabled,
				; FT.UNS hits it

	DEFINE OPTION(OPT,CDE),<
	 IFN FTUNS&FT.'OPT,<CDE> >
	DEFINE OPTOFF(OPT,CDE),<
	 IFE FTUNS&FT.'OPT,<CDE> >


;Paranoia checks and flags.  Values assigned to FT$VAL are available to the
; user (via @^V).

	FT$VAL=0		;ASSUME VANILLA

	OPTION UNS,<UH.OH <%This version of TV is *NOT* supported>
			FT$VAL=FT$VAL!1B0 >

	OPTION ENC,<UH.OH < ENCRYPTION included>
			FT$VAL=FT$VAL!1B35 >

	OPTION BIG,<UH.OH < BIG BUFFER assumptions made>
			FT$VAL=FT$VAL!1B34 >

	OPTION CST,<UH.OH < (This is a USER CUSTOMISED version of TV)>
			FT$VAL=FT$VAL!1B1 >

	IFLE MAXSEC, UH.OH <%Extended buffer commands will not be available.>
	IFG MAXSEC,<	FT$VAL=FT$VAL!1B33>

	IFL USARYL-^D10, FOAD <Array size set too small!>
;ACCUMULATOR ASSIGNMENTS

	FF=0			;CONTROL FLAGS

;*** A, B AND C MUST BE CONTIGUOUS AND IN THAT ORDER ***
	A=1
	B=2			;BYTE POINTER TO COMMAND BUFFER

;*** c AND d MUST BE ADJACENT AND c .L. 11 ***
	C=3			;COMMAND BUFFER END ADDRESS
	D=4
	P1=5
	P2=6

;*** OU AND CH MUST BE CONSECUTIVE
	OU=7
	CH=10
	T=11

;*** TT AND TT1 MUST BE ADJACENT ***
	TT=12
	TT1=13

;*** I IS FOR GENERAL USAGE
	I=14

;*** 15 AND 16 RESERVED FOR TRVAR AND FRIENDS, EXCEPT FOR SEARCH ROUTINE
;*** SAC1 AND SAC2 MUST BE CONSECUTIVE
	SAC1=15
	SAC2=16
	CX=16
	P=17

.JBUUO==40			;UUO WORD
.JB41==41			;INSTRUCTION EXECUTED BY UUO
;OPDEFS AND DEFINES

	OPDEF	UERR	[01B8]
	OPDEF	UPSTR	[02B8]	;PRINT STRING UUO
	OPDEF	ULDB	[03B8]	;LDB BUT ADJUST BYTE POINTER TO AVOID HOLE
	OPDEF	UILDB	[04B8]	;SAME FOR ILDB
	OPDEF	ULERR	[05B8]	;LOCAL ERROR
	OPDEF	UJERR	[06B8]	;JSYS ERROR
	OPDEF	UJERR	[07B8]	;LOCAL JSYS ERROR
	OPDEF	UIERR	[8B8]	;INTERNAL ERROR
	OPDEF	UCTYPE	[9B8]	;SINGLE CHARACTER

;ERROR MACRO

	DEFINE ERROR ($MSG)<	UERR [ASCIZ \$MSG\]>

;INTERNAL ERROR (NOT USER ERROR)

	DEFINE IERROR ($MSG)<	UIERR [ASCIZ \TV internal error - $MSG\]>

;JSYS ERROR

	DEFINE JERROR ($MSG)<	UJERR [ASCIZ \$MSG\]>

;LOCAL JSYS ERROR

	DEFINE LJERR ($MSG)<	UJERR [ASCIZ \$MSG\]>

;LOCAL ERROR MACRO (LIKE ERROR, BUT RETURNS)

	DEFINE LERROR ($MSG)<	ULERR [ASCIZ \$MSG\]>

;PRINT STRING MACRO

	DEFINE PSTR ($MSG)<	UPSTR [ASCIZ \$MSG\]>

;PRINT LITERAL CHARACTER

	DEFINE CTYPE (CHAR)<	UCTYPE "CHAR">

;MACROS WHICH EXPAND INTO COMND JSYS FUNCTION BLOCKS...

	DEFINE NOISEX (MESSAG)
<	FLDDB. .CMNOI,,<-1,,[ASCIZ /MESSAG/]>
>

	DEFINE C.(WHAT)
<DEFINE WHAT'X
<	FLDDB. .'WHAT
>>

C. CMINI
C. CMCFM
C. CMIFI
C. CMFIL
C. CMFLD
C. CMCFM
C. CMOFI

;MAJOR BUFFER ASSIGNMENTS

	CBUF=50000			;BUFFER FOR TYPIN AND QREG TEXT

 OPTOFF BIG,<
	MTBUF0==400000			;MAIN TEXT AREA
	EMTBUF=763500			;END OF MAIN BFR AREA, ROOM FOR DDT
 >
 OPTION BIG,<
	MTBUF0==60000				;MAIN TEXT AREA FOR BIGBUF
	EMTBUF=777600				;END MAIN TEXT (NO DDT!)
 >
	BBUF1==100000			;BACKUP BUFFERS IN LOWER FORK
		; (LOWER FORK COPYS ONE TO DISK WHILE WE USE OTHER ONE)
	BBUF2==400000
;CONTROL FLAGS

	ARG2==	1B34		;THERE IS A SECOND ARGUMENT
	ARG==	1B33		;THERE IS AN ARGUMENT
	PERUS==	1B32		;PERUSE MODE
	SLSL==	1B31		;@ SEEN
	PCHFLG==1B30		;N SEARCH
	COLONF==1B29		;COLON SEEN

	FINDR==	1B26		;LEFT ARROW SEARCH
	RPLFG==	1B25		;I REPLACE COMMAND
	CTOFLG==1B24		;^O COMMAND
	TRACEF==1B23		;? SEEN

	FORM==	1B18		;FORM FEED TERMINATED LAST Y OR A

	RSCNF2==1B17		;SAYS RESCANNED DATA AVAILABLE
	RSCANF==1B16		;SAYS WE'RE USING RESCANNED DATA
	FINF==	1B15		;INPUT CLOSED BY EOF
	UREAD==	1B10		;INPUT FILE IS OPEN
	UWRITE==1B9		;OUTPUT FILE IS OPEN
	DUMPF==	1B8		;FULL FILE OPERATION IN PROGRESS (LIKE ;U ;X)
	SCANF==	1B7		;SET IF SCANNING

;VARIOUS CHARACTER DEFINITIONS
PCHAR=="*"			;PROMPT CHARACTER
CFLAG=="'"			;CHAR FOR FLAGGING "WRONG CASE" CHARACTERS

C.MORE==40			;CHARACTER TO CONTINUE DISPLAY
C.TOP==37			;SAME
C.QUOT=="V"-100			;QUOTE ONE CHARACTER
C.LOWR=="A"-100			;LOWERCASE SHIFT
C.RAIS=="B"-100			;UPPERCASE SHIFT

.TT102=^D37			;VT102 TERMINAL CODE

;VT05 ESCAPE CODES...

	C.CAD=="N"-100		;vt05 cursor addressing character
	C.LM==37			;add column or row to get there on vt05
	C.UP=="Z"-100			;-L
	C.DOWN=="K"-100			;+L
	C.LEFT=="H"-100			;-c
	C.RITE=="X"-100			;+c
	C.EOL=="^"-100			;CLEAR TO END OF LINE

;VT50, VT52 ESCAPE CODES, MUST BE PRECEDED BY ALTMODE

	V52.ES==33
	V52.UP==101
	V52.DN==102
	V52.RT==103
	V52.LT==104
	V52.EL==113			;CLEAR TO END OF LINE

;STORAGE

	LPDL=200
	GCTBL=150
	LPF=200			;AT LEAST ENOUGH ROOM FOR SAVING ALL THE QREGS
	OTABL=110		;LENGTH FOR TAGS FOR "O" COMMAND
;ENTRY VECTOR
	LOC	140

GOGO:	JRST TECO		;START ADDRESS
	JRST REE		;REENTER ADDRESS
VRSNI:	%%LVER,,%%RVER		;VERSION NUMBER
ENLEN==.-GOGO			;LENGTH OF ENTRY VECTOR
;CHARACTER TABLE.  ALLOWS RAISING, LOWERING, ETC. IN ONE INSTRUCTION.
;ALSO HAS INFORMATION CONCERNING "WHAT KIND OF CHARACTER IS THIS?"

	CH%UPR==1B35		;BIT TO MEAN CHARACTER IS CAPITAL LETTER
	CH%DWN==1B34		;LOWER CASE
	CH%EOL==1B33		;<CR><LF><FF>
	CH%BL0==1B32		;<SP><TAB>

	CH%DIG==1B28		;DIGITS, 0-9
	CH%PN1==1B27		;PUNCTUATION .,;:!?"

	CH%SYM==1B24		;.$%
	CH%USR==1B23		;USER DEFINABLE

	 CH%ALP=CH%DWN!CH%UPR	;ALPHABETIC IS UPPER+LOWER
	 CH%SBL==CH%ALP!CH%DIG!CH%SYM	;SYMBOL CONSTUTIENT IS ALPHA+DIGITS+.%$
	 CH%BL1==CH%EOL!CH%BL0	;BLANK TYPE 1 - <CR><FF><LF><SP><TAB>
	 CH%APN==CH%ALP!CH%DIG	;ALPHANUMERICS
	 CH%QRG=CH%APN		;QREG CHARACTER TYPE IS ALPHANUMERIC

	LWRFLD==177B8
	UPRFLD==177B15
	MSKSTR LWRCOD,CHRTAB,LWRFLD ;LOWERCASE VERSION OF CHARACTER
	MSKSTR UPRCOD,CHRTAB,UPRFLD ;UPPERCASE VERSION

CHRTAB:		FLD(0,LWRFLD)!FLD(0,UPRFLD)
		FLD(1,LWRFLD)!FLD(1,UPRFLD)
		FLD(2,LWRFLD)!FLD(2,UPRFLD)
		FLD(3,LWRFLD)!FLD(3,UPRFLD)
		FLD(4,LWRFLD)!FLD(4,UPRFLD)
		FLD(5,LWRFLD)!FLD(5,UPRFLD)
		FLD(6,LWRFLD)!FLD(6,UPRFLD)
		FLD(7,LWRFLD)!FLD(7,UPRFLD)
		FLD(10,LWRFLD)!FLD(10,UPRFLD)
	CH%BL0!	FLD(11,LWRFLD)!FLD(11,UPRFLD)	;^I
	CH%EOL!	FLD(12,LWRFLD)!FLD(12,UPRFLD)	;^J
		FLD(13,LWRFLD)!FLD(13,UPRFLD)
	CH%EOL!	FLD(14,LWRFLD)!FLD(14,UPRFLD)	;^L
	CH%EOL!	FLD(15,LWRFLD)!FLD(15,UPRFLD)	;^M
		FLD(16,LWRFLD)!FLD(16,UPRFLD)
		FLD(17,LWRFLD)!FLD(17,UPRFLD)
		FLD(20,LWRFLD)!FLD(20,UPRFLD)
		FLD(21,LWRFLD)!FLD(21,UPRFLD)
		FLD(22,LWRFLD)!FLD(22,UPRFLD)
		FLD(23,LWRFLD)!FLD(23,UPRFLD)
		FLD(24,LWRFLD)!FLD(24,UPRFLD)
		FLD(25,LWRFLD)!FLD(25,UPRFLD)
		FLD(26,LWRFLD)!FLD(26,UPRFLD)
		FLD(27,LWRFLD)!FLD(27,UPRFLD)
		FLD(30,LWRFLD)!FLD(30,UPRFLD)
		FLD(31,LWRFLD)!FLD(31,UPRFLD)
		FLD(32,LWRFLD)!FLD(32,UPRFLD)
		FLD(33,LWRFLD)!FLD(33,UPRFLD)	;^Z
		FLD(34,LWRFLD)!FLD(34,UPRFLD)
		FLD(35,LWRFLD)!FLD(35,UPRFLD)
		FLD(36,LWRFLD)!FLD(36,UPRFLD)
		FLD(37,LWRFLD)!FLD(37,UPRFLD)
	CH%BL0!	FLD(40,LWRFLD)!FLD(40,UPRFLD)	;SPACE
	CH%PN1!	FLD(41,LWRFLD)!FLD(41,UPRFLD)	;!
	CH%PN1!	FLD(42,LWRFLD)!FLD(42,UPRFLD)	;"
		FLD(43,LWRFLD)!FLD(43,UPRFLD)
	CH%SYM!	FLD(44,LWRFLD)!FLD(44,UPRFLD)	;$
	CH%SYM!	FLD(45,LWRFLD)!FLD(45,UPRFLD)	;%
		FLD(46,LWRFLD)!FLD(46,UPRFLD)
		FLD(47,LWRFLD)!FLD(47,UPRFLD)
		FLD(50,LWRFLD)!FLD(50,UPRFLD)
		FLD(51,LWRFLD)!FLD(51,UPRFLD)
		FLD(52,LWRFLD)!FLD(52,UPRFLD)
		FLD(53,LWRFLD)!FLD(53,UPRFLD)
	CH%PN1!	FLD(54,LWRFLD)!FLD(54,UPRFLD)	;,
		FLD(55,LWRFLD)!FLD(55,UPRFLD)	;-
	CH%PN1!CH%SYM!	FLD(56,LWRFLD)!FLD(56,UPRFLD)	;.
		FLD(57,LWRFLD)!FLD(57,UPRFLD)
	CH%DIG!	FLD(60,LWRFLD)!FLD(60,UPRFLD)	;0
	CH%DIG!	FLD(61,LWRFLD)!FLD(61,UPRFLD)	;1
	CH%DIG!	FLD(62,LWRFLD)!FLD(62,UPRFLD)	;2
	CH%DIG!	FLD(63,LWRFLD)!FLD(63,UPRFLD)	;3
	CH%DIG!	FLD(64,LWRFLD)!FLD(64,UPRFLD)	;4
	CH%DIG!	FLD(65,LWRFLD)!FLD(65,UPRFLD)	;5
	CH%DIG!	FLD(66,LWRFLD)!FLD(66,UPRFLD)	;6
	CH%DIG!	FLD(67,LWRFLD)!FLD(67,UPRFLD)	;7
	CH%DIG!	FLD(70,LWRFLD)!FLD(70,UPRFLD)	;8
	CH%DIG!	FLD(71,LWRFLD)!FLD(71,UPRFLD)	;9
	CH%PN1!	FLD(72,LWRFLD)!FLD(72,UPRFLD)	;:
	CH%PN1!	FLD(73,LWRFLD)!FLD(73,UPRFLD)	;;
		FLD(74,LWRFLD)!FLD(74,UPRFLD)
		FLD(75,LWRFLD)!FLD(75,UPRFLD)
		FLD(76,LWRFLD)!FLD(76,UPRFLD)
	CH%PN1!	FLD(77,LWRFLD)!FLD(77,UPRFLD)	;?
		FLD(100,LWRFLD)!FLD(100,UPRFLD)
	CH%UPR!	FLD(141,LWRFLD)!FLD(101,UPRFLD)
	CH%UPR!	FLD(142,LWRFLD)!FLD(102,UPRFLD)
	CH%UPR!	FLD(143,LWRFLD)!FLD(103,UPRFLD)
	CH%UPR!	FLD(144,LWRFLD)!FLD(104,UPRFLD)
	CH%UPR!	FLD(145,LWRFLD)!FLD(105,UPRFLD)
	CH%UPR!	FLD(146,LWRFLD)!FLD(106,UPRFLD)
	CH%UPR!	FLD(147,LWRFLD)!FLD(107,UPRFLD)
	CH%UPR!	FLD(150,LWRFLD)!FLD(110,UPRFLD)
	CH%UPR!	FLD(151,LWRFLD)!FLD(111,UPRFLD)
	CH%UPR!	FLD(152,LWRFLD)!FLD(112,UPRFLD)
	CH%UPR!	FLD(153,LWRFLD)!FLD(113,UPRFLD)
	CH%UPR!	FLD(154,LWRFLD)!FLD(114,UPRFLD)
	CH%UPR!	FLD(155,LWRFLD)!FLD(115,UPRFLD)
	CH%UPR!	FLD(156,LWRFLD)!FLD(116,UPRFLD)
	CH%UPR!	FLD(157,LWRFLD)!FLD(117,UPRFLD)
	CH%UPR!	FLD(160,LWRFLD)!FLD(120,UPRFLD)
	CH%UPR!	FLD(161,LWRFLD)!FLD(121,UPRFLD)
	CH%UPR!	FLD(162,LWRFLD)!FLD(122,UPRFLD)
	CH%UPR!	FLD(163,LWRFLD)!FLD(123,UPRFLD)
	CH%UPR!	FLD(164,LWRFLD)!FLD(124,UPRFLD)
	CH%UPR!	FLD(165,LWRFLD)!FLD(125,UPRFLD)
	CH%UPR!	FLD(166,LWRFLD)!FLD(126,UPRFLD)
	CH%UPR!	FLD(167,LWRFLD)!FLD(127,UPRFLD)
	CH%UPR!	FLD(170,LWRFLD)!FLD(130,UPRFLD)
	CH%UPR!	FLD(171,LWRFLD)!FLD(131,UPRFLD)
	CH%UPR!	FLD(172,LWRFLD)!FLD(132,UPRFLD)
		FLD(133,LWRFLD)!FLD(133,UPRFLD)
		FLD(134,LWRFLD)!FLD(134,UPRFLD)
		FLD(135,LWRFLD)!FLD(135,UPRFLD)
		FLD(136,LWRFLD)!FLD(136,UPRFLD)
		FLD(137,LWRFLD)!FLD(137,UPRFLD)
		FLD(140,LWRFLD)!FLD(140,UPRFLD)
	CH%DWN!	FLD(141,LWRFLD)!FLD(101,UPRFLD)	;a
	CH%DWN!	FLD(142,LWRFLD)!FLD(102,UPRFLD)
	CH%DWN!	FLD(143,LWRFLD)!FLD(103,UPRFLD)
	CH%DWN!	FLD(144,LWRFLD)!FLD(104,UPRFLD)
	CH%DWN!	FLD(145,LWRFLD)!FLD(105,UPRFLD)
	CH%DWN!	FLD(146,LWRFLD)!FLD(106,UPRFLD)
	CH%DWN!	FLD(147,LWRFLD)!FLD(107,UPRFLD)
	CH%DWN!	FLD(150,LWRFLD)!FLD(110,UPRFLD)
	CH%DWN!	FLD(151,LWRFLD)!FLD(111,UPRFLD)
	CH%DWN!	FLD(152,LWRFLD)!FLD(112,UPRFLD)
	CH%DWN!	FLD(153,LWRFLD)!FLD(113,UPRFLD)
	CH%DWN!	FLD(154,LWRFLD)!FLD(114,UPRFLD)
	CH%DWN!	FLD(155,LWRFLD)!FLD(115,UPRFLD)
	CH%DWN!	FLD(156,LWRFLD)!FLD(116,UPRFLD)
	CH%DWN!	FLD(157,LWRFLD)!FLD(117,UPRFLD)
	CH%DWN!	FLD(160,LWRFLD)!FLD(120,UPRFLD)
	CH%DWN!	FLD(161,LWRFLD)!FLD(121,UPRFLD)
	CH%DWN!	FLD(162,LWRFLD)!FLD(122,UPRFLD)
	CH%DWN!	FLD(163,LWRFLD)!FLD(123,UPRFLD)
	CH%DWN!	FLD(164,LWRFLD)!FLD(124,UPRFLD)
	CH%DWN!	FLD(165,LWRFLD)!FLD(125,UPRFLD)
	CH%DWN!	FLD(166,LWRFLD)!FLD(126,UPRFLD)
	CH%DWN!	FLD(167,LWRFLD)!FLD(127,UPRFLD)
	CH%DWN!	FLD(170,LWRFLD)!FLD(130,UPRFLD)
	CH%DWN!	FLD(171,LWRFLD)!FLD(131,UPRFLD)
	CH%DWN!	FLD(172,LWRFLD)!FLD(132,UPRFLD)	;z
		FLD(173,LWRFLD)!FLD(173,UPRFLD)
		FLD(174,LWRFLD)!FLD(174,UPRFLD)
		FLD(175,LWRFLD)!FLD(175,UPRFLD)
		FLD(176,LWRFLD)!FLD(176,UPRFLD)
		FLD(177,LWRFLD)!FLD(177,UPRFLD)
;Flags for commands

	CM.ATS==1B0	;Atsign is meaningful for this command
	CM.0AI==1B1	;it is illegal to have 0 args before the command
	CM.1AI==1B2	;it is illegal to have only 1 arg 'fore the cmd
	CM.2AI==1B3	;it is illegal to have 2 args before this command
	 CM.NAI==CM.2AI!CM.1AI ;no args allowed before this command
	CM.MOD==1B4	;this command modifies the buffer
	CM.OPR==1B5	;this is a binary operator (could be unary also)
	CM.EXE==1B6	;this command is to be executed while scanning
	CM.PRE==1B7	;this is a command prefix char (^ ;)
;Reserved 1B9 and 1B8
	CM.OFS==777B17	;this field contains 0 or the offset to ARGTAB
	CM.ADR==777777	;this field is the address to PUSHJ to,
			; or Prefix value to if CM.PRE is set.

;Prefix character types (index into PREPTR)

	PRE.NO==0	;No prefix character seen
	PRE.SM==1	;Semicolon character seen
	PRE.UP==2	;Uparrow prefix seen
	PRE.CL==3	;Colon seen
	PRE.AT==4	;Atsign seen


;Argtypes, used in scanning over commands. These end up in strings at ARGTAB.

	CS.STP==0	;End of argtype string
	CS.SY1==1	;Followed by one symbol
	CS.QRG==2	;followed by Qreg name
	CS.DIG==3	;followed by a digit string, len .GE. 0
	CS.STR==4	;followed by a simple string (no special ^x chars)
	CS.INS==5	;followed by insert string or filename
	CS.SRS==6	;followed by a search string
	 NBACS==3	 ;Number of bits to hold largest of Argtype values

	ILLEG==0	;illegal command
	NOFLG==0	;no flags for this command
;This macro sets up the command table for TV. It contains the flags needed to 
;to parse the commands or scan over them while scanning (SCANF flag) is being
;done.

	DEFINE CTR%(CHAR,FLAGS,ADDR,TYPES),<
	 ifn FLAGS&<0,,-1>,<	;;if any flags are in the RH...
		FOAD <Command table error, flags in RH> >
	 %%'CHAR==0		;;assume no argtype string will be needed
	 irp TYPES,<		;;get the first arg in TYPES (or -1)
	  %TMP==TYPES		;;..
	  stopi>		;;stop after first
	 ifg %TMP,< %%'CHAR==1-ARGTA1+<[BYTE(NBACS)TYPES ,CS.STP]>>
				;;if there is a real string, point to it.
	 EXP FLAGS!<%%'CHAR,,ADDR> ;;punch out the word
	 PURGE %%'CHAR>		;;and toss out the unneeded symbol

;This macro is used to call the above. It passes the decimal expansion of the
;character's ascii value (so CTR% can produce a unique symbol, %%nnn) and
;fills in reasonable defaults. It creates the symbols in order. The args are:
; A Address to jump to
; F flags approprate to this command (see CM.xxx)
; T Trailing argtypes (see CS.xxx)

	DEFINE CT%(A<ILLEG>,F<0>,T<-1>),<
	 IFNDEF %%TMP,<%%TMP==0>
	 CTR% \<%%TMP>,F,A,<T>
	 %%TMP==%%TMP+1>

;Off the listing to punch out any literals made so far - must be done right
; before CMDTAB.
	XLIST
	 LIT
	LIST
;Punched!
;Main Command table here

CMDTAB:
CT%								;^@
CT%	COMM	,CM.NAI!CM.ATS		,<CS.STR>		;^A
CT%	CCOND	,CM.0AI!CM.2AI		,<CS.SY1>		;^B
CT%								;^C
CT%	CALDDT							;^D
CT%	FFEED	,CM.2AI						;^E
CT%	FITER	,CM.2AI						;^F
CT%	DECDMP							;^G
CT%	GTIME							;^H
CT%	TAB	,CM.NAI!CM.MOD		,<CS.INS>		;^I
CT%	CFLUSH							;^J
CT%								;^K
CT%	CTRLL							;^L
CT%	CFLUSH							;^M
CT%	ALTFLW	,CM.2AI						;^N
CT%	CTOG	,CM.NAI			,<CS.QRG>		;^O
CT%								;^P
CT%	QCVAL	,CM.ATS			,<CS.QRG>		;^Q
CT%	RNGE	,CM.0AI						;^R
CT%								;^S
CT%	SPTYI							;^T
CT%								;^U
CT%	VRSN	,CM.ATS						;^V
CT%								;^W
CT%	SSERCH	,CM.2AI						;^X
CT%	ARRY	,CM.ATS						;^Y
CT%								;^Z
CT%	CFLUSH							;ESC
CT%								;^\
CT%	HLFWRD	,CM.0AI!CM.ATS					;^]
CT%	CNTRUP	,CM.NAI			,<CS.SY1>		;^^
CT%	DUJSI	,CM.0AI						;^_
   UPALEN=.-CMDTAB	;END OF ^ COMMAND RANGE

CT%	SPACC	,CM.OPR						;SPACE
CT%	EXCLAM	,CM.EXE						;!
CT%	DQUOTE	,CM.2AI!CM.EXE		,<CS.SY1>		;"
CT%	COR	,CM.OPR!CM.0AI					;#
CT%	CFLUSH							;$ DOLLARSIGN
CT%	PCNT	,NOFLG			,<CS.QRG>		;%
CT%	CAND	,CM.OPR!CM.0AI					;&
CT%	APOST	,CM.EXE						;'
CT%	OPEN							;(
CT%	CLOSE							;)
CT%	TIMES	,CM.OPR!CM.0AI					;*
CT%	PLUS	,CM.OPR						;+
CT%	COMMA	,CM.2AI!CM.0AI					;,
CT%	MINUS	,CM.OPR						;-
CT%	PNT							;.
CT%	SLASH	,CM.OPR!CM.0AI					;/
CT%	CDNUM	,CM.ATS			,<CS.DIG>		;0
CT%	CDNUM	,CM.ATS			,<CS.DIG>		;1
CT%	CDNUM	,CM.ATS			,<CS.DIG>		;2
CT%	CDNUM	,CM.ATS			,<CS.DIG>		;3
CT%	CDNUM	,CM.ATS			,<CS.DIG>		;4
CT%	CDNUM	,CM.ATS			,<CS.DIG>		;5
CT%	CDNUM	,CM.ATS			,<CS.DIG>		;6
CT%	CDNUM	,CM.ATS			,<CS.DIG>		;7
CT%	CDNUM	,CM.ATS			,<CS.DIG>		;8
CT%	CDNUM	,CM.ATS			,<CS.DIG>		;9
CT%	PRE.CL	,CM.PRE						;:
CT%	PRE.SM	,CM.PRE						;;
CT%	LSSTH	,CM.EXE						;LEFT ANGLE
CT%	PRNT	,CM.0AI						;=
CT%	GRTH	,CM.EXE						;RIGHT ANGLE
CT%	QUESTN							;?
CT%	PRE.AT	,CM.PRE						;@
CT%	ACMD							;A
CT%	ZERINA							;B
CT%	CHARAC	,CM.2AI						;C
CT%	DELETE	,CM.2AI!CM.MOD					;D
CT%	ELINE	,CM.2AI						;E
CT%								;F
CT%	QGET	,CM.MOD			,<CS.QRG>		;G
CT%	HOLE	,CM.2AI						;H
CT%	INSERT	,CM.2AI!CM.ATS!CM.MOD	,<CS.INS>		;I
CT%	JMP	,CM.2AI!CM.ATS					;J
CT%	KILL	,CM.MOD						;K
CT%	LINE	,CM.2AI						;L
CT%	MAC	,NOFLG			,<CS.QRG>		;M
CT%	SERCHP	,CM.2AI!CM.ATS!CM.MOD	,<CS.SRS>		;N
CT%	OG	,NOFLG			,<CS.STR>		;O
CT%	PUNCH	,CM.MOD						;P
CT%	QREG	,NOFLG			,<CS.QRG>		;Q
CT%	REPLAC	,CM.2AI!CM.ATS!CM.MOD	,<CS.SRS,CS.INS>	;R
CT%	SERCH	,CM.2AI!CM.ATS		,<CS.SRS>		;S
CT%	TYPE							;T
CT%	USE	,CM.2AI!CM.0AI		,<CS.QRG>		;U
CT%	VIEW							;V
CT%	WRDCOM	,NOFLG			,<CS.STR>		;W
CT%	X	,CM.MOD!CM.ATS		,<CS.QRG>		;X
CT%	DYANK	,CM.2AI!CM.MOD					;Y
CT%	END1							;Z
CT%	OPENB	,NOFLG			,<CS.QRG>		;[
CT%	BAKSL							;\
CT%	CLOSEB	,NOFLG			,<CS.QRG>		;]
CT%	PRE.UP	,CM.PRE						;^
CT%	LARR	,CM.ATS!CM.2AI!CM.MOD	,<CS.SRS>		;_

   CMDLEN=.-CMDTAB	;LENGTH OF COMMAND TABLE
;SEMTAB is just like CMDTAB, for SEMICOLON commands

SEMTAB:
CT%	TCOND							; ;ESCAPE
CT%								; ;^\
CT%								; ;^]
CT%								; ;^^
CT%								; ;^_
CT%	TCOND							; ;SPACE 
CT%								; ;!
CT%								; ;"
CT%								; ;#
CT%								; ;$
CT%								; ;%
CT%	TXZNC	,CM.0AI!CM.2AI		,<CS.QRG>		; ;&
CT%	UPLOWC	,CM.0AI!CM.2AI					; ;'
CT%								; ;(
CT%								; ;)
CT%								; ;*
CT%								; ;+
CT%								; ;,
CT%								; ;-
CT%								; ;.
CT%	REMDIV	,CM.NAI						; ;/
CT%								; ;0
CT%								; ;1
CT%								; ;2
CT%								; ;3
CT%								; ;4
CT%								; ;5
CT%								; ;6
CT%								; ;7
CT%								; ;8
CT%								; ;9
CT%								; ;:
CT%								; ;;
CT%								; ;LEFT ANG
CT%	UDFFLS	,CM.2AI			,<CS.STR>		; ;=
CT%								; ;RIGHT ANG
CT%								; ;?
CT%	UDFFL	,CM.2AI			,<CS.QRG>		; ;@
CT%								; ;A
CT%								; ;B
CT%	SEMIC							; ;C
CT%	DNLD							; ;D
CT%	DOFILE	,NOFLG			,<CS.INS>		; ;E
CT%								; ;F
CT%	GETOB	,CM.MOD						; ;G
CT%	DECDMP							; ;H
CT%	OVWR	,CM.0AI!CM.2AI!CM.MOD				; ;I
CT%								; ;J
CT%								; ;K
CT%	CNLINE	,CM.0AI!CM.1AI					; ;L
CT%	MFILE	,CM.2AI			,<CS.QRG,CS.INS>	; ;M
CT%	PIKNUM	,CM.2AI						; ;N
CT%								; ;O
CT%	PICKUP							; ;P
CT%								; ;Q
CT%	OPNRD	,NOFLG			,<CS.INS>		; ;R
CT%	BSAVE							; ;S
CT%	TPREG	,CM.2AI						; ;T
CT%	UNLD							; ;U
CT%								; ;V
CT%	OPNWR	,NOFLG			,<CS.INS>		; ;W
CT%	EXCOM							; ;X
CT%	YLOAD	,CM.NAI!CM.MOD					; ;Y
CT%								; ;Z
CT%	SOPENB	,CM.0AI!CM.2AI					; ;[
CT%	RAND	,CM.0AI						; ;\
CT%	SCLOSB	,CM.NAI						; ;]
   SEMLEN=.-SEMTAB

	IF2, <PURGE CTR%,CT%>
	PURGE %TMP,%%TMP
ZEROW:				;Guaranteed zero word.
ARGTAB:	0			;0 offset to ARGTAB is meaningless.
ARGTA1:	LIT			;the macros defined strings in literals -
				; punch them out as an array at ARGTAB
;START HERE FOR DEBUGGING.  THIS ENTRY MAKES TV THINK YOU STARTED
;IT WITH THE COMMAND "TV FOO.BAR". NOT NORMALLY USED.

 IFN FTDEB,<

DEBUG:	HRROI	A,[ASCIZ /TV FOO.BAR
/]
	RSCAN%
	 JSHLT
	SETOM	VIRGIN		;SO RSCAN STUFF HAPPENS ON RESTART
	JRST	TECO
>

;STARTUP TIME INITIALIZATION

TECO:	RESET%
	XMOVEI	A,20
	TLNE	A,-1			;ARE WE IN A NON-ZERO SECTION?
	JRST	[HRROI A,[ASCIZ/
?TV does not run in non-zero sections;  those sections are reserved for data./]
	     PSOUT%
	     HALTF%
	     JRST	TECO]		;YES, DIE NOW
;**;[512] At TECO: +1L, Inserted 4 lines                    SM  9-Jul-82
	MOVE	A,[SIXBIT/TV/]		;[512] SET UP FOR SETSN
	MOVE	B,A			;[512] BOTH NAMES TO "TV"
	SETSN%				;[512] SET IT
	 ERJMP	.+1			;[512] IGNORE NON-EXISTANT ERROR RETURN
	AOS	VIRGIN			;VIRGIN 0 MEANS PROGRAM HASN'T BEEN RUN
	MOVE	A,[XWD FIRSTV,FIRSTV+1]
	SETZM	FIRSTV			;CLEAR VARIABLES AREA
	BLT	A,TOP

;SET UP LUUO DISPATCH FOR SECTION 0 AND ALL OTHER SECTIONS

	MOVE	A,[CALL S0UUOH]		;SETUP SECTION 0 UUO DISPATCH
	MOVEM	A,.JB41

;MISCELLANEOUS SET UP

	MOVE	P,[XWD -LPDL,PDL-1]
	MOVEI	A,"!"
	MOVEM	A,LASTCH		;DISPLAY CONTINUATION CHARACTER
	MOVSI	A,(ASCII "/\")
	MOVEM	A,PTRCHR		;WHAT POINTER LOOKS LIKE ON SCREEN
	MOVSI	B,(1B0)			;SET BREAKMASK FOR TERMINATOR
	MOVN	A,TERMIN
	LSH	B,(A)
	MOVEM	B,BRKLST
	SETOM	BAKFLG			;DEFAULT IS TO SAVE COMMAND STRINGS.
	SETOM	LPM			;GUARANTEE INITIAL PMAP
	SETOM	LPM2
	MOVX	A,RD%JFN+RD%BBG+RD%BEG
	 	;JFNS AND DESTINATION POINTER GIVEN, RETURN WHEN EVERYTHING DELETED
	MOVEM	A,RDFLG			;STORE FLAGS
	MOVEI	A,RDEND-RDCWB		;CALCULATE SIZE OF TEXTI BLOCK
	MOVEM	A,RDCWB
	MOVEI	A,BRKLST
	MOVEM	A,RDBRK
	MOVSI	A,(<RET>)
	MOVEM	A,TRACS
	MOVEI	A,CBUF+200		;ADR OF TEXT BUFFER
	IMULI	A,5			;CHR ADDR OF BEGINNING
	MOVEM	A,QRBUF
	MOVEM	A,EQRBUF		;SETUP END OF QREG BUF
	MOVEI	A,MTBUF0		;SETUP MAIN TEXT BUFFER ADDRESSES
	IMULI	A,5
	MOVEM	A,BEG
	MOVEM	A,PT
	MOVEM	A,ZEE
	MOVE	I,BEG
	MOVEM	I,SCRNPT		;FOR DISPLAY ROUTINE
	MOVEI	A,CBUF+77
	MOVEM	A,CBUFH
	MOVEI	A,CBUF
	MOVEM	A,LSTCB
	MOVEM	A,LSTCE
	MOVEI	FF,0			;CLEAR FLAG REGISTER
;**;[503] At TECO: +53L, Deleted 1 line         	SM	24-Mar-82
	MOVEI	A,.PRIOU		;GET CONTROL SETTINGS BEFORE THEY GET CHANGED
	RFCOC%				;GET CONTROL CHARACTER SETTINGS
	TRO	C,600000		;MAKE SURE ALTMODE ECHOES AS $
	DMOVEM	B,REGCWD		;REMEMBER SETTING
	MOVSI	A,(CR%CAP+CR%ACS)
	XMOVEI	B,[SAVPDL]-17		;LOAD SAVER'S AC17 WITH STACK ADDRESS
	CFORK%				;COMMAND SAVER WITH INITIALIZED STACK POINTER
	 JSHLT
	SETOM	SDONEF			;ASSUME SAVER IS INITIALLY "DONE"
	MOVEM	A,SAVFRK		;REMEMBER FORK HANDLE
	SETZM	SAVJFN			;SAY NO JFN YET ON BACKUP FILE
	XMOVEI	A,SAVBEG		;GET ADDRESS OF START OF WINDOW
	LSH	A,-11			;CONVERT TO PROCESS PAGE #
	HRLI	A,.FHSLF		;SOURCE FORK HANDLE ,, PAGE #
	MOVEI	B,SAVBEG_-9		;CREATE WINDOW FROM SAVER FORK TO US
	HRL	B,SAVFRK
	MOVE	C,[PM%CNT+PM%RD+PM%WR+PM%EX+<SAVEND-SAVBEG>_-9+2]
	PMAP%
	CALL	HK			;KILL THE ENTIRE BUFFER
	MOVEI	A,^D50			;DEFAULT NUMBER OF CHARACTERS BETWEEN SAVES
	MOVEM	A,BAKLEN
	SETZM	BBLEN			;NOTHING IN BACKUP BUFFER YET
	SETZM	OBBLEN
	MOVE	A,[POINT 7,BBUF1]	;INITIALIZE POINTER TO BACKUP BUFFER
	MOVEM	A,BBPTR
	MOVEM	A,BBUFX
	SETZM	WTOGGL			;START WITH FIRST WINDOW
	SETO	A,			;GET INFO ABOUT OUR JOB.
	HRROI	B,P2			;GET ONE PIECE OF INFORMATION INTO "p2"
	MOVEI	C,.JILNO		;LOGGED-IN DIRECTORY NUMBER
	GETJI%				;GET LOGGED-IN DIR NUMBER INTO p2
	 JSHLT
GDS:	HRROI	A,DIRECT		;PUT DIRECTORY NAME IN "DIRECT"
	MOVE	B,P2			;b HOLDS DIRECTORY NUMBER
	DIRST%				;GET DIRECTORY NAME FROM MONITOR
	 JSHLT
	CALL	SETIO			;RESET IO
	MOVEI	A,.PRIOU		;USE PRIMARY OUTPUT
	MOVEM	A,TTYOUT		;SAVE CHANNEL
	CALL	CMDINI			;INITIALIZE FOR COMND JSYS
	CALL	RESCAN			;MAKE RESCANNED DATA AVAILABLE
	DMOVE	A,[EXP INIFIL,<-1,,DIRECT>]
	GTJFN%				;TRY TO ACCESS <USER>TV.INI
	JRST	NOINI			;ASSUME NONE
	MOVE	B,[7B5!OF%RD]
	OPENF%				;OPEN IT FOR READING
	JRST	NOINI			;COULDN'T, SO ASSUME NONE EXISTS
	MOVEM	A,INIJFN		;REMEMBER JFN OF INI FILE
NOINI:	CALL	SYSMOD			;GET SYSTEM'S TERMINAL CHARACTERISTICS
	CALL	SETMOD			;SET UP CTRL/CHARACTER ECHOING
	SKIPE	SCRNF			;LEAVE WINDOW SIZE 0 UNLESS TERMINAL IS A SCREEN
	CALL	WINSTN			;SET WINDOW SIZE UP
;(ONLY HERE, SO AFTER REENTER, CUSTOM WINDOW SIZE DOESN'T GET CLOBBERED)
	JRST	GOX


;THE FOLLOWING CODE SUPPORTS THE OPTION OF THE USER INITIATING THIS
;PROGRAM WITH AN EXEC COMMAND LINE LOOKING LIKE:
;
;		@NAME FILE.EXT
;
;WHERE "NAME" IS WHATEVER NAME THIS VERSION OF TECO IS SAVED AS AND
;"FILE.EXT" IS THE FILE THE USER WISHES TO EDIT.  THE EFFECT IS JUST
;AS THOUGH THE TYPESCRIPT HAD ORIGINALLY BEEN:
;
;		@NAME
;		*;Y$
;		INPUT FILE:	FILE.EXT
;

RESCAN:	CALL	RESC1			;DO MOST OF THE WORK
	 TRNA				;IF NOT RESCANNING, THROW AWAY REST OF LINE
	RET
	CALL	RSCNT			;NO, SEE HOW MANY CHARACTERS LEFT TO READ
	JUMPE	A,CPOPJ			;JUST RETURN IF NONE
	MOVN	C,A			;THAT MANY TO READ
	MOVEI	A,.PRIIN		;READ FROM PRIMARY
	SETZ	B,			;DON'T REALLY READ THEM TO ANYWHERE
	SIN%				;THROW THEM AWAY
	RET

;ROUTINE TO RETURN IN A NUMBER OF RSCAN CHARACTERS LEFT TO READ

RSCNT:	MOVEI	A,.RSCNT		;CODE FOR GETTING NUMBER
	RSCAN%				;ASK SYSTEM WHAT NUMBER IS
	 MOVEI	A,0			;SAY 0 IF ERROR
	RET

RESC1:	STKVAR	<CREAF>
 IFN FTRSC,<				;;DO RESCANS ON RESTARTS?
	SKIPE	VIRGIN
	RET >			;IF PROGRAM IS RESTARTED, NO MESSING ALLOWED
	SETZM	CREAF		;NOT CREATE COMMAND YET
	SETZB	A,ENTFLG	;NOT SURE HOW WE GOT HERE YET
	RSCAN%		;CAUSE ORIGINAL COMMAND LINE TO BE AVAILABLE AS INPUT
	 RET			;COULDN'T EVEN DO THAT!
	CALL	RSCNT		;GET NUMBER OF CHARACTERS AVAILABLE
	JUMPE	A,CPOPJ		;JUMP IF NONE
	MOVEI	A,0		;NO PROMPT
	CALL	READY		;INITIALIZE FOR COMND JSYS
	MOVEI	A,[CMFLDX]	;READ PROGRAM NAME AS FIELD
	CALL	RFIELD		;READ IT INTO ATOM BUFFER
	 RET			;IF CAN'T, GIVE UP
	GETNM%			;FIND OUT WHAT PROGRAM NAME WE'RE RUNNING AS
	MOVE	C,A		;PUT OUT SIXBIT NAME IN c
	MOVE	P1,[POINT 6,C]	;AND A BYTE POINTER TO IT IN p1
	MOVE	P2,[POINT 7,ATMBFR] ;PREPARE TO READ CHARACTERS FROM PROGRAM NAME
RSCANR:	CAMN	P1,[600,,C]	;THEY AGREED BUT WEREN'T SPACES, SO NOW
	JRST	RSCAN2		;IF ENTIRE NAME HAS MATCHED, STOP COMPARING
	ILDB	B,P1		;PICK UP A LETTER FROM OUR NAME
	JUMPE	B,RSCAN2	;JUMP IF NAME MATCHES
	ILDB	CH,P2		;READ A CHARACTER OF THE COMMAND LINE
	LOAD	CH,UPRCOD,(CH)	;DO ALL COMPARISONS IN UPPER CASE
	CAIN	CH,"A"-'A'(B)	;YES?
	JRST	RSCANR		;CONTINUE COMPARING NAME
	MOVEI	P1,1		;IF "EDIT" WE WILL STORE 1 IN ENTFLG
	HRROI	A,ATMBFR	;NAME DIFFERED, LOOK AT COMMAND LINE AGAIN
	HRROI	B,[ASCIZ /EDIT/]
	STCMP%			;IS IT AN "EDIT" COMMAND?
	JUMPE	A,RSCAN2		;YES, O.K.
	HRROI	A,ATMBFR
	HRROI	B,[ASCIZ /PERUSE/]
	STCMP%
	JUMPE	A,RSCANE		;PERUSE?
	HRROI	A,ATMBFR		;NOT "EDIT", MAYBE "CREATE"
	HRROI	B,[ASCIZ /CREATE/]
	STCMP%
	JUMPE	A,[SETOB P1,CREAF	;YES, "CREATE", AND ENTFLG WILL BE -1
		 JRST RSCAN2]
	RET		;NOT RECOGNIZABLE COMMAND, DON'T USE RESCANNED DATA

RSCANE:	TXO	FF,PERUS
RSCAN2:	MOVEM	P1,ENTFLG		;SO USER CAN GET THE WAY WE ENTERED
	MOVEI	A,[NOISEX (FILE)]
	CALL	RFIELD		;CHECK FOR NOISE WORDS
	 RET			;DON'T DO RESCANNING IF FAILS
	CALL	CONFRM		;see if end of line
	 TRNA			;NO END OF LINE
	RET			;END OF LINE, SO NO FILESPEC COMING
	SKIPE	CREAF		;DOING CREATE COMMAND?
	JRST	RSOUT		;YES, PARSE OUTPUT SPEC
	MOVEI	A,[CMIFIX]	;read input file
	CALL	READFL		;read filespec from terminal
	SKIPE	GTJERR		;DID WE GET A SUCCESSFUL INPUT SPEC?
	JRST	RS3		;NO, SO DON'T PARSE OUTPUT SPEC
	MOVEI	A,[NOISEX (OUTPUT AS)]
	CALL	RFIELD		;PERHAPS AN OUTPUT SPEC SUPPLIED
	 JRST	RS3		;NO
	MOVEI	A,[CMOFIX]	;READ OUTPUT SPEC
	CALL	RFIELD
	 JRST	RS3		;DON'T OPEN OUTPUT FILE IF CAN'T READ NAME
RS3A:	MOVEM	B,CREJFN		;REMEMBER JFN FOR CREATE COMMAND
RS3:	SKIPN	CREAF		;NO RESCANNED DATA AVAILABLE IF CREATE COMMAND
	TXO	FF,RSCNF2		;NOTE THAT RESCANNED DATA AVAILABLE
	JRST	CPOPJ1		;SKIP TO MARK THAT COMMAND LINE WAS GIVEN
RSOUT:	MOVEI	A,[CMOFIX]
	CALL	READFL
	JRST	RS3A

;ROUTINE TO INITIALIZE FOR COMMAND LINE.  IT TAKES EITHER 0 OR A BYTE POINTER
;IN A TO PROMPT STRING.

READY:	CAIN	A,0		;ANY PROMPT?
	HRROI	A,ZEROW		;NO, POINT TO A NULL STRING
	MOVEM	A,SBK+.CMRTY	;SAVE POINTER TO PROMPT
	POP	P,REPARA		;REMEMBER REPARSE ADDRESS
	DMOVEM	0,CMDACS+0	;SAVE AC'S
	MOVE	1,[2,,CMDACS+2]
	BLT	1,CMDACS+17
	MOVE	A,[PDL,,CMDPDL]	;PREPARE TO SAVE ENTIRE STACK
	HRRZI	B,-PDL(P)	;FIGURE HOW MANY WORDS TO SAVE (MINUS 1)
	BLT	A,CMDPDL(B)		;SAVE THE STACK
	PUSH	P,REPARA		;MAKE STACK LIKE IT WAS
	HRL	A,TYIJFN		;SOURCE OF COMMAND
	HRRI	A,.PRIOU		;REGULAR PRIMARY OUTPUT
	MOVEM	A,SBK+.CMIOJ
	MOVEI	A,[CMINIX]	;TYPE PROMPT
	CALL	RFIELD
	 JFCL			;SHOULDN'T FAIL
	RET			;RETURN TO CALLER

;COME HERE IF REPARSE IS NEEDED (BECAUSE USER EDITED INTO PARSED STUFF)

REPARS:	MOVE	P,CMDACS+P		;RESTORE P FIRST
	MOVE	A,[CMDPDL,,PDL]	;PREPARE TO RESTORE STACK
	BLT	A,(P)		;RESTORE THE STACK
	MOVSI	16,CMDACS
	BLT	16,16		;RESTORE AC'S
	HRRZ	16,REPARA		;GET LOCAL ADDRESS TO RETURN TO
	JRST	(16)		;RETURN TO BEGINNING OF COMMAND LINE

;ROUTINE WHICH CHECKS FOR LINE CONFIRMATION (CR OR LF) AND SKIPS
;IF SO

CONFRM:	MOVEI	A,[CMCFMX]	;CHECK FOR END OF LINE
	CALL	RFIELD
	 RET			;no skip if no confirmation
	JRST	CPOPJ1

;READ A FIELD ROUTINE.  GIVE IT ADDRESS OF FUNCTION BLOCK IN A.
;IT SKIPS IFF COMND GIVES A SUCCESSFUL RETURN.  A AND B WILL HAVE
;RESULT OF COMND JSYS IN THEM.

RFIELD:	STKVAR	<CFCN>
	SETOM	WINFLG		;IF RECEIVING INPUT, ASSUME USER HAS SEEN ALL
	MOVEM	A,CFCN		;SAVE FUNCTION
RF1:	MOVE	B,CFCN		;PUT FUNCTION BLOCK POINTER IN B
	MOVEI	A,SBK		;POINTER TO STATE BLOCK IN A
	COMND%			;READ FIELD OF COMND
	 ERJMP	CMDERR		;ERROR IN COMND JSYS
	TXNE	A,CM%NOP		;DID COMMAND PARSE CORRECTLY?
	 RET			;NO, SO SINGLE RETURN
	JRST	CPOPJ1		;YES, SO SKIP RETURN

CMDERR:	CALL	%GETER		;GET REASON FOR ERROR
	HRRZ	B,A		;LEAVE ERROR CODE IN B
	CAIN	B,IOX4		;END OF FILE?
	JRST	CMDE1			;YES, GO HANDLE IT
	TXO	A,CM%NOP		;DESIGNATE NO PARSE
	RET				;RETURN NON-SKIP

CMDE1:	CALL	TYIPOP			;GET BACK TO LAST INPUT STREAM
	JRST	RF1			;RETRY COMND JSYS

;ROUTINE TO RETURN LAST ERROR FOR OURSELF IN A.

%GETER:	MOVEI	A,.FHSLF		;OURSELF
	GETER%				;GET ERROR CODE
	HRRZ	A,B			;RETURN CODE IN A
	RET

;COMND JSYS INITIALIZATION ROUTINE.  CALL ONLY ONCE AT BEGINNING OF
;PROGRAM.

CMDINI:	MOVEI	A,REPARS		;REPARSE ADDRESS
	MOVEM	A,SBK+.CMFLG
	HRROI	A,CMDBFR		;POINTER TO COMMAND BUFFER
	MOVEM	A,SBK+.CMBFP
	MOVEM	A,SBK+.CMPTR		;POINTER TO NEXT FIELD
	MOVEI	A,CMDBLN*5		;ROOM FOR TYPIN
	MOVEM	A,SBK+.CMCNT
	SETZM	SBK+.CMINC		;NO UNPARSED CHARACTERS YET
	HRROI	A,ATMBFR		;POINTER TO ATOM BUFFER
	MOVEM	A,SBK+.CMABP
	MOVEI	A,ATMBLN*5
	MOVEM	A,SBK+.CMABC		;ROOM IN ATOM BUFFER
	MOVEI	A,CJFNBK		;POINTER TO JFN BLOCK
	MOVEM	A,SBK+.CMGJB
	RET

;CALL THE FOLLOWING TO RESET TERMINAL IO (AT STARTUP AND REENTER)

SETIO:	MOVEI	A,.PRIIN
	MOVEM	A,TYIPDL		;PUSH TTY INPUT ONTO TYPIN STACK
	MOVEM	A,TYIJFN		;INITIAL TYPIN JFN IS TERMINAL
	MOVE	A,[1-TYILEN,,TYIPDL] 	;INITIALIZE IO STACK
	MOVEM	A,TYIP
	SETOM	TERIO			;ASSUME INITIAL INPUT IS A TERMINAL
	RET
;CALL HERE DURING STARTUP TO ENABLE CTRL/C TRAPPING.

ENACC:	MOVEI	A,.FHSLF		;OURSELF
	RPCAP%				;GET CURRENT CAPABILITIES
	TXO	C,SC%CTC
	EPCAP%				;ENABLE CTRL/C TRAPPING
	 ERJMP	.+1			;HMMM...
	MOVE	A,[3,,2]		;CTRL/C TRAPPING IS ON CHANNEL 2
	ATI%				;TRY TO ENABLE CTRL/C
	 ERJMP	.+1			;QUIETLY FAIL IF USER SAID "SET NO CONTROL-C"
	RET

FTUVAL:	FT$VAL				;STORE THE OPTIONS FLAGS
FTESEC:	EXP	MAXSEC			;STORE THE NUMBER OF SECTIONS ALLOWED

REE:	MOVX	A,PC%USR
	MOVEI	B,REE0			;GET TO SECT 0 ALWAYS
	XJRSTF	A			;GET TO REE0 IN PROPER SECTION
	 	;..

REE0:	MOVE	P,[XWD -LPDL,PDL-1] 	;INITIALIZE PUSHDOWN LIST
	TXZ	FF,RSCANF+RSCNF2	;NO MORE RESCANNING ON REENTER
	CALL	SETIO			;ALWAYS RESET IO ON REENTER
	CALL	SYSMOD			;GET SYSTEM'S TERMINAL MODES
	CALL	SETMOD			;SET UP CTRL/CHARACTER ECHOING
	SETZM	INIJFN			;NO LONGER DOING INITIALIZATION
GOX:	SETZM	UPDATF			;NOT DOING WUPDATE YET
	SETZM	QUOJFN			;NO JFN CURRENTLY BEING OUTPUT TO
	CALL	CLRSCN			;MAYBE CLEAR THE SCREEN
	SETOM	WINFLG			;SO DISPLAY HAPPENS ON REENTER
	CALL	XSIR			;SET UP LEVTAB, CHNTAB, AND DO SIR
	MOVEI	A,.FHSLF
	CIS%				;CLEAR PENDING INTERRUPTS
	MOVE	2,[17B3+1B11+1B12]	;SELECT CHANNELS 0,1,2,11,12
	AIC%				;ACTIVATE CHANNELS
	MOVSI	1,.TICCG		;CONTROL-G TO CHANNEL 0
	ATI%
	MOVE	1,[.TICCO,,1]		;CONTROL-O TO CHANNEL 1
	ATI%
	CALL	ENACC			;ENABLE CTRL/C TRAPPING
GO:	MOVE	P,[XWD -LPDL,PDL-1] 	;INITIALIZE PUSHDOWN LIST
;**;[503] At GO: +1L, Deleted 2 lines           	SM	24-Mar-82
	TXZ	FF,-1-TRACEF-FORM-UREAD-UWRITE-RSCNF2-PERUS-CTOFLG
	TXNE	FF,DUMPF		;INTERRUPTED OUT OF LARGE OUTPUT?
	CALL	FIXOUT			;YES
	MOVEI	A,.FHSLF
	EIR%				;MAKE SURE INTERRUPTS ARE ON
	MOVEI	A,^D10
	MOVEM	A,RADIX			;INITIALIZE TYPEOUT TO DECIMAL
	SETZM	ABORTF			;CLEAR INTERRUPT FLAGS
	SETZM	LISNF
	CALL	UPDATE			;UPDATE THE SCREEN
	SETZM	LEV
	MOVE	A,[IOWD LPF,PFL]	;MAKE STACK POINTER
	MOVEM	A,PF			;INITIALIZE QREG STACK
	JRST	CLIS

;THIS ROUTINE CALLED IF INTERRUPT OR REENTER FROM A ;U-CLASS COMMAND THAT
;WAS IN THE MIDDLE OF WRITING THE FILE

FIXOUT:	SKIPGE	A,OUTJFN
	JRST	FIX1			;NO OUTPUT!  (OPENF IN OPNOUT PROBABLY FAILED)
	TXO	A,CZ%ABT		;FLUSH THE OUTPUT OPERATION
	CLOSF%
	 ERJMP	.+1			;IGNORE FAILURE
FIX1:	TXZ	FF,DUMPF!UWRITE		;FORGET THAT FILE WAS OPEN
	RET

;ROUTINE TO SET UP CHNTAB AND LEVTAB, THEN DO SIR JSYS

;**;[523] At XSIR:, Replaced 28 lines with 4                SM 19-May-83
XSIR:	MOVEI	A,.FHSLF		;[523] JUST DO SIR JSYS
	MOVE	B,[LEVTAB,,CHNTAB]	;[523] GET TABLE ADDRESSES
	SIR%				;[523] COMMUNICATE THEM TO THE MONITOR
	RET				;[523] DONE
;Extended buffer code
;This implementation was suggested by God. Please direct inquiries
; to Him.

	SM%RWX==PM%RWX			;ACCESS WANTED TO SECTIONS

;This code will not work on a machine without extended addressing.

	CDESEC=1			;SECTION THE CODE AND DATA START IN
	FDGSEC=MAXSEC+CDESEC		;FDGSEC IS WHERE WE GO TO CREATE XBLT HANDLER


 IFG MAXSEC,<			;IF turned on, a lot of code is added.

	IFG FDGSEC-37, FOAD <Unacceptable values for CDESEC and MAXSEC>

CDEL:	TDZA	A,A			;TELL THE CODE TO KILL A PIECE
CIN:	SETO	A,			;TELL THE CODE TO READ A PIECE
	SKIPN	MSECF			;HAVE WE DONE SAVES YET?
	JRST	EXTQE			;NO, SO WE CAN'T FIND ANYTHING
	MOVEM	A,SYL			;SAVE FUNCTION CODE FOR A SEC...
	MOVX	A,.FHSLF		;MUST DISABLE INTERRUPTS SO THEY DONT HAPPEN..
	DIR%				;DURING NON-0 SECTION CODE
;From this point, errors must leave via RETCPY (to turn interrupt code back on)
	MOVE	A,SYL			;GET IT BACK
	TXNE	FF,ARG			;ANY ARGS?
	CAIN	C,0			;OR ARG OF ZERO?
	SETOM	FARG			;DEFAULT BUFFER NAME IS -1
	JRST	GOSAV3			;OK

COUT:	TXNE	FF,ARG			;ANY ARG?
	CAIN	C,0			;OR ARG OF 0?
	SETOM	FARG			;DEFAULT BUFFER NAME IS -1
	MOVX	A,.FHSLF		;MUST TURN OFF INTERRUPTS FOR THIS
	DIR%				;OFF...
	SKIPE	MSECF			;DONE ANY MULTIPLE SECTION STUFF?
	JRST	GOSAVS			;YES, SO SECTION CDESEC IS SET UP
	 	;..

;This is "once only" code. It is done on the first call to COUT only
; (and calls to CDEL or CIN return errors if COUT was never called.)
;At the end, MSECF is set nonzero.

	MOVSI	A,.FHSLF		;WE NEED TO GO NON-0 TO GO THIS
	MOVE	B,[.FHSLF,,FDGSEC] 	;.. USE A FAR OUT SECTION TO SET UP,
	MOVX	C,SM%RWX+SM%IND+1 	;WITH ALL ACCESSES, 1 SECT ONLY
	SMAP%				;JUST LIKE SECTION 0
	 ERJMP	SMAPQE
	SETZ	A,			;NOW CREATE SECTIONS CDESEC ON UP
	MOVE	B,[.FHSLF,,CDESEC] 	;..
	MOVX	C,SM%RWX+MAXSEC		;VIRGIN WITH ALL ACCESSES
	SMAP%
	 ERJMP	SMAPQE			;SNH
	XJRSTF	[PC%USR
		 FDGSEC,,COUATL] 	;INTO CODE IN SECTION FDGSEC FOR XBLTS

	 	;.. INTO SECTION FDGSEC ..

COUATL:	MOVEI	A,CDLEN1		;XBLT THE CODE FROM SECT 0 TO SEC CDESEC
	MOVEI	B,CDFDG
	MOVE	C,[CDESEC,,BTRF]
	EXTEND	A,[XBLT]		;..
	MOVEI	A,VAR1E-VAR1SP+1 	;NOW CLEAR THE CDESEC VARIABLE SPACE
	MOVE	B,[CDESEC,,VAR1SP]
	MOVE	C,[CDESEC,,VAR1SP+1]
	EXTEND	A,[XBLT]		;..
	MOVEI	A,2			;AND PUT IN THE 2 WORDS AT NPGES1
	MOVEI	B,[EXP <MAXSEC*1000*1000-NPGES1-1000>,0]
	MOVE	C,[NPGES1]
	EXTEND	A,[XBLT]		;THIS INITIALISES THE FREESPACE
	XJRSTF	[PC%USR
		 0,,COUT1]		;NOW BACK TO SECT 0

	 	;.. BACK TO SECTION 0 ..

COUT1:	SETO	A,			;NOW DESTROY SECTION FDGSEC, ITS NOT NEEDED
	MOVE	B,[.FHSLF,,FDGSEC]
	MOVEI	C,1
	SMAP%				;..
	 ERJMP	.+1			;IF CANT, DONT CARE
	SETOM	MSECF			;OK, WE HAVE THE UNIVERSE SET UP NOW

GOSAVS:	MOVE	A,ZEE			;GET CHARACTER POSITION OF END
	CALL	MOVHOL			;MOVE HOLE TO END SO NEEDN'T SAVE IT
	SETO	A,			;"INDEX" INTO LIST OF ITEMS WE ARE BUILDING
	MOVE	B,[BFINFO,,BFINFE] 	;THIS SAVES PT, ZEE, ETC.
	ADDI	A,1			;+1 FOR EACH ENTRY
	MOVEM	B,MVELST(A)		;FOR SAVING BUFFER
	MOVE	B,ZEE
	SUB	B,BEG			;HOW MANY CHARACTERS? (HOLE IS AT END)
	IDIVI	B,5			;MAKE THAT A WORD LENGTH
	ADDI	B,2			;AND DONT MISS ANYTHING
	HRLI	B,MTBUF0		;PUT BUFFER START IN LH, LEN IS IN RH
	ADDI	A,1			;NOW STORE THIS ENTRY
	MOVEM	B,MVELST(A)
	 	;..

;Come here to gate to code at BTRF in section CDESEC. The "name" of the
;info wanted is in FARG, and A contains one of the following:
; -1 to read the info down into section 0 (RETRIEve)
;  0 to quamp the info named by FARG (DELETe Block)
;  1 or more to save the information in section 0 referenced by the MVELST
;	array into an extended section. In this case, A is the highest
;	index valid in MVELST.

GOSAV3:	MOVE	C,FARG
	XJRSTF	[PC%USR
		 CDESEC,,BTRF]		;AND GO

SMAPQE:	MOVEI	P1,3			;THE ERROR CODE FOR NO SMAP MESSAGE
	 	;..			;AND FALL INTO RETCPY

;Back here after BTRF has run. Always come here (to reenable interrupts).
;P1 contains 0 if all ok, .GT. 0 is an error index.

RETCPY:	MOVX	A,.FHSLF
	EIR%				;REENABLE INTERRUPTS
	JUMPG	P1,EXTQE-1(P1)		;ERROR? GO TO CORRECT MESSAGE
	TXZN	FF,ARG2			;NO ERROR. IF 2 ARGS...
	JRST	CFLUSH			;NO
	MOVE	P1,SARG			;THEN CHECK FOR FLAGS
	TXNE	P1,1			;1B35=HK
	CALL	HK
	JRST	CFLUSH			;NO MORE FLAGS

EXTQE:	ERROR	<Cannot find that saved buffer>	;1
	ERROR	<Extended buffer space exhausted>;2
	ERROR	<SMAP not available>		;3

;Punch out Literals so there aren't problems with literals in wrong sections.
;Listing off for neatness
	XLIST
	LIT
	LIST

;The following code ends up in section CDESEC starting at BTRF. It lives there
;so the XBLTs between section 0 and other sections will work.
;The values of A and C are important here.

 BTRF==140

CDFDG:	PHASE	BTRF			;THIS CODE GOES TO SECTION 1
	MOVEM	C,NAMEI			;SAVE INFO NAME
	JUMPL	A,RETRIE		;A.LT.0 MEANS RETRIEVE INFO NAMED (C)
	JUMPE	A,DELETB		;A.EQ.0 MEANS DELETE IT
	MOVEM	A,NUMBI			;NUMBER OF WORDS IN "COMMAND LIST"
	ADDI	A,1			;CORRECT COUNT FOR XBLT
	MOVEI	B,MVELST		;ADDR, SECTION 0, OF "COMMAND LIST"
	XMOVEI	C,CMDLST		;TO COPY UP HERE FOR EASIER MANIPULATION
	EXTEND	A,[XBLT]		;..
	MOVE	C,NAMEI			;DOES THIS BLOCK EXIST NOW?
	SETO	D,			;USE TO POINT TO FIRST ZERO SLOT
	MOVSI	A,-NAMLEN		;GO AND SEE
NAMCHK:	MOVE	B,NAMLST(A)
	CAME	C,B			;MATCH?
	JRST	CCMPCK
	JSP	I,DELBA			;DELETE BLOCK REF'D BY WHERE(A)
	JRST	OPSLOT
CCMPCK:	JUMPN	B,NXTNAM		;IF A REAL NAME, SKIP 0 MEMORY
OPSLOT:	CAIGE	D,0			;HAVE WE SEEN A ZERO LOC BEFORE?
	HRRZ	D,A			;NO, REMEMBER THIS ONE
NXTNAM:	AOBJN	A,NAMCHK		;OK, LOOK NEXT
	JUMPL	D,SPACQE		;IF NO OPEN SLOTS, GO COMPLAIN
	MOVEM	D,SLOT			;REMEMBER CHOSEN SLOT
	SETZ	A,			;COUNT UP NUMBER OF WORDS NEEDED
	SKIPA	B,CMDLST		;IN THE ARRAY AT CMDLST
CNTWRD:	ADD	B,CMDLST(A)
	ADDI	B,3			;EACH SECTION NEEDS +3 WORDS
	CAMGE	A,NUMBI			;COUNTED UP COMMAND LIST?
	AOJA	A,CNTWRD		;NO, AGAIN FOR NEXT
	MOVEI	B,1(B)			;TOSS OUT LH, IT CONTAINS TRASH, ADD 1
	XMOVEI	C,FRELST
	MOVE	D,FRELST+1		;POINT TO FREELIST
NXTCHK:	CAMG	B,(D)			;ENOUGH SPACE HERE?
	JRST	OKSPAC			;YES, WE CAN GO
	MOVE	C,D			;WE NEED THIS SO AS TO UPDATE FRELST LATER
	SKIPE	D,1(D)			;ADVANCE THROUGH CHAIN
	JRST	NXTCHK
SPACQE:	MOVEI	P1,2			;OUT OF SLOTS
	JRST	LEAVE1
OKSPAC:	MOVE	A,SLOT			;GET SLOT CHOSEN
	MOVEM	D,WHERE(A)		;SAVE POINTER TO BLOCK
	MOVE	A,(D)			;HOW MANY HERE?
	SUB	A,B			;HOW MANY WILL BE LEFT?
	MOVE	P1,A			;COPY THE "SIZE LEFT"
	SUBI	P1,4			;SEE IF LESS THAN 4
	JUMPG	P1,NOTALL		;JUMP IF 4 OR MORE LEFT
	MOVE	A,1(D)			;GET THIS WORD'S "NEXT" POINTER
	MOVEM	A,1(C)			;AND HAVE THIS BLOCK SKIPPED OVER
	JRST	GBLK
NOTALL:	ADDB	B,1(C)			;ADJUST POINTER DOWN BY NUMBER USING
	MOVEM	A,(B)			;SAY HOW MANY AT NEW BLOCK
	MOVE	A,1(D)			;GET OLD BLOCK'S NEXT POINTER
	MOVEM	A,1(B)			;COPY IT HERE
GBLK:	MOVE	A,SLOT
	MOVE	D,WHERE(A)		;GET START BLOCK ADDRESS
	SETZ	A,			;TIME TO SCAN CMDLST
XBLTLP:	HRRZ	B,CMDLST(A)		;LENGTH IN B
	MOVEM	B,(D)			;ALSO AT TOP OF BLOCK
	MOVE	C,D
	ADDI	C,3			;POINT TO WHERE DATA WILL LAND
	MOVEM	C,1(D)			;TO MAKE FUTURE XBLTS EASY
	HLRZ	C,CMDLST(A)		;GET SECTION 0 ADDR OF INFO
	MOVEM	C,2(D)			;STORE THAT
	ADDI	D,3			;ADVANCE POINTER TO BEGINNING OF DATA RANGE
	EXTEND	B,[XBLT]		;THIS COPIES THE DATA
	SETZM	(D)			;POINTS TO WORD AFTER, MAKE 0 (TO MARK END)
	CAMGE	A,NUMBI			;DONE LIST?
	AOJA	A,XBLTLP
	MOVE	A,SLOT			;WHERE DOES THIS GO?
	MOVE	C,NAMEI
	MOVEM	C,NAMLST(A)		;STORE NAME IN THAT SLOT
LEAVOK:	SETZ	P1,			;0 = OK
LEAVE1:	XJRSTF	[PC%USR
		 0,,RETCPY]

DELETB:	MOVSI	A,-NAMLEN
	SETZ	I,			;STAYS 0 IF NO NAMLST ENTRY MATCHES
DELB1:	CAMN	C,NAMLST(A)
	JSP	I,DELBA			;DELETE BLOCK AT WHERE(A)
	AOBJN	A,DELB1
	JUMPN	I,LEAVOK		;NONZERO IF JSP EVER DONE
	TXNE	FF,COLONF		;DOES USER CARE IF NOT FOUND?
	JRST	LEAVOK			;COLON SEEN, HE DOESNT CARE
	JRST	NFNDQE			;HE CARES, SET UP TO GIVE ERROR

RETRIE:	MOVSI	A,-NAMLEN
SCANR:	CAMN	C,NAMLST(A)
	JRST	GOTBLK
	AOBJN	A,SCANR
NFNDQE:	MOVEI	P1,1
	JRST	LEAVE1
GOTBLK:	MOVE	C,WHERE(A)
GNXTB:	SKIPN	B,(C)			;IS THERE DATA HERE?
	JRST	LEAVOK
	DMOVE	C,1(C)			;NEATLY LOAD C & D FOR XBLT
	EXTEND	B,[XBLT]		;BONZAI!
 BONZAI=CDESEC,,.			;FOR FUN
	JRST	GNXTB			;GO SEE

DELBA:	DMOVEM	A,S1TMP			;SAVE A & B
	DMOVEM	C,S1TMP2		;AND C & D
	SETZM	NAMLST(A)		;KILL THE NAME
	MOVE	D,WHERE(A)		;GET WHERE IT IS
	MOVEM	D,WHRKIL		;IT WILL BE KILLED
	SETZ	B,			;READY TO COUNT UP SPACE
MSBLK:	SKIPN	A,(D)			;ANY DATA HERE?
	AOJA	B,GKILL			;NO, ACCOUNT FOR 0 WORD AND GO KILL
	ADDI	B,3(A)			;COUNT UP SPACE
	ADDI	D,3(A)			;ADVANCE POINTER OVER BLOCK
	JRST	MSBLK
GKILL:	MOVEM	B,SIZKIL		;SAVE SIZE TO BE ADDED TO FRELST CHAIN
	MOVE	D,WHRKIL		;WHERE DOES IT START?
	MOVEM	B,(D)			;FIRST WORD OF FREEBLOCK IS LENGTH
	XMOVEI	C,FRELST
	MOVE	D,FRELST+1		;GET ADDRESSES TO SCAN FRELST WITH
	MOVE	A,WHRKIL		;GET ADDRESS OF THIS BLOCK IN MEMORY
FPIFL:	CAMG	A,D			;ARE WE BELOW THE RIGHT PLACE?
	JRST	KILHRE
	MOVE	C,D			;TRAILING CHASER
	MOVE	D,1(D)			;GET THE NEXT ADDRESS
	JUMPN	D,FPIFL
KILHRE:	MOVE	A,1(C)
	MOVE	B,WHRKIL		;POINT TO BLOCK TO GO IN AGAIN
	MOVEM	A,1(B)			;SECOND WORD IS "WHERE NEXT"
	MOVEM	B,1(C)			;MAKE LAST BLOCK POINT TO NEW ONE

	MOVE	A,WHRKIL		;NOW SEE IF PMAPING CAN FREE PAGES UP
	MOVE	B,A			;THIS IS MERELY TO REDUCE SWAPPING SPACE STRAIN
	ADD	B,SIZKIL		;LENGTH+START YIELDS LOC+1 OF END
	SUBI	B,1			;POINT TO END
	LSH	B,-9			;GET PAGE #
	SUBI	B,1			;LESS ONE
	LSH	A,-9
	ADDI	A,1			;AND 1 DOWN FROM TOP FOR START PAGE
	CAMLE	A,B			;IS START PAGE .LE. THAN END PAGE?
	JRST	CHKSET			;NO, NO PMAP TO DESTROY PAGES
	SUB	B,A			;HOW MANY PAGES?
	MOVEI	B,1(B)			;+1 TO GET REPETITION COUNT
	TXO	B,PM%CNT		;SET IT SO
	MOVE	C,B			;AND PUT IN C FOR PMAP
	HRRZ	B,A			;GET FIRST PAGE # IN RH B
	HRLI	B,.FHSLF		;DONE TO SELF
	SETO	A,
	PMAP%				;BLOW PAGES AWAY
	 ERJMP	CHKSET			;OH, WELL
CHKSET:	MOVE	C,FRELST+1		;GET WHAT FRELST POINTS TO TO START
CHKADJ:	MOVE	A,(C)
	ADD	A,C			;IF BLOCK LOC+BLOCK LEN IS
	CAME	A,1(C)			; .EQ. LOC NEXT BLOCK
	JRST	CHKAD2			;(NO)
	MOVE	B,1(C)			;THEN THE LEN OF THE NEXT BLOCK
	MOVE	A,(B)			;GETS ADDED TO THIS ONE
	ADDM	A,(C)			;..
	MOVE	A,1(B)			;AND THE "WHERE NEXT" OF THAT BLOCK
	MOVEM	A,1(C)			;BECOMES THIS ONE (THE BLOCKS ARE COMBINED)
CHKAD2:	SKIPE	C,1(C)			;IF THERE IS A NEXT BLOCK
	JRST	CHKADJ			;THEN GO AGAIN
	DMOVE	A,S1TMP			;ALL DONE, RESTORE AC'S
	DMOVE	C,S1TMP2
	SETZM	WHERE(A)		;FOR NEATNESS
	JRST	(I)			;CALLED BY JSP I,
CDLENI=.-BTRF

	XLIST
	LIT
	LIST

S1TMP:	BLOCK	2
S1TMP2:	BLOCK	2
WHRKIL:	0				;LOC OF FIRST PAGE TO PMAP AWAY
SIZKIL:	0
NAMEI:	0
NUMBI:	0				;# OF WORDS IN "COMMAND LIST"
SLOT:	0
CMDLST:	BLOCK	30			;DONT EXPECT MORE THAN 30 ENTRIES
VAR1SP:	0
 NAMLEN==200				;MAX NUMBER OF ENTRIES
NAMLST:	BLOCK	NAMLEN
WHERE:	BLOCK	NAMLEN
 VAR1E==.-1
FRELST:	0				;ZERO WORD FOR ALGORITHM TO CHEW ON
	NPGES1				;PAGE ADDRESS OF FREESPACE

 NPGES1=CDESEC,,<.&777000>+1000		;WHERE FIRST LOC OF FREESPACE IS

 CDLEN1==.-BTRF+1			;# OF WORDS TO COPY TO SEC CDESEC

	DEPHASE
>					;END OF IFG MAXSEC

;Back to a semblence of reality.
;Routines to play with the array, part 1

WZERO:	TXNN	FF,ARG
	SETZ	C,			;If no value given, assume 0
	EXCH	C,USRARY		;Store user value, return old
WZERO1:	MOVE	B,[USRARY,,USRARY+1]	;Ready to propagate value
	BLT	B,USRARY+USARYL-1	;Cascade it
	JRST	ARGINC			;And return value

WSUM:	TXZN	FF,ARG2			;2 ARGS?
	TDZA	P1,P1			;NO, SET PRECOMMA ARG TO 0
	JUMPL	P1,ARRYQE
	CAIL	P1,USARYL		;IN BOUNDS?
	JRST	ARRYQE
	TXNN	FF,ARG			;ONE ARG?
	MOVEI	C,USARYL-1		;NO, PROVIDE THAT DEFAULT TOO
	JUMPL	C,ARRYQE
	CAIL	C,USARYL		;USUAL RANGE CHECK
	JRST	ARRYQE
	CAMLE	P1,C			;ARGS IN CANONICAL ORDER?
	EXCH	P1,C			;NO, SWITCH THEM FOR HIM
	SKIPA	A,USRARY(P1)		;BETTER THAN SETZ A, AND EXTRA ADD
WSUM1:	ADD	A,USRARY(P1)		;SUM IN NEXT ARRAY LOC
	CAMGE	P1,C			;WAS THAT THE LAST ONE REQUESTED?
	AOJA	P1,WSUM1		;NO, ADD IN NEXT
	JRST	ARGINA			;YES, SUM IN A


;	IFN FTDEB,<		;NOT NORMALLY USED
;
;;SETX - RUN TV IN A NON-ZERO SECTION
;;REPLACE RESET AT TECO WITH JRST SETX
;;RETURNS +1: ALWAYS, WITH PC IN A NON-ZERO SECTION AND SECTION
;;	     0 MAPPED INTO THAT SECTION
;
;SETX:	MOVSI	A,.FHSLF		;GET SOURCE FORK HANDLE ,, SECTION#
;	MOVE	B,[.FHSLF,,3]		;DESTINATION F.H. ,, SECTION#
;	MOVE	C,[PM%RD+PM%WR+1]	;ACCESS,,COUNT
;	SMAP%				;MAP SECTION 0 INTO ANOTHER SECTION
;	MOVSI	A,(PC%USR)	;BUILD PC
;	MOVSS	B
;	HRRI	B,TECO+1
;	XJRSTF	A			;GET TO TECO+1 IN NON-ZERO SECTION
;> ;end of FTDEB
;INTERRUPT HANDLING ROUTINES

;COME HERE IF QUOTA EXCEEDED OR DISK FULL...

OVRQUO:	PUSH	P,CX			;SAVE CX SINCE "SAVEAC" CLOBBERS IT
	CALL	OVR2			;DO THE WORK (THIS WAY SO SAVEAC CAN BE USED)
	POP	P,CX
	DEBRK%				;GO BACK AND CONTINUE TRYING TO WRITE FILE

OVR2:	SAVEAC	<A,B,C>			;DON'T CLOBBER AC'S
	SKIPE	EXPFLG			;DON'T EXPUNGE UNLESS USER ALLOWS IT
	SKIPN	B,QUOJFN		;FIRST TIME THROUGH HERE?
	JRST	OVR1			;NO, DON'T LOOP!
	PSTR <
%Quota exceeded or disk full - expunging deleted files
>
	SETZB	A,QUOJFN		;CLEAR CELL SO WE DON'T LOOP
	RCDIR%				;SEE WHICH DIRECTORY WE'RE WRITING TO
	 ERJMP	OVR1			;FAILED, SO GIVE REAL ERROR
	SETZ	A,			;NO SPECIAL BITS (AGAIN)
	MOVE	B,C			;GET DIRECTORY BEING EXPUNGED
	DELDF%				;EXPUNGE IT
	 ERJMP	OVR1			;FAILED, SO GIVE REAL ERROR
	RET

;COME HERE IF OVER QUOTA OR DISK FULL, BUT EXPUNGE DOESN'T OR CAN'T HELP

OVR1:	LERROR <Over quota or disk full -
 After some files are EXPUNGEd, type CONTINUE.
>
	CALL	DOHALT			;LET USER FIX PROBLEM
	RET				;CONTINUE WRITING THE FILE

;WAUTO-EXPUNGE ALLOWS EXPUNGE TO BE DONE WHEN OVER QUOTA

AUTO:	SETOM	EXPFLG
	JRST	CFLUSH			;[502] DONE

;NOAUTO-EXPUNGE DISALLOWS AUTO-EXPUNGE TO BE DONE WHEN OVER QUOTA

NOAUTO:	SETZM	EXPFLG
	JRST	CFLUSH			;[502] DONE

;COME HERE WHEN USER TYPES ^C.

CTRL.C:	CALL	SAVACS			;SAVE THE ACS
	PSTR <^C>			;SHOW USER THE ^C
	SETOM	MESFLG			;ASSUME SCREEN MESSED UP
	SKIPE	SCRNF			;ARE WE ON A SCREEN
	CALL	EOS			;YES, SO CLEAR TO END OF SCREEN
	CALL	DOHALT			;HALT
	JRST	DEBRK.			;DISMISS INTERRUPT

;ROUTINE TO HALT.  IT RESTORES TERMINAL MODES TO WHAT THEY WERE LAST
;TIME USER ENTERED TV.  ALSO, IF USER CONTINUES, IT REMEMBERS NEW
;TERMINAL MODES, AND RESTORES TV'S MODES.

DOHALT:	HALTF%				;STOP
HALTED:	CALL	SYSMOD			;USER CONTINUED, GET NEW MODES
	JRST	CFLUSH			;[502] DONE

;INTERRUPT TO HERE WHEN USER TYPES CTRL/G

TTYINT:	CALL	SAVACS
	MOVEI	A,.PRIOU
	CFOBF%				;CLEAR OUTPUT BUFFER ALWAYS
	SKIPN	LISNF			;DOING COMMAND INPUT?
	JRST	TTYI1			;NO
	SKIPE	ABORTF			;YES, FIRST INTERRUPT?
	JRST	REE			;YES, START COMMAND INPUT OVER.
TTYI3:	AOS	ABORTF			;NOTE INTERRUPT REQUEST
	MOVEI	A,"G"-100
	PBOUT%				;DO DING
	JRST	IOER1			;RETURN

TTYI1:	MOVEI	A,.PRIIN
	CFIBF%				;CLEAR INPUT BUFFER
	SKIPE	ABORTF			;FIRST REQUEST?
	JRST	TTYI2			;NO, STOP IMMEDIATELY
	JRST	TTYI3

ABORT:	PSTR <
Aborted
>
	JRST	REE

TYOQT:	MOVEI	A,.PRIOU		;QUIT FROM TYPEOUT, CLEAR OUTPUT BUFFER
	CFOBF%
	JRST	REE

;IMMEDIATE STOP

TTYI2:	MOVEI	A,.FHSLF		;JIC!
	CIS%
	JRST	REE

;ROUTINE WHICH SKIPS IFF BACKING UP IS CURRENTLY HAPPENING

SKBACK:	SKIPE	TERIO			;DON'T BACK UP CHARACTERS NOT TYPED ON TERMINAL
	SKIPN	BAKFLG			;IF BAKFLG IS 0
	RET				;SINGLE SKIP FOR NO INITIALIZATION
	JRST	CPOPJ1			;SKIP RETURN FOR BACK UP GOING ON

;CALL THIS ROUTINE IN ORDER TO WAIT FOR ALL COMMAND STRINGS FED TO SAVER
;SO FAR TO BE SAFELY OUT ON THE DISK.  MAINLY USED FOR EXITING BACK TO
;THE EXEC.

SINK:	CALL	SKBACK			;MAKE SURE WE'RE DOING BACKUP
	RET
	MOVEI	A,0			;NO NONPERMANENTS
	CALL	BUPDAT
	SKIPN	SDONEF			;WAIT FOR LAST UPDATE TO COMPLETE
	CALL	HANG
	SKIPL	SDONEF			;WAS THERE AN ERROR?
	JRST	BUPERR			;YES, GO REPORT IT
	RET				;WHEN COMPLETE, RETURN

;THE FOLLOWING ROUTINE ALLOWS FOR WAITING FOR A SOMETHING TO HAPPEN
;WITHOUT TYING DOWN THE SYSTEM.
;WHAT YOU REALLY WANT			HOW YOU DO IT
;--------------------			-------------
;
;	HAS-"IT"-HAPPENED??		HAS-"IT"-HAPPENED??
;	JRST .-1	;NO		CALL HANG	;NO, WAIT FOR IT
;	...			;YES		...	;YES

HANG:	MOVEI	A,^D150			;SLEEP FOR A WHILE
	DISMS%
WAITIN:	POP	P,A			;GET ADDRESS WE WOULD HAVE RETURNED TO
	JRST	-2(A)			;GO BACK AND SEE IF EVENT HAS HAPPENED YET
;CONTROL-O INTERRUPT, SUPRESS OUTPUT BUT DON'T STOP PROCESSING

CTRL.O:	AOSN	COFLG			;COMPLEMENT FLAG - NOW CLEAR?
	DEBRK%				;YES, DO NOTHING FURTHER
	CALL	SAVACS
	MOVEI	A,.PRIOU
	CFOBF%				;FLUSH OUTPUT
	PSTR <^O...
>
	SETOM	COFLG			;SET FLUSH FLAG
	HRRZ	A,LEV3PC		;SEE WHERE WE CAME FROM
	MOVSI	B,(PC%USR)
	CAIN	A,TYOLOC+1		;THE BOUT?
	IORM	B,LEV3PC		;YES, SET PC NOT TO RESUME BOUT
	JRST	IOER1
;IO ERROR INTERRUPT

IOERR:	CALL	SAVACS			;SAVE ACS DURING INTERRUPT
	PSTR <
IO data error, >
	MOVE	B,IAC+A			;ASSUME JFN IN A
	CAMN	B,INJFN			;THE INPUT ONE?
	JRST	IOERI			;YES
	CAMN	B,OUTJFN		;THE OUTPUT ONE?
	JRST	IOERO			;YES
	PSTR <Unexplained
>
IOER1:	JRST	DEBRK.

;SAVACS SAVES AC'S FOR DURING INTERRUPT ROUTINES
;LEAVES AC0 ALONE, SINCE IT HAS FLAGS IN IT

SAVACS:	MOVEM	1,IAC+1			;SAVE AC 1
	MOVE	1,[2,,IAC+2]
	BLT	1,IAC+16		;SAVE ACS 2 THROUGH 16
	RET

;COME HERE TO RESTORE AC'S AND DISMISS INTERRUPT

DEBRK.:	MOVE	16,[IAC+1,,1]
	BLT	16,16			;restore ac's
	DEBRK%

IOERI:	PSTR <Input file: >
IOER2:	MOVEI	A,.PRIOU
	SETZ	C,
	JFNS%				;TYPE FULL NAME OF FILE
	HRROI	A,[ASCIZ /
/]
	PSOUT%
	AOS	ABORTF			;REQUEST ABORT
	JRST	IOER1

IOERO:	PSTR <Output file: >
	JRST	IOER2

;(REST OF INTERRUPT TABLES MOVED INTO SAVER FORK AREA)

;ROUTINE TO POP UP ONE TYPIN JFN.

TYIPOP:	SKIPE	SILFLG
	JRST	SHHH
	PSTR <
End of >
	MOVEI	A,.PRIOU		;OUTPUT TO PRIMARY
	MOVE	B,TYIJFN		;TYPE FILESPEC BEING ENDED
	SETZ	C,			;PRINT IT IN STANDARD FORMAT
	JFNS%
	CALL	CRR
SHHH:	MOVE	A,TYIJFN		;GET JFN WE'RE GETTING RID OF.
	CLOSF%				;CLOSE THE FILE.
	 JFCL				;COULDN'T BUT DON'T WORRY.
	MOVE	A,TYIP			;POP UP TO LAST INPUT JFN BECAUSE EOF.
	POP	A,TYIJFN
	MOVEM	A,TYIP			;SAVE NEW POINTER
	MOVE	A,TYIJFN		;GET NOW CURRENT INPUT JFN.
	HRRM	A,RDIOJ			;STORE LATEST JFNS FOR TEXTI
	HRLM	A,RDIOJ
	HRRM	A,SBK+.CMIOJ		;STORE FOR COMND JSYS TOO
	HRLM	A,SBK+.CMIOJ
	DVCHR%				;SEE IF THIS JFN IS A TERMINAL
	MOVE	A,TERIO			;REMEMBER WHETHER ENDING STREAM IS A TERMINAL
	MOVEM	A,OTERIO
	SETZM	TERIO			;FIRST ASSUME IT'S NOT.
	LDB	A,[221100,,B]		;GET DEVICE TYPE NUMBER
	CAIN	A,.DVTTY		;SKIP IF IT IS A TERMINAL
	SETOM	TERIO			;REMEMBER THAT IT'S A TERMINAL
	RET

;ROUTINE TO CAUSE CHAR TO BE REAVAILABLE FOR INPUT.

RECHAR:	MOVE	A,TYIJFN		;CORRECT JFN IN A
	BKJFN%				;PUT CHARACTER BACK IN STREAM
	 JSHLT
	RET

;ROUTINE TO INPUT A CHARACTER BUT NOTHING ELSE(I.E. NO BACKUP)

TYIX:	SETOM	WINFLG			;IF RECEIVING INPUT, ASSUME USER HAS SEEN ALL
	MOVE	A,TYIJFN		;GET APPROPRIATE INPUT JFN
	BIN%				;READ THE CHARACTER
	 ERJMP	TYIEOF			;IF FAILS, PROBABLY END OF FILE
	MOVE	A,B			;RETURN IT IN A
	RET

TYIEOF:	CALL	%GETER			;GET REASON FOR FAILURE
	CAIE	A,IOX4			;END OF FILE?
	 JSHLT				;NO, UNEXPECTED ERROR
	CALL	TYIPOP			;YES, GET BACK TO LAST INPUT LEVEL
	JRST	TYIX			;CONTINUE READING

;ROUTINE TO BACKUP A CHARACTER IN A.

BCHAR:	STKVAR	<SHCHR>
	LSH	A,1			;SHIFT CHARACTER TO MAKE IT ASCII
	MOVEM	A,SHCHR
	CALL	SKBACK			;MAKE SURE WE'RE BACKING UP
	RET
	AOS	B,BBLEN			;ACCUMULATE CHARACTER IN BACKUP BUFFER
	HRLI	B,100700		;MAKE POINTER TO CHARACTER
	HRRI	B,SHCHR
	MOVE	A,BBPTR			;POINTER TO WHERE CHARACTER GOES
	MOVEI	C,1			;ONLY DOING ONE CHARACTER
	CALL	TUTHER			;COPY CHARACTER INTO BACKUP BUFFER
	IBP	BBPTR			;STORE UPDATED POINTER
	MOVE	A,BBLEN
	SUB	A,OBBLEN		;SEE HOW MANY ACCUM'D CHARS SINCE LAST UPDATE
	CAMGE	A,BAKLEN		;ENOUGH CHARACTERS YET TO DO UPDATE?
	RET
	MOVEI	A,0			;NO NONPERMANENT CHARS
;	CALLRET	BUPDAT		;YES, INITIATE AN UPDATE

;ROUTINE WHICH INITIATES UPDATE OF BACKUP FILE.  PASS IT NUMBER OF
;NONPERMANENT CHARACTERS TO UPDATE IN A.

BUPDAT:	STKVAR	<NONPER,SAVPAG,SAVCNT>
	MOVEM	A,NONPER		;REMEMBER NUMBER OF NONPERMANENT CHARS
	MOVE	A,BBLEN
	MOVEM	A,OBBLEN		;REMEMBER NUMBER OF BACKUP CHARACTERS
				 	;AT TIME OF THIS UPDATE
	SKIPN	SDONEF			;MAKE SURE SAVER IS DONE WITH LAST CHUNK
	CALL	HANG			;NOT, SO WAIT FOR IT TO BE
	SKIPL	SDONEF			;MAKE SURE THERE WERE NO ERRORS
	JRST	BUPERR			;THERE WAS, PROBABLY OVER QUOTA
	MOVE	A,BBLEN
	MOVEM	A,SAVPER		;SAVER NEEDS TO KNOW # OF PERMANENT CHARS
	ADD	A,NONPER		;GET TOTAL NUMBER OF CHARACTERS
	MOVEM	A,SAVTOT		;SAVER NEEDS THAT
	MOVE	A,BBPTR			;FIGURE OUT WHERE NONPERMANENT CHARACTERS GO
	MOVE	B,RDBFP			;GIVE SAVER NONPERMANENT CHARACTERS
	MOVE	C,NONPER		;GET PERMANENT NUMBER OF CHARACTERS
	CALL	TUTHER			;APPEND NONPERMANENTS TO PERMANENTS
	MOVE	A,BBUFX
	MOVEM	A,SAVX			;TELL SAVER WHICH BUFFER TO USE
	CALL	SAVGO			;START THE SAVER
	SETZM	BBLEN			;THERE'S NO CHARACTERS LEFT IN BACKUP BUFFER
	SETZM	OBBLEN			;RESET OLD COUNT SO NEXT SAVE HAPPENS..
	MOVE	A,[<POINT 7,BBUF1>+<POINT 7,BBUF2>]; AT RIGHT TIME
	SUB	A,BBUFX			;SWITCH TO OTHER BACKUP BUFFER
	MOVEM	A,BBUFX
	MOVEM	A,BBPTR
	SETCMM	WTOGGL			;TOGGLE TO OTHER WINDOW BUFFER
	RET

;COME HERE IF SAVER ENCOUNTERED ERROR DURING TRYING TO BACKUP LAST
;SEGMENT.  ASSUME THE ERROR CAN BE CORRECTED BY USER, LIKE "OVER QUOTA".
;HENCE PRINT THE ERROR MESSAGE, BUT OTHERWISE JUST RETRY THE LAST SAVE
;AND DON'T TRY TO BACKUP ANY NEW CHARACTERS YET.

BUPERR:	PSTR <
%TV backup file not updated yet - >
	MOVE	B,SDONEF		;GET ERROR CODE
	HRL	B,SAVFRK		;USE SAVER'S FORK HANDLE
	MOVE	A,TTYOUT		;DIRECT OUTPUT TO TERMINAL
	MOVEI	C,0			;NO CHARACTER COUNT LIMITATION
	ERSTR%				;PRINT SYSTEM'S REASON FOR ERROR
	 JFCL
	 JFCL
	CALL	CRR
	CALLRET	SAVGO			;MAYBE UNDER QUOTA AGAIN, RETRY THE SAVE

;ROUTINE TO CALL WHEN DESTINATION BUFFER STARTING ADDRESS IS SET UP.
;THIS ROUTINE CONJURES UP AN INITIAL OLD COMMAND POINTER BASED ON HOW MANY
;CHARACTERS HAVE BEEN TYPED THAT HAVE NOT YET BEEN BACKED UP, SUCH THAT
;WHEN SAVLEN'S WORTH HAVE ACCUMULATED, A BACKUP WILL HAPPEN

SETOCP:	MOVN	A,BBLEN			;GET NEGATIVE NUMBER OF CHARACTERS TYPED
					; AND NOT BACKED UP
	ADJBP	A,RDBFP			;INITIALIZE PLACE IN COMMAND STRING AT
					; WHICH LAST UPDATE HAPPENED
	MOVEM	A,OCP			;REMEMBER
	RET

;ROUTINE TO START UP SAVER FORK

SAVGO:	MOVE	A,SAVFRK		;START UP THE SAVER
	MOVEI	B,SAVST
	SETZM	SDONEF			;SAY SAVER ISN'T DONE YET
	SFORK%
	RET

;FOLLOWING ROUTINE TAKES PAGE NUMBER IN RIGHT HALF OF A, AND DOES PMAP SUCH THAT
;A WRITE INTO OUR PAGE AT FRKWI2 OR FRKWIN ACTUALLY CAUSES A WRITE INTO PAGE
;GIVEN IN A OF OTHER FORK

SFW:	HRRZ	A,A			;KEEP ONLY PAGE NUMBER
	MOVEI	D,LPM			;FIRST ASSUME FIRST WINDOW
	SKIPE	WTOGGL			;OTHER?
	MOVEI	D,LPM2			;YES
	CAMN	A,(D)			;SAME AS LAST PAGE MAPPED?
	RET				;YES SO NOTHING TO DO
	HRL	A,SAVFRK		;GET CORRECT FORK HANDLE
	MOVE	B,[.FHSLF,,FRKWPN]	;GET WINDOW PAGE NUMBER
	SKIPE	WTOGGL
	HRRI	B,FRKWP2		;KEEP WINDOW NUMBER CORRECT
	XMOVEI	C,20			;GET SECTION # IN LH
	LSH	C,-11			;GET SECTION # IN BITS 18-26
	TDO	B,C			;PUT SECTION # IN PMAP DESTINATION
	MOVX	C,PM%WR			;WE WANT TO WRITE INTO THE PAGE
	PMAP%				;MAP FROM OTHER FORK TO US
	HRRZM	A,(D)			;REMEMBER NEW MAPPED PAGE
	RET

;ROUTINE TO COPY CHARACTERS "TO OTHER" FORK.  GIVE IT DESTINATION POINTER
;IN A (PLACE IN OTHER FORK TO WHICH CHARACTERS ARE GOING), SOURCE
;POINTER IN B, AND NUMBER OF CHARACTERS IN C.
;THIS ROUTINE ASSUMES ASCII POINTERS

TUTHER:	STKVAR	<TFROM,TWHERE,TCNT,INUM,TPTR>
	TLC	B,-1
	TLCN	B,-1
	HRLI	B,(POINT 7)		;CHANGE -1 TO 440700
	TLC	A,-1
	TLCN	A,-1
	HRLI	A,(POINT 7)		;CHANGE -1 TO 440700
	MOVEM	B,TFROM
	MOVEM	A,TWHERE
	MOVEM	C,TCNT
TU1:	JUMPE	C,CPOPJ			;RETURN IF EVERYTHING MOVED
	MOVE	A,[010700,,FRKWIN+777] 	;GET POINTER TO END OF WINDOW
	SKIPE	WTOGGL			;USING OTHER WINDOW?
	MOVE	A,[010700,,FRKWI2+777]	;YES, GET POINTER TO IT
	MOVE	B,TWHERE		;GET PLACE WE'RE MOVING DATA TO
	IBP	B			;CHANGE 010700,,F-1 TO 440700,,F
	ADD	B,[70000,,0]
	MOVEM	B,TWHERE		;REMEMBER THE POINT 7 VERSION
	TRZ	B,777000		;GET RID OF PAGE NUMBER
	SKIPN	WTOGGL			;CHOOSE APPROPRIATE WINDOW
	TROA	B,FRKWIN		;GET BYTE POINTER AS TRANSLATED FOR OTHER FORK
	TRO	B,FRKWI2
	MOVEM	B,TPTR			;REMEMBER TRANSLATED POINTER
	CALL	SUBBP			;CALCULATE NUMBER OF BYTES WE CAN DO
	MOVEM	A,INUM			;REMEMBER HOW MANY WE CAN DO BEFORE UPING PAGE#
	LDB	A,[111100,,TWHERE]	;GET PAGE OF FORK TO BE MAPPED
	CALL	SFW			;SET UP FORK WINDOW
	MOVE	P1,INUM			;GET NUMBER OF CHARACTERS WE CAN DO ON THIS PAGE
	CAMLE	P1,TCNT			;MAKE SURE LESS THAN ENTIRE AMOUNT DESIRED
	MOVE	P1,TCNT			;MORE.  ONLY DO WHAT WAS REQUESTED
	MOVEM	P1,INUM			;REMEMBER NUMBER WE'RE ACTUALLY DOING
	MOVE	I,TFROM			;TRANSFER FROM WHERE WE'RE SUPPOSED TO
	MOVE	OU,TPTR			;USE TRANSLATED POINTER FOR DESTINATION
	CALL	MVSTR			;TRANSFER AS MUCH AS CAN BE
	MOVE	A,INUM			;GET NUMBER WE JUST DID
	ADJBP	A,TFROM			;CALCULATE POINTERS FOR NEXT SECTION
	MOVEM	A,TFROM
	MOVE	A,INUM
	ADJBP	A,TWHERE
	MOVEM	A,TWHERE
	MOVN	C,INUM
	ADDB	C,TCNT			;UPDATE COUNT OF LEFT TO DO
	JRST	TU1			;LOOP TO FINISH

;ROUTINE WHICH INPUTS COMMAND STRING USING TEXTI

DTEXTI:	STKVAR	<CCL>
	SETOM	WINFLG			;IF RECEIVING INPUT, ASSUME USER HAS SEEN ALL
DTXTI1:	MOVEI	A,RDCWB			;ASSUME EVERYTHING ELSE CORRECT
	TEXTI%				;READ SOME MORE INPUT
	 JRST	MEOF			;MAYBE END OF FILE
	SETZM	ABORTF			;SO IFOO^G$$ DOES THE INSERT
	MOVE	A,RDDBP
	MOVE	B,RDBFP			;YES, SEE HOW LONG COMMAND STRING IS
	CALL	SUBBP
	MOVEM	A,CCL			;REMEMBER NEW COMMAND STRING LENGTH
	MOVE	A,RDDBP			;GET RIGHTMOST POSITION OF COMMAND
	MOVE	B,OCP			;GET OLD POSITION, AT LAST UPDATE
	CALL	SUBBP			;SEE HOW MUCH TYPED SINCE LAST UPDATE
	CAMGE	A,BAKLEN		;ENOUGH FOR A BACKUP?
	JRST	DTNOG			;NO, NOT YET
	MOVE	A,RDDBP			;YES, SO REMEMBER WHERE THIS UPDATE HAPPENED
	MOVEM	A,OCP			;..
	CALL	SKBACK			;BACKING UP?
	JRST	DTNOG			;NO, CHAR NOT FROM TTY OR USER SAID WNOBACKUP$
	MOVE	A,CCL			;GET CURRENT COMMAND STRING LENGTH
	CALL	BUPDAT			;UPDATE THE BACKUP FILE
DTNOG:	MOVE	A,RDFLG			;SEE WHY TEXTI STOPPED INPUTTING
	TXNN	A,RD%BTM		;BREAK CHARACTER?
	RET				;NO, LET CALLER HANDLE IT
	CALL	TYIX			;YES, ESCAPE TYPED, SEE IF NEXT ESCAPE ALSO
	CAMN	A,TERMIN		;IS IT THE TERMINATOR?
	CALLRE	STFCHR			;STUFF THE SECOND ESCAPE AND RETURN
	CALL	RECHAR			;NOT AN ESCAPE, CAUSE IT TO BE REREAD
	JRST	DTXTI1			;GO BACK AND KEEP READING

;HERE IF ERROR DURING TEXTI

MEOF:	CAIE	A,IOX4			;END OF FILE REACHED?
	 JSHLT				;NO, SOME OTHER ERROR
	CALL	TYIPOP			;YES, POP BACK TO PREVIOUS LEVEL OF IO
	SKIPE	OTERIO			;ENDING A NON-TERMINAL STREAM?
	RET				;NO
	MOVE	A,RDDBP			;YES, DON'T LET TYPIST DELETE CHAR RECEIVED..
	MOVEM	A,RDBFP			; FROM NON-TERMINAL
	SETZ	B,
	IDPB	B,A			;DON'T LET PSOUT GO TOO FAR
	MOVEI	A,PCHAR			;DISPLAY PROMPT CHARACTER
	SKIPE	TERIO			;BUT NOT IF READING FROM NON-TERMINAL
	PBOUT%
	MOVE	A,CPTR			;SHOW USER COMMAND SO FAR
	SKIPE	TERIO			;DON'T BOTHER DISPLAYING COMMAND SO FAR IF
	PSOUT%				; STILL	READING FROM NON-TERMINAL
	MOVE	A,RDBFP			;SEARCH BACK TO BEGINNING OF CURRENT LINE
MEOF1:	CAMN	A,RDRTY			;ARE WE BACK TO THE BEGINNING OF BUFFER?
	JRST	MEOF2			;YES
	LDB	B,A			;NO, SEE IF WE'VE FOUND BEGINNING OF LINE
	CAIN	B,.CHLFD		;HAVE WE?
	JRST	MEOF2			;YES
	SETO	B,			;NO, SEARCH BACKWARDS FOR IT
	ADJBP	B,A
	MOVE	A,B
	JRST	MEOF1
MEOF2:	MOVEM	A,RDRTY			;SET UP SO ^R ONLY SHOWS CURRENT LINE
	CALL	SETOCP			;SET UP THE OLD COMMAND POINTER
	JRST	DTXTI1			;GO CONTINUE READING FROM PREVIOUS SOURCE

;ROUTINE TO STUFF CHARACTER INTO COMMAND STRING.

STFCHR:	IDPB	A,RDDBP			;STUFF THE CHARACTER IN
	SOS	RDDBC			;ASSUME THERE WAS ROOM!
	RET

	;JSYS ERROR REPORT

JSER:	CALL	WINCLS			;DON'T LET SCREEN UPDATE WIPE OUT ERROR MESSAGE
	PSTR <
?>
	CALL	CLRINP			;CLEAR TYPEAHEAD
	HRLOI	B,.FHSLF		;THIS FORK, LAST ERROR
	SETZ	C,
	ERSTR%				;PRINT ERROR MSG
	 JFCL
	 JFCL
	CALL	CRR
	RET

	IFN FTDEB,<			;NOT NORMALLY USED

;THIS ROUTINE PRINTS A CRLF AND A ? AND THE ERROR CODE CORRESPONDING TO
;THE ERROR NUMBER IN 1.

JSER1:	MOVE	B,A			;PUT ERROR CODE IN 2
	MOVEI	A,.PRIOU		;AND SAY TO PRINT ERROR ON TTY
	SETZ	C,			;SAY TO PRINT WHOLE MESSAGE
	PSTR <
?>
	HRLI	B,.FHSLF
	ERSTR%				;PRINT MESSAGE
	 JFCL
	 JFCL
	CALLRET	CRR

> ;END OF FTDEB

;ROUTINE TO CLEAR TYPEAHEAD.  THIS IS DESIRABLE WHEN AN ERROR OCCURS,
;SINCE USER PROBABLY DOES NOT WANT HIS TYPEAHEAD EXECUTED IF PREVIOUS
;COMMAND FAILS.

CLRINP:	MOVEI	A,.PRIOU
	DOBE%				;WAIT FOR PRESENT OUTPUT TO BE SEEN
	CFIBF%				;CLEAR EXTRA TYPING
	RET
;OUTPUT A CHARACTER.  TAKES CHARACTER IN A. DOES NOT DESTROY C.

TYO:	MOVE	B,A			;CHARACTER TO B
	MOVE	A,TTYOUT		;GET OUTPUT CHANNEL
TYOLOC:	BOUT%				;PRINT IT; THIS TAG IS FOR INTERRUPT SYSTEM
	RET

;SERVICE ROUTINE FOR CTYPE MACRO, TYPES ONE LITERAL CHARACTER

UCTYP0:	HRRZ	A,UUOB+.AREFA	;GET THE CHARACTER (EFF ADDR OF UUO)
	CALLRET	TYO		;TYPE IT AND RETURN

;PRINT STRING SUBROUTINE - SEE MACRO DEFINITION
; HRROI TT,[ASCIZ /STRING/]
; CALL PSTR0

PSTR0:	HRLI	TT,(POINT 7)	;MAKE BYTE PTR
	ILDB	A,TT		;GET CHAR FROM STRING
	JUMPN	A,[CALL TYO	;OUTPUT IF IF NOT NULL
		JRST .-1]
	RET			;OTHERWISE, DONE
;ROUTINE TO OUTPUT DECIMAL INTEGER
;CALL MOVE c, DECIMAL INTEGER
;	MOVEI	A,ADDRESS OF OUTPUT ROUTINE
;	HRRM	A,LISTF5
;	CALL	DPT
;	RETURN

DPT0:	HRRM	A,LISTF5		;SETUP CHAR DISPATCH ADR
DPT:	MOVSI	CH,(IFIW)
	HLLM	CH,LISTF5		;SET FOR LOCAL INDIRECT REFERENCE
	MOVEI	A,"-"
	SKIPGE	C		;NEGATIVE NUMBER?
	CALL	@LISTF5		;YES, OUTPUT MINUS SIGN
	MOVMS	C			;c:=ABSOLUTE VALUE OF c
	CAIGE	C,0		;DID THAT FETCH IT POSITIVE OR ZERO?
	SETZ	C,			;HE JUST INVENTED -0 (1B0)
DPT2:	IDIV	C,RADIX		;d:=DIGIT
	PUSH	P,D		;STACK THE DIGIT
	SKIPE	C			;DONE?
	CALL	DPT2		;NO.
	POP	P,A			;YES, RETRIEVE DIGIT
	ADDI	A,60		;CONVERT IT TO ASCII.
	JRST	@LISTF5		;PRINT IT

;ROUTINE TO TYPE CARRIAGE RETURN LINE FEED
;CALL CALL CRR
;	RETURN

CRR:	MOVEI	A,.CHCRT
	CALL	TYO
	MOVEI	A,.CHLFD
	CALLRET	TYO

;ROUTINE TO GET TO LEFT MARGIN

LM:	CALL	CHKLM		;AT LEFT MARGIN?
	 CALLRE	CRR		;NO, GET THERE
	RET			;YES, ALREADY THERE

;SKIP IF AT LEFT MARGIN

CHKLM:	MOVE	A,TTYOUT		;GET OUTPUT CHANNEL
	RFPOS%			;GET POSITION ON LINE
	TRNN	B,-1		;AT LEFT MARGIN?
	AOS	(P)			;YES
	RET			;NO
;HERE TO GET NEXT COMMAND STRING FROM TTY

CLIS:	SKIPN	A,INIJFN		;IS THERE A TV.INI?
	JRST	CLIS3		;NO, OR WE'VE ALREADY EXECUTED IT
	MOVEI	B,1		;INITIALIZE A NULL COMMAND
	MOVEM	B,COMCNT
	MOVEM	B,COMAX
	MOVSI	B,(<BYTE(7)177>)
	MOVEM	B,CBUF
	MOVE	B,[POINT 7,CBUF]
	MOVEM	B,CPTR
	CALL	MFILE0		;READ FILE INTO Q-REG AREA
	CALL	MAC0
	CALL	CFLUSH
	JRST	ICMD
CLIS3:	TXZE	FF,RSCNF2		;RESCANNED DATA AVAILABLE?
	TXO	FF,RSCANF		;YES, ENABLE IT
CLIS1:	HRRZ	A,LSTCB		;PREPARE TO SAVE LAST COMMAND STRING
	HRRZ	B,LSTCE
	CAIG	A,CBUF
	JRST	CSAV1		;IS ALREADY IN RIGHT PLACE
	SUBI	B,0(A)
	CAIG	B,3
	JRST	CRST		;NOT USEFULLY LONG
	ADDI	B,CBUF
	MOVEI	A,CBUF
	HRL	A,LSTCB
	BLT	A,-1(B)		;MOVE TO CBUF
CSAV1:	HLL	B,LSTCE		;NUMBER OF CHARS
	MOVEM	B,LSTCB
	JRST	CSAV2

CRST:	MOVE	B,LSTCB		;RESET COMMAND STRING
CSAV2:	HRLI	B,10700		;MAKE BYTE POINTER
	SOJ	B,			;MAKE PROPER BYTE POINTER
	MOVEM	B,RDRTY		;SET UP RETYPE BUFFER
	MOVEI	A,PCHAR		;SET UP PROMPT
	IDPB	A,B
	MOVEM	B,CPTR
	MOVEM	B,RDBFP		;MARK BEGINNING OF INPUT BUFFER
	MOVEM	B,RDDBP		;DESIGNATE CURRENT END OF INPUT BUFFER
	MOVEM	B,RDBKL		;MARK BACKUP LIMIT
	CALL	TYO		;TYPE THE PROMPT
;**;[504] At CSAV2: +10L, Replaced 2 lines with 4           SM 16-Nov-82
	SKIPE	TERIO		;[504] IS THIS TERMINAL INPUT?
	SKIPA	A,TYIJFN		;[504] YES, ECHO TO TTY
	MOVEI	A,.NULIO		;[504] NO, TOSS ECHO AWAY
	HRL	A,TYIJFN		;[504] INPUT FROM INPUT JFN
	MOVEM	A,RDIOJ		;TELL TEXTI WHERE CHARACTERS COMING FROM
	MOVEM	A,SBK+.CMIOJ	;TELL COMND JSYS TOO
	SETOM	LISNF		;NOTE NOW DOING COMMAND INPUT
	SETOM	ABORTF		;CAUSES ^G TO ACT IMMEDIATELY HERE
	MOVEI	A,.PRIOU
	DOBE%			;WAIT FOR ALL OUTPUT, IN CASE ^G
	SETZM	COFLG		;CLEAR TYPEOUT FLAG
	SETZM	ABORTF		;CLEAR ABORT FLAG
	SETZM	DUNFLG		;DON'T PUT OUT HEADING AGAIN
	SKIPGE	WINFLG
	SKIPN	SCRNF		;NO SCREEN CLEARING FOR NON-DISPLAY!
	TRNA			;NO SCREEN CLEARING IF PRESERVED OUTPUT!
	CALL	EOS		;CLEAR PAD FOR COMMAND TYPEIN
	SKIPE	SCRNF
	CALL	EOL		;ALWAYS CLEAR LINE IF DISPLAY TERMINAL.
	SETZM	INTDPH		;INTDPH:=0
	SETZM	PCISG
ZSYMT:	SETZM	SYMS
	MOVE	T,[XWD SYMS,SYMS+1]
	BLT	T,SYMEND
	MOVE	C,CBUFH
	CALL	SETOCP		;CALCULATE INITIAL OLD COMMAND POINTER
	TXNN	FF,RSCANF		;ARE WE RESCANNING?
	JRST	LINRS		;NO
	MOVE	B,[POINT 7,[BYTE(7) ";","Y",.CHTRM,.CHTRM]]
			;GOBBLE INPUT BEFORE OUTPUT IN CASE "EDIT A..3 A..3"
	JRST	LIFAKE		;FORCE THIS COMMAND STRING
LINRS:	CALL	TYIX		;INPUT FIRST CHARACTER
	MOVEM	A,FCHAR		;SAVE SINCE EOS CLOBBERS A
	SKIPE	SCRNF		;DON'T CLEAR SCREEN ON NON-SCREENS
	CALL	EOS		;CLEAR PREVIOUS PRESERVED OUTPUT
	MOVE	A,FCHAR
	MOVEI	B,0
	SKIPN	EOBFLG		;IF EOBUFFER ALREADY DISPLAYED, <SP> NO-OPS.
	SKIPN	SLENTH		;USING A DISPLAY WINDOW?
	JRST	LINRS1		;NO, SO SPACE ISN'T SPECIAL
	CAIN	A,C.MORE		;MAGIC "MORE" CHARACTER?
	JRST	DMORE		;YES, GO DO IT
LINRS1:	CAIE	A,.CHLFD		;FIRST CHARACTER LINEFEED?
	JRST	LI69NL		;NO.
	MOVE	B,[POINT 7,C$LDWT]	;LT$$
	SKIPE	SLENTH		;DON'T DO THE "T" IF A WINDOW IS BEING USED.
	MOVE	B,[POINT 7,C$LDW]	;L$$
LI69NL:	CAIE	A,"^"		;UP ARROW?
	JRST	LI69NU		;NO.
	MOVE	B,[POINT 7,C$LUPT]	;-LT$$
	SKIPE	SLENTH		;NO "T" IF A WINDOW IS BEING USED.
	MOVE	B,[POINT 7,C$LUP]	;-L$$
LI69NU:	MOVE	C,TRMTYP
	CAIE	C,.TTV05		;ONLY VT05 HAS FUNNY ARROWS.
	JRST	LI83
	CAIN	A,C.UP
	MOVE	B,[POINT 7,C$LUP]	;-L$$
	CAIN	A,C.DOWN
	MOVE	B,[POINT 7,C$LDW]	;L$$
	CAIN	A,C.RITE
	MOVE	B,[POINT 7,C$CHR]	;C$$
	CAIN	A,C.LEFT
	MOVE	B,[POINT 7,C$CHL]	;-C$$
	JRST	LI96		;FOR VT05, DON'T RECOGNIZE CONTROL-H AS -LT
LI83:	CAIE	C,.TT102		;TV102?
	CAIN	C,.TT100		;VT100?
	JRST	LIV100		;YES
	CAIN	C,.TT125		;VT125
	JRST	LIV100
	CAIE	C,.TTV50		;VT50?
	CAIN	C,.TTV52		;OR VT52?
LIV100:	CAIE	A,.CHESC		;ESCAPE SEQUENCE COMING? (ARROWS)
	JRST	LI84		;NO
	MOVE	C,TRMTYP
	CAIE	C,.TT125		;VT125 OR VT102?
	CAIN	C,.TT102
	JRST	L102
	CAIE	C,.TT100		;VT100?
	JRST	LIN100		;NO
L102:	CALL	TYIX		;YES, READ THE "[" BEFORE THE ARROW DESIGNATOR
	CAIE	A,"["		;PROPER ESCAPE SEQUENCE COMING?
	JRST	LINONE		;NO
LIN100:	CALL	TYIX		;LOOK AT NEXT CHARACTER
	MOVE	CH,A
	LOAD	CH,UPRCOD,(CH)	;GET RAISED VERSION OF IT
	CAIN	CH,V52.UP
	MOVE	B,[POINT 7,C$LUP]	;-L$$
	CAIN	CH,V52.DN
	MOVE	B,[POINT 7,C$LDW]	;L$$
	CAIN	CH,V52.LT
	MOVE	B,[POINT 7,C$CHL]	;-C$$
	CAIN	CH,V52.RT
	MOVE	B,[POINT 7,C$CHR]	;C$$
	CAIN	B,0		;ANY ESCAPE SEQUENCE CALCULATED?
LINONE:	MOVE	B,[POINT 7,C$NULL]	; $$
LIFAKE:	MOVE	P1,B		;POINTER TO CHARACTERS IN P1
LIF1:	ILDB	A,P1		;GET CHARACTER OF FAKE COMMAND
	JUMPE	A,LI89		;ENTIRE COMMAND STUFFED IF NULL FOUND
	CALL	STFCHR		;STUFF NEXT CHARACTER OF COMMAND
	JRST	LIF1		;LOOP FOR ALL CHARACTERS
LI85:	CALL	RECHAR		;CAUSE NON-SPECIAL CHARACTER TO BE REAVAILABLE
	MOVEI	A,.TICTI	;DISABLE TYPEIN INTERRUPT
	DTI%			;SO THEY DON'T KEEP HAPPENING DURING...
				; COMMAND INPUT
LI1:	MOVE	C,CBUFH
	MOVE	B,RDDBP
	CAIG	C,(B)		;COMMAND BUFFER EXCEEDED?
	 CALL	LIXPND		; YES, EXPAND
	MOVE	A,CBUFH
	MOVE	B,RDDBP
	HRLI	A,010700		;MAKE BYTE POINTER
	CALL	SUBBP		;SEE HOW MANY CHARACTERS THERES ROOM FOR
	MOVE	P1,A		;REMEMBER ROOM LEFT BEFORE EXPANSION REQUIRED
	MOVE	A,RDDBP		;GET RIGHTEND OF COMMAND STRING
	MOVE	B,OCP		;GET PLACE AT LAST BACKUP
	CALL	SUBBP		;GET NUMBER OF UNBACKED UP CHARS
	MOVE	B,BAKLEN	;GET NUMBER ALLOWED BEFORE BACKUP REQUIRED
	SUB	B,A		;GET NUMBER TO INPUT BEFORE BACKUP REQUIRED
	CAML	P1,B		;EXPANSION BEFORE BACKUP?
	MOVE	P1,B		;NO, BACKUP WILL HAPPEN FIRST
	MOVEM	P1,RDDBC		;REMEMBER HOW MANY CHARS TO INPUT
	CALL	DTEXTI		;INPUT SOME OF THE COMMAND STRING
	MOVE	A,RDFLG		;GET FLAGS FROM TEXTI
	TXNE	A,RD%BLR		;DID USER DELETE EVERYTHING?
	JRST	LINRS		;YES, GO CHECK FOR SPECIAL FIRST CHARACTER AGAIN
	TXNN	A,RD%BTM		;TWO ALTMODES SEEN?
	JRST	LI1		;NO, GET MORE INPUT
LI89:	MOVE	A,[.TICTI,,TICHN]	;WE WANT TO KNOW WHEN USER TYPES
	ATI%
	MOVE	A,RDDBP
	MOVE	B,CPTR
	CALL	SUBBP		;SUBTRACT POINTERS TO CALCULATE LEN OF COMMAND
	MOVEM	A,COMCNT		;REMEMBER LENGTH
	CALL	SKBACK		;MAKE SURE WE'RE BACKING UP
	JRST	LINB		;NO
	MOVE	A,RDDBP
	MOVE	B,RDBFP
	CALL	SUBBP		;CALCULATE LENGTH OF ACTUAL TYPED STRING
 ; (ENTIRE COMMAND MINUS PERHAPS SOME PARTIAL COMMAND FROM OLD BACKUP FILE!)
	MOVE	C,A
	ADDM	C,BBLEN		;BACKUP BUFFER IS NOW LONGER
	MOVE	A,BBPTR		;APPEND COMMAND TO BACKUP BUFFER
	MOVE	B,RDBFP
	MOVE	D,C
	ADJBP	D,BBPTR		;UPDATE POINTER TO END OF BACKUP BUFFER
	MOVEM	D,BBPTR
	CALL	TUTHER		;IT IS, COPY THE STRING
LINB:	MOVEI	CH,177		;END OF COMMAND STRING MARKER
	AOS	A,COMCNT	;MARK END OF COMMAND STRING WITH ASCII 177
	IDPB	CH,RDDBP
	MOVEM	A,COMAX
	MOVE	P1,RDDBP		;SAVE END OF THIS COM STRING
	IBP	P1			; FOR POSSIBLE LATER USE
	IBP	P1			;POINTER BEFORE LAST THREE CHARS
	HRLI	P1,-3(A)
	MOVEM	P1,LSTCE
	SETZM	LISNF		;NO LONGER DOING COMMAND INPUT
	SKIPN	SLENTH		;IF NO WINDOW,
	CALL	LM			;MAKE SURE AT LEFT MARGIN
LINOCR:	TXNE	FF,TRACEF		;ARE WE TRACING?
	CALL	WINCLS		;YES, SO DON'T LET SCREEN WIPE OUT TRACINGS!
	CALL	CFLUSH		;[502] CLEAR MISC FLAGS
	SETZM	EXECOP		;[502] CLEAR THESE HERE
	SETZM	LASTOP		;[502] ..
	JRST	ICMD		;[502] GO DO WORK

C$LUP:	BYTE(7) "-","L",.CHTRM,.CHTRM
C$LUPT:	BYTE(7) "-","L","T",.CHTRM,.CHTRM
C$LDW:	BYTE(7) "L",.CHTRM,.CHTRM
C$LDWT:	BYTE(7) "L","T",.CHTRM,.CHTRM
C$CHR:	BYTE(7) "C",.CHTRM,.CHTRM
C$CHL:	BYTE(7)	"-","C",.CHTRM,.CHTRM
C$NULL:	BYTE(7) " ",.CHTRM,.CHTRM


;SUBBP ROUTINE SUBTRACTS TWO ASCII BYTE POINTERS GIVEN IN A AND B,
;YIELDING CHARACTER DIFFERENCE IN B

SUBBP:	LDB	C,[360600,,A]	;C TELLS HOW FAR FROM RIGHT EDGE A IS
	LDB	D,[360600,,B]	;D SHOWS HOW FAR FROM RIGHT EDGE B IS
	SUB	C,D			;BITS DIFFERENT A AND B ARE
	IDIVI	C,7		;CHARACTERS DIFFERENT A AND B ARE
	SUB	A,B		;CALCULATE HOW MANY WORDS APART A AND B ARE
	IMULI	A,5		;CHANGE FROM WORDS TO CHARACTERS
	SUBI	A,(C)		;GET TOTAL CHARACTER DIFFERENCE
	HRRZ	A,A		;GET RID OF GARBAGE IN LEFT HALF
	RET

LIXPND:	MOVEI	C,100
	ADDM	C,CBUFH		;ALLOW COMMAND TO EXTEND FURTHER
	MOVE	P1,EQRBUF
	IDIVI	P1,5		;p1:=QREG BUFFER END WORD ADDRESS.
	MOVE	P2,QRBUF
	IDIVI	P2,5		;p2:=Q-REG BUFFER BASE WORD ADDRESS.
	SUBM	P1,P2		;NO. OF WORDS IN Q-REG AND DATA BUFFER.
	MOVE	CH,(P1)
	MOVEM	CH,100(P1)	;MOVE Q-REG AND DATA BUFFERS UP 100 WORDS.
	SOS	P1
	SOJGE	P2,.-3
	MOVEI	P1,500
	ADDM	P1,QRBUF		;QRBUF:=p1(QRBUF)+500
	ADDM	P1,EQRBUF		;UPDATE END OF QREG BUF
	RET

;ROUTINE TO SKIP IF CHARACTER SHOULD BE FLAGGED (WRONG CASE OR CONTROL)

SFLAGC:	CAIL	CH,37		;IS CHARACTER CONTROL?
	JRST	SFNC		;NO
	CAIE	CH,.CHESC		;IS CHARACTER AN ESCAPE
	AOS	(P)			;YES, SO NO FLAG
	RET				;CONTROL, NOT ESCAPE, FLAG IT
SFNC:	SKIPN	FLAGF		;CASE SWITCH UPPER?
	RET			;CASE SWITCH 0, NO FLAG
	MOVX	A,CH%UPR		;FLAGGING UPPERASE, GET UPPERCASE BIT
	TDNE	A,CHRTAB(CH)	;IS CHARACTER UPPERASE?
	AOS	(P)			;GIVE SKIP
	RET
LI84:	CAIN	A,C.LEFT
	MOVE	B,[POINT 7,C$LUPT] ;-LT$$ FOR NON-VT05, "BACKSPACE" IS -LT.
	CAIE	A,C.LEFT
	JRST	LI96		;JUMP IF FIRST CHARACTER IS NOT A "BS"
	SKIPE	SLENTH
	MOVE	B,[POINT 7,C$LUP]
			;DON'T DO THE "T" IF WE'RE USING A NON-0 WINDOW SIZE.
LI96:	JUMPN	B,LIFAKE		;JUMP IF CHARACTER IS SPECIAL
	JRST	LI85		;GO PUT IT BACK INTO INPUT STREAM

;DECREMENT ASCII BYTE PTR

DBP:	CAMN	TT,HOLEPT		;SITTING JUST TO RIGHT OF HOLE?
	MOVE	TT,HOLBPT		;YES, SO GET TO LEFT OF IT
	ADD	TT,[7B5]		;BACK UP POINTER
	JUMPGE	TT,.+2		;SKIP IF P NOT NOW 44 OR MORE
	SUB	TT,[43B5+1]		;FIX FUNNY POINTERS
	RET
;ROUTINE TO RETURN NEXT CHARACTER FROM COMMAND BUFFER AND ERROR IF EMPTY.
;CALL CALL SKRCH
;	RETURN WITH CHARACTER IN CH
;GOES TO ERR IF COMMAND BUFFER IS EMPTY

SKRCH:	SKIPN	COMCNT		;COMMAND BUFFER EMPTY?
SKRCQE:	ERROR <Missing command character(s) or terminator>

;ROUTINE TO RETURN NEXT CHARACTER FROM COMMAND BUFFER.
;CALL CALL RCH
;	RETURN ALWAYS WITH CHARACTER IN CH

RCH:	SOSGE	COMCNT		;DECREMENT COMMAND BUFFER CHARACTER COUNT
				;IS COMMAND BUFFER EMPTY?
	JRST	RCH2		;YES. POP UP TO HIGHER MACRO LEVEL.
	ILDB	CH,CPTR		;NO. GET COMMAND CHARACTER IN CH
	TXNE	FF,SCANF	;DON'T PRINT CHARACTERS BEING SCANNED OVER
	RET
	MOVE	A,CH		;TYO WANTS CHARACTER IN A
	XCT	TRACS		;RETURN OR JRST TYO IN TRACE MODE

RCH2:	POP	P,CH		;SAVE RETURN FOR POPJ IN CH
	SKIPE	INTDPH		;MAKE SURE ITERATIONS HAVE ENDED!
	ERROR <Unended iteration loop>
	POP	P,INTDPH		;RESTORE PREVIOUS NESTING DEPTH
	CALL	RESCMD		;RESTORE PREVIOUS COMMAND STATE
	PUSH	P,CH		;GET RETURN BACK ON PDL.
	JRST	RCH		;TRY AGAIN.

;ROUTINE TO PEEK AT NEXT CHARACTER IN COMMAND STRING WITHOUT ACTUALLY
;READING IT.  SKIPS IFF THERE WAS ONE TO READ, RETURNS IT IN CH.

PEEKCH:	MOVE	CH,COMCNT		;SEE IF MORE COMMAND
	SOJL	CH,CPOPJ		;JUMP IF THERE ISN'T
	MOVE	CH,CPTR		;THERE IS, SO PEEK AT NEXT CHARACTER
	ILDB	CH,CH
	JRST	CPOPJ1

;GET CHARACTER W/O TRACE - USED WHEN SKIPPING IN CONDITIONALS

SKRCH1:	SOSGE	COMCNT		;ANY CHARACTERS LEFT?
	JRST	SKRCQE		;NO, GO ERROR
	ILDB	CH,CPTR		;YES. GET A CHARACTER.
	RET			;RETURN.

;These blocks are used by the command "parser" to point to the proper
;range and table for each command type.

PREPTR:	0,,CMDPTR		;PREFIX TYPE 0 (NONE)
	0,,SEMPTR		;PREFIX TYPE PRE.SM
	0,,UPAPTR		;PREFIX TYPE PRE.UP
	COLFLG,,CMDPTR		;PREFIX TYPE PRE.CL
	ATSFLG,,CMDPTR		;PREFIX TYPE PRE.AT

COLFLG:	COLONF
ATSFLG:	SLSL

UPAPTR:	0,,CMDTAB		;USE MAIN TABLE FOR ^ COMMANDS
	"@"			;OFFSET BY "@"
	"@"+UPALEN		;LENGTH IS CONTROL CHAR RANGE

CMDPTR:	0,,CMDTAB		;UNPREFIXED COMMANDS
	0			;THERE IS NO OFFSET FOR THESE!
	0+CMDLEN		;MAX LEGAL IS TABLE LENGTH

SEMPTR:	0,,SEMTAB		;SEMICOMMANDS USE SEMTAB TABLE
	.CHESC			;OFFSET BY ESCAPE
	SEMLEN+.CHESC		;MAX IS TABLE LENGTH OF SEMTAB


ICMD:	SKIPE	ABORTF		;<RUB>, ^G, I/O ERROR
	JRST	ABORT		;ARE ALL EXCUSES TO QUIT
	SETZM	DLIMIT		;NO FUNNY DELIMITERS WHILE SCANNING
ICMD2:	CALL	RCH		;GET THE COMMAND CHARACTER
	CAIN	CH,177		;MAGIC EOC CHARACTER?
	JRST	[SETZM INIJFN
		 JRST GO]	;YES, END OF TV.INI
	CAIE	CH,140		;EXPLICIT TEST FOR GRAVE, IT'S NOT AN ATSIGN
	CAILE	CH,172		;ABOVE A LOWER CASE Z
	JRST	NOSUCH		;IS CONSIDERED ILLEGAL
	CAIL	CH,141		;IS THIS CHARACTER LOWERCASE?
	SUBI	CH,40		;YES, CONVERT TO UPPER CASE
	MOVE	A,PREFXC
	CAMN	CH,TERMIN	;TERMINATOR?
	JUMPE	A,TERCMD	;YES, TERMINATE COMMAND IF NOT PREFIXED
	MOVE	B,PREPTR(A)	;B POINTS TO RANGE/INFO BLOCK
	HLRZ	A,B		;LH (IF >0) IS LOC OF FLAGS TO OR IN
	CAIE	A,0		;IS IT?
	OR	FF,(A)		;YES, OR IN FLAGS
	SETZM	PREFXC		;GOT TYPE, CLEAR PREFIX STATE
NPREFX:	MOVE	C,1(B)		;GET LOW LIMIT IN C
	CAMG	CH,2(B)		;DOES IT EXCEED THE UPPER BOUND?
	CAMGE	CH,C		;OR IS IT LESS THEN THE LOWER BOUND?
NOSUCH:	ERROR <Undefined command> ;COMMAND LOSES
	SUBM	CH,C		;OFFSET BY LOWER BOUND AND STORE IN C
	ADD	C,(B)		;AND ADD POINTER TO PROPER TABLE
	MOVE	A,(C)		;PICKUP COMMAND INFO
	HRRZ	B,A		;GET DISPATCH ADDR, PREFIX TYPE OR 0
	JUMPE	B,NOSUCH	;IF ZERO, NONESUCH
	TXNE	A,CM.PRE	;IS THIS A PREFIX CHARACTER?
	JRST	[MOVEM B,PREFXC ;YES, STORE AS SUCH (TYPE IN B)
		 JRST ICMD2]	;AND GO GET THE REST OF THE COMMAND
	TXNN	A,CM.EXE	;IS THIS COMMAND EXECUTED EVEN WHILST SCANNING?
	TXNN	FF,SCANF	;NO, ARE WE SCANNING?
	JRST	GODO		;THIS COMMAND ACTUALLY GETS DONE
	LDB	A,[POINT 9,A,17] ;SCANNING - FETCH OFFSET INTO ARG TABLE
	JUMPE	A,ICMD		;IF ZERO, THIS COMMAND HAS NO TRAILING ARGS
	MOVEI	C,ARGTAB(A)	;ELSE FETCH THE POINTER TO THEM.
	HRLI	C,(POINT NBACS)	;STORED IN A STRING, BYTE SIZE NBACS
	MOVEM	C,SKPPNT	;STORE POINTER FOR ILDBing
SKPTRL:	ILDB	A,SKPPNT	;PICKUP TRAILING ARG TYPE
	JUMPE	A,ICMD		;IF ZERO, DONE SCANNING OVER TRAILING ARGS
	CALL	@SKPTAB(A)	;ELSE, GO DO ROUTINE TO SKIP THE TYPE OF ARG
	JRST	SKPTRL		;UNTIL ALL TYPES ARE DONE

GODO:	TXNE	FF,SCANF	;IF EXECUTING WHILE SCANNING...
	JRST	DOCALL		;THEN SKIP REST OF CHECKING, AND PUSHJ OUT
	TXNE	FF,SLSL		;IS ATSIGN SET FOR THIS COMMAND?
	TXNE	A,CM.ATS	;YES, IS IT MEANINGFUL?
	SKIPA	C,LASTOP	;YES, SKIP WITH LAST OP SEEN
	ERROR	<Atsign modifier seen for command that cannot accept it>
	MOVEM	C,EXECOP	;STORE OP TO DO AFTER THIS COMMAND
	SETZM	LASTOP		;AND LEAVE LASTOP EMPTY
	MOVE	C,FARG		;IT'S OK, GET THE FIRST ARG
	TXNE	A,CM.OPR	;IS THIS AN OPERATOR COMING UP?
	MOVEM	C,PREOPV	;STORE THE PRE-OP VALUE
	TXNN	FF,ARG		;IS THERE AN ARG HERE?
	TXNN	A,CM.0AI	;NO. IS THAT LEGAL?
	SKIPA	P1,SARG		;COMBO OK, PICK UP ANY SECOND ARG
AG0QE:	ERROR	<Argument is missing>
	SETO	T,		;ASSUME NO ARGS
	TXNN	FF,ARG		;IS THERE ONE?
	JRST	DOCALL		;NO, OK TO DO THIS COMMAND
	TXNN	FF,ARG2		;YES, ARE THERE TWO?
	TDZA	T,T		;NO
	MOVEI	T,1		;YES!
	XCT	[TXNN A,CM.1AI	;ONE ARG WHEN ONE IS ILLEGAL
		 TXNN A,CM.2AI](T) ;TWO WHEN TWO IS WRONG
	JRST	DOCALL		;NO, ITS OK, GO DO
	CAIE	T,0		;WHICH ERROR?
AG2QE:	ERROR	<Two args where two args aren't allowed>
	SKIPL	EXECOP		;WEAK OP CARRYING A VALUE?
AG1QE:	ERROR	<Arg given where it isn't allowed>
	SETZM	EXECOP		;IT WAS MEANINGLESS, JUST KILL IT
	SETO	T,		;SET TO RIGHT NUMBER OF ARGS
	TXZA	FF,ARG		;AND SAY NONE, AND GO ON
TERCMD:	MOVEI	B,CFLUSH	;TERMINATOR CHARACTER AS COMMAND COMES HERE
;Commands branch here. They see the number of passed args -1 in T, the
;first arg (if any) in C, the second arg (if any) in P1.

DOCALL:	CALL	(B)		;GO DO IT
	 JFCL			;IN CASE SOMETHING HAS A SKIP RET
	SKIPN	A,EXECOP	;IS THERE AN OP TO DO?
	JRST	ICMD		;NO, GO GET NEXT COMMAND
	SKIPN	B,LASTOP	;DID WE JUST SEE ANOTHER OP?
	JRST	GODOOP		;NO, GO DO OP (IF ARGS ARE THERE)
	JUMPG	B,ICMD		;IF REAL LASTOP, LOSE ANY EXECOP
	JUMPL	A,ICMD		;WEAK LASTOP. IF EXECOP WEAK, REPLACE IT
DOP:	MOVEM	A,LASTOP	;WEAK LASTOP. DEFER EXECOP TO GET PAST SPACE!
	JRST	ICMD		;AND GO
GODOOP:	TXNE	FF,ARG		;GOT A GOOD EXECOP. GOT ARGS FOR IT?
	JRST	GARGOP		;GOT AN ARG TO OP ON
	JUMPL	A,DOP		;DONT. IF OP IS WEAK, DEFER IT
	ERROR	<Nothing returned a value after an Operator or Comma>
GARGOP:	MOVE	C,PREOPV	;GET PRE-OP ARG
	MOVE	B,FARG		;AND THE POST OP ONE
	TXZE	A,OPF.NG	;REQUEST 2ND ARG BE NEGATED FIRST?
	MOVN	B,B		;DONE
	XCT	BINFUN(A)	;AND DO THE BINARY FUNCTION
	MOVEM	C,FARG		;AND STORE RESULT
	JRST	ICMD		;GO GET NEXT COMMAND
;Table that indicates what function is to be done when a binary op becomes due.
;OP.nnn is used to index into it

	OP.NOP==1
	OP.ADD==2
	OP.SUB==3
	OP.MUL==4
	OP.DIV==5
	OP.AND==6
	OP.IOR==7
	OP.XOR==10
	OP.ANC==11		;AND /W COMPLEMENT

	OPF.NG=1B18		;NEGATE SECOND VALUE (A op -B)

;TRNA IS USED TO SKIP OVER THE MOVEM (IE, DO NOTHING)
BINFUN:	TRNA			;NOT INDEXED BY 0
	MOVE	C,B		;USED IF "OP" DEMANDS TRAILING VALUE
	ADD	C,B		;ADD IS 2
	SUB	C,B		;SUB IS 3
	IMUL	C,B		;IMUL IS 4
	CALL	DODIVI		;IDIV IS 5, GO DO AND SAVE REMAINDER
	AND	C,B		;AND IS 6
	IOR	C,B		;OR IS 7
	XOR	C,B		;XOR IS 10
	ANDCM	C,B		;ANDCM IS 11

DODIVI:	IDIV	C,B		;IDIV IS 5
	MOVEM	D,DIVREM	;KEEP REMAINDER AROUND FOR THE ;/ COMMAND.
	RET
;This table is index by the SC.xxx values. The represent the addresses of
;routines to CALL when a certain type of trailing arg is to be skipped

SKPTAB:	0			;NOT INDEXED BY ZERO
	SKRCH1			;HERE TO SKIP ONE CHARACTER !CS.SY1
	SKRCH1			;HERE TO SKIP QREG (ONE CHARACTER) !CS.QRG
	SKPDIG			;HERE TO SKIP A DIGIT STRING, LEN.GE.0 !CS.DIG
	SKPSTR			;HERE TO SKIP SIMPLE STRING !CS.STR
	SKPINS			;HERE TO SKIP INSERT STR !CS.INS
	SKPSRS			;HERE TO SKIP SEARCH STRING !CS.SRS

;Skip a string of digits of length greater or EQUAL to zero.
SKPDIG:	CALL	PEEKCH		;CHECK NEXT CHAR IF ANY
	 RET			;NONE, NUMBER SKIPPED OVER
	CAIN	CH,"."		;IS IT THE OCTAL INDICATOR?
	JRST	SKRCH1		;YES, READ IT, AND NUMBER ENDS HERE
	CAIL	CH,"0"
	CAILE	CH,"9"		;IS IT A DIGIT?
	RET			;STOP ON NONNUMERIC
	PUSHJ	P,SKRCH1	;SKIP THE DIGIT
	JRST	SKPDIG		;AND GO FOR NEXT CHAR

;Skip over a simple string, such as ^Atext$ uses.
SKPSTR:	CALL	GETDLM		;GO FIGURE OUT DELIMITER, STORE IN DLIMIT
SKPST1:	CALL	SKRCH1		;SCAN UNTIL GOT IT
	CAME	CH,DLIMIT	;..
	JRST	SKPST1		;NOT YET...
	RET			;GOTCHA.

;Skip over an Insert string, such as Itext$ or Rtext1$text2$ uses.
SKPINS:	CALL	GETDLM		;GET DELIMITER INTO DLIMIT
SKPIN1:	CALL	SKRCH1		;GET CHARACTER FROM STRING
	CAMN	CH,DLIMIT	;IS CHARACTER MEANING "END"?
	RET			;YES, JUST LEAVE
	CAIE	CH,C.LOWR	;IS CASE OF NEXT CHAR BEING SHIFTED?
	CAIN	CH,C.RAIS	;..?
	MOVEI	CH,C.QUOT	;YES, TREAT EXACTLY LIKE QUOTING CHAR
	CAIN	CH,C.QUOT
	CALL	SKRCH1		;WE ARE QUOTING SOMETHING, GOBBLE WHAT'S QUOTED
	JRST	SKPIN1		;AND GO GET NEXT CHAR

;Skip over search strings. This can involve recursion and things of like
;messiness, esp. with ^N or ^E in the string.
SKPSRS:	CALL	GETDLM		;GET DELIMITER INTO DLIMIT
SKPSR1:	CALL	SKRCH1		;GET INITIAL CHARACTER IN TOKEN
	CAMN	CH,DLIMIT	;IS IT END-OF-STRING?
	RET			;YES, HAPPY DAYS
	CALL	IDNTKN		;GO SCAN OVER IF ITS A TOKEN
	JRST	SKPSR1		;AND GET NEXT

IDNCHR:	CALL	SKRCH1		;HERE IF IDNTKN NEEDS A NEW CHAR BUT CARES
				;NOT ABOUT END-OF-STRING CHAR
IDNTKN:	CAIN	CH,"N"-100	;IS IT THE ^N TOKEN?
	CALLRET	IDNCHR		;YES, FETCH NEXT TOKEN AND LEAVE
	CAIE	CH,^D17		;IS IT OLD-STYLE QUOTE
	CAIN	CH,C.QUOT	;OR NEW STYLE QUOTE?
	CALLRET	SKRCH1		;YES, READ A CHARACTER AND LEAVE
	CAIE	CH,"E"-100	;IS IT AN ^E?
	RET			;NO, ITS A SINGLE CHAR TOKEN, DONE
				;(^X,^S need nothing special)
	CALL	SKRCH1		;WHAT KIND OF ^E ARE YOU?
	CAIN	CH,^D60		;AN OPEN ANGLE BRACKET?
	JRST	[CALL SKPDIG	;YES, SKIP THE NUMBER FOLLOWING...
		 CALL SKRCH1	;AND WHAT SHOULD BE A CLOSEANGLE
		 RET]		;AND LEAVE
	CAIE	CH,"["		;MAYBE HEAVY RECURSION AHEAD
	RET			;NO, IT WAS ^Ex
CEBSCN:	CALL	IDNCHR		;RECURSION... "TURNING AND TURNING IN THE
				;WIDENING GYRE..."
	CALL	SKRCH1		;FETCH A CHARACTER, SHOULD BE ] OR ,
	CAIN	CH,","		;LOOK AND SEE
	JRST	CEBSCN		;ITS A REQUEST FOR THE NEXT IN-^E TOKEN
	CAIN	CH,"]"		;IS THIS THE END OF THE ^E[] ?
	RET			;GOOD, UNWIND
	ERROR	<Comma or "]" required, can't skip over string>


;This decides what the delimiter is for the string about to be scanned over -
;ie, ESC unless atsign form is indicated. The delimiter is returned in DLIMIT.
GETDLM:	SKIPE	DLIMIT		;DO WE ALREADY HAVE A KNOWN DELIMITER?
	RET			;YES, USE IT
	MOVE	CH,TERMIN	;DEFAULT STRING END IS <ESC>
	TXZE	FF,SLSL		;BUT IF ATSIGN FLAG IS LIT
	TXNN	A,CM.ATS	;AND IS NOT MEANINGLESS HERE	
	TRNA			;(NOT CHANGING DELIMITER)
	CALL	SKRCH1		;THEN THE NEXT CHAR IS THE DELIMITER
	MOVEM	CH,DLIMIT	;STORE IT.
	RET
;Routines to return args.
;CFLUSH is what CRET used to be (clears all args & flags)
;All commands should exit by JRSTing here, except for special convolutions and
; fudgery. Commands not changing the arguments may simply RET.
;The meanings are:
;
;ARGXNA - the command stores athe arg in AC A. This wont turn off SLSL or
;	COLONF, but is otherwise like ARGINA. CDNUM needs this.
;ZERINA - command returns a 0
;NE1INA - command returns -1
;ARGINA - the command stores the arg in AC A. This makes sure that the one
;	arg is on, unless two args have already been specified. This turns
;	off SLSL and COLONF.
;ARGINC - same as ARGINA, except the arg is in AC C.
;ARGIN - lights the arg returned (ARG) flag. assumes arg(s) already stored

CFLUSH:	TXZ	FF,COLONF!FINDR!PCHFLG!SLSL!ARG2!ARG ;HERE TO TOSS OUT FLAGS
	SETZM	PREOPV
	SETZM	FARG		;CANT CLEAR EXECOP/LASTOP HERE
	RET			;DONE

ARGXNA:	MOVEM	A,FARG		;STORE THE ARG IN A
	JRST	ARGIN		;BUT DON'T MEDDLE WITH SLSL OR COLONF
ZERINA:	TDZA	A,A		;COMMAND RETURNS A ZERO
NE1INA:	SETO	A,		;COMMAND RETURNS A -1
ARGINA:	MOVE	C,A		;STORE THE ARG IN A
ARGINC:	MOVEM	C,FARG		;STORE THE ARG IN C
ARGINF:	TXZ	FF,SLSL!COLONF	;CLEAR THIS-COMMAND-ONLY FLAGS
ARGIN:	TXO	FF,ARG		;RETURNING AN ARG
CPOPJ:	RET
;MAIN COMMANDS BRANCHED TO BY COMMAND PARSER START HERE.

SPACC:	TXNN	FF,ARG		;IS THERE AN ARG FOR ME?
	RET			;NO, LEAVE THINGS JUST AS THEY ARE...
	SKIPA	A,[1B0+OP.ADD]	;SET LASTOP FOR OP ADD, 1B0 MEANS TENTATIVE
PLUS:	MOVEI	A,OP.ADD	;OPERATION REQUESTED IS ADD
SETBOP:	MOVEM	A,LASTOP
	CAIL	A,0		;IF NOT A TENTATIVE OP,..
	TXZ	FF,ARG		;SAY NO ARG WAITING
	RET

MINUS:	MOVEI	A,OP.SUB	;SUBTRACT
	SKIPN	EXECOP		;IS AN ARG WAITING?
	JRST	SETBOP		;GO SET BINARY OP CONDITION
	MOVEI	A,OPF.NG	;OH! THIS IS DIFFERENT...
	XOR	A,EXECOP	;REMEMBER OPERATION, BUT SAY TO NEGATE POSTOP
	SETZM	EXECOP
	MOVEM	A,LASTOP
	RET			;AND GO PLAY


COMMA:	MOVEM	C,SARG		;STORE ARG
	TXO	FF,ARG2		;TWO ARG2 CONDITION
	TXZ	FF,ARG		;BUT NOT ONE ARG CONDITION, YET.
	MOVEI	A,OP.NOP	;BINARY OP CONDITION FORCES FOLLOWING NUMBER
	JRST	SETBOP		;GO STORE AND RETURN

CAND:	MOVEI	A,OP.AND	;AND OPERATION
	TXNE	FF,COLONF	;:& FUNCTION?
	MOVEI	A,OP.ANC	;YES, AND WITH COMPLEMENT
	JRST	SETBOP

COR:	MOVEI	A,OP.IOR	;OR OPERATION
	TXNE	FF,COLONF	; :# FUNCTION?
	MOVEI	A,OP.XOR	;YES, XOR
	JRST	SETBOP

TIMES:	MOVEI	A,OP.MUL	;MULTIPLY OPERATION
	JRST	SETBOP

SLASH:	MOVEI	A,OP.DIV	;DIVIDE OP
	JRST	SETBOP

CDNUM:	MOVEI	C,-60(CH)	;[502] CONVERT FIRST DIGIT TO A VALUE
;**;[505] At CDNUM: +1L, Added 1 line           	SM	13-Apr-82
	MOVE	D,C		;[505] TWO COPIES; DECIMAL AND OCTAL
CDNUM1:	CALL	PEEKCH		;[502] GET NEXT DIGIT OR DOT, IF ANY
	 JRST	ARGINC		;[502] NONE, THE VALUE IS IN C
	CAIN	CH,"."
	JRST	CDNUM2		;[502] IF A DOT, MUST GO CONVERT TO OCTAL
	CAIL	CH,"0"		;[502] IS A DIGIT?
	CAILE	CH,"9"		;[502] ..
	JRST	[MOVE A,C	;[502] NO, SO WE ARE DONE
		 JRST ARGXNA]	;[502] GO EXIT OUT, PRESERVING FLAGS
	IMULI	C,^D10		;[502] A POWER OF 10 UP...
	ADDI	C,-60(CH)	;[502] AND IN THE NEW LOWORDER DIGIT
;**;[505] At CDNUM1: +10L, Added 2 lines        	SM	13-Apr-82
	LSH	D,3		;[505] GET OCTAL JUST IN CASE
	IORI	D,-60(CH)	;[505] AND ADD IN THE DIGIT.
	CALL	RCH		;[502] TOSS READ DIGIT
	JRST	CDNUM1		;[502] AND GO GET NEXT
CDNUM2:	CALL	RCH		;[502] TOSS DOT OUT
;**;[505] At CDNUM2: +1L, Replaced 2 lines with 1	SM	13-Apr-82
	MOVE	A,D		;[505] GET THE OCTAL
	JRST	ARGXNA		;[502] RETURN WITH VALUE IN PLACE

RNGE:	MOVM	C,C		;GET MAGNITUDE OF FIRST ARG
	TXZE	FF,ARG2		;IS THERE A SECOND ARG?
	SUB	C,P1		;YES, SUBTRACT IT OFF
	JRST	ARGINC		;RETURN RESULT

VRSN:	TXZE	FF,SLSL		;[526]ATSIGN FORM?
	SKIPA	C,FTUVAL	;[526]YES, RETURN OPTION WORD
	MOVE	C,VRSNI		;[526]NO, RETURN VERSION WORD
	JRST	ARGINC		;RETURN VALUE FOR USER

QCVAL:	CALL	QREGVI		;A:=QTAB ENTRY, CH:=Q-REG INDEX
	MOVE	C,A
	PUSH	P,CH
	CALL	QGET2		;GET NUMBER OF CHARS
	POP	P,C			;Q-REG INDEX
	TXZE	FF,SLSL		;@FORM?
	JRST	QABSOL		;YES, RETURN BYTE POINTER TO QREG...!
	MOVE	A,P1		;GET QREG LEN IN A, IN CASE NO ARGS
	TXNN	FF,ARG		;ANY ARGS?
	JRST	ARGINA		;NO ARGS, JUST RETURN LENGTH
QCV2:	SKIPLE	FARG
	CAMGE	A,FARG		;IS REFERENCE WITHIN QREG LENGTH?
	JRST	QCVLQE		;NO, GO DECIDE ON ERROR TYPE
	MOVE	I,QTAB-"0"(C)
	TLZ	I,(-1B14)
	ADD	I,QRBUF
	ADDI	I,3
	ADD	I,FARG		;PUT CHARACTER ADDRESS INTO I
	CALL	GETX		;GET POINTER TO BYTE IN TT
	MOVE	C,SARG
	LDB	A,TT
	TXZE	FF,ARG2		;READ OR WRITE?
	DPB	C,TT
	JRST	ARGINA
QCVLQE:	TXNN	FF,COLONF		;DID HE EXPECT THE WORST?
	ERROR	<Qreg character reference out of bounds>
	JRST	NE1INA		;RETURN -1 IF ILLEGAL (YES, UNCONVENTIONAL...)
QABSOL:	MOVE	I,QTAB-"0"(C)
	TLZ	I,(-1B14)
	ADD	I,QRBUF
	ADDI	I,3
	CALL	GETX
	MOVE	C,TT
	JRST	ARGINC

REMDIV:	MOVE	C,DIVREM
	JRST	ARGINC		;GET REMAINDER FROM LAST IDIV

RAND:	TXNE	FF,ARG		;RANDOM NUMBERS ARE NICE FOR TEXT JUSTIFICATION
	CAIN	C,0
	MOVEI	C,^D100
	SKIPE	A,ISEED
	JRST	WRAND1
	GTAD%
	AND	A,CONS4
	CAIN	A,0
	MOVEI	A,^D123457
	MOVEM	A,ISEED
WRAND1:	MUL	A,CONS3
	DIV	A,CONS4
	MOVEM	B,ISEED
	MOVSI	A,237K
	DFAD	A,[EXP 0,0]
	FLTR	C,C
	FMP	C,A
	FIX	C,C
	JRST	ARGINC
CONS3:	^D16807
CONS4:	17777,,-1

ARRY:	TXNE	FF,SLSL		;ATSIGN?
	JRST	[MOVEI A,USRARY	;@^Y RETURNS PHYSICAL LOC OF ARRAY!
		 TXNE FF,COLONF	;:@^Y RETURNS THE LENGTH OF THE ARRAY!
		 MOVEI A,USARYL
		 JRST ARGINA]	;DONE
	JUMPL	T,AG0QE		;IF NO ARGS, COMPLAIN BITTERLY
ARRY1:	CAIL	C,0		;ILLEGAL ARRAY REFRENCE IF .LE. 0
	CAIL	C,USARYL		;IN LEGAL RANGE FOR ARRAY?
ARRYQE:	ERROR <Reference to array is out of bounds>
	MOVE	A,USRARY(C)	;GET VALUE THAT IS THERE
	TXZE	FF,ARG2		;DOES HE WANT TO STORE A NEW VALUE?
	MOVEM	P1,USRARY(C)	;YES, STORE IT FOR HIM
	JRST	ARGINA		;DONE

DUJSI:	HLRZ	A,FARG		;DID HE SPECIFY HIS OWN OPCODE/AC/ETC?
	JUMPN	A,DUXCT
	MOVEI	A,(JSYS)	;THE OPCODE OF A JSYS
	HRLM	A,FARG		;THE USER PROVIDED A JSYS NUMBER
DUXCT:	DMOVE	1,USRARY+1	;GET USER AC'S
	DMOVE	3,USRARY+3	;..
	DMOVE	5,USRARY+5	;..
	SETOM	USRARY+0	;SET ERROR FLAG TO -1 (NO ERROR YET)
	XCT	FARG		;BE IT ON HIS OWN HEAD...
	 ERJMP	DUJSIE		;HE LOSES
	JRST	CLNJSI
	JRST	CLNJSI		;SOME JSI HAVE MULTIPLE SKIPS
DUJSIE:	DMOVEM 	A,USRARY+1
	MOVEI	A,.FHSLF	;GO DISCOVER WHAT HIS ERROR WAS
	GETER%			;..
	 ERJMP	CLNJS2		;IT WONT FAIL.
	HRRZM	B,USRARY+0
	JRST	CLNJS2		;WE ALREADY STORED AC1/2
CLNJSI:	DMOVEM	1,USRARY+1
CLNJS2:	DMOVEM	3,USRARY+3
	DMOVEM	5,USRARY+5	;RESTORE AC'S BACK
	TXZN	FF,ARG2		;DOES HE WANT A WORD RETURNED?
	JRST	DUJEN1		;NO, GO SEE IF HE WANTS ERRORS RETURNED
	MOVE	C,SARG		;THE SECOND ARG IS THE INDEX OF THE WORD
	TXZ	FF,SLSL		;CLEAR ATSIGN
	JRST	ARRY1		;AND BECOME AN ARRY COMMAND

DUJEN1:	TXNN	FF,COLONF	;RETURN ERROR INDICATION OR -1?
	JRST	CFLUSH		;NOPE
	MOVE	C,USRARY+0	;RETURN VALUE
	JRST	ARGINC		;AND DONE

HLFWRD:	TXZE	FF,SLSL		;ATSIGN FORM?
	JRST	SPLWRD		;YES, GO SPLIT LH,,RH
	TXZN	FF,ARG2		;DID HE PROVIDE BOTH ARGS?
	SETZ	P1,		;NOPE, ASSUME ZERO
	HRL	C,P1		;BUILD PRECOMMA ARG LH, POST RH
	TXNE	FF,COLONF	;ETO CHTO ONI KHOTCHUT?
	MOVSS	C		;NYET, TOVARISHCH, NYET...
	JRST	ARGINC		;UVIDIMSYA
SPLWRD:	TXZE	FF,COLONF	;CUANDO?
	HLRZS	C		;LA OTRA, POR FAVOR
	ANDI	C,-1		;DAMELO, 
	JRST	ARGINC		;Y ADIOS.

ENTFVR:	MOVE	C,ENTFLG
	JRST	ARGINC		;NO, GIVE USER THE ENTRY FLAG

UDFFLS:	TXNN	FF,ARG		;ARG GIVEN?
	SETZM	FARG		;NO, ASSUME ZERO
	SKIPE	CEYFLG		;DID SOME SEARCH USE THIS?
	SETOM	SRPF		;YES, MUST REPARSE
	TXNN	FF,SLSL		;DECIDE DELIMITER
	SKIPA	CH,TERMIN	;DELIMITER WILL BE USUAL TERMINATOR
	CALL	SKRCH		;GET USER CHOICE
	MOVEM	CH,DLIMIT	;AND REMEMBER IN EITHER CASE
	MOVE	P1,FARG		;GET USER SELECTED COMMAND MODE
	ANDI	P1,3		;0-3 ONLY
	MOVX	C,CH%USR	;WE WILL BE DIDDLING /W THIS FLAG
	JUMPN	P1,UDFFS1	;IF NON-0, WE WILL NOT HAVE TO CLEAR THE ARRAY
	MOVEI	CH,177		;ARRAY IS 177 LONG...
	ANDCAM	C,CHRTAB(CH)	;CLEAR THE BIT IN EACH ARRAY LOC
	SOJGE	CH,.-1		;..
	MOVEI	P1,1		;AND THE FUNCTION BECOMES 1
UDFFS1:	SKIPE	ABORTF		;^G TYPE INTERRUPT?
	RET			;YES, GIVE UP NOW
	CALL	SKRCH		;NO, GET NEXT CHARACTER.
	CAMN	CH,DLIMIT	;DELIMITER?
	JRST	CFLUSH		;YES, ALL DONE!
	XCT	TDLTAB-1(P1)	;NO, DO THE FUNCTION BASED ON C & CH
	JRST	UDFFS1		;AND GET NEXT CHARACTER

TDLTAB:	IORM	C,CHRTAB(CH)	;1=TURN ON
	ANDCAM	C,CHRTAB(CH)	;2=TURN OFF
	XORM	C,CHRTAB(CH)	;3=COMPLEMENT

UDFFL:	MOVEI	A,1		;ASSUME DEF OF 1
	TXNN	FF,ARG		;DID HE GIVE AN ARG?
	MOVEM	A,FARG		;YES, STUFF AWAY FOR LATER
	SKIPE	CEYFLG		;DID SOME SEARCH USE THIS OPTION?
	SETOM	SRPF		;YES, WE WILL NEED A REPARSE
	CALL	QREGVI		;WHICH QREG?
	MOVE	C,A		;QTST WANTS THE ENTRY IN C
	MOVEM	C,SYL		;WE'LL WANT THIS AGAIN LATER
	CALL	QTST		;IS IT WHAT IT SHOULD BE?
	 JRST	QGETQE		;NO. WE WANT TEXT!
	CALL	QGET2T		;HOW MANY CHARACTERS? INTO P1.
	MOVE	I,SYL		;GET THE ENTRY BACK
	TLZ	I,(-1B14)
	ADD	I,QRBUF
	ADDI	I,4		;POINT AT QREG TEXT
	MOVX	A,CH%USR	;BIT TO TWIDDLE
	SETZ	P2,		;POINTER INTO CHARACTER ARRAY.
MLP1:	SOSGE	P1		;DONE ALL CHARACTERS IN USER QREG YET?
	SKIPA	CH,FARG		;YES, USE DEFAULT
	CALL	GETINC		;NO, READ USER CHOICE
	ANDI	CH,3		;PARSE DOWN TO 2 BITS
	XCT	TWITAB(CH)	;DO THE OPERATION REQUESTED
	CAIGE	P2,177		;AT END OF TABLE?
	AOJA	P2,MLP1		;NO, GET NEXT
	JRST	CFLUSH		;DONE NOW

TWITAB:	ANDCAM	A,CHRTAB(P2)	;0 INDEX, TURN BIT OFF
	CAIL	P2,177		;1 INDEX, DO NOTHING (SAVES 1 INSTRUCTION...)
	IORM	A,CHRTAB(P2)	;2 INDEX, TURN ON BIT
	XORM	A,CHRTAB(P2)	;3 INDEX, COMPLEMENT BIT

;^F returns or modifies the iteration count

FITER:	TXNE	FF,COLONF
	JRST	[TXNN FF,ARG	;IS THERE AN ARG GIVEN?
		 SOSA C,ITERCT	;NO, ASSUME -1
		 ADDB C,ITERCT
		 JRST ARGINC]	;GO RETURN
	TXNN	FF,ARG
	SKIPA	C,ITERCT
	JRST	[MOVEM C,ITERCT
		 JRST CFLUSH]
	JRST	ARGINC

;^N BRANCHES TO THE BEGINNING OR END OF THE CURRENT ITERATION

ALTFLW:	SKIPN	INTDPH
	JRST	TCONQE		;IF NOT IN A LOOP, THIS IS AN ERROR
	TXNE	FF,COLONF	;IS THERE A COLON MODIFIER?
	JRST	ALTFL2		;YES, GO HANDLE
	TXNN	FF,ARG		;IS THERE JUST AN ARG?
	JRST	RSLOP		;NO, JUST ^N - GO TO BEGINNING OF LOOP
	MOVEM	C,ITERCT	;n^N - GO ALTER ITERATION COUNT AND MAYBE LEAVE
	JRST	ALTFLM
ALTFL2:	TXNN	FF,ARG		;ARG GIVEN?
	SOSA	C,ITERCT	;NO, ASSUME -1
	ADDB	C,ITERCT	;YES, ADD IN AND RETURN VALUE
ALTFLM:	JUMPLE	C,INCMA		;IF 0 OR LESS, WE WANT TO LEAVE THIS LOOP
	JRST	RSLOP		;ELSE, WE WANT TO GET TO LOOP'S BEGINNING
;FINISH OUTPUT AND RETURN TO THE TIME-SHARING EXEC.

;SEMICOLON X COMMAND IS LIKE EX COMMAND IN STANDARD TECO. IT DOES
;SEMICOLON U COMMAND, AND RETURNS TO EXEC.

EXCOM:	TXNN	FF,PERUS
	JRST	EXCOM1
	SETZM	DEFSPC
	SETZM	DEFNAM
	SETZM	DEFEXT
EXCOM1:	CALL	UNLOAD		;DO A ;U COMMAND

;SEMICOLON H COMMAND JUST RETURNS TO EXEC

DECDMP:	CALL	SINK		;WAIT FOR COMMAND STRINGS TO BE SAVED
	TXNE	FF,COLONF		;IF : FORM, DONT BOTHER TO CLEAR SCREEN
	JRST	DOHALT		;JUST FLY AWAY
	CALL	CLRSCN		;CLEAR THE SCREEN
	SETOM	MESFLG		;ASSUME SCREEN MESSED UP IF RETURNING TO EXEC
	JRST	DOHALT		;DO A HALT
;RETURNS THE VALUE OF THE FORM FEED FLAG


FFEED:	TXNE	FF,FORM		;IS IT SET?
	JRST	NE1INA		;YES, GO RETURN -1
	JRST	ZERINA		;NO, GO RETURN 0


;AN ABBREVIATION FOR B,ZEE

HOLE:	SETZM	SARG		;SET SECOND ARGUMENT TO 0.
	TXOA	FF,ARG2		;RETURNING 2 ARGS

;.=NUMBER OF CHARACTERS TO THE LEFT OF THE POINTER

PNT:	SKIPA	A,PT

;Z=NUMBER OF CHARACTERS IN THE BUFFER

END1:	MOVE	A,ZEE
	SUB	A,BEG
	JRST	ARGINA

;() MAY BE USED TO OVERRIDE LEFT TO RIGHT OPERATOR SCAN

OPEN:	POP	P,CH		;[502] GET RETURN ADDRESS FOR LATER JRST
	PUSH	P,PREOPV		;[502] SAVE THE OPERAND
	TXNE	FF,ARG2		;[502] IS THERE A SECOND ARG?
	PUSH	P,SARG		;[502] YES, SAVE IT
	MOVE	A,EXECOP		;[502] GET THE OP THAT'S DUE
	SETZM	EXECOP		;[502] CLEAR IT, IT'S NOT PENDING ANYMORE
	TXNE	FF,ARG2		;[502] DID WE STORE A 2ND VALUE?
	TLO	A,(1B17)		;[502] YEAH, RIGHT, FLAG IT
	PUSH	P,A		;[502] AND SAVE THIS MESS
	PUSH	P,PARCHK		;[502] ADD ON PAREN HEADER
	AOS	LEV			;[502] INCREMENT ( LEVEL.
	PUSH	P,CH		;[502] PUT THE RETURN ADDRESS BACK
	JRST	CFLUSH		;[502] CLEAR ARG2 AND ALL ELSE

CLOSE:	SOSGE	LEV		;IS THERE A (?
CLOSX:	ERROR <Unmatched right parenthesis>
	TXZE	FF,ARG2		;2 ARGS AT CLOSE PAREN TIME?
	ERROR <Two args given to a close parenthesis>
	POP	P,CH		;[502] FETCH OUR RETURN ADDRESS FOR LATER JRST
	POP	P,A		;[502] POP OFF THE "IS THIS A PAREN?" WORD
	CAME	A,PARCHK		;[502] IS THIS A PAREN?
	JRST	CLOSX		;[502] IT LOSES
	POP	P,A			;[502] GET OP & FLAGS
	TLZN	A,(1B17)		;[502] DID WE SAVE A SECOND ARG?
	JRST	CLOSY		;[502] NAY, SKIP THE 2ARG CODE
	TXO	FF,ARG2		;[502] YES, MARK ITS COMING BACK
	POP	P,SARG		;[502] PUT IT BACK
CLOSY:	POP	P,PREOPV		;[502] RETURN PRE-OP VALUE
	MOVEM	A,EXECOP		;[502] STORE OP BACK
	JRST	(CH)		;[502] AND DONE (ACT LIKE RET)
PARCHK:	707070,,CLOSX		;[502] PAREN HEADER
;N= CAUSES THE VALUE OF N TO BE TYPED OUT.

PRNT:	TXNN	FF,COLONF		;DONT LOCK DOWN SCREEN IF COLON FORM
	CALL	WINCLS		;ANNOUNCE BEGINNING OF DATA TO BE PRESERVED
	MOVEI	A,TYO
	PUSH	P,RADIX		;save current radix
	HRRM	A,LISTF5		;CONSOLE
	CALL	PEEKCH		;PEEK AT NEXT CHARACTER
	 JRST	PRNT1		;ISN'T ONE
	CAIE	CH,"="		;and if "==" seen,
	JRST	PRNT1		;(it wasn't)
	CALL	RCH		;then print number in octal
	MOVEI	A,8
	MOVEM	A,RADIX
PRNT1:	MOVE	C,FARG		;GET THE NUMBER
	CALL	DPT
	MOVEI	A,"."		;get decimal point
	MOVE	B,RADIX		;and radix number was printed in
	CAIN	B,8		;octal printout ??
	CALL	TYO		;yes, so print decimal point
	POP	P,RADIX		;restore original base
	TXNN	FF,COLONF		;DONT CRLF IF COLON FORM
	CALL	CRR		;[502] CRLF AND...
	JRST	CFLUSH		;[502] DONE.

;CAUSES COMMAND INTERPRETATION TO STOP UNTIL THE USER TYPES A CHARACTER
;ON THE TELETYPE AND THEN HAS THE ASCII VALUE OF THE CHARACTER TYPED IN.

SPTYI:	CALL	TYIX
	MOVEM	A,FARG		;REMEMBER CHARACTER
	CALL	BCHAR		;BACKUP THE CHARACTER
	JRST	ARGINF		;[502] AND RETURN IT PROPER

;WDATE-AND-TIME INPUTS CURRENT DATE AND TIME INTO BUFFER

WDATIM:	HRROI	A,DATBUF		;POINT TO DATA BUFFER
	SETO	B,			;WE WANT CURRENT DATE AND TIME
	SETZ	C,			;NO SPECIAL FLAGS
	ODTIM%			;GET THE DATE AND TIME
	MOVE	A,[POINT 7,DATBUF]	;GET POINTER TO THE STRING
	CALL	INSRTZ		;[502] INSERT IT...
	JRST	CFLUSH		;[502] AND RETURN

; ^H HAS THE VARIOUS TIMES

GTIME:	TXNN	FF,ARG
	JRST	GTMID
	JUMPLE	C,GTMID
	CAIE	C,1
	JRST	GRUNTM
	GTAD%
	JRST	ARGINA
GRUNTM:	MOVEM	C,SYL
	MOVX	A,.FHSLF
	RUNTM%
	MOVE	B,SYL
	CAIE	B,2
	JRST	ARGINC
	JRST	ARGINA
GTMID:	SETO	B,			;SAY WE WANT CURRENT TIME
	SETZ	D,			;NO SPECIAL FEATURES
	ODCNV%
	HRRZ	C,D
	JRST	ARGINC		;AND RETURN


;HAS THE VALUE OF THE NEXT CHARACTER IN THE COMMAND STRING.

CNTRUP:	CALL	RCH		;^^ HAS VALUE OF CHAR FOLLOWING IT
	MOVE	C,CH
	JRST	ARGINC

;^X - SET SEARCH SWITCH

;INITIALED TO 0, 1 MEANS EXACT MATCH REWUIRED ON SEARCHES, 0
;MEANS LOWER AND UPPER CASE LETTERS MATCH TO EITHER LOWER OR UPPER

SSERCH:	MOVE	A,EXACTF		;GET PRESENT VALUE
	TXNN	FF,ARG		;ARG GIVEN?
	JRST	ARGINA		;NO, RETURN PRESENT VALUE
	MOVEM	C,EXACTF		;SET NEW VALUE
	SETOM	SRPF		;REMEMBER TO REPARSE SEARCH
	JRST	CFLUSH

;wflaguppers$ - flag upper case letters

FLAGU:	SETOM	FLAGF		;SAY FLAGGING
	MOVEI	A,.PRIIN
	RFMOD%
	TXO	B,TT%UOC		;FLAG UPPER CASE CHARACTERS
	TXZ	B,TT%LCA	;SYSTEM PREVENTS FLAGGING UNLESS THIS BIT OFF
	STPAR%			;TELL SYSTEM
	JRST	CFLUSH		;[502] DONE

;wnoflag$ - flag nothing

NOFLAG:	SETZM	FLAGF
	MOVEI	A,.PRIIN
	RFMOD%
	TXZ	B,TT%UOC		;CLEAR FLAG BIT
	STPAR%
	JRST	CFLUSH		;[502] DONE

;wnoshift$ - don't change case of input

NSHIFT:	MOVEI	A,.PRIIN
	RFMOD%
	TXZ	B,TT%LIC		;CLEAR "RAISE" BIT
	STPAR%
	JRST	CFLUSH		;[502] DONE

;wraise$ - raise typed in lower case letters

TERRAS:	MOVEI	A,.PRIIN
	RFMOD%
	TXO	B,TT%LIC		;SET "RAISE" BIT
	STPAR%
	JRST	CFLUSH		;[502] DONE

;WSAVLEN$ - SET OR GET NUMBER OF CHARACTERS TO INPUT BETWEEEN SAVES.

BETSAV:	MOVE	A,BAKLEN		;GET CURRENT SETTING
	TXNN	FF,ARG		;DID USER SUPPLY ARGUMENT?
	JRST	ARGINA		;NO, SO RETURN ONE.
	CAIL	C,1
	CAILE	C,MAXBAK
	ERROR <Arg must be positive and less than or equal to MAXBAK>
	MOVEM	C,BAKLEN		;SET NEW VALUE
	JRST	CFLUSH		;[502] DONE

;WWIDTH$ - SET OR GET TERMINAL WIDTH

WTHSET:	MOVE	A,SWIDTH		;GET CURRENT SETTING
	TXNN	FF,ARG		;DID YOU SUPPLY ARG?
	JRST	ARGINA		;NO, SO RETURN CURRENT VALUE.
	CAIGE	C,0		;MAKE SURE WIDTH IS LEGAL.
	ERROR <Negative width setting not allowed>
	MOVE	A,C
	PUSH	P,C
	CALL	SETWID		;GO SET NEW WIDTH
	JERROR <Couldn't set up terminal width>
	POP	P,SWIDTH		;SET UP NEW WIDTH
	JRST	CFLUSH		;[502] DONE

;ROUTINE TO SET TERMINAL WIDTH
;ACCEPTS:	A/	NEW WIDTH
;RETURNS:	+1:	FAILED
;		+2:	WON

SETWID:	MOVE	C,A
	MOVEI	A,.PRIOU		;PRIMARY OUTPUT
	MOVEI	B,.MOSLW		;SET LINE WIDTH
	MTOPR%			;TRY TO DO IT
	 ERJMP	CPOPJ		;FAILED
	JRST	CPOPJ1		;SUCCEEDED

;GET WIDTH INTO A, SKIP IFF SUCCESS

GETWID:	MOVEI	A,.PRIOU
	MOVEI	B,.MORLW
	MTOPR%
	 ERJMP	CPOPJ
	MOVE	A,C
	JRST	CPOPJ1

;GET PAGE (SCREEN) SIZE INTO A, SKIPS IFF SUCCESSFUL

GETLEN:	MOVEI	A,.PRIOU
	MOVEI	B,.MORLL
	MTOPR%
	 ERJMP	CPOPJ
	MOVE	A,C
	JRST	CPOPJ1

;WWINDOW$ - SET OR RETURN NUMBER OF SCREEN LINES USED FOR WINDOW

WINSET:	MOVE	A,SLENTH		;GET CURRENT SIZE OF WINDOW IN LINES
	TXNN	FF,ARG		;ARGUMENT TO COMMAND?
	JRST	ARGINA		;NO, SO RETURN ONE
	MOVE	B,SSIZE		;FOR SCREENS, SCREEN SIZE IS MAXIMUM
	SKIPN	SCRNF
	MOVEI	B,MAXLEN	;FOR NONSCREENS, INTERNAL BUFFER SIZE IS LIMIT
	CAIL	C,0
	CAMLE	C,B		;MAKE SURE ARG IS REASONABLE
	ERROR <Invalid window size>
WINSOK:	MOVEM	C,SLENTH		;SET NUMBER OF LINES TO USE
	JRST	CFLUSH		;[502] DONE

 OPTION ENC,<

;WENCRYPT - SET/CLEAR ENCRYPTION FLAG
COMMENT ~
	If this code is enabled, and the command nWENCRYPT$ is given, where
n is non-zero, the commands that read in files (;Y and related) will prompt
for a "password". This is a decryption keyword; the file is assumed to be
encoded. If it is not, type Carriage Return, and no decryption will be
applied. If the keyword is wrong, you will see the appearance of quantities
of trash in the buffer.
	Also, output commands (;X and related) will ask for an encryption
keyword; as before, if just a Carriage Return is typed, no encryption will
be applied. For paranoia's sake, this is requested twice - the typed strings
must match. Case of letters does not matter.
	If you interrupt TV during reads and writes when encryption is on,
the results are likely to be indeterminate - mostly, you will lose the
buffer.
	0Wencrypt$ turns the encrypt functions off. Without an arg,
Wencrypt$ returns the value of the current flag. ~

ENCPT:	MOVE	A,ENCFLG
	TXNN	FF,ARG		;WANT VALUE OR SET VALUE?
	JRST	ARGINA		;RETURN
	MOVEM	C,ENCFLG
	JRST	CFLUSH
>

;WSILENCE - SET OR CLEAR ALLOWING "END OF..." MESSAGE AFTER ;Efile$

SETSHH:	MOVE	A,SILFLG
	TXNN	FF,ARG		;WANT VALUE OR SET VALUE?
	JRST	ARGINA		;RETURN
	MOVEM	C,SILFLG
	JRST	CFLUSH

;WPERUSE$ - GET OR SET PERUSE MODE BIT
WPERUS:	TXNN	FF,ARG
	JRST	WPERU1
	TXNE	C,1
	TXOA	FF,PERUS
	TXZ	FF,PERUS
	JRST	CFLUSH
WPERU1:	TXNN	FF,PERUS
	JRST	ZERINA
	MOVEI	C,1
	JRST	ARGINC

;WSCREENSIZE - SET OR RETURN NUMBER OF LINES EXISTING ON ENTIRE SCREEN.

SCNSET:	MOVE	A,SSIZE		;GET CURRENT SETTING
	TXNN	FF,ARG		;DID USER SUPPLY ARG TO COMMAND?
	JRST	ARGINA		;NO, SO RETURN CURRENT SETTING.
	CAIL	C,0
	CAILE	C,MAXLEN		;MAKE SURE NEW SETTING IS REASONABLE.
	ERROR <Illegal screen size setting>
	MOVEM	C,SSIZE		;SET NEW SCREEN SIZE
	CALL	WINSTN		;[502] SET UP STANDARD WINDOW SIZE
	JRST	CFLUSH		;[502] DONE

;WEDITBASIC$ - DON'T FILTER LINE NUMBERS WHEN READING IN FILES, BECAUSE
;THE FILES NEED THEM, LIKE FOR INSTANCE THEY ARE BASIC PROGRAMS.

EBASIC:	SETOM	BASICF	;SET THE FLAG TO REMEMBER NOT TO FILTER LINE NUMBERS.
	JRST	CFLUSH		;[502] DONE

;WEDITREGULAR$ - FILTER LINE NUMBERS AS USUAL.

ERGLR:	SETZM	BASICF		;SAY TO FILTER THE LINE NUMBERS.
	JRST	CFLUSH		;[502] DONE
;HAS THE VALUE OF THE NUMBER REPRESENTED BY THE DIGITS (OR MINUS SIGN)
;FOLLOWING THE POINTER IN THE BUFFER.  THE SCAN TERMINATES ON ANY OTHER
;CHARACTER.  THE POINTER IS MOVED OVER THE NUMBER FOUND (IF ANY).

BAKSL:	TXNE	FF,ARG		;WHICH KIND OF BACKSLASH?
	JRST	BAKSL1		;ARG TO MEMORY
	MOVEI	A,^D10		;SPECIFY DECIMAL
PKNM1:	CALL	PKNUM		;DO THE WORK
	JRST	ARGINA		;PROCEED WITH REST OF COMMAND

;ROUTINE TO PICK UP NUMBER FROM BUFFER IN BASE SPECIFIED IN A, LEAVING POINTER
;AFTER THE NUMBER AND NUMBER IN A

PKNUM:	STKVAR	<NEGF,PBASE>
	MOVEM	A,PBASE		;REMEMBER BASE
	SETZM	SYL		;START WITH NO NUMBER
	MOVE	I,PT		;MEMORY TO ARGINA
	CAML	I,ZEE		;ANY CHARS?
	JRST	BAKSL3		;NO, SO CAN'T POSSIBLY BE A "-"
	CALL	GETINC		;SOME CHARS, SEE IF "-"
	SETZM	NEGF		;NO MINUS SEEN YET
	CAIE	CH,"-"		;IS IT?
	JRST	BAKSL5		;NO
	SETOM	NEGF		;YES, REMEMBER
BAKSLA:	CAML	I,ZEE		;OVERDID IT ?
	JRST	BAKSL3		;YES. EXIT
	CALL	GETINC		;NO. GET A CHAR
BAKSL5:	MOVE	A,PBASE		;GET BASE
	CAIGE	CH,"0"(A)		;DIGIT IN CORRECT BASE?
	CAIGE	CH,"0"		;DIGIT?
	SOJA	I,BAKSL2		;NOT A DIGIT. BACKUP AND LEAVE LOOP
	SUBI	CH,"0"		;CONVERT TO NUMBER
	EXCH	CH,SYL
	IMUL	CH,PBASE
	ADDM	CH,SYL		;SYL:= 10.*SYL+CH
	JRST	BAKSLA		;LOOP

BAKSL3:	MOVE	I,ZEE		;HERE ON OVERFLOW
BAKSL2:	SKIPE	NEGF		;MINUS SIGN SEEN?
	MOVNS	SYL		;YES. NEGATE
	MOVEM	I,PT		;MOVE POINTER PAST #
	MOVE	A,SYL		;RETURN NUMBER IN A
	RET

;NA (WHERE N IS A NUMERIC ARGUMENT) = VALUE IN 7-BIT ASCII OF THE
;CHARACTER TO THE RIGHT OF THE POINTER.

ACMD:	TXNN	FF,ARG		;DOES AN ARGUMENT PRECEED A?
	JRST	APPEND		;NO. THIS IN AN APPEND COMMAND.
ACMDI:	MOVE	I,PT		;YES.
PICK1:	CAML	I,ZEE		;MAKE SURE THERE'S A CHARACTER AFTER POINTER
	JRST	PICKQE
	CALL	GET		;CH:=CHARACTER TO THE RIGHT OF PT.
	MOVE	C,CH		;RETURN CH AS VALUE.
	JRST	ARGINC
PICKQE:	TXNN	FF,COLONF		;DID HE EXPECT THE ERROR?
	ERROR <Pointer is at end of buffer>
	JRST	NE1INA		;YES, RETURN -1

PICKUP:	MOVE	I,PT		; ;P COMMAND, PICKUP CODE AND INC PNTR
	CAMGE	I,ZEE
	AOS	PT			;DON'T ALLOW POINTER OUT OF BOUNDS
	JRST	PICK1
;	;N picks up a positive number from the data (base 10)
;	n;N picks it up in base n.  PT is left at first non-number.

PIKNUM:	TXNN	FF,ARG
	MOVEI	C,^D10
	MOVE	A,C		;GET BASE
	JRST	PKNM1		;DO THE WORK
;NUI PUTS THE NUMERIC VALUE N IN Q-REGISTER I.

USE:	CALL	QREGVI		;YES. CH:=Q-REGISTER INDEX.
	EXCH	C,QTAB-"0"(CH)	;STORE NEW, FETCH OLD
	TXNE	FF,COLONF		;COLON MODIFIED?
	JRST	ARGINC		;YES, GO RETURN OLD VALUE
	JRST	CFLUSH		;NO, DON'T.

;QI HAS THE VALUE OF THE LATEST QUANTITY PUT INTO Q-REGISTER I.

QREG:	CALL	QREGVI
	JRST	ARGINA

; ;' RETURNS THE UPPER CASE EQUIVALENT OF THE PASSED CHARACTER. :;' RETURNS
;   lower case.

UPLOWC:	JUMPL	C,NE1INA		;NEG ARG PASSED? LEAVE.
	CAILE	C,177			;IN ASCII RANGE?
	JRST	NE1INA			;NO, RET -1
	TXNE	FF,COLONF		;UPPER OR LOWER
	JRST	LOWERC			;LOWER
	LOAD	C,UPRCOD,(C)		;UPPER, RETURN VALUE FROM CHRTAB
	JRST	ARGINC
LOWERC:	LOAD	C,LWRCOD,(C)
	JRST	ARGINC

; n;&I RETURNS THE VALUE IN I ANDED WITH n, AND THEN TURNS OFF THE BITS IN QI
;  SELECTED BY n.

TXZNC:	CALL	QREGVI		;GET QREG AND VALUE
	MOVE	B,FARG		;AND GET ARG PASSED IN
	AND	A,B			;RETURN QREG CONTENTS AND'D WITH ARG
	ANDCAM	B,QTAB-"0"(CH)	;BUT TURN OFF THOSE BITS IN THE QREG
	JRST	ARGINA		;GOOD FOR ONCE-ONLY TESTS

;ROUTINE TO RETURN Q-REGISTER INDEX IN CH AND CONTENT IN A.
;CALL CALL QREGVI
;	RETURN
;ASSUMES COMCNT,CPTR AND COMAX ARE SET UP.
;IF NEXT CHARACTER IN COMMAND STRING
;IS NOT A LETTER OR A DIGIT, DOES NOT RETURN.
;FROM USEA,PCNT,OPENB+1,MAC,QGET

QREGVI:	CALL	RCH		;CH:=NEXT COMMAND STRING CHARACTER.
	MOVE	A,CHRTAB(CH)
	TXNN	A,CH%QRG	;ARE YOU A QREG CHARACTER?
QREGQE:	ERROR <Illegal Q-reg name>
QREGVL:	TXNE	A,CH%DIG	;ENTRY FOR WLIB$ STUFF
	JRST	QREGVD		;DIGIT
	ANDI	CH,137		;DROP LC BIT
	SUBI	CH,"A"-"9"-1
QREGVD:	MOVE	A,QTAB-"0"(CH)	;A:=CONTENTS OF Q-REGISTER.
	RET

;%I ADDS 1 TO THE QUANTITY IN Q-REGISTER IN AND STANDS FOR THE
;	NEW VALUE

PCNT:	CALL	QREGVI		;CH:=Q-REGISTER INDEX.
	TXNE	FF,COLONF		;DECR OR INCR?
	SOSA	C,QTAB-"0"(CH)	;DECREMENT Q-REG.
	AOS	C,QTAB-"0"(CH)	;INCREMENT Q-REG.
	JRST	ARGINC		;RETURN NEW VALUE.
;m,nXi MOVES A PORTION OF THE BUFFER INTO Q-REGISTER i.
;	IT SETS Q-REGISTER IN TO A DUPLICATE OF THE (M+1)TH
;	THROUGH NTH CHARACTERS IN THE BUFFER.
;nXi INTO Q-REGISTER i IS COPIED THE STRING OF CHARACTERS STARTING
;	IMMEDIATELY TO THE RIGHT OF THE POINTER AND PROCEEDING THROUGH
;	THE NTH LINE FEED.

X:	STKVAR	<XARG1,XARG2,OLDEBF,SAVEBF,QNAM>
	SETZM	XARG1		;CLEAR SO QGC DOESN'T TRIP OVER TRASH
	SETZM	QNAM
	SOSG	GCCNT		;TIME FOR GC?
	CALL	QGC		;YES
	CALL	GETARG		;p1:=FIRST STRING ARGUMENT ADDRESS
				;c:=SECOND STRING ARGUMENT ADDRESS.
	MOVEM	P1,XARG1
	MOVEM	C,XARG2
	MOVE	A,C
	CALL	MOVHOL		;GET HOLE OUT OF WAY OF STUFF BEING 
				; MOVED INTO Q-REG
;**NOTE: PUTTING HOLE AFTER TEXT AS OPPOSED TO BEFORE IT IS IMPORTANT
;FOR EFFICIENCY, AS SUBSEQUENT DELETION PUTS HOLE THERE.

	MOVE	A,EQRBUF
	MOVEM	A,OLDEBF		;SAVE OLD BUFFER ADDRESS
X0:	MOVE	P1,XARG1
	MOVE	C,XARG2
	SUBM	C,P1		;COMPUTE LENGTH OF STRING
	ADDI	P1,4		;PLUS 4 OVERHEAD CHARS
	MOVE	C,EQRBUF		;COMPUTE NEW END OF QREG BUF
	ADD	C,P1
	MOVE	A,C
	ADDI	A,^D35+5		;LEAVE ROOM FOR SEARCH ROUTINE TO USE
	CAML	A,BEG		;OVERLAPS MAIN BUFFER?
	JRST	[	MOVE A,EQRBUF
		MOVEM A,SAVEBF	;SAVE PRESENT QREG FREE PTR
		CALL QGC	;YES, DO GC
		MOVE C,SAVEBF
		CAMN C,EQRBUF	;DID GC DO ANYTHING?
		ERROR <Qreg string storage full>
		JRST X0]	;TRY AGAIN
	MOVE	OU,EQRBUF		;GET ADDRESS TO PUT STRING
	MOVEM	OU,OLDEBF		;SAVE IT FOR QREG
	MOVEM	C,EQRBUF		;UPDATE END OF AREA
	MOVEI	CH,141		;FIRST CHARACTER OF BUFFER := 141
	CALL	PUT
	AOS	OU
	MOVE	I,[POINT 7,P1,14]	;TO GET LAST 3 CHARS IN p1
	MOVEI	P2,3
X3:	ILDB	CH,I		;GET PART OF COUNT
	CALL	PUT		;WRITE ONTO STORAGE STRING
	AOJ	OU,
	SOJG	P2,X3		;DO FOR THREE CHARS = 21 BITS
	MOVE	OU,TT		;SAVE BYTE POINTER FROM LAST PUT
	SUBI	P1,4
	MOVE	I,XARG1		;RECOVER SOURCE PTR
	CALL	GETX		;CONSTRUCT BYTE PTR TO SOURCE
	CALL	DBP		;BACKUP TO BEGINNING
	MOVE	I,TT		;SAVE IT
	CALL	MVSTR		;MOVE STRING FROM I TO OU
	MOVE	P1,XARG1
	MOVE	C,XARG2		;RECOVER ARGS
	CALL	QREGVI		;GET PTR TO Q-REG AND MAKE SURE NAME IS LEGAL
	MOVEM	CH,QNAM		;SAVE Q-REG NAME
	TXNN	FF,SLSL		;IF ATSIGN SEEN, DONT REMOVE TEXT!
	CALL	KLBUF1		;NORMAL X, JUST REMOVE TEXT
	MOVE	CH,QNAM
	MOVE	C,OLDEBF
	SUB	C,QRBUF		;ADDRESS RELATIVE TO C(QRBUF)
	TLO	C,400000
	MOVEM	C,QTAB-"0"(CH)	;[502] MAKE QTAB ENTRY
	JRST	CFLUSH		;[502] DONE
;GI THE TEXT IN Q-REGISTER IN IS INSERTED INTO THE BUFFER AT THE
;	CURRENT LOCATION OF THE POINTER.  THE POINTER IS THEN PUT JUST
;	TO THE RIGHT OF THE INSERTION.  THE Q-REGISTER IS NOT CHANGED.

QGET:	CALL	QREGVI		;A:=QTAB ENTRY, CH:=Q-REG INDEX
	MOVE	C,A
	PUSH	P,CH		;SAVE QREG POINTER
	CALL	QTST		;IS THERE TEXT THERE?
	JRST	[TXZN FF,COLONF	;NO, DO WE CARE?
		JRST QGETQE	;YES, GO YITCH
		POP P,CH	;NO, BALANCE STACK
		JRST BAKSL1]	;AND GO INSERT IT AS A DIGIT STRING
	CALL	QGET2T		;GET NUMBER OF CHARS (1ST PART DONE BY QTST)
	POP	P,C			;Q-REG INDEX
	JUMPLE	P1,CFLUSH	;QUIT IMMEDIATELY IF NULL STRING
	MOVE	I,QTAB-"0"(C)
	TLZ	I,(-1B14)
	ADD	I,QRBUF
	ADDI	I,3
	MOVE	A,I		;PUT CHARACTER ADDRESS INTO A
	CALL	ADDPTR		;CHANGE ADDRESS TO POINTER
	MOVE	B,P1		;STRING LENGTH INTO B
	CALL	INSRT0		;INSERT Q-REG INTO BUFFER
	JRST	CFLUSH		;DONE

; ;T - TYPE CONTENTS OF Q REG

TPREG:	CALL	WINCLS		;START PRESERVED OUTPUT
	TXNN	FF,ARG
	JRST	COMM		;TYPE LITERAL STRING IF NO ARG
				;(THIS GOES AWAY SOMEDAY. USE ^A.)
	MOVE	C,FARG		;[502] C GETS LOST BY SUBROUTINES
	CALL	QGET2
TPR1:	JUMPE	P1,CFLUSH
	CALL	GETINC
	MOVE	A,CH
	CALL	TYO
	SKIPE	ABORTF		;ABORTING?
	JRST	TYOQT		;YES
	SOJA	P1,TPR1


QTST:	TLZN	C,377770	;TEST FOR TEXT IN QREG
	TLZN	C,400000
	RET			;NONSKIP IF NO TEXT
	MOVE	I,QRBUF
	ADD	I,C
	CALL	GETINC		;GET FIRST CHAR
	CAIN	CH,141		;141 MEANS THIS IS A QREG
	AOS	(P)
	RET			;DONE W/ TEST

QGET2:	TLZN	C,377770		;DOES Q-REG CONTAIN TEXT?
	TLZN	C,400000
	JRST	QGETQE
	ADD	C,QRBUF		;YES
	MOVE	I,C		;I:=Q-REG BUFFER ADDRESS
	CALL	GETINC		;IS FIRST CHARACTER IN BUFFER 141?
	CAIE	CH,141
QGETQE:	ERROR <Qreg does not contain text>
QGET2T:	CALL	GETINC		;p1:=LENGTH OF STRING
	MOVEM	CH,P1
	CALL	GETINC
	LSH	P1,7		;RECONSTRUCT CHAR COUNT,
	IOR	P1,CH		;MOST SIGNIFICANT CHARS FIRST
	CALL	GETINC
	LSH	P1,7
	IOR	P1,CH
	SUBI P1,4
	RET
;]I POPS Q-REGISTER IN OFF THE Q-REGISTER PUSHDOWN LIST.
;	THE Q-REGISTER PUSHDOWN LIST IS CLEARED EACH TIME $$ IS TYPED.

CLOSEB:	CALL	QREGVI		;[521] WHAT QREG? CH:=INDEX
	MOVE	B,PF		;[521] FETCH POINTER
	HRRZ	P1,B		;[521] IS THE POP REASONABLE TO DO?
	CAIGE	P1,PFL		;[521] NOT IF OFF STACK TOP
	JRST	OPBIQE		;[521] YOU LOSE
	POP	B,QTAB-"0"(CH)	;[521] OK, DO OPERATION
	JRST	OCBCOM		;[521] AND COMMON CODE (WITH OPENB)

;[I PUSHES Q-REGISTER IN ONTO THE Q-REGISTER PUSHDOWN LIST.

OPENB:	CALL	QREGVI		;[521] WHICH QREG? CH:=INDEX
	MOVE	B,PF		;[521] GET STACK POINTER
	PUSH	B,A		;[521] DO STORE OPERATION
	 ERJMP	OPBIQE		;[521] IT DIDN'T FIT
OCBCOM:	MOVEM	B,PF		;[521] SAVE NEW POINTER
	TXNE	FF,ARG		;IS THERE AN ARGUMENT?
	RET			;[502] YES. LEAVE THINGS ALONE THIS WAY
	JRST	CFLUSH		;NO. CLEAR FLAGS.

SOPENB:	MOVE	B,PF		;GET STACK
	PUSH	B,C		;PUSH VALUE IN C
	 ERJMP	OPBIQE		;[521] IT DIDN'T FIT
	MOVEM	B,PF		;AND DONE
	JRST	CFLUSH		;..

SCLOSB:	MOVE	B,PF		;GET STACK
	HRRZ	A,B		;[521] IS HE TRYING TO READ OFF THE BOTTOM?
	CAIGE	A,PFL		;[521]..?
OPBIQE:	ERROR	<Incorrect use of user stack> ;[521] OOPS 
	POP	B,C		;RETURN A VALUE
	MOVEM	B,PF		;KEEP STACK POINTER
	JRST	ARGINC		;GO RETURN C
;UNLOAD (;U, ;D) COMMANDS

;**; At DNLOAD:, change label				SM	4-Mar-82
DNLD:	SKIPE	WRITEF		;MAKE SURE WE'RE AT BEGINNING OF OUTPUT FILE
	ERROR <;Invalid ;D command - output file already partially written>
	SETOM	DUNFLG		;SAY ;D MODE
	CALL	UNLOAX		;[502] DO A PROPER UNLOAD
	JRST	CFLUSH		;[502] DONE
UNLD:	CALL	UNLOAD		;[502] DO THE UNLOAD
	JRST	CFLUSH		;[502] AND RETURN PROPERLY

UNLOAD:	SETZM	DUNFLG		;SAY ;U MODE
;**; At UNLOAD: +1L, Added one label			SM	4-Mar-82
UNLOAX:	CALL	SKPWRT		;FILE OPEN?
	 CALL	UNLD1		;NO, GO OPEN ONE
	MOVE	A,OUTJFN		;GET HANDLE ON OUTPUT DEVICE
	SKIPE	DUNFLG		;PUT IN HEADING IF REQUESTED
	CALL	HEDING		;PUT HEADING IN OUTPUT FILE
	MOVSI	C,2000		;A LARGE NUMBER OF PAGES
	TXO	FF,ARG		;MAKE BELIEVE IT WAS TYPED IN
	CALL	PUNCH		;PUNCH THOSE PAGES
	CALLRE	CLOSEF		;CLOSE AND RENAME FILES


UNLD1:	HRROI	B,[ASCIZ /Output file: /]
	MOVX	A,GJ%FOU+GJ%MSG	;specify output file spec
	CALL	GETCFM		;GET FILE NAME FROM USER AND ASSIGN JFN
	TXO	FF,DUMPF		;REMEMBER DOING LARGE DUMP
	JRST	OPNOUT		;OPEN FILE AND RETURN

;GET FILESPEC AND CONFIRMATION.  CALL WITH GTJFN BITS IN A, PROMPT
;POINTER IN B.  RETURNS WITH JFN IN A.

GETCFM:	STKVAR	<<QUAG,2>,<ARGS1,2>,NAMPTX>
	DMOVEM	A,ARGS1		;SAVE GTJFN BITS
GETCF1:	DMOVE	A,ARGS1
	CALL	GSCRIP		;DO THE GTJFN
	DMOVEM	A,QUAG		;SUCCESS, SAVE GTJFN DATA
	TXNE	FF,RSCANF		;RESCANNING?
	JRST	GETCF2		;YES, SO DON'T WAIT FOR CONFIRMATION
	CALL	CONFRM		;confirm
	 JRST	GETCFB		;BAD CONFIRMATION
GETCF2:	MOVE	C,[POINT 7,NAMBFR]	;GET POINTER TO BEGINNING OF NAME AREA
	MOVEM	C,NAMPTX
NAMSTR:	ILDB	A,NAMPTX		;PICK UP CHARACTER FROM SCRIPT
	JUMPE	A,NAMS1		;LEAVE LOOP WHEN NULL HIT
	CALL	BCHAR		;PUT CHARACTER IN LOG FILE
	JRST	NAMSTR		;LOOP FOR REST OF NAME.
NAMS1:	MOVEI	A,15
	CALL	BCHAR		;FINISH WITH CRLF
	MOVEI	A,12
	CALL	BCHAR
MRETYP:	TXNE	FF,RSCANF
	JRST	MRTYP1		;ALWAYS RETYPE NAME IF RESCANNING
	SKIPE	TERIO
	JRST	MR1		;ON TERMINAL IO AND NOT RESCANNING,...
				; DON'T RETYPE NAME.
MRTYP1:	MOVE	B,GTJJFN		;PUT RECEIVED JFN IN 2
	MOVEI	A,.PRIOU		;AND DIRECT OUTPUT TO TTY
	SETZ	C,			;STANDARD PRINTOUT
	JFNS%			;PRINT FILE NAME
	CALL	CRR
MR1:	MOVE	A,GTJJFN		;PUT JFN BACK IN 1
	RET			;SUCCESS RETURN

GETCFB:	 LERROR <Carriage return required after filespec
>
	JRST	GETCF1

;ROUTINE WHICH SAVES FILENAME DEFAULT STRING.  GIVE IT JFN IN A.
;NOTE THAT IF ONLY THE JFN BLOCK DEFAULTS ARE DEPENDED ON, THEN COMND
;WILL JUST REPROMPT FOR FILESPEC IF YOU TRY TO DEFAULT IT BY TYPING
;<CR>.

SETFDS:	MOVE	B,A		;JFN IN B
	HRROI	A,DEFSPC		;POINT TO DEFAULT SPEC AREA
	MOVX	C,1B8+1B11+JS%PAF+JS%TMP	;JUST NAME, EXT, ;T
	JFNS%			;STORE THE STRING
	RET

;ROUTINE TO DO LONG FORM GTJFN AND STORE TYPED NAME IN LOG FILE.
;CALL ROUTINE WITH GTJFN BITS IN A
;give it pointer to prompt string in b.
;THE JFN IS RETURNED IN "A".  THE ROUTINE RETURNS WHEN THE GTJFN SUCCEEDS

GSCRIP:	STKVAR	<PROMPT,FAILF>
	SETOM	FAILF		;SAY WE HAVEN'T HAD A FAILURE YET
	MOVEM	A,CJFNBK+.GJGEN	;remember GTJFN code
	MOVEM	B,PROMPT		;remember pointer to prompt
	MOVSI	B,774000		;MASK FOR SEEING IF STRINGS EXIST
	HRROI	A,DEFNAM		;GET POINTER TO DEFAULT NAME
	TDNE	B,DEFNAM		;IS THERE ONE?
	MOVEM	A,CJFNBK+.GJNAM	;YES, USE IT
	HRROI	A,DEFEXT		;SAME SCHTUCK WITH EXTENSION
	TDNE	B,DEFEXT
	MOVEM	A,CJFNBK+.GJEXT
GSR2:	MOVE	A,PROMPT		;GET POINTER TO PROMPT STRING
	TXNN	FF,RSCANF		;ARE WE RESCANNING??
	JRST	GSR3		;NO
	PSOUT%			;YES, PRINT THE PROMPT
	JRST	GSR1
GSR3:	CALL	READY		;type prompt
	MOVX	A,CM%DPP		;FIRST ASSUME THERE'S A DEFAULT STRING
	IORM	A,FILCBK+.CMFNP	;TURN ON DEFAULT BIT
	MOVSI	B,774000		;MASK FOR FIRST CHARACTER OF DEFAULT
	TDNN	B,DEFSPC		;IS THERE A DEFAULT?
	ANDCAM	A,FILCBK+.CMFNP	;NO, TURN OFF DEFAULT BIT
GSR4:	MOVEI	A,FILCBK		;POINT TO FILE FUNCTION BLOCK
	CALL	READFL		;read filespec
GSR1:	SKIPN	GTJERR		;WAS THERE AN ERROR?
	RET			;NO, JUST RETURN
	AOSE	FAILF		;FIRST FAILURE?
	JRST	GSR5		;NO, SO DON'T TRY AGAIN
	SETZM	CJFNBK+.GJNAM	;YES, SEE IF REMOVING DEFAULTS HELP
	SETZM	CJFNBK+.GJEXT
	JRST	GSR4		;GO BACK AND REINTERPRET INPUT
;**;[515] At GSR5:, Replaced 1 line with 4, Modified 1      SM	25-Feb-83
GSR5:	TXZN	FF,RSCANF	;[515] CLEAR AND GIVE FILENAME IF IT WAS SET
	JRST	GSR6		;[515] IT WASN'T, DONT DO IT HERE
	HRROI	A,ATMBFR		;[515] POINTER TO FAILING NAME
	PSOUT%			;[515] TYPE IT BEFORE ERROR MESSAGE
GSR6:	MOVE	A,GTJERR		;GET REASON FOR FAILURE
	MOVEM	A,LSTERR		;SAVE FOR ERROR ROUTINE
	LJERR <Can't access file>
	JRST	GSR2		;GO BACK AND TRY AGAIN

;ROUTINE TO READ FILESPEC USING COMND JSYS.
;PASS IT THE COMND FUNCTION BLOCK ADDRESS IN A.

READFL:	SETZM	GTJERR		;FIRST ASSUME NO GTJFN ERROR
	CALL	RFIELD		;READ FILESPEC
	 HRRZM	B,GTJERR		;SAVE ERROR CODE
	MOVEM	B,GTJJFN		;REMEMBER JFN
	MOVE	A,GTJJFN		;GET THE JFN
	SKIPN	GTJERR		;DO WE HAVE ONE?
	CALL	STORNM		;YES, REMEMBER ITS NAME
	RET

;ROUTINE TO DO GTJFN AND STORE THE FILENAME SO THAT WFILENAME WILL
;BE ABLE TO GET IT.  ASSUMES THE AC'S ARE ALREADY SET UP FOR GTJFN.
;IT RETURNS +1 ON FAILURE, +2 SUCCESS, GTJFN DATA IN A AND B.

DOGTJ:	STKVAR	<<GTJDAT,2>>
	GTJFN%			;DO THE GTJFN
	 RET			;RETURN IF FAILURE
	DMOVEM	A,GTJDAT		;REMEMBER GTJFN DATA
	CALL	STORNM		;store file name
	DMOVE	A,GTJDAT		;return gtjfn data in a and b
	JRST	CPOPJ1

;routine to store filename string in nambfr.  pass it the jfn in a.

STORNM:	MOVE	B,A		;JFN IN B
STORN1:	HRROI	A,NAMBFR		;PREPARE TO STORE NAME
	MOVX	C,1B2+1B5+1B8+1B11+1B14+JS%PAF+JS%TMP ;WE WANT ALL FIELDS
	JFNS%			;STORE THE FILESPEC FOR WFILENAME
	RET
;LOAD ENTIRE FILE COMMAND - ;Y

YLOAD:	SETZM	SYL
	TXZE	FF,COLONF
	SETOM	SYL		;REMEMBER IF COLON FLAG ON
	TXNN	FF,UREAD		;FILE OPEN?
	CALL	YLD1		;NO, GO OPEN ONE
	CALL	SINLDS
	SKIPE	SYL		;DOES HE CARE HOW MANY CHARS..?
	JRST	CFLUSH		;NO
	MOVE	C,ZEE		;NUMBER OF CHARS NOW IN BUFFER
	SUB	C,BEG
	MOVEI	A,TYO		;SAY WHERE TO OUTPUT CHARS
	CALL	DPT0		;DECIMAL PRINT FROM c
	PSTR < chars
>
	JRST	CFLUSH

YLD1:	HRROI	B,[ASCIZ /Input file: /]
	MOVX	A,GJ%OLD		;input file
	CALL	GETCFM		;GET FILE NAME
	MOVE	B,TYIJFN		;SEE WHERE INPUT CAME FROM
	CAIN	B,.PRIIN		;DON'T CLEAR RESCAN FLAG YET IF NOT PRIIN
	TXZ	FF,RSCANF		;NOTE THAT WE'RE NOT RESCANNING ANYMORE.
	JRST	OPNIN		;GO OPEN THE FILE.
;FAST LOAD OF FILE USING SIN

SINLDS:	SETZM	YAMODE		;DOING ;Y NOT Y OR A
SINLD:	STKVAR	<LCS,FSPC>
SINLD2:	TXZ	FF,FORM
	MOVE	A,ZEE
	CALL	MOVHOL		;PUT HOLE AT END OF BUFFER
	CALL	FILFRE		;GET NUMBER OF CHARACTERS WE CAN READ IN
	MOVEM	A,FSPC
	MOVE	A,INJFN
	MOVE	OU,ZEE		;PUT FILE AT END OF BFR
	CALL	PUT		;COMPUTE BYTE PTR
	CALL	DBP		;BACKUP 1
	MOVE	B,TT		;SET IT FOR SIN
 OPTION ENC,<			;FOR CODING
	movem	b,cdestr	;start decoding here
>
	SKIPG	C,FSPC		;GET NUMBER OF CHARACTERS WE CAN READ
	JRST [	SKIPN YAMODE	;NO ROOM? IF NOT Y OR A...
		ERROR <File too large for buffer> ;COMPLAIN
		JRST CFLUSH]	;ELSE JUST RETURN
	MOVN	C,C		;MAKE NEG FOR SIN
	PUSH	P,C		;AND SAVE THAT WAY
	SKIPN	YAMODE		;Y OR A MODE?
	JRST	SUCKSI		;NO, ITS ;Y AND ;Y DOESNT *DO* <FF>
	MOVN	C,C		;Y OR A - MAKE IT POSITIVE AGAIN,
	MOVEI	D,"L"-100		;AND STOP ON <FF>
SUCKSI:	SIN%			;DO ALL OF FILE OR AS MUCH AS FITS
SUCKIN:	SKIPE	YAMODE		;DID WE NEGATE BEFORE?
	MOVN	C,C		;YES, ACCOUNT FOR THAT
	POP	P,TT
	SUBM C,TT		;COMPUTE AMOUNT DONE
 OPTION	ENC,<			;FOR CODING ALGORITHM
	movmm	tt,cdecnt	;number bytes to read
>
	ADDM	TT,ZEE		;UPDATE Z
	ADDM	TT,HOLBEG	;NOTE THAT HOLE STARTS FURTHER TO THE RIGHT
 OPTION ENC,<
	skipe	encflg		;are we doing encryption?
	skipn	cdecnt		;and do we have some numbers of to 'crypt?
	jrst	ncodes		;both aren't true, later
	push	p,b		;save b
	skipe	cdewin		;need an input password?
	jrst	nopasw		;no
	call	getpsd		;get the input password
	setom	cdewin		;we have one now
	move	b,cdewrd	;pick up the coding value (0 if no coding)
	movem	b,cdewri	;store as value for input coding
nopasw:	movei	a,cdewri	;pointer to inpout coding value
	skipe	(a)		;is coding desired?
	call	hack		;yes, do it
ncode:	pop	p,b		;restore b
ncodes:
 >
	LDB	CH,B		;GET LAST CHAR STORED
	MOVEM	CH,LCS		;REMEMBER IT
	CALL	SETHPT		;SET HOLE POINTERS
	MOVE	A,INJFN		;RESTORE CLOBBERED JFN
	GTSTS%
	TLNE	B,(1B8)
	TXOA	FF,FINF
	TXZ	FF,FINF		;FINF ON OR OFF FOR EOF
	SKIPE	YAMODE
	JRST	NCLSF		;DOING Y OR A, DONT TRY TO CLOSE FILE
	TXNN	FF,FINF		;DOING ;Y. EOF?
	JRST	SINLD2		;NO, TRY S'MORE (PROB. AN I/O ERROR)
	CALL	CLSINF		;YES, NOW CLOSE OFF
NCLSF:	MOVE	CH,LCS		;GET LAST CHARACTER STORED
	CAIN	CH,"L"-100		;IS LAST CHAR FORMFEED?
	TXO	FF,FORM		;YES
	RET

 OPTION ENC,<			;coding algorithm

;This code is not supported, principally because this is not an optimal
;encryption scheme.
;perhaps someday, it will be supported.
; This expects a value in CDECNT (the number of characters to code) and
; the coding value in a.
hack:	movem	a,whrcde
hackl:	sosge	cdecnt
	ret
	setcm	a,@whrcde
	rot	a,5
	move	b,a
	rot	b,2
	add	a,b
	jffo	a,.+2
	movei	a,37424
	addb	a,b
	tlnn	b,100
	xori	a,653201
	tlce	a,401			;an exercise in randomness
	trce	a,20004
	xor	a,[375001674315]
	tlnn	a,1002
	rot	a,6
	trne	b,1000
	xor	a,[130064220717]
	movsm	a,@whrcde
	ildb	b,cdestr
	xor	b,a
	dpb	b,cdestr
	jrst	hackl
>
;ER PREPARE TO READ FILE

OPNRD:	TXNE	FF,UREAD		;FILE NOW OPEN?
	CALL	CLSINF		;CLOSE INPUT FILE
	CALL	FILSPC		;GET FILE SPEC
	MOVSI	A,(1B2+1B17)	;OLD FILE+SHORT FORM
	CALL	DOGTJ		;DO GTJFN, AND REMEMBER FILENAME
	JRST	TYINPT
	DPB	CH,CPTR		;PUT ESCAPE BACK IN
OPNIN:	HRRZM	A,INJFN
	HRROI	A,DEFNAM		;GET COMPLETE NAME OF FILE JUST OPENED
	MOVE	B,INJFN		;FOR POSSIBLE LATER USE AS DEFAULT
	MOVSI	C,(1B8)		;NAME ONLY
	JFNS%
	HRROI	A,DEFEXT
	MOVSI	C,(1B11)		;EXTENSION ONLY
	JFNS%
	 ERJMP	.+1
	MOVE	A,INJFN		;GET THE JFN
	CALL	SETFDS		;SET FILENAME DEFAULT STRING
	MOVE	A,INJFN
	MOVE	B,[7B5+OF%RD]	;BYTE SIZE+READ
	SKIPE	BASICF		;ARE WE FILTERING OUT LINE NUMBERS?
	TXO	B,OF%PLN	;NO. (MAYBE A "BASIC" FILE).
	OPENF%
	JRST	TYNOPN
 OPTION ENC,<
	setzm	cdewin		;New file, will need password
>
	TXO	FF,UREAD		;FILE OPEN
	TXZ	FF,FINF		;NOT EOF
OPNT2:	TXNN	FF,COLONF
	JRST	CFLUSH		;NO COLON, NO VALUE
	JRST	NE1INA		;IT WORKED, RETURN -1

;TYPE INPUT DEVICE ERROR

TYNOPN:	MOVE	A,INJFN		;RELEASE JFN
	RLJFN%
	JFCL
	TRNA
TYINPT:	DPB	CH,CPTR		;UNCLOBBER COMMAND STRING
	SETOM	INJFN
FLERR:	TXNE	FF,COLONF
	JRST	ZERINA		;COLON FLAGGED, RETURN 0, NOT ERROR
	CALL	JSER
	ERROR <File operation failed>
;EW SELECTS THE OUTPUT DEVICE AND OPENS THE FILE SPECIFIED (IF ANY)

OPNWR:	CALL	SKPWRT		;OUTPUT FILE NOW OPEN?
	 TRNA			;NO
	CALL	CLOSEF		;CLOSE IT
	CALL	FILSPC
	MOVSI	A,(1B0+1B3+1B17)	;WRITE+PRINT OLD/NEW+SHRT
	CALL	DOGTJ		;DO GTJFN AND REMEMBER FILESPEC
	JRST	OPNBAD
	DPB	CH,CPTR
OPNOUT:	HRRZM	A,OUTJFN
	HRROI	A,DEFNAM		;GET COMPLETE NAME OF FILE JUST OPENED
	MOVE	B,OUTJFN		;FOR POSSIBLE LATER USE AS DEFAULT
	MOVSI	C,(1B8)		;NAME ONLY
	JFNS%
	HRROI	A,DEFEXT		;EXTENSION STRING
	MOVSI	C,(1B11)		;EXTENSION ONLY
	JFNS%
	MOVE	A,OUTJFN
	CALL	SETFDS		;SET FILENAME DEFAULT STRING
	MOVE	B,[7B5+OF%WR]
	MOVE	A,OUTJFN
	OPENF%
	 ERJMP	OUTER1
 OPTION ENC,<
	setzm	cdewon		;will need password
 >
	SETZM	WRITEF		;MARK THAT NO OUTPUT HAS HAPPENED YET
	TXO	FF,UWRITE		;SAY WE HAVE OUTPUT FILE OPEN
OPNWR2:	TXNN	FF,COLONF
	JRST	CFLUSH
	JRST	NE1INA

OPNBAD:	DPB	CH,CPTR		;UNCLOBBER COMMAND STRING
	JRST	OUTERR

;SKPWRT SKIPS IFF AN OUTPUT FILE IS OPEN.  IF UWRITE IS OFF AND CREJFN IS
;NON-0, SKPWRT SILENTLY OPENS THE OUTPUT FILE AND SKIPS.  THIS IS SO THAT
;IF THE USER GIVES THE EXEC COMMAND "EDIT A.B.1 A.B.1", ^C WILL LEAVE A.B.1
;INTACT.  NOTE THAT OPENING THE OUTPUT FILE AT STARTUP WOULD FLUSH ITS
;CONTENTS.

SKPWRT:	SKIPN	CREJFN		;ANY OUTPUT SPEC WAITING TO BE OPENED?
	TXNE	FF,UWRITE		;OUTPUT FILE, OR LATENT ONE?
	TRNA
	RET			;NEITHER, SO DON'T SKIP
	TXNE	FF,UWRITE		;OUTPUT FILE ALREADY OPEN?
	JRST	CPOPJ1		;SKIP TO SAY SO
	SKIPE	INIJFN		;STILL DOING TV.INI?
	RET			;YES, SO DON'T OPEN LATENT FILE YET
	MOVE	A,CREJFN		;DOING CREATE, SO CREATE THE FILE NOW
	CALL	OPNOUT		;OPEN IT FOR OUTPUT
	SETZM	CREJFN		;THERE'S NO MORE LATENT OUTPUT SPEC
	JRST	CPOPJ1		;SAY OUTPUT FILE OPEN
;PUT HEADING INTO OUTPUT FILE

HEDING:	MOVEI	B,";"
	CALL	BOUTX
	HRRZ	B,OUTJFN
	MOVE	C,[1B5+1B8+1B11+1B14+1B35]
	CALL	JFNSX
	HRROI	B,[ASCIZ /, /]
	SETZ	C,
	CALL	SOUTX
	SETO	B,
	SETZ	C,
	CALL	ODTIMX
	HRROI B,[ASCIZ /, Edit by /]
	CALL	SOUTX
	PUSH	P,A		;SAVE STRING POINTER
	GJINF%
	MOVE	B,A
	POP	P,A
	CALL	DIRSTX
	 JFCL
	MOVEI	B,15
	CALL	BOUTX
	MOVEI	B,12
	CALL	BOUTX
	RET

OUTER1:	MOVE	A,OUTJFN
	RLJFN%			;RELEASE JFN
	JFCL
	SETZM	CREJFN		;DON'T LET NEXT ATTEMPT USE SAME JFN
OUTERR:	SETOM	OUTJFN
	JRST	FLERR		;FILE ERROR, GO RETURN 0 OR ERROR
;EF FINISHES OUTPUT ON THE CURRENT OUTPUT FILE WITHOUT
;	SELECTING A NEW OUTPUT FILE.

SEMIC:	CALL	CLOSEF
	JRST	CFLUSH

CLOSEF:	CALL	SKPWRT		;OPEN LATENT OUTPUT FILE NOW
	 JFCL			;WE DON'T CARE WHETHER THERE WAS ONE
	TXZN	FF,UWRITE!DUMPF
	RET
CLOS2:	MOVE	A,OUTJFN
	CLOSF%
	JFCL
	SETZM	WRITEF		;MARK THAT NO DATA WRITTEN IN OUTPUT FILE
	SETOM	OUTJFN		; (ANYMORE...YET...WHAT HAVE YOU)
	RET

;CLOSE INPUT FILE

CLSINF:	TXZN	FF,UREAD
	RET
	MOVE	A,INJFN
	CLOSF%
	 ERJMP	.+1
	SETOM	INJFN
	RET

;GATHER FILE NAME

FILSPC:	STKVAR	<SAVFPT>
	MOVE	B,CPTR		;GET POINTER TO BEGINNING OF FILESPEC
	MOVEM	B,SAVFPT		;REMEMBER IT
FILS2:	CALL	SKRCH
	CAME	CH,TERMIN		;FIND THE TERMINATOR
	JRST	FILS2
	SETZ	B,		;SMASH IT TO 0
	DPB	B,CPTR
	MOVE	B,SAVFPT		;RETURN POINTER IN B
	RET			;RETURN ORIGINAL CPTR
;A   APPEND TO THE END OF THE BUFFER FROM THE SELECTED INPUT
;	TERMINATING THE READ IN THE SAME MANNER AS Y.  THE POINTER
;	IS NOT MOVED BY A.

APPEND:	CALL	YANKS
	JRST	CFLUSH

;Y RENDER THE BUFFER EMPTY.  READ INTO THE BUFFER UNTIL
;	(A)  A FORM FEED CHARACTER IS READ, OR
;	(B)  THE BUFFER IS WITHIN ONE THIRD OR
;128 CHARACTERS OF CAPACITY AND A LINE FEED IS READ, (BULLSHIP!) OR
;	(C)  AN END OF FILE IS READ, OR
;	(D)  THE BUFFER IS COMPLETELY FULL.
;THE FORM FEED (IF PRESENT) DOES ENTER THE BUFFER.

DYANK:	CALL	YANK
	JRST	CFLUSH

YANK:	TDZA	I,I		;HK AND READ BUFFER COMES HERE (Y,N,P)
YANKS:	SETO	I,			;APPEND JUMPS HERE
	TXNN	FF,UREAD		;HAS AN INPUT FILE BEEN SPECIFIED?
YANKQE:	ERROR <No file for input> ;NO.
	SKIPE	ABORTF		;ABORT REQUEST?
	RET			;YES, DON'T CLOBBER BUFFER
	SETOM	YAMODE		;TELL SINLD THAT THIS IS Y OR A
	CAIN	I,0
	CALL	HK			;KILL ENTIRE BUFFER
	JRST	SINLD		;GO DO SIN STUFF
	JRST	CFLUSH

;^ITEXT$ INSERTS AT THE CURRENT POINTER LOCATION THE ^I (TAB)
;	AND THE TEXT FOLLOWING THE ^I UP TO BUT NOT INCLUDING THE
;	ALT MODE.  THE POINTER IS PUT TO THE RIGHT OF THE INSERTED
;	MATERIAL.

TAB:	MOVE	A,[POINT 7,[BYTE (7).CHTAB]]	;PREPARE TO INSERT TAB
	MOVEI	B,1		;ONLY ONE CHARACTER
;**;[502] At TAB: +2L, REMOVE EDIT 500 IFF INSTALLED SM 4-Mar-82 (2 LINES)
	CALL	INSRT0		;INSERT THE TAB
	;...			;FALL INTO STANDARD INSERT CODE

;ITEXT$ INSERT, AT THE CURRENT POINTER LOCATION, THE TEXT FOLLOWING
;	THE IN UP TO BUT NOT INCLUDING THE FIRST ALT. MODE.  THE
;	POINTER IS PUT TO THE RIGHT OF THE INSERTED MATERIAL.
;NOTE: The I command can't just blindly insert its characters, since there
;may be case control characters in the string.  Therefore the I command doesn't
;use INSRT0.  If you are looking for the general text insertion routine, please
;see INSRT0.

INSERT:	TXNE	FF,ARG		;IS THERE AN ARGUMENT?
	JRST	INS1A		;YES. NI COMMAND.

;ENTRY FROM REPLACE COMMAND

RPINS:	STKVAR	<IBEG,IDSPTR,UUF,LLF,ITERM,ICNT,IBEG>
	SKIPE	ABORTF		;ABORT REQUEST?
	RET			;YES, DON'T START INSERT
	TXNN	FF,SLSL		;DID @ PRECEED I?
	SKIPA	CH,TERMIN	;NO. CH:=TERMINATOR
	CALL	RCH		;YES. CH:=USER SELECTED TERMINATOR.
	MOVEM	CH,ITERM
	SETZM	UUF		;SAY NO CASE CONTROL HAPPENING YET
	SETZM	LLF
	MOVE	A,PT
	TXNN	FF,SCANF		;DON'T MOVE HOLE IF SCANNING
	CALL	MOVHOL		;PUT HOLE WHERE WE'RE INSERTING
	MOVE	A,PT
	CALL	ADDPTR		;MAKE BYTE POINTER TO DESTINATION OF INSERTION
	SETO	B,			;BACK UP 1 SINCE IDPB BEING DONE
	ADJBP	B,A
	MOVEM	B,IDSPTR		;REMEMBER DESTINATION POINTER
	MOVEM	B,IBEG		;REMEMBER BEGINNING FOR MEASURING
	CALL	NFREE		;SEE HOW MANY CHARACTERS WE'RE ALLOWED TO INSERT
	MOVEM	A,ICNT
INXT:	CALL	SKRCH		;GET NEXT CHARACTER
	CAIN	CH,C.QUOT		;QUOTE REQUEST?
	JRST [	CALL SKRCH	;YES, READ CHARACTER BEING QUOTED
		JRST II]	;GO INSERT IT
	CAMN	CH,ITERM		;FOUND THE TERMINATOR?
	JRST	ITDON		;YES
	CAIN	CH,C.LOWR		;FORCE LOWERCASE?
	JRST [	CALL SKRCH	;YES LOOK AT NEXT
		CAIN CH,C.LOWR	;LOCK LOWERCASE?
		JRST [	SETOM LLF	;YES
			SETZM UUF	;UNLOCK UPPERS
			JRST INXT]
		LOAD CH,LWRCOD,(CH)	;NO, JUST MAKE ONE CHARACTER LOWERCASE
		JRST II]	;AND GO INSERT THE ONE BEING LOWERED
	CAIN	CH,C.RAIS		;FORCING UPPER?
	JRST [	CALL SKRCH	;YES, LOOK AT NEXT CHARACTER
		CAIN CH,C.RAIS	;LOCKING INTO UPPERCASE?
		JRST [	SETOM UUF	;YES, REMEMBER
			SETZM LLF	;AND UNLOCK LOWERS
			JRST INXT]	;GO GET NEXT CHARACTER
		LOAD CH,UPRCOD,(CH)	;NOT LOCKING UPPERCASE, JUST MAKE ONE CHARACTER UPPERCASE
		JRST II]	;GO INSERT IT
	SKIPE	UUF		;FORCING UPPER?
	LOAD	CH,UPRCOD,(CH)	;YES, GET UPPERCASE
	SKIPE	LLF		;FORCING LOWER?
	LOAD	CH,LWRCOD,(CH)	;YES, GET LOWERCASE
II:	SOSGE	ICNT		;ROOM FOR THIS CHARACTER?
	JRST	IERR		;NO, FAIL
	TXNN	FF,SCANF		;DON'T REALLY INSERT IF SCANNING
	IDPB	CH,IDSPTR		;STORE CHARACTER IN INSERTION STRING
	JRST	INXT		;LOOP FOR REST OF INSERTION

ITDON:	MOVE	A,IDSPTR		;GET PLACE TEXT RAN TO
	MOVE	B,IBEG		;GET PLACE WE STARTED
	CALL	SUBBP		;SEE HOW MANY CHARACTERS GOT INSERTED
	ADDM	A,ZEE		;SHOW INCREASE IN BUFFER SIZE
	ADDM	A,PT		;POINTER HAS ALSO MOVED TO RIGHT
	ADDM	A,HOLBEG	;HOLE STARTS FURTHER TO RIGHT NOW (IT'S SMALLER)
	CALL	SETHPT		;UPDATE HOLE DATA
	JRST	CFLUSH		;[502] DONE

;ASCIZ INSERT ROUTINE.  INSERTS THE ASCIZ STRING (ONE MARKED BY
;NULL AT END)
;CALL:
;	A/	POINTER TO ASCIZ STRING
;	CALL INSRTZ
;RETURN:
;	+1 ALWAYS

INSRTZ:	MOVE	C,A		;GET COPY OF INSERTION POINTER
	SETZ	B,		;FIRST ASSUME 0 CHARACTERS
INZ1:	ILDB	D,C		;GET CHARACTER
	JUMPE	D,INSRT0	;IF IT'S NULL, WE CAN GO INSERT
	AOJA	B,INZ1		;NO, LOOP UNTIL NULL FOUND

;GENERAL INSERT ROUTINE.  IT ALWAYS INSERTS TEXT AT THE POINTER.
;THE CALL:
;	A/	POINTER TO INSERTION
;	B/	NUMBER OF CHARACTERS
;	CALL INSRT0
;RETURNS:
;	+1 ALWAYS
;	UPDATED POINTER IN A POINTING TO END OF INSERTION

INSRT0:	STKVAR	<IPT,IC>
	MOVEM	A,IPT		;SAVE POINTER
	MOVEM	B,IC		;SAVE COUNT
	MOVE	A,PT
	CALL	MOVHOL		;put hole where insert is going
	MOVE	P1,IC		;get size of insert
	CALL	NFREE		;SEE HOW MANY MORE CHARACTERS WILL FIT IN BUFFER
	CAMGE	A,IC		;MAKE SURE THERE'S ROOM FOR THE INSERTION
IERR:	ERROR <No room in buffer>
;MOVE INSERTION INTO DATA BUFFER

INS1B:	MOVE	I,IPT		;GET BEGINNING OF INSERTION
	JUMPE	P1,INS1C		;IN CASE SOURCE IS NULL
	MOVE	OU,PT
	ADDM	P1,PT		;UPDATE POINT
	CALL	PUT		;COMPUTE DEST BYTE PTR
	CALL	DBP		;BACKUP TO BEGINNING OF DEST
	MOVE	OU,TT
	CALL	MVSTR		;MOVE STRING FROM I TO OU
	MOVE	A,IC		;GET SIZE OF INSERTION
	ADDM	A,HOLBEG		;HOLE STARTS AT A LARGER ADDRESS NOW
	ADDM	A,ZEE		;THERE'S MORE IN BUFFER NOW TOO!
	CALL	SETHPT		;SET HOLE POINTERS;
INS1C:	MOVE	A,IC		;RETURN UPDATED INSERTION POINTER IN A
	ADJBP	A,IPT
	RET
; ;G  INSERT LAST COMMAND STRING (OF  .G. 15 CHARS) INTO BUFFER

GETOB:	HLRZ	B,LSTCB		;NUMBER OF CHARS
	JUMPE	B,CFLUSH		;NO SAVED STRING
	MOVEI	A,1		;SKIP OVER THE PROMPT CHARACTER
	ADJBP	A,[POINT 7,CBUF]	;CONSTRUCT PTR TO SAVED STRING
	CALL	INSRT0		;INSERT COMMAND STRING INTO BUFFER
	JRST	CFLUSH

;WHOLE$ - RETURN CHARACTER LOC OF HOLE IN BUFFER

WHOLE:	MOVE	C,HOLBEG
	SUB	C,BEG
	JRST	ARGINC

;WBACKUP$ - TURN ON BACKUP SYSTEM

BACKUP:	SETOM	BAKFLG
	JRST	CFLUSH		;[502] DONE

;WNOBACK$ - TURN OFF BACKUP SYSTEM

NOBACK:	SETZM	BAKFLG
	JRST	CFLUSH		;[502] DONE

;TERMINAL INITIALIZATION ROUTINES
DEFINE TERINI (TABNAM)
<
TABNAM:
%%Z==0
	BLOCK	100		;MAKE SURE UNUSED ENTRIES ARE 0

DEFINE TER (SYMBOL,ADDRES)
<	LOC TABNAM+SYMBOL
	ADDRES
IFG SYMBOL-%%Z,<
	%%Z==SYMBOL
>
	LOC %%Z+TABNAM+1
>>

;TABLE OF TERMINAL INITIALIZATION ROUTINES, INDEXED BY TERMINAL TYPE

	TERINI TRMINI
	TER .TTV05,VT05		;VT05
	TER .TT100,VT100	;VT100
	TER .TTV50,VT50		;VT50
	TER .TTV52,VT52		;VT52
	TER .TT102,VT102	;VT102
	TER .TT125,VT125	;VT125

;TABLE OF TERMINAL STANDARD CHARACTERISTICS

LB==7
WB==^D15
SB==^D16

;DEFSTRS TO ACCESS THE VARIOUS TERMINAL STANDARD FIELDS

	DEFSTR STDLEN,TERSTD,LB,8
	DEFSTR STDWTH,TERSTD,WB,8
	DEFSTR SF,TERSTD,SB,1

DEFINE TCR(TYPE,LENGTH,WIDTH,SFF)
<	TER TYPE,<LENGTH>B<LB>+<WIDTH>B<WB>+<SFF>B<SB>
>
	TERINI TERSTD
RADIX 5+5
	TCR .TTV05,20,72,1
	TCR .TTV50,12,80,1
	TCR .TT100,24,80,1
	TCR .TT102,24,80,1
	TCR .TT125,24,80,1
	TCR .TTV52,24,80,1
RADIX 8


;TERMINAL TYPE INITIALIZATION
VT52:	MOVEI	A,.TTV52		;TERMINAL TYPE
	JRST	VTXXX

VT50:	MOVEI	A,.TTV50
VTXXX:	MOVEM	A,TRMTYP		;SET VT50 TERMINAL TYPE.
	SETOM	SCRNF
	CALL	SETPAR
	JRST	CFLUSH		;[502] SET PARAMETERS AND LEAVE

VT102:	MOVX	A,.TT102
	JRST	VTXXX

VT125:	MOVX	A,.TT125
	JRST	VTXXX

VT100:	MOVEI	A,.TT100
	JRST	VTXXX

VT05:	MOVEI	A,.TTV05
	JRST	VTXXX		;[502] GO SETUP

;ROUTINE CALLED AT STARTUP AND REENTER TO RESTORE TERMINAL
;CHARACTERISTICS THAT AREN'T INITIALIZED BY RESET JSYS, AND THAT MAY
;HAVE TO BE RESTORED AT REENTER, SINCE JSYS'S SUCH AS COMND MAY HAVE
;CLOBBERED THEM.

SETMOD:	MOVEI	A,1
	MOVEM	A,COCNST		;FORCE REGCOC TO DO SOMETHING
	CALL	REGCOC		;SET UP REGULAR CONTROL CHARACTER STUFF
	MOVE	A,TTYOUT		;STANDARD OUTPUT CHANNEL
	RFMOD%			;GET WAKEUP MODES
	TXO	B,TT%WAK		;WAKE ON EVERYTHING
	SFMOD%			; (FOR READING FIRST CHARACTER OF COMMAND)
	RET

;REGCOC SETS CONTROL CHARACTER ECHOS TO THAT FOR STANDARD OUTPUT.

REGCOC:	SOSE	A,COCNST	;SEE HOW MANY TIMES WE'RE NESTED AFTER THIS
	RET			;NOTHING TO DO IF OUTER ROUTINE...
				; STILL WANTS DISCOC
	MOVE	A,TTYOUT		;STANDARD OUTPUT
	SKIPE	FLAGF		;ARE WE SUPPOSED TO FLAG?
	JRST [	RFMOD%		;YES, GET SETTINGS
		TXO B,TT%UOC	;YES, TURN FLAGGING BACK ON
		STPAR%
		JRST .+1]
	DMOVE	B,REGCWD		;GET STANDARD CONTROL CHARACTER SETTINGS
	SFCOC%
	MOVE	B,COCPOS
	SFPOS%			;UNDO SYSTEM-ACCOUNTING OF ESCAPE SEQUENCE
	MOVE	A,SWIDTH
	CALL	SETWID		;RESTORE CORRECT TERMINAL WIDTH
	 JSHLT			;BETTER NOT FAIL!
	RET

;DISCOC CAUSES ALL CONTROL CHARACTERS TO ECHO LITERALLY, AS IS NEEDED BY
;VIDEO DISPLAY FUNCTIONS

DISCOC:	AOS	A,COCNST		;REMEMBER HOW MANY TIMES WE'VE NESTED
	CAIE	A,1		;IS THIS THE FIRST TIME?
	RET			;NO, SO NOTHING TO DO
	MOVE	A,TTYOUT		;STANDARD OUTPUT CHANNEL
	SKIPE	FLAGF		;IS FLAGGING ON?
	JRST [	RFMOD%		;YES, TURN IT OFF
		TXZ B,TT%UOC	;SINCE WE'LL DO OUR OWN FLAGGING.
		STPAR%
		JRST .+1]
	DMOVE	B,[EXP 525252525252,525252525252]
	SFCOC%
	RFPOS%			;SEE WHERE ON LINE WE ARE
	MOVEM	B,COCPOS		;REMEMBER SO THAT WE CAN UNDO ERRONEOUS
				; SYSTEM ACCOUNTING OF ESCAPE SEQUENCES
	MOVEI	A,0		;DON'T ALLOW LINEWRAP
	CALL	SETWID
	 JSHLT			;SHOULDN'T EVER FAIL
	RET

;THE FOLLOWING ROUTINE IS CALLED EVERY TIME WE TRANSFER FROM
;THE EXEC (BACK) TO TV.  IT ASKS THE SYSTEM WHAT THE CURRENT TERMINAL
;TYPE IS, AND THEN SETS UP ALL THE TERMINAL PARAMETERS.

SYSMOD:	MOVEI	A,.PRIOU
	GTTYP%			;get terminal type
	MOVEM	B,TRMTYP		;SAVE TERMINAL TYPE
SYSMD1:	CALL	GETMOD		;GET THE REST OF THE TERMINAL MODES
	MOVE	A,SLENTH		;GET WINDOW SIZE
	CAMLE	A,SSIZE		;MAKE SURE WITHIN RANGE
	CALL	WINSTN		;IF NOT, RESET IT TO A STANDARD SETTING
	RET

;CALL THE FOLLOWING AFTER SETTING UP TRMTYP FOR NEW TERMINAL TYPE

SETPAR:	MOVX	A,.PRIOU		;primary input
	MOVE	B,TRMTYP		;get new terminal type
	STTYP%			;tell monitor new terminal type
	SETOM	MESFLG		;IF TERMINAL TYPE CHANGED, ASSUME SCREEN MESSED UP
	CALL	SYSMD1		;go get all the new modes
	CALLRET	WINSTN		;SET UP STANDARD WINDOW SIZE

;THE FOLLOWING ROUTINE ASSUMES THE SYSTEM'S TERMINAL PARAMETERS
;HAVE BEEN SET UP, AND THIS ROUTINE SETS UP TV'S INTERNAL DATA TO
;REFLECT THE CURRENT TERMINAL SETTINGS

GETMOD:	MOVEI	A,.PRIIN	;PRIMARY INPUT DEVICE
	RFMOD%			;GET TTY INFO
	SETZM	FLAGF		;FIRST ASSUME NOT FLAGGING UPPERS
	TRNE	B,TT%UOC
	SETOM	FLAGF		;SYSTEM SAYS WE'RE FLAGGING UPPERS.
	CALL	GETWID		;GET SYSTEM TERMINAL WIDTH
	 MOVEI	A,0		;ASSUME DEFAULT IF CAN'T READ IT
	MOVE	B,TRMTYP		;GET TERMINAL TYPE
	CAIN	A,0		;IF ZERO,
	LOAD	A,STDWTH,(B)	;USE STANDARD WIDTH
	MOVEM	A,SWIDTH		;SET UP TERMINAL WIDTH
	CALL	GETLEN		;GET SCREEN SIZE
	 MOVEI	A,0		;USE STANDARD IF CAN'T
	MOVE	B,TRMTYP		;GET TERMINAL TYPE
	CAIG	A,MAXLEN		;DON'T ALLOW TOO LARGE SCREEN SIZE
	CAIN	A,0		;NON-0 LENGTH?
	LOAD	A,STDLEN,(B)	;NO, SO USE STANDARD LENGTH
	MOVEM	A,SSIZE		;REMEMBER SCREEN SIZE
	LOAD	A,SF,(B)		;SEE IF TERMINAL IS A SCREEN
	SETZM	SCRNF		;FIRST ASSUME NOT
	CAIE	A,0
	SETOM	SCRNF		;BUT MAYBE SO!
	RET

;ROUTINE TO SET UP STANDARD WINDOW SIZE TO 3 LESS THAN SCREEN SIZE

WINSTN:	MOVE	A,SSIZE		;GET SCREEN SIZE
	SUBI	A,3		;LEAVE ROOM FOR COMMAND LINES
	CAIG	A,MAXLEN		;MAKE SURE WINDOW SIZE IS LEGAL
	CAIGE	A,0		;NEVER CREATE A ZERO WINDOW SIZE FOR STANDARD
	MOVEI	A,0		;USE NO WINDOW IF IT'S <0 AFTER NORMALIZATION
	MOVEM	A,SLENTH		;STORE WINDOW SIZE
	RET
;NI INSERT AT THE POINTER A CHARACTER WHOSE 7-BIT ASCII CODE IS N
;  (BASE 10).  THE POINTER IS MOVED TO THE RIGHT OF THE NEW CHARACTER.

;**; [517] At INS1A:, inserted 5 lines, modified 1	SM	14-Mar-83
INS1A:	SKIPG	COMCNT		;[517] ANY CHARACTERS LEFT IN COMMAND STRING?
	JRST	INNEQE		;[517] NO, SO MISSING ESCAPE
	CALL	RCH		;[517] YES, GET IT
	CAME	CH,TERMIN	;[517] IS IT THE TERMINATOR?
INNEQE:	ERROR	<No terminator after nI command>  ;[517] SORRY, NO LONGER LEGAL
INS1A1:	MOVE	A,[070700,,FARG]	;POINTER TO "STRING"
	MOVEI	B,1		;WE'RE ONLY INSERTING ONE CHARACTER
	CALL	INSRT0		;[502] INSERT IT
	JRST	CFLUSH		;[502] AND DONE

OVWR:	MOVE	I,PT		;WHERE ARE WE?
	CAMN	I,ZEE		;AT END?
	JRST	OVWRND		;YES, WILL HAVE TO USE INS1A
	CALL	GETX		;BYTE POINTER TO NEXT CHAR, PLEASE
	LDB	A,TT		;GET CHARACTER THAT'S THERE
	DPB	C,TT		;AND SET THE USERS VALUE
	AOS	PT		;AND ADVANCE OVER IT
	JRST	ARGINA		;AND RETURN WITH OLD CHARACTER IN A
;**; [517] At OVWRND:, modified 1 line	SM	14-Mar-83
OVWRND:	CALL	INS1A1		;GO INSERT GIVEN CHARACTER [517] NO ESCAPE CHECK
	JRST	NE1INA		;AND RETURN -1

;@IJTEXTJ INSERT, AT THE CURRENT POINTER POSITION, THE TEXT
;	SURROUNDED BY THE INSTANCES OF THE TERMINATOR J, WHICH MAY BE AT
;	THE USER'S CHOICE ANY CHARACTER NOT APPEARING IN THE TEXT.
;	THE POINTER IS PUT TO THE RIGHT OF THE INSERTED MATERIAL.


;NBACKSLASH INSERT AT THE CURRENT POINTER LOCATION THE ASCII NUMBERS
;	EQUAL TO N.

BAKSL1:	PUSH	P,RADIX		;SAVE OLD RADIX
	TXZN	FF,ARG2		;SECOND ARG?
	JRST	BAKSLR
	SKIPG	T,SARG		;YES, FETCH
	MOVEI	T,^D10		;DEFAULT IS 10
	MOVEM	T,RADIX
BAKSLR:	MOVE	T,[XWD 700,BAKTAB-1]
	SETZ	P1,		;COUNT # DIGITS IN P1.
	MOVEI	CH,BAKSL4		;SET DPT TO RETURN TO BAKSL4
	HRRM	CH,LISTF5
	CALL	DPT		;CONVERT NUMBER TO ASCII, STORE IN BAKTAB.
	MOVE	A,[POINT 7,BAKTAB]	;POINT TO NUMBER
	MOVE	B,P1		;COUNT OF CHARACTERS
	CALL	INSRT0		;INSERT THE NUMBER
	POP	P,RADIX		;RESTORE OLD RADIX
	JRST	CFLUSH

BAKSL4:	IDPB	A,T		;STORE DIGIT IN BAKTAB
	AOJA	P1,CPOPJ		;P1:=P1+1. RETURNS TO DPT CALL+1
;NT TYPE OU THE STRING OF CHARACTERS STARTING AT THE RIGHT OF THE
;	POINTER AND CONTINUING THROUGH THE NTH LINE FEED ENCOUNTERED.
;	IF N IS NEGATIVE, N LINES TO THE LEFT OF THE POINTER ARE TYPED.
;T SAME AS 1T.
;I,JT TYPE OUT THE (I+1)TH THROUGH THE JTH CHARACTER OF THE BUFFER.

TYPE:	CALL	WINCLS		;START PRESERVED OUTPUT
	CALL	TVINIT		;GET AND CHECK ARGS
TYPE3:	SKIPN	COFLG		;^O REQUEST?
	CAML	I,C		;DONE?
	JRST	CFLUSH		;[502] DONE
	UILDB	A,P2		;GET NEXT CHAR
	CALL	TYO		;OUTPUT IT
	SKIPN	ABORTF		;ABORT REQUEST?
	AOJA	I,TYPE3		;NO
	JRST	TYOQT		;YES, QUIT

;TVINIT ROUTINE RETURNS ILDB POINTER TO BUFFER IN P2, LEFTMOST
;CHARACTER ADDRESS IN I, AND ONE MORE THAN LAST CHARACTER ADDRESS IN
;IN C

TVINIT:	CALL	GETARG		;p1:=FIRST STRING ARGUMENT ADDRESS.
				;c:=SECOND STRING ARGUMENT ADDRESS.
	MOVE	I,P1		;START GETTING CHARACTERS AT C.
	CALL	GET
	MOVSI	P2,(07B5)		;BACKUP 1 BECAUSE ILDB BELOW
	ADD	P2,TT
	RET
;P IS THE SAME AS 1P
;NP IS IDENTICAL TO PP...P (P PERFORMED N TIMES).
;I,JP OUTPUTS (I+1)TH THROUGH JTH CHARACTERS OF BUFFER.  NO FORM
;	FEED IS PUT AT THE END.  BUFFER UNCHANGED; POINTER UNMOVED.

PUNCH:	CALL	PUNCHA		;[502] DO THE WORK
	JRST	CFLUSH		;[502] DONE

PUNCHA:
;**;[511] At PUNCHA: +2L, Modified 1 line                   SM  9-Jun-82
	TXNE	FF,ARG2		;I,JP? ;[511] DON'T CLEAR ARG2 YET
	JRST	PCH0		;YES. GET STRING ARGUMENTS AND OUTPUT.
	TXNN	FF,ARG
	MOVEI	C,1
	MOVE	D,C		;NO. d:=N
	JUMPL	D,CPOPJ		;IF N .L. 0, IGNORE P.
	STKVAR	<DCNT>		;(HOLDS DE COUNT) (HOW CORNEY!)
	MOVEM	D,DCNT		;REMEMBER HOW MANY PAGES TO DO
PUN1:	CALL	PUNCHR		;PUNCH OUT BUFFER
	SKIPE	ABORTF		;ABORT?
	RET			;YES, DON'T CLOBBER BUFFER
	CALL	HK			;KILL ENTIRE BUFFER
	TXNE	FF,UREAD
	TXNE	FF,FINF
	RET
	SKIPN	DCNT		;DONE?
	RET			;YES
	CALL	YANK		;RENEW BUFFER
	SKIPE	ABORTF		;ABORT?
	RET			;YES
	MOVE	P1,ZEE
	CAMN	P1,BEG		;EMPTY BUFFER?
	TXNN	FF,FINF		;YES. QUIT ON EOF
	SOSG	DCNT		;DONE ENOUGH PAGES?
	RET
	JRST	PUN1		;NO, KEEP GOING

PUNCHR:	MOVE	P1,BEG		;OUTPUT DATA BUFFER.
	MOVE	C,ZEE
	JRST	PCH1

; ;W - WRITE OUT BUFFER AND DELETE

WRBUF:	TXNN	FF,ARG
	JRST [	MOVE P1,BEG	;ASSUME B,ZEE IF NO EXPLICIT ARG
		MOVE C,ZEE
		JRST WRBUF1]
	CALL	GETARG
WRBUF1:	PUSH	P,C		;SAVE ARGS
	PUSH	P,P1
	CALL	PCH1
	POP	P,P1		;RECOVER ARGS FOR KLBUF
	POP	P,C
	JRST	KLBUF

;DO OUTPUT VIA ROUTINE ADDRESS IN p2
; p1 = START ADDRESS
; c = END ADDRESS

PCH0:	CALL	GETARG		;GET STRING ARGS
PCH1:	STKVAR	<WRBEG,WREND>	;START AND 1+END CHARACTER ADDRESS
	MOVEM	P1,WRBEG		;STORE STARTING ADDRESS
	MOVEM	C,WREND		;AND END ADDRESS
	CALL	SKPWRT		;CAN DO SOUT
	ERROR <No file for output>
 OPTION ENC,<
	skipe	encflg
	skipe	cdewon		;need an output password?
	jrst	nogpsd
	call	getps2		;ask twice
	setom	cdewon		;got it now
	move	a,cdewrd	;get the value getps2 generated
	movem	a,cdewro	;store as output password
nogpsd:
>
	MOVE	A,WRBEG		;GET STARTING ADDRESS
	CAML	A,HOLBEG		;MAKE SURE NOT IN HOLE
	ADD	A,HOLSIZ		;IN HOLE, GET OUT
	MOVEM	A,WRBEG
	MOVE	A,WREND		;SAME FOR END ADDRESS
	CAMLE	A,HOLBEG	;ALLOWED TO BE HOLBEG BECAUSE NOT WRITTEN
	ADD	A,HOLSIZ
	MOVEM	A,WREND
	MOVE	A,WRBEG		;GET STARTING ADDRESS
	CAML	A,HOLBEG		;IS IT TO LEFT OF HOLE?
	JRST	DOAFT		;NO, THERE'S NOTHING TO THE LEFT OF THE
				; HOLE BEING WRITTEN
	MOVE	A,HOLBEG		;GET LESSER OF END ADDRESS
	CAML	A,WREND		;AND BEGINNING OF HOLE
	MOVE	A,WREND		;END ADDRESS MORE LEFT
	SUB	A,WRBEG		;A:= # OF CHARS IN FIRST PART
	MOVN	C,A		;C GETS MINUS NUMBER OF CHARS
	MOVE	I,WRBEG		;I GETS STARTING ADDRESS
	CALL	SOUT1		;DUMP STUFF TO LEFT OF HOLE
DOAFT:	MOVE	A,WREND		;MAKE SURE RIGHT MARGIN IS TO RIGHT
	CAMG	A,HOLEND		;OF END OF HOLE
	JRST	NOAFT		;NOTHING TO WRITE TO RIGHT OF HOLE
	MOVE	C,HOLEND		;GET GREATER OF BEGINNING OF OUTPUT
	CAMGE	C,WRBEG		;AND END OF HOLE
	MOVE	C,WRBEG
	MOVE	I,C		;SAVE STARTING ADDRESS
	SUB	C,WREND		;CALCULATE MINUS NUMBER OF CHARS IN 2ND PART
	CALL	SOUT1		;WRITE SECOND PART
NOAFT:	RET			;DONE!

SOUT1:	JUMPE	C,CPOPJ		;DO NOTHING IF NO CHARACTERS
	STKVAR	<SVCNT>
	MOVEM	C,SVCNT		;SAVE NEGATIVE CHARACTER COUNT
	CALL	GET1		;GET LDB POINTER TO START IN TT
	SETO	B,			;BACK UP BY ONE BYTE
	ADJBP	B,TT		;TO GET ILDB POINTER IN B
	MOVE	C,SVCNT		;GET CHARACTER COUNT
 OPTION ENC,<			;FOR CODING ALGORITHM
	skipn	encflg		;doing encryption?
	jrst	nooutc		;no, skip on
	jumpe	c,nooutc	;any characters to 'crypt?
	movmm	c,cdecnt	;yes, remember value (hack looks here)
	movem	b,cdestr	;store pointer for hack
	push	p,c		;save b and c
	push	p,b
	movei	a,cdewro	;get pointer to output password
	skipe	(a)		;real encryption value?
	call	hack		;yes, do it up
	pop	p,b		;restore b and c
	pop	p,c
nooutc:
>
	MOVE	A,OUTJFN		;GET JFN TO USE FOR OUTPUT
	CALL	SOUTX		;WRITE THE ^%$#&@$ DATA!
	SETOM	WRITEF		;SHOW THAT OUTPUT FILE HAS SOME DATA IN IT
	RET			;DONE
 OPTION ENC,<
;Code to fetch and encrypt password.

	blen==100		;max is 100 (319 letters)

getpse:	hrroi	a,[asciz/Did not match, type both again...
/]
	psout%
getps2:	hrroi	a,[asciz/ Output/]
	setzm	syl
	jrst	getpsn
getpsd:	setom	syl
	hrroi	a,[asciz/ Input/]
getpsn:	psout%
	hrloi	a,(tl%cor!tl%cro)
	seto	b,
	tlink%
	 erjmp	.+1
	movx	a,.priin
	rfmod%
	move	d,b
	txz	b,tt%eco
	sfmod%
	setzm	cdewrd
	hrroi	a,[asciz/ password: /]
	move	c,a
	psout%
	setzm	datbuf
	move	a,[datbuf,,datbuf+1]
	blt	a,datbuf+177
	hrroi	a,datbuf
	move	b,[rd%bel!rd%crf!rd%rai+blen*5-1]
	rdtty%
	 erjmp	.+1
	movei	a,.chcrt
	pbout%
	skipe	syl
	jrst	gogcde
	hrrzm	b,syl
	ldb	b,[point 7,datbuf,6]
	cain	b,.chlfd
	jrst	goytr
	hrroi	a,[asciz/ Retype for paranoia: /]
	move	c,a
	psout%
	hrroi	a,datbuf+blen
	move	b,[rd%bel!rd%crf!rd%rai+blen*5-1]
	rdtty%
	 erjmp	.+1
	hrrzs	b
	came	b,syl
	jrst	getpse
	subi	b,<blen+1>*5
	idivi	b,5
	hrli	b,datbuf
	movss	b
cmppas:	move	a,blen(b)
	came	a,(b)
	jrst	getpse
	aobjn	b,cmppas
gogcde:	move	b,d
	movx	a,.priin
	sfmod%
	call	crr
	move	c,[point 7,datbuf]
	movei	d,16
	setz	b,
geyt:	ildb	a,c
	cain	a,.chlfd
	jrst	goytr
	setom	cdewrd
gotyq:	rot	b,4
	xor	b,a
	rot	b,-3
	jfcl	17,.+1
	add	b,a
	trne	b,40
	add	b,[642032,,532716]
	jfcl	17,.+2
	movss	b
	ldb	a,[point 12,c,11]
	lsh	a,6
	add	a,d
	hrl	a,b
	rotc	a,9
	eqv	b,a
	tlnn	b,400
	aoja	d,geyt
	soja	d,geyt
goytr:	cain	b,0
	movei	b,114411
	skipe	cdewrd
	movem	b,cdewrd
	ret
>
;THE MUMBLX ROUTINES DO JSYS'S THAT MAY CAUSE OVER QUOTA TRAPS, AND
;WHICH OVER QUOTA CAN BE CORRECTLY CONTINUED FROM.  AT TIME OF THIS
;WRITING, FOR EXAMPLE, A MULTIPLE PAGE PMAP COPYING FROM CORE TO A FILE
;COULD NOT BE CORRECTLY CONTINUED FROM AFTER AN OVER QUOTA TRAP.
;IT WOULD ERRONEOUSLY DO ALL THE PAGES OVER AGAIN, OR FALL THROUGH AND
;NEVER DO THE ONES THAT COME AFTER THE OVER QUOTA TRAP

DEFINE FOOX(WHAT)
<WHAT'X:	MOVE	CX,[WHAT]
	CALLRET	JSYSX
>

FOOX	BOUT
FOOX	SOUT
FOOX	JFNS
FOOX	DIRST
FOOX	ODTIM

JSYSX:	MOVEM	A,QUOJFN		;STORE JFN IN CASE OVER QUOTA
	XCT	CX			;DO THE JSYS
IOWAIT:	 JFCL				;PARANOIA
	SETZM	QUOJFN			;CLEAR THIS, DON'T CAUSE AUTO-EXPUNGE
	RET

;THE ;S COMMAND SAVES THE ENTIRE BUFFER AND CLOSES THE OUTPUT FILE, 
;WITHOUT ALTERING THE BUFFER OR THE POINTER.  IF NO FILE IS OPEN
;FOR WRITING WHEN ;S IS EXECUTED, ONE IS OPENED.  WITH ARGUMENT(S),
;THE ;S COMMAND INTERPRETS THE ARGS LIKE K, T, X ETC. AND DOES THE
;SAME AS 	;S WITH NO ARGS, EXCEPT ONLY THE SPECIFIED BUFFER PORTION IS
;SAVED.

BSAVE:	TXNE	FF,ARG!ARG2		;[506] DID THE USER GIVE ARGS?
	JRST [CALL GETARG		;[506] YES, SET THEM UP...
	      JRST BSAVE1]		;[506] AND USE THEM
	MOVE	P1,BEG
	MOVE	C,ZEE			;USE (W)HOLE BUFFER IF NO ARGS SUPPLIED.
BSAVE1:	PUSH	P,C
	PUSH	P,P1			;SAVE THE BUFFER ADDRESS RANGE.
	CALL	SKPWRT			;IS AN OUTPUT FILE ALREADY OPEN?
	 CALL	UNLD1			;NO, SO OPEN ONE.
	POP	P,P1
	POP	P,C			;RESTORE BUFFER RANGE TO BE OUTPUT.
	CALL	PCH1			;OUTPUT THE SPECIFIED BUFFER PORTION
	JRST	SEMIC			;AND DO THE;C OPERATION
;NJ MOVE THE POINTER TO THE RIGHT OF THE NTH CHARACTER IN THE
;	BUFFER. (I.E., GIVE "." THE VALUE N.)
;J SAME AS 0J.

JMP:	TXZE	FF,SLSL			;@J?
	JRST	ATSGNJ			;YES.
	ADD	C,BEG			;PT:=N+BEG
	JRST	JMP1

; R - REPLACE ... BY ...

REPLAC:	CALL	CHK2
;**;[510] At REPLAC: +1L, Inserted 1 line                   SM 26-May-82
	MOVEM	FF,TMPFLG		;[510] REMEMBER FLAGS FOR LATER
	TXO	FF,RPLFG
	TXZ	FF,ARG+ARG2		;SO AS NOT TO CONFUSE S K AND I
	MOVEM	C,REPARG		;REMEMBER ARGUMENT TO R COMMAND
RPLC3:	CALL	SAVCMD			;REMEMBER CMD STATE FOR GARBAGE COLLECTOR
;**;[516] At RPLC3: +1L, Inserted 3 lines                   SM  7-Mar-83
	MOVE	A,TMPFLG		;[516] RESTORE FLAGS CLEARED BY OTHER ROUTINES
	ANDI	A,SLSL!COLONF		;[516] CLEAR ALL BUT SLSL AND COLONF
	OR	FF,A			;[516] IF THEY WERE ON, KEEP THEM ON
	SKIPE	ABORTF			;ABORT?
	JRST	RPLC4			;YES, STOP
	MOVEI	A,1			;WANT 1ST OCCURENCE
	SKIPGE	REPARG			;IS ARG NEGATIVE ??
	SETO	A,			;YES, SO WANT -FIRST OCCURANCE
	CALL	SERCH0			;SEARCH AND ADVANCE PT
	TXNN	FF,SLSL			;SEE IF @ BEFORE R
	JRST	RNOHAK			;NO @
	MOVE	TT,CPTR			;THERE WAS @, SO BACK UP COMMAND POINTER
					; SO INSERT CAN READ DELIMITER
	CALL	DBP			;DECREMENT COMMAND STRING BYTE POINTER
	AOS	COMCNT			;AND REMEMBER ONE MORE CHAR IN COMMAND STRING
	MOVEM	TT,CPTR			;SAVE NEW POINTER
RNOHAK:	TXNN	FF,SCANF		;IF SCANNING, PRETEND SEARCH FAILED
	SKIPL	SFINDF			;DID SEARCH SUCCEED?
	JRST	NOREPL			;NO, :RFOO$BAR$ WAS REQUESTED, BUT NO FOO FOUND
	MOVN	P1,SCHLNN		;GET NUMBER OF CHARACTERS TO DELETE
	SKIPLE	REPARG			;IF -ARG, WE ARE ALREADY AT BEG OF STRING
	ADDM	P1,PT			;BACKUP PT TO BEG OF SEARCH STRING
	PUSH	P,PT
	MOVM	A,P1			;SPECIFY HOW MANY CHARACTERS TO DELETE
	CALL	ERASE			;DELETE THEM
	CALL	RPINS			;INSERT THE NEW STUFF
	POP	P,C
	SKIPGE	REPARG			;SKIP IF REPLACING IN FORWARD DIRECTION
	MOVEM	C,PT			;RESTORE PT IF -ARG
	SKIPLE	REPARG			;REPLACING TO THE RIGHT?
	SOS	REPARG			;YES, SO APPROACH 0 FROM ABOVE
	SKIPGE	REPARG			;REPLACING TO THE LEFT?
	AOS	REPARG			;YES, SO APPROACH 0 FROM BELOW
	SKIPN	REPARG			;DONE ENOUGH REPLACEMENTS?
	JRST	RPLC4			;YES
	CALL	RESCMD			;RESTORE COMMAND STATE
	JRST	RPLC3

;**;[504] Fix code at NOREPL: to use SKPIN1
NOREPL:	TXNN	FF,SLSL			;SEE IF @
	SKIPA	CH,TERMIN		;NO, TAKE USUAL TERMINATOR
	CALL	RCH			;USER CHOICE
	MOVEM	CH,DLIMIT		;SKPIN1 WANTS DELIMITER IN DLIMIT
	CALL	SKPIN1			;SKIP INSERT STRING
RPLC4:	ADJSP	P,-CBLEN		;GET RID OF SAVED COMMAND STATE
	TXZ	FF,RPLFG
;**;[510] At RPLC4: +2L, Inserted 3 lines                   SM 26-May-82
	MOVE	A,TMPFLG		;[510] GET ORIGINAL FLAGS BACK
	TXNE	A,COLONF		;[510] DID HE ASK FOR A COLON MODE REPLACE?
	TXO	FF,COLONF		;[510] YES, BUT THE FLAG GOT CLOBBERED.
	MOVE	A,SFINDF		;RETURN SEARCH SUCCESS VALUE
	JRST	SRET			;GO RETURN CORRECT VALUE
;NC SAME AS .+NJ.  NOTE THAT N MAY BE NEGATIVE.

CHARAC:	CALL	CHK2			;MAKE SURE THERE IS AN ARGUMENT
	ADD	C,PT			;c:=PT+p1(c)

;IF c LIES BETWEEN BEG AND Z, STORE IT IN PT.

JMP1:	CALL	CHK			;IS p1(c) WITHIN DATA BUFFER?
	MOVEM	C,PT			;YES. PT:=p1(c)
	JRST	CFLUSH

;NL IF N .G. 0:	MOVE POINTER TO THE RIGHT, STOPPING WHEN IT HAS
;		PASSED OVER N LINE FEEDS.
;	IF N .L. 0:	MOVE POINTER TO THE LEFT; STOP WHEN IT HAS PASSED
;		OVER N+1 LINE FEEDS AND THEN MOVE IT TO THE RIGHT OF
;		THE LAST LINE FEED PASSED OVER.
;L SAME AS 1L.

LINE:	CALL	GETARG			;NO. p1:=FIRST STRING ARGUMENT ADDRESS,
	XOR	C,P1			;C:=SECOND STRING ARGUMENT ADDRESS.
	XORM	C,PT
	JRST	CFLUSH

; n,m;L RETURNS THE NUMBER OF LINEFEEDS BETWEEN n AND m.

CNLINE:	CALL	GETARG
	MOVE	I,P1			;GO HUNTING FOR LINEFEEDS
	SETZ	A,			;ACCUMLATE COUNT HERE
CNTLF1:	CAML	I,C			;GOT TO END OF RANGE?
	JRST	ARGINA			;YES, RETURN ANSWER
	CALL	GET			;GET CHARACTER
	CAIN	CH,.CHLFD		;GOT A LINE FEED?
	ADDI	A,1			;YES, COUNT IT
	AOJA	I,CNTLF1		;AND GO GET NEXT CHARACTER
;"E" - ENDLINE, GOES TO END OF SAME LINE THAT "L" GOES TO BEGINNING
;OF, EXCEPT DEFAULT ARG IS 0, I.E. GO TO END OF CURRENT LINE

ELINE:	SKIPN	EXECOP			;[502] IS AN OP WAITING?
	TXNE	FF,ARG			;[502] OR AN ARG?
	JRST	.+2			;[502] YES, GO HANDLE LIKE THE "L" COMMAND
	JRST	ELINE0			;[502] NEITHER, GET TO END OF THIS LINE
	CALL	GETARG
	XOR	C,P1			;SET PT TO WHICHEVER ARG ISN'T PT
	XORM	C,PT
ELINE0:	CALL	TOEOL			;MOVE PT TO END OF CURRENT LINE
	JRST	CFLUSH

;SUBROUTINE TO MOVE PT TO END OF CURRENT LINE

TOEOL:	MOVE	I,PT
	MOVE	P1,ZEE
	SUB	P1,I			;COMPUTE MAX NUMBER CHARS TO SKIP
	JUMPE	P1,CPOPJ		;NOP IF AT END OF BUFFER
	CALL	GET			;GET FIRST CHAR
TOEOL1:	AOS	PT			;SKIP ONE CHAR
	CAIN	CH,.CHLFD		;JUST PASSED END OF LINE?
	JRST	TOEOL2			;YES
	UILDB	CH,TT			;NO, GET NEXT CHAR
	SOJG	P1,TOEOL1		;COUNT CHARS
	RET				;AT END OF BUFFER

;BACKUP OVER END OF LINE CHARACTER AND ANY CR'S WHICH MAY HAVE
;PRECEEDED IT

TOEOL2:	SOS	C,PT			;BACKUP OVER CHAR
	CAMG	C,BEG			;AT TOP OF BUFFER?
	RET				;YES, DONE
	CALL	DBP
	LDB	CH,TT			;GET PRECEEDING CHAR
	CAIN	CH,.CHCRT		;A CR?
	JRST	TOEOL2			;YES, BACK OVER IT TOO
	RET				;NO, DONE
;ROUTINE TO RETURN CURRENT ARGUMENT IN c
;ASSUMES A VALUE OF 1 WITH SIGN OF LAST OPERATOR
;IF THERE IS NO CURRENT ARGUMENT
;CALL CALL CHK2
;	RETURN WITH C:=CURRENT ARG.,+1 OR -1

CHK2:	TXNN	FF,ARG			;IS THERE AN ARGUMENT?
	JRST	CHK22			;NO, GO CONJURE ONE UP
	MOVE	C,FARG			;[502] YES, GET IT
	RET				;DONE

CHK22:	MOVE	C,EXECOP		;[502] WHAT IS THE CURRENT OP?
	SETZM	EXECOP			;[502] AND BLOW AWAY THE OP
	CAIE	C,OP.SUB		;[502] REAL MINUS SIGN?
	TDZA	C,C			;[502] NO, 0 (WILL BECOME 1)
	HRROI	C,-2			;[502] YES, -2 (WILL BE -1)
	AOJA	C,CPOPJ

;NK PERFORM NL BUT DELETE EVERYTHING THE POINTER MOVES OVER.
;M,NK DELETE THE (M+1)TH THROUGH THE NTH CHARACTER FROM THE BUFFER.
;	THE POINTER IS THEN PUT WHERE THE DELETION TOOK PLACE.
;K SAME AS 1K

KILL:	CALL	GETARG			;p1:=FIRST STRING ARG. ADDRESS
					;c:=SECOND STRING ARG. ADDRESS
KLBUF:	CAMN	P1,BEG
	CAME	C,ZEE
	TRNA
	JRST	HKC			;[502] BECOME AN HK COMMAND
	MOVEM	P1,PT			;PT:=C(p1)
	SUB	C,P1			;C:=NO. OF CHARACTERS TO KILL.
	JUMPE	C,CFLUSH		;[507] NONE. GO CLEAR FLAGS.
	JRST	KLB1

KLBUF1:	TXO	FF,RPLFG
	CALL	KLBUF
	TXZ	FF,RPLFG
	RET
;ND DELETE N CHARACTERS FROM THE BUFFER: IF N IS POSITIVE, DELETE
;	THEM JUST TO THE RIGHT OF THE POINTER; IF N IS NEGATIVE, DELETE
;	THEM JUST TO ITS LEFT.
;D SAME AS 1D

DELETE:	CALL	CHK2		;MAKE SURE c CONTAINS AN ARGUMENT
KLB1:	SKIPE	ABORTF		;ABORT?
	RET			;YES
	MOVE	A,C		;GET NUMBER OF CHARACTERS TO DELETE
	CALL	ERASE		;[502] DO IT
	JRST	CFLUSH		;[502] AND DONE

;ROUTINE TO KILL ENTIRE BUFFER.  THIS IS CODED AS A SPECIAL CASE SO
;THAT WE DON'T WASTE TIME MOVING THE HOLE TO THE POINT WHERE THE
;DELETION IS TAKING PLACE.

HKC:	CALL	HK			;[502] DO THE WORK
	JRST	CFLUSH		;[502] AND DONE

HK:	MOVE	A,BEG
	MOVEM	A,ZEE		;RESET END OF BUFFER TO BEGINNING
	MOVEM	A,PT		;PUT POINTER AT BEGINNING TOO
	CALLRET	MAKHOL		;RECREATE THE HOLE AND RETURN

;ROUTINE TO ERASE CHARACTERS FROM BUFFER AT THE POINTER.  TAKES NUMBER
;OF CHARACTERS IN A, WHERE POSITIVE MEANS DELETE THEM TO RIGHT OF
;POINTER AND NEGATIVE MEANS DELETE THEM TO LEFT OF POINTER.

ERASE:	STKVAR	<COUNT>		;CELL TO HOLD NUMBER OF CHARACTERS BEING DELETED
	MOVEM	A,COUNT		;REMEMBER HOW MANY
	MOVE	C,A
	ADD	C,PT		;c:=PT+c
	CALL	CHK		;STILL IN DATA BUFFER?
	MOVE	A,PT
	SKIPL	B,COUNT
	ADD	A,B

;**NOTE: HIGH EFFICIENCY "X" OPERATION ASSUMES THAT THE ERASE ROUTINE
;POSITIONS THE HOLE TO THE RIGHT OF THE DELETION-ELECT.

	CALL	MOVHOL		;PUT THE HOLE TO RIGHT OF DELETION-ELECT
	MOVM	A,COUNT		;GET EXTRA HOLE SIZE
	MOVN	A,A		;GET NEGATIVE
	ADDM	A,ZEE		;Z ALWAYS GOES DOWN FOR A DELETION
	ADDM	A,HOLBEG		;HOLE STARTS FURTHER LEFT AFTER DELETION
	SKIPGE	A,COUNT		;DELETING TO LEFT OF POINTER?
	ADDM	A,PT		;YES, SO POINTER MOVES LEFT TOO
	CALL	SETHPT		;SET HOLE POINTERS
	RET			;DONE

;ROUTINE TO CHECK DATA BUFFER POINTER
;CALL MOVE c,POINTER
;	CALL CHK
;	RETURN IF c LIES BETWEEN BEG AND Z

CHK:	CAMG	C,ZEE
	CAMGE	C,BEG
	ERROR <Argument out of range>
	RET

;ROUTINE TO PUT STRING ARGUMENT ADDRESSES WITHIN DATA BUFFER
;BOUNDS AND CHECK ORDER RELATION.
;CALL MOVE p1,FIRST STRING ARGUMENT ADDRESS
;	MOVE c,SECOND STRING ARGUMENT ADDRESS
;	CALL CHK1
;	RETURN
;p1:=MAXI(BEG,C),BEG), c:=MIN(p1(c),Z)
;IF p1 .G. c, DOES NOT RETURN.

CHK1:	CAMG	P1,BEG		;p1:=MAX(p1(p1),BEG)
	MOVE	P1,BEG
	CAML	C,ZEE		;c:=MIN(p1(c),Z)
	MOVE	C,ZEE
	CAMLE	P1,C		;p1 .G. c?
	ERROR <Second argument is not greater than first>
	RET			;NO

;ROUTINE TO PARSE A SEARCH STRING.
;ACCEPTS:	A/	0 FOR PARSING FROM COMMAND STRING, NON-0 FOR REPARSING
;
;RETURNS:	+1	ALWAYS

SPARSE:	TRVAR	<RPCNT,RPPTR,RPRSF,RBEG,REND,<SMAT0,4>>	
				;200(8) BITS, ONE FOR EACH CHARACTER
	MOVEM	A,RPRSF		;REMEMBER WHETHER REPARSING
	JUMPN	A,[	MOVE A,[POINT 7,SCHBUF]	
				;SET UP POINTER TO STRING BEING REPARSED
			MOVEM A,RPPTR
			MOVE A,SSLEN
				;REMEMBER HOW MANY CHARACTERS TO REPARSE
			MOVEM A,RPCNT
			JRST .+1]
	SETZM	SMAT		;CLEAR THE MATRIX
	MOVE	A,[SMAT,,SMAT+1]
	BLT	A,SMAT+SMATLN-1
	MOVX	P1,1B0		;BIT POSITION TO SET IN TABLE
	MOVE	A,[POINT 7,SCHBUF]	;POINTER TO SEARCH STRING BUFFER
	MOVEM	A,SCHPTR
	SETZM	SSLEN		;INITIALIZE THE SEARCH STRING LENGTH
SER1:	SKIPE RPRSF		;REPARSING?
	JRST [	SKIPG RPCNT	;YES, HAVE WE REACHED END OF STRING?
		JRST SP1	;YES
		CALL GETSCH	;NO, GET NEXT CHARACTER (CNT DEC'D AT GETSCH)
		JRST SER2]	;DON'T CHECK FOR TERMINATOR!
	CALL	GETSCH		;GET NEXT CHARACTER FROM SEARCH STRING
	CAMN	CH,SDELIM		;END OF SEARCH STRING?
	JRST	SP1		;YES
SER2:	JUMPE	P1,[ERROR <Search string more than 36 character positions long>]
	CALL	SCHST1		;STUFF SEARCH CHARACTER INTO STRING
	CALL	SCHAR		;GET BITS FOR CHARACTER
	MOVSI	T,-200		;COPY BITS INTO P1TH COLUMN OF SMAT
	MOVE	TT,[POINT 1,A]	;1-BIT BYTE POINTER TO BITS (440100)
SER3:	ILDB	CH,TT		;GET NEXT BIT
	CAIE	CH,0		;SET THIS BIT?
	IORM	P1,SMAT(T)		;YES
	AOBJN	T,SER3
	LSH	P1,-1		;STEP TO NEXT COLUMN IN MATRIX
	JRST	SER1		;LOOP FOR REST OF SEARCH STRING

SP1:	MOVE	A,P1
	JFFO	A,SEOS3		;GET NUMERICAL LENGTH OF SEARCH STRING
	MOVEI	B,^D36		;IF A IS 0, THEN SEARCH STRING LENGTH IS 36
SEOS3:	MOVEM	B,SCHLNN		;REMEMBER IT
	SETOB	A,B		;A ACCUMULATES BITS THAT ARE 1 FOR ALL
				; CHARACTERS MATCHING FIRST FIVE,
				; B ACCUMULATES 0'S
	MOVSI	C,-SMATLN		;POINTER TO SEARCH MATRIX
ZLUP1:	LDB	D,[370500,,SMAT(C)] ;GET WHICH POSITIONS THIS CHARACTER
				 ;MAY MATCH IN
	HRRZ	P1,C		;GET THE CHARACTER
	MUL	P1,[<BYTE(7)1,1,1,1,1>];MAKE FIVE COPIES
	LSH	P2,1
	LSHC	P1,-1		;GET ALL FIVE COPIES IN ONE WORD
	MOVE	P1,P2		;COPY OF CHARACTERS IN P1
;*
;1 TURN ALL BITS ON IN POSITIONS WHERE THIS CHARACTER ISN'T SUPPOSED TO MATCH
;2 TURN ALL BITS OFF IN COLUMNS THAT AREN'T SUPPOSED TO MATCH THIS CHARACTER
;3 ACCUMULATE BIT POSITIONS THAT ARE ON FOR ALL CHARACTERS THAT MAY MATCH
;4 ACCUMULATE BITS THAT ARE OFF FOR ALL CHARACTERS THAT MAY MATCH THIS POSITION
	ORCM	P1,MSKTAB(D)	;*1
	AND	P2,MSKTAB(D)	;*2
	AND	A,P1		;*3
	ANDCM	B,P2		;*4
	AOBJN	C,ZLUP1		;LOOP FOR ALL CHARACTERS
	IOR	A,B			;NOW A HOLDS ALL BITS THAT ARE THE SAME
				; FOR ALL CHAR THAT MATCH IN FIRST 5 POSITIONS
	MOVE	B,SCHLNN		;SEE HOW LONG SEARCH STRING IS
	CAIG	B,5		;LESS THAN 5?
	TDZ	A,DNTCAR(B)		;GET RID OF BITS WE DON'T CARE ABOUT
	LSH	A,-1		;WORD DURING SEARCH WILL BE RIGHT-JUSTIFIED
	MOVEM	A,CARBTS		;REMEMBER BIT POSITIONS WE CARE ABOUT
	MOVSI	A,-SMATLN		;LOOP TO GET SOME STRING THAT MATCHES
	MOVEI	B,0		;THIS WILL BECOME SOME STRING THAT'S...
				; A MATCH FOR THE FIRST 5 CHARS OF
				; THE SEARCH STRING
	SETO	C,			;THIS SHOWS POSITIONS YET TO BE FILLED
GEN0:	SKIPN	P1,SMAT(A)	;DOES THIS CHARACTER MATCH ANYWHERE?
	JRST	GEN1		;NO
	TLNE	P1,(1B0)	;IS THIS CHARACTER A MATCH FOR THE 1ST POSITION
	TLNN	C,(1B0)		;DOES FIRST POSITION NEED FILLING?
	JRST	GEN2		;NO
	DPB	A,[350700,,B]	;FOUND A CHARACTER FOR FIRST POSITION
	TLZ	C,(177B6)		;REMEMBER THAT WE FOUND ONE
GEN2:	TLNE	P1,(1B1)		;SAME FOR SECOND CHARACTER POSITION
	TLNN	C,(1B7)
	JRST	GEN3
	DPB	A,[260700,,B]
	TLZ	C,(177B13)
GEN3:	TLNE	P1,(1B2)
	TLNN	C,(1B14)
	JRST	GEN4
	DPB	A,[170700,,B]
	TDZ	C,[177B20]
GEN4:	TLNE	P1,(1B3)
	TRNN	C,1B21
	JRST	GEN5
	DPB	A,[100700,,B]
	TRZ	C,177B27
GEN5:	TLNE	P1,(1B4)
	TRNN	C,1B28
	JRST	GEN1
	DPB	A,[010700,,B]
	TRZ	C,177B34
GEN1:	AOBJN	A,GEN0		;LOOP FOR ALL CHARACTERS
	MOVE	A,SCHLNN		;SEE HOW MANY POSITIONS WE SHOULD HAVE
				; FOUND CHARACTERS FOR
	TRZ	C,1			;GET RID OF B35
	CAIG	A,5
	TDZ	C,DNTCAR(A)		;GET RID OF BITS WE DON'T CARE ABOUT
	JUMPN	C,SFAIL		;IF SOME BITS DIDN'T GET CLEARED,
		; THERE'S NO POSSIBLE STRING THAT COULD MATCH THE SEARCH!
	MOVEM	B,MATCH		;REMEMBER STRING THAT MATCHES THE SEARCH
	LSH	B,-1		;RIGHT-JUSTIFY
	AND	B,CARBTS		;KEEP ONLY BITS WE CARE ABOUT
	MOVEM	B,SMASK		;REMEMBER MASK FOR SEARCH LOOP

;WHEN SEARCHING IN REVERSE, THE LSHC'S SHIFT THE UNUSED B35 THROUGH THE
;WORD WE'RE TESTING.  ONE WAY TO AVOID THIS IS COLLAPSE THE TWO WORDS
;BEFORE SHIFTING.  HOWEVER, THIS IS AN EXTRA INSTRUCTION EVERY TIME
;THROUGH THE SEARCH LOOP.  INSTEAD, AFTER EVERY SHIFT, WE'LL USE A
;DIFFERENT SET OF MASKS TO TEST THE WORD, MASKS WHICH ASSUME THE
;B35 MOVES THROUGH THE WORD.  THE FOLLOWING TWO CALLS TO GENTAB
;GENERATE THE SPECIAL VERSIONS OF THE TWO MASKS.

	MOVE	P1,CARBTS	;MASK SHOWING BIT POSITIONS WE CARE ABOUT
	MOVEI	P2,CARTAB ;ADDRESS OF TABLE TO RECEIVE VERSIONS OF THE MASK
	CALL	GENTAB		;GENERATE THE DIFFERENT VERSIONS
	MOVE	P1,SMASK		;MASK SHOWING WHAT WE'RE LOOKING FOR
	MOVEI	P2,SMTAB		;TABLE TO RECEIVE DIFFERENT VERSIONS
	CALLRET	GENTAB

;ROUTINE TO READ NEXT CHARACTER FROM COMMAND STRING AND STUFF IT INTO
;SEARCH STRING

SCHSTF:	CALL	GETSCH		;READ CHARACTER
SCHST1:	AOS	A,SSLEN		;SEE HOW MANY CHARACTERS THIS WILL BE
	CAILE	A,SMAXLN		;STILL WITHIN RANGE?
	ERROR <Too many characters in search string>
	IDPB	CH,SCHPTR		;STORE CHARACTER IN SEARCH STRING
	RET

;ROUTINE CALLED DURING SEARCH PARSING TO GET NEXT CHARACTER FROM SEARCH
;STRING.  DURING A SEARCH COMMAND.

GETSCH:	SKIPN	RPRSF		;REPARSING?
	CALLRET	SKRCH		;NO, GO READ CHARACTER FROM COMMAND STRING
	SOS	RPCNT		;GET THE $%$^%# COUNT RIGHT!
	ILDB	CH,RPPTR		;YES, GET NEXT CHARACTER BEING REPARSED
	RET

;CALL HERE TO SAVE COMMAND STATE ON STACK

SAVCMD:	POP	P,B			;GET RETURN ADDRESS
	MOVX	A,CMMSK		;GET VALUE TO CHECK AT RESCMD TIME...
	MOVEM	A,CMSMK		;AND STORE
	HRRI	A,1(P)		;GET STACK ADDRESS FOR SAVING ARGS
	ADJSP	P,CBLEN		;ALLOCATE ROOM FOR BLOCK
	 ERJMP	SAVIQE		;[520] NO ROOM?
	HRLI	A,CBBLK		;GET STARTING ADDRESS OF BLOCK
	BLT	A,(P)		;PUT COMMAND STATE ON STACK
	JRST	(B)		;RETURN TO CALLER

;Dilemma. The stack is already blown at this point. We really can't just use
; the ERROR macro, since it makes heavy use of the stack. We set up a temp
; stack just for this case...
SAVIQE:	MOVEI	P,DATBUF-1	;[521] USE THE SCRATCH BLOCK FOR STACK
	ERROR	<Too many nested iterations, or illegal O command>
				;[520] HERE IF NO ROOM ON STACK FOR ITERATION

;HERE TO READ SAVED STATE BUT *NOT* REMOVE IT FROM THE STACK

REACMD:	POP	P,A			;GET RET ADDRESS
	MOVX	B,CMMSK		;GET CHECK WORD
	CAME	B,(P)		;IS LAST WORD CORRECT?
	JRST	RESQE		;NOPE!
	MOVSI	B,1-CBLEN(P)	;GET ADDRESS OF STATE
	HRRI	B,CBBLK		;ADDRESS OF BLOCK TO RESTORE STATE TO
	BLT	B,CBBLK+CBLEN-1	;RESTORE IT
	JRST	(A)		;GO LEAVE

;HERE TO RESTORE PREVIOUS COMMAND STATE

RESCMD:	POP	P,A			;GET RETURN ADDRESS
	MOVX	B,CMMSK		;CHECK LEGALITY
	CAME	B,(P)		;OK?
RESQE:	ERROR <Command state not saved, check angle brackets and parentheses>
	HRLI	B,1-CBLEN(P)	;GET ADDRESS OF SAVED STATE
	HRRI	B,CBBLK		;ADDRESS OF STATE BLOCK
	BLT	B,CBBLK+CBLEN-1	;RESTORE STATE
	ADJSP	P,-CBLEN		;RELEASE STACK SPACE
	JRST	(A)		;RETURN TO CALLER

;ROUTINE TO TURN ON CORRECT BITS IN MATRIX ACCORDING TO WHAT THE NEXT CHARACTER
;IS. CALL WITH CHARACTER IN CH.

SCHAR:	STKVAR	<NOTFLG,<SAVSM,4>>
	HRLI	A,SMAT0		;SAVE AWAY MATRIX WHILE WE USE IT
	HRRI	A,SAVSM
	BLT	A,3+SAVSM
	SETZB	A,SMAT0		;CLEAR OUT THE BIT TABLE
	SETZB	B,1+SMAT0
	DMOVEM	A,2+SMAT0	;VERY SLIGHTLY CLEVER
	SETZM	NOTFLG		;HAVEN'T SEEN ^N YET
SCHNOT:	CAIN	CH,"N"-100		;NOT?
	JRST [	SETCMM NOTFLG	;YES, REVERSE DECISION OF WHETHER TO NEGATE
		CALL SCHSTF	;READ AND STUFF NEXT CHARACTER
		JRST SCHNOT]	;MAYBE DOUBLE NEGATIVE
	CAIE	CH,"Q"-100		;^Q?
	CAIN	CH,C.QUOT		;QUOTING THE NEXT CHARACTER?
	JRST	[	CALL SCHSTF	;YES, READ CHARACTER BEING QUOTED
		CALL SETBIT	;SET BIT FOR LITERAL CHARACTER
		JRST SCHOUT]	;DONE
	CAIN	CH,"E"-100		;IS IT SPECIAL SEARCH OPTION CHARACTER?
	JRST	DOCE		;YES, GO HANDLE IT
	CAIN	CH,"X"-100		;NO. ^X?
	JRST	CNTRX		;YES
	CAIN	CH,"S"-100		;NO. ^S?
	JRST	CNTRB		;YES
	CALL	SETBIT		;SET BIT FOR CHARACTER
	SKIPE	EXACTF		;EXACT MATCH ONLY?
	JRST	SCHOUT		;YES, DON'T SET OTHER CASE
	LOAD	CH,UPRCOD,(CH)	;NO, GET UPPERCASE VERSION
	CALL	SETBIT		;SET BIT FOR UPPERCASE
	LOAD	CH,LWRCOD,(CH)	;GET LOWERCASE VERSION
	CALL	SETBIT		;SET BIT FOR LOWERCASE
SCHOUT:	DMOVE	A,SAVSM
	DMOVE	C,2+SAVSM		;GET PRESERVED SMAT0 FROM PREVIOUS LEVEL
	EXCH	A,SMAT0		;RESTORE PRESERVED SMAT0, GET OURS
	EXCH	B,1+SMAT0
	EXCH	C,2+SMAT0
	EXCH	D,3+SMAT0
	SKIPE	NOTFLG		;WAS "NOT" SPECIFIED?
	JRST [	SETCA A,	;YES, COMPLEMENT ALL THE BITS
		SETCA B,
		SETCA C,
		SETCA D,
		RET]
	RET


;CNTR X MATCHES ANY ARBITRARY CHARACTER

CNTRX:	SETOB	A,SMAT0
	SETOB	B,1+SMAT0		;MATCH EVERYTHING
	DMOVEM	A,2+SMAT0
	JRST	SCHOUT

;HERE TO HANDLE ^E.  THIS ROUTINE RECURSES FOR USEFUL THINGS LIKE
;^E[A,B,^E<12>] ( FIND A OR B OR LINEFEED) AND USELESS THINGS
; LIKE ^E[A,B,^E[C,D]] ( FIND A OR B OR C OR D)

DOCE:	CALL	SCHSTF		;PUT CHARACTER IN SEARCH STRING
	CAIE	CH,74		;NUMBER COMING UP? (74 IS OPEN ANGLE BRACK)
	JRST	SNOTDG		;NO

;OCTAL DIGITS AFTER CTRL/E MEANS CHARACTER WITH SPECIFIED ASCII VALUE

	MOVX	P2,1B0		;START WITH 1B0 SO WE'LL KNOW IF ANYTHING TYPED

SDIG1:	CALL	PEEKCH		;PEEK AT NEXT CHARACTER
	 JRST	SDIGE		;AREN'T ANY MORE!
	CAIL	CH,"0"		;OCTAL DIGIT?
	CAILE	CH,"7"		;..
	JRST	SDIGE		;NO
	LSH	P2,3		;YES, MAKE ROOM FOR IT
	CALL	SCHSTF		;REALLY READ IT THIS TIME!
	IORI	P2,-"0"(CH)	;ACCUMULATE DIGIT
	JRST	SDIG1		;GET REST OF DIGITS

SDIGE:	CALL	SCHSTF		;MAKE SURE THERE'S A CLOSING BRACKET
	CAIE	CH,76		;76 IS CLOSE ANGLE
	ERROR <Angle bracket missing after number in search string>
	JUMPL	P2,CPOPJ		; MAKE ^E<> BE A NOOP
	MOVE	CH,P2		;SPECIFY WHICH CHARACTER TO SET
	CALL	SETBIT
	JRST	SCHOUT

;^E NOT FOLLOWED BY OCTAL DIGIT

SNOTDG:	LOAD	CH,UPRCOD,(CH)	;GET UPPERCASE
	CAIN	CH,"["		;SEE IF OPEN BRACKET...
	JRST	SBRAK		;YES, GO PROCESS
	CAIN	CH,"A"
	JRST	SBALPH		;ANY ALPHABETIC
	CAIN	CH,"C"
	JRST	SBSYM		;ANY SYMBOL CONSTITUENT
	CAIN	CH,"D"
	JRST	SBDIG		;ANY DIGIT
	CAIN	CH,"P"
	JRST	SBPUN		;PUNCTUATION
	CAIN	CH,"V"
	JRST	SBLOW		;ANY LOWERCASE LETTER
	CAIN	CH,"W"
	JRST	SBHGH		;ANY UPPERCASE
	CAIN	CH,"Y"
	JRST	SBUSR		;USER DEFINED HITS
	CAIN	CH,"X"
	JRST	CNTRX		;ANYTHING
	ERROR <Illegal character after CTRL/E in search string>

;Edit 509
;The following defines are used to build the code to OR in bits to SMAT0.
;I$MSK clears the bits, and should be done before each set of MA$MSKs.
;Each MA$MSK generates 3 (or 6) instructions which light all the bits that
;represent the two characters passed to it, and all the ones inbetween. IE,
;MA$MSK "E","H"  would turn on the bits for E,F,G and H in the SMAT0 array.

;This could have been done a LOT simpler, but future expansion is easier
; this way.

;Isolate the RH or the LH moved to the RH with these.

	DEFINE $RH(V),< <<V>&<0,,-1>> >
	DEFINE $LH(V),< <<<V>&<-1,,0>>_-^D18> >

;DMOVXX tries to load AC,AC+1 with V1 and V2 in the least number of words.

	DEFINE DMOVXX (AC,V1,V2),<
	 %%A1==$RH <V1>
	 %%A2==$LH <V1>
	 %%B1==$RH <V2>
	 %%B2==$LH <V2>
	 IFE $RH <%%A1+1>,<%%A1==0>
	 IFN %%A1,<%%A1==-1>
	 IFE $RH <%%A2+1>,<%%A2==0>
	 IFN %%A2,<%%A2==-1>
	 IFE $RH <%%B1+1>,<%%B1==0>
	 IFN %%B1,<%%B1==-1>
	 IFE $RH <%%B2+1>,<%%B2==0>
	 IFN %%B2,<%%B2==-1>
	 %%A== <%%A1&%%A2>!<%%B1&%%B2>
	 IFN %%A,<	DMOVE AC,[EXP <V1>,<V2>]>
	 IFE %%A,<	MOVX AC,<V1>
			MOVX <AC+1>&17,<V2> > >


	DEFINE I$MSK,<
	 %%W0==0
	 %%W1==0
	 %%W2==0
	 %%W3==0>

	DEFINE OR$MSK (SY,BI),<
	 %%W'SY'==%%W'SY'!BI>

	DEFINE MA$MSK (CH1,CH2,PTQ<-1>),<
	 %%C==CH1
	 %%N==CH2-%%C+1
	 IFLE %%N,<FOAD <Bad args to MA$MSK>>
	 REPEAT %%N,<
	  %%W==%%C/44
	  %%B==<1B0>_<%%W*44-%%C>
	  OR$MSK \%%W,%%B
	  %%C==%%C+1>
	 IFN PTQ,<
	  IFN %%W0,<
	   IFE %%W1,<	MOVX A,%%W0
			IORM 0+SMAT0>
	   IFN %%W1,<	DMOVXX A,%%W0,%%W1
			IORM A,0+SMAT0
			IORM B,1+SMAT0
			 %%W1==0>
	  >
	  IFN %%W1,<
	   IFE %%W2,<	MOVX A,%%W1
			IORM A,1+SMAT0>
	   IFN %%W2,<	DMOVXX A,%%W1,%%W2
			IORM A,1+SMAT0
			IORM B,2+SMAT0
			 %%W2==0>
	  >
	  IFN %%W2,<
	   IFE %%W3,<	MOVX A,%%W2
			IORM A,2+SMAT0>
	   IFN %%W3,<	DMOVXX A,%%W2,%%W3
			IORM A,2+SMAT0
			IORM B,3+SMAT0
			 %%W3==0>
	  >
	  IFN %%W3,<	MOVX A,%%W3
			IORM A,3+SMAT0>
	 > >


;^EA MATCHES ANY ALPHABETIC

SBALPH:	I$MSK
	MA$MSK	"a","z",0	;get lowercase, inhibit code gen.
	MA$MSK	"A","Z"		;ADD UPPERCASE AND PUNCH OUT CODE
	JRST	SCHOUT

;^ED MATCHES ANY DIGIT

SBDIG:	I$MSK
	MA$MSK	"0","9"
	JRST	SCHOUT

;^EV MATCHES ANY LOWERCASE LETTER

SBLOW:	I$MSK
	MA$MSK	"a","z"
	JRST	SCHOUT

;^EW MATCHES ANY UPPERCASE LETTER

SBHGH:	I$MSK
	MA$MSK	"A","Z"
	JRST	SCHOUT

	PURGE	%%W,%%B,%%N,%%C,%%W0,%%W1,%%W2,%%W3
	IF2, <PURGE I$MSK,OR$MSK,MA$MSK>
;End edit 509

;DO ANY CHARACTER THAT THE USER FLAGGED WITH THE ;@q COMMAND

SBUSR:	SETOM	CEYFLG		;NOTE THAT ^EY IS BEING DONE
	MOVX	C,CH%USR
	JRST	SBSETA

;DO ANY NON-SYMBOL CHARACTER (^S=^N^EC)

CNTRB:	SETCMM	NOTFLG		;SAY "NOT" AND FALL INTO SYMBOL CODE
	;JRST SBSYM

;^EC MATCHES ANY SYMBOL CONSTITUENT

SBSYM:	MOVX	C,CH%SBL
	JRST	SBSETA

;DO ANY PUNCTUATION CHARACTER (^EP)

SBPUN:	MOVX	C,CH%PN1		;PUNCTUATION
	;JRST SBSETA

;HERE TO LIGHT BITS IN SMAT0 ACCORDING TO THE CONTENTS OF C AND
; THE CHRTAB ARRAY.

SBSETA:	MOVEI	CH,177		;SCAN CHRTAB
SBUSR1:	MOVE	A,CHRTAB(CH)	;GET VALUE FROM TABLE...
	TDNE	A,C		;DID USER LIGHT THE BIT FOR THIS CHAR?
	CALL	SETBIT		;AH HA! FLAG IT.
	SOJGE	CH,SBUSR1		;AND GO FOR NEXT
	JRST	SCHOUT

;SET THE BIT INDICATED BY CH IN SMAT0

SETBIT:	MOVE	A,CH
	IDIVI	A,44		;FIGURE OUT WHICH WORD AND BIT
	ADDI	A,SMAT0		;SMAT0 IS AN INDEXED REFRENCE
	MOVE	B,SBITS(B)		;GET CORRECT BIT
	IORM	B,(A)		;TURN IT ON IN THE PROPER WORD
	RET

;^E FOLLOWED BY [CH1,CH2,CH3...] MEANS MATCH ANY OF THE LISTED ITEMS

SBRAK:	CALL	SCHSTF		;READ ITEM
	CALL	SCHAR		;ACCUMULATE IT AS A MATCH
	IORM	A,SMAT0		;ACCUMULATE CHOICES
	IORM	B,1+SMAT0
	IORM	C,2+SMAT0
	IORM	D,3+SMAT0
	CALL	SCHSTF		;READ CLOSING BRACKET OR COMMA
	CAIN	CH,","		;COMMA?
	JRST	SBRAK		;YES, GO GET NEXT ITEM
	CAIE	CH,"]"		;IF NOT COMMA, BETTER BE CLOSING BRACKET
	ERROR <Comma or "]" required>
	JRST	SCHOUT

;TABLE OF BIT POSITIONS WE DON'T CARE ABOUT, USED TO MASK OUT
;CHARACTER POSITIONS WHEN SEARCH STRING IS LESS THAN 5 CHARACTERS.

DNTCAR:	-1
	<BYTE(7)0,177,177,177,177>!1;LENGTH IS ONE, LEEP ONLY FIRST POSITION
	<BYTE(7)0,0,177,177,177>!1 ;KEEP 2 FOR 2 ETC.
	<BYTE(7)0,0,0,177,177>!1
	<BYTE(7)0,0,0,0,177>!1
	1			;FOR 5 OR OVER, KEEP ALL

;TABLE OF MASKS FOR CHARACTER POSITIONS.  WORD N OF THIS TABLE
;CONTAINS BYTE(7)M,M,M,M,M  WHERE N IN BINARY IS MMMMM, EXCEPT THAT
;INSTEAD OF 0'S AND 1'S FOR THE M'S, 0'S AND 177'S ARE USED.

MSKTAB:
DEFINE GENMSK(N)
<
 BYTE(7)<<N_-4>*177>,<<N_-3>&1*177>,<<N_-2>&1*177>,<<N_-1>&1*177>,<N&1*177>
>
%%X==0
%%X==0
REPEAT 2*2*2*2*2,<
	GENMSK(%%X)
%%X==%%X+1
>

;ROUTINE WHICH TAKES A WORD IN P1 AND A TABLE ADDRESS IN P2, AND
;STORES THE CONTENTS OF P1 IN THE 5 ELEMENTS OF THE TABLE, EACH COPY
;HAVING A GAP IN A DIFFERENT BIT POSITION

GENTAB:	MOVE	B,P1		;GET COPY OF WORD
	LSH	B,1			;GET GAP AT B35
	MOVEM	B,(P2)		;STORE IN TABLE
	MOVE	B,(P2)
	LSHC	A,7
	LSH	B,-1
	LSHC	A,-7		;PUT GAP AT B7
	MOVEM	B,1(P2)
	MOVE	B,(P2)
	LSHC	A,^D14
	LSH	B,-1
	LSHC	A,-^D14		;PUT IT AT B14, ETC.
	MOVEM	B,2(P2)
	MOVE	B,(P2)
	LSHC	A,^D21
	LSH	B,-1
	LSHC	A,-^D21
	MOVEM	B,3(P2)
	MOVE	B,(P2)
	LSHC	A,^D28
	LSH	B,-1
	LSHC	A,-^D28
	MOVEM	B,4(P2)
	RET

;ROUTINE WHICH SKIPS IF DIFFERENT SEARCH BEING DONE THIS TIME THAN
;LAST

NOTSAM:	MOVE	A,CPTR		;GET POINTER TO CURRENT COMMAND STRING
	MOVE	T,SSLEN		;GET LENGTH OF LAST SEARCH STRING
	MOVE	B,[POINT 7,SCHBUF]	;GET POINTER TO LAST SEARCH STRING
	MOVE	C,COMCNT		;GET MAXIMUM CHARACTERS TO COMPARE
NOTS1:	SOJL	C,CPOPJ1		;SAY NOT THE SAME IF CURRENT RUNS OUT
	ILDB	D,A		;GET CHARACTER FROM COMMAND STRING
	CAMN	D,SDELIM	;HAVE WE COME TO DELIMITER IN COMMAND STRING?
	JRST	NOTS2		;YES, MAYBE SEARCH IS SAME AS LAST TIME
	SOJL	T,CPOPJ1		;STRINGS DIFFERENT IF LAST ONE SHORTER
	ILDB	CH,B		;AND ONE FROM LAST SEARCH STRING
	CAME	D,CH		;THE SAME?
	JRST	CPOPJ1		;DIFFERENT SEARCH, SKIP RETURN
	JRST	NOTS1		;LOOP TO CHECK REST OF STRINGS

NOTS2:	JUMPE	T,CPOPJ		;IF LAST SEARCH STRING RUNS OUT WHEN WE
		; FIND DELIMITER IN BUFFER, WE'VE GOT SAME SEARCH AS LAST TIME
	JRST	CPOPJ1		;NEW SEARCH SHORTER, SO IT'S DIFFERENT

;COME HERE WHEN WE KNOW THE CURRENT SEARCH IS THE SAME AS THE LAST ONE,
;BECAUSE THE SPECIFIED STRING IS EXACTLY THE SAME AS THE LAST ONE.
;WE MUST NOW SKIP OVER THE SEARCH STRING IN THE COMMAND BUFFER.

SERCH3:	ILDB	C,CPTR		;GET CHARACTER FROM SEARCH STRING
	SOS	COMCNT		;ACCOUNT FOR IT BEING READ
			; (WE'VE ALREADY MADE SURE WE'LL FIND A DELIMITER)
	CAME	C,SDELIM		;THE DELIMITER YET?
	JRST	SERCH3		;NOT YET
	JRST	SERCH9		;GO DO SAME SEARCH AS LAST TIME


;ENTER AT SERCH0 WITH ARG FOR SEARCH IN A.  

SERCH0:	MOVEM	A,SCHARG		;SAVE ARG
	JRST	SERCH1		;FALL INTO COMMON CODE

LARR:	TXOA	FF,FINDR		;FINDR:=1 FOR LEFT ARROW SEARCH

SERCHP:	TXO	FF,PCHFLG		;PCHFLG:=1 FOR N SEARCH

;ENTRY FOR S COMMAND IS HERE...

SERCH:	CALL	CHK2		;MAKE SURE THERE IS AN ARG
	MOVEM	C,SCHARG		;REMEMBER ARG
SERCH1:	TXNN	FF,SLSL		;@ SEEN?
	SKIPA	CH,TERMIN		;USE ALT-MODE DELIMITER IF NO @ SEEN
	CALL	RCH		;YES. CH:=USER SPECIFIED DELIMITER.
	MOVEM	CH,SDELIM		;REMEMBER DELIMITER

;SET UP SEARCH TABLE

SERCH2:	CALL	PEEKCH		;PEEK AT NEXT CHARACTER
	 JRST	SERCH4		;IF THERE ISN'T ONE, IT'S NOT THE ONE SOUGHT!
	CAME	CH,SDELIM		;THE DELIMITER?
	JRST	SERCH4		;NO, PERHAPS DIFFERENT SEARCH
	CALL	SKRCH		;YES, REALLY READ IT.
	JRST	SERCH9		;GO DO SAME SEARCH AS LAST TIME
SERCH4:	CALL	NOTSAM		;SKIP IF DIFFERENT SEARCH BEING DONE
	 JRST	SERCH3		;SAME ONE, GO DO IT
	MOVEI	A,0		;SAY WE'RE READING SEARCH FROM COMMAND STRING
	SETZM	CEYFLG		;WE HAVEN'T SEEN A ^EY YET
	CALL	SPARSE		;PARSE THE SEARCH STRING
	SETZM	SRPF		;IF JUST READ FROM COMMAND STRING,
				; NO REPARSE NEEDED
SERCH9:	SKIPN	SSLEN		;MAKE SURE WE'VE DONE A SEARCH BEFORE.
	ERROR <No default search string set up yet>
	MOVEI	A,1
	SKIPE	SRPF		;REPARSE DEFAULTED SEARCH IF 1^X OR 0^X TYPED
	CALL	SPARSE		;CAN'T CALL SPARSE AT SSERCH,
				; SINCE IT MAY GO TO SFAIL!
	SETZM	SRPF		;NO MORE REPARSE NEEDED
	MOVE	B,SCHARG		;GET ARG BEFORE IT GETS COUNTED TO 0
	MOVEM	B,SOARG		;REMEMBER IT
	JUMPE	B,SRET1		;RETURN IMMEDIATELY IF 0S OR 0R

;ENTER HERE IF SEARCH MASKS ARE ALREADY SET UP.  FOR INSTANCE, DURING
; N OR _ OR F COMMAND, SEARCH IS RESUMED HERE AFTER NEW PAGE IS READ
;IN.  R COMMAND COULD BE MADE QUICKER IF IT WERE TAUGHT TO ENTER HERE
;TOO, ESPECIALLY FOR LARGE NUMERICAL ARGS TO R.

SERCHS:	MOVE	A,PT		;REMEMBER WHERE CURRENT SEARCH STARTS
	MOVEM	A,S0PT
	SKIPG	SCHARG		;SEARCHING FORWARD?
	JRST	SETBAK		;NO, BACKWARDS

; IN ORDER TO KNOW WHEN WE'VE HIT
;THE BUFFER HOLE, SO THAT WE CAN SKIP OVER IT, WE'LL PLANT A COPY OF A STRING
;THAT MATCHES THE SEARCH JUST AT THE HOLE BOUNDARY.  THIS WILL ALLOW
;US TO DETECT THE HOLE BECAUSE WE'LL GET A FALSE ALARM SEARCH MATCH.
;ALSO, WE'LL COPY A SMALL PART OF THE BUFFER THAT'S BEFORE THE HOLE
;INTO THE HOLE, SO THAT EVEN IF WHAT WE'RE LOOKING FOR CROSSES THE
;HOLE, WE'LL FIND IT.
;IN ADDITION, WE'LL PUT A MATCH AT THE END OF THE BUFFER TO CATCH
;FAILING SEARCHES - THAT IS, SEARCHES REALLY ALWAYS SUCCEED!

	MOVE	I,HOLEND		;POINTER TO CHARS AFTER HOLE
	MOVE	OU,HOLBEG	;WE WANT TO COPY THEM TO BEGINNING OF HOLE
	MOVE	P1,SCHLNN		;WE NEED ONLY COPY ONE LESS THAN NUMBER
	SOJ	P1,			;OF CHARS IN THE SEARCH STRING
	CALL	MVCST		;COPY THE CHARS
	MOVE	I,[5*MATCH]	;POINTER TO STRING GUARANTEED TO MATCH
	MOVE	OU,SCHLNN	;WE WANT TO PUT IT ALMOST THIS MANY CHARS IN
	SOJ	OU,			;ONE LESS BECAUSE N-1 CHARS WERE COPIED
	ADD	OU,HOLBEG		;FIGURE WHERE TO COPY TO
	MOVEI	P1,5		;ONLY COPY 5 CHARACTERS
	CALL	MVCST		;COPY THE MATCH
	MOVE	OU,[010700,,EMTBUF-1] ;WE ALSO WANT TO PUT MATCH AT END OF BFFR
	MOVE	I,[010700,,MATCH-1]
	MOVEI	P1,5
	CALL	MVSTR		;TO CATCH FAILING SEARCHES
	MOVE	A,SCHLNN	;GET NUMBER OF CHARACTERS IN SEARCH STRING
	CAILE	A,5
	MOVEI	A,5		;FOR THIS CALCULATION, WE WANT 5 OR LESS
	MOVE	B,A		;MAKE COPY FOR BYTE POINTER CALCULATION
	IMULI	A,7		;FIGURE OUT HOW MANY BITS TO SHIFT
				; FOR GETTING TO NEXT FRAME
	MOVEM	A,SLIDE		;REMEMBER HOW MANY
	MOVE	C,FNXTAB-1(B)	;FIGURE OUT WHERE TO TRANSFER TO
	MOVEM	C,NXTFRM		;REMEMBER WHEN GOING TO NEXT FRAME
	ADJBP	B,[000700,,A-1]	;MAKE BYTE PTR TO RIGHTMOST CHARACTER IN FRAME
	MOVEM	B,SLAST		;REMEMBER POINTER TO LAST CHARACTER IN FRAME
	MOVE	A,PT		;GET FIRST CHARACTER POSITION TO BE EXAMINED
	CAML	A,HOLBEG		;ARE WE IN HOLE?
	ADD	A,HOLSIZ		;GET ABSOLUTE CHARACTER ADDRESS
FSRCH:	IDIVI	A,5		;NOW A SHOWS WHICH WORD CONTAINS FIRST CHARACTER
	MOVE	C,FSTAB(B)		;C TELLS WHERE TO ENTER SEARCH LOOP
	MOVEM	C,SADD		;REMEMBER WHERE TO ENTER LOOP
	IMULI	B,7		;CALCULATE HOW MUCH TO SHIFT TO LEFT-JUSTIFY
				; FIRST CHARACTER
	MOVEI	D,1(A)		;WORD POINTER TO BUFFER FOR SEARCH LOOP
	MOVEM	D,SPTR		;REMEMBER WORD POINTER
	MOVE	P1,B		;P1 NOW HOLDS HOW MUCH TO SHIFT AT THE START
	DMOVE	A,-1(D)		;GET PRIMARY DATA
	LSH	A,-1		;GET RID OF GAP AT B35
	LSHC	A,(P1)		;SHIFT INTO CORRECT POSITION TO START SEARCH
	DMOVEM	A,SDAT		;INITIALIZE SEARCH DATA
	JRST	FLSALM		;INITIALIZE SEARCH BY SAYING "FALSE ALARM"

;TABLE OF PLACES TO TRANSFER TO IN FORWARD SEARCH LOOP WHEN WE'VE JUST
;SHIFTED OUR DATA OVER TO THE NEXT FRAME UPON DECIDING THAT SINCE
;RIGHTMOST CHARACTER OF LAST FRAME ISN'T ANYWHERE IN THE SOUGHT STRING,
;WE CAN SAVE TIME BY SKIPPING N CHARACTERS IN BUFFER WHERE N IS NUMBER
;OF CHARACTERS IN SEARCH STRING.

FNXTAB:	IFIW!S1			;SEARCH STRING IS ONE CHARACTER LONG
	IFIW!S2			;TWO CHARACTERS LONG
	IFIW!S3			;GET THE PATTERN?
	IFIW!S4
	IFIW!S5

;TABLE OF PLACES TO TRANSFER WITHIN THE BACKWARD SEARCH LOOP, AND DURING
;THE BACKWARD SEARCH LOOP, WHEN THE LEFTMOST CHARACTER OF THE CURRENT
;FRAME ISN'T ANYWHERE IN THE SOUGHT STRING.  IF THIS IS THE CASE,
;WE CAN SKIP N CHARACTERS OF THE BUFFER.

BNXTAB:	IFIW!BS1			;CAN ONLY SKIP 1 IF 1 CHARACTER LONG
	IFIW!BS2
	IFIW!BS3
	IFIW!BS4
	IFIW!BS0	;(PROBABLY SHOULD BE CALLED BS5 FOR CONSISTENCY)

;TABLE OF ENTRIES INTO THE FORWARD SEARCH LOOP.  SHOWS FIVE ENTIRES
;TO USE DEPENDING ON WHETHER FIRST CHARACTER TO BE CHECKED IS IN POSITION
;0,1,2,3, OR 4 IN THE FIRST WORD TO BE EXAMINED.

FSTAB:	IFIW!S0			;CHARACTER IS LEFT-JUSTIFIED
	IFIW!S1 ;CHARACTER IS ONE CHARACTER TO RIGHT OF LEFT EDGE OF WORD
	IFIW!S2
	IFIW!S3
	IFIW!S4			;CHARACTER IS AT RIGHT MARGIN

;HERE'S THE SEARCH LOOP FORWARD (TO THE RIGHT).  IT GETS ENTERED AT
;VARIOUS PLACES ACCORDING TO WHERE THE FIRST CHARACTER TO BE EXAMINED
;IS LOCATED WITH RESPECT TO WORD BOUNDARIES.

 ;START OF FORWARD SEARCH LOOP.

S00:	MOVE	B,(D)		;GET WORD FROM BUFFER
S0:	LDB	C,SLAST		;GET RIGHTMOST CHARACTER IN FRAME
	SKIPE	SMAT(C)		;IS THAT CHAR ANYWHERE IN THE SEARCH STRING?
	JRST	S0A		;YES, SO WE MUST EXAMINE THE FRAME
	LSHC	A,@SLIDE		;NO, SLIDE TO NEXT FRAME IMMEDIATELY
	JRST	@NXTFRM		;GO EXAMINE NEXT FRAME
S0A:	MOVE	C,A		;GET COPY OF CHARACTERS FROM BUFFER
	AND	C,P1		;KEEP ONLY BITS WE CARE ABOUT
	CAMN	C,P2		;SEE IF IT'S WHAT WE'RE LOOKING FOR
	CALL	SWIN1		;MAYBE, CHECK REST OF STRING AND LOCATION
	LSHC	A,7		;SLIDE FRAME TO RIGHT ONE POSITION
S1:	MOVE	C,A
	AND	C,P1
	CAMN	C,P2
	CALL	SWIN2		;DUPLICATE RATHER THAN LOOP FOR SPEED
	LSHC	A,7
S2:	MOVE	C,A
	AND	C,P1
	CAMN	C,P2
	CALL	SWIN3
	LSHC	A,7
S3:	MOVE	C,A
	AND	C,P1
	CAMN	C,P2
	CALL	SWIN4
	LSHC	A,7
S4:	MOVE	C,A
	AND	C,P1
	CAMN	C,P2
	CALL	SWIN5
	LSHC	A,7
S5:	AOJA	D,S00		;ALL 5 POSITIONS FAILED.  GET NEW WORD

SWIN1:	MOVEI	C,0		;C IS HOW MANY TIMES WE SHIFTED...
				; BEFORE GETTING A MATCH
	JRST	SWIN
SWIN2:	MOVEI	C,1
	JRST	SWIN
SWIN3:	MOVEI	C,2
	JRST	SWIN
SWIN4:	MOVEI	C,3
	JRST	SWIN
SWIN5:	MOVEI	C,4
	JRST	SWIN

;GET HERE WHEN SEARCH MATCHES FIRST FIVE CHARACTERS.  WE MUST CHECK
;THAT THE REST OF THE CHARACTERS MATCH, AND THAT WE ARE STILL IN THE BUF
;FER.  IF WE'RE IN BUFFER BUT REST DON'T MATCH, KEEP SEARCHING.  IF OUT
;OF BUFFER, SEARCH FAILED.

SWIN:	POP	P,SADD		;REMEMBER WHERE TO RESUME SEARCH IF...
				; WE'RE NOT REALLY DONE YET
	DMOVEM	A,SDAT		;SAVE DATA FOR RESTORING SEARCH LOOP
	MOVEM	D,SPTR		;SAVE SEARCH POINTER
	SKIPG	SCHARG		;SEARCHING TO THE RIGHT?
	JRST	BSWIN		;NO, TO THE LEFT
	MOVEI	A,-1(D)		;WE HAVE TO GET CHAR ADDRESS OF FIRST CHAR
	IMULI	A,5	;NOW WE'VE GOT CHAR ADDRESS IF WE DID NO SHIFTING
	ADD	A,C	 ;ADD # OF TIMES WE SHIFTED TO GET EXACT CHAR ADDRESS
	MOVEM	A,SENDPT	;SAVE CHAR ADDRESS OF FIRST CHAR OF STRING
	CAML	A,HOLBEG		;SEE IF WE'RE IN HOLE
	CAMLE	A,HOLEND
	JRST	SWNIH		;NO
	MOVE	B,SCHLNN		;YES, SEE WHERE FAKE MATCH WAS PUT
	ADD	B,HOLBEG
	SOJ	B,
	CAMN	A,B		;DID WE JUST HIT THE FAKE MATCH?
	JRST	GETOUT		;YES, GET OUT OF HOLE AND RESUME SEARCH
SWNIH:	CAML	A,HOLEND		;ARE WE TO RIGHT OF HOLE?
	SUB	A,HOLSIZ		;YES, MAKE VIRTUAL CHARACTER ADDRESS
	MOVE	B,A		;GET COPY OF CHAR ADDRESS OF FIRST CHARACTER
	ADD	B,SCHLNN	;GET CHARACTER ADDRESS OF CHARACTER AFTER LAST
	CAMLE	B,ZEE		;DID WE MATCH IN THE BUFFER?
	JRST	SFAIL		;NO, SO THE SEARCH FAILED COMPLETELY
	CALL	SCHK		;MAKE SURE REST OF CHARACTERS MATCH
	 JRST	FLSALM		;THEY DON'T, GO KEEP SEARCHING
	MOVE	A,SENDPT	;GET CHAR ADDRESS OF LEFTMOST CHAR THAT MATCHED
	ADD	A,SCHLNN		;GET CHARACTER POSITION OF END OF STRING
	CAML	A,HOLEND		;ARE WE TO RIGHT OF HOLE?
	SUB	A,HOLSIZ	;YES, CHANGE TO VIRTUAL CHARACTER ADDRESS
	MOVE	B,A		;GET A COPY
	SUB	B,S0PT		;SEE HOW FAR WE'VE PROGRESSED
	CAMGE	B,SCHLNN		;AT LEAST THE LENGTH OF THE STRING?
	 JRST	FLSALM		;OTHERWISE /\---- 2S--$ WOULD GO ONLY TO ---/\-
	MOVEM	A,S0PT		;REMEMBER WHERE THIS SEARCH BRINGS US TO
SRWIN:	SKIPGE	SCHARG		;IS SEARCH ARGUMENT NEGATIVE?
	AOS	SCHARG		;YES, SO APPROACH 0 THIS WAY
	SKIPLE	SCHARG		;IF SEARCH ARG IS POSITIVE?
	SOS	SCHARG		;APPROACH 0 THIS WAY
	SKIPE	SCHARG		;HAVE WE FOUND STRING ENOUGH TIMES?
	JRST	FLSALM		;NO, KEEP SEARCHING
	MOVEM	A,PT		;STORE NEW VALUE OF POINTER
SRET1:	SETOB	A,SFINDF		;SET FLAG SAYING SEARCH SUCCEEDED
	TXNE	FF,RPLFG		;JUST RETURN IF DOING REPLACE COMMAND
	RET			;ALL DONE!
SRET:	TXNN	FF,COLONF		;NOT REPLACE, :S?
	JRST	CFLUSH		;NO, DON'T RETURN VALUE
	JRST	ARGINA		;YES, RETURN VALUE

;COME HERE WHEN WE WANT TO SEARCH TO THE LEFT

SETBAK:	MOVE	I,HOLBEG		;GET LEFT EDGE OF HOLE
	SUB	I,SCHLNN
	AOJ	I,
	MOVE	OU,HOLEND
	SUB	OU,SCHLNN
	AOJ	OU,
	MOVE	P1,SCHLNN
	SOJ	P1,
	CALL	MVCST		;COPY CHARACTERS FROM TO...
	 ; LEFT OF HOLE TO INTO HOLE AT RIGHT EDGE...
	 ; (IN CASE SEARCH MATCHES ACROSS THE HOLE)
	MOVE	OU,HOLEND
	SUB	OU,SCHLNN
	SUBI	OU,4
	MOVE	I,[5*MATCH]
	MOVEI	P1,5
	CALL	MVCST		;PUT MATCH AT HOLE SO WE'LL KNOW DURING
				; SEARCH LOOP WHEN WE HIT THE HOLE
	MOVE	OU,BEG
	SUBI	OU,5
	MOVE	I,[5*MATCH]
	MOVEI	P1,5
	CALL	MVCST		;PUT MATCH AT BEGINNING OF BUFFER SO 
				;WE'LL KNOW WHEN SEARCH FAILS
	MOVE	A,SCHLNN		;GET LENGTH OF SEARCH STRING
	CAILE	A,5
	MOVEI	A,5		;WE CAN SKIP AT MOST 5 CHARACTERS AT A TIME
	MOVE	B,BNXTAB-1(A)	;FIGURE OUT WHERE TO JUMP TO WHEN FIRST CHARACTER DOESN'T MATCH
	MOVEM	B,NXTFRM		;REMEMBER FOR SEARCH LOOP
	IMUL	A,[-7]		;FIGURE OUT HOW MANY BITS TO THE RIGHT TO SHIFT
	SOJ	A,			;WHEN FIRST CHAR EXAMINED ISN'T IN
				 ; SEARCH STRING AT ALL (ONE EXTRA FOR B35!)
	HRRZM	A,SLIDE		;REMEMBER, BUT CLEAR LH BECAUSE REF'D WITH @
	MOVE	A,PT
	SOJ	A,		;FIGURE OUT WHICH CHAR TO START SEARCHING WITH
	CAML	A,HOLBEG
	ADD	A,HOLSIZ		;MAKE ABSOLUTE ADDRESS
BSRCH:	IDIVI	A,5		;FIND WHICH WORD TO START WITH
	MOVE	C,BSTAB(B)		;GET PLACE TO START SEARCH LOOP WITH
	MOVEM	C,SADD		;REMEMBER
	MOVEI	D,(A)		;D ALWAYS SHOWS NEXT WORD TO LOOK AT
	MOVEM	D,SPTR		;REMEMBER WHICH WORD TO PICK UP FIRST
	MOVE	P1,B		;P1 REMEMBERS HOW MUCH TO INITIALLY SHIFT
	DMOVE	A,(D)		;GET INITIAL DATA TO START SEARCH WITH
	LSHC	A,@SHFTAB(P1)	;RIGHT JUSTIFY FIRST 5 CHARS IN A'B
	DMOVEM	A,SDAT		;INITIALIZE THE SEARCH DATA
	JRST	FLSALM		;INITIALIZE SEARCH BY PRETENDING WE JUST...
				; HAD A FALSE MATCH

;GET HERE WHEN SEARCHING LEFT FINDS A MATCH ON FIRST 5 CHARACTERS.

BSWIN:	MOVE	A,D		;GET WORD ADDRESS OF WORD CONTAINING LEFTMOST
				; CHAR IN STRING
	IMULI	A,5
	ADDI	A,5
	SUB	A,C		;A HOLDS LEFTMOST CHARACTER ADDRESS OF THE
	MOVE	B,HOLEND		; 5 THAT MATCHED
	SUB	B,SCHLNN
	SUBI	B,4		;GET TO CHARACTER ADDRESS OF PLANTED STRING
	CAMN	A,B		;DID WE JUST MATCH IN THE HOLE?
	JRST	BGETOT		;YES, GO GET OUT OF HOLE AND KEEP SEARCHING
	CAML	A,HOLBEG
	SUB	A,HOLSIZ		;GET VIRTUAL ADDRESS
	MOVEM	A,SENDPT		;REMEMBER WHERE SEARCH MAY HAVE MATCHED
	CAMGE	A,BEG		;DID IT MATCH IN THE BUFFER AT ALL?
	JRST	SFAIL		;NO, SO SEARCH FAILED
	ADD	A,SCHLNN		;GET CHAR ADDRESS OF CHAR TO RIGHT
				; OF ENTIRE STRING
	CAMLE	A,S0PT		;STRING BETTER ENTIRELY FIT TO LEFT OF
				; POINTER AS OF LAST SEARCH
	JRST	FLSALM		;DOESN'T
	SUB	A,SCHLNN		;GET FIRST CHARACTER ADDRESS AGAIN
	CALL	SCHK		;MAKE SURE ENTIRE STRING MATCHES
	 JRST	FLSALM		;DOESN'T
	MOVE	A,SENDPT	;GET WHAT TO SET PT TO IF STRING HAS BEEN
				; FOUND ENOUGH TIMES
	MOVEM	A,S0PT		;REMEMBER WHERE WE'VE PROGRESSED TO DURING
				; SEARCHING
	JRST	SRWIN

;TABLE OF HOW MUCH TO SHIFT INITIAL DATA TO RIGHT-JUSTIFY FIRST 5 CHARACTERS...
;WE'RE TESTING

SHFTAB:	,-^D36			;CHARACTER IS LEFT-JUSTIFIED
	,-^D29			;CHARACTER IS ONE CHARACTER TO THE RIGHT
	,-^D22			;2
	,-^D15			;ONE FROM THE RIGHT
	,-^D8			;CHARACTER RIGHT-JUSTIFIED

;TABLE OF ADDRESS IN LEFTWARD SEARCH LOOP AT WHICH TO ENTER ACCORDING
;TO HOW MUCH INITIAL DATA HAD TO BE SHIFTED TO RIGHT-JUSTIFY FIRST
;CHARACTER IN B

BSTAB:	IFIW!BS0
	IFIW!BS4
	IFIW!BS3
	IFIW!BS2
	IFIW!BS1

;THE BACKWARD SEARCH LOOP.  IT MERELY LOADS A WORD FROM MEMORY,
;SEES IF ANY OF THE 5 POSITIONS OF THAT DATA MATCHES THE FIRST
;FIVE CHARACTERS OF THE SOUGHT STRING, AND THEN PROCEDES TO THE NEXT
;WORD TO THE LEFT IN MEMORY.

BS00:	MOVE	A,(D)		;GET NEXT WORD FROM BUFFER
	LDB	C,[350700,,B]	;GET LEFTMOST CHARACTER OF FRAME
	SKIPE	SMAT(C)		;IS CHARACTER ANYWHERE IN SEARCH STRING
	JRST	BS0A		;YES, SO WE MUST EXAMINE FRAME
	LSHC	A,@SLIDE		;NO, SO WE CAN SKIP UP TO FIVE POSITIONS
	JRST	@NXTFRM		;SKIP SOME.
BS0A:	MOVE	C,B		;GET COPY OF DATA
	AND	C,P1		;KEEP ONLY BITS EQUAL IN ALL POSSIBLE MATCHES
	CAMN	C,T		;SEE IF WE HAVE A MATCH
	CALL	SWIN1		;WE DO.  THE "CALL" REMEMBERS HOW
				; MANY TIMES WE HAD TO SHIFT TO GET A MATCH
	LSHC	A,-8		;INSTEAD OF 7, WHICH WOULD GET 6 BITS AND B35
BS1:	MOVE	C,B
	AND	C,P2		;DIFFERENT MASK SINCE B35 IS EMBEDDED
	CAMN	C,TT
	CALL	SWIN2
	LSHC	A,-7		;ONLY 7 NOW SINCE WE'VE SKIPPED OVER B35
BS2:	MOVE	C,B
	AND	C,OU
	CAMN	C,TT1
	CALL	SWIN3
	LSHC	A,-7
BS3:	MOVE	C,B
	AND	C,CH
	CAMN	C,I
	CALL	SWIN4
	LSHC	A,-7
BS4:	MOVE	C,B
	AND	C,SAC1
	CAMN	C,SAC2
	CALL	SWIN5
	LSHC	A,-7		;NO POSITIONS MATCHED
BS0:	SOJA	D,BS00		;GO GET NEXT WORD FROM BUFFER

;FOLLOWING ROUTINE TAKES ABSOLUTE CHAR ADDRESS IN A, ASSUMED
;TO BE LEFTMOST CHARACTER IN STRING, AND SKIPS IFF STRING MATCHES
;ONE BEING SEARCHED FOR

SCHK:	SOJ	A,		;BACK UP ONE CHAR BECAUSE WE WANT TO DO ILDB
	MOVE	I,A
	CALL	GET		;MAKE ILDB POINTER IN TT TO BEGINNING
				; OF SUPPOSED MATCHING STRING IN BUFFER
	MOVSI	A,400000		;BIT BEING CHECKED IN SEARCH TABLE
	MOVE	B,SCHLNN		;B SHOWS HOW MANY CHARACTERS TO TEST
SCHECK:	SOJL	B,CPOPJ1		;IF ALL MATCH WE'RE REALLY DONE!
	UILDB	C,TT		;GET CHARACTER FROM BUFFER
	TDNN	A,SMAT(C)		;IS THIS CHARACTER A MATCH?
	RET			;STRING DOESN'T MATCH
	LSH	A,-1		;STEP TO NEXT BIT POSITION
	JRST	SCHECK		;YES, CHECK THE REST

;GET HERE WHEN WE JUST HIT THE HOLE WHILE SEARCHING TO THE RIGHT.
;THE FOLLOWING CODE GETS US OUT OF THE HOLE AND CONTINUES THE SEARCH.

GETOUT:	MOVE	A,HOLEND		;FIRST CHARACTER TO CHECK NEXT
	JRST	FSRCH		;GO RESTART FORWARD SEARCH

;GET HERE WHEN SEARCHING TO THE LEFT, AND WE JUST HIT THE RIGHT
;EDGE OF THE HOLE

BGETOT:	MOVE	A,HOLBEG
	SOJ	A,			;SKIP OVER HOLE (TO LEFT EDGE OF IT)
	JRST	BSRCH		;START SEARCHING AGAIN

;COME HERE IF SEARCH ISN'T THROUGH YET BECAUSE ALTHOUGH FIRST FIVE
;CHARACTERS MATCHED, THE REST OF THE STRING DIDN'T.  HOPEFULLY THIS
;RARELY HAPPENS, AS IT WOULD GROSSLY SLOW DOWN THE SEARCH.  OBVIOUSLY
;SUCH SUCKY CASES CAN BE CONSTRUCTED, BUT AS BENJAMIN FRANKLIN ONCE
;SAID: "TO GAMBLE IS TO COAPUTE THE GREGS OF FRETRICAL INACQUICIES
;	WITHOUT THE CRUX OF PLEGANOUS FINALITY"
;BUT AS GEORGE RAFT REPLIED: "WHAT DOES BENJAMIN FRANKLIN KNOW?"
;(PAT PAULSON SAID IT ALL ACTUALLY)

FLSALM:	DMOVE	A,SDAT		;GET SEARCH DATA BACK
	MOVE	D,SPTR		;GET BUFFER WORD INDEX
	SKIPG	SCHARG
	JRST	FLSB		;SEARCH TO LEFT, DIFFERENT INITIALIZATION
	MOVE	P1,CARBTS		;GET BITS WE CARE ABOUT
	MOVE	P2,SMASK		;GET VALUE THOSE BITS ARE SUPPOSED TO BE
	JRST	@SADD		;RESUME THE SEARCH

FLSB:	DMOVE	P1,CARTAB		;LOAD UP MASKS OF BITS WE'RE TESTING
	DMOVE	OU,CARTAB+2
	MOVE	SAC1,CARTAB+4	;THERE 5 DIFFERENT VERSIONS
	DMOVE	T,SMTAB		;LOAD UP THE 5 VERSIONS OF SOUGHT
				; VALUES FOR THE BITS
	DMOVE	TT1,SMTAB+2
	MOVE	SAC2,SMTAB+4
	JRST	@SADD		;(RE)ENTER SEARCH LOOP

;TABLE TO TRANSFORM CHARACTER RANK INTO SINGLE BIT MASK.  FOR INSTANCE,
;CHARACTER 1 (THE FIRST) CORRESPONDS TO 1B0, CHARACTER 2 CORRESPONDS
;TO 1B1 ETC.  HENCE "MOVE A,SBITS(P1)" GETS CORRECT BIT LOADED INTO A
;FOR P1TH CHARACTER (WELL 'CONTENTS OF P1'TH ACTUALLY)

SBITS:
	%%X==1B0
REPEAT ^D36,<
	%%X
	%%X==%%X_-1
>

;GET HERE WHEN SEARCH FAILS

SFAIL:	SETZM	SFINDF		;CLEAR FLAG SAYING SEARCH SUCCEEDED
	TXNE	FF,PCHFLG+FINDR	;S SEARCH?
	JRST	NOFND1		;NO.
	TXNN	FF,COLONF		;YES. COLON MODIFIER?
	JRST	NOFND2		;NO

	TXZ	FF,PCHFLG+FINDR	;YES.
	TXNE	FF,RPLFG		;ARE WE DOING A REPLACE COMMAND?
	RET			;YES, SO JUST RETURN
	JRST	ZERINA		;NO, RETURN 0

NOFND1:	SKIPGE	SOARG		;POSITIVE SEARCH?
	JRST	NOFND2		;CAN'T DO BEG BACKARROW OR NEG N
	SKIPN	ABORTF		;ABORT?
	TXNN	FF,UREAD		;INPUT FILE SELECTED?
	JRST	NOFND2		;NO. DONE.
;**;[503] At NOFND1: +5L, Replaced 2 lines      	SM	24-Mar-82
	TXNE	FF,FINF		;[503] ALREADY AT EOF?
	JRST	NOFND3		;[503] YES, SEARCH FAILS, QUAMP THE BUFFER
	MOVEI	C,1		;PUNCH 1 PAGE ONLY
	TXNE	FF,PCHFLG		;N SEARCH?
	CALL	PUNCHA		;YES. PUNCH THIS BUFFER AND REFILL IT.
	TXNE	FF,FINDR		;LEFT ARROW SEARCH?
	CALL	YANK		;YES. FILL BUFFER.
;**;[503] At NOFND1: +14L, Deleted 1 line       	SM	24-Mar-82
	JRST	SERCHS		;CONTINUE SEARCHING

;**;[503] At NOFND2: -1L, Added 4 lines        	SM	24-Mar-82
NOFND3:	MOVEI	C,1		;[503] PUNCH 1 BUFFER IF ANY
	TXNE	FF,PCHFLG		;[503] NEED TO OUTPUT LAST BUFFER?
	CALL	PUNCHA		;[503] YES, PUNCH IT
	CALL	HK			;[503] SEARCH FAILED, CLEAR BUFFER.

;**;[510] At NOFND2:, Inserted 2 lines                      SM 26-May-82
NOFND2:	TXNE	FF,COLONF		;[510] IS HE INTERCEPTING ERRORS?
	JRST	ZERINA		;[510] YES, GIVE HIM ZERO.
	STKVAR	<SFLPTR,SFLLEN>	;O.K., SINCE P IS RESET AT "GO"
	LERROR <Search failed for: >
	MOVE	A,[POINT 7,SCHBUF]	;POINTER TO STRING WE COULDN'T FIND
	MOVEM	A,SFLPTR
	MOVE	A,SSLEN		;GET LENGTH (MIGHT BE NULLS IN STRING!)
	MOVEM	A,SFLLEN
	UCTYPE	""""		;PUT STRING IN QUOTES
NOF1:	SOSGE	SFLLEN		;MAYBE STRING IS EXHAUSTED
	JRST	[	PSTR <"
>				;FINISH STRING WITH CLOSE QUOTE AND CRLF
			JRST GO]	;FINISH ERROR HANDLING
	ILDB	A,SFLPTR		;GET NEXT CHARACTER FROM SEARCH STRING
	CAIL	A,.CHTAB		;FORMATTING CHARACTER?
	CAILE	A,.CHCRT
	JRST [	UCTYPE @A	;NO, TYPE THE CHARACTER
		JRST NOF1]	;CONTINUE WITH REST OF STRING
	UCTYPE	"<"		;START SPECIAL STRING
	UPSTR	@[	[ASCIZ /TAB/]
			[ASCIZ /LF/]
			[ASCIZ /VT/]
			[ASCIZ /FF/]
			[ASCIZ /CR/]]-.CHTAB(A)
	UCTYPE	">"		;FINISH SPECIAL STRING
	JRST	NOF1		;DO REST OF STRING

;MI PERFORM NOW THE TEXT IN Q-REGISTER IN AS A SERIES OF COMMANDS.

MAC:	CALL	QREGVI		;A:=C(Q-REG)

MAC0:	TLZE	A,400000		;MAKE SURE Q-REG CONTAINS TEXT
	TLZE	A,377770
	JRST	QGETQE
	POP	P,SYL		;[502] SAVE RETURN ADDRESS
	ADD	A,QRBUF
	MOVE	I,A
	CALL	SAVCMD		;SAVE CURRENT COMMAND STATE
	PUSH	P,INTDPH		;REMEMBER HOW DEEP ITERATIONS ARE
	CALL	GETINC		;GET FIRST CHARACTER OF MACRO
	CAIE	CH,141		;IT SHOULD BE FLAG
	JRST	QGETQE		;OOPS
	CALL	GETINC		;GET NUMBER OF CHARACTERS IN MACRO
	MOVE	A,CH
	CALL	GETINC
	LSH	A,7
	IOR	A,CH
	CALL	GET
	LSH	A,7
	IOR	A,CH
	SUBI	A,4		;-FLAG AND COUNT
	MOVEM	A,COMCNT		;THAT MANY COMMANDS TO COUNT
	MOVEM	A,COMAX		;AND MAX.
	SETZM	INTDPH		;SAY NO ITERATIONS YET
	MOVE	A,I
	IDIVI	A,5
	MOVE	B,BTAB(B)		;MAKE A BYTE POINTER
	HRR	B,A
	MOVEM	B,CPTR		;PUT IT IN CPTR
	JRST	@SYL		;[502] RETURN TO CALLER
;MXFILENAME$ PUTS THE CONTENTS OF THE FILE IN Q-REG X 

MFILE:	CALL	QREGVI		;GET Q-REG NAME TO USE & MAKE SURE 'TIS LEGAL.
	MOVE	T,CH		;REMEMBER NAME IN T
	CALL	FACCES		;OPEN THE FILE
	CALL	MFILE0		;LOAD THE FILE
	MOVEM	A,QTAB-"0"(T)	;STORE POINTER TO TEXT IN QREG "X"
	JRST	CFLUSH		;[502] DONE

;WLIBRARY$FILENAME$ DOES THINGS LIKE ;MI, BUT DIFFERENT

WLIBR:	CALL	FACCES
	MOVEM	A,JFNIS
	DVCHR%			;SEE IF THIS JFN IS A TERMINAL
	LDB	A,[221100,,B]	;GET DEVICE TYPE NUMBER
	CAIN	A,.DVTTY		;SKIP IF IT IS A TERMINAL
	JRST	[MOVEI	C,[ERROR <Cannot load a Library from the terminal>]
		 JRST	BADLIB]	;IT IS, ILLEGAL
WLIB1:	MOVE	A,JFNIS
NQREGN:	BIN%			;GET THE QREG NAME
	 ERJMP	NOMOR
	CAIE	B,12		;ALLOW CR, LF, ...
	CAIN	B,15
	JRST	NQREGN
	CAIE	B,"\"		;AND BACKSLASH AND SPACE...
	CAIN	B,40		;AS DROSS
	JRST	NQREGN
	MOVE	CH,B		;CANT CALL QREGVx HERE, SINCE AN ILL QREG
	CAIE	CH,"#"		;# MEANS ARRAY REFERENCE
	JRST	QLOADL		;GO LOAD Q-REG LOC
	MOVE	A,JFNIS
	MOVEI	C,^D10
	NIN%
	 ERJMP	ILAQE
	CAIL	B,0
	CAIL	B,USARYL
	JRST	UABNQE
	MOVEI	T,USRARY(B)
	BKJFN%
	 ERJMP	GREF
	JRST	GREF
QLOADL:	MOVE	A,CHRTAB(CH)
	TXNN	A,CH%QRG	;ARE YOU A QREG CHARACTER?
	 JRST	BADQRE
	CALL	QREGVL		;NOW DO THE TRANSLATION
	MOVE	T,CH		;SAVE THE INDEX
	ADDI	T,QTAB-"0"
GREF:	MOVE	A,JFNIS
	BIN%
	 ERJMP	ILIBQE		;ILLEGAL LIBRARY FORMAT
	CAIE	B,"="
	JRST	NORFET
	MOVE	A,JFNIS
	MOVEI	C,^D10
	NIN%
	 ERJMP	INULQE		;ILLEGAL NUMBER
	MOVEM	B,(T)		;STORE THE NUMBER
	BKJFN%
	 ERJMP	WLIB1		;ASSUME OK?
	BIN%
	CAIE	B,"\"		;BACKSLASH IS LEGAL
	CAIG	B,40		;DID THE NUMBER END WITH SPACE OR LESS?
	JRST	WLIB1
	 JRST	INULQE		;NO, GO COMPLAIN
NORFET:	MOVEM	B,STOPAT	;STOP AT THIS CHARACTER...
	CALL	MFILE1		;GO LOAD UP
	TRNA			;NONSKIP IS OK
	 JRST	BADLIB		;IF SKIP, DO ERROR IN AC C
	MOVEM	A,(T)		;AND THE Q-REG IS ALL SET
	JRST	WLIB1
NOMOR:	MOVE	A,JFNIS
	CLOSF%
	 ERJMP	.+1
	JRST	CFLUSH

UABNQE:	MOVEI	C,ARRYQE	;Array reference out of bounds
	JRST	BADLIB
ILAQE:	MOVEI	C,[ERROR <Number not in a readable format after "#">]
	JRST	BADLIB
INULQE:	MOVEI	C,[ERROR <Number not in a readable format after "=">]
	JRST	BADLIB
ILIBQE:	MOVEI	C,[ERROR <EOF while looking for delimiter>]
	JRST	BADLIB
BADQRE:	MOVEI	C,QREGQE	;BAD Q REGISTER
BADLIB:	MOVEM	C,SYL
	LERROR	<Library file error, at file position >
	MOVE	A,JFNIS
	RFPTR%			;WHERE DID IT HAPPEN?
	 ERJMP	NOPOSI		;DONT KNOW
	MOVX	A,.PRIOU
	MOVEI	C,^D10
	NOUT%
	 ERJMP	.+1
NOPOSI:	MOVE	A,JFNIS
	CLOSF%
	 ERJMP	.+1
	JRST	@SYL		;GO JUMP TO ERROR CODE AS APPROPRATE

;ROUTINE TO LOAD A FILE INTO A Q-REG.  GIVE IT JFN IN A.  IT RETURNS
;HANDLE IN A.
;ENTER AT MFILE0 TO READ UNTIL EOF, MFILE1 TO READ UNTIL CHAR IN
; STOPAT. CALLING MFILE1 WITH A NON-NEGATIVE STOPAT MEANS THE FILE
; IN JFN A WILL NOT BE CLOSED ON RETURN, AND A +2 RETURN IS GIVEN IF
; AN ERROR OCCURS (+1 OTHERWISE)

MFILE0:	SETOM	STOPAT		;GO UNTIL EOF
MFILE1:	CALL	QGC		;GET AS MUCH SPACE AS POSSIBLE
	MOVE	C,EQRBUF		;GET ADDRESS OF BEGINNING OF FREE SPACE
	SUB	C,BEG	;SUBTRACT END OF F.S. TO YIELD NEG OF FREE AMOUNT
	ADDI	C,4		;LEAVE 4 CHARACTERS SPACE FOR FLAG AND LENGTH
	JUMPGE	C,MFILQE
	PUSH	P,A		;SAVE JFN FOR A MOMENT
	PUSH	P,C		;LIKEWISE COUNT
	DVCHR%			;BE THIS DEVICE A TERMINAL?
	LDB	A,[POINT 9,B,17]	;ISOLATE THE TYPE
	SETZM	SYL		;ASSUME NOT A TTY
	CAIN	A,.DVTTY		;ARE YOU A TTY?
	SETOM	SYL		;IT *IS* A TTY! IT GETS SPECIAL TREATMENT
	POP	P,C			;RESTORE COUNT
	POP	P,A			;RESTORE JFN
	MOVE	OU,EQRBUF
	MOVEI	CH,141
	CALL	PUT		;CREATE BYTE POINTER TO BEGINNING
				; OF FREE SPACE AND PUT IN FLAG
	PUSH	P,TT		;SAVE BYTE POINTER
	IBP	TT
	IBP	TT
	IBP	TT
	MOVE	B,TT		;TELL SYSTEM WHERE TO READ FILE INTO
	MOVE	P1,C		;SAVE AMOUNT WE'LL ATTEMPT TO READ IN
	SKIPL	SYL		;IS THIS A TTY?!?
	JRST	SININ		;NO, GO SIN IT IN
 ;HERE IF INPUT DEV IS A TTY: - WE WILL DO A TEXTI
	MOVNM	C,TXTI+.RDDBC	;STORE POS NUMBER OF BYTES IN TEXTI BLOCK
	HRLI	A,.PRIOU		;SET UP JFN STUFF
	MOVSM	A,TXTI+.RDIOJ	;..
	TXNE	FF,ARG		;WAS AN ARG GIVEN?
	JRST [	SKIPN A,FARG	;GET USER FLAGS
		JRST .+1	;IF NONE REALLY GIVEN, USE NORMAL DEFAULTS
		TRNE A,(RD%BTM)	;DID USER SET A FUNNY BIT (IE, -1 PASSED IN?)
		MOVEI A,(RD%BEL) ;YES, PROVIDE ALTERNATE DEFAULTS
		HRLZS A		;MOVE TO LEFT HALF
		TXO A,RD%JFN	;WE INSIST ON THIS
		JRST .+2]	;NOW SKIP OVER DEFAULT FLAGS
	MOVX	A,RD%BRK!RD%JFN	;BRK ON <ESC><^Z>
	MOVEM	A,TXTI+.RDFLG	;..
	MOVEM	B,TXTI+.RDDBP	;DEST WAS IN B
	MOVEI	A,.RDDBC		;HIGHEST ADDRESS IN BLOCK
	MOVEM	A,TXTI+.RDCWB	;..THATS THE BLOCK COUNT
	MOVEI	A,TXTI		;POINT AT BLOCK...
	TEXTI%			;AND READ FROM TTY: INTO CORE
	 ERJMP	.+1		;THIS DOESNT FAIL
	MOVE	A,TXTI+.RDFLG	;CHECK THE FLAGS
	TXNE	A,RD%BFE		;RUBOUT BACK TO BEFORE BEGINNING?
	JRST [SETZ C,		;YES, MEANING NO CHARS READ
	      JRST NTXTIN]
	TXNN	A,RD%BTM		;DID WE END ON A BREAK CHARACTER?
	JRST	MFILQE		;NO, GO DIE HORRIBLY - COUNT EXHAUSTED
	ADD	C,TXTI+.RDDBC	;#CHARS LEFT+(-#ALLOCATED)
	MOVN	C,C		;GET THE POSITIVE # CHARS READ IN
NTXTIN:	HLRZ	A,TXTI+.RDIOJ	;GET JFN BACK
	CLOSF%			;AND BAG IT
	 ERJMP	MFILCL		;SHAN'T FAIL
	JRST	MFILCL		;GO FIGURE OUT WHATS WHERE
SININ:	SKIPL	D,STOPAT	;DOING THE FUNNY STOPAT STUFF?
	MOVN	C,C		;YES, THE MAX COUNT GOES POSITIVE
SININ2:	SIN%			;READ ENTIRE FILE INTO CORE
	SKIPGE	STOPAT		;NORMAL READ TO EOF?
	JRST	SINTST		;YES, GO SEE
	MOVN	C,C		;SET IT NEGATIVE AGAIN
	SUBI	C,1		;WE *DONT* WANT THE TERMINATOR
	JRST	NOCLOS		;DONT CLOSE THE FILE, THATS FOR THE CALLER
SINTST:	GTSTS%			;GET EOF BIT INTO b
	CLOSF%			;CLOSE THE FILE
	 ERJMP	.+1		;IF CANT, TOO BAD
	TXNN	B,GS%EOF		;WAS THERE ENOUGH ROOM FOR WHOLE FILE?
	JRST	MFILQE
NOCLOS:	SUB	C,P1		;SEE HOW MANY CHARACTERS WE READ IN
MFILCL:	ADDI	C,4		;4 FOR FLAG AND COUNT.
	MOVE	B,[250700,,C]	;PREPARE TO PICK UP AMOUNT IN THREE INSTALLMENTS
	POP	P,D			;RESTORE BYTE POINTER
REPEAT 3,<
	ILDB	P1,B		;PICK UP PART OF LENGTH
	IDPB	P1,D		;PUT IT AT BEGINNING OF STRING
>
	ADD	C,EQRBUF		;COMPUTE NEW SPACE BOUNDARY
	MOVE	A,EQRBUF		;GET OLD FREE SPACE BOUNDARY
	MOVEM	C,EQRBUF		;UPDATE BOUNDARY
	SUB	A,QRBUF		;GET RELATIVE ADDRESS
	TLO	A,(1B0)		;SET "TEXT" FLAG
	RET

MFILQE:	SKIPGE	STOPAT		;DO WE RETURN ERRORS TO THE CALLER?
MFI2QE:	ERROR <Not enough qreg space> ;NO. (WE DIDN'T REACH EOF)
	MOVEI	C,MFI2QE	;YES, IN AC C
MFILER:	AOS	(P)		;SKIP FOR ERROR
	RET
;ERROR HANDLERS

DONTFL:	DPB	CH,CPTR		;PUT ALTMODE BACK IN STRING
DNTFL2:	CALL	JSER		;ANALYZE ERROR
	ERROR <Couldn't access file>
DNTFL1:	MOVE	A,C		;COULDN'T OPEN FILE, SO RELEASE JFN
	RLJFN%
	JFCL			;CAN'T EVEN DO THAT!
	JRST	DNTFL2		;ANNOUNCE REASON FOR ERROR

;FILE ACCESS ROUTINE

FACCES:	CALL	FILSPC		;FIND END OF FILE NAME AND DELIMIT WITH NULL
	MOVSI	A,(GJ%OLD+GJ%SHT)	;SHORT FORM+OLD FILE ONLY
	GTJFN%			;GET HANDLE ON FILE
	JRST	DONTFL		;COULDN'T.
	DPB	CH,CPTR		;PUT ALTMODE BACK
	MOVE	B,[70000,,OF%RD]	;7 BIT BYTES+OPEN FOR READING
	MOVE	C,A		;SAVE JFN IN CASE OF ERROR
	OPENF%			;OPEN THE FILE
	JRST	DNTFL1		;COULDN'T.
	RET

;WFILENAME INSERTS THE FULL FILENAME OF THE LAST FILESPEC GIVEN
;IN A ;Y ;U ;S ;D ;X ;R OR ;W COMMAND

WFILEN:	MOVE	A,[POINT 7,NAMBFR]	;POINTER TO FILESPEC
	CALL	INSRTZ		;[502] INSERT THE FILENAME
	JRST CFLUSH		;[502] AND LEAVE

;EFILENAME$ PUSHES TYPIN JFN AND INPUTS FROM NAMED FILE.

DOFILE:	CALL	FACCES		;OPEN THE FILE
	MOVE	C,TYIP		;GET TYPIN STACK POINTER
	PUSH	C,TYIJFN		;SAVE OLD TYPIN JFN
;**;[513] At DOFILE: +3L, Inserted 1 line                   SM 31-Aug-82
	 ERJMP	PCMDQE		;[513] IF THATS ILLEGAL, WE WILL GO COMPLAIN
	MOVEM	C,TYIP		;SAVE NEW STACK POINTER
	MOVEM	A,TYIJFN		;AND SAVE NEW INPUT JFN
	DVCHR%			;SEE IF DEVICE IS A TERMINAL
	SETOM	TERIO		;FIRST ASSUME IT'S NOT
	LDB	A,[221100,,B]	;GET DEVICE TYPE
	CAIE	A,.DVTTY		;SKIP IF IT'S A TERMINAL
	SETZM	TERIO		;IT'S NOT.
	JRST	CFLUSH		;[502] DONE

;**;[513] At DOFILE: +13L, Inserted 3 lines                 SM 31-Aug-82
PCMDQE:	CLOSF%			;[513] CLOSE THE FILE WE OPENED
	 ERJMP	.+1		;[513] DOESNT MATTER
	ERROR	<Too many command streams pushed>
;<> ITERATION BRACKETS.  COMMAND INTERPRETATION IS SENT
;	BACK TO THE < WHEN THE > IS ENCOUNTERED.

LSSTH:	TXNE	FF,SCANF		;SCANNING?
	JRST [	MOVEI A,">"	;YES, SEE IF SCANNING FOR CLOSING BRACKET
		CAMN A,LCHAR
		AOS SCNEST	;YES, SO NEST DEEPER
		JRST CFLUSH]
	POP	P,SYL		;[502] STORE THIS FOR THE RETURN
	AOS	INTDPH
	PUSH	P,ITERCT		;SAVE ITERATION COUNT
	MOVE	A,P		;[521] SEE IF THERE'LL BE ROOM ON THE STACK
	ADJSP	A,CBLEN+2	;[521] CBLEN WORDS FOR SAVCMD, + PUSHJ P, + PUSH
	 ERJMP	SAVIQE		;[521] NO ROOM. HANDLE BEFORE WE'RE OUT OF STACK
	TXZN	FF,ARG		;IS THERE AN ARGUMENT?
	 HRLOI	C,377777		;NO, SET ITERCT= POS INF
	MOVEM	C,ITERCT		;YES. ITERCT:=ARGUMENT
	CALL	SAVCMD		;SAVE CURRENT COMMAND STATE
	PUSH	P,SYL		;[502] RESTORE RETURN
	SKIPG	C,ITERCT
	JRST	INCMA		; 0<...> DOES NOTHING FEATURE.
	JRST	CFLUSH

GRTH:	TXNE	FF,SCANF		;SCANNING?
	JRST [	MOVEI A,^D62	;YES, SEE IF FOR CLOSED BRACKET
		JRST SCAN1]
	SKIPG	INTDPH		;IS THERE A LEFT ANGLE BRACKET?
	ERROR <Unmatched right angle bracket>
	SOSG	ITERCT		;ITERCT:=ITERCT-1. DONE?
	JRST	INCMA2		;YES
RSLOP:	POP	P,SYL		;[502] SAVE THE RETURN ADDRESS
	CALL	REACMD		;RESTORE COMMAND STATE TO BEGINNING OF LOOP
	PUSH	P,SYL		;[502] RESTORE RETURN ADDRESS
	TXNE	FF,TRACEF		;TRACING?
	CALL	CRR		;YES. OUTPUT CRLF
	JRST	CFLUSH
;:	IF NOT IN AN ITERATION, GIVES ERROR.  IF IN AN ITERATION AND
;	IF THE MOST RECENT SEARCH FAILED, SEND COMMAND TO FIRST UNMATCHED
;	RBRACKET TO THE RIGHT.  OTHERWISE, NO EFFECT.

TCOND:	SKIPN	INTDPH		;IN < > ?
TCONQE:	ERROR <No iteration loop currently in progress>
	TXNN	FF,ARG		;YES. IF NO ARG,
	MOVE	C,SFINDF		;LAST SEARCH SWITCH

	JUMPL	C,CFLUSH		;IF ARG  .L. 0, JUST RET + EXECUTE LOOP
INCMA:	MOVEI	A,^D62		;WHAT WE'RE LOOKING FOR (RIGHT ANGLE BRACK.)
	CALL	SCAN		;SET IT

INCMA2:	POP	P,SYL		;[502] SAVE HIS RETURN ADDRESS
	SOS	INTDPH		;POP OUT A LEVEL
	ADJSP	P,-CBLEN		;THROW AWAY SAVED COMMAND STATE
	POP	P,ITERCT
	PUSH	P,SYL		;[502] RESTORE HIS RETURN ADDRESS
	JRST	CFLUSH

;HERE WITH CHARACTER IN A TO SCAN FOR
SCAN:	MOVEM	A,LCHAR		;REMEMBER WHAT WE'RE LOOKING FOR
	TXO	FF,SCANF		;REMEMBER WE'RE SCANNING
	SETZM	SCNEST		;RESET NESTING LEVEL
	RET			;[502] RETURN

;!TAG! TAG DEFINITION.  THE TAG IS A NAME FOR THE LOCATION IT
;	APPEARS IN IN A MACRO, ITERATION OR COMMAND STRING.

EXCLAM:	CALL	SKRCH		;EXCLAM JUST INCREMENTS PAST ANOTHER !
	CAIE	CH,"!"
	JRST	EXCLAM
	JRST	CFLUSH
;OTAG$ GO TO THE TAG NAMED TAG.  THE TAG MUST APPEAR IN THE 
;	CURRENT MACRO OR COMMAND STRING.

CTOG:	TXO	FF,COLONF!CTOFLG	; ^O, NOT O, AND DON'T MEDDLE CACHE
	CALL	QREGVI
	MOVE	C,A			;IF IT ISN'T TEXT, QGET2 WILL ERROR OUT
	CALL	QGET2			;GET I AS CHAR ADDRESS, P1 AS COUNT
	JUMPE	P1,CFLUSH		;NULL STRING MEANS NO-OP
	CAILE	P1,OTABL-2		;WILL THIS FIT?
	JRST	STLTQE			;NO, DIE NOW
	MOVEI	P2,OTAB-1		;LET'S COPY THINGS
	MOVEI	CH,"!"
QREGCO:	ADDI	P2,1
	MOVEM	CH,(P2)
	CALL	GETINC
	SOJG	P1,QREGCO
	MOVEM	CH,1(P2)
	ADDI	P2,2
	JRST	OG12

OG:	TXNE	FF,COLONF		; : FLAG LIT?
	JRST	OGNFA		;YES, FOR SOME REASON, USER WANTS RE-INTERPERT
	MOVE	A,CPTR		;COMPUTE HASH OF CPTR INTO SYMBOL TABLE
	MOVE	B,A
	IDIVI	B,17
	CAMN	A,SYMS(C)		;DO 3 PROBES MAX THEN GIVE UP
	JRST	OGFND
	SKIPN	SYMS(C)
	JRST	OGNF
	CAMN	A,SYMS+1(C)

ES1:	AOJA	C,OGFND
	SKIPN	SYMS+1(C)
	AOJA	C,OGNF
	CAMN	A,SYMS+2(C)
	AOJA	C,ES1
	SKIPN	SYMS+2(C)
	ADDI	C,2

OGNF:	PUSH	P,CPTR
	PUSH	P,C
OGNFA:	MOVEI	P2,OTAB+1
	MOVEI	A,41
	MOVEM	A,-1(P2)		;OTAB_"!"
OGNF1:	CALL	SKRCH
	MOVEM	CH,(P2)		;OTAB+1 ... _ TAG
	CAIL	P2,OTAB+OTABL	;FILLED BUFFER?
STLTQE:	ERROR <Symbol too long or terminator missing>
	CAME	CH,TERMIN
	AOJA	P2,OGNF1
OG12:	CALL	SAVCMD		;SAVE COMMAND STATE NOW
	MOVEI	A,"!"
	MOVEM	A,(P2)		;ALTMODE: OTAB+N_"!"
	MOVE	C,COMCNT
	SUB	C,COMAX		;# REMAINING COMMANDS
	IDIVI	C,5
	ADD	C,CPTR		;MAKE A COMMAND POINTER
	JUMPE	D,OG2
	SOS	C
	MOVMS	D
	JRST	.(D)
	IBP	C
	IBP	C
	IBP	C
	IBP	C
OG2:	MOVE	B,COMAX		;ALL COMMANDS
OG4:	MOVEM	C,CPTR
	MOVEM	B,COMCNT
	MOVEI	D,OTAB		;INIT SEARCH STRING TO "!"
OG5:	CAIN	D,1(P2)		;END OF STRING?
	JRST	OG3		;YES
	CALL	SKRCH1		;NO. GET A CHAR
	CAMN	CH,(D)		;MATCH ?
	AOJA	D,OG5		;YES. MOVE ON.
	IBP	C			;NO. TRY A NEW STARTING PT
	SOJG	B,OG4		;COUNT DOWN COMMANDS
	CALL	RESCMD		;IT FAILS. RESTORE STATE
	TXNN	FF,COLONF		;NONESUCH LABEL. DID USER EXPECT THAT?
	ERROR <Tag not found>	;NO, GIVE HIM HIS ERROR MESSAGE
	JRST	CFLUSH		;CONTINUE, THE USER WANTS TO DEAL WITH IT.

OG3:	ADJSP	P,-CBLEN		;BLOW AWAY OLD SAVED STATE
	TXNE	FF,COLONF		;DID USER INDICATE FUNNY : MODE?
	JRST	CFLUSH		;YES, WE ARENT USING THE HASH TABLE
	POP	P,A
	POP	P,SYMS(A)
	MOVEM	B,CNTS(A)
	MOVEM	C,VALS(A)
	JRST	CFLUSH

OGFND:	MOVE	A,VALS(C)
	MOVEM	A,CPTR
	MOVE	A,CNTS(C)
	MOVEM	A,COMCNT
	JRST	CFLUSH
;APOSTROPHE MARKS END OF CONDITIONAL FOR DOUBLE QUOTE

APOST:	TXNN	FF,SCANF		;SCANNING?
	JRST	CFLUSH		;NO, NOTHING TO DO
	MOVEI	A,"'"		;YES, SEE FOR WHAT
SCAN1:	CAME	A,LCHAR		;FOR APOSTROPHE?
	JRST	CFLUSH		;NO
	SOSGE	SCNEST		;[502] DEPTH RIGHT YET?
	TXZA	FF,SCANF		;[502] YES! BACK TO NORMAL SNAFU
	JRST	CFLUSH		;[502] ..
	MOVEM	A,SYL
	CALL	TRACS		;IF TRACING, I WANT TO SEE THE END
	MOVE	A,SYL
	CAIE	A,"'"
	JRST	CFLUSH
	POP	P,SYL		;SAVE OUR RETURN ADDRESS
	CALL	SAVCMD
	PUSH	P,TRACS		;SAVE THE CURRENT TRACE MODE
	MOVSI	CH,(<RET>)	;AND NUKE IT
	MOVEM	CH,TRACS		;SO THIS CANT TRACE TWICE
SCANA:	SKIPN	COMCNT
	JRST	SCANB
	CALL	RCH		;IGNORE INTERVIENING SPACES AND CRLFS
	CAIE	CH,12
	CAIN	CH," "
	JRST	SCANA
	CAIN	CH,15
	JRST	SCANA
	CAIE	CH,""""		;IS FIRST NON-BLANK A QUOTE COMMAND?
	JRST	SCANB		;NO, SO GO RESET TO NORMAL
	SKIPLE	COMCNT
	CALL	RCH		;OK, IS " SOMETHING. IS IT "#?
	SETOM	PCISG		;ASSUME OK
	CAIE	CH,"#"		;IF IT IS, WE WANT THE NEXT "# DONE
	SETZM	PCISG		;CHECK AND SEE
SCANB:	POP	P,TRACS
	CALL	RESCMD
	PUSH	P,SYL
	JRST	CFLUSH

DQUOTE:	CALL	RCH
	TXNE	FF,SCANF		;SCANNING?
	JRST	DQS		;YES
	CAIN	CH,"#"
	JRST [MOVE A,PCISG
	     SETZM PCISG
	     JRST DQ2]
	JUMPL	T,AG0QE		;IF MISSING AN ARG, AND NOT "#, COMPLAIN
	CALL	EVCOND		;GO EVAL A CONDITIONAL
DQ2:	JUMPL	A,CFLUSH		;IF TRUE, GO GET NEXT COMMAND
				;ELSE...
NOGO:	MOVEI	A,"'"		;SAY WE'RE LOOKING FOR AN APOSTROPHE
	CALL	SCAN		;SCAN COMMAND STRING FOR END OF CONDITIONAL
	JRST	CFLUSH

CCOND:	CALL	RCH		;GET CONDITIONAL CHARACTER
	CALL	EVCOND		;TEST C AGAINST IT
	JRST	ARGINA		;0 OR -1 IN A

;EVCOND - GET NEXT COMMAND CHARACTER, SEE IF ITS A LEGAL CONDITIONAL CHAR
;IF IT ISNT, DIE
;IF IT IS, TEST THE VALUE IN C AND RETURN 0 IN A IF FAILED, -1 IF OK

EVCOND:	CAIN	CH,"#"		; "# ALWAYS fails.
	JRST	DFAIL
	LOAD	CH,UPRCOD,(CH)
	SUBI	CH,"A"		;UPPERCASE, MINUS "A"
	CAIL	CH,0		;IN RANGE?
	CAILE	CH,DQLEN	;..?
DQQE:	ERROR	<Undefined command, no such conditional test>
	SKIPN	B,DQXCT(CH)	;GET WORD TO XCT TO TEST THIS CONDITION
	JRST	DQQE		;IF 0, THIS ISN'T A LEGAL COMMAND
	LDB	A,[POINT 4,B,12] ;GET THE AC FIELD!
	CAIN	A,A		;REF'ING AC A? IF SO...
	JRST	[JUMPL C,DFAIL	;ONLY CHARACTERS CAN BE LEGAL VALUES
		 CAILE C,177	;SO CHECK THAT FIRST
		 JRST DFAIL	;WASN'T A CHARACTER
		 MOVE A,CHRTAB(C) ;IT WAS, GET THE CHARACTER INFO TO TEST
		 JRST .+1]	;AND GO.
	XCT	B		;PERFORM THE TEST
DFAIL:	TDZA	A,A		;NONSKIP MEANS FAILED, MARK /W 0
DOK:	SETO	A,		;SKIP OR JUMP HERE MEANS PASSED
	TXNE	FF,COLONF		;INVERT THE TEST?
	SETCA	A,		;YES
	RET			;RETURN WITH ANSWER

;INDEX THIS TABLE TO DO VALUE TESTS (IE, "E, "C STUFF)
;IF THE INSTRUCTION HAS "A" IN THE AC FIELD, THE VALUE BEING TESTED
;MUST BE IN THE RANGE 0-177, AND THE ENTRY FROM CHRTAB MUST BE IN A,
;FOR THE TEST TO MAKE SENSE.

DQXCT:	TXNN	A,CH%ALP	;A ALPHABETIC CHARACTERS
	TXNN	A,CH%BL1	;B BLANKS <SP><TAB><CR><LF><FF>
	TXNN	A,CH%SBL	;C SYMBOL (A-Z 0-9 .%$)
	TXNN	A,CH%DIG	;D DIGIT
	JUMPE	C,DOK		;E .EQ. 0
	JUMPGE	C,DOK		;FALSE, FAILED (.GE. 0)
	JUMPG	C,DOK		;G .GT. 0
	0			;H
	JUMPA	A,DOK		;I ANY CHARACTER
	JUMPLE	C,DOK		;J .LE. 0
	CALL	CNTCHK		;K ANY CONTROL CHARACTER
	JUMPL	C,DOK		;L .LT. 0
	0			;M
	JUMPN	C,DOK		;N .NE. 0
	TRNN	C,1		;O ODD
	TXNN	A,CH%PN1	;P PUNCTUATION
	CALL	QTST		;Q TEXT QREG
	0			;R
	0			;S
	JUMPL	C,DOK		;TRUE (.LT. 0)
	TXNN	A,CH%UPR	;U UPPER CASE
	TXNN	A,CH%DWN	;V LOWER CASE
	TXNN	A,CH%UPR	;W UPPER CASE
	TXNN	A,CH%BL0	;X SPACING TYPES THAT AREN'T END-OF LINE
	TXNN	A,CH%USR	;Y USER SETTABLE CONDITION
	CALL	ZCHK		;Z BETWEEN 0 AND Z INC
	 DQLEN=.-DQXCT

CNTCHK:	JUMPL	C,CNTCK2	;CONTROL CHARACTER, 0 TO 37
	CAIGE	C,40		;SPACE OR BETTER?
	AOS	(P)		;NO, SKIP, THIS IS A CONTROL CHARACTER
CNTCK2:	RET

ZCHK:	JUMPL	C,CNTCK2	;BETWEEN 0 AND Z. NONSKIP IF <0...
	ADD	C,BEG		;OFFSET BY BEG SO WE CAN COMPARE
	CAMG	C,ZEE		;MUST BE .LE. ZEE TO BE ACCEPTED
CPOPJ1:	AOS	(P)
	RET

;GET HERE WHEN "x ENCOUNTERED DURING A SCAN

DQS:	MOVEI	A,"'"
DQS1:	CAMN	A,LCHAR		;ARE WE SCANNING FOR APOSTROPHE
	AOS	SCNEST		;YES, SO NEST DEEPER
	JRST	CFLUSH		;RETURN FOR NEXT COMMAND
;LUUO HANDLER
;S0UUOH - HANDLES LUUO'S FROM SECTION 0, INVOKED BY CALL S0UUOH
;	  IN LOCATION .JB41; WORKS BY DUMMYING UP NON-ZERO SECTION
;	  LUUO BLOCK
;S1UUOH - HANDLES LUUO'S FROM NON-ZERO SECTIONS, INVOKED BY HARDWARE
;	  PASSING CONTROL TO LOCATION WHOSE ADDRESS IS IN UUOB+.ARNPC

S0UUOH:	MOVEM	16,UUOACS+16	;SAVE AC'S 0-16
	MOVEI	16,UUOACS
	BLT	16,UUOACS+15
	HRRZ	TT,.JBUUO		;COPY EFFECTIVE ADDR TO UUO BLOCK
	MOVEM	TT,UUOB+.AREFA
	LDB	TT,[POINT 4,.JBUUO,12] ;COPY AC SPECIFICATION TO UUO BLOCK
	DPB	TT,[POINT 4,UUOB+.ARPFL,30]
	LDB	TT,[POINT 9,.JBUUO,8] ;COPY OPCODE TO UUO BLOCK
	DPB	TT,[POINT 9,UUOB+.ARPFL,26] ;KEEP OPCODE IN TT FOR DISPATCH
	JRST	LUUO1		;MERGE WITH NON-0 SECTION CODE

S1UUOH:	MOVEM	16,UUOACS+16	;SAVE AC'S 0-16
	MOVEI	16,UUOACS
	BLT	16,UUOACS+15
	PUSH	P,UUOB+.AROPC	;PUT RETURN PC ON STACK FOR POPJ
	LDB	TT,[POINT 9,UUOB+.ARPFL,26] ;GET OPCODE OF UUO
LUUO1:	CAIL	TT,LUUOTB		;IS THIS OPCODE DEFINED FOR TV?
UUOQE:	IERROR <Undefined LUUO>	;NO
	CALL	UUOTAB(TT)		;GO TO ROUTINE
	MOVSI	16,UUOACS
	BLT	16,16		;RESTORE AC'S
	RET			;END OF UUO.

UUOTAB:	JRST UUOQE		;ILLEGAL, GO DIE
	JRST UERR0		;ERROR
	JRST UPSTR0		;PRINT STRING
	JRST %LDB		;GO HANDLE LDB FROM BUFFER
	JRST %LDB		;GO HANDLE ILDB FROM BUFFER
	JRST LERR0		;ERROR BUT RETURN TO CALLER
	JRST JERR0		;JSYS ERROR
	JRST LJERR0		;LOCAL JSYS ERROR
	JRST IERR0		;INTERNAL ERROR
	JRST UCTYP0		;PRINT SINGLE CHARACTER
LUUOTB==.-UUOTAB

;JSYS ERROR.

JERR0:	CALL	LJERR0		;DO IT LIKE LOCAL ONE
	JRST	GO			;BUT DON'T RETURN

;LOCAL JSYS ERROR.

LJERR0:	CALL	ERRMES		;PRINT PROGRAM'S REASON FOR ERROR
	PSTR < - >
	SETZM	ERRBUF		;CLEAR BUFFER IN CASE ERSTR FAILS
	HRROI	A,ERRBUF		;PREPARE TO BUFFER SYSTEM'S REASON
	HRLOI	B,.FHSLF		;OURSELF, LAST ERROR
	SKIPE	D,LSTERR		;ANY PARTICULAR ERROR?
	HRR	B,D			;YES, USE IT
	MOVSI	C,-ERRBLN*5	;NUMBER OF CHARACTERS WE HAVE ROOM FOR...
				; IN OUR BUFFER
	ERSTR%			;GET ERROR STRING
	 PSTR <Unknown error code>
	 JFCL			;DON'T WORRY IF LENGTH TOO SHORT
	UPSTR	ERRBUF		;PRINT ERROR MESSAGE
	SETZM	LSTERR		;DON'T USE SAME PARTICULAR ERROR OVER AGAIN
	CALLRET	CRR		;END WITH CARRIAGE RETURN

;LOCAL ERROR (LERROR) MEANS PRINT THE MESSAGE AS AN ERROR, BUT
;RETURN TO THE CALLER

LERR0:	CALLRET	ERRMES		;NO CRLF, SINCE MIGHT BE COMPOSITE MESSAGE

;INTERNAL ERROR

IERR0:	CALL	ERRMES		;PRINT THE MESSAGE
	HRROI	A,[ASCIZ/
 Please submit an SPR. Version /]
	PSOUT%
	MOVX	A,.PRIOU
	MOVEI	B,.EDIT
	MOVEI	C,^D10
	NOUT%
	 ERJMP	.+1
	CALL	CRR		;END OF LINE
	CALL	DOHALT		;STOP
	RET			;ATTEMPT TO CONTINUE IF USER REQUESTS SO

;ERROR UUO
;TYPE ERROR MESSAGE FOLLOWED BY LAST 10 CHARS OF COMMAND STRING

UERR0:	CALL	ERRMES		;PRINT THE ERROR MESSAGE
	SKIPGE	COMCNT		;DID COMCNT OVERSHOOT (AT RCH)?
	SETZM	COMCNT		;YES, ASSUME COMMAND JUST EXHAUSTED
	MOVE	A,COMAX
	SUB	A,COMCNT
	MOVEM	A,ERR1		;ERR1 := NUMBER OF CHARACTERS EXECUTED
	MOVE	P1,CPTR		;VALUE OF CPTR WHEN LAST ERROR OCCURRED.
	MOVEI	P2,12
	SUBI	P1,2		;BACK POINTER UP 10 CHARACTERS.
	PSTR <:	>
	ILDB	A,P1		;GET CHARACTER
	CAMG	P2,ERR1		;WAS IT IN THE COMMAND BUFFER?
	CALL	TYO		;YES. TYPE IT.
	CAME	P1,CPTR		;HAVE WE REACHED THE BAD COMMAND?
	SOJA	P2,.-4		;NO. DO IT AGAIN.
	CALL	CRR		;TYPE CRLF AFTER ERROR MESSAGE IF NOT SCREEN.
	JRST	GO

;PRINT ERROR MESSAGE

ERRMES:	CALL	WINCLS		;SO ERROR MESSAGES DON'T GET ERASED
	SETZM	INIJFN		;IF ERROR DURING TV.INI,
				; DON'T TRY TO REEXECUTE IT AT CLIS
	PUSH	P,UUOB+.AREFA	;SAVE PTR TO ERROR STRING
	CALL	LM			;MAKE SURE WE'RE AT LEFT MARGIN
	PSTR <?>		;QUESTION MARK MUST ALWAYS BE AT LEFT MARGIN.
	CALL	CLRINP		;CLEAR TYPING INPUT
	POP	P,TT		;RECOVER ADR OF ERROR STRING
	HRRO	TT,TT		;CONSTRUCT BYTE PTR
	CALLRET	PSTR0		;PRINT IT

;PRINT STRING UUO

UPSTR0:	HRRO	TT,UUOB+.AREFA	;GET ADR OF STRING
	CALLRET	PSTR0		;PRINT IT
;COMMAND TO COMPLEMENT TRACE MODE. "?" AS A COMMAND

QUESTN:	MOVE	A,[JRST TYO]
	TXCE	FF,TRACEF
	MOVSI	A,(<RET>)
	MOVEM	A,TRACS
	TXNE	FF,TRACEF		;DID WE TOGGLE INTO TRACE MODE?
	CALL	WINCLS		;DON'T ERASE TRACINGS
	JRST	CFLUSH

COMM:	MOVE	CH,TERMIN		;ASSUME ESCAPE ENDS STRING
	TXNN	FF,SLSL		;ATSIGN MODIFIER?
	JRST	COMM0		;NAY, GO ACT AS NORMAL
	CALL	DISCOC		;ATSIGN FORM ALLOWS CONTROL CHARACTER OUTPUT
	CALL	SKRCH		;GET THE DLIMIT CHAR
COMM0:	MOVEM	CH,DLIMIT		;SET DELIMITER
COMM1:	PUSHJ	P,SKRCH		;GET A COMMENT CHAR
	SKIPE	ABORTF		;ABORT?
	JRST	TYOQT		;YES, QUIT TYPEOUT
	CAMN	CH,DLIMIT		;END OF STRING?
	JRST [TXNE FF,SLSL	;YES, WE WE DOING LITERAL OUTPUT?
	      CALL REGCOC	;YES, SET IT BACK
	      JRST CFLUSH]	;AND LEAVE.
	MOVE	A,CH
	PUSHJ	P,TYO		;TYPE IT
	JRST	COMM1

	.JBSYM==116		;WHERE SYMBOLS USUALLY ARE
	.JBUSY==117		;UNDEFINED SYMBOLS

CALDDT:
 OPTION	BIG,<
	ERROR	<?BIGTV can't use DDT>
 >
 OPTOFF BIG,<
	SKIPE	770000		;SEE IF DDT IS LOADED
	JRST	770000		;IT IS, GO ENTER
	MOVX	A,GJ%SHT!GJ%OLD ;MUST FETCH
	HRROI	B,[ASCIZ/SYS:UDDT.EXE/]
	GTJFN%			;GET A JFN FOR SYSTEM'S DDT...
	 ERJMP	NODDT		;ODD DEF OF SYS:
	MOVEM	A,UUOACS+1	;CONVIENENT STORAGE
	MOVX	A,.FHSLF
	XGVEC%
	DMOVEM	B,UUOACS+2	;SAVE AWAY THE ENTRY VECTOR
	MOVE	A,UUOACS+1	;GET JFN BACK
	HRLI	A,.FHSLF	;SET UP FOR MERGE OF DDT
	GET%			;GO
	 ERJMP	NODDTK		;CANT, GO DROP JFN
	MOVX	A,.FHSLF	;GO RESTORE ENTRY VECTOR
	DMOVE	B,UUOACS+2
	XSVEC%			;..
	SKIPE	A,.JBSYM		;GET SYMBOLS
	MOVEM	A,@770001		;HAND THEM TO DDT IF THERE
	SKIPE	A,.JBUSY
	MOVEM	A,@770002
	JRST	770000		;RET$X GOES BACK TO COMMAND SCANNER
				;THE ^D COMMAND IS INTENTIONALLY TRANSPARENT
				; TO FLAGS, VALUES, ETC.

	OPDEF	RETX	[JRST	CFLUSH]		;TYPE RETX$X IN DDT TO CLEAR
	OPDEF	RETC	[JRST	ARGINC]		;TYPE RETC$X TO RETURN ARG

NODDTK:	MOVE	A,UUOACS+1
	RLJFN%
	 ERJMP	NODDT
NODDT:	ERROR	<Can't load DDT>
 >	;END OPTOFF BIG
;THE FOLLOWING ROUTINE DECIDES WHERE IN BUFFER TO START DISPLAYING
;FROM.  IT TRYS TO CAUSE THE POINTER TO BE ABOUT ONE HALF DOWN THE
;WINDOW.  AT POPJ TIME, SCRNPT HAS BEEN SET UP AS AN ADDRESS
;OF THE BUFFER CHARACTER TO BE DISPLAYED FIRST.
;THE SCREEN SIZE IS DETERMINED BY THE CONTENTS OF DLENTH.

WINIT:	STKVAR	<DFT>
	MOVEI	P1,0		;FIRST FIND THE END OF THE CURRENT LINE
	MOVE	I,PT		;START FROM THE POINTER.
WINL:	CAML	I,ZEE		;END OF BUFFER?
	JRST	WINND1		;YES, SO SURELY END OF LINE!
	CALL	GET		;FIND OUT WHAT CHARACTER WE'RE AT.
	CAIE	CH,12
	CAIN	CH,15
	JRST	WINND1		;LF OR CR, SO WE'RE AT THE END OF THE LINE.
	AOJ	P1,
	CAIG	CH,37
	CALL	SFLAGC
	TRNA
	AOJ	P1,	;FLAGGED LETTER OR CONTROL CHARACTER TAKE UP 2 COLUMNS.
	CAIL	P1,MAXWTH	;NEVER SCAN MORE THAN LONGEST ALLOWED LINE.
	JRST	WINND1
	CAMGE	P1,SWIDTH	;DON'T SCAN LONGER THAN SPECIFIED TERMINAL LINE WIDTH.
	AOJA	I,WINL		;KEEP SCANNING FOR END OF LINE.
WINND1:	MOVE	A,DLENTH	;GET NUMBER OF LINES IN SCREEN TO BE USED
	IDIVI	A,2		;QUOTIENT IS HOW MANY LINES WANTED ABOVE POINTER
	MOVEM	A,DFT
WINR5:	MOVEI	P1,0		;CHARACTER COUNTER

;WE NOW COUNT LINES IN REVERSE, ACCOUNTING FOR ONE LINE EVERY TIME
;A SCREEN LINE'S WIDTH OF CHARACTERS IS SCANNED, OR AN END OF
;LINE WITHIN THE ACTUAL BUFFER IS ENCOUNTERED

	CAMG	I,BEG		;ARE WE ALREADY AT BEGINNING OF BUFFER ?
	JRST	WINR1		;YES
WINR4:	SUBI	I,1		;BACK UP ONE CHARACTER
	CAMG	I,BEG		;BEGINNING OF BUFFER ???
	JRST	WINR1		;YUP
	CALL	GET		;MAKE BYTE POINTER AND GET CHAR INTO CH
	CAIN	CH,12		;LF ??
	JRST	WINLF		;YES, END OF LINE
	ADDI	P1,1		;ACCOUNT FOR CHARACTER SPACE
	CAIN	CH,.CHTAB		;TAB?
	ADDI	P1,6		;YES, ASSUME WORST IS 8, 1 ABOVE,
				; 6 HERE, 1 BELOW
	CALL	SFLAGC		;AND IF IT SHOULD BE FLAGGED ON OUTPUT
	CAIG	CH,37		;OR IS A CONTROL CHARACTER
WINR6:	ADDI	P1,1		;IT TAKES UP AT LEAST TWO POSITIONS
	CAIL	P1,MAXWTH
	JRST	WINRX		;RIDICULOUSLY LONG LINES DON'T LOUSE US UP.
	CAMGE	P1,SWIDTH		;REAL LONG LINE?
	JRST	WINR4		;NOT YET, GOBBLE ON
WINRX:	SOSLE	DFT		;DO MORE LINES?
	JRST	WINR5		;YES
WINR1:	MOVEM	I,SCRNPT		;SET UP POINTER TO BUFFER WHERE TO START
				; DISPLAYING

;...
;NOW WE PRETTY MUCH KNOW WHERE TO START DISPLAYING FROM.  THE FOLLOWING
;STEP MAKES AN EFFORT TO NOT CHOP OFF THE FIRST LINE ON THE DISPLAY.
;NOTE THAT THE FOLLOWING CODE IS NEEDED IN ADDITION TO THE LININI
;ROUTINE, SINCE WHEN A SCREEN REFRESH IS ALREADY CALLED FOR, WE
;ARE MORE WILLING TO BACK UP TO THE BEGINNING OF THE LINE, SINCE WE
;DON'T CARE IF THAT CAUSES THE REST OF THE LINE TO SPILL ONTO THE NEXT
;ON THE SCREEN.
;...

	MOVE	A,I		;GET CURRENT BEGINNING OF DISPLAY
	CALL	LINBGQ		;TRY TO FIND BEGINNING OF LINE
	MOVEM	A,SCRNPT		;THIS IS WHERE TO DISPLAY FROM
	RET

WINLF:	SUBI	I,1		;SAW LINEFEED, BACKUP AND SEE IF CR
	CALL	GET		;GET CHAR BEFORE LINEFEED
	CAIE	CH,15		;CR?
	AOJ	I,			;NO
	SOSLE	DFT		;DONE ENOUGH LINES?
	JRST	WINR5		;NOT YET
	AOJA	I,WINR1		;ENOUGH LINES BACK, PREPARE TO EXIT

;ROUTINE TO FIND BEGINNING OF BUFFER LINE.  PASS IT CHARACTER ADDRESS
;IN A.  THE ROUTINE RETURNS WITH ADDRESS OF BEGINNING OF LINE IN A, OR
;BEGINNING OF BUFFER, OR A UNMODIFIED IF NEITHER IS FOUND.

LINBGQ:	STKVAR	<FSTCNT,GIVENA>
	MOVEM	A,GIVENA
	SETZM	FSTCNT		;AMOUNT WE'VE TRIED TO BACKUP
	SOS	I,A
WINBU:	CAMGE	I,BEG		;ARE WE BACK TO BEGINNING OF BUFFER?
	AOJA	I,WINBU1		;YES, SO WE'RE AT BEGINNING OF LINE
	CALL	GET		;SEE IF WE'RE BACK TO BEGINNING OF LINE
	CAIN	CH,12		;LINEFEED?
	AOJA	I, WINBU1		;YES, ASSUME BEGINNING OF LINE
	AOS	A,FSTCNT		;NOT YET, SEE HOW HARD WE'VE LOOKED
	CAIGE	A,MAXWTH		;MAXIMUM AMOUNT FOR DISPLAY LINE?
	SOJA	I,WINBU		;NO, SO KEEP LOOKING
	MOVE	I,GIVENA		;YES, SO NO MODIFICATION
WINBU1:	MOVE	A,I		;RETURN LINE BEGINNING IN A
	RET
;ROUTINE TO UPDATE THE SCREEN.  THIS IS INVOKED EVERY TIME TV IS READY
;TO INPUT A COMMAND.  IT IS ALSO INVOKED BY THE "WUPDATE$" COMMAND.

UPDATE:
 OPTION ENC,<
	skipn	encflg		;encryption turned on?
	jrst	updata		;no
	hrloi	a,(tl%cor!tl%cro)
	seto	b,		;yes, break links before typing out
	tlink%
	 erjmp	.+1
updata:
>
	MOVE	I,ZEE		;GET POINTER TO END OF BUFFER
	SUBI	I,1
	CALL	GETX		;CHANGE TO BYTE POINTER
	MOVEM	TT,SCRNZ		;TELL DISPLAY TO GO ALL THE WAY
	MOVE	A,TTYOUT
	MOVEI	B,.MORLC
	MTOPR%			;READ LINE COUNTER
	MOVEM	C,CRRCNT		;IN CASE WE HAVE TO LINE STARVE UP
				; FROM WHERE WE ARE
	MOVEI	B,.MORLM		;GET MAXIMUM LINES OUTPUT
	MTOPR%
	SUB	C,SSIZE		;CALCULATE NUMBER OF SCROLLS
	AOJ	C,			;NO SCROLL IF EXACTLY AT BOTTOM
	CAML	C,SSIZE
	MOVE	C,SSIZE		;DON'T TRY TO SCROLL MORE THAN ENTIRE SCREEN
	MOVN	B,C
	SKIPN	SCRNF		;ON A SCREEN?
	JRST	NOSCRL		;NO, SO NO SCROLLING
	JUMPLE	C,NOSCRL	;NEG SCROLL AMOUNT MEANS NO SCROLLING HAPPENED
	ADDM	B,DISBLK	;ADJUST MARK FOR WHERE PRESERVED OUTPUT BEGINS
	ADDM	B,CRRCNT	;ADJUST CURSOR POSITION UPSCREEN DUE TO SCROLL
	MOVE	I,LINNEW(C)	;FIND WHAT PART OF BUFFER NOW BEGINS DISPLAY
	MOVEM	I,SCRNPT		;SAVE NEW BEGINNING ADDRESS
	IMUL	C,[<WINDEX>B17]	;C HAS BUFFER WORD OFFSET IN LEFT HALF
	ADD	C,[WINDOW,,WINDOW]	;MAKE WINDOW+X,,WINDOW
	MOVE	B,DLENTH		;GET NUMBER OF LINES NEEDED TO SCROLL
	IMULI	B,WINDEX		;GET NUMBER OF MEMORY WORDS INVOLVED
	HLRZ	D,C		;GET FIRST WORD BEING MOVED FROM
	ADDI	D,-1(B)		;CALCULATE LAST MEMORY WORD MOVED FROM
	SUBI	D,WINDOW+WINTOP	;SEE HOW MANY WOULD BE OUT OF BOUNDS
	CAIGE	D,0		;ARE THERE SOME OUT OF BOUNDS?
	MOVEI	D,0		;NO, SO SAY EXACTLY NONE
	SUB	B,D			;TRIM SIZE OF BLT TO NOT MOVE WORDS FROM
				; OUT OF BOUNDS
	BLT	C,WINDOW-1(B)	;SCROLL THE MEMORY TO AGREE WITH SCREEN
	MOVEI	D,WINDOW(B)	;GET NEXT ADDRESS TO BE FIXED 
				;(FIRST ONE BLT MISSED)
	MOVE	C,DLENTH		;SEE HOW MANY LINES WE CARE ABOUT
	IMULI	C,WINDEX		;SEE HOW MANY BUFFER WORDS WE CARE ABOUT
	ADDI	C,WINDOW-WINDEX	;GET FIRST ADDRESS OF LAST GROUP WE CARE ABOUT
UPD1:	CAMLE	D,C		;DO WE CARE ABOUT THIS WORD?
	JRST	NOSCRL		;NO, WE'RE DONE FIXING MEMORY
	SETOM	(D)		;YES, KILL IT TO FORCE IT TO BE REDISPLAYED
	ADDI	D,WINDEX		;STEP TO FIRST WORD OF NEXT GROUP
	JRST	UPD1
NOSCRL:	MOVE	A,DISBLK		;FIND OUT WHERE PRESERVED OUTPUT BEGINS
	SOJ	A,			;GET LINES ALLOWABLE FOR WINDOW,
				; LEAVING ROOM FOR PROMPT AND PRESERVED OUTPUT
	CAMG	A,SLENTH	;DON'T LET THIS WINDOW EXCEED STANDARD WINDOW.
	SKIPGE	WINFLG		;DON'T RESET SCREEN LENGTH IF THERE
				; IS PRESERVED OUTPUT
	MOVE	A,SLENTH		;IT WAS.
	MOVEM	A,DLENTH		;WE JUST MADE SURE OUTPUT OF T,=, ETC. -
				;  DON'T GET ERASED
	SKIPG	DLENTH		;MAYBE DON'T DISPLAY BECAUSE WE MUST
				; PRESERVE THE WHOLE SCREEN
	RET			;DON'T DISPLAY IF ZERO LENGTH WINDOW
	SKIPE	MESFLG		;SCREEN MESSED UP?
	CALL	CLRSCN		;YES, SO CLEAR GARBAGE OFF IT
	MOVE	I,SCRNPT	;GET CHARACTER ADDRESS OF FIRST CHARACTER
	SKIPN	MESFLG		;IF REDOING ENTIRE SCREEN ANYWAY, RECENTER IT
	CAML	I,ZEE		;ARE WE IN BUFFER?
	CALL	WINIT		;NO, RELOCATE DISPLAY BEGINNING POINTER
	CALL	DISINI		;INITIALIZE DISPLAY ROUTINE
	CALL	LININI		;INITIALIZE FIRST LINE OF DISPLAY
	CALL	WINFIL		;FILL UP NEW SCREENFUL
	SKIPN	PUTPTF		;SEE IF POINTER IS ON SCREEN
	CALL	WINIT		;WASN'T, SO GET NEW STARTING CHARACTER
	SETZM	MESFLG		;CLEAR FLAG SAYING SCREEN WAS MESSED UP
	CALL	DISINI		;INITIALIZE DISPLAY ROUTINE
	CALL	VIEW1		;DISPLAY TO END OF BUFFER
GO2:	RET

;THE WUPDATE$ COMMAND UPDATES THE SCREEN.

WUPDAT:	SETOM	UPDATF		;SAY DOING WUPDATE
	CALL	UPDATE
	SETZM	UPDATF
	JRST	CFLUSH		;[502] DONE

;THE NV OR N,MV COMMAND IS JUST LIKE T, EXCEPT THE DISPLAY IS JUST
;UPDATED TO REPRESENT THE TEXT DESIRED TO BE VIEWED.

VIEW:	SKIPN	SLENTH		;MAKE SURE A WINDOW SIZE EXISTS
	JRST	TYPE		;NO, SO DO REGULAR "T" COMMAND
	CALL	TVINIT		;MAKE SURE WE HAVE REASONABLE ARGUMENTS
	MOVEM	I,SCRNPT		;CHAR ADDRESS OF CHAR IN BUFFER TO
				; BE DISPLAYED FIRST
	MOVE	I,C
	SUBI	I,1
	SETZM	DISBLK		;DON'T LET ANY OUTPUT HAPPEN AFTER V COMMAND.
	AOS	WINFLG		;NOTE THAT PRESERVED OUTPUT HAS STARTED.
	MOVE	A,SLENTH
	MOVEM	A,DLENTH		;SET WINDOW SIZE TO DEFAULT
	CALL	GETX		;MAKE BYTE POINTER
	MOVEM	TT,SCRNZ	;LDB POINTER TO LAST CHARACTER TO BE DISPLAYED
	CALL	DISINI
	CALL	VIEW1		;DISPLAY SOME OF BUFFER
VIEW3:	SKIPE	EOBFLG		;SEEN END OF BUFFER?
	JRST	CFLUSH		;[502] DONE
	CALL	TYIX		;SEE IF HE WANTS TO SEE MORE
	CAIE	A,C.MORE		;USER WANT TO SEE MORE?
	JRST	[CALL RECHAR	;NO
		 JRST CFLUSH]
	CALL	MORE1		;YES, SHOW HIM SOME
	JRST	VIEW3		;LOOP UNTIL DONE

;HERE WHEN FIRST CHARACTER TYPED OF COMMAND IS SPACE.  WE SHOULD DISPLAY
; NEXT BUFFER SECTION.

DMORE:	CALL	MORE1		;DO THE WORK
	JRST	CLIS		;GO BACK FOR NEXT COMMAND

MORE1:	CALL	MORE		;DO THE DISPLAYING
	MOVEI	A,C.MORE
	CALLRET	BCHAR		;REMEMBER IN BACKUP FILE THAT USER TYPED SPACE

;COME HERE TO DO MORE IF USER TYPES SPACE

MORE:	AOS	A,SCNEND		;YES, FIND OUT WHERE WE LEFT OFF
	MOVEM	A,SCRNPT		;AND RESUME THERE
	SKIPN	SCRNF		;IF NOT ON A SCREEN,
	CALL	CRR		;TYPE A CRLF HERE.
	CALLRET	VIEW2		;GO BACK AND DISPLAY MORE

;ENTER HERE IF SCRNPT AND SCRNZ ARE ALREADY SET UP

VIEW1:	MOVE	TT,SCRNZ
	CALL	PTR2AD		;MAKE CHARACTER ADDRESS FROM POINTER
	CAMGE	I,SCRNPT
	SETOM	EOBFLG		;IF NOTHING TO DISPLAY, PRETEND END OF BUFFER
VIEW2:	SETZM	COLUMN
	MOVE	A,DLENTH		;START WITH FULL WINDOW'S WORTH
	SKIPN	EOBFLG		;SAYING "MORE"?
	SOJ	A,			;YES, USE ONE LESS LINE FOR DISPLAY
	CALL	DISPLA		;OUTPUT FULL WINDOW'S WORTH
	SKIPN	SCRNF		;HARDCOPY?
	 JRST [	CALL CRR	;YES, FINISH LAST LINE
		JRST NOLNPS]	;SKIP CURSOR POSITIONING STUFF
	MOVE	CH,DLENTH		;NO, SO PROMPT USER FOR PERMISSION
	SOJ	CH,
	CALL	LINPOS		;BY REQUESTING PERMISSION AT BOTTOM
	CALL	EOL		;OF WINDOW AREA
NOLNPS:	SKIPN	UPDATF		;NO "--MORE--" IF WUPDATE
	SKIPE	EOBFLG		;QUIT IF END OF BUFFER
	JRST	LASTV		;YES
	SKIPE	TYPEF		;SKIP IF NOT EO-BUFFER AND USER
				; HASN'T TYPED ANYTHING
	JRST	LASTV		;USER TYPED SOMETHING
	MOVE	A,TTYOUT		;GET OUTPUT CHANNEL
	HRROI	B,[IFE FTUNS,<ASCIZ /--More--/>
		 IFN FTUNS,<ASCIZ /--Less--/>]
	MOVEI	C,0
	SOUT%			;ASK FOR PERMISSION TO CONTINUE DISPLAYING
LASTV:	SKIPN	SCRNF		;HARDCOPY?
	CALLRET	CRR		;YES, PUT END OF LINE AFTER "MORE" AND RETURN
	MOVE	CH,DLENTH
	CALL	LINPOS		;POSITION CURSOR AFTER WINDOW
	HRRZ	A,CRRCNT		;TELL SYSTEM CURSOR POSITION
	CALL	SETLIN
	RET

;ROUTINE TAKING ARG IN A AND SETTING LINE COUNTER TO THAT VALUE

SETLIN:	MOVE	C,A		;ARG INTO B FOR JSYS
	MOVE	A,TTYOUT		;STANDARD OUTPUT
	MOVEI	B,.MOSLC		;SET LINE COUNTER
	MTOPR%
	MOVEI	B,.MOSLM		;SET MAXIMUM TOO
	MTOPR%
	MOVEI	B,0
	SFPOS%	;SAY WE'RE AT LEFT MARGIN (PAGE POSITION SHOULDN'T MATTER)
	RET
;^L CLEARS THE SCREEN AND CAUSES THE POINTER TO BE MOVED
;INTO THE CENTER OF THE SCREEN THE NEXT TIME AN UPDATE HAPPENS

CTRLL:	CALL	CLRSCN
	JRST	CFLUSH		;[502] CLEAR SCREEN AND LEAVE

CLRSCN:	HRLOI	A,377777	;USE OUT-OF-BOUNDS VALUE TO FORCE RECALCULATION
	MOVEM	A,SCRNPT
	SETZM	WINDOW		;CLEAR WINDOW MEMORY TO SHOW THERE'S
				; NOTHING ON SCREEN
	MOVE	A,[WINDOW,,WINDOW+1]
	BLT	A,WINDOW+WINTOP
	CALL	HOME		;YES, HOME UP FIRST
CEOS:	SKIPN	SCRNF		;ARE WE ON A SCREEN?
	RET			;NO, SO DON'T TRY TO CLEAR IT
	JRST	EOS		;THEN CLEAR TO END OF SCREEN

CLREOS:	MOVEI	CH,37		;MAGIC CLEAR TO END OF SCREEN CHARACTER
	CALLRET	CNFILL		;REQUIRES FILLERS
CUP:	MOVEI	CH,C.UP		;LINE STARVE
	CALLRET	CNFILL

;SCREEN MANAGEMENT ROUTINES

;ROUTINE TO ERASE "REST" OF LINE.

EOL:	CALL	DISCOC		;MAKE CONTROL CHARACTERS TYPE LITERALLY
	MOVE	A,TRMTYP	;FIND OUT WHAT SPECIES OF TERMINAL WE ARE
	CALL	@EOLTAB(A)	;CALL APPROPRIATE ROUTINE
	CALLRET	REGCOC		;RESTORE CONTROL CHARACTER STUFF

	TERINI EOLTAB
	TER (.TTV05,IFIW!CLREOL)
	TER (.TTV50,IFIW!V50EOL)
	TER (.TT100,IFIW!V100CL)
	TER (.TT102,IFIW!V100CL)	 ;VT102 IS LIKE VT100
	TER (.TT125,IFIW!V100CL)	 ;VT102 IS LIKE VT100
	TER (.TTV52,IFIW!V50EOL) ;VT52 GETS CLEARED JUST LIKE VT50

;ROUTINE FOR ERASING "REST OF SCREEN"

EOS:	CALL	DISCOC		;MAKE SO ALL CONTROLS ARE LITERAL
	MOVE	A,TRMTYP
	CALL	@EOSTAB(A)		;CALL APPROPRIATE ROUTINE
	CALLRET	REGCOC		;RESTORE REGULAR CONTROL STUFF AND RETURN

	TERINI EOSTAB
	TER (.TTV05,IFIW!CLREOS)
	TER (.TTV50,IFIW!V50EOS)
	TER (.TT100,IFIW!V100ES)
	TER (.TT102,V100ES)
	TER (.TT125,V100ES)
	TER (.TTV52,IFIW!V50EOS) ;SCREEN CLEARING THE SAME ON VT52 AS VT50

;ROUTINE TO PUT CURSOR AT TOP LEFT (HOME) POSITION ON SCREEN.

HOME:	SETZB	A,CRRCNT		;RESET LINE COUNTER.
	CALL	SETLIN		;TELL SYSTEM WE'RE AT TOP OF SCREEN
	SKIPN	SCRNF		;ON A SCREEN?
	CALLRET	CRR		;NO, JUST TYPE CRLF AND RETURN
	CALL	DISCOC		;MAKE CONTROL CHARACTERS SOME OUT LITERALLY
	MOVE	A,TRMTYP
	CALL	@HOMTAB(A)		;DO SPECIES DEPENDENT HOMEUP
	CALLRET	REGCOC		;RESTORE CONTROL CHARACTERS AND RETURN

	TERINI HOMTAB
	TER (.TTV05,IFIW!HOMEUP)
	TER (.TTV50,IFIW!V50HOM)
	TER (.TT100,IFIW!V100HM)
	TER (.TT102,V100HM)
	TER (.TT125,V100HM)
	TER (.TTV52,IFIW!V50HOM) ;VT50 AND VT52 HOME THE SAME WAY

;LINE STARVE...

LINSTV:	CALL	DISCOC		;TYPE CONTROLS LITERALLY
	MOVE	A,TRMTYP
	CALL	@STVTAB(A)
	CALLRET	REGCOC		;RESTORE CONTROL CHARACTER STUFF

	TERINI STVTAB
	TER (.TTV05,IFIW!CUP)
	TER (.TTV50,IFIW!V50CUP)
	TER (.TT100,IFIW!V100UP)
	TER (.TT102,IFIW!V100UP)
	TER (.TT125,IFIW!V100UP)
	TER (.TTV52,IFIW!V50CUP)

;VT100 ROUTINES

;MACRO TO CAUSE DISPLAY OF ANSI SEQUENCE ESCAPE - OPEN BRACKET - CHARACTER
;FOLLOWED BY RET

DEFINE DSPANS(chr)
<	HRROI	B,[BYTE(7) .CHESC, "[", chr]
	JRST	DSPANI
>

DSPANI:	MOVE	A,TTYOUT
	SETZ	C,
	SOUT%
	 ERJMP	.+1
	RET

V100ES:	DSPANS "J"

V100CL:	DSPANS "K"

V100UP:	DSPANS "A"

;***; [477] ADD 1 line @ V100HM:+0	LEM	11-12-81
V100HM:	PSTR <[?1l>			;[477] reset Cursor Key Mode
	DSPANS "H"

;VT50 ROUTINES

DEFINE DSPANS(chr)
<	HRROI	B,[BYTE(7) .CHESC, <chr>]
	JRST	DSPANI
>

V50EOS:	DSPANS	112	;CLEAR TO END OF SCREEN

V50EOL:	DSPANS	V52.EL	;CLEAR TO END OF LINE

V50HOM:	DSPANS	110	;HOMEUP

V50CUP:	DSPANS	V52.UP	;LINE STARVE

;VT05 CURSOR CONTROL

CLREOL:	SKIPA	CH,[C.EOL]	;MAGIC VT05 CLEAR TO END OF LINE CHARACTER
HOMEUP:	MOVEI	CH,"]"-100	;MAGIC VT05 CHARACTER TO HOME UP
CNFILL:	MOVE	A,CH
	CALL	TYO		;TYPE MAGIC CHARACTER
	MOVEI	C,4
CNFIL2:	MOVEI	A,0
	CALL	TYO
	SOJG	C,CNFIL2		;AND FOUR NULLS FOR FILLER
	RET

;ROUTINE TO REMEMBER WHERE PRESERVED OUTPUT STARTS.
;PRESERVED OUTPUT IS LIKE T OR = COMMAND.  BUFFER SHOWING SHOULDN'T
;OVERPRINT SUCH OUTPUT.

WINCLS:	AOSE	WINFLG		;IS THIS FIRST PRESERVED OUTPUT
				; FOR THIS COMMAND STRING?
	RET			;NO, SO WE'VE ALREADY MARKED POSITION
	CALL	LM			;START "T" "=" ETC. AT LEFT MARGIN
	CALL	SYSLIN		;FIND OUT LINE WE'RE ON
	MOVEM	A,DISBLK		;REMEMBER WHERE PRESERVATION STARTS
	RET

;ROUTINE TO FIND OUT WHAT LINE WE'RE ON

SYSLIN:	MOVE	A,TTYOUT
	MOVEI	B,.MORLC		;READ LINE COUNTER
	MTOPR%
	MOVE	A,C		;GIVE ANSWER IN A
	RET

;ROUTINE TO DISPLAY NEW WINDOW
;PASS IT NUMBER OF LINES TO USE IN A.

DISPLA:	TRVAR <OLDPTR,NEWPTR,NEWCOL,OLDCOL,LINCTR,LINPTR,OLDBEG,NEWBEG,SPCNT,LEN2,LEN1,DLEN1>
	MOVEM	A,DLEN1		;REMEMBER NUMBER OF LINES AVAILABLE FOR DATA
	CALL	DISCOC		;MAKE CONTROL CHARACTERS ECHO LITERALLY
	SKIPE	SCRNF		;HARDCOPY?
	JRST	DISPLB		;NO
	CALL	LM			;YES, MAKE SURE AT LEFT MARGIN
	SETZM	CRRCNT		;ASSUME STARTING AT TOP OF WINDOW
DISPLB:	SETZM	TYPEF		;FIRST ASSUME THERE'S NO TYPEAHEAD
	MOVE	A,TYIJFN
	SIBE%			;SKIP IF THERE ISN'T.
	 SETOM	TYPEF		;THERE IS, SET FLAG SAYING SO.
	CALL	WINFIL		;FILL WINEW WITH NEW DISPLAYFUL
	SETZB	A,LINCTR		;CLEAR LINE COUNTER AND LOAD INTO A
CM1:	MOVEI	B,WINDEX		;GET WORDS PER DISPLAY MEMORY
	IMUL	B,A		;CALCULATE OFFSET INTO MEMORY
				; FOR LINE BEING WORKED ON
	MOVE	C,B		;COPY FOR POINTER TO NEW DISPLAY MEMORY
	ADD	B,[POINT 7,WINDOW]	;COMPLETE POINTER TO CURRENT WINDOW
	MOVEM	B,OLDPTR
	MOVEM	B,OLDBEG	;REMEMBER POINTER TO BEGINNING OF OLD LINE
	ADD	C,[POINT 7,WINEW];COMPLETE POINTER TO NEW DATA BEING DISPLAYED
	MOVEM	C,NEWBEG		;REMEMBER POINTER TO NEW LINE
	SETZM	LEN1		;NUMBER OF CHARACTERS NEEDED TO "FIX" LINE
	CALL	LREPLA		;CALCULATE CHARACTERS NECESSARY
				; TO REWRITE WHOLE LINE
	MOVE	C,NEWBEG		;RESET LINE POINTER TO BEGINNING
	MOVEM	C,NEWPTR
	SETZM	OLDCOL		;START AT LEFT MARGIN
	SETZM	NEWCOL		;NEW COLUMN WE'RE GOING TO
	MOVE	C,[POINT 7,LINBFR]	;POINTER TO LINE BUFFER FOR OUTPUTTING
				; DISPLAY LINE
	MOVEM	C,LINPTR		;INITIALIZE DISPLAY LINE POINTER
CMLUP:	ILDB	B,OLDPTR		;PICK UP CHARACTER FROM CURRENT SCREEN
	ILDB	A,NEWPTR		;AND ONE FOR NEW SCREEN
	JUMPE	A,CMEND		;JUMP IF DONE SCANNING LINE
	JUMPE	B,CMEND1		;OLD LINE ENDED BEFORE NEW
	SKIPE	SCRNF		;IF HARDCOPY
	CAME	A,B		;OR IF CHARACTERS ARE DIFFERENT,
	CALL	PILB		;THEN DISPLAY NEW CHARACTER
	AOS	NEWCOL		;STEP TO NEXT COLUMN ON SCREEN
	JRST	CMLUP		;COMPARE REST OF CHARACTERS ON LINE
CMEND1:	CALL	PILB		;OLD ENDED FIRST, STASH NEW CHARACTERS
	AOS	NEWCOL
	ILDB	A,NEWPTR
	JUMPN	A,CMEND1		;JUMP IF MORE NEW CHARACTERS
	JRST	CMEND2
CMEND:	JUMPE	B,CMEND2		;JUMP IF BOTH LINES ENDED AT SAME TIME
	SKIPN	SCRNF		;DON'T ATTEMPT TO CLEAR TO EOL ON HARDCOPY
	JRST	CMEND2
	CALL	MOVCOL		;GET TO END OF LINE BEFORE
				; CLEARING TO END OF LINE!
	CALL	GETEOL		;NEW ONE ENDED FIRST, PUT IN AN EOL
CMEND2:	SKIPE	TYPEF		;HAS USER STARTED TYPING NEXT COMMAND?
	 JRST	DISDON		;YES, SO STOP UPDATING DISPLAY
	MOVE	A,LINPTR		;GET LINE POINTER
	CAMN	A,[POINT 7,LINBFR];WAS ANYTHING PUT IN BUFFER FOR THIS LINE?
	JRST	CMNEXT		;NO, SO THIS LINE STAYS AS IS
	MOVEI	A,0		;MARK END OF DISPLAY BUFFER WITH NULL
	IDPB	A,LINPTR
	MOVEI	C,WINDEX		;GET WORDS PER DISPLAY BUFFER
	IMUL	C,LINCTR		;CALCULATE OFFSET FOR LINE BEING DISPLAYED NOW
	MOVE	A,LINCTR		;GET LINE BEING DONE NOW
	MOVE	T,C		;GET COPY OF POINTER TO DISPLAY AREA
	HRL	T,T			;COPY IT TO LEFT HALF
	ADD	T,[WINEW,,WINDOW]	;MAKE BLT POINTER
	BLT	T,WINDOW+WINDEX-1(C);MOVE LINE FROM WINEW AREA TO WINDOW AREA
	MOVE	CH,LINNEW(A)
	MOVEM	CH,LINBEG(A)	;COPY BUFFER POINTER OF BEGINNING OF LINE
	MOVEI	CH,(A)		;FIND WHAT DISPLAY LINE POSITION TO
	CALL	LINPOS		;GO TO AND GO THERE
DISPL9:	MOVE	A,TTYOUT		;USE STANDARD OUTPUT CHANNEL
	HRROI	B,LINBFR		;POINTER TO NEW LINE
	MOVEI	C,0
	MOVE	D,LEN1		;GET NUMBER OF CHARACTERS TO FIX LINE
	SKIPE	SCRNF		;ALWAYS REPLACE ENTIRE LINE ON HARDCOPY
	CAML	D,LEN2		;BETTER TO FIX THAN REPLACE?
	HRROI	B,LINBF2		;BETTER TO REPLACE
	SOUT%			;OUTPUT NEW LINE
CMNEXT:	AOS	A,LINCTR		;STEP TO NEXT LINE ON SCREEN
	CAMGE	A,DLEN1		;HAVE ALL LINES BEEN PROCESSED?
	JRST	CM1		;NO, GO DO NEXT
DISDON:	CALLRET	REGCOC		;RESTORE CONTROL CHARACTER BEHAVIOR

;THE FOLLOWING ROUTINE FILLS LINBF2 WITH THE CHARACTERS NECESSARY TO
;COMPLETELY REWRITE THE CURRENT DISPLAY LINE.  LEN2 SHOWS APPROXIMATE
; NUMBER OF CHARACTERS NECESSARY

LREPLA:	SETZM	SPCNT			;NO TAB IN PROGRESS YET
	SETZM	LEN2			;COUNTS CHARACTERS PUT INTO BUFFER
	MOVE	A,NEWBEG		;GET POINTER TO BEGINNING OF NEW LINE
	MOVEM	A,NEWPTR		;STORE POINTER FOR SCANNING NEW LINE
	MOVE	A,[POINT 7,LINBF2]	;POINTER TO OUTPUT LINE BEING CREATED
	MOVEM	A,LINPTR
	SETZM	NEWCOL			;COLUMN OF SCREEN WE'RE AT
	SKIPE	SCRNF			;DON'T ATTEMPT CLEAR LINE ON HARDCOPY
	CALL	GETEOL			;START WITH EOL TO CLEAR OLD LINE
LRLUP:	AOS	A,NEWCOL		;SEE WHICH COLUMN TYPING NEXT CHARACTER
					; WILL BRING US TO
	SOJ	A,			;SEE WHERE WE'RE AT BEFORE TYPING THE CHARACTER
	TRNN	A,7			;A TAB STOP?
	CALL	LRTAB			;YES, PUT IN A TAB IF ANY SPACES WERE STORED UP
	ILDB	A,NEWPTR		;GET NEXT CHARACTER FROM NEW LINE
	JUMPE	A,LR2			;LEAVE LOOP IF END OF STRING
	CAIN	A,40			;A SPACE?
	JRST	LR1			;YES
	SKIPG	B,SPCNT			;DID SOME SPACES PRECEDE THIS CHARACTER?
	JRST	LR5			;NO
	MOVEI	A,40			;YES, SO PUT THE SPACES IN BEFORE THE CHARACTER
	ADDM	B,LEN2			;KEEP TRACK OF NUMBER OF CHARACTERS
LR6:	IDPB	A,LINPTR		;PUT IN A SPACE
	SOSLE	SPCNT			;MORE NEEDED?
	JRST	LR6			;YES, PUT THEM IN
	LDB	A,NEWPTR		;GET ORIGINAL CHARACTER BACK
LR5:	IDPB	A,LINPTR		;PUT ORIGINAL CHARACTER IN LINE BUFFER
	AOS	LEN2			;KEEP TRACK OF BUFFER LENGTH
	JRST	LRLUP			;LOOP FOR REST OF CHARACTERS OF LINE
LR1:	AOS	SPCNT			;FOR A SPACE, JUST REMEMBER HOW MANY WE'VE SEEN
	JRST	LRLUP			;GO GET REST OF CHARACTERS
LR2:	MOVEI	A,0
	IDPB	A,LINPTR		;FINISH WITH NULL (NOTE THAT WE'VE STRIPPED
					;TRAILING SPACES, OR AT LEAST UP TO 7 OF THEM)
	RET

;EVERY TIME A TAB STOP IS REACHED, COME HERE TO PUT A TAB IN BUFFER IF ANY
;SPACES WERE RIGHT-JUSTIFIED DURING LAST "TAB COLUMN" (8-SPACES)

LRTAB:	SKIPN	A,SPCNT			;ANY SPACES STORED UP?
	RET				;NO, SO NOTHING TO DO
	AOS	LEN2
	MOVEI	A,.CHTAB		;YES, SO PUT TAB IN BUFFER
	IDPB	A,LINPTR
	SETZM	SPCNT			;SHOW THAT NO BUFFERED SPACES ANYMORE
	RET

;INTERRUPT TO HERE IF USER TYPES WHILE BUFFER IS EMPTY.

TYPO:	PUSH	P,A			;DON'T CLOBBER NUTTIN
	PUSH	P,B
	MOVE	A,TYIJFN
	SIBE%				;CAREFUL NOT TO SET FLAG IF CHAR
					; THAT CAUSED INTERRUPT HAS ALREADY BEEN READ!
	 SETOM	TYPEF			;SET FLAG TO SHOW HE TYPED
	POP	P,B
	POP	P,A
	DEBRK%

;ROUTINE WHICH TAKES CHARACTER IN A AND PUTS IN IN DISPLAY LINE
;BUFFER.  IT ALSO PUTS IN THE APPROPRIATE CONTROL CHARACTERS FOR
;GETTING THE CURSOR TO THE CORRECT LINE POSITION WHERE THE CHARACTER
;IS SUPPOSED TO GO

PILB:	STKVAR	<CHAR>
	MOVEM	A,CHAR			;REMEMBER WHICH CHARACTER WE'RE DOING
	MOVE	A,NEWCOL		;GET COLUMN AT WHICH THIS CHARACTER GOES
	CAMN	A,OLDCOL		;ARE WE ALREADY AT RIGHT PLACE?
	JRST	COLOK			;YES
	CALL	MOVCOL			;PUT CONTROL SEQUENCE IN TO GET TO
					; CORRECT COLUMN
COLOK:	MOVE	A,CHAR			;GET CHARACTER BEING PUT IN
	IDPB	A,LINPTR		;PUT IT IN
	AOS	LEN1			;KEEP TRACK OF NUMBER OF CHARACTERS IN OUTPUT
					; BUFFER FOR FIXING LINE
	MOVE	A,NEWCOL		;GET COLUMN THIS CHARACTER WAS PUT
	AOJ	A,			;SHOW COLUMN WE'RE AT NOW
	MOVEM	A,OLDCOL		;REMEMBER WHERE WE ARE NOW
	RET

;CODE TO MOVE FROM OLDCOL TO NEWCOL

MOVCOL:	STKVAR	<DRIGHT,OLDC,NEWC,SAVB>
	MOVE	A,NEWCOL		;GET COLUMN AT WHICH THIS CHARACTER GOES
	SUB	A,OLDCOL		;SEE HOW FAR WE MUST MOVE
	MOVE	B,OLDCOL		;GET WHERE WE'RE MOVING FROM
	MOVEM	A,DRIGHT		;REMEMBER HOW FAR WE'RE MOVING
	MOVEM	B,OLDC			;REMEMBER WHERE WE'RE STARTING FROM
	ADD	A,OLDC			;CALCULATE WHERE WE'RE GOING
	MOVEM	A,NEWC			;REMEMBER
	TRZ	B,7			;GO BACK TO LAST TAB STOP
	MOVEI	C,.CHTAB		;GET A TAB
MOVTAB:	ADDI	B,8			;SEE WHERE TAB WOULD BRING US
	CAMLE	B,NEWC			;TOO FAR?
	JRST	MOVNMT			;YES
	IDPB	C,LINPTR		;NO, PUT IN A TAB
	AOS	LEN1
	JRST	MOVTAB			;TRY TO PUT IN ANOTHER TAB
MOVNMT:	SUBI	B,8			;UNDO LAST NONTAB!
	CAMGE	B,OLDC			;MAKE SURE WE'RE NOT TO THE LEFT OF
					; WHERE WE STARTED!
	MOVE	B,OLDC			;WE ARE (WE DIDN'T TYPE ANY TABS)
	MOVEM	B,SAVB			;REMEMBER WHERE WE ARE
	MOVE	C,B			;NUMBER OF CHARACTERS ALONG LINE WE ARE
	ADJBP	C,OLDBEG		;GET POINTER TO CHARACTER BEING PASSED OVER
MOVSPC:	CAML	B,NEWC			;ARE WE THERE YET?
	JRST	MOVNMC			;YES
	ILDB	A,C			;GET CHARACTER BEING PASSED OVER
	IDPB	A,LINPTR		;PASS OVER IT BY TYPING IT.
					; (QUICKER THAN $C ON VT52)
	AOS	LEN1
	AOS	B,SAVB			;SHOW THAT WE'VE MOVED A SPACE
	JRST	MOVSPC			;GO SEE IF MORE SPACES NEEDED
MOVNMC:	RET				;ALL DONE, WE'RE AT NEW POSITION

;CLEAR TO END OF LINE (IN BUFFER)

GETEOL:	MOVE	A,TRMTYP		;GET FLAVOR
	JRST @EOLTB1(A)			;DO TERMINAL DEPENDENT CLEARING

	TERINI EOLTB1
	TER (.TTV05,IFIW!V05POL)
	TER (.TTV50,IFIW!V50POL)
	TER (.TT100,IFIW!V100PL)
	TER (.TT102,IFIW!V100PL)
	TER (.TT125,IFIW!V100PL)
	TER (.TTV52,IFIW!V50POL)

V100PL:	MOVEI	A,.CHESC
	IDPB	A,LINPTR
	MOVEI	A,"["
	IDPB	A,LINPTR
	MOVEI	A,"K"
	IDPB	A,LINPTR
	RET

V05POL:	MOVEI	A,C.EOL			;PUT IN CLEARING CHARACTER
	IDPB	A,LINPTR
	MOVEI	A,177			;NEEDS FILLERS
	REPEAT 4,<IDPB A,LINPTR> 	;(CAN'T USE NULLS BECAUSE SOUT WOULD TERMINATE)
	RET

V50POL:	MOVEI	A,V52.ES		;ESCAPE CODE FOR VT50
	IDPB	A,LINPTR
	MOVEI	A,V52.EL		;END OF LINE CHARACTER
	IDPB	A,LINPTR
	RET

;MOVE RIGHT A COLUMN (CAN'T USE SPACE, WHICH ERASES AS IT GOES!)

;**;[476] DELETE one line at MOVRIT	LEM	20-OCT-81
;**;[476] DELETE one line at MOVRIT+3	LEM	20-OCT-81
MOVRIT:	MOVE	A,TRMTYP		;GET FLAVOR OF TERMINAL
	CALL	@RITTAB(A)		;DO TERMINAL DEPENDENT MOVING

	TERINI RITTAB
	TER (.TTV05,IFIW!V05RIT)
	TER (.TTV50,IFIW!V50RIT)
	TER (.TT100,IFIW!V100RT)
	TER (.TT102,IFIW!V100RT)
	TER (.TT125,IFIW!V100RT)
	TER (.TTV52,IFIW!V50RIT)

V100RT:	MOVEI	A,.CHESC
	IDPB	A,LINPTR
	MOVEI	A,"["
	IDPB	A,LINPTR
	MOVEI	A,"C"
	IDPB	A,LINPTR
	RET

V05RIT:	MOVEI	A,C.RITE		;VT05 CHARACTER FOR MOVING RIGHT
	IDPB	A,LINPTR		;PUT IT IN BUFFER
	RET

V50RIT:	MOVEI	A,V52.ES		;ESCAPE CODE NEEDED FOR VT5X
	IDPB	A,LINPTR
	MOVEI	A,V52.RT		;CHARACTER FOR MOVING RIGHT
	IDPB	A,LINPTR
	RET

;ROUTINE TO PUT CURSOR ON LINE SPECIFIED BY CONTENTS OF CH

LINPOS:	STKVAR	<NEWCRR>
	MOVEM	CH,NEWCRR
	CAMN	CH,CRRCNT		;ALREADY AT CORRECT PLACE?
	JRST [	CALL CHKLM		;YES, MAKE SURE AT LEFT MARGIN
		 JRST [	MOVEI A,.CHCRT
			CALL TYO
			JRST LINDON]
		JRST LINDON]
	MOVEI	A,-1(CH)		;IF GOING DOWN EXACTLY ONE LINE, JUST
	CAME	A,CRRCNT		;TYPE CRLF, SO AS NOT TO OVERPRINT
					; SYSTEM MESSAGES
	SKIPN	SCRNF			;ON A SCREEN?
	JRST	LINHRD			;NO, HARD COPY
	CALL	DISCOC			;MAKE CONTROL CHARACTERS ECHO LITERALLY
	MOVE	A,TRMTYP
	CALL	@POSTAB(A)		;CALL APPROPRIATE ROUTINE
	CALL	REGCOC			;RESTORE CONTROL CHARACTERS
LINDON:	MOVE	A,NEWCRR
	MOVEM	A,CRRCNT		;REMEMBER WHERE WE NOW ARE.
	RET

;POSITIONING ON A HARDCOPY

LINHRD:	CAMGE	CH,CRRCNT		;MAKE SURE GOING DOWN
	IERROR <Hardcopy linestarve>
LINH1:	MOVE	A,CRRCNT		;SEE WHERE ANOTHER CRLF WILL BRING US
	CAML	A,NEWCRR		;FAR ENOUGH?
	RET				;YES, DONE
	CALL	CRR			;NO, GET TO NEXT LINE
	AOS	CRRCNT
	JRST	LINH1			;LOOP FOR REST

	TERINI POSTAB			;CURSOR ADDRESSING ROUTINES
	TER (.TTV05,IFIW!LINECH)
	TER (.TTV50,IFIW!V50LIN)
	TER (.TT100,IFIW!V100LN)
	TER (.TT102,IFIW!V100LN)
	TER (.TT125,IFIW!V100LN)
	TER (.TTV52,IFIW!V50LIN)

;ROUTINE FOR VT50 RANDOM LINE ADDRESSING

V50LIN:	PUSH	P,CH			;REMEMBER WHERE WE WANT TO GO
	SUB	CH,CRRCNT		;CALCULATE HOW FAR AWAY WE ARE.
	JUMPG	CH,V50DWN		;WE HAVE TO GO DOWN TO SOMEWHERE
	MOVNI	CH,2(CH)		;2 CHARACTERS OVERHEAD FOR HOMEUP
	HRRZ	CH,CH			;FLUSH BAD BITS
	CAMG	CH,(P)
	JRST	V50GUP			;IT'S BETTER TO GO UP THAN HOME AND COME DOWN
	CALL	HOME			;CHECK ON THE FOLKS (GO TO TOP OF SCREEN)
	MOVE	CH,(P)			;WE'RE GOING TO START AT THE TOP AND COME DOWN.
	JUMPE	CH,V50DN1		;MAYBE HOMING UP IS ALL THAT'S NECESSARY
V50LN1:	MOVEI	A,12			;CHARACTER FOR MOVING DOWN
	CALL	TYO
	SOJG	CH,V50LN1		;FAR ENOUGH YET?
	JRST	V50DON			;YES.

V50GUP:	ADDI	CH,2
	CALL	LINSTV			;LINE STARVE
	SOJG	CH,.-1
	JRST	V50DON

V50DWN:	MOVEI	A,12			;CHARACTER TO MOVE DOWN A LINE
	CALL	TYO
	SOJG	CH,V50DWN		;GO UP UNTIL WE GET TO CORRECT PLACE
V50DON:	MOVEI	A,15
	CALL	TYO			;GET TO LEFT MARGIN
V50DN1:	POP	P,CH
	RET

;VT100 LINE ADDRESSING

V100LN:	MOVE	A,TTYOUT
	HRROI	B,[BYTE(7) .CHESC, "[" ]
	HRROI	C,-2
	SOUT%
	MOVEI	B,1(CH)			;LINE 0 IS HARDWARE LINE 1
	MOVEI	C,^D10			;SEND LINE NUMBER IN DECIMAL
	MOVE	A,TTYOUT		;USE STANDARD OUTPUT CHANNEL
	NOUT%				;SEND THE LINE NUMBER
	ERCAL	 JSERR			;SHOULDN'T FAIL
	MOVEI	A,"H"			;SAY WE'RE DOING POSITIONING
	CALLRET	TYO

;ROUTINE FOR VT05 RANDOM LINE ADDRESSING

LINECH:	MOVEI	A,C.CAD			;MAGIC CURSOR ADDRESSING CHARACTER
	CALL	TYO			;TYPE IT
	ADDI	CH,40			;MAKE VT05 ADDRESS
	CALL	CNFILL			;IT REQUIRES FILLERS
	MOVEI	A,C.LM+1		;GO TO COLUMN 1
	CALL	TYO
	RET

;THE FOLLOWING ROUTINE ASSUMES SCRNPT CONTAINS A CHARACTER ADDRESS
;OF THE FIRST ONE TO BE DISPLAYED.  THIS
;ROUTINE TRIES TO BACKUP SCRNPT TO THE BEGINNING OF THE LINE, BEING
;CAREFUL NOT TO DO SO IF THAT WOULD CAUSE THE LINE TO OVERFLOW, THUS
;CAUSING A LARGE AMOUNT OF SCREEN REFRESH (SHIFTING EVERYTHING DOWN)

LININI:	STKVAR	<LINQCL,CHARAD,BACKTO>
	MOVE	A,SCRNPT		;GET CURRENT BEGINNING OF LINE
	CALL	LINBGQ			;TRY TO FIND REAL BEGINNING
	MOVEM	A,BACKTO		;REMEMBER WHERE BEGINNING IS
	MOVEM	A,CHARAD		;INITIAL CHARACTER ADDRESS IS BEGINNING OF LINE
	SETZM	LINQCL			;KEEP TRACK OF COLUMNS
LINI1:	MOVE	A,LINQCL		;SEE WHAT COLUMN WE'RE UP TO
	CAML	A,SWIDTH		;HAS LINE GOTTEN REAL LONG?
	RET				;YES, SO WE WON'T TRY TO REPOSITION
					; BEGINNING POINTER
	MOVE	A,CHARAD		;GET CURRENT CHARACTER ADDRESS
	CAML	A,ZEE			;MAKE SURE WE HAVEN'T HIT END OF BUFFER
	JRST	LINI2			;WE HAVE, SO LINE ISN'T TOO LONG
	MOVE	I,A
	CALL	GET			;GET CURRENT CHARACTER
	CAIN	CH,15			;DID WE FIND END OF LINE?
	JRST	LINI2			;YES, SO WE CAN FIT THIS WHOLE LINE ON
	MOVE	A,CH
	MOVE	B,LINQCL		;FOR TAB, WIDTH DEPENDS ON CURRENT COLUMN
	CALL	CHRCOL			;GET WIDTH OF CHARACTER
	MOVEM	A,LINQCL		;KEEP TRACK OF WHAT COLUMN WE'RE UP TO
	AOS	CHARAD			;STEP TO NEXT CHARACTER IN BUFFER
	JRST	LINI1			;LOOP BACK TO SEE IF WE'VE FOUND END OF LINE

LINI2:	MOVE	A,BACKTO		;THE LINE IS REASONABLE LENGTH, SO
	MOVEM	A,SCRNPT		;WE CAN START DISPLAYING FROM ITS BEGINNING
	RET

;ROUTINE TO TELL EFFECT OF DISPLAYING A CHARACTER, COLUMNWISE.
;THE CALL:
;	1/	CHARACTER TO BE DISPLAYED
;	2/	COLUMN ON LINE SO FAR
;	CALL CHRCOL
;RETURNS +1 ALWAYS WITH:
;	1/	COLUMN CHARACTER BRINGS US TO
;
;THIS ROUTINE KNOWS HOW TO ACCOUNT FOR TABS AND FLAGGED CHARACTERS

CHRCOL:	STKVAR	<COL1,CHAR1>
	MOVEM	A,CHAR1
	MOVEM	B,COL1
	CAIN	A,.CHTAB		;A TAB?
	JRST	CHRCTB			;YES
	AOS	COL1			;ALL CHARACTERS INCREASE COLUMN BY AT LEAST 1
	MOVE	CH,A
	CALL	SFLAGC			;A FLAGGED CHARACTER?
	 SKIPA	A,COL1			;NO
	AOS	A,COL1			;YES, SO INCREASE COLUMN BY 2
	RET				;RETURN VALUE IN A IN EITHER CASE

CHRCTB:	MOVEI	A,^D8
	ADD	A,COL1			;TAB MIGHT GO 8 COLUMNS
	TRZ	A,7			;BUT USUALLY NOT QUITE THAT MUCH
	RET

;ROUTINE TO FILL WINEW WITH NEW PICTURE TO BE DISPLAYED
;SCRNPT MUST BE THE ADDRESS OF THE FIRST CHARACTER WITHIN BUFFER
;DESIRED IN DISPLAY.  ROUTINE ASSUMES SCRNPT POINTS TO SOME CHARACTER
;WITHIN THE BUFFER.

WINFIL:	TRVAR	<OURWT0,OURWTH,WLNO>
	SKIPE	T,SWIDTH
	CAILE	T,MAXWTH
	MOVEI	T,MAXWTH		;IN SCREEN BUFFER, NOT ANY WIDTH IS ALLOWED!
	MOVEM	T,OURWTH		;REMEMBER WIDTH OF OUR SCREEN MEMORY
	SOJ	T,			;LEAVE ROOM FOR ONE CONTINUATION CHARACTER
	MOVEM	T,OURWT0
	SETZM	WLNO			;DISPLAY LINE NUMBER
	MOVEI	P2,1			;POINTER TO LINNEW ARRAY
	MOVE	I,SCRNPT		;POINTER TO FIRST CHARACTER TO BE DISPLAYED
	SOJ	I,			;WE WANT ILDB POINTER
	CALL	GETX			;MAKE BYTE POINTER
	MOVE	C,TT			;PUT POINTER IN C
WINFL3:	MOVE	TT,C			;PUT POINTER IN TT
	CALL	PTR2AD			;CHANGE TO CHARACTER ADDRESS
	AOJ	I,			;GET FIRST CHARACTER ADDRESS OF DISPLAY LINE
	MOVEM	I,LINNEW-1(P2)		;REMEMBER WHAT PART OF BUFFER
					; BEGINS ON EACH LINE
	MOVE	P2,[POINT 7,WINEW]
	ADD	P2,WLNO			;CREATE POINTER TO NEW DISPLAY IMAGE
	MOVEI	P1,0			;# OF CHARS ON THIS SCREEN LINE SO FAR
WINFL2:	CALL	PUTCHR			;GET CHARACTER FROM BUFFER
	CAIE	T,.CHTAB		;IS THIS A TAB?
	JRST	WINNT			;NO
	MOVEI	T,40			;YES, MARK IT WITH APPROPRIATE NUMBER OF SPACES
WINTAB:	AOJ	P1,			;COUNT THE COLUMN FOR TAB
	IDPB	T,P2			;ALWAYS PUT AT LEAST ONE SPACE IN FOR TAB
	TRNE	P1,7			;ARE WE AT NEXT TAB STOP YET?
	JRST	WINTAB			;NO, SPACE OVER SOME MORE
	JRST	WINFL2			;GO GET NEXT CHARACTER FROM BUFFER

WINNT:	IDPB	T,P2			;SAVE IT IN SCREEN MEMORY
	CAIN	T,15
	SETO	P1,			;SO AOJA CORRECTLY ZEROES p1 FOR END OF LINE
	CAIE	T,12			;LF MEANS END OF SCREEN LINE
	AOJA	P1,WINFL2		;COUNT CHARACTER AND GO GET ANOTHER
	MOVEI	T,0			;CLOBBER END OF LINE WITH 0
	DPB	T,P2			;REPLACE LINEFEED WITH NULL
	SETO	A,
	ADJBP	A,P2			;POINT TO WHAT MAY BE A CARRIAGE RETURN
	CAIN	P1,0			;IS IT?
	DPB	T,A			;YES, SO NULL IT TOO
				; (DISPLA ROUTINE EXPECTS NULL AFTER TEXT OF LINE)
	MOVEI	P2,WINDEX
	ADDB	P2,WLNO			;STEP TO NEXT DISPLAY LINE
	IDIVI	P2,WINDEX
	ADDI	P2,1
	CAMGE	P2,DLENTH		;ARE WE THROUGH?
	JRST	WINFL3			;NO DO ANOTHER
	MOVE	TT,C
	CALL	PTR2AD			;MAKE CHARACTER ADDRESS
	MOVEM	I,SCNEND		;REMEMBER LAST CHARACTER POSITION DISPLAYED
	MOVE	A,WLNO
WINFL5:	CAILE	A,WINTOP		;HAS WHOLE DISPLAY AREA BEEN UPDATED?
	RET				;YES
	SETOM	WINDOW(A)		;NO, OBSCURE THE UNUSED PORTION
	ADDI	A,WINDEX
	JRST	WINFL5

;ROUTINE TO RETURN NEXT DISPLAY LINE CHARACTER IN T, TAKES
;TWO CALLS TO GET ^* FOR CONTROL-CHARACTER.
;LINEFEEDS NOT AT THE LEFT MARGIN ARE RETURNED AS ^J.
;CARRIAGE RETURNS NOT FOLLOWED BY LINEFEEDS ARE RETURNED AS ^M.
;THE CONTENTS OF LASTCH IS GIVEN IF LINE IS ABOUT TO GO OVER RIGHT MARGIN.
;POINTER IS DISPLAYED AS CHARACTER STRING THAT IS THE CONTENTS OF
;PTRCHR.

PUTCHR:	SKIPE	SEOL			;NON-ZERO SEOL MEANS END OF DISPLAY LINE
	JRST	PUTEOL			;END OF LINE
	CAML	P1,OURWT0		;BEGINNING OF END OF LINE?
	JRST	SCON			;HANDLE END OF LINE
	SKIPE	CTLFLG			;OUTPUTTING CONTROL CHARACTER?
	JRST	CTLCHR			;YES, GO SEND CHARACTER
	SKIPLE	PUTPTF			;if outputting pointer
	JRST	PUTPT1			;continue doing so...
	SKIPE	EOBFLG			;END OF BUFFER?
	JRST	EOBCHR			;YES, JUST SEND CRLFS
	MOVE	T,BEG
	CAMN	T,ZEE			;NO BUFFER?
	JRST	EOBCR2			;THEN SURELY WE ARE AT THE END!
	CAME	C,ILDBPT		;ARE WE AT POINTER IN BUFFER?
	JRST	PUTCR1			;NOT YET, OR PAST IT
	SKIPE	PUTPTF			;AT IT, BUT DID WE ALREADY KNOW THAT?
	JRST	PUTPT1			;YES, SO CONTINUE GIVING PICTURE OF POINTER
POINTP:	MOVE	T,[010700,,PTRCHR-1] 	;GET POINTER TO PICTURE OF POINTER
	MOVEM	T,PUTPTF
	JRST	PUTPT1			;OUTPUT PICTURE OF POINTER
PUTCR1:	UILDB	T,C			;GET NEXT CHARACTER IN BUFFER
	CAMN	C,SCRNZ			;IS THIS LAST CHARACTER IN BUFFER?
	SETOM	EOBFLG			;YES, SET FLAG FOR NEXT CALL TO PUTCHR
	CAIN	T,.CHESC		;ALTMODE?
	MOVEI	T,"$"			;DOLLAR SIGN
	CAIN	T,15			;CR?
	JRST	SCR			;YES, MAYBE END OF LINE (IF LINEFEED NEXT)
	CAIN	T,12			;LF?
	JRST	SLF			;YES, PART OF END OF LINE?
	CAIN	T,.CHTAB			;HANDLE TAB SPECIALLY
	RET				;NOTHING SPECIAL HERE ABOUT TAB
	CAILE	T,37			;OTHER CONTROL CHARACTER?
	JRST	PUTCR3
PUTCR2:	ADDI	T,100			;MAKE * PART OF ^*
	MOVEM	T,CTLFLG
	MOVEI	T,"^"			;PRINT UPARROW FIRST
	RET

PUTCR3:	MOVE	CH,T
	CALL	SFLAGC			;FLAG THIS CHARACTER?
	RET				;NO
	MOVEM	T,CTLFLG		;REMEMBER WHAT CH WAS FLAGGED
	MOVEI	T,CFLAG			;GET FLAG CHARACTER
	RET
PUTPT1:	ILDB	T,PUTPTF		;GET CHARACTER OF PICTURE OF POINTER
	JUMPN	T,CPOPJ			;ZERO MEANS POINTER HAS COMPLETED BEING
	SETOM	PUTPTF			;NEG MEANS POINTER FULLY DISPLAYED
	SKIPE	EOBFLG			;END OF BUFFER?
	JRST	EOBCR4			;YES
	JRST	PUTCR1			;GO BACK TO GET NEXT CHARACTER FROM BUFFER
EOBCR2:	SETOM	EOBFLG
	JRST	POINTP
CTLCHR:	MOVE	T,CTLFLG		;GET CHARACTER THAT WAS "CONTROL"ED
	SETZM	CTLFLG			;SAY DONE PROCESSING CONTROL CHARACTER
	RET
EOBCHR:	SKIPL	EOBFLG			;EOBFLG NEGATIVE IF JUST REACHED END OF LINE
	JRST	EOPCR1			;DIDN'T JUST, SO OSCILLATE BETWEEN CR AND LF
	CAME	C,ILDBPT		;IF POINTER IS AT END OF BUFFER,
	JRST	EOBCR4			;PUT IT IN PICTURE
	SKIPN	PUTPTF			;SKIP IF POINTER IN PICTURE
	JRST	POINTP			;IT'S NOT, SO PUT IT IN
EOBCR4:	MOVEI	T,12			;SO CR BEFORE LF IN OSCILLATION
	MOVEM	T,EOBFLG
EOPCR1:	MOVEI	T,27			;CR+LF
	SUBB	T,EOBFLG		;CHANGE CR TO LF AND LF TO CR
	RET				;T HAS CR OR LF BECAUSE NO MORE BUFFER
SCR:	CAME	C,ILDBPT
	SKIPGE	EOBFLG			;ARE WE AT END OF BUFFER?
	JRST	PUTCR2			;CR LAST CHAR IN BUFFER = ^M
	MOVE	T,C			;SEE IF CHAR AFTER CR IS LF
	UILDB	T,T			;GET NEXT CHARACTER
	CAIN	T,12			;LF?
	JRST	SCR1			;YES
	MOVEI	T,15			;NO, ^M
	JRST	PUTCR2
SCR1:	MOVEI	T,15			;CRLF, SO CARRIAGE RETURN NOT HACKED
	RET
SLF:	MOVE	TT,C			;DECREMENT BYTE POINTER
	CALL	DBP
	CAME	TT,ILDBPT		;IF JUST AFTER CARAT, LINEFEED IS ^J
	JUMPE	P1,SLF1			;LINEFEED AT LEFT MARGIN IS JUST LINEFEED
SLF2:	MOVEI	T,12			;NO, SO ^J
	JRST	PUTCR2
SLF1:	MOVEI	T,12			;CR BEFORE LF, SO DON'T HACK LF
	RET
SCON:	CAME	C,ILDBPT		;ARE WE AT POINTER NOW?
	JRST	SCON4			;NO
	SKIPL	PUTPTF			;skip if pointer fully displayed
	JRST	SCON2			;it's not
SCON4:	SKIPE	CTLFLG			;OR IN THE MIDDLE OF A CONTROL CHARACTER
	JRST	SCON2			;THEN TYPE CONTINUATION CHARACTER
	SKIPE	EOBFLG			;END OF BUFFER?
	JRST	EOBCHR
	MOVE	TT,C
	UILDB	T,TT			;PEEK AT NEXT TWO CHARACTERS AND IF THEY
					;ARE CRLF, THEN NO CONTINUATION
	CAMN	TT,ILDBPT		;AT POINTER NOW
	JRST	SCON2			;THEN CONTINUATION REQUIRED
	CAIN	T,15			;CR?
	JRST	SCON1			;YES, SEE IF LF NEXT
	CAME	TT,SCRNZ		;END OF BUFFER?
	JRST	SCON69			;NO, MAYBE LINE IS JUST ONE MORE CHARACTER
	SETOM	EOBFLG			;REMEMBER THAT END OF BUFFER HAS BEEN REACHED
	CAIE	T,.CHTAB		;TAB AT END OF LINE?
	CAIN	T,.CHESC		;OR ALTMODE
	JRST	SCON5			;TAB OR ALTMODE IS LAST CHAR IN BUFFER
	CAILE	T,37
	JRST	SCONGD			;NON-CONTROL CHARACTER IS LAST IN BUFFER
SCON2:	CAML	P1,OURWTH		;DID WE JUST TAB TO RIGHT MARGIN?
	JRST [	MOVE T,OURWT0		;YES, SO CAN'T PUT ANOTHER CHARACTER IN LIEU
					;OF CONTINUATION SIGNAL EVEN IF THAT CHARACTER
					;IS THE LAST ON THE LINE
		SUB T,P1		;CALCULATE AMOUNT OF OVERSHOOT
		MOVE P1,OURWT0		;POSITION AT EXACT PLACE WHERE CONTINUATION GOES
		ADJBP T,P2		;BACK UP POINTER SO LAST SPACES OF TAB
					; GET REPLACED
					;WITH CONTINUATION SIGNAL
		MOVE P2,T
		JRST .+1]		;DO CONTINUATION BEFORE CHARACTERS AFTER TAB
	MOVEI	T,12			;START EOL SEQUENCE WITH LF SO CR FIRST
	MOVEM	T,SEOL
	MOVE	T,LASTCH		;GET CONTINUATION CHARACTER
	RET
;AT THIS POINT WE KNOW CHARACTER FOR COLUMN 72 IS NOT THE LAST
;IN THE BUFFER, AND IT IS NOT IMMEDIATELY FOLLOWED BY THE POINTER
SCON69:	CAMGE	P1,OURWTH		;IF JUST TABBED TO RIGHT MARGIN, NO ROOM FOR
					;LAST REMAINING CHARACTER ON LINE
	CAIG	T,37			;IS THIS CHAR A CONTROL CHARACTER
	JRST	SCON2			;YES, SO NO ROOM FOR IT HERE
	MOVE	CH,T
	CALL	SFLAGC			;WOULD THIS CHAR BE FLAGGED?
	TRNA				;NO
	JRST	SCON2			;CHARACTER FLAGGED, SO NO ROOM
	UILDB	T,TT			;NOT CONTROL, SO IF CRLF NEXT, NO CONTINUATION
	CAME	TT,ILDBPT		;NOW AT END OF BUFFER?
	CAMN	TT,SCRNZ		;OR RIGHT BEFORE POINTER?
	JRST	SCON2			;YES, SO EVEN CR WOULD BE ^M
	CAIE	T,15			;CR?
	JRST	SCON2			;NO
	UILDB	T,TT			;YES, LOOK AT NEXT ONE
	CAIE	T,12			;IS IT A LINEFEED?
	JRST	SCON2			;NO
	JRST	SCONGD			;YES

SCON1:	UILDB	T,TT
	CAIE	T,12			;LF AFTER CR AT EOL?
	JRST	SCON2			;NO
SCONGD:	UILDB	T,C			;CRLF , SO JUST GOBBLE IT UNHACKED
	RET
SCON5:	MOVE	CH,T
	CALL	SFLAGC
	JRST	SCONGD
	JRST	SCON2
PUTEOL:	MOVEI	T,27			;CR + LF
	SUBB	T,SEOL			;CHANGE ONE TO THE OTHER
	CAIN	T,12			;SEE IF WE'VE PRINTED ONE SET YET
	SETZM	SEOL			;YES, ANNOUNCE END OF END OF LINE
	RET
;DISPLAY INITIALIZATION ROUTINE

DISINI:	SETZM	EOBFLG			;END OF BUFFER FLAG
	SETZM	PUTPTF			;POINTER IN DISPLAY FLAG
	SETZM	CTLFLG			;NON-ZERO MEANS CONTROL CHARACTER
	SETZM	SEOL			;END OF LINE SEEN FLAG
	MOVE	I,PT
	SUBI	I,1			;TO POINT TO LAST CHARACTER
	CALL	GETX			;LDB POINTER TO CHARACTER AFTER
					; POINTER IN BUFFER
	MOVEM	TT,ILDBPT
	RET

;@J TRIES TO PUT THE POINTER IN THE MIDDLE OF THE SCREEN.

ATSGNJ:	SKIPN	SLENTH			;IS THERE A POSITIVE WINDOW DEFINED?
	JRST	CFLUSH			;NO, SO @J DOES NOTHING.
	MOVE	A,SLENTH		;YES, GET WINDOW SIZE.
	LSH	A,-1			;DIVIDE BY 2 TO GET IN MIDDLE OF WINDOW.
	MOVE	I,LINNEW(A)		;GET POINTER TO FIRST CHARACTER OF A LINE.
	CAMG	I,ZEE			;MAKE SURE WE'RE STILL IN THE BUFFER.
	CAMGE	I,BEG			;AND NOT BEFORE IT.
	JRST	CFLUSH			;WE WEREN'T, SO GIVE UP.
	MOVEM	I,PT			;WE'RE O.K., SO CHANGE "POINT".
	JRST	CFLUSH
;ROUTINE TO RETURN STRING OPERATION STRING ARGUMENTS.
;ARGUMENTS ARE CHARACTER ADDRESSES IN THE DATA BUFFER.
;TRANSFORMS M,N OR N, WHERE THE LATTER SPECIFIES A NUMBER OF LINES,
;TO ARGUMENTS.
;CALL CALL GETARG
;	RETURN WITH FIRST ARGUMENT ADDRESS IN p1, SECOND IN B.
;THE ROUTINE ALSO MAKES SURE THE ARGUMENTS SUPPLIED ARE REALLY
;WITHIN THE BUFFER!
;GETARG CLEARS ARG2. IT DOES NOT CLOBBER A (SOME ROUTINES DEPEND ON THIS).

GETARG:	MOVE	C,FARG			;[502] GET FIRST ARG IF ANY
	TXZE	FF,ARG2			;[506] IS THERE A SECOND ARGUMENT?
	JRST	GETAG6			;YES

;N SIGN INDICATES DIRECTION RELATIVE TO PT.

	TXON	FF,ARG			;NO. IS THERE AN ARGUMENT?
	CALL	CHK22			;[502] C=1 OR -1 (-1 IF OP="-")
					;IE, ASSUME AN ARG OF 1 AND RETAIN SIGN
	MOVE	I,PT			;I:=PT
	JUMPLE	C,GETAG2		;WAS LAST ARGUMENT FUNCTION -?
GETAG4:	CAMN	I,ZEE			;NO. ARGUMENT IS LOCATION OF NTH LINE
					;FEED FORWARD FROM PT.
					;IS PT AT END OF BUFFER?
	JRST	GETAG1			;YES.
	CALL	GET			;NO.
	CAIE	CH,.CHLFD		;LF?
	AOJA	I,GETAG4		;NO. TRY AGAIN.
	SOSLE	C			;HAVE WE FOUND ENOUGH?
	AOJA	I,GETAG4		;NO, FIND ANOTHER.
	CAME	I,BEG
	TXNN	FF,COLONF
	AOJA	I,GETAG1		;AT BEGINNING OF BUFFER OR NOT : COMMAND
	SOJ	I,			;FOR :L,:K ETC. PUT POINTER BEFORE END OF LINE
	CALL	GETINC			;GET CHARACTER BEFORE LINEFEED
	CAIE	CH,.CHCRT		;CR?
	AOJA	I,GETAG1		;NO, SO COLON HAS NO EFFECT.
	SOJ	I,			;YES, SO PUT POINTER AT END OF LAST LINE

GETAG1:	MOVE	C,I			;YES. RETURN FIRST ARGUMENT IN p1
	MOVE	P1,PT			;SECOND IN B.
	CALLRET	CHK1			;CHECK ARGS AND RETURN.

;M,N

GETAG6:	ADD	C,BEG			;p1:=M+BEG
	ADD	P1,BEG			;c:=N+BEG
	CALLRET	CHK1			;MAKE SURE ARGUMENTS ARE WITHIN BUFFER
					; AND RETURN.

GETAG2:	SOS	I			;ARG IS POS OF NTH LINE FEED LEFT OF PT.
					;N:=N-1
GETAG9:	CAMGE	I,BEG			;PASSED BEGINNING OF BUFFER?
	JRST	GETAG3			;YES. I:=BEG
	CALL	GET			;NO.
	CAIE	CH,.CHLFD		;LF?
	SOJA	I,GETAG9		;NO. BACK UP ONE POSITION AND TRY AGAIN.
	AOSG	C			;HAVE WE FOUND ENOUGH LINEFEEDS?
	SOJA	I,GETAG9		;NOT YET.
	CAME	I,BEG
	TXNN	FF,COLONF
	AOJA	I,GETAG3		;AT BEGINNING OF BUFFER OR NOT : COMMAND
	SOJ	I,			;FOR :L,:K ETC. PUT POINTER BEFORE END OF LINE
	CALL	GETINC			;GET CHARACTER BEFORE LINEFEED
	CAIE	CH,.CHCRT		;CR?
	AOJA	I,GETAG3		;NO, SO COLON HAS NO EFFECT.
	SOJ	I,			;YES, SO PUT POINTER AT END OF LAST LINE

GETAG3:	CAMGE	I,BEG			;YES. PASSED BEGINNING OF BUFFER?
	MOVE	I,BEG			;YES. RESET TO BEGINNING.
	MOVE	P1,I			;NO. RETURN FIRST ARGUMENT IN C.
	MOVE	C,PT			;SECOND IN c
	CALLRET	CHK1			;CHECK ARGS AND RETURN.
;MOVE STRING GIVEN CHARACTER POINTERS
; I/ SOURCE CHAR PTR
; OU/ DEST CHAR PTR
; p1/ COUNT

MVCST:	MOVE	A,I			;GET CHAR ADDRESS OF LEFTMOST CHAR IN SOURCE
	CALL	ADDPTR			;MAKE LDB POINTER TO FIRST CHARACTER
	SETO	I,
	ADJBP	I,A			;MAKE ILDB POINTER TO FIRST CHAR IN I
	MOVE	A,OU			;LIKEWISE GET IDPB POINTER TO
					; LEFTMOST DESTINATION CHARACTER
	CALL	ADDPTR
	SETO	OU,
	ADJBP	OU,A			;NOW OU HAS IDPB POINTER TO DESTINATION
	CALLRET	MVSTR			;MOVE REST OF STRING

;MOVE STRING
; I/ SOURCE BYTE PTR
; OU/ DEST BYTE PTR
; p1/ COUNT
;RETURNS WITH I AND OU UPDATED SUCH THAT SUBSEQUENT CALL WITH NEW COUNT
;IN P1 WOULD JUST "CONTINUE" COPYING.
;THIS SIMULATES AN ILDB/IDPB/SOJG LOOP IF DESTINATION IS TO LEFT OF SOURCE
;IF DESTINATION IS TO RIGHT OF SOURCE, THE SOURCE IS MOVED STARTING
;WITH ITS RIGHTMOST END, HENCE DOING THINGS LIKE SLIDING A LONG STRING
;A FEW CHARACTERS TO THE RIGHT WORKS.  NOTE THAT THE I, OU, AND P1 YOU
;SHOULD CALL MVSTR WITH ARE ALWAYS FOR ILDB/IDPB/SOJG REGARDLESS OF
;CURRENT FLOW.  JUST LEAVE THE DRIVING TO US... BUT YOUR PRAYERS COULDN'T
;HURT

MVSTR:	STKVAR	<RETOU,RETI>
	TLC	I,-1			;IF -1 IN LEFT HALF, THEN 0 THERE NOW
	TLCN	I,-1			;RESTORE LEFT HALF TO ORIGINAL AND
					; SKIP IF WASN'T -1 ORIGINALLY
	HRLI	I,(POINT 7)		;WAS -1 SO MAKE IT 440700
	TLC	OU,-1
	TLCN	OU,-1
	HRLI	OU,(POINT 7)
	MOVE	A,P1			;GET COUNT
	ADJBP	A,OU			;CALCULATE UPDATED POINTER
	MOVEM	A,RETOU
	MOVE	A,P1
	ADJBP	A,I			;DO BOTH POINTERS
	MOVEM	A,RETI
	CALL	MVSTWK			;DO THE WORK
	MOVE	OU,RETOU
	MOVE	I,RETI
	RET

MVSTWK:	JUMPLE	P1,CPOPJ		;RETURN NOW IF NO CHARACTERS TO MOVE
	STKVAR	<ARGI,ARGOU>
	MOVEM	I,ARGI			;SAVE ARGS
	MOVEM	OU,ARGOU
	MOVEM	P1,STRLEN
	MOVE	TT,I			;GET CHARACTER ADDRESSES OF ARGS
	IBP	TT			;WE WANT ADDRESS OF BEGINNING OF SOURCE
	MOVEM	TT,SRCBPT		;REMEMBER WHERE SOURCE STARTS
	CALL	PTRXAD			;MAKE CHARACTER ADDRESS
	MOVEM	I,SRCBEG
	MOVE	TT,ARGOU
	IBP	TT
	MOVEM	TT,DESBPT		;REMEMBER WHERE DESTINATION STARTS
	CALL	PTRXAD
	MOVEM	I,DESBEG
	MOVE	I,SRCBEG
	CAMN	I,DESBEG		;DOING MUCH MOVING AT ALL?
	RET				;NO, NONE AT ALL
	ADD	I,STRLEN		;GET RIGHTMOST CHAR ADDRESS OF SOURCE
	MOVEM	I,SRCEND		;REMEMBER CHARACTER ADDRESS JUST TO RIGHT
					; OF SOURCE
	CALL	GET1			;GET BYTE POINTER TO JUST TO RIGHT OF SOURCE
	MOVEM	TT,SRCEPT
	MOVE	I,DESBEG
	ADD	I,STRLEN
	MOVEM	I,DESEND		;REMEMBER END OF DESTINATION
	CALL	GET1			;GET BYTE PTR TO JUST TO RIGHT OF DESTINATION
	MOVEM	TT,DESEPT
	MOVE	A,DESBEG
	CAML	A,SRCBEG
	CAML	A,SRCEND
	 SKIPA	I,ARGI			;IT'S SAFE TO ILDB/IDPB/SOJG
	JRST	MVSTX			;ILDB/IDPB/SOJG WOULD CLOBBER CERTAIN BYTES
					; WITH IDPB BEFORE THEY GOT ILDB'D !
	MOVE	OU,ARGOU		;LEAVE ARGS AS GIVEN TO US

MVST1:	ILDB	CH,I			;MOVE ONE CHAR
	IDPB	CH,OU
	SOJLE	P1,CPOPJ		;RETURN IF COUNT DONE
	TLNE	OU,(74B5)		;DEST NOW AT WORD BOUNDARY?
	JRST	MVST1			;NO, DO ANOTHER CHAR
	CAIGE	P1,^D20			;AT LEAST 20 CHARS TO DO?
	JRST	MVST1			;NO, NOT WORTH SETTING UP WORD MOVE
	MOVE	TT,P1			;YES, SETUP FOR FULL WORD MOVE
	IDIVI	TT,5			;COMPUTE NUMBER FULL WORDS TO MOVE
	MOVEM	TT1,P1			;SAVE REMAINDER OF CHARACTERS
	LDB	T,[POINT 6,I,5]		;GET SOURCE "P" FIELD
	CAIN	T,1			;SOURCE ALSO ON WORD BOUNDARY?
	JRST	MVST4			;YES, GO DO BLT
	MOVN	P2,T
	SUBI	T,1			;T = P-1
	ADDI	P2,^D36			;p2 = 36-P
	ADDM	TT,I			;UPDATE PTRS FOR FULL WORDS MOVED
	ADDM	TT,OU
	MOVNM	TT,C			;SETUP NEG COUNT FOR LOOP
	MOVEI	B,1(P)			;GET ADDRESS OF NEXT FREE STACK WORD
	ADD	P,[NMVLP,,NMVLP]	;ALLOCATE STACK SPACE FOR LOOP
	MOVSI	A,MVLP			;COPY MOVE LOOP ONTO STACK
	HRR	A,B
	BLT	A,0(P)
	HRRZ	A,I			;FILL IN SOURCE ADR 
	HRRM	A,MVLP0(B)
	HRRZ	A,OU			;FILL IN DESR ADR
	HRRM	A,MVLPA(B)
	HRRM	B,MVLPC(B)		;FILL IN LOOP ADR TO AOJL
	MOVE	A,MVLP0(B)		;GET MOVE INSTRUCTION
	TLZ	A,(17777B12)		;CLEAR BITS 0-12
	TLO	A,(IFIW)		;COMPOSE LOCAL INDIRECT WORD
	MOVE	A,@A			;GET FIRST (PARTIAL) SOURCE WORD
	LSH	A,-1			;RIGHT JUSTIFY IT
	JRST	MVLPC(B)		;JUMP INTO LOOP

;FULL-WORD CHARACTER MOVE LOOP - MOVED ONTO STACK AND ADDRESSES FILLED IN

MVLP:	PHASE	0
MVLP0:	MOVE	B,.-.(C)		;GET FIRST PART OF SOURCE WORD
	ROTC	A,0(P2)			;SHIFT LEFT TO COMPLETE DEST WORD
	LSH	A,1			;LEFT JUSTIFY DEST CHARS
MVLPA:	MOVEM	A,.-.(C)		;STORE DEST WORD
	ROTC	A,0(T)			;SHIFT IN REMAINDER OF SOURCE WORD
MVLPC:	AOJLE	C,.-.			;COUNT WORDS AND LOOP
	JRST	MVST2			;LOOP DONE, JUMP OFF STACK
	DEPHASE
NMVLP==.-MVLP				;NUMBER OF WORDS IN LOOP

;LOOP RETURNS HERE FROM STACK WHEN DONE

MVST2:	SUB	P,[NMVLP,,NMVLP]	;CLEAR STACK
	JUMPG	P1,MVST1		;IF ANY CHARS REMAINING, GO DO THEM
	RET

;BLT CASE - SOURCE AND DEST ARE ALIGNED

MVST4:	HRLZ	A,I			;GET SOURCE ADR
	HRR	A,OU			;GET DESR ADR
	ADD	A,[1,,1]		;MAKE BOTH POINT TO FIRST WORD
	ADDM	TT,I			;UPDATE SOURCE PTR FOR FULL WORDS MOVED
	ADDM	TT,OU			;UPDATE DEST PTR FOR FULL WORDS MOVED
	HRRZ	TT,OU			;GET LOCAL ADDRESS OF LAST WORD
	BLT	A,0(TT)			;MOVE WORDS UNTIL LAST WORD OF DEST
	JUMPG	P1,MVST1		;IF ANY CHARS REMAINING, GO DO THEM
	RET

;GET HERE WHEN SLIDING A STRING TO THE RIGHT.

MVSTX:	MOVE	P1,DESEND		;GET ADDRESS TO RIGHT OF DESTINATION
	IDIVI	P1,5			;SEE HOW CLOSE TO WORD BOUNDARY WE ARE
MVSTX1:	JUMPE	P2,MVSTX2		;WE'RE ON WORD BOUNDARY
	CALL	DOBBYT			;TRANSFER ONE BYTE
	SKIPN	STRLEN			;SHOW REFLECTION OF ENTIRE LENGTH
	RET				;LENGTH EXHAUSTED, WE'RE ALL DONE
	SOJA	P2,MVSTX1		;LOOP UNTIL DESTINATION ENDS ON WORD BOUNDARY
MVSTX2:	MOVE	A,STRLEN		;SEE HOW MANY CHARACTERS TO DO
	CAIGE	A,5			;AT LEAST ON WORD'S WORTH IN DESTINATION?
	JRST	MVSTX3			;NO
	MOVE	A,SRCEND		;SEE WHERE SOURCE ENDS
	IDIVI	A,5
	JUMPE	B,BAKBLT		;JUMP IF DESTINATION AND SOURCE ARE ON
					; WORD BOUNDARIES
	MOVE	A,SRCEND
	IDIVI	A,5			;SEE WHERE IN WORD IT IS
	SUBI	B,5
	IMULI	B,7			;GET MINUS BITS RIGHT TO SHIFT TO WORD ALIGN
					; WITH DESTINATION
	HRRM	B,MAKE5			;REMEMBER FOR FAST LOOP
	ADDI	B,^D35
	MOVN	B,B			;GET MINUS BITS RIGHT TO SHIFT TO
					; REALIGN WITH SOURCE
	HRRM	B,RESIDU
	MOVE	A,STRLEN
	IDIVI	A,5			;GET NUMBER OF FULL DESTINATION
					; WORDS TO BE WRITTEN
	MOVEM	A,WCNTB
	MOVE	A,DESEND
	SOJ	A,			;GET RIGHTMOST ADDRESS OF DESTINATION
	IDIVI	A,5			;RIGHTMOST WORD ADDRESS
	SUB	A,WCNTB			;TIGHT LOOP ADDS WCNTB
	HRRM	A,SETDES		;SAVE FOR STORING DESTINATION
	MOVE	A,SRCEND
	SOJ	A,			;SRCEND IS ONE CHARACTER TO RIGHT
	IDIVI	A,5			;GET SOURCE WORD ADDRESS
	MOVE	B,(A)			;PRIME LOOP WITH FIRST SOURCE WORD
	SOJ	A,			;RIGHTMOST SOURCE ADDRESS
	SUB	A,WCNTB			;OFFSET SOURCE WORD ADDRESS BECAUSE LOOP
					; INDEXES BY C
	HRRM	A,GETSRC		;FIX TIGHT LOOP FETCH ADDRESS
	MOVE	C,WCNTB			;C TELLS HOW MANY WORDS TO DO
	CALL	MBLUP			;DO THE TIGHT LOOP
MVSTX4:	MOVE	A,WCNTB
	IMULI	A,5			;NUMBER OF CHARACTERS WE DID IN A
	MOVN	B,A			;NEGATIVE NUMBER IN B
	ADJBP	B,SRCEPT		;UPDATE NEW END OF SOURCE
	MOVEM	B,SRCEPT
	MOVN	B,A
	ADJBP	B,DESEPT		;UPDATE NEW END OF DESTINATION
	MOVEM	B,DESEPT
	MOVN	B,A			;GET NEGATIVE NUMBER OF CHARACTERS DONE
	ADDM	B,STRLEN		;UPDATE NUMBER LEFT TO DO
MVSTX3:	SKIPN	STRLEN			;ANY MORE CHARACTERS TO DO?
	RET				;NO, ALL DONE
	CALL	DOBBYT			;YES, DO ONE
	JRST	MVSTX3			;LOOP FOR REST

;IF SOURCE AND DESTINATION BOTH ARE ON WORD BOUNDARIES, AND THERE'S
;AT LEAST ONE WORD TO DO, COME HERE TO DO IT.  THIS WOULD BE A BLT
;CASE IF A BACKWARDS BLT WERE AVAILABLE.

BAKBLT:	MOVE	A,STRLEN		;SEE HOW MANY CHARACTERS LEFT TO DO
	IDIVI	A,5			;SEE HOW MANY WORDS
	MOVEM	A,WCNTB			;REMEMBER
	MOVE	A,SRCEND
	SOJ	A,
	IDIVI	A,5			;GET RIGHTMOST WORD ADDRESS OF SOURCE
	SUB	A,WCNTB			;LOOP ADDS COUNT TO ADDRESS
	HRRM	A,BBS			;SET UP FETCH IN LOOP
	MOVE	A,DESEND
	SOJ	A,
	IDIVI	A,5			;GET RIGHTMOST WORD ADDRESS OF DESTINATION
	SUB	A,WCNTB
	HRRM	A,BBD
	MOVE	C,WCNTB			;LOAD COUNTER WITH NUMBER OF WORDS TO DO
	CALL	BBL			;DO THE BACKWARDS BLT LOOP
	JRST	MVSTX4			;GO UPDATE COUNTS AND FINISH NIBBLINGS

;ROUTINE TO DO ONE BYTE

DOBBYT:	SOS	SRCEND			;WE'RE DOING A BYTE, SO SHRINK
					; SOURCE END ADDRESS
	HRROI	TT,-2
	ADJBP	TT,SRCEPT		;GET MODIFIED PTR TO JUST BEFORE END OF SOURCE
	ILDB	CH,TT			;GET THE BYTE
	MOVEM	TT,SRCEPT		;REMEMBER NEW END OF SOURCE POINTER
	HRROI	TT,-2
	ADJBP	TT,DESEPT		;GET POINTER TO DESTINATION
	IDPB	CH,TT			;STORE THE BYTE
	MOVEM	TT,DESEPT		;UPDATE DESTINATION END POINTER
	SOS	DESEND			;UPDATE DESTINATION END ADDRESS
	SOS	STRLEN			;SHOW DECREASE IN NUMBER LEFT TO DO
	RET
;ROUTINE TO RETURN IN CH THE CHARACTER TO THE RIGHT OF THE POINTER
;AND INCREMENT THE POINTER.
;CALL MOVE I,POINTER (AS A CHARACTER ADDRESS)
;	CALL GETINC
;	RETURN WITH CHARACTER IN CH AND POINTER TO CHARACTER IN I.

GETINC:	CALL	GET
	AOJA	I,CPOPJ

;CHANGE CHARACTER ADDRESS INTO BYTE POINTER

ADDPTR:	IDIVI	A,5			;DIVIDE BY BYTES PER WORD
	HLL	A,BTAB(B)		;CHOOSE CORRECT LEFT HALF
	RET

;"GET" TAKES CHARACTER ADDRESS IN I, RETURNS BYTE POINTER TO CHARACTER
;IN TT, CHARACTER IN CH.  KNOWS ABOUT THE HOLE AND HOW TO AVOID IT.

GET:	CALL	GETX			;GET BYTE POINTER
	LDB	CH,TT
	RET

;GETX IS LIKE "GET", BUT DOESN'T REFERENCE THE MEMORY POINTED TO
;BY THE CONSTRUCTED BYTE POINTER

GETX:	PUSH	P,I			;SAVE CHARACTER ADDRESS ARG
	CAML	I,HOLBEG		;ARE WE TO LEFT OF HOLE?
	ADD	I,HOLSIZ 	;NO, SO MODIFICATION NECESSARY TO GET OUT OF HOLE
	CALL	GET2
	POP	P,I			;DON'T CLOBBER USER'S I
	RET

;GET1 IS LIKE GETX, BUT DOESN'T CHECK FOR WHETHER WE'RE IN HOLE OR
;NOT

GET1:	CALL	GET2
	RET

GET2:	MOVE	TT,I
	IDIVI	TT,5
	HLL	TT,BTAB(TT1)
	RET

PUT:	CALL	PUT2
	DPB	CH,TT
	RET

PUT2:	MOVE	TT,OU
	IDIVI	TT,5
	HLL	TT,BTAB(TT1)
	RET

;ROUTINE TO SUPPORT ULDB AND UILDB UUO'S, WHICH ARE EXACTLY LIKE
;LDB AND ILDB INSTRUCTIONS, EXCEPT THAT IF THE HOLE IN THE BUFFER IS
;REFERENCED, IT IS PASSED OVER.

%LDB:	HRRZ	A,UUOB+.AREFA		;GET ADDRESS OF BYTE POINTER
	CAIGE	A,20			;IS IT IN AN AC?
	ADDI	A,UUOACS		;YES, SO POINT TO SAVED AC BLOCK
	CAIN	TT,<UILDB>_-^D27	;ARE WE SUPPOSED TO INCREMENT POINTER?
	IBP	(A)			;YES
	MOVE	TT,(A)			;GET BYTE POINTER
	CAMN	TT,HOLBPT		;MAKE SURE WE'RE NOT IN HOLE
	MOVE	TT,HOLEPT		;WE ARE, GET OUT
	LDB	CH,TT			;GET THE DATA
	MOVEM	TT,(A)			;STORE RESULTANT POINTER
	LDB	A,[POINT 4,UUOB+.ARPFL,30];GET AC FIELD OF LUUO
	MOVEM	CH,UUOACS(A)		;STORE DATA (SECOND, SO UILDB T,T WINS)
	RET				;ALL DONE

;ROUTINE TO CHANGE BYTE POINTER TO CHARACTER ADDRESS.  GIVE IT THE
;BYTE POINTER IN TT, IT RETURNS THE ADDRESS IN I.  THE ADDRESS GIVEN
;IS AS IF THERE WERE NO HOLE IN THE BUFFER.  THAT IS, IF CHARACTER
;ADDRESS BEFORE DOING THE "AS IF" IS REAL LARGE, I.E. TO RIGHT OF
;HOLE, IT IS ADJUSTED LEFT.

PTR2AD:	CALL	PTRXAD			;FIRST DO RAW WORK, THEN WE'LL WORRY ABOUT HOLE
	CAML	I,HOLBEG		;ARE WE TO LEFT OF HOLE?
	SUB	I,HOLSIZ		;NO, SO ADJUSTMENT NECESSARY
	RET

;ROUTINE TO TAKE BYTE POINTER IN TT AND TRANSFORM IT INTO A CHARACTER
;ADDRESS, WHICH IS RETURNED IN I.  NO AC'S ARE CHANGED EXCEPT, OF COURSE, I.

PTRXAD:	PUSH	P,A
	PUSH	P,B
	HRRZ	I,TT			;CHANGE BYTE POINTER TO CHARACTER ADDRESS
	IMULI	I,5			;5 CHARACTERS PER WORD.
	LDB	A,[360600,,TT]
	IDIV	A,[-7]			;DIVIDE P FIELD FOR NUMBER OF CHARS OVER IN WORD
	ADDI	I,4(A)			;ADD CHARACTER REMAINDER TO CHARACTER ADDRESS
	POP	P,B
	POP	P,A
	RET

;CHARACTER TRANSLATION BYTE POINTER TABLE
;TRANSLATES 1 CHARACTER POSITION TO THE RIGHT
;OF A CHARACTER ADDRESS POINTER

	XWD 440700,0
BTAB:	XWD 350700,0
	XWD 260700,0
	XWD 170700,0
	XWD 100700,0
	XWD 10700,0
;ROUTINE TO CREATE THE HOLE.  IT GETS CALLED WHEN BUFFER IS BEING
;COMPLETELY CLEARED.

MAKHOL:	MOVE	A,BEG			;HOLE IS INITIALLY LOCATED AT BEGINNING
	MOVEM	A,HOLBEG		;REMEMBER WHERE HOLE BEGINS
	MOVX	A,EMTBUF*5		;GET ADDRESS JUST BEYOND END OF HOLE
	MOVEM	A,HOLEND
	CALL	SETHPT
	RET

;ROUTINE TO MOVE THE HOLE.  CALL IT WITH DESIRED CHARACTER ADDRESS
;IN A.  THE HOLE WILL BE MOVED SUCH THAT ARG IN A IS FIRST CHARACTER
;OF HOLE.  HENCE CALLING IT WITH 0 PUTS HOLE AT BEGINNING OF BUFFER.

MOVHOL:	STKVAR	<DISTAN,NEWBEG,NEWEND>
	MOVEM	A,NEWBEG		;REMEMBER WHERE HOLE'S GOING TO
	SUB	A,HOLBEG		;CALCULATE DISTANCE
	MOVEM	A,DISTAN		;REMEMBER DISTANCE
	MOVE	A,HOLEND
	SUB	A,HOLBEG		;GET SIZE OF HOLE
	ADD	A,NEWBEG		;ADD BEGINNING TO GET NEW END
	MOVEM	A,NEWEND		;STORE NEW END
	MOVE	A,DISTAN		;GET DISTANCE
	JUMPL	A,MOVLFT		;JUMP OFF IF MOVING HOLE LEFT
	MOVE	I,HOLEND		;GET OLD END OF HOLE
	MOVE	OU,HOLBEG
	MOVE	P1,DISTAN		;GET NUMBER OF CHARACTERS NECESSARY TO MOVE
	CALL	MVCST			;MOVE DATA IN BUFFER TO RELOCATE THE HOLE
MOVDON:	MOVE	A,NEWBEG
	SUB	A,HOLBEG		;SEE HOW FAR RIGHT WE MOVED IT
	ADDM	A,HOLEND		;MARK NEW END OF HOLE
	MOVE	A,NEWBEG
	MOVEM	A,HOLBEG		;REMEMBER NEW LOCATION OF HOLE
	CALL	SETHPT
	RET

;FOLLOWING CODE FOR CASE WHERE HOLE IS BEING MOVED "LEFT".

MOVLFT:	MOVE	I,NEWBEG		;MOVE DATA FROM NEW LOCATION OF BEGIN OF HOLE
	MOVE	OU,NEWEND		;TO NEW END OF HOLE
	MOVM	P1,DISTAN		;GET POSITIVE NUMBER OF CHARACTERS TO MOVE
	CALL	MVCST			;MOVE DATA AROUND TO REPOSITION HOLE
	JRST	MOVDON			;RESET HOLE LOCATION AND RETURN

;ROUTINE TO UPDATE HOLBPT AND HOLEPT TO CONTAIN BYTE POINTER VERSIONS
;OF HOLBEG AND HOLEND.  THIS ALLOWS MORE EFFICIENT HOLE BOUNDARY
;AVOIDANCE, AS POINTERS NEEDN'T BE CHANGED TO CHARACTERS ADDRESSES TO
;BE CHECKED.

SETHPT:	STKVAR	<SAVI,SAVTT>
	MOVEM	I,SAVI
	MOVEM	TT,SAVTT
	MOVE	I,HOLBEG		;GET BEGINNING ADDRESS
	CALL	GET1			;CONVERT TO POINTER
	MOVEM	TT,HOLBPT		;STORE POINTER
	MOVE	I,HOLEND		;GET END OF HOLE ADDRESS
	CALL	GET1			;CONVERT TO POINTER
	MOVEM	TT,HOLEPT		;STORE ENDING POINTER
	MOVE	A,HOLEND
	SUB	A,HOLBEG
	MOVEM	A,HOLSIZ		;STORE HOLE'S SIZE
	MOVE	I,SAVI
	MOVE	TT,SAVTT
	RET

;ROUTINE TO SAY HOW MANY CHARACTERS MORE THE BUFFER CAN HOLD
;RETURNS THE RESULT IN A.

NFREE:	MOVE	A,HOLSIZ		;SOMEWHERES AROUND THE SIZE OF THE HOLE
	SUBI	A,^D35			;NEED ROOM FOR STRINGS BEING SEARCHED FOR
	SUBI	A,5			;NEED ROOM FOR MATCH IN SEARCHES
	RET

NFREER:	CALL	NFREE
	TXNE	FF,ARG
	SUB	A,C
	JRST	ARGINA

;WHEN READING IN A FILE, CALL FILFRE INSTEAD OF NFREE SO THAT SOME
;INSERTS MAY BE DONE AFTER THE FILE IS READ IN

FILFRE:	CALL	NFREE			;GET ACTUAL SPACE AVAILABLE
	SUBI	A,1000			;LEAVE SOME ROOM FOR INSERTS
	RET
;GARBAGE COLLECTION.  REMOVE FROM QREG BUFFER AREA ANY
;STRINGS NO LONGER IN USE, I.E. FOR WHICH NO POINTERS
;CAN BE FOUND.
;THIS ALSO CLEARS THE TAG CACHE
QGC:	MOVEM	16,ACNR+16
	MOVEI	16,ACNR
	BLT	16,ACNR+15		;SAVE AC'S
	CALL	GC			;DO THE WORK
	MOVSI	16,ACNR			;RESTORE ACS
	BLT	16,16
	RET

GC:	MOVEI	T,100
	MOVEM	T,GCCNT			;NUMBER OF X'S TO DO BEFORE NEXT GC
	SETOM	GCPTR			;YES. GCPTR:=-1
	CLEARM	SYMS			;CLEAR SYMS,VALS AND CNTS TABLES
	MOVE	T,[XWD SYMS,SYMS+1]
	BLT	T,SYMEND
	MOVEI	T,CPTR			;COMMAND BUFFER
	CALL	GCMA
	HRRZ	T,P
	CAIL	T,PDL			;PUSHDOWN LIST EMPTY?
	CALL	GCMA			;NO. GARBAGE COLLECT ALL BYTE POINTERS
	CAILE	T,PDL
	SOJA	T,.-2
	HRRZ	T,PF			;COLLECT QREG PDL
	CAIL	T,PFL
	CALL	GCM
	CAILE	T,PFL
	SOJA	T,.-2
	MOVE	T,[XWD -44,QTAB]	;GARBAGE COLLECT Q-REGISTERS.
	CALL	GCM
	AOBJN	T,.-1
	MOVE	T,[XWD -USARYL,USRARY] 	;CHECK IT FOR STRINGS
	CALL	GCM			;LOOP THROUGH THE ENTRIES
	AOBJN	T,.-1
	 	;..
;COMPACT QREG STRING STORAGE AREA

	;..
	MOVE	I,QRBUF			;I WILL CONTAIN NEXT FREE ADDRESS TO USE

;FIND STRING WITH LOWEST ADDRESS IN AREA

GCS1A:	MOVE	TT,EQRBUF		;END OF PRESENT QREG AREA
	SKIPGE	OU,GCPTR		;SETUP TO SCAN GCTAB - EMPTY?
	JRST	GCS21			;YES
GCS1:	MOVE	A,GCTAB(OU)		;GET ADR OF STRING FOUND ABOVE
	ADD	A,QRBUF
	CAMGE	A,I			;PTR ABOVE AREA ALREADY DONE?
	JRST	GCS2			;NO, NOT INTERESTED
	CAMGE	A,TT			;THIS LOWEST PTR IN GC AREA?
	MOVE	TT,A			;YES, REMEMBER IT
GCS2:	SOJGE	OU,GCS1
GCS21:	CAML	TT,EQRBUF		;IS LOWEST PTR WITHIN QREG AREA?
	JRST [	MOVEM I,EQRBUF		;NO, UPDATE FINAL END OF ACTIVE STUFF
		RET]

;HAVE FOUND A STRING, MOVE IT AND EVERYTHING AFTER IT DOWN TO
;LOWEST FREE ADDRESS.

	MOVE	A,TT			;ADDRESS OF STRING
	IDIVI	A,5			;COMPUTE WORD ADR OF BEG OF STRING
	MOVE	B,I
	IDIVI	B,5			;COMPUTE WORD ADDRESS OF BEG OF FREE SPACE
	SKIPE	C			;DOES FREE AREA START ON WORD BOUNDARY?
	AOS	B			;NO, SKIP PARTIAL WORD
	HRLZ	OU,A			;SETUP SOURCE FOR BLT
	MOVE	T,A
	SUB	T,B			;COMPUTE DISTANCE OF MOVE
	JUMPLE	T,GCS4A			;JUMP IF ALREADY IN RIGHT PLACE
	HRR	OU,B			;SETUP DEST FOR BLT
	MOVE	C,EQRBUF		;EQRBUF IS END OF SOURCE
	IDIVI	C,5			;SETUP FINAL DEST FOR BLT
	SUB	C,T			;I.E. FINAL SOURCE MINUS DISTANCE
	BLT	OU,0(C)			;MOVE STUFF DOWN
	MOVNS	OU,T			;GET NEG DISTANCE
	IMULI	OU,5			;IN TERMS OF CHARACTERS
	ADDM	OU,EQRBUF		;UPDATE AREA END ADDRESS
	ADDM	OU,RREL			;RREL:=p1(RREL)-5*NREG
	MOVE	CH,GCPTR		;UPDATE INSERTER
GCS3:	MOVE	A,GCTAB(CH)		;GET STRING ADR
	ADD	A,QRBUF
	CAMGE	A,TT
	JRST	GCS4
	ADDM	OU,GCTAB(CH)		;RELOCATE PTR
	MOVE	A,GCTAB2(CH)		;GET ADR WHERE PTR WAS LIVING
	SKIPL	TT1,0(A)
	TLNN	TT1,777700
	JRST [	ADDM OU,0(A)		;RELOCATE CHAR PTR
		JRST GCS4]
	ADDM	T,0(A)			;RELOCATE BYTE POINTER
GCS4:	SOJGE	CH,GCS3			;DONE?
	ADD	TT,OU			;YES. I:=p1(TT)-5*NREG

GCS4A:	MOVE	I,TT			;SHOULD POINT TO BEG OF STRING FLAG (141)
	CALL	GETINC
	CAIE	CH,141
GCERR:	IERROR <GC error>
	CALL	GETINC
	MOVE	A,CH
	CALL	GETINC
	LSH	A,7			;GET COUNT OF STRING
	IOR	A,CH
	CALL	GETINC
	LSH	A,7
	IOR	A,CH
	ADD	I,A
	SUBI	I,4			;CORRECT FOR 4 OVERHEAD CHARS
	JRST	GCS1A
;MARK ACTIVE QREG STRING
; T/ ADDRESS OF QREG STRING PTR

GCM:	MOVE	I,(T)
	TLZE	I,400000		;DOES Q-REG CONTAIN TEXT?
	TLZE	I,377770
	RET				;NO
	ADD	I,QRBUF			;YES. ENTER POINTER IN GCTAB

GCM2:	CAML	I,EQRBUF		;IN QREG BUFFER?
	RET				;NO. FORGET IT.
	CALL	GET			;YES. CHECK FOR MARK.
	CAIE	CH,141			;END OF STRING?
	RET				;NO.
GCM3:	SUB	I,QRBUF			;YES. I:=# CHARACTERS TO RETREIVE.
	AOS	TT,GCPTR		;YES. TO BE GRABBED.
	CAIL	TT,GCTBL		;AM IN WINNING?
	JRST	GCERR			;NO. VERY BAD.
	MOVEM	I,GCTAB(TT)		;SAVE CHAR ADR
	MOVEM	T,GCTAB2(TT)		;SAVE WHERE IT LIVES
	RET

;MARK ACTIVE BYTE PTR, I.E. CPTR AND SAVED CPTR'S WHILE IN MACROS.
; T/ ADDRESS OF BYTE PTR
;ASSUMED: ADDRESS-1 CONTAINS TOTAL COUNT (COMAX), ADDRESS+1
;CONTAINS REMAINING COUNT (COMCNT).

GCMA:	MOVE	I,0(T)
	LDB	TT,[POINT 12,I,17]	;BYTE SIZE + XR
	CAIE	TT,700			;DOES T PT TO A TEXT BYTE PTR?
	RET				;NO
	LDB	TT,[POINT 6,I,5]	;BYTE POSITION
	IDIVI	TT,7			;NO. OF CHARACTERS
	HRRZI	I,1(I)			;BYTE PTR ADDR +1
	IMULI	I,5
	SUBI	I,4(TT)			;A MAGIC NUMBER
	ADD	I,1(T)			;CT (WE HOPE)
	SUB	I,-1(T)			;MAX
	JRST	GCM2
WRDCOM:	STKVAR	<BEGWRD>
	MOVE	A,CPTR			;GET POINTER TO BEGINNING OF WORD
	MOVEM	A,BEGWRD		;REMEMBER
WRD1:	CALL	SKRCH			;PICK UP LETTER OF WORD FROM COMMAND STRING
	CAME	CH,TERMIN		;END OF WORD FROM COMMAND STRING?
	JRST	WRD1			;NO, KEEP LOOKING
	SETZ	A,
	DPB	A,CPTR			;ISOLATE WORD BY PUTTING NULL AT END
	MOVEI	A,WORDS			;TELL SYSTEM WHERE TABLE IS
	MOVE	B,BEGWRD		;GET POINTER TO WORD
	TBLUK%				;LOOK UP THE WORD
	MOVE	D,TERMIN
	DPB	D,CPTR			;FIX THE COMMAND STRING
	TXNE	B,TL%AMB		;GIVE APPROPRIATE ERROR IF FAILURE
	ERROR <Ambigious partial command>
	TXNE	B,TL%NOM
	ERROR <Undefined command word>
	HRRZ	B,(A)			;GET ADDRESS OF DATA BLOCK
	MOVE	A,(B)			;GET FLAGS
	MOVE	C,FARG			;[502] JUST GET THE ARG
	JRST	@1(B)			;GO EXECUTE THE COMMAND

;WLIST$ - LIST ALL THE DEFINED WORDS

WRDLST:	CALL	WINCLS			;THIS IS PRESERVED OUTPUT.
	MOVSI	CH,-WLEN		;AOBJN WORD OF SORTS
	MOVE	I,SWIDTH		;WHAT DO WE THINK THE WIDTH IS?
	SUBI	I,21			;LESS ABOUT 2 TAB STOPS
	MOVEM	I,SYL			;WE STOP IF WE WOULD TAB TO HERE
	SETZ	I,			;I IS POSITION ON LINE, START AT BEGINNING
WRDLS1:	HLRZ	C,WORDS+1(CH)		;(466)GET ADDRESS OF WORD NAME
	UPSTR	@C			;TYPE OUT WORD
	AOBJP	CH,WRDELX		;IF THATS THE LAST WORD, LEAVE LOOP NOW
	SETZ	A,			;NO, MUST COUNT # CHARACTERS TYPED
	HRLI	C,(POINT 7)		;READ EACH CHARACTER WE TYPED
WRDLSC:	ILDB	B,C			;..
	CAIE	B,0			;AT END OF STRING?
	AOJA	A,WRDLSC		;NO, ADD ONE TO COUNT AND COUNT ON
	TRZ	A,7			;CONVERT TO TABS STOPS-1
	JUMPG	A,WRDLS3		;IF 10 OR MORE CHARACTERS, GO
	MOVEI	B,1			;NO, NEED 2 TABS, NOT 1
	MOVEI	A,10			;AND ACCOUNT FOR TYPED TAB
WRDLS3:	ADDI	I,10(A)			;IF TABS TYPED, WE ARE AT CHARACTER LOC (I)
	CAML	I,SYL			;AT/PAST MAX FOR THIS LINE?
	JRST [	SETZ I,			;YES, CLEAR COUNT
		CALL CRR		;AND START AN NEW LINE
		JRST WRDLS1]		;AND GO GET NEXT WORD
WRDTBO:	CTYPE <	>			;TYPE TAB
	SOJGE	B,WRDTBO		;MIGHT NEED ANOTHER ONE
	JRST	WRDLS1			;[502] DONE

WRDELL:	TXNN	FF,ARG
WRDELX:	SETZM	FARG
WRDEL1:	CALL	CRR
	SOSLE	FARG
	JRST	WRDEL1
	JRST	CFLUSH

PRESCR:	MOVE	A,WINFLG		;MIGHT WANT WINFLG RETURNED
	CAILE	A,0			;IF .GT. 0...
	SETZ	A,			;RETURN 0
	TXNN	FF,ARG			;TAKE OR RETURN?
	JRST	ARGINA			;RETURN
	CAIGE	C,0			;TAKE. IF C .LT. 0,...
	SETO	C,			;SET TO -1
	MOVEM	C,WINFLG		;STORE
	JRST	CFLUSH			;AND DONE

;W COMMAND DISPATCH TABLE.  W STANDS FOR WORD AND MAY APPEAR IN THE
;COMMAND STRING FOLLOWED BY A UNIQUE WORD OR PARTIAL WORD.

DEFINE WORD (A,C,FLAGS<0>)<[ASCIZ /A/],,[EXP FLAGS,IFIW!C]>

;**; [502] At WORDS:, remove references to flags CH%TOR SM	4-Mar-82
;CURRENTLY DEFINED WORD COMMANDS:
WORDS:	WLEN,,WLEN
	WORD AUTO-EXPUNGE,AUTO		;AUTO-EXPUNGE WHEN OVER QUOTA
	WORD BACKUP,BACKUP		;TURN ON COMMAND SAVING
	WORD CLEOS,CEOS			;CLEAR TO END OF SCREEN
	WORD CRLF,WRDELL		;TYPE A CRLF (NOT PRESERVED)
	WORD DATE-AND-TIME,WDATIM 	;INSERT CURRENT DATE AND TIME
	WORD EDITBASIC,EBASIC		;DON'T FILTER OUT LINE #'S.
	WORD EDITREGULAR,ERGLR		;FILTER LINE NUMBERS AS USUAL.
 OPTION ENC,<
	WORD ENCRYPT,ENCPT		;TURN ENCRYPTION FLAG ON/OFF
>
	WORD ENTER,ENTFVR		;RETURN ENTER FLAG
 IFG MAXSEC,<
	WORD FETCH-BUFFER,CIN		;RESTORE TV STATE
>
	WORD FILENAME,WFILEN		;LAST FILENAME IN COMMAND
	WORD FLAGUPPERS,FLAGU		;FLAG CAPITALS
 IFG MAXSEC,<
	WORD FREE-BUFFER,CDEL		;GO DELETE BUFFER
>
	WORD HOLE,WHOLE			;RETURN LOC OF INTERNAL HOLE
	WORD LIBRARY,WLIBR		;LOAD Q-REGS FROM A FILE
	WORD LIST,WRDLST		;LIST ALL THE DEFINED WORD
	WORD NOAUTO-EXPUNGE,NOAUTO 	;DON'T AUTO-EXPUNGE WHEN OVER QUOTA
	WORD NOBACKUP,NOBACK		;TURN OFF COMMAND SAVING
	WORD NOFLAG,NOFLAG		;DON'T FLAG ANY LETTERS
	WORD NOSHIFT,NSHIFT		;DON'T SHIFT INPUT
	WORD PERUSE,WPERUS		;GET/SET/CLEAR PERUSE BIT
	WORD PRESERVE,PRESCR		;SET UP TO PRESERVE SCREEN OUTPUT
	WORD RAISE,TERRAS		;RAISE INPUT LETTERS
	WORD SAVLEN,BETSAV		;GET/SET # CHARS TO INPUT BEFORE SAVING.
	WORD SCREENSIZE,SCNSET		;SET OR GET SCREEN SIZE
	WORD SILENCE,SETSHH		;SET/CLEAR NO "END OF..." MSG
	WORD SPACE-LEFT,NFREER		;NUMBER OF CHARACTERS LEFT
 IFG MAXSEC,<
	WORD STORE-BUFFER,COUT		;"SAVE" TV STATE
>
	WORD SUM,WSUM			;RETURN ARRAY SUM
	WORD UPDATE,WUPDATE		;UPDATE THE SCREEN
	WORD VT05,VT05			;ANNOUNCE THAT YOU ARE RUNNING ON A VT05
	WORD VT100,VT100		;SAY VT100
	WORD VT102,VT102		;VT102 TERMINAL
	WORD VT125,VT125		;VT125
	WORD VT50,VT50			;SAY YOU ARE ON A VT50.
	WORD VT52,VT52			;SAY WE'RE A VT52
	WORD WIDTH,WTHSET		;SET OR GET CURRENT LINE WIDTH
	WORD WINSIZE,WINSET		;GET OR SET WINDOW SIZE
	WORD ZERO,WZERO			;PROPAGATE 0 (OR SOMETHING) THROUGH THE ARRAY
WLEN==.-WORDS-1

;PUT LITERALS HERE THAT SAVER NEEDN'T HAVE IN ITS MAP
XLIST					;DON'T CLUTTER LINEPRINTER PAPER WITH THEM
LIT
LIST
;PAGES USED FOR WINDOWS TO OTHER FORK

FRKWPN==<.+1000>_-9
FRKWIN==FRKWPN_9
FRKWP2==FRKWPN+1
FRKWI2==FRKWP2_9

	LOC	FRKWI2+1000		;LEAVE ROOM FOR WINDOWS

;PATCH SPACE

PATS:
PAT:	BLOCK	50

;DATA AREA FOR TV

DATAIS:					;ADDR OF BEGINNING OF VARIABLE SPACE

;IF 0, THIS IS THE VIRGIN RUN (FIRST TIME SINCE LOADING)
VIRGIN:	-1

;ROUTINE TO MOVE STRING STARTING WITH RIGHTMOST END.  IT'S HERE
;BECAUSE THE "000"S GET FILLED IN AT RUN TIME. YES, CRUDE.

MBLUP:
GETSRC:	MOVE	A,000(C)		;GET SOURCE WORD
	LSH	A,-1			;GET RID OF DATA GAP AT B35
MAKE5:	LSHC	A,000			;GET 5 CONTIGUOUS BYTES IN B
	TRZ	B,1			;GET RID OF B35
SETDES:	MOVEM	B,000(C)		;STORE DESTINATION WORD
RESIDU:	LSHC	A,000			;PUT REST OF WHAT WAS IN A LEFT-JUSTIFIED IN B
	SOJG	C,MBLUP			;REPEAT FOR ALL FULL WORDS
	RET				;DONE

;ROUTINE TO MOVE STRING FROM RIGHTMOST END WHEN WE KNOW THERE'S NO
;SHIFTING TO DO BECAUSE SOURCE AND DESTINATION ARE WORD ALIGNED

BBL:
BBS:	MOVE	A,000(C)		;GET SOURCE WORD
BBD:	MOVEM	A,000(C)		;STORE IN DESTINATION
	SOJG	C,BBL			;REPEAT FOR ALL WORDS
	RET

;FUNCTION DESCRIPTOR BLOCK FOR COMND TO READ FILESPECS

FILCBK:	<.CMFIL>B8			;SPECIFY FILE FUNCTION
	0				;DATA
	0				;HELP TEXT
	-1,,DEFSPC			;DEFAULT POINTER

TERMIN:	EXP	.CHTRM			;TERMINATING CHARACTER

BRKLST:	1B<.CHTRM>			;WAKE ON TERMINATOR
	BLOCK	3

FIRSTV:					;FIRST LOCATION CLEARED AT STARTUP
COCNST:	0				;NUMBER OF TIMES WE'VE SET DISPLAY MODE
COCPOS:	0				;SAVED LINE POSITION BEFORE ESCAPE SEQUENCE
REGCWD:	BLOCK 2				;STANDARD CONTROL ECHO BITS
TRMTYP:	0				;HOLDS TERMINAL TYPE
UUOACS:	BLOCK 20			;SAVED AC'S DURING UUOS
IAC:	BLOCK 20			;INTERRUPT AC'S
ABORTF:	0				;ABORT REQUESTED IF NOT 0
LISNF:	0				;DOING COMMAND INPUT IF NOT 0
COFLG:	0				;SUPRESS OUTPUT IF NON-0
BASICF:	0				;-1 IF WE INSIST "NO FILTER LINE #S"
FLAGF:	0				;-1 = FLAGGING UPPERS
CRRCNT:	0				;NUMBER OF CRLFS TYPED
COLUMN:	0				;CURSOR COLUMN DURING COMMAND TYPIN
ERRBLN==20				;ROOM FOR SYSTEM ERROR MESSAGES
LSTERR:	0				;HOLDS 0 OR SPECIFIC ERROR NUMBER
ERRBUF:	BLOCK ERRBLN
FLDSIZ==^D78				;SIZE OF FILESPEC FIELD MAX, 39 CHARS MAYBE
					; ALL QUOTED
FWDS==FLDSIZ/5+1			;WORDS NEEDED FOR FIELD OF FILESPEC

FNAMSZ==FLDSIZ+1+1+FLDSIZ+1+FLDSIZ+1+FLDSIZ+1+6+1+FLDSIZ
 ;STRUCTURE, COLON, BRACKET, DIR, BRACKET, NAME, DOT, EXT, DOT,...
 ; GENERATION, SEMICOLON, ATTRIBUTE

NAMBFR:	BLOCK FNAMSZ/5+1		;ROOM FOR NAME PLUS NULL

DEFSPC:	BLOCK FNAMSZ+1			;DEFAULT FILESPEC

CMDBLN==<FLDSIZ+1+FNAMSZ+2>/5+1		;PROGRAM, SPACE, FILESPEC, CRLF (RESCAN BUFFER)
CMDBFR:	BLOCK CMDBLN
CMDACS:	BLOCK 20			;SAVED AC'S FROM BEGINNING OF COMMAND LINE
 ATMBLN==CMDBLN
ATMBFR:	BLOCK ATMBLN			;HOLDS LAST PARSED FIELD
SBK:	BLOCK 20			;COMND JSYS STATE BLOCK
CJFNBK:	BLOCK 20			;GTJFN BLOCK FOR COMND JSYS
REPARA:	0				;REPARSE ADDRESS FOR COMND
DATBUF:	BLOCK 200			;FOR RANDOM DATA INSERTIONS
BAKTAB:	BLOCK 20			;RECEIVES ASCII CONVERSION OF NUMERICAL ARGUMENT
TRACS:	0				;RET OR JRST OUTPUT ROUTINE
BAKLEN:	0				;NUMBER OF CHARACTERS TO BUFFER BEFORE SAVING
BAKFLG:	0				;-1 IF COMMANDS ARE BEING SAVED
SAVFRK:	0				;HOLDS FORK HANDLE OF SAVER
LPM:	0				;LAST PAGE MAPPED FROM OTHER FORK
LPM2:	0				;LAST OTHER PAGE MAPPED FROM OTHER FORK
RESPTR:	0				;PTR TO CMD STRING INVOKED BY "TV FILENAME"
LSTCB:	0				;BEG OF LAST COMMAND STRING
LSTCE:	0				;END OF LAST COMMAND STRING
ISEED:	0				;FOR RANDOM NUMBER GENERATION (!)
 OPTION ENC,<				;FOR (UNSUPPORTED) CODING ALGORITHM
encflg:	0
cdestr:	0
cdecnt:	0
cdewrd:	0
whrcde:	0
cdewri:	0
cdewro:	0
cdewin:	0
cdewon:	0
 >
DIVREM:	0				;REMAINDER AFTER LAST USER IDIV
ENTFLG:	0				;HOW WE GOT HERE (0=?, 1=EDIT, -1=CREATE)
SYL:	0				;TEMP FOR MANY RANDOM ROUTINES
JFNIS:	0				;USED BY WLIBRARY.
STOPAT:	0				;USED BY MFILE0/1
WLCKF:	0				;LOCK FLAGS
;**;[510] At TMPFLG:, Inserted 1 line                       SM 26-May-82
TMPFLG:	0				;[510] USED FOR STORING FF
DLIMIT:	0				;[502] DELIMITER USED IN SCANNING STRINGS
FARG:	0				;[502] FARG, Not NUM, and DLIM not needed
SARG:	0
EXECOP:	0				;[502] BINARY OP DUE TO BE DONE
LASTOP:	0				;[502] BINARY OP BEING REQUESTED
SKPPNT:	0				;[502] POINTER WHILST SKIPPING TRAILING ARGS
PREFXC:	0				;[502] COMMAND PREFIX
PREOPV:	0				;[502] VALUE BEFORE BINARY OP
LEV:	0
DUNFLG:	0				; ;D/;U FLAG
DEFNAM:	BLOCK FWDS			;DEFAULT FILE NAME
DEFEXT:	BLOCK FWDS			;DEFAULT EXTENSION
TTYOUT:	0				;TTY OUTPUT JFN
TYIJFN:	0				;TYPIN JFN
TYIP:	0				;TYPIN STACK POINTER
 TYILEN==50				;MAXIMUM DEPTH OF INPUT FILES ALLOWED FOR TYPIN
TYIPDL:	BLOCK TYILEN			;TYPIN STACK
TERIO:	0				;SET IF CURRENT INPUT IS FROM A TERMINAL
OTERIO:	0				;PREVIOUS (OLD) VALUE OF TERIO
INJFN:	0
OUTJFN:	0
YAMODE:	0				;DOING Y OR A, OR;Y
SILFLG:	0				;NON-0 IF "END OF ..." MESSAGE TO BE SKIPPED.
WRITEF:	0				;NON-0 IF OUTPUT FILE HAS SOME OUTPUT IN IT
SCNEST:	0				;NEST LEVEL WHILE SCANNING
LCHAR:	0				;CHARACTER BEING SCANNED FOR
ITERCT:	0
INTDPH:	0				;DEPTH IN ITERATIONS
PCISG:	0				;USED FOR "# HACK
SRPF:	0				;-1 IF REPARSE NEEDED OF SEARCH STRING
CEYFLG:	0				;-1 IF ^EY HAS CHANGED SINCE LAST SEARCH
EXACTF:	0				;0= SEARCHES MATCH EITHER CASE, 1= EXACT
SFINDF:	0
ERR1:	0
RADIX:	0				;holds radix for number printout
LISTF5:	0				;OUTPUT DISPATCH

UUOB:	BLOCK 4				;HARDWARE LUUO BLOCK

;*** TEXTI STATE BLOCK

RDCWB:	0				;NUMBER OF WORDS FOLLOWING
RDFLG:	0				;FLAGS
RDIOJ:	0				;SOURCE DESIGNATOR,,DESTINATION DESIGNATOR
RDDBP:	0				;DESTINATION POINTER
RDDBC:	0				;NUMBER OF BYTES MORE WE CAN READ
RDBFP:	0				;BEGINNING OF DESTINATION BUFFER
RDRTY:	0				;POINTER TO PROMPT
RDBRK:	0				;POINTER TO BREAK SET
RDBKL:	0				;PLACE IN INPUT WHERE WE MUST REPARSE

RDEND==.				;USED TO MEASURE SIZE OF BLOCK
FCHAR:	0				;FIRST CHARACTER OF COMMAND

;*** DO NOT SEPARATE ***

 	CMMSK==370037,,RESQE		;USUALLY STUFFED IN TO SAY "THIS IS A CSB"
 CBBLK==.			;BEGINNING OF AREA TO STACK WHEN CHANGING COMMAND STATE
COMAX:	0
CPTR:	0
COMCNT:	0
CMSMK:	0				;MUST BE LAST WORD OF THIS BLOCK
 CBLEN==.-CBBLK				;NUMBER OF WORDS TO SAVE FOR COMMAND STATE

;*** DO NOT SEPARATE ***

CBUFH:	0
GCPTR:	0
GCCNT:	0				;COUNT OF X'S TO DO BETWEEN GC'S
RREL:	0

;*** SEARCH DATA

SMAXLN==200				;MAXIMUM SEARCH STRING LENGTH
					; (NUMBER OF TYPED CHARACTERS)
SMAXWD==SMAXLN/5+1			;WORDS TO HOLD MAXIMUM LENGTH
SCHPTR:	0				;POINTER TO SEARCH STRING
SSLEN:	0				;NUMBER OF TYPED CHARACTERS IN LAST SEARCH
SCHBUF:	BLOCK SMAXWD			;ACTUAL CHARACTERS TYPED IN LAST SEARCH STRING
SRCHLN:	0				;BIT N ON MEANS SEARCH STRING IS N CHARS LONG
SCHLNN:	0				;N
SENDPT:	0				;CHAR ADDRESS OF CHAR THAT MATCHED IN SEARCH
S0PT:	0				;WHAT TO SET PT TO IF SEARCH HAS SUCCEEDED
					; n TIMES
SDELIM:	0				;SEARCH DELIMITING CHARACTER ($ UNLESS @S)
CARTAB:	BLOCK 5				;CARBTS WITH GAP IN DIFFERENT PLACES
SMTAB:	BLOCK 5				;SAME AS CARTAB BUT WITH SMASK
SCHARG:	0				;ARGUMENT TO SEARCH COMMAND
SLAST:	0				;B.P. TO NTH CHARACTER POSITION
					; IN SEARCH WORKING REGISTER
NXTFRM:	0				;WHERE TO GO DURING SEARCH TO SKIP FRAME
SLIDE:	0				;NUMBER OF BITS TO SHIFT DATA IN ORDER
					; TO SKIP FRAME
SDAT:	BLOCK 2				;HOLDS SEARCH DATA FROM BUFFER
MATCH:	0				;HOLDS A MATCH ON 1ST 5 CHARACTERS OF SEARCH
SMASK:	0				;SHOWS WHAT FIRST FIVE CHARACTERS SHOULD BE
CARBTS:	0				;BIT POSITIONS WE CARE ABOUT DURING SEARCH
SADD:	0				;ADDRESS AT WHICH TO RESUME SEARCH...
					; AFTER FALSE ALARM
SPTR:	0				;POINTER TO BUFFER DURING SEARCH
REPARG:	0				;ARG TO REPLACE COMMAND
SOARG:	0				;OLD SEARCH ARG
SMATLN==200				;LENGTH OF SEARCH MATRIX
SMAT:	BLOCK SMATLN			;SEARCH MATRIX.  BIT N ON IN WORD K
					;MEANS CHARACTER K IS BEING SEARCHED FOR
					;AS AN N-1TH CHARACTER IN THE SEARCH STRING

;*** END OF SEARCH DATA SECTION

OTAB:	BLOCK OTABL			;"O" COMMAND SEARCH TABLE
GCTAB:	BLOCK GCTBL			;GCS3+4,GCM2+13
GCTAB2:	BLOCK GCTBL
ACNR:	BLOCK 20			;SAVED ACS IN GC

				 	;THESE ARE REF'D BY: [(0)=ZERO'D BY]
SYMS:	BLOCK 22			;ZSYMS(0),OG3+1,GC+3(0)
VALS:	BLOCK 22			;ZSYMS(0),OG3+3,GC+3(0)
CNTS:	BLOCK 22			;ZSYMS(0),OG3+2,GC+3(0)
SYMEND=.-1

 IFN MAXSEC,<			 	;;IF and only if allowing extended addressing
MSECF:	0				;MULSEC FLAG
MVELST:	BLOCK	30			;SPACE TO CREATE COMMAND LISTS FOR FOR XTN GAMES
 >

GTJERR:	0				;ERROR CODE FROM GTJFN
GTJJFN:	0				;JFN
CREJFN:	0				;JFN FOR CREATE COMMAND
BBUFX:	0				;SHOWS WHICH BACKUP BUFFER BEING USED
WTOGGL:	0				;WINDOW BUFFER TOGGLE FOR SAVER FORK
					;HOLDS 0 FOR ONE BUFFER, -1 FOR OTHER
					;USING TWO BUFFERS REDUCES NUMBER OF PMAPS
					;NEEDED
BBPTR:	0				;POINTER TO BACKUP BUFFER
BBLEN:	0				;NUMBER OF CHARACTERS IN BACKUP BUFFER
OBBLEN:	0				;BBLEN AT TIME OF LAST UPDATE
OCP:	0				;OLD COMMAND POINTER (WHERE LAST BACKUP OCCURED)
INIJFN:	0				;HOLDS INI FILE JFN
QUOJFN:	0				;HOLDS JFN BEING WRITTEN TO
UPDATF:	0				;-1 IF DOING WUPDATE

PFINFO:				;QREG STACK
PF:	0				;Q-REG STACK POINTER
PFL:	BLOCK LPF			;Q-REG STACK
PFINFE=.-1

QINFO:				;QREG INFO
QTAB:	BLOCK 45			;Q-REGISTER TABLE
 QTABE=.-1
QRBUF:	0
EQRBUF:	0				;END OF QREG BUFFER AREA
QINFE=.-1

BFINFO:				;BUFFER STATE INFO
HOLBEG:	0				;CHARACTER ADDRESS OF BEGINNING OF HOLE
HOLEND:	0				;CHAR ADDRESS OF FIRST CHARACTER NOT IN HOLE
HOLBPT:	0				;BYTE POINTER (LDB) TO BEGINNING OF HOLE
HOLEPT:	0				;BYTE PTR (LDB) TO FIRST CHAR TO RIGHT OF HOLE
HOLSIZ:	0				;NUMBER OF CHARACTERS IN HOLE
BEG:	0
PT:	0
ZEE:	0				;CHAR PTR TO END OF BFR
 BFINFE=.-BFINFO
				;ARRAY
USRARY:	BLOCK USARYL			;USER ARRAY

;**** VARIABLE AREA FOR STRING MOVE ROUTINE

SRCBEG:	0				;LEFTMOST CHARACTER ADDRESS OF STRING
					; BEING MOVED
SRCBPT:	0				;BYTE POINTER FORM OF SRCBEG
DESBEG:	0				;LEFTMOST CHAR ADDRESS OF DESTINATION
DESBPT:	0				;BYTE POINTER FORM OF DESBEG
SRCEND:	0				;CHAR ADDRESS JUST TO RIGHT OF SOURCE
SRCEPT:	0				;BYTE POINTER FORM OF SRCEND
DESEND:	0				;CHAR ADDRESS JUST TO RIGHT OF DEST.
DESEPT:	0				;BYTE POINTER FORM OF DESEND
STRLEN:	0				;NUMBER OF CHARACTERS LEFT TO MOVE
WCNTB:	0				;NUMBER OF WHOLE WORDS BEING MOVED

;**** END OF STRING MOVE STORAGE AREA

PDL:	BLOCK LPDL+5			;[521] +5, IN CASE ERROR IS PDL OV.
CMDPDL:	BLOCK LPDL			;SAVED PDL DURING COMMAND

;*****  DISPLAY ROUTINE VARIABLE AREA

SCRNF:	0				;SET TO -1 IF WE'RE RUNNING ON A SCREEN.
SCRNZ:	0				;BYTE PTR TO LAST CHAR TO BE DISLAYED
SCRNPT:	0				;CHAR ADDR OF 1ST CHAR TO BE DISPLAYED
ILDBPT:	0				;LDB POINTER TO CHARACTER BEFORE POINTER
SCNEND:	0				;CHAR ADDR OF LAST CHAR IN BUFFER DISPLAYED
MESFLG:	0				;SET TO -1 TO MEAN DISPLAY IS MESSED UP
SWIDTH:	0				;SCREEN WIDTH
LASTCH:	0				;CONTINUATION CHARACTER FOR LAST COLUMN
DLENTH:	0				;NUMBER OF LINES TO USE FOR NEXT DISPLAY WINDOW
DISBLK:	0				;NUMBER OF LINES TYPED BEFORE SOME THAT
					; WANT TO NOT BE OVERWRITTEN BY DISPLAY
TXTI:	BLOCK .RDDBC+1			;TEXTI BLOCK FOR MFILE0:
SLENTH:	0				;HOLDS NUMBER OF SCREEN LINES TO DISPLAY
SSIZE:	0				;HOLDS NUMBER OF LINES THAT FIT ON SCREEN
MAXLEN==^D40				;MAXIMUM VALUE ALLOWABLE FOR SLENTH
PTRCHR:	BLOCK 2				;ASCII STRING TO REPRESENT POINTER WITH
LBSIZ==<MAXWTH*2>/5+1			;WORDS NEEDED FOR DISPLAY LINE BUFFER
LINBFR:	BLOCK LBSIZ
WINDEX=1+<MAXWTH+2>/5			;PDP-10 WORDS PER SCREEN LINE
LINBF2:	BLOCK WINDEX			;OUTPUT BUFFER WHEN REPLACING ENTIRE LINE
					;STORAGE
WINTOP=MAXLEN*WINDEX-1			;HIGHEST WORD USED FOR SCREEN MEMORY RELATIVE
					;TO FIRST WORD (WINDOW OR WINEW)
WINDOW:	BLOCK WINTOP+1			;STORAGE OF WHAT IS SHOWING ON SCREEN NOW
WINEW:	BLOCK WINTOP+1			;NEW SCREENFUL ABOUT TO BE DISPLAYED
LINBEG:	BLOCK MAXLEN			;CHAR POINTERS TO BEGINNING OF DISPLAY
					; LINES IN BUFFER
LINNEW:	BLOCK MAXLEN			;SAME POINTERS AS LINBEG. MOVED TO LINBEG AS
					; LINES ARE ACTUALLY PUT ON SCREEN.
WINFLG:	0				;-1 IF NO LINES WORTH PRESERVING HAVE
					; BEEN PRINTED
EOBFLG:	0				;END OF BUFFER FLAG
SEOL:	0				;END OF DISPLAY LINE FLAG
CTLFLG:	0				;CONTROL CHARACTER FLAG
PUTPTF:	0				;POINTER ON SCREEN FLAG
TYPEF:	0				;-1 WHEN USER STARTS TYPING
DATAE=.-1				;END OF TV VARIABLE SPACE

;THIS IS THE ROUTINE THAT RUNS AS A LOWER FORK TO SAVE TYPED IN
;STRINGS ON THE DISK.
;THIS ROUTINE MUST BE LOADED IN MEMORY CONTIGUOUS TO EVERYTHING
;IT NEEDS TO RUN, SUCH AS ITS LITERALS, DATA, CODE, AND ANY ROUTINES
;IN .REQUIRED FILES.  THIS IS BECAUSE FOR THE PURPOSE OF STARTUP
;EFFICIENCY, WE WANT TO DO A SINGLE PMAP TO SET UP THE MINIMUM NUMBER
;OF PAGES IN THE LOWER FORK.

SAVBEG==.				;REMEMBER WHERE SAVER FORK BEGINS

;DATA FOR SAVER FORK.  IT MUST BE CONTIGUOUS WITH THE SAVER FORK
;ITSELF

SDONEF:	0				;-1 WHEN SAVER DONE SAVING A STRING
SAVJFN:	0				;HOLDS COMMAND FILE JFN
SAVPDL:	BLOCK 50			;STACK FOR SAVER
MAXBAK==^D1000				;MAXIMUM NUMBER OF TYPED IN CHARS
					; ALLOWED BETWEEN SAVES
SAVX:	0				;BYTE POINTER TO WHICH AREA TO SAVE
SAVTOT:	0				;TOTAL CHARACTERS BEING BACKED UP
SAVPER:	0				;# OF PERMANENT CHARS BEING BACKED UP
SAVPOS:	0				;FILE POSITION AT WHICH SAVED CHARS GO
EXPFLG:	0				;-1 FOR AUTO-EXPUNGE
DIRECT:	BLOCK 1+3+^D78/5		;SPACE FOR DIRECTORY NAME

TOP==.-1
;INTERRUPT TABLES

LEVTAB:	LEV1PC
	LEV2PC
	LEV3PC				;LOCATIONS OF SAVED PC DURING INTERRUPTS

LEV1PC:	BLOCK 2
LEV2PC:	BLOCK 2
LEV3PC:	BLOCK 2				;INTERRUPT PC'S STORED HERE

CHNTAB:	XWD 3,TTYINT			;CONTROL-G
	XWD 3,CTRL.O			;CONTROL-O
	XWD 3,CTRL.C			;CONTROL-C
	XWD 3,TYPO			;USER HAS TYPED SOMETHING
TICHN==3				;TYPEIN INTERRUPT CHANNEL
	REPEAT ^D11-^D4,<0>
	XWD 3,IOERR			;CHANNEL 11, IO ERROR
	XWD 3,OVRQUO			;CHANNEL 12, OVER QUOTA
	0
	0
	0
	0
	0
	0
	0
	0
	0
	0
	0
	0
	0
	0
	0
	0
	0
	0
	0
	0
	0
	0
	0

;GTJFN BLOCK FOR COMMAND FILE...

SAVFIL:	GJ%FOU				;FILE FOR OUTPUT USE
	377777,,377777			;NO JFNS FOR FILE NAME INPUT
	0
	0
	POINT 7,[ASCIZ /COMMANDS/]
	POINT 7,[ASCIZ /TV/]
	0				;STANDARD PROTECTION,
	0				;ACCOUNT
	0
	0
	0

;GTJFN INFO FOR ACCESSING TV.INI FILE.

INIFIL:	GJ%OLD				;OLD FILE ONLY
	377777,,377777
	0
	0
	POINT 7,[ASCIZ /TV/]
	POINT 7,[ASCIZ /INI/]
	0
	0
	0
	0
	0

;GET TO HERE WHEN A TYPED IN STRING IS READY TO BE SAVED...

SAVST:	SKIPN A,SAVJFN			;GET JFN OF BACKUP FILE
	JRST CNOGT9			;NO JFN EVER DONE, GO DO IT
SAVST1:	MOVE B,[7B5+OF%WR+OF%RD] 	;OPEN FILE IN UPDATE MODE
	OPENF%
	JRST CNOGET			;COULDN'T OPEN IT, SAY WHY
	MOVE B,SAVPOS			;GET TO CORRECT FILE POSITION
	SFPTR%
	 JSHLT
	MOVE A,SAVJFN			;GET JFN TO SAVE STRING ON
	MOVE B,SAVX			;POINT AT TEXT BEING SAVED
	MOVN C,SAVTOT			;GET NEG. NUMBER OF CHARACTERS TO SAVE
	SOUT%				;SAVE THE STRING ON THE DISK
	 ERJMP CNOGTE			;COULDN'T, PROBABLY OVER QUOTA
	TXO A,CO%NRJ			;CLOSE FILE BUT DON'T RELEASE JFN
	CLOSF%
	 JSHLT
	SETO B,				;WE WANT TO CHANGE AN ENTIRE FDB WORD
	MOVE C,SAVPOS			;GET PLACE IN FILE WE STARTED WRITING
	ADD C,SAVTOT			;ADD NUMBER OF CHARACTERS WRITTEN TO GET
					; TOTAL FILE SIZE
	HRLI A,.FBSIZ			;SPECIFY WHICH WORD WE'RE CHANGING
	CHFDB%				;UPDATE THE FILE'S END
	MOVE A,SAVPOS			;GET FILE POSITION
	ADD A,SAVPER			;INCREASE BY AMOUNT EQUAL TO #...
					; OF PERMANENT CHARACTERS
	MOVEM A,SAVPOS
	SETOM SDONEF			;SET DONE FLAG TO SHOW WE'RE DONE
	HALTF%				;JUST HALT

;HERE WHEN ERROR, PROBABLY OVER QUOTA

CNOGTE:	MOVE A,SAVJFN			;CLOSE JFN
	TXO A,CO%NRJ			;BUT DON'T RELEASE IT
	CLOSF%
	 JSHLT
CNOGT3:	MOVEI A,.FHSLF
	GETER%				;GET LAST ERROR
	HRRZM B,SDONEF			;SIGNAL WE'RE DONE WITH ERROR CODE
	HALTF%

CNOGET:	CAIE A,OPNX2			;FILE DELETED OUT FROM UNDER US?
	JRST CNOGT8			;NO, SOMETHING ELSE
	MOVE A,SAVJFN			;YES, THROW AWAY OLD JFN
	RLJFN%
	 JFCL				;DON'T WORRY IF CAN'T
	JRST CNOGT9			;GO GET NEW JFN
CNOGT8:	CAIE A,DESX3			;SKIP IF JFN WAS RELEASED OUT FROM UNDER US
	JRST CNOGT3			;NO, OPENF FAILED FOR OBSCURE REASON
					; (MAYBE ENTIRE DISK FULL!!)
CNOGT9:	DMOVE A,[EXP SAVFIL,<-1,,[ASCIZ /TVBACK:/]>]
	GTJFN%				;PERHAPS USER WANTS BACKUP FILE
					; ON LOGICAL NAME TVBACK:
	 ERJMP CNOGT1			;NO
	JRST CNOGT2			;YES
CNOGT1:	DMOVE A,[EXP SAVFIL,<-1,,DIRECT>]
	GTJFN%				;GET HANDLE ON BACKUP FILE.
	 JSHLT				;COULDN'T EVEN DO THAT!
CNOGT2:	MOVEM A,SAVJFN			;SAVE THE BACKUP FILE JFN.
	JRST SAVST1			;GO BACK AND TRY THE OPENF AGAIN.

	XLIST				;DON'T LIST LITERALS IN LISTING
	LIT	;MAKE SURE LITERALS SAVER NEEDS ARE IN ITS MAP
	LIST				;TURN LISTING BACK ON

	RELOC .-140	;WE'RE NOT RELOCATABLE BUT OTHER MODULES MAY BE

	.REQUIRE SYS:MACREL
;NOTE THAT ANY .REQUIRES THAT SAVER REFERENCES MUST BE CONTIGUOUS TO
;SAVER

	SAVEND==.RLEND			;MARK END OF SAVER FORK

	END <ENLEN,,GOGO>