Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-06 - 43,50374/sosdec.mac
There are no other files named sosdec.mac in the archive.
00100	TITLE	SOS - SON OF STOPGAP	%21(122)
00200	
00300	;*** COPYRIGHT 1973,1974 DIGITAL EQUIPMENT CORP., MAYNARD, MASS. ***
00400	
00500	SUBTTL DEFINITIONS
00600	
00700	WHOSOS==0	;LAST EDITED BY TAH
00800	VERSOS==21
00900	PATSOS==0	;PATCH LEVEL
01000	MODSOS==122	;EDIT LEVEL
01100	
01200	; EDITOR FOR THE DISK -- WORKS BY RECOPYING FILES USED
01300	
01400		MLON		;MULTI-LINE THINGIES
01500		SALL		;SUPPRESS MACRO XPANSIONS
01600		.HWFRMT		;READABLE LISTING
01700	
01800	IFNDEF LSTSW,<LSTSW==1		;FOR L COMMAND>
01900	IFNDEF JUSTSW,<JUSTSW==0	;FOR TEXT JUSTIFICATION>
02000	IFNDEF RENTSW,<RENTSW==1	;FOR RE-ENTRANT VERSION>
02100	IFNDEF CCLSW,<CCLSW==1		;FOR CCL FEATURES>
02200	IFNDEF TEMPC,<TEMPC==1		;FOR TEMPCORE FEATURE>
02300	IFNDEF CRYPSW,<CRYPSW==0	;FOR ENCRYPTED FILES>
02400	IFNDEF EXTEND,<EXTEND==1	;FOR EXTENDED FEATURES>
02500	IFNDEF PPNTSW,<PPNTSW==0	;FOR PRETTY PRINT FEATURES>
02600	
02700	IFN RENTSW,< TWOSEG
02800		RELOC	400000 >
02900	
03000		INTERN	.JBVER
03100		.JBVER==137
03200		LOC	.JBVER
03300		BYTE	(3)WHOSOS (9)VERSOS (6)PATSOS (18)MODSOS
03400		RELOC
03500	
03600	OPDEF	OCRLF	[OUTSTR [BYTE (7)15,12]]
03700	OPDEF	ONECHO	[SETSTS TTY,1]
03800	OPDEF	OFFECHO	[SETSTS TTY,201]
03900	
04000	;I/O CHANNELS
04100	
04200	TTY==1		;CHL FOR TTY
04300	IN==2
04400	OUT==3
04500	LPT==4
04600	ALTDV==5	;THE OTHER INPUT DEVICE (COPY AND TRANSFER)
04700	IND==6		;INDIRECT CHL FOR "@" CMD
04800	OPT==7		;CHL FOR OPTION FILE
04900	
05000	;ACS USED
05100	
05200	JF=0	;TEMP FLAGS FOR JUSTIFY & PRETTY PRINT
05300	T1=1	;TEMP REGISTERS
05400	T2=2
05500	T3=3
05600	T4=4
05700	T5=5
05800	
05900	FL=10		;FLAG REGISTER
06000	FL2=11
06100	ALTP=12		;POINTER FOR ALTER MODE
06200	CS=13		;CHARACTER TABLE BITS
06300	SINDEX=14	;LINE TO FIND, USED ALSO BY THE VARIOUS ROUTINES
06400	PNTR=15		;POINTS AT CURRENT PLACE IN BUFFER
06500	C=16		;CHARACTER RETURNED HERE BY GNCH
06600	P=17		;PUSHDOWN LIST
06700	
06800	;FLAGS  (RIGHT HALF)
06900	
07000	BOF==1		;NOW ON FIRST RECORD OF FILE
07100	EOF==2		;HAVE READ END OF FILE BUT NOT NECESSARILY BUT IN BUFFER
07200	EOF2==4		;LAST WORD OF FILE IS IN CURRENT BUFFER
07300	ADDL==10	;USED IN COMMAND SCANNING--LINE NUMBER + INC
07400	SUBL==20	;LINE NUMBER - INC
07500	IDF==40		;SCAN HAS SEEN AN IDENTIFIER
07600	NUMF==100	;SCAN HAS SEEN A NUMBER
07700	TERMF==200	;SCAN SAW A TERMINATOR (LF OR ALTMODE)
07800	LINSN==400	;THE COMMAND INPUT ROUTINES SAW A LINE NUMBER
07900	PGSN==1000	;THEY SAW A PAGE NUMBER
08000	NEWFL==2000	;NEW FILE NAME SEEN BY END CODE
08100	ORDF==4000	;LINES OUT OF ORDER (USED BY NUMBER)
08200	BGSN==10000	;BIGGEST PAGE HAS BEEN SEEN
08300	M37F==20000	;THIS IS A MODEL 37
08400	CNTF==40000	;COMMAND USING !
08500	DPYF==100000	;THIS IS A DISPLAY
08600	READOF==200000	;THIS FILE IS BEING USED IN READ ONLY MODE
08700	EXTOG==400000	;ON FOR SHORT ERROR MESSAGES
08800	
08900	;SPECIAL FLAGS FOR PARSE CODE
09000	
09100	F.LAHD==1	;LOOK-AHEAD FLAG
09200	F.PER==2	;PERIOD SEEN
09300	F.SLSH==4	;SLASH SEEN
09400	F.CDSN==10	;CODE SEEN
09500	F.PPN==20	;PPN SEEN
09600	F.COLN==400	;COLON SEEN
09700	F.EQL==1000	;EQUAL SIGN SEEN
09800	F.ANY==2000	;ANY ATOM SEEN BEFORE EOL
09900	
10000	P.FLGS==F.LAHD!F.PER!F.SLSH!F.CDSN!F.PPN!F.COLN!F.EQL!F.ANY
10100	
10200	CODMAX==^D20	;MAX CHARS IN CODE
10300	SFDLVL==6	;MAX SFD LVL
10400	
10500	D==PNTR
10600	S1==PNTR		;SPECIAL ACS
10700	S2==SINDEX
     
00100	;FLAGS (LEFT HALF)
00200	
00300	NEGF==1		;SEARCH HAS SEEN A 
00400	DEMCHR==2	;SEARCH MUST SEE ANOTHER CHARACTER
00500	ASSMF==4	;SEARCH HAS ASSUMED SEARCH CONTINUATION
00600	ALTSRF==10	;HE WANTS TO DO A SEARCH AND EDIT
00700	NUMSRF==20	;HE ONLY WANTS NUMBERS OF LINES FOUND
00800	ARBITG==40	;WE ARE DOING  CURRENTLY, DO NOT ALLOW ANOTHER
00900	EXCTSR==100	;WANTS TO SEARCH EXACTLY (NOT IGNORE CASE)
01000	COPFIL==200	;WE ARE COPYING FROM ANOTHER FILE
01100	ISCOP==400	;WE ARE DOING A COPY
01200	NOPRN==1000	;DO NOT PRINT WHILE DOING SUBSTITUTE
01300	DECID==2000	;ALLOW USER TO DECIDE IF LINE IS OK
01400	EXCTS1==4000	;ANOTHER EXACT SEARCH FLAG FOR SUBS
01500	QMODF==10000	;DO NOT TREAT ? AS A SPECIAL CASE ON INPUT
01600	GCOM==20000	;DOING A G COMMAND INSTEAD OF E
01700	SRCOP==40000	;DOING A SEARCH OF SECOND FILE
01800	TRANFL==100000	;THIS IS A TRANSFER COMMAND WHICH HAS DELETED LINES
01900	TECOF==200000	;THIS IS A TECO FILE
02000	FSTOPF==400000	;THIS IS THE FIRST READ OP ON THIS FILE
02100	
02200	;FLAGS IN FL2 (RIGHT)
02300	
02400	STARF==1	;WE HAVE SEEN A * FOR THE LAST LINE
02500	RUBF==2		;WE ARE DOING RUBOUT IN INTRA-LINE EDIT
02600	ALTDUP==4	;DUPLEX CHARACTERS IN ALTER MODE
02700	RUBF2==10	;DOING DELETE TYPE RUBOUT IN ALTER MODE
02800	SVIT==20	;WE ARE DOING A "W" COMMAND (SAVE WORLD)
02900	NONUMF==40	;SUPPRESS LINE NOS FOR P,R,I CMDS
03000	ACONST==100	;ADD CONSTANT FOR R COMMAND
03100	MONOF==200	;MONOTONIC RENUMBERING - NO REST AT P.M.
03200			;UNUSED (400)
03300	SUPN==1000	;SUPPRESS LISTING OF LINE NUMBERS
03400			;UNUSED (2000)
03500			;UNUSED (4000)
03600	QSEPF==10000	;TREAT . % $ AS SEPARATORS
03700	COMFLF==20000	;READ COMMANDS FROM FILE
03800	
03900	;FLAGS IN FL2 (LEFT)
04000	
04100	PDECID==1	;PERM DECIDE MODE FOR S
04200	UARWF==2	;UP ARROW (^) SEEN FOR FIRST LINE
04300			;UNUSED (4)
04400	NORENT==10	;DON'T ALLOW REENTER
04500	RENTF==20	;REENTER COMMAND TYPED
04600	BELLF==40	;ALLOW <BELL><BELL>
04700	BELLSN==100	;<BELL> SEEN
04800	AUTOF==200	;AUTO SAVE IN PROGRESS
04900	DSKCK==400	;CHECK DISK QUOTAS
05000	SLPSW==1000	;SLEEPING UNTIL DISK SPACE APPEARS
05100	DOENDF==2000	;E CMD REQUESTED
05200	INOPTF==4000	;READING OPTION FILE
05300	INPARS==10000	;DOING INITIAL PARSE
05400	PCHGF==20000	;FILE HAS CHANGED THIS PASS
05500	FCHGF==40000	;FILE HAS CHANGED THIS EDIT
05600	CCHGF==100000	;THIS COMMAND HAS CHANGED THE FILE
05700	FSEQF==200000	;ORIGINAL FILE HAD SEQ #'S
05800	
05900	ALLCHG==PCHGF!FCHGF!CCHGF	;ALL FLAGS AFFECTING FILE CHANGE
06000	
06100	;FLAGS FOR JF (RIGHT)
06200	
06300	JFFLG==1	;J DOES FILL ONLY
06400	JRFLG==2	;J DOES RIGHT JUSTIFY
06500	JCFLG==4	;J DOES CENTERING
06600	JBLF==10	;J SEES A BLANK
06700	JLFLG==20	;J DOES LEFT JUSTIFY
06800	JPER==40	;J SEES A PERIOD OR SOMETHING LIKE IT
06900	JWFLG==100	;J DOES FILL WORDS ONLY
07000	EJECT==200	;EJECT AFTER PAGES
07100	WAIT==400	;WAIT FOR CR AFTER PAGES
07200	PGNOS==1000	;PAGE NUMBERS AT BOTTOM
     
00100	OPDEF	ERROR	[1B8]	;ERROR UUOS FATAL ERROR
00200	OPDEF	NERROR	[2B8]	;NON-FATAL ERROR
00300	OPDEF	RERROR	[3B8]	;PRINT MESSAGE AND RETURN
00400	OPDEF	XLOOK	[4B8]	;EXTENDED LOOKUP
00500	OPDEF	XENTR	[5B8]	;EXTENDED ENTER
00600	OPDEF	XRENM	[6B8]	;EXTENDED RENAME
00700		MAXUUO==6
00800	
00900	;ERROR NUMBERS
01000	
01100	ICN==1		;INTERNAL EDITRO CONFUSION
01200	DIE==2		;DEVICE INPUT ERROR
01300	DDE==3		;DEVICE OUTPUT ERROR
01400	ILC==4		;ILLEGAL COMMAND
01500	ILUUO==5	;PROTECTION. SOMEONE EXECUTED AN ILLEGAL UUO
01600	LTL==6		;LINE IS TOO LOGNNG
01700	NLN==7		;NULL COMAND RANGE
01800	NSP==10		;NO SUCH PAGE (DELETE)
01900	ORDER==11	;LINES OUT OF ORDER
02000	UNA==12		;LPT NOT AVAILABLE FOR L COMMAND
02100	ILR==13		;ILLEGAL REPLACEMENT WITH INSERT
02200	WAR==14		;WRAP AROUND IN RENUMBERING
02300	TMS==15		;TOO MANY SEARCH STRINGS GIVEN
02400	STL==16		;TOO MANY TOTAL STRING CHRS
02500	ISS==17		;ILLEGAL SEARCH STRING
02600	ILFMT==20	;ILLEGAL LINE FORMAT DETECTED
02700	NSG==21		;NO STRING GIVEN
02800	FNF==22		;FILE NOT FOUND (COPY)
02900	DNA==23		;DISK NOT AVAILABLE (COPY)
03000	NEC==24		;NOT ENOUGH CORE (COPY)
03100	IRS==25		;ILLEGAL REPLACEMENT STRING
03200	STC==26		;SEARCH STRING TOO COMPLEX (GOT PDLOV)
03300	ITD==27		;ILLEGAL TRANSFER DESTINATION (PLACE NO LONGER THERE)
03400	NNN==30		;NO NEXT LINE (FROM JOIN TYPE COMMANDS)
03500	SRF==31		;SEARCH FAIL (F AND S COMMANDS)
03600	CMERR==32	;ERROR IN COMMAND FILE
03700	CMEND==33	;EOF SEEN IN COMMAND FILE
03800	MAR==34		;RMAR MUST BE GREATER THAN LMAR AND PMAR
03900	BBF==35		;FUNNY STUFF IN "BASIC" MODE (FATAL)
04000	
04100	SRBLG==^D200	;NUMBER OF CHRS ALLOWED IN SEARCH STRING
04200	SRNUM==6	;NUMBER OF SEARCH STRINGS ALLOWED
04300	PDLSIZ==200	;PUSHDOWN LIST SIZE
04400	MXWPL==^D100	;MAX NUMBER OF WORDS PER LINE
04500	MINDSK==^D5	;MINIMUM DISK SPACE TO TRY OUTPUT
04600	OVRDRW==^D100	;OVER DRAW ALLOWANCE
04700	IFN EXTEND,<LSNUM==3	;NUMBER OF NESTED LINE SEARCHES ALLOWED>
04800	%LPP==^D53		;LINES/PAGE FOR "L" CMD
04900	PGSZ==^D55		;LINES / PAGE
05000	FULLPG==^D65		;LINES TO NEXT PAGE
05100	
05200	.TOLCT==1003	;LOWER CASE TTY
05300	.GTPRG==3	;PROGRAM NAME
05400	.GTLDV==16	;LEVEL D TABLE
05500	 %LDSTP==12	;DEFAULT PROTECTION
05600	
05700	SUBTTL RPG LOADER
     
00100	CREFIT:	OCRLF			;INFORM USER IS ALL OK
00200		MOVE	T4,[1,,RPGR]
00300		SKIPN	T1,RUNDEV	;ANY SPECIFIED
00400		JRST	TENTFOLD
00500		MOVEM	T1,RPGR		;STASH DEVICE NAME
00600		HRRZS	T4		;REMOVE RUN INCREMENT
00700		HRROI	T1,RUNEXT
00800		POP	T1,RPGR+2
00900		POP	T1,RPGR+1
01000		SKIPE	T1,RUNPTH	;ANY PATH INFO?
01100		SKIPN	RUNPTH+1	;YES - JUST PPN?
01200		JRST	CRFIT1		;JUST STORE PPN AND EXIT
01300		MOVE	T1,[RUNPTH,,PTHADR+2]
01400		BLT	T1,PTHADR+2+SFDLVL
01500		SETZM	PTHADR
01600		SETZM	PTHADR+1
01700		MOVEI	T1,PTHADR
01800	CRFIT1:	MOVEM	T1,RPGR+4	;STASH PATH PNTR
01900	TENTFOLD:
02000		RUN	T4,
02100		HALT	.		;SAY DON'T RETURN
02200	
02300	SUBTTL	CHARACTER TABLES
     
00100	
00200	
00300	
00400	;A CHARACTER TABLE FOR USE ON TYPE IN AND TYPE OUT
00500	
00600	;FLAGS USED IN CHARACTER TABLE
00700	
00800	OPF==10		;THIS IS A SPECIAL CHARACTER
00900	SNUMF==4	;THIS IS PART OF A NUMBER
01000	LETF==2		;THIS IS A LETTER
01100	TERM==1		;THIS IS A TERMINATOR
01200	M37==400000	;THIS CHR IS PRINTED AS ITSELF ON MODEL 37
01300	NSEPF==200000	;THIS IS NOT A SEPERATOR (USED ON $,%,AND.)
01400	DEFINE CHRS (FLAGS,PALT,INALT,RH)
01500	<BYTE (4) FLAGS (7) PALT,INALT(18)RH>
01600	
01700	CTBL:	0
01800		CHRS	OPF,"!","",""
01900		CHRS	OPF,42,"",""
02000		CHRS	OPF,"#",3,3
02100		CHRS	OPF,"$",4,4
02200		CHRS	OPF,"%",5,5
02300		CHRS	OPF,"&",6,6
02400		CHRS	OPF,"'",7,7
02500		CHRS	OPF,"(",10,10
02600		0
02700		CHRS	OPF!TERM,0,12,12
02800		CHRS	OPF,0,13,13
02900		CHRS	OPF,0,14,14
03000		0
03100		CHRS	OPF,")",16,16
03200		CHRS	OPF,"*",17,17
03300		CHRS	OPF,"+",20,20
03400		CHRS	OPF,54,21,21
03500		CHRS	OPF,"-",22,22
03600		CHRS	OPF,".",23,23
03700		CHRS	OPF,"/",24,24
03800		CHRS	OPF,"0",25,25
03900		CHRS	OPF,"1",26,26
04000		CHRS	OPF,"2",27,27
04100		CHRS	OPF,"9",30,30
04200		CHRS	OPF,"6",31,31
04300		CHRS	OPF,"4",32,32
04400		CHRS	OPF,"=",33,33
04500		CHRS	OPF,74,34,34
04600		CHRS	OPF,76,35,35
04700		CHRS	OPF,"7",36,36
04800		CHRS	OPF,"8",37,37
04900		0
05000		CHRS	OPF,0,1,"!"
05100		CHRS	OPF,0,2,42
05200		CHRS	OPF,0,3,"#"
05300		CHRS	OPF,0,4,"$"+NSEPF
05400		CHRS	OPF,0,5,"%"+NSEPF
05500		CHRS	OPF,0,6,"&"
05600		CHRS	OPF,"'","'","'"
05700		CHRS	OPF,0,10,"("
05800		CHRS	OPF,0,16,")"
05900		CHRS	OPF,0,17,"*"
06000		CHRS	OPF,0,20,"+"
06100		CHRS	OPF,0,21,54
06200		CHRS	OPF,0,22,"-"
06300		CHRS	OPF,0,23,"."+NSEPF
06400		CHRS	OPF,0,24,"/"
06500		CHRS	SNUMF,0,25,20
06600		CHRS	SNUMF,0,26,21
06700		CHRS	SNUMF,0,27,22
06800		CHRS	SNUMF,0,176,23
06900		CHRS	SNUMF,0,32,24
07000		CHRS	SNUMF,0,"5",25
07100		CHRS	SNUMF,0,31,26
07200		CHRS	SNUMF,0,36,27
07300		CHRS	SNUMF,0,37,30
07400		CHRS	SNUMF,0,30,31
07500		CHRS	OPF,0,174,":"
07600		CHRS	OPF,0,73,73
07700		CHRS	OPF,0,34,74
07800		CHRS	OPF,0,33,"="
07900		CHRS	OPF,0,35,76
08000		CHRS	OPF,0,37,"?"
08100		CHRS	OPF,0,140,"@"
08200	XXZ=101
08300	REPEAT ^D26,<CHRS	LETF,0,XXZ+40,XXZ-40
08400	XXZ=XXZ+1>
08500		CHRS	OPF,0,173,"["
08600		CHRS	OPF,0,"\","\"
08700		CHRS	OPF,0,175,"]"
08800		CHRS	OPF,0,"^","^"
08900		CHRS	OPF,0,"_","_"
09000		CHRS	OPF,100,140,140
09100	XXZ=141
09200	REPEAT ^D26,<CHRS	LETF,XXZ-40,XXZ,XXZ-100
09300	XXZ=XXZ+1>
09400		CHRS	OPF,"[",173,173+M37
09500		CHRS	OPF,":",174,174+M37
09600		CHRS	OPF,"]",175,175+M37
09700		CHRS	OPF,"3",176,176
09800		CHRS	OPF,"\",177,177
09900		CHRS	OPF,0,0,200
10000	
10100	SUBTTL SCANNER
     
00100	GNCH:	SKIPN	C,LIMBO		;USE SAVED CHAR IF ANY
00200		PUSHJ	P,@CHIN		;ELSE GET FRESH CHAR
00300		SETZM	LIMBO		;AND CLEAR LIMBO
00400		CAMN	C,ESC		;CHECK ESCAPE CHAR
00500		MOVEI	C,200		;CONFUSE WITH LEFT CURLY BRACKET
00600		TLNE	FL,QMODF	;SHOULD WE TREAT ' SPECIALLY
00700		JRST	GNCH1Y		;NO:
00800		CAIN	C,"'"		;YES: SHOULD WE USE ALT CHR SET?
00900		JRST	GNCHA		;YES:
01000	GNCH1Y:	TDNN	FL2,[INOPTF,,COMFLF]
01100		TLNN	FL2,BELLF		;ALLOWED?
01200		JRST	GNCHB		;NO: JUST GET BITS
01300		CAIN	C,7		;YES: SEE IF BELL
01400		JRST	[TLO FL2,BELLSN	;SAY WE SAW ONE
01500			 JRST GNCHA]	;AND LOOK AT NEXT
01600	GNCHB:	JUMPE	C,GNCH		;IGNORE NULLS
01700		MOVE	CS,CTBL(C)	;GET CHARACTER TABLE BITS
01800		TLNE	CS,LETF_16	;CHECK TO SEE IF A LETTER
01900		TDC	C,CASEBT	;USE UPPER/LOWER INFO
02000		POPJ	P,		;AND RETURN
02100	
02200	GNCHA:	PUSHJ	P,@CHIN		;GET NEXT CHAR
02300		JUMPE	C,GNCHA		;SKIP NULLS
02400		TLZE	FL2,BELLSN	;WAS 1ST BELL SEEN
02500		JRST	[CAIN C,7	;YES: CHECK FOR 2ND
02600			 JRST [OCRLF	;2ND SEEN - PUNT
02700			       CLRBFI
02800			       JRST COMND]
02900			 MOVEM C,LIMBO	;SAVE CHAR
03000			 MOVEI C,7	;RETURN A BELL
03100			 JRST GNCHB]
03200		SKIPE	CTBL(C)		;NO CHANGE FOR NULL,SPACE,TAB,CRET
03300		MOVS	C,CTBL(C)	;GET ALTERNATE CHR FROM CHR TABLE
03400		ANDI	C,177		;ONLY THE CHR BITS
03500		JRST	GNCHB		;GO CHECK THINGS
03600	
03700	;HERE TO INPUT FROM TTY
03800	
03900	TTYCH:	SOSG	TTIBH+2		;SEE IF MORE CHARS
04000		PUSHJ	P,TTYINP	;NO: GO FETCH SOME MORE
04100		ILDB	C,TTIBH+1	;YES: GET ONE
04200		JUMPE	C,TTYCH		;SKIP OVER NULLS
04300		POPJ	P,		;RETURN
04400	
04500	TTYINP:	IN	TTY,0		;INPUT UUO
04600		POPJ	P,		;ALL OK
04700		STATO	TTY,20000	;SEE IF EOF?
04800		JRST	TTYERR		;NO -- ERROR?
04900	TTINP1:	RELEAS	TTY,0		;EOF -- RE-INIT TTY
05000		OPEN	TTY,TTDEVI
05100		  ERROR	ICN
05200		MOVEI	C,TTIBUF	;SET UP INPUT BUFFER
05300		EXCH	C,.JBFF##
05400		INBUF	TTY,1
05500		MOVEM	C,.JBFF##	;RESTORE JOBFF
05600		JRST	TTYINP		;NOW TRY INPUT AGAIN
05700	
05800	TTYERR:	SETSTS	TTY,1		;CLR ERRORS
05900		CLRBFI
06000		OCRLF
06100		OUTSTR	[ASCIZ "TTY input error -- Retype line"]
06200		OCRLF
06300		JRST	TTINP1
     
00100	;SUBROUTINE TO SCAN NEXT ATOM
00200	;CALL:
00300	;	PUSHJ	P,SCAN
00400	;	<RETURN HERE>
00500	;C(ACCUM) := SIXBIT ATOM
00600	;C(T1)    := ASCII SEQ NUMBER FORM
00700	;C(T2)    := DECIMAL INTEGER
00800	;C(C)     := BREAK CHAR OR SPACE IF IDENT.
00900	
01000	SCAN:	TRZ	FL,TERMF!NUMF!IDF ;RESET FLAGS
01100		SKIPE	CS,SAVCHR	;CHECK TO SEE IF WE LEFT ONE LAST TIME
01200		JRST	SL1		;YES, IT MUST BE A DELIMITER
01300		SKIPN	C,SAVC		;BACK UP A CHARACTER?
01400		JRST	SL10		;NO
01500		PUSHJ	P,GNCHB		;YES, GET BITS
01600		TLNN	FL2,INPARS	;HANDLE SPECIAL IF IN PARSE
01700		JRST	SL11		;NOT IN INITIAL PARSE
01800		SETZM	SAVC
01900		SETZM	SAVCHR
02000		POPJ	P,		;RETURN IF SPACE DELIM
02100	SL10:	PUSHJ	P,GNCH		;GET A CHR
02200	SL11:	SETZM	SAVC
02300		JUMPE	CS,SL10		;CHECK FOR TAB, SPACE, AND IGNORE
02400		JUMPL	CS,SL1		;SPECIAL CHARACTER?
02500		MOVE	T3,[POINT 6,ACCUM] ;SET TO SAVE IDENT
02600		SETZM	ACCUM
02700		TLNE	CS,SNUMF_16	;CHECK FOR NUMBER
02800		JRST	SNUM1		;AND GO RACING OFF TO NUMBER ROUTINE
02900	SL2P:	TRO	FL,IDF		;IT IS AN IDENT
03000	SL2:	TLNE	T3,770000	;HAVE WE STORED ENOUGH?
03100		IDPB	CS,T3		;NO, STORE ANOTHER (RH OF CHR TABLE HAS SIXBIT)
03200		PUSHJ	P,GNCH		;CONTINUE
03300		JUMPG	CS,SL2		;CHECK FOR ANOTHER NUMBER OR LETTER
03400	SOK1:	MOVEM	CS,SAVCHR	;SAVE THE CHARACTER (MUST BE A SPECIAL CHR)
03500		TLNE	FL2,INPARS
03600		JRST	[MOVEM C,SAVC	;SAVE HERE IF IN PARSE
03700			 SETZB C,SAVCHR
03800			 POPJ P,]
03900		MOVEI	C,0		;ZERO IN C FOR NUMBERS AND IDNETS
04000		POPJ	P,
04100	
04200	SL1:	HRRZ	C,CS		;FOR SPECIAL CHARACTERS, RETURN RH OF CTABLE
04300		TLNE	CS,TERM_16	;CHECK FOR TERMINATOR
04400		TRO	FL,TERMF	;AND SET FLAG
04500		ANDI	C,377		;GET RID OF EXTRA BITS
04600		SETZM	SAVCHR		;ZERO SAVCHR FOR LATER
04700		CAIE	C,"."		;CHECK FOR .
04800		POPJ	P,		;NO RETURN
04900		MOVE	T1,CLN		;SET UP FOR CURRENT LINE AND PAGE
05000		MOVE	T2,CPGL
05100		TRO	FL,NUMF		;CALL IT A NUMBER
05200		POPJ	P,
     
00100	SNUM1:	SETZB	T1,T2		;SET NUMBER ACCUMS TO 0
00200	SN1A:	TLNE	T3,770000	;WILL STORE THE SIXBIT FOR FILE NAMES
00300		IDPB	CS,T3		;BUT ONLY IF LESS THAN 6
00400	SN1B:	TLNE	T1,(<177B7>)	;CHECK FOR 5 CHARS
00500		JRST	SOK2		;5 ALREADY
00600		LSH	T1,7		;ACCUMULATE ASCII IN T1
00700		IOR	T1,C
00800		IMULI	T2,^D10		;DECIMAL IN T2
00900		ADDI	T2,-"0"(C)
01000		PUSHJ	P,GNCH		;GET NEXT AND CONTINUE
01100		JUMPLE	CS,SOK2		;CHECK FOR END OF NUMBER
01200		TLNN	CS,SNUMF_16	;CHECK FOR NUMBER
01300		JRST	SL2P		;MUST BE AN IDENT
01400		JRST	SN1A		;CONTINUE SCANNING NUMBER
01500	
01600	SOK2:	TRO	FL,NUMF		;IT WAS A NUMBER
01700		LSH	T1,1		;CONVERT TO LINE NUMBER
01800		IOR	T1,[<ASCII /00000/>!1]
01900		JRST	SOK1		;SAVE DELIM AND RETURN
02000	
02100	SUBTTL PLACE FINDING ROUTINES
     
00100	
00200	;FIND-- PAGE TO FIND IS IN DPG. NUMBER TO FIND IS IN SINDEX.
00300	;LOADS T1 WITH THE LINE NUMBER FOUND
00400	;IF NO EXACT MATCH WILL FIND NEXT HIGHER NUMBER OR A PAGE MARK.
00500	
00600	FIND:	MOVE	T1,DPG		;GET THE DESIRED PAGE
00700		CAMLE	T1,CPG		;IS IT GREATER THAN THE PAGE WE ARE ON
00800		JRST	FWDPG		;YES, SEARCH FORWARD FOR PAGE
00900		CAML	T1,CPG		;IS IT THE SAME AS THE CURRENT PAGE?
01000		JRST	FEQPG		;YES, JUST SEARCH FOR LINE NUMER
01100		SUBI	PNTR,1		;BACK UP A LITTLE (IN CASE POINTED AT PAGE MARK)
01200	FIND1:	PUSHJ	P,CHKREN	;SEE IF REENTER
01300		JRST	FNDONE		;YES: FINISH UP
01400		SKIPN	T1,(PNTR)	;GET THE WORD, BUT WATCH FOR START OF BUFFER
01500		JRST	FINDHD		;WILL HAVE TO FINISH COPY AND START OVER
01600		CAME	T1,PGMK		;IS IT A PAGE MARK?
01700		SOJA	PNTR,FIND1	;CONTINUE SEARCHING
01800		SOS	T1,CPG		;DECREASE THE PAGE WE ARE NOW ON
01900		CAME	T1,DPG		;IS IT THE RIGHT ONE YET?
02000		SOJA	PNTR,FIND1	;NO, KEEP SEARCHING
02100		SUBI	PNTR,1		;BACK OVER PAGE MARK
02200	FIND2:	PUSHJ	P,CHKREN	;REENTER?
02300		JRST	FNDONE		;YES:
02400		SKIPN	T1,(PNTR)	;PICK UP WORD AND CHECK FOR START OF BUFFER
02500		JRST	FINDHD		;HAVE TO DO IT THE HARD WAY
02600		TRNN	T1,1		;IS IT A SEQUENCE NUMBER?
02700		SOJA	PNTR,FIND2	;NO, CONTINUE SEARCH
02800		CAMN	T1,PGMK		;IS IT PERHAPS A PAGE MARK?
02900		AOJA	PNTR,FNDFW1	;YES, GO FORWARD A LINE AND RETURN IT
03000		CAMGE	SINDEX,T1	;IS THE LINE WE WANT GREATER OR EQUAL TO THIS ONE
03100		SOJA	PNTR,FIND2	;NO, KEEP UP THE GOOD WORK
03200		CAMN	SINDEX,T1	;EXACT MATCH?
03300		POPJ	P,		;YES, RETURN
03400		JRST	FNDFW1		;GO FORWARD A LINE TO GET NEXT LARGER
03500	FEQPG:	SKIPN	T1,(PNTR)	;CHECK THE WORD WE ARE POINTING AT
03600		JRST	FNDFOO		;MUST BE POINTING AT END OF BUFFER OR BUFFER EMPTY
03700		CAMN	T1,PGMK		;IS IT A PAGE MARK?
03800		SOJA	PNTR,FIND2	;MUST BE ONE AT END OF PAGE, SEARCH BACKWARDS
03900	FEQPG1:	CAMGE	SINDEX,T1	;COMPARE TO LINE WE WANT
04000		JRST	FIND2		;WANT A SMALLER ONE, SEARCH BACK
04100		JRST	FNDFW1		;SEARCH FORWARD
04200	
04300	FWDPG:	PUSHJ	P,CHKREN	;REENTER?
04400		JRST	FNDONE		;YES:
04500		SKIPN	T1,(PNTR)	;SEARCH FORWARD FOR PAGE
04600		JRST	FNXRCP		;END OF BUFFER, GET A NEW ONE
04700		CAME	T1,PGMK		;FOUND A PAGE MARK?
04800		AOJA	PNTR,FWDPG	;NO, CONTINUE
04900		AOS	T1,CPG		;ADVANCE CURRENT PAGE COUNT
05000		CAME	T1,DPG		;AND SEE IF WE ARE THER YET
05100		AOJA	PNTR,FWDPG	;NUTS, LOOK SOME MORE
05200		ADDI	PNTR,1		;ADVANCE BEYOND PAGE MARK
05300	FNDFW1:
05400	FIND3:	PUSHJ	P,CHKREN	;REENTER?
05500		JRST	FNDONE		;YES:
05600		SKIPN	T1,(PNTR)	;LOOK FOR LINE
05700		JRST	FNXRC		;END OF RECORD, GET A NEW ONE
05800		TRNN	T1,1
05900		AOJA	PNTR,FIND3	;NOT LINE NUMBER
06000		CAMN	T1,PGMK		;PAGE MARK
06100		POPJ	P,		;RETURN IT, IT IS BEST MATCH WE CAN FIND
06200		CAMLE	SINDEX,T1	;ARE WE THERE YET?
06300		AOJA	PNTR,FIND3	;NO, CONTINUE SEARCH
06400		POPJ	P,		;YES, FINALLY
06500	
06600	FNDFOO:	CAMN	PNTR,BUFP	;ARE WE POINTED TO START OF BUFFER
06700		JRST	FDFOO1		;YES, BUFFER MUST BE EMPTY
06800		SUBI	PNTR,1		;NO, MUST HAVE BEEN AT END OF BUFFER
06900	FDFOO2:	SKIPN	T1,(PNTR)	;GET WORD
07000		ERROR	ICN		;MUST BE CONFUSED, THERE SHOULD BE A LINE NUMBER
07100		TRNN	T1,1		;SEARCH FOR LINE NUMBER
07200		SOJA	PNTR,FDFOO2	;KEEP LOOKING
07300		CAMN	T1,PGMK		;IS IT A PAGE MARK
07400		AOJA	PNTR,FNDFW1	;YES, SEARCH FORWARD
07500		JRST	FEQPG1		;GO DO SOMETHING WITH IT
07600	FDFOO1:	TRNE	FL,EOF2		;ARE WE AT END OF FILE?
07700		JRST	FINDHD		;WILL HAVE TO TRY FROM START
07800		PUSHJ	P,GETN		;GET THE NEXT BUFFER
07900		JRST	FEQPG
08000	
08100	;HERE TO SAY WE HAVE BEEN INTERUPTED
08200	
08300	FNDONE:	JRST	COMND		;JUST GO TO CMD LOOP FOR NOW
     
00100	FNXRCP:	TRNE FL,EOF2	;AR WE AT END OF FILE
00200		JRST FNX1	;YES, JUST RESET BGPG AND LOOK AGAIN
00300		PUSHJ P,GETN	;GET THE NEXT BUFFER
00400		JRST FWDPG	;AND CONTINUE SEARCH
00500	FNX1:	MOVE T1,CPG	;SET BGPG TO CURRENT PAGE
00600		MOVEM T1,BGPG
00700		TRO FL,BGSN	;RECORD THAT LARGEST PAGE SEEN
00800		MOVEI T1,0	;RETURN 0 FOR EOF
00900		POPJ P,
01000	
01100	FNXRC:	TRNE FL,EOF2	;ARE WE AT END OF FILE
01200		JRST FNX1	;YES, GIVE HIM BACK THE 0
01300		PUSHJ P,GETN	;NO, GET THE NEXT BUFFER
01400		JRST FIND3	;AND CONTINUE LOOKING FOR LINE
01500	
01600	FINDHD:	TRNE	FL,BOF		;ARE WE AT THE START OF THE FILE
01700		JRST	FNDFST		;YES, CAN NOT GO BACK JUST GIVE FIRST LINE OF FILE
01800		TLNE	FL,COPFIL	;IS THIS A COPY?
01900		JRST	FINDH4		;YES: DON'T RELEAS IN & OUT
02000		TRNE	FL,READOF	;ALSO HANDLE SPECIAL IF RO
02100		JRST	FINDH
02200		PUSHJ	P,OCOMPL	;FINISH COPYING FILE
02300		TLNN	FL2,PCHGF	;ANY CHANGES THIS PASS?
02400		JRST	[SETZB T1,T2	;NO - JUST DELETE OUTPUT
02500			 RENAME OUT,T1
02600			   JRST EDFLIN
02700			 RELEAS IN,0	;AND CLOSE INPUT FILE
02800			 JRST FINDH1]
02900	FINDH:	SKIPE AUXFIL
03000		JRST	[SETZB T1,T2
03100			 RENAME IN,T1
03200			   JRST EDFLIN
03300			 JRST .+1]
03400		RELEAS	IN,0		;RELEASE IO DEVICES
03500		MOVE	T1,[OCRBLK,,ICRBLK]
03600		BLT	T1,ICRBKE	;COPY TEMP SPECS TO INPUT
03700		MOVSI	T1,'TMP'	;GET CORRECT EXTENSION
03800		HLLM	T1,ICREXT
03900		TRNE FL,READOF	;READ ONLY?
04000		JRST FINDH1	;YES: SKIP RENAME
04100		PUSHJ P,OUTDO	;PURGE BUFFER
04200		XRENM	OUT,ICRBLK	;RENAME OUTPUT FILE
04300		JRST EDFLIN	;LOSER
04400	FINDH1:	RELEAS	OUT,0		;CLOSE NOW
04500		MOVE	T1,OCRDEV
04600		MOVEM	T1,OUDEVI+1	;GET OUTPUT STR ALSO
04700		MOVE	T1,ICRDEV
04800		MOVEM	T1,INDEVI+1
04900		OPEN IN,INDEVI	;AND GET THEM BACK
05000		JRST NODSK	;WHERE DID THE DISK GO, IT WAS HARE BEFORE
05100		OPEN OUT,OUDEVI
05200		JRST NODSK
05300		MOVE T1,BUFHD	;SET UP JOBFF TO ESTABLISH BUFFERS
05400		MOVEM T1,.JBFF##
05500		HLRZ	T1,EDBUF	;GET BUFFER INFO
05600		INBUF	IN,0(T1)
05700		OUTBUF	OUT,0(T1)
05800		TRNE FL,READOF	;ARE WE IN READ ONLY MODE?
05900		JRST FINDH2	;SET TO POINT TO ORIGINAL NAME AGAIN
06000		TLNE	FL2,PCHGF	;LEAVE AS IS IF NO CHANGES
06100		SETOM AUXFIL	;MARK AUX FILE IN USE
06200		XLOOK	IN,ICRBLK	;OPEN INPUT FILE
06300		JRST EDFLIN	;BUT IT JUST PUT ONE THERE
06400	IFN CRYPSW,<
06500		SETOM IBUF+3	;INIT BLK CNTR
06600	>
06700		XENTR	OUT,OCRBLK
06800		JRST	EDFLIN		;SOME OTHER BASTARD MUST BE USING IT
06900		SETZM	OPG		;OUTPUT PAGE CNTR
07000	IFN CRYPSW,<
07100		MOVNI T1,2
07200		MOVEM T1,OBUF+3	;INIT BLK CNTR
07300	>
     
00100	FINDH3:	SETZM	WC		;WC STARTS OUT 0
00200		TDZ	FL,[TECOF,,EOF!EOF2]
00300		TDO	FL,[FSTOPF,,BOF]
00400		TLNN	FL,COPFIL	;DON'T HURT THIS FLAG IF IN COPY
00500		TLZ	FL2,PCHGF	;NO CHANGES YET
00600		MOVEI	T1,1		;SET UP INPUT PAGE IN CASE OF
00700		MOVEM	T1,INPG		;ORDER OR LTL ERRORS ON INPUT
00800		SETZM	SVWD
00900		SETZM	OLDLIN		;USED IN CHECKING INPUT ORDER OF LINES
01000		PUSHJ	P,FILLBF	;FILL UP THE BUFFER
01100		MOVEI	T1,1
01200		MOVEM	T1,CPG		;START ON PAGE 1
01300		MOVE	PNTR,BUFP	;SET PNTR TO START OF WORLD
01400		JRST	FIND		;AND GO LOOKING
01500	
01600	FNDFST:	MOVE	T1,@BUFP	;GET FIRST WORD
01700	FNDFS1:	MOVE	PNTR,BUFP	;SET TO START OF WORLD
01800		POPJ	P,		;AND DISMISS
01900	
02000	FINDH4:	RELEAS	ALTDV,0		;LET GO OF ALTERNATE DEVICE
02100		OPEN	ALTDV,ALDEVI
02200		  JRST	NODSK
02300		MOVE	T1,SVJRL2
02400		MOVEM	T1,.JBFF##
02500		INBUF	ALTDV,0
02600		XLOOK	ALTDV,ALTBLK
02700		  JRST	NOFIL		;WHOOPS
02800		JRST	FINDH3
02900	
03000	FINDH2:	MOVE	T1,[ORGBLK,,ICRBLK]
03100		BLT	T1,ICRBKE	;SET UP FILE NAME
03200		XLOOK	IN,ICRBLK
03300		  JRST	NOFIL		;NO FILE THERE START OVER
03400	IFN CRYPSW,<
03500		SETOM	IBUF+3 >
03600		JRST	FINDH3		;GO ON
     
00100	
00200	;FIND THE NEXT LINE, PAGE MARK, ETC.
00300	
00400	FINDN1:	SKIPN T1,(PNTR)
00500		JRST FINDN2
00600		TRNN T1,1
00700	FINDN:	AOJA PNTR,FINDN1
00800		POPJ P,		;RETURN THE LINE
00900	
01000	FINDN2:	TRNE FL,EOF2	;IS IT EOF?
01100		POPJ P,		;YES, RETURN PRESENT T1 (0 FOR EOF)
01200		PUSHJ P,GETN	;GET NEXT BUFFER
01300		JRST FINDN1	;GO LOOK SOME MORE
01400	
01500	
01600	
01700	FINDZ1:	SKIPN T1,(PNTR)	;AS FINDN BUT STOPS AT END OF RECORD
01800		POPJ P,
01900		TRNN T1,1	;LINE NUMBER?
02000	FINDZ:	AOJA PNTR,FINDZ1
02100		POPJ P,
02200	
02300	
02400	
02500	;FIND THE PREVIOUS LINE
02600	
02700	FINDB1:	SKIPN T1,(PNTR)	;WATCH OUT FOR START OF BUFFER
02800		JRST FINDB2
02900		TRNN T1,1	;LINE NUMBER?
03000	FINDB:	SOJA PNTR,FINDB1	;TRY AGAIN
03100		CAMN T1,PGMK	;TEST FOR PAGE MARK
03200		SOS CPG		;NOW ON PREVIOUS PAGE
03300		POPJ P,		;RETURN LINE NUMBER
03400	
03500	FINDB2:	TRNE FL,BOF	;AT START OF FILE?
03600		JRST FNDFS1	;YES, GO GET THE FIRST LINE OF FILE
03700		MOVE T1,1(PNTR)	;GET THE FIRST LINE ON THIS PAGE
03800		TRNN T1,1	;MAKE SURE THERE IS ONE THERE
03900		ERROR ICN	;NO, WE ARE CONFUSED
04000		PUSH P,SINDEX	;SAVE (CALLER MAY NEED IT)
04100		MOVE SINDEX,T1
04200		PUSHJ P,FINDHD	;THIS WILL WORK AND WE WILL HAVE A LITTLE SPACE BEFORE
04300		POP P,SINDEX	;GET THIS BACK
04400		SOJA PNTR,FINDB1	;GO LOOK BACK AGAIN
04500	
04600	SUBTTL BUFFER HANDLING ROUTINES
     
00100	OCOMPL:	TLNN	FL2,PCHGF	;SEE IF NEEDED
00200		POPJ	P,		;NO - RETURN
00300	OCOMP0:	MOVE	T1,WC		;GET CURRENT WORD COUNT
00400		ADD	T1,BUFP		;TURN IT INTO A POINTER
00500		PUSHJ	P,DUMP		;DUMP DUMPS BUFFER FROM BUFP TO (T1)
00600		SETZM	WC		;TELL IT NO CURRENT WORD COUNT
00700		TRNE	FL,EOF2		;ALL DONE?
00800		POPJ	P,
00900		PUSHJ	P,FILLBF	;FILL UP INPUT BUFFER
01000		PUSHJ	P,CHKREN	;DID WE REENTER?
01100		JRST	COMND		;YES: GO TO COMMAND LOOP
01200		JRST	OCOMP0		;AND GO DUMP THIS ONE TOO
01300	
01400	
01500	
01600	GCHAR:		;;; ENTRY FOR UNSEQUENCE (CHAR MODE)
01700	GETWD:	TRNE	FL,EOF
01800		JRST	RTEOF		;RETURN 0 IF EOF
01900		TLNE	FL,COPFIL	;IN A COPY, WE GET FROM SOMEWHERE ELSE
02000		JRST	COPGET
02100		SOSG	IBUF+2		;CHECK FOR MORE WORDS
02200		PUSHJ	P,GETDO		;NO - GET SOME BY INPUT
02300	GETWD1:	ILDB	T3,IBUF+1	;PICK UP A WORD
02400		JUMPE	T3,GETWD	;IGNORE 0 WORDS
02500		POPJ	P,		;RETURN
02600	
02700	GETDO:	IN	IN,0		;FETCH A BUFFER
02800		  JRST	GTUNDO		;OK RETURN
02900		STATZ	IN,1B22		;ERROR - MAYBE EOF?
03000		TROA	FL,EOF		;EOF - SET FLAG
03100		ERROR	DIE		;YOU LOSE!
03200		POP	P,0(P)		;RETURN UP A LEVEL
03300	RTEOF:	MOVEI	T3,0		;AND RETURN A ZERO
03400		POPJ	P,
03500	
03600	GTUNDO:
03700	IFN CRYPSW,<
03800		MOVEM	7,S.CRYP+7
03900		MOVEI	7,S.CRYP
04000		BLT	7,S.CRYP+6
04100		AOS	6,IBUF+3	;GET BLK NUMBER
04200		MOVE	5,ICRCOD
04300		HRRZ	7,IBUF		;ADDR OF BUFFER
04400		ADD	7,[XWD -200,2]
04500		PUSHJ	P,CRYPT.##
04600		MOVSI	7,S.CRYP
04700		BLT	7,7
04800	>
04900		POPJ	P,
     
00100	PCHAR:		;;; ENTRY FOR UNSEQUENCE (CHAR MODE)
00200	OUTWD:	SOSG	OBUF+2		;CHECK WORDS LEFT
00300		PUSHJ	P,OUTDO
00400	OUTWD1:	IDPB	T3,OBUF+1	;OUTPUT IT
00500		POPJ	P,		;AND RETURN
00600	
00700	OUTDO:	TLNE	FL2,DSKCK	;CHECK DISK?
00800		PUSHJ	P,DSKTST	;YES:
00900	IFN CRYPSW,<
01000		MOVEM	7,S.CRYP+7
01100		MOVEI	7,S.CRYP
01200		BLT	7,S.CRYP+6
01300		HRRZ	7,OBUF
01400		ADD	7,[XWD -200,2]
01500		MOVE	5,OCRCOD
01600		AOSL	6,OBUF+3	;ALLOW FOR DUMMY OUTPUT
01700		PUSHJ	P,CRYPT.##
01800		MOVSI	7,S.CRYP
01900		BLT	7,7
02000	>
02100		OUT	OUT,0
02200		  POPJ	P,		;NO ERRORS - RETURN
02300		PUSH	P,[OUTDOK]	;FAKE UP PDL
02400		PUSH	P,T1		;SAVE T1
02500		PUSH	P,T2		;  AND T2
02600		STATO	OUT,1B21	;ERROR OR QUOTA EXCEDED
02700		ERROR	DDE		;ERROR - YOU LOSE
02800		JRST	DSKBTL		;GO TELL LOSER
02900				;;;; POPJ RETURN TO .+1
03000	OUTDOK:	TLO	FL2,DSKCK	;REMEMBER THIS HAPPENED
03100		POPJ	P,		;OUTPUT ALREADY DONE IT SEEMS
03200	
03300	;ROUTINE TO DUMP BUFFER FROM BUFP TO (T1)
03400	
03500	DUMP:	MOVE	T2,BUFP
03600		CAMGE	T2,T1		;CHECK TO SEE IF WE ARE DUMPINF ANYTHING
03700		TRZ	FL,BOF		;IF SO TURN OFF BOF
03800		TRNN	FL,READOF	;RETURN IF READ ONLY MODE
03900	DUMP1:	CAML	T2,T1		;MORE TO DO?
04000		POPJ	P,		;NO, RETURN
04100		PUSH	P,T1		;SAVE FOR LATER
04200		MOVEI	T1,1(T2)	;FIND END OF THIS LINE
04300	DUMP3:	SKIPN	T3,(T1)		;ANY OLD END WILL DO
04400		JRST	DUMP2
04500		TRNN	T3,1		;SUCH AS A LINE NUMBER
04600		AOJA	T1,DUMP3	;NOT YET
04700	DUMP2:	SUB	T1,T2		;GET LENGTH
04800		CAML	T1,OBUF+2	;WILL IT FIT?
04900		PUSHJ	P,OUTDO		;NO, DUMP CURRENT BUFFER
05000	DUMP4:	MOVE	T3,(T2)		;PICK UP WORD
05100		CAMN	T3,PGMK		;COUNT UP OUTPUT PAGES
05200		AOS	OPG		;...
05300		PUSHJ	P,OUTWD
05400		ADDI	T2,1		;ADVANCE POINTER
05500		SOJG	T1,DUMP4	;AND CHECK COUNT
05600		POP	P,T1
05700		JRST	DUMP1		;GO CHECK FOR END
     
00100	DSKTST:	PUSH	P,T1		;SAVE SOME AC'S
00200		PUSH	P,T2
00300		PUSHJ	P,FREDSK	;FIND OUT HOW MUCH DSK THERE IS
00400		CAIL	T1,MINDSK	;LESS THAN MINIMUM?
00500		JRST	DSKRET		;NO: PROCEED
00600	DSKBTL:	CLRBFI			;YES: CLEAR TYPE AHEAD
00700		OUTSTR	DSKMS2		;TELL HIM WHAT HAPPENED
00800		PUSHJ	P,TELSP0	;SUMMARY OF SPACE
00900	
01000	DSKTS0:	OUTSTR	[ASCIZ /
01100	Well? /]
01200		INCHRW	T1		;GET ANSWER
01300	DSKTS1:	CLRBFI
01400		OCRLF
01500		ANDI	T1,137		;FORCE UPPER CASE
01600		CAIN	T1,"G"
01700		JRST	NOWAT
01800		CAIN	T1,"R"
01900		JRST	DSKRES
02000		CAIN	T1,"T"
02100		JRST	TTEST
02200		CAIE	T1,"W"
02300		JRST	DSKHLP
02400		TLO	FL2,SLPSW	;SET FOR SPECIAL SLEEP ACTION
02500	CHKTYP:	INCHRS	T1		;LOOK FOR CHAR
02600		JRST	TRYDSK		;NOPE - TRY DSK OUTPUT
02700		JRST	DSKTS1		;YES - LOOK AT WHAT HE TYPED
02800	
02900	TRYDSK:	MOVEI	T1,2		;SLEEP FOR 2 SEC.
03000		SLEEP	T1,		;ZZZ
03100	TTEST:	PUSHJ	P,FREDSK	;CHECK FREE STORAGE
03200	BTEST:	CAIL	T1,MINDSK	;OK NOW?
03300		JRST	[OUTSTR [ASCIZ /DSK ok now./]
03400			 OCRLF
03500			 JRST DSKRET]
03600		TLNN	FL2,SLPSW	;CHECK SPECIAL
03700		JRST	DSKTS0		;TO TOP OF LOOP
03800		OUTCHR	[15]
03900		JRST	CHKTYP		;TRY AGAIN
04000	
04100	NOWAT:	TLZ	FL2,DSKCK	;TURN OFF DISK CHECKING
04200	DSKRET:	POP	P,T2		;RESTORE AC'S
04300		POP	P,T1
04400		POPJ	P,
04500	
04600	DSKRES:	PUSHJ	P,TELSPC	;PRINT OUT RESOURCES
04700		JRST	BTEST		;AND TRY NOW.
04800	
04900	FREDSK:	MOVE	T1,[3,,STRNAM]	;DSKCHR UUO
05000		DSKCHR	T1,
05100		  SKIPA	T1,[^D100]	;AS GOOD A NUMBER AS ANY
05200		SKIPG	T1,STRNAM+1	;GET AMOUNT IN T1
05300		ADDI	T1,OVRDRW	;ADJUST FOR OVERDRAW
05400		CAMLE	T1,STRNAM+2	;HOW ABOUT THE REST OF THE WORLD
05500		MOVE	T1,STRNAM+2	;DISK IS FULL - GIVE LESSER
05600		POPJ	P,
05700	
05800	;ROUTINE TO SET UP STR INFO FOR DSKCHK
05900	
06000	STRSET:	MOVEI	T1,OUT		;PATH UUO ON OUTPUT CHL
06100		MOVEM	T1,PTHADR
06200		MOVE	T1,[<SFDLVL+4>,,PTHADR]
06300		PATH.	T1,
06400		  SKIPA	T1,[SIXBIT "DSK"]
06500		MOVE	T1,PTHADR
06600		MOVEM	T1,STRNAM	;STORE STRUCTURE NAME
06700		MOVE	T1,[5,,STRNAM]
06800		DSKCHR	T1,		;GET REAL NAME
06900		  SKIPA	T1,[SIXBIT "DSK"]
07000		MOVE	T1,STRNAM+4
07100		MOVEM	T1,STRNAM	;ACTUAL NAME
07200		MOVEM	T1,OCRDEV	;ACTUAL DEVICE
07300		POPJ	P,
     
00100	DSKHLP:	OUTSTR	DSKMSG
00200		JRST	DSKTS0
00300	
00400	DSKMSG:	ASCIZ	"You must type:
00500	G - Do the output (now and forever).
00600	T - Test disk space and do output if space available.
00700	R - Give resources and do output if space available.
00800	W - Wait until either space appears or you type a different response.
00900	"
01000	DSKMS2:	ASCIZ	"
01100	[Insufficient disk space to do output]
01200	
01300	"
01400	
01500	TELSPC:	PUSHJ	P,FREDSK
01600	TELSP0:	MOVE	T2,STRNAM+1	;GET FREE SPACE
01700		JUMPL	T2,TELOVR	;OVERDRAWN?
01800	TELSP1:	PUSHJ	P,DPRNT		;PRINT IN DECIMAL
01900		OUTSTR	[ASCIZ " disk blocks in your area on "]
02000		MOVE	T2,STRNAM	;SIXBIT ATOM TO PRINT
02100		PUSHJ	P,PRTSX6
02200		PUSHJ	P,FORCE		;DUMP BUFFER
02300		OCRLF
02400		MOVE	T2,STRNAM+2	;GET REST OF WORLD
02500		PUSHJ	P,DPRNT		;IN DECIMAL
02600		OUTSTR	[ASCIZ " blocks for all users on this structure"]
02700		OCRLF
02800		POPJ	P,		;RETURN
02900	
03000	TELOVR:	OUTSTR	[ASCIZ "Over quota by "]
03100		MOVN	T2,T2		;TELL HIM BAD NEWS
03200		JRST	TELSP1
03300	
03400	INSIST:	OUTSTR	[ASCIZ "? You must type either "]
03500	CONFRM:	OUTSTR	[ASCIZ "(y or n): "]
03600		INCHRW	T1		;GET RESPONSE
03700		ANDI	T1,137		;FORCE UPPER CASE
03800		CLRBFI
03900		CAIE	T1,"N"
04000		JRST	CONFRY	;MAYBE HE MEANT YES
04100		OUTSTR	[ASCIZ "o
04200	"]
04300		POPJ	P,
04400	
04500	CONFRY:	CAIE	T1,"Y"
04600		JRST	INSIST
04700		OUTSTR	[ASCIZ "es
04800	"]
04900		JRST	CPOPJ1
     
00100	
00200	GETN:	MOVE T1,WC	;GET THE NEXT BUFFER. FIND CURRENT WORD COUNT
00300		CAMGE T1,HLFWC	;GREATER THAN HALF OF MAX POSSIBLE?
00400		JRST FILLBF	;NO, JUST REFILL BUFFER
00500		ASH T1,-1	;YES, TAKE HALF OF IT
00600		ADD T1,BUFP	;CONVERT TO POINTER
00700	GETN1:	SKIPN T2,(T1)	;LOOK FOR A WORD BOUNDARY
00800		JRST NOWFL	;WE ARE HERE?
00900		TRNN T2,1	;SEQUENCE NUMBER?
01000		SOJA T1,GETN1
01100	NOWFL:	PUSHJ P,DUMP	;DUMP IT
01200		MOVE T2,T1	;COPY POINTER
01300		SUB T2,BUFP	;AND FIND OUT HOW MANY DUMPED
01400		SUB PNTR,T2	;ADJUST POINTER
01500		EXCH T2,WC	;CALC NEW WORD COUNT
01600		SUBB T2,WC
01700		ADD T2,BUFP	;GET POINTER TO END OF BUFFER
01800		HRLS T1		;SET UP BLT
01900		HRR T1,BUFP
02000		BLT T1,(T2)
02100		JRST FILLBF	;AND FINISH FILLIN BUFFER
02200	
02300	
02400	
02500	FILLBF:	MOVE T1,WC	;GET WORD COUNT
02600		ADD T1,BUFP	;AND CONVERT TO POINTER TO END OF BUFFER
02700	FILBF3:	CAML T1,FILPT	;FULL ENOUGH?
02800		POPJ P,		;YES, RETURN
02900		TLNE FL,TECOF	;SPECIAL READING FOR TECO FILES
03000		JRST RDTECO
03100		HRLI T1,-MXWPL-2	;GET A COUNT FOR MAX LINE SIZE
03200		SKIPN T3,SVWD	;SEE IF THERE IS A WORD LEFT FROM LAST TIME
03300		PUSHJ P,GETWD	;ELSE GET A NEW ONE
03400		JUMPE T3,SNEOF	;MUST BE EOF
03500		CAMN	T3,PGMK		;CHECK FOR PAGE MARKS
03600		JRST	CKPGMK		;GO FUDGE P/M
03700		TLZE FL,FSTOPF	;IF FIRST OP
03800		JRST CKTECO	;CHECK FOR TECO FILE
03900	NOTECO:	MOVEM T3,SVWD2	;SAVE FOR SEQUENCE CHECK
04000		JRST FILBF4	;GO PUT IT AWAY
04100	FILBF1:	PUSHJ P,GETWD	;ELSE GET A NEW ONE
04200		JUMPE T3,FILBF2	;0 WORD MUST BE EOF
04300		TRNE T3,1	;CHECK FOR SEQNUM
04400		JRST FILBF2	;YES, FINISH PUTTING IT IN
04500	FILBF4:	MOVEM T3,(T1)	;PUT IN THIS WORD
04600		AOS WC		;AND ADVANCE WORD COUNT
04700		AOBJN T1,FILBF1	;ADVANCE POINTER AND CHECK COUNT
04800		JRST INLTL	;LINE IS TOO LONG
04900	FILBF2:	MOVEM T3,SVWD	;SAVE THIS WORD
05000	FILBF0:	SETZM (T1)	;MAKE SURE OF A ZERO WORD
05100		HRRZS T1	;ELIMINATE COUNT INFO
05200		MOVE T3,SVWD2	;CHECK ON ORDER OF INPUT LINES
05300		CAMG T3,OLDLIN	;CHECK FOR CORRECT ORDER
05400		JRST OUTOFO	;LINES ARE OUT OF ORDER
05500	FILBF5:	MOVEM T3,OLDLIN	;SAVE FOR LATER
05600		SKIPE SVWD	;CHECK TO SEE IF WAS EOF
05700		JRST FILBF3	;AND TRY FOR MORE
05800	SNEOF:	SETZM (T1)	;MAKE SURE OF ZERO WORD
05900		TRO FL,EOF2	;SET EOF FLAG
06000		MOVE T1,INPG	;GET INPUT PAGE
06100		MOVEM T1,BGPG	;AND SET LARGEST PAGE
06200		TRO FL,BGSN
06300		SETZM SVWD	;ALSO ZERO EXTRA WORD
06400		POPJ P,		;AND RETURN
06500	
06600	CKPGMK:	SETZM	OLDLIN		;RESET LINE LAST INPUT
06700		AOS	INPG		;INCR INPUT PAGE
06800		MOVEM	T3,0(T1)	;STASH PGMK
06900		AOS	WC		;INCR WORD/COUNT
07000		PUSHJ	P,GETWD		;PASS NEXT WORD
07100		MOVE	T3,PGMKW2	;GRNTEE CORRECT P/M 2ND WORD
07200		MOVEM	T3,1(T1)	;STASH
07300		AOS	WC		;INCR WC
07400		SETZM	2(T1)		;GRNTEE ZERO WORD
07500		SETZM	SVWD		;FORCE READ
07600		MOVEI	T1,2(T1)	;CORRECT PNTR
07700		JRST	FILBF3		;CHECK FULL
07800	
07900	INLTL:	PUSHJ P,GETWD	;FIND THE END OF THE LINE ON INPUT
08000		JUMPE T3,INLTL2	;THIS IS IT
08100		TRNN T3,1	;OR MAYBE THIS
08200		JRST INLTL	;KEEP LOOKING
08300	INLTL2:	MOVEM T3,SVWD	;SAVE IT
08400		PUSH P,T1	;SAVE POINTER TO END OF IT
08500		SUBI T1,2	;LAST PART THAT IS IN THE LINE
08600		MOVEI T2,<BYTE (21)0(7)15,12>	;A CRLF
08700		DPB T2,[POINT 15,(T1),35]	;MAKE SURE IT ENDS PROPERLY
08800	INLTL1:	SKIPN T2,(T1)	;NOW LOOK FOR THE START OF IT
08900		ERROR ICN	;SOMETHING HAS GONE WRONG, THERE IS NO LINE 
09000		TRNN T2,1	;START?
09100		SOJA T1,INLTL1	;NO, TRY AGAIN
09200		MOVE T2,INPG	;PRINT HIM THE CURRENT PAGE
09300		PUSHJ P,PGPRN
09400		PUSHJ P,OUTLIN	;PRINT THE LINE
09500		RERROR LTL	;AND THE ERROR MESSAGE
09600		POP P,T1	;RESTORE POINTER TO END
09700		SOS WC	;GET WORD COUNT CORRECTED
09800		SOJA T1,FILBF0	;AND CONTINUE FILL
09900	
10000	OUTOFO:	PUSH P,T1	;SAVE THE POINTER
10100		PUSH P,T3	;SAVE T3 ALSO
10200		SUBI T1,1	;GET BACK INTO LINE
10300	OUTOF1:	SKIPN T2,(T1)	;LOOK FOR START OF LINE
10400		ERROR ICN	;HORRIBLE CONFUSION
10500		TRNN T2,1	;CHECK FOR SEQ NUM
10600		SOJA T1,OUTOF1	;NOPE, TRY SOME MORE
10700		MOVE T2,INPG	;PRINT HIM THE PAGE
10800		PUSHJ P,PGPRN
10900		PUSHJ P,OUTLIN	;PRINT THE LINE
11000		RERROR ORDER	;GIVE HIM SOMETHING TO THINK ABOUT
11100		POP P,T3	;RESTORE
11200		POP P,T1	;GET SET TO GO ON
11300		JRST FILBF5	;GO
     
00100	CKTECO:	TRNE T3,1	;CHECK FOR A LINE NUMBER
00200		JRST NOTECO	;NO ITS NOT A TECO FILE
00300		TLO FL,TECOF	;SET WARNING FLAG
00400		SETZM SVWD	;GRNTEE USE FIRST SEQ #
00500		TLNE FL,COPFIL	;IS IT ANOTHER FILE?
00600		JRST CKTEC2	;SPECIAL CHECK
00700		TLO	FL2,PCHGF!FCHGF	;SAVE WE'VE CHANGED
00800		SETSTS IN,1	;SET FOR CHAR AT A TIME INPUT
00900		MOVSI T3,(<POINT 7,0>)
01000		HLLM T3,IBUF+1	;SET INPUT BYTE POINTER
01100		MOVEI T3,5	;COMVERT TO CHRS
01200		IMULM T3,IBUF+2
01300		AOS IBUF+2	;AND COMPENSATE FOR THINKING WE TOOK ONE
01400	
01500	RDTECO:	HRRZM T1,TMPT1	;SAVE THIS FOR A WHILE
01600		MOVEI T3,1(T1)	;ZERO OUT A FEW WORDS
01700		HRL T3,T1
01800		SETZM (T1)
01900		BLT T3,MXWPL(T1)
02000		ADDI T1,1	;THIS IS WHERE CHRS SHOULD BE PUT
02100		PUSH P,T1	;SAVE
02200		SKIPE BASICF	;IS THIS A BASIC FILE
02300		JRST RDBAS	;YES: PROCESS SPECIAL
02400		SKIPE T1,SVWD	;CHECK BEGINNING OF PAGE
02500		CAIN T1,1	;...
02600		JRST	[MOVE T1,TECFST
02700			 MOVEM T1,SVWD
02800			 MOVEM T1,SVWD2
02900			 JRST RDTEC1]
03000		MOVE T2,TECINC	;GET INCREMENT
03100		PUSHJ P,ASCIAD
03200		MOVEM T1,SVWD	;SAVE FOR LATER
03300		MOVEM T1,SVWD2	;AND FOR ORDER CHECK
03400		CAMGE T1,TECINC		;CHECK WAR
03500		JRST INSPG1	;FORCE PAGE INSERT
03600	RDTEC1:	EXCH T1,(P)	;GET OLD T1 BACK AND SAVE NUMBER
03700		MOVEI T2,MXWPL*5-2	;COUNT
03800		MOVEI T3,11	;FIRST CHR
03900		HRLI T1,(<POINT 7,0>)
04000		IDPB T3,T1
04100	LINL1:	PUSHJ P,GETWD	;NEXT CHR
04200	LINL1A:	CAIN T3,15
04300		JRST LINL1	;IGNORE RETURNS
04400		CAIN T3,14
04500		JRST	[SKIPE BASICF	;ILLEGAL IN BASIC MODE
04600			 ERROR BBF
04700			 JRST IPGMK]
04800		JUMPE T3,EOF1	;MUST BE END OF FILE
04900		POP P,-1(T1)	;PUT NUMBER IN PROPER PLACE
05000		JRST LP1	;AND READ MORE OF LINE
05100	CLP:	PUSHJ P,GETWD
05200	LP1:	CAIN T3,15	;IGNORE RETURNS
05300		JRST CLP
05400		CAIE T3,0	;FOR EOF
05500		CAIN T3,12	;OR LINE FEED
05600		JRST LINFD	;GO PUT IN RETURN LINE FEED
05700		CAIN	T3,14
05800		JRST	LINFD
05900		IDPB T3,T1	;ELSE DEPOSTI
06000		SOJG T2,CLP	;HAVE WE RUN OUT
06100		ADD T1,[XWD 700,0]	;BACK UP POINTER
06200		TLZ FL,TECOF	;USE THE ABSENCE AS A FLAG
06300		PUSHJ P,GETWD
06400		CAIE T3,12
06500		JUMPN T3,.-2
06600	LINFD:	MOVEI T3,15
06700		IDPB T3,T1
06800		MOVEI T3,12
06900		IDPB T3,T1
07000		MOVEI T1,1(T1)
07100		MOVE T3,T1
07200		SUB T3,TMPT1	;GET COUNT
07300		ADDM T3,WC
07400		TLOE FL,TECOF	;IF OFF WE HAD A LTL ERR
07500		JRST FILBF0	;THIS WILL FINISH UP
07600		PUSH P,T1	;SET UP FOR LTL CODE
07700		AOS WC
07800		AOS (P)
07900		SOJA T1,INLTL1
08000	
08100	INSPG1:	POP P,T1
08200		SKIPA
08300	IPGMK:	POP P,T2	;GET RID OF IT
08400		MOVEI T3,1	;SO IT WILL NOT BE EOF
08500		MOVEM T3,SVWD	;SO WE START OVER
08600		MOVE T3,PGMK
08700		MOVEM T3,OLDLIN
08800		MOVEM T3,-1(T1)
08900		MOVEI T2,2
09000		ADDM T2,WC
09100		MOVE	T3,PGMKW2
09200		MOVEM T3,(T1)
09300		SETZM	1(T1)		;GRNTEE ZERO
09400		MOVEI	T1,1(T1)	;UPDATE PNTR
09500		AOS	INPG		;INCR INPUT PAGE
09600		JRST	FILBF3		;FINISH OFF
09700	
09800	EOF1:	POP P,T2	;CLEAR STACK
09900		SOJA T1,SNEOF
10000	
10100	;HERE TO HANDLE BASIC FILES
10200	
10300	RDBAS:	MOVEI	T2,5		;5 CHARS MAX
10400		MOVE	T1,[<ASCII "00000">_<-1>]
10500	
10600	RDBAS0:	PUSHJ	P,GETWD		;GET CHAR
10700		JUMPE	T3,BASEOF	;MUST BE EOF
10800		CAIE	T3,40		;SKIP SPACES
10900		CAIN	T3,11		;AND/OR TABS
11000		JRST	RDBAS0
11100		CAIG	T3,"9"		;FIRST CHAR MUST BE A DIGIT
11200		CAIGE	T3,"0"		;...
11300		ERROR	BBF
11400		JRST	RDBDG1
11500	
11600	RDBDIG:	PUSHJ	P,GETWD		;FETCH NEXT CHAR
11700		JUMPE	T3,BASEOF	;EOF SEEN IF T3 := 0
11800		CAIG	T3,"9"		;MUST BE DIGIT
11900		CAIGE	T3,"0"
12000		JRST	RDBDG2		;END OF DIGIT STREAM
12100	RDBDG1:	LSH	T1,7		;MAKE ROOM FOR NEW DIGIT
12200		ADD	T1,T3
12300		SOJA	T2,RDBDIG	;ADD IN AND READ NEXT
12400	
12500	RDBDG2:	SKIPGE	T2		;CHECK FOR MORE THAN 5
12600		ERROR	BBF
12700		LSH	T1,1		;MAKE LIKE REAL SEQ #
12800		IORI	T1,1
12900		MOVEM	T1,SVWD		;SAVE GOOD THINGS
13000		MOVEM	T1,SVWD2
13100		EXCH	T1,0(P)		;GET PNTR BACK & SAVE #
13200		HRLI	T1,(<POINT 7,0>);FORM B.P.
13300		MOVEI	T2,11		;DEPOSIT A TAB
13400		IDPB	T2,T1		;...
13500		MOVEI	T2,MXWPL*5-2	;INIT LTL CNTR
13600		CAIE	T3,11		;IF TAB
13700		CAIN	T3,40		; OR SPACE
13800		JRST	LINL1		;GET NEXT CHAR
13900		JRST	LINL1A		;ELSE ALREADY HAVE CHAR
14000	
14100	BASEOF:	POP	P,T1		;RETURN POINTER
14200		JRST	SNEOF		;SAY EOF SEEN
14300	
14400	SUBTTL RANGE SPECIFIER READERS
     
00100	
00200	;ROUTINE TO GET ONE LINE NUMBER FROM INPUT STREAM. HANDLES + AND -
00300	
00400	GETLS:	PUSHJ P,SCAN
00500	GETL:	TRZ FL,LINSN!ADDL!SUBL
00600		TRZ FL2,STARF
00700		TLZ FL2,UARWF
00800		CAIN C,"^"
00900		JRST DOFST
01000		CAIN C,"*"
01100		JRST DOLST
01200	IFN EXTEND,<
01300		CAIN C,200	;DO WE HAVE TO SEARCH FOR IT
01400		PUSHJ P,LSRCH	;OK THEN HERE WE GO
01500	>
01600		TRZN FL,NUMF
01700		POPJ P,		;SCAN DID NOT SEE A NUMBER RETURN (CALLER CAN GIVER ERR)
01800		MOVEM T1,HILN	;SAVE THE NUMBER HERE
01900	GETL1:	TRO FL,LINSN	;SET A FLAG TO SAY WE SAW THE LINE
02000		PUSHJ P,SCAN	;SCAN FOR + OR -
02100		CAIN C,"+"
02200		JRST ADDNUM
02300		CAIE C,"-"
02400		POPJ P,		;NEITHER
02500		TROA FL,SUBL	;SET SUBTRACT FLAG
02600	ADDNUM:	TRO FL,ADDL	;SET ADD FLAG
02700		PUSHJ P,SCAN	;SCAN ANOTHER
02800		TRZN FL,NUMF	;WAS IT A NUMBER
02900		NERROR ILC	;ANYTHING ELSE IS ILLEGAL
03000		MOVEM T2,SVINC	;SAVE IT
03100		JRST SCAN	;RETURN AFTER SCANNING ONE MORE
03200	DOLST:	TRO FL2,STARF
03300		JRST GETL1
03400	DOFST:	TLO FL2,UARWF
03500		JRST GETL1
03600	
03700	
03800	
03900	;ROUTINE TO RESOLVE THE + AND - IN THE LINE NUMBER. WE MUST WAIT
04000	;UNTIL THE PAGE HAS BEEN DEFINED BEFORE DOING THIS
04100	
04200	ADDSUB:	MOVE SINDEX,HILN	;GET THE NUMBER
04300		MOVE T1,HIPG	;GET THE REQUIRED PAGE
04400		MOVEM T1,DPG	;AND SET IT AS THE DESIRED ONE
04500		TLNE FL2,UARWF
04600		JRST	[MOVE SINDEX,[<ASCII /00000/>!1]
04700			PUSHJ P,FIND
04800			SKIPE T1	;FIND ANY
04900			CAMN T1,PGMK
05000			MOVE T1,[<ASCII /00100/>!1]
05100			MOVE SINDEX,T1
05200			JRST DOAS]
05300		TRNN FL2,STARF
05400		JRST DOAS
05500		MOVE SINDEX,[<ASCII /99999/>!1]	;FIND A BIG LINE
05600		PUSHJ P,FIND
05700		CAME T1,[<ASCII /99999/>!1]	;IF ITS THERE ITS LAST
05800		PUSHJ P,FINDB		;ELSE BACK UP
05900		SKIPE T1		;CHECK TO SEE IF EMPTY PAGE
06000		CAMN T1,PGMK
06100		SKIPA
06200		MOVE SINDEX,T1	;OK, USE ONE FOUND, ELSE LEAVE BIG
06300	DOAS:	TRZE FL,ADDL	;DID WE WANT TO ADD?
06400		JRST ADLIN	;YES, GO ADD
06500		TRZN FL,SUBL	;OR SUBTRACT?
06600	CPOPJ:	POPJ P,	;NO, RETURN
06700		PUSHJ P,FIND	;GET THE DESIRED LINE
06800	SUBL1:	SOSGE SVINC	;DO WE WANT TO GO BACK STILL FARTHER
06900		POPJ P,		;NO, ALL DONE
07000		PUSHJ P,FINDB	;GET THE PREVIOUS LINE
07100		SKIPE T1	;0 MUST BE AT START OF BUFFER, QUIT
07200		CAMN T1,PGMK	;WAS IT A PAGE MARK?
07300		POPJ P,		;YES, AS FAR AS WE GO, SINDEX HAS CORRECT NUMBER
07400		MOVE SINDEX,T1	;THIS WILL DO
07500		JRST SUBL1	;GO TRY FOR MORE
07600	ADLIN:	PUSHJ P,FIND	;GET DESIRED LINE
07700		CAME T1,PGMK	;WAS IT A PAGE MARK?
07800		JUMPN T1,ADLIN1	;OR 0 (I.E. END OF FILE)
07900		POPJ P,		;RETURN WITH ORIGINAL NUMBER
08000	ADLIN1:	CAME T1,HILN	;SEE IF AN EXACT MATCH
08100		SOS SVINC	;IF NO, ALREADY ARE +1
08200		MOVE SINDEX,T1	;GET THE WORD WE HAVE FOUND
08300	ADLIN2:	SOSGE SVINC	;NEED TO GO FURTHER
08400		POPJ P,		;NO, RETURN RESULTS
08500		PUSHJ P,FINDN	;GET THE NEXT LINE IN SEQUENCE
08600		CAME T1,PGMK	;PAGE MARK?
08700		JUMPN T1,.+2	;OR EOF
08800		POPJ P,		;YES, RETURN
08900		MOVE SINDEX,T1	;ACCEPT NEW NUMBER
09000		JRST ADLIN2	;AND LOOK FOR MORE
09100	
     
00100	
00200	;ROUTINE GETS A FULL SEQ NUMBER OF FORM A/B
00300	
00400	GETLAS:	PUSHJ P,SCAN
00500	GETLA:	TRZ FL,PGSN	;NO PAGE SEEN YET
00600		PUSHJ P,GETL	;GET THE LINE NUMBER PART
00700		MOVE T2,CPGL	;IN CASE LSRCH GOT A NEW PAGE
00800		TRNE FL,PGSN	;DID LSRCH GET PAGE?
00900		MOVEM T2,HIPG	;YES, USE IT
01000		CAIE C,"/"	;IS THIS A PAGE COMMING?
01100		JRST NOPG	;NO, A LINE NUMBER AT MOST
01200		PUSHJ P,SCAN	;YES, GET THE PAGE NUMBER
01300		CAIN C,"*"
01400		JRST LASTPG		;GET LAST PAGE #
01500		CAIE C,"^"		;UPARROW MEANS
01600		JRST GETLPG		;GET PAGE 1
01700		MOVEI T2,1
01800		TRO FL,NUMF		;MAKE LIKE NUMBER
01900	GETLPG:	SKIPLE T2	;NUMBERS .LE. 0 LOSE
02000		TRZN FL,NUMF	;WAS IT A NUMBER
02100		NERROR ILC	;LOSE LOSE
02200		TRO FL,PGSN	;YEP, WE SAW IT
02300		MOVEM T2,HIPG	;SAVE THAT NUMBER
02400		PUSHJ P,SCAN	;CHECK FOR + OR -
02500		CAIN C,"+"
02600		JRST PGPLS
02700		CAIE C,"-"
02800		JRST NOPG	;NO, GO DO ADSUB ON LINE NUMBER
02900		PUSHJ P,SCAN	;GET THE NUMBER
03000		TRZN FL,NUMF	;MUST BE A NUMBER
03100		NERROR ILC
03200		MOVE T1,HIPG
03300		SUB T1,T2
03400		MOVEM T1,HIPG	;FILL IN NUMBER
03500	NOPGA:	PUSHJ P,SCAN	;SCAN PAST NUMBER
03600	NOPG:	TRNN FL,LINSN!PGSN	;DID WE SEE A LINE OR A PAGE?
03700		NERROR ILC	;NO, SOMETHING IS WRONG
03800		PUSH P,T1	;SAVE (HAVE ALREADY SCANNED)
03900		PUSH P,T2
04000		PUSHJ P,ADDSUB	;TAKE CARE OF + AND - FOR LINE
04100		POP P,T2
04200		POP P,T1
04300		MOVEM SINDEX,HILN	;SAVE RESULT
04400		POPJ P,		;AND RETURN
04500	
04600	PGPLS:	PUSHJ P,SCAN	;GET NUMBER TO ADD
04700		TRZN FL,NUMF	;A NUMBER?
04800		NERROR ILC	;NO, NERROR
04900		ADDM T2,HIPG	;ADD IT IN
05000		JRST NOPGA	;AND CLEAN UP
05100	
05200	LASTPG:	TRNE	FL,BGSN		;SEEN LAST
05300		JRST	LSTPG1		;YES: SKIP CODE
05400		MOVSI	T1,1
05500		MOVEM	T1,DPG		;TRY FOR LARGE
05600		MOVEI	SINDEX,0
05700		PUSHJ	P,FIND
05800		TRNN	FL,BGSN		;SHOULD SEE IT NOW
05900		ERROR	ICN
06000	LSTPG1:	MOVE	T2,BGPG
06100		TRO	FL,NUMF		;NUMBER SEEN
06200		JRST	GETLPG
06300	
06400	
06500	
06600	;ROUTINE SETS HIPG IN CASE NONE SEEN BY GETLA, THEN CALLS GETLA
06700	
06800	GET1S:	PUSHJ P,SCAN
06900	GET1:	MOVE T3,CPGL
07000		MOVEM T3,HIPG
07100		JRST GETLA
07200	
07300	
07400	
07500	;GET A PAIR OF FORM A/B,C/D LOLN IS SET BY CALLER BEFORE CALL
07600	
07700	GET2S:	PUSHJ P,SCAN
07800	GET2:	TRZ FL,CNTF	;NOT A ! COMMAND
07900		PUSHJ P,GET1	;GET A LINE AND PAGE NUMBER PAIR
08000		MOVE T3,HIPG	;NOW SET LOWER PAGE TO THE ONE SEEN
08100		MOVEM T3,LOPG
08200		MOVE T3,HILN	;RESET LOW LINE IS A NUMBER SEEN
08300		TRNE FL,LINSN
08400		MOVEM T3,LOLN
08500	GET2HF:MOVE T3,[<ASCII /99999/>!1]	;SET UP A LARGE NUMBER
08600		TRNN FL,LINSN	;IF NO LINE NUMBER SEEN
08700		MOVEM T3,HILN
08800		TRZ FL,PGSN	;SO DELETE CAN DETECT A SECOND PAGE SPEC
08900		CAIN C,"!"	;IS IT A ! COMMAND?
09000		JRST GET2CT	;GO TAKE CARE OF IT
09100		CAIE C,":"	;CHECK FOR SECOND SET
09200		POPJ P,		;NOPE, RETURN
09300		MOVEM T3,HILN	;SET HILN ANYWAY
09400		JRST GETLAS	;AND GO GET THE SECOND PAIR
09500	
09600	GET2CT:	TRO FL,CNTF	;SET THE APPROPRIATE FLAG
09700		PUSHJ P,SCAN	;THERE SHOULD BE A NUMBER HERE
09800		TRNN FL,NUMF
09900		NERROR ILC	;LOSE
10000		MOVEM T2,SVCNT	;HANG ON TO IT
10100		JRST SCAN	;SCAN NEXT AND RETURN
10200	
10300	
10400	SUBTTL LINE NUMBER SEARCH
     
00100	IFN EXTEND,<
00200	;SEARCH FOR A LINE AND USE ITS NUMBER INSTEAD OF .
00300	;MOSTLY PLAGIARIZED FROM SEARCH
00400	
00500	LSRCH:	PUSH	P,SVINC	;SAVE PREVIOUSLY GATHERED LINE NUMBERS
00600		PUSH P,SVCNT
00700		PUSH	P,HIPG
00800		PUSH	P,LOLN
00900		PUSH	P,LOPG
01000		PUSH	P,FL	;SAVE FLAGS IN CASE CALLED WITHIN SEARCH
01100		PUSH P,FL2
01200		TLZ	FL,ASSMF	;CLEAR ALL FLAGS
01300		SETZM LOLN	;JUST LIKE EVERYONE ELSE HAS TO
01400		SETZM LSCNT	;START WITH ZERO
01500		SOSGE	LSBUFN	;GET STRING BUFFER NUMBER
01600		NERROR	TMS	;NESTING TOO DEEP
01700		MOVE	T2,LSBUFN	;INDEX IN STRING BUFFER TABLES
01800		MOVE	T1,LSPTR(T2)	;SET UP BYTE POINTER
01900		MOVE T3,LSPTT(T2)	;AND POINTER TO BYTE POINTER TABLE
02000		PUSHJ P,SSTRNG	;GET A SEARCH STRING
02100		JRST	[MOVE T2,LSBUFN		;INDEX TO POINTERS
02200			SKIPN @LSPTT(T2)	;WAS STRING SET?
02300			NERROR NSG	;NO, TELL HIM
02400			CAIN C,12
02500			JRST ASLMD1	;SPECIAL CONTINUE MODE
02600			JRST .+1]	;YES, USE OLD ONE
02700		TLZ FL,NUMSRF!DECID!EXCTSR	;CLEAR FLAGS
02800		PUSHJ P,SCAN	;CHECK FOR WHAT COMES AFTER
02900		TRNN FL,TERMF	;IF TERMINATOR
03000		CAIN C,","	;OR ,
03100		JRST ASLMDT	;SET UP LIMITS SPECIALLY
03200		CAIE C,"!"
03300		CAIN C,":"
03400		JRST ASLMDT	;LET HIM SPECIFY 2ND HALF OF RANGE
03500		PUSHJ P,GET2	;ELSE CALL USUAL LIMIT ROUTINE
03600	LSC4:	MOVE T1,HILN	;SAVE END OF RANGE
03700		MOVEM T1,LSHILN
03800		MOVE T1,HIPG
03900		MOVEM T1,LSHIPG
04000		CAIE C,","	;ANY MORE ARGUMENTS?
04100		JRST LSC1	;NO, CHECK TERMINATOR AND PROCEED
04200		PUSHJ P,SCAN	;YES, SEE WHAT IT IS
04300		TRNN FL,IDF	;SHOULD BE IDENT OR NUMBER
04400		JRST LSC2	;NOT IDENT, CHECK FOR NUMBER OF SEARCHES
04500		MOVS T1,ACCUM	;GET THE IDENT
04600		CAIN T1,(<SIXBIT /N  />)	;AND FIND OUT WHAT IT IS
04700		TLO FL,NUMSRF!DECID
04800		CAIN T1,(<SIXBIT /D  />)
04900		TLO FL,DECID	;WANTS TO DECIDE ON LINE
05000		TLNN FL,NUMSRF!DECID	;WAS IT EITHER?
05100		JRST LSC3	;NO, CHECK E
05200		PUSHJ P,SCAN	;CONTINUE LOOKING
05300		CAIE C,","
05400		JRST LSC1	;NO MORE ARGUMENTS
05500		PUSHJ P,SCAN	;WELL WHAT KIND IS THIS ONE?
05600		TRNN FL,IDF	;MORE IDENTS?
05700		JRST LSC2	;NO, MUST BE NUMBER OF SEARCHES
05800		MOVS T1,ACCUM
05900	LSC3:	CAIE T1,(<SIXBIT /E  />)
06000		NERROR ILC	;NO, HE MUST HAVE MADE A MISTAKE
06100		TLO FL,EXCTSR	;YES, REMEMBER IT
06200		PUSHJ P,SCAN	;AND CHECK FOR MORE
06300		CAIE C,","
06400		JRST LSC1	;NO MORE
06500		PUSHJ P,SCAN	;ONLY ONE THING IT CAN BE NOW
06600	LSC2:	TRNN FL,NUMF
06700		NERROR ILC	;NOPE, LOSE
06800		MOVEM T2,LSCNT	;SAVE AS COUNT OF LINES TO FIND
06900		PUSHJ P,SCAN	;GET TERMINATOR (WE HOPE)
07000	LSC1:	TRNN FL,TERMF	;ALLS WELL THAT ENDS WELL
07100		NERROR ILC	;BUT THIS DOSNT
07200	LSCH1A:	MOVE T1,LSBUFN
07300		MOVE T1,LSPTT(T1)	;GET POINTER TO STRINGS
07400		PUSHJ P,CODSR	;AND GENERATE CODE
     
00100		MOVE T1,LOPG	;GET SET TO HUNT IT
00200		MOVEM T1,DPG
00300		MOVEM T1,LSPG	;FLAG TO SAY IF WE SHOULD PRINT PAGE
00400		MOVE SINDEX,LOLN
00500		PUSHJ P,FIND
00600		TRZ FL,LINSN	;NO LINES YET
00700	ONLSC:	PUSHJ P,ONMOV	;CHECK RANGE
00800		JRST ENDLSC	;DONE
00900		TLZE FL,ASSMF	;FIRST TIME AND WANT .+1?
01000		JRST	[CAME T1,LOLN	;IS THERE EXACT MATCH?
01100			JRST .+1	;NO, THIS IS .+1
01200			AOS SVCNT	;PRETEND WE DIDNT SEE IT
01300			JRST LSNXT]	;AND TAKE NEXT
01400		CAMN T1,PGMK	;PAGES ARE SPECIAL
01500		JRST LSCPAG	;SO TAKE GOOD CARE OF THEM
01600		MOVE T2,LSBUFN
01700		MOVE T2,LSPTT(T2)	;POINTER TO STRINGS
01800		PUSHJ P,COMSRC	;GO SEARCH THIS LINE
01900		JRST LSNXT	;LOSER
02000		MOVE T2,CPG	;GET CURRENT PAGE
02100		CAME T2,LSPG	;AND SEE IF WE SHOULD PRINT IT
02200		PUSHJ P,PGPRN	;YES
02300		MOVE T2,CPG	;NOW SET IT AS CURRENT
02400		MOVEM T2,CPGL
02500		MOVEM T2,LSPG	;ALSO RESET FLAG
02600		MOVE T2,(PNTR)	;ALSO SET LINE
02700		MOVEM T2,CLN
02800		TRO FL,LINSN	;WE SAW ONE
02900		TLNN FL,DECID	;DOES HE WANT OPTION?
03000		JRST LSNXTC	;NO, GO GET NEXT ONE OR STOP
03100		TLNE FL,NUMSRF	;DO WE WANT ONLY LINE NUMBERS?
03200		JRST LSCNUM	;YES
03300		MOVE T1,PNTR	;GO PRINT LINE
03400		PUSHJ P,OUTLIN
03500	LSNXT1:
03600		INCHRW T1
03700		ANDI T1,177
03800		OCRLF
03900		CAIE T1,177	;DID HE SAY RUBOUT(DO NOT USE)?
04000		JRST LSOUT	;NO, WE'RE THROUGH
04100	LSNXTC:	SOSG LSCNT	;HAVE WE FOUND ENOUGH
04200		JRST LSOUT	;YES, GIVE UP (WE HAVE SEEN AT LEAST ONE)
04300	LSNXT:	PUSHJ P,FINDN	;GET NEXT LINE TO LOOK A
04400		JRST ONLSC
04500	LSCNUM:	MOVE T1,(PNTR)	;PRINT SEQUENCE NUMBER
04600		PUSHJ P,OUTSN
04700		OCRLF
04800		JRST LSNXT1	;AND DECIDE
04900	ENDLSC:	TRZN FL,LINSN	;DID WE SEE ONE?
05000		NERROR NLN	;NULL RANGE
05100		JRST LSOUT
05200	LSCPAG:	AOS CPG	;JUST ADVANCE PAGE COUNTER
05300		JRST LSNXT	;AND PROCEED
05400	LSOUT:	POP P,FL2	;RESTORE THE FLAGS WE USED
05500		POP P,T1
05600		AND T1,[XWD ASSMF!NUMSRF!EXCTSR!DECID,ADDL!SUBL!CNTF]
05700		ANDCM FL,[XWD ASSMF!NUMSRF!EXCTSR!DECID,ADDL!SUBL!CNTF]
05800		IOR FL,T1
05900		POP P,LOPG	;RESTORE PREVIOUS LINE NUMBERS
06000		POP P,LOLN
06100		POP P,HIPG
06200		POP P,SVCNT
06300		POP P,SVINC
06400		MOVE T1,CLN	;LOAD CURRENT LINE AND PAGE WHICH WE FOUND
06500		MOVE T2,CPGL
06600		TRO FL, NUMF!PGSN	;AND MAKE LIKE SCAN SAW A NUMBER
06700		AOS LSBUFN	;GO BACK TO SEARCH STRING ON PREVIOUS LEVEL IF ANY
06800		POPJ P,		;AND EXIT VICTORIOUS
     
00100	ASLMD1:	TROA FL,CNTF	;MARK AS KEEP END OF RANGE
00200	ASLMDT:	TRZ FL,CNTF	;JUST IN CASE
00300		TLO FL,ASSMF	;WE ASSUME .+1
00400		MOVE T1,CLN	;SET THINGS UP FOR . TO INFINITY
00500		MOVEM T1,LOLN
00600		MOVEM T1,HILN	;AS GOOD AS ANYTHING WITH THE PAGE WE WILL
00700		MOVE T1,CPGL	;USE
00800		MOVEM T1,LOPG
00900		TRZE FL,CNTF	;KEEP END?
01000		JRST LNOSPC	;YES
01100		CAIE C,":"	;IF A : OR !
01200		CAIN C,"!"
01300		JRST HALFLS	;GET THE SECOND HALF (.+1 TO GIVEN)
01400		MOVSI T1,377777	;GET A LARGE PAGE
01500		MOVEM T1,HIPG
01600		JRST LSC4	;BACK INTO THINGS
01700	
01800	HALFLS:	MOVEM T1,HIPG	;SET TOP AS /.
01900		PUSHJ P,GET2HF	;GET THE SECOND HALF
02000		JRST LSC4	;AND GO
02100	
02200	LNOSPC:	MOVE T1,LSHIPG
02300		MOVEM T1,HIPG	;PUT BACK END
02400		MOVE T1,LSHILN
02500		MOVEM T1,HILN
02600		JRST LSCH1A
02700	>
02800	
02900	SUBTTL INITIALIZE
     
00100	
00200	
00300	;HERE IS THE INITIALIZE CODE
00400	
00500	STPT:
00600		SKIPA
00700		JRST	DOSAIL		;ENTRY POINT FOR SAIL
00800		SETZM	RPGSW
00900		SETZM	TMPCF		;CLEAR TMPCOR FLAG
01000	IFN RENTSW,<
01100		MOVEI 0,IMPEND
01200		HRLM 0,.JBSA##
01300		RESET
01400		MOVE 0,.JBFF##
01500		CORE 0,		;GET ENUF CORE
01600		EXIT		;YOU LOSE
01700		MOVE 0,[XWD DATAB,DATABL]
01800		BLT 0,DATABL+DATAE-DATAB
01900	>
02000		SETZM ZEROB
02100		MOVE 0,[XWD ZEROB,ZEROB+1]
02200		BLT 0,IMPEND-1
02300		MOVE 0,[BYTE (7) 15,15,15,15,15]
02400		MOVEM 0,CRSX	;PUT CR'S IN PLACE
02500	IFE RENTSW,< RESET >
02600		HRROI	P,[.+2]		;DUMMY PDL
02700		JRST	DISINT		;DISABLE ^C INT
02800	
02900		MOVSI	FL,QMODF	;SET FOR ' IS NOT SPECIAL
03000		MOVEI	FL2,0		;NOTHING IN SECOND FLAG REGISTER
03100		SETOM	BAKF		;SET FOR BAK FILE
03200		MOVEI	T1,TTYCH	;SET UP DEFAULT INPUT
03300		MOVEM	T1,CHIN		;...
03400	IFN CCLSW,<
03500		MOVE T1,[POINT 7,CMDBUF]
03600		MOVEM T1,P.TEXT
03700		RESCAN 1
03800		  SKPINL		;CHECK SOMETHING THERE
03900		    JRST RPGRET		;NO--GO ASK USER
04000		MOVE T1,[POINT 7,CMDBUF]
04100		MOVEI T2,5*^D20
04200	CMDL:	SKPINC			;MAKE SURE SOMETHING THERE
04300		  JRST	CMDD		;NO--GIVE UP
04400		INCHWL	T3		;YES--GET IT
04500		CAIN T3,15		;PITCH RETURNS
04600		JRST CMDL
04700		IDPB T3,T1
04800		CAIE T3,12		;LOOK FOR TERM
04900		CAIN T3,33
05000		JRST CMDD
05100		SOJG T2,CMDL
05200	
05300	CMDD:	MOVEI T3,12
05400		DPB T3,T1
05500		SETOM RPGSW
05600	>
05700	RPGRET:	MOVE	T1,[JSR ERRHD]	;SET UP UUO HANDLER
05800		MOVEM	T1,.JB41##
05900		MOVEI	T1,PDLOV	;SET UP A PDLOV TRAP
06000		MOVEM	T1,.JBAPR##
06100		MOVEI	T1,200000	;SET FOR PDLOV ONLY
06200		APRENB	T1,
06300		OPEN	TTY,TTDEVI	;FOR SETSTS ONLY
06400		  EXIT			;YOU LOSE
06500		MOVEI	T1,TTIBUF	;SET UP INPUT BUFFER
06600		EXCH	T1,.JBFF##
06700		INBUF	TTY,1
06800		MOVEM	T1,.JBFF##
06900		MOVE	T1,[POINT 7,TTOBUF]
07000		MOVEM	T1,TTOPNT	;SET UP TTY OUTPUT BUFFER
07100		MOVEI	T1,^D80
07200		MOVEM	T1,TTOCNT
07300		MOVE	T1,.JBFF##
07400		MOVEM	T1,BUFHD	;FOR LATER RECOPY OPERATIONS
     
00100	NOCOM0:	TLNN	FL2,AUTOF
00200		MOVE	P,[IOWD PDLSIZ,PDL]
00300		TRNE	FL2,SVIT	;SKIP * IF DOING W COMMAND
00400		JRST	RPGR1
00500		TLZ	FL2,INPARS!BELLF ;SAY WE ARE STARTING
00600		SETZM	OPTION		;LOOK FOR DEFAULT
00700		PUSHJ	P,DOOPT
00800		  JRST	.+2		;IGNORE NOT FOUND RETURN
00900		JRST	[OUTSTR	[ASCIZ "? Syntax error in default options"]
01000			 SETZM RPGSW	;CLR CMD MODE
01100			 CLRBFI
01200			 JRST .+1]
01300	NOCOM1:	TLO	FL2,INPARS	;SET FOR PARSE
01400	IFN CCLSW,<
01500		SKIPE RPGSW
01600		JRST DOCMD.
01700	>
01800		OUTSTR	[ASCIZ /
01900	File: /]
02000	DOCMD.:	PUSHJ P,PARSE
02100	RPGR1:	TLZ	FL2,INPARS	;PARSE DONE
02200		MOVE	T1,[ORGBLK,,ICRBLK]
02300		BLT	T1,ICRBKE	;MOVE INFO TO INPUT BLOCK
02400		MOVE	T1,[NEWBLK,,OCRBLK]
02500		BLT	T1,OCRBKE	;INFO FOR TEMP FILES
02600		MOVSI	T3,'SOS'	;SET UP TEMP FILE NAME
02700		PUSHJ	P,JOBNUM
02800		MOVEM	T3,EDNAM
02900		MOVEM	T3,OCRNAM
03000		MOVSI	T1,'TMP'
03100		MOVEM	T1,OCREXT
03200		MOVE	T1,ORGCOD	;GET ORIG FILE PSW
03300		SKIPN	NEWNAM		;DO WE HAVE A NEW FILE
03400		MOVEM	T1,OCRCOD	;NO - USE ORIG PSW
03500		MOVE	T1,ORGDEV	;GET INPUT DEVICE NAME
03600		MOVEM	T1,INDEVI+1	;STASH IN OPEN BLOCK
03700		DEVCHR	T1,		;GET CHARACTERISTICS
03800		TLNN	T1,(1B1)	;SEE IF REAL LIVE DISK
03900		  JRST	NOTDKI		;NOPE!
04000		MOVEI	T1,INDEVI	;ADDR OF OPEN BLOCK
04100		DEVSIZ	T1,		;GET BUFFER INFO
04200		  SKIPA	[2,,203]	;DEFAULT IF NO UUO
04300		JUMPLE	T1,NOTDKI	;LOSE IF ERROR FLAGS
04400		MOVEM	T1,EDBUF	;STORE FOR LATER
04500	
04600		OPEN	IN,INDEVI	;OPEN INPUT CHL
04700		  JRST	NOTDKI		;OOPS!
04800	
04900		XLOOK	IN,ICRBLK	;DO EXTENDED LOOKUP
05000		  JRST	NOFILE		;CHECK TYPE OF FAILURE
05100	
05200		MOVEI	T1,IN		;SET UP FOR PATH UUO
05300		MOVEM	T1,PTHADR
05400		MOVE	T1,[<SFDLVL+4>,,PTHADR]
05500		PATH.	T1,
05600		  HALT	.		;NEVER COME HERE (OFTEN)
05700	
05800		SKIPN	NEWNAM		;SAVE PATH INFO IN NEW FILE
05900		JRST	[MOVE T1,[PTHADR+2,,OCRPTH]
06000			 BLT T1,OCRPTH+SFDLVL
06100			 JRST .+1]
06200		SETZM	CREATF		;SAY NOT CREATE
06300		TRNE	FL,READOF	;IF READ ONLY, LOOKUP IS ENUF
06400		JRST	GUDPRV
06500		LDB	T2,[POINT 9,XBLOCK+2,8]
06600		CAIL	T2,400		;CHECK IF OK TO EDIT
06700		SKIPE	NEWNAM		;NO GOOD IF NO OUTPUT SPEC
06800	GUDPRV:	SKIPA	T1,PTHADR	;ATTN PROGRAM BUMMERS
06900		JRST	BADPRV		;CANNOT EDIT THIS ONE
07000		HRRM	T2,ORGPRT	;SAVE FOR LATER
07100		ANDI	T2,77		;STASH TEMP FILE PROT
07200		SKIPN	T2		;WATCH OUT FOR X00 FILES
07300		MOVEI	T2,100		;THIS IS BETTER
07400		HRRM	T2,OCRPRT
07500		MOVEM	T1,STRNAM	;SET UP FOR DSKCHR
07600		MOVE	T1,[5,,STRNAM]
07700		DSKCHR	T1,		;FIND REAL NAME
07800		  SKIPA	T4,[SIXBIT "DSK"]
07900		MOVE	T4,STRNAM+4
08000		MOVEM	T4,ORGDEV	;STORE DEVICE NAME
08100	FILRET:	SKIPE	NEWNAM		;OUTPUT SPECIFIED?
08200		MOVE	T4,NEWDEV	;YES: GET OUTPUT DEVICE
08300		MOVEM	T4,OUDEVI+1	;SAVE IT IN OUPUT BLOCK
08400		MOVEM	T4,OCRDEV	;AND OUTPUT FILE DESC
08500		DEVCHR	T4,		;GET CHARACTERISTICS
08600		TLNN	T4,(1B1)	;GRNTEE DISK
08700		  JRST	NOTDKO
08800	
08900		OPEN	OUT,OUDEVI	;OPEN OUTPUT CHL
09000		  JRST	NOTDKO		;GRONK
09100	
09200		HLRZ	T1,EDBUF	;GET DEFAULT # OF BUFFERS
09300		INBUF	IN,0(T1)	;GET BUFFERS
09400		OUTBUF	OUT,0(T1)	;...
09500		MOVE	T1,.JBFF##
09600		SETZM	0(T1)		;SAVE A ZERO WORD
09700		ADDI	T1,1		;NEXT ONE IS START OF
09800		MOVEM	T1,BUFP		;  BUFFERS
     
00100	MOCO:	MOVE	T1,.JBREL##	;FIND THE END OF CORE
00200		MOVEM	T1,CORTOP
00300		SUBI	T1,2*MXWPL+2	;LEAVE SPACE FOR A COUPLE OF LINES
00400		MOVEM	T1,FILPT	;THIS IS HOW FAR TO FILL THE BUFFER
00500		MOVE	T1,CORTOP	;NOW FIND THE SIZE
00600		SUB	T1,BUFP
00700		CAIGE	T1,3000
00800		JRST	[MOVE T2,.JBREL##
00900			 ADDI T2,2000
01000			 CORE T2,
01100			 SKIPA
01200			 JRST MOCO
01300			 JRST .+1]	;DID NOT GET IT, GIVE UP
01400		MOVE T2,T1	;GET A COPY
01500		SUBI T2,MXWPL+1	;WHEN TO START DUMPING
01600		MOVEM T2,MAXWC
01700		ASH T1,-1	;TAKE HALF OF IT
01800		MOVEM T1,HLFWC	;SAVE THAT FIGURE
01900		TRNE FL2,SVIT
02000		JRST NOSV1	;SKIP SOME MORE STUFF IF IN W COMMAND
02100		PJOB T3,
02200		TRMNO. T3,		;GET TTY #
02300		JRST NOLCT		;ERROR - IGNORE
02400		MOVEI T2,.TOLCT		;CODE FOR LC TEST
02500		MOVE T1,[2,,T2]
02600		TRMOP. T1,
02700		JRST NOLCT		;NOT IMP EITHER
02800		SKIPN T1
02900		TRO FL,M37F		;LC SET SO SAY HE'S M37
03000	NOLCT:	MOVE T1,[<ASCII /00000/>!1]
03100		MOVEM T1,CLN	;SET UP THE CURRENT LINE
03200		SKIPN	T1,TECINC	;USE STEP IF GIVEN
03300		MOVE T1,[<ASCII /00100/>!1]	;AND CURRENT INCREMENT
03400		MOVEM T1,INCR
03500		MOVEM T1,CURINS	;CURRENT PLACE TO INSERT IF NO ARGS TO I
03600	NOSV1:	MOVEI T1,1	;AND THE CURRENT PAGE
03700		MOVEM T1,CPG
03800		TRNE FL2,SVIT	;DO NOT CHANGE LOGICAL PAGE (.)
03900		JRST NOSV1A
04000		MOVEM T1,CPGL
04100		MOVEM T1,IPG		;CURRENT PAGE TO INSERT ON
04200	NOSV1A:	MOVE PNTR,BUFP	;SET THE BUFFER POINTER
04300		MOVEI T1,1	;SET INPUT PAGE
04400		MOVEM T1,INPG
04500		SETZM SVWD	;O WORDS WAITING
04600		SETZM WC	;ZERO WORD COUNT FOR START
04700		SETZM OLDLIN	;UESD FOR ORDER CHECKING ON INPUT
04800		TLNN	FL2,AUTOF	;PRESERVE IF IN AUTO SAVE
04900		SETZM ALTSN	;USED FOR ALTMODE SEEN FOR I AND R
05000		SETZM AUXFIL	;USED TO FLAG AUXILLARY FILE IN USE
05100		TRNE FL2,SVIT
05200		JRST NOSV2
05300		SETZM CASEBT	;0 FOR LETTERS AS UPPER CASE 40 FOR LOWER
05400		SETZM SRPNT	;NO SEARCH STRING YET
05500		SETZM R1PNT	;ALSO REPLACE STRINGS
05600		SETZM R2PNT
05700		SETZM SVPBTS#
05800		MOVSI T1,1	;SET BIG PAGE LARGE FOR NOW
05900		MOVEM T1,BGPG
06000		TRNE	FL,READOF	;DONT BOTHER IF READ-ONLY
06100		JRST	NOSV2
06200		XLOOK	OUT,OCRBLK	;GRNTEE TMP FILE GONE
06300		  JRST	[HRRZ T1,XBLOCK+1
06400			 JUMPN T1,EDFLIN ;ERROR IF OTHER THAN FNF
06500			 JRST NOSV2]
06600		SETZB	T1,T2		;DELETE IT IF THERE
06700		RENAME	OUT,T1
06800		  JRST	EDFLIN		;LOSE IF CAN'T DELETE
06900	NOSV2:	MOVSI	T1,'TEM'	;RESET EXT
07000		HLLM	T1,OCREXT
07100		TLO FL2,BELLF	;ALLOW BELLS
07200		PUSHJ	P,ENBINT	;ENABLE ^C INTS
07300		SKIPE	CREATF		;CHECK IF WE ARE CREATING
07400		  JRST	CRTOK
07500	IFN CRYPSW,< SETOM IBUF+3 >
07600		TRNE FL2,SVIT	;WRAP ON SAVE CMD(W)
07700		JRST NOSV3	;YES: DON'T PRINT MSG AGAIN!
07800		MOVEI	T1,[ASCIZ /Edit: /]
07900		TRNE	FL,READOF	;CHECK FOR R/O
08000		MOVEI	T1,[ASCIZ /Read: /]
08100		OUTSTR	@T1		;PRINT MSG
08200		MOVEI	T4,ICRBLK
08300		PUSHJ	P,GVNAM0	;GIVE FILE NAME
08400		OCRLF
08500	NOSV3:	TRNE FL,READOF
08600		JRST NOENT	;DO NOT ENTER
08700		XENTR	OUT,OCRBLK
08800		  JRST	EDFLIN		;SOME OTHER BASTARD IS USING IT
08900		PUSHJ	P,STRSET	;SETUP STR INFO
09000		SETZM	OPG		;OUTPUT PAGE CNTR
09100	IFN CRYPSW,<
09200		MOVNI T1,2
09300		MOVEM T1,OBUF+3 
09400	>
09500	NOENT:	TRO FL,BOF	;IS AT START OF FILE
09600		TLO FL,FSTOPF	;FIRST OP
09700		TLZ	FL2,ALLCHG	;NO CHANGES YET
09800		PUSHJ P,FILLBF	;AND FILL UP THE BUFFER
09900		TLZN	FL2,AUTOF	;SKIP IF AUTO SAVE
10000		JRST COMND
10100		TRZ	FL2,SVIT	;CLR THIS TOO
10200		MOVE	SINDEX,SVLNUM	;GET BACK TO POINT OF LAST INSERT
10300		TLZ	FL2,NORENT	;RE-ENABLE FOR REENTER
10400		JRST	FIND		;EXITS TO CALLER
     
00100	RJUST:	MOVE	T3,ACCUM	;GET THE SIXBIT
00200		MOVEI	T1,0
00300	RJUST1:	MOVEI	T2,0
00400		LSHC	T2,6
00500		CAIL	T2,"0"-40	;CHECK FOR OCTAL DIGIT
00600		CAILE	T2,"7"-40
00700		POPJ	P,
00800		LSH	T1,3
00900		IORI	T1,-20(T2)
01000		JUMPN	T3,RJUST1	;DONE IF NULLS LEFT
01100		AOS	(P)
01200		POPJ	P,		;SKIP RETURN FOR ALL OK
01300	
01400	;ROUTINE FOR FETCH FULL PATH NAME
01500	
01600	SETPPN:	PUSHJ	P,SCAN		;FETCH ATOM
01700		TRNN	FL,IDF!NUMF	;CHECK FOR ATOM
01800		JRST	[CAIN C,"-"	;CHECK FOR DEFAULT SPEC
01900			 JRST STDPTH
02000			 SKIPN T1,MYPPN	;HAVE DEFAULT?
02100			 PUSHJ P,USRPPN	;NO: GET ONE
02200			 HLLZM T1,PTH(ALTP)
02300			 JRST SETPP1]
02400		PUSHJ	P,RJUST		;RIGHT JUSTIFY ATOM IN OCTAL
02500		  POPJ	P,		;PPN ERROR
02600		HRLZM	T1,PTH(ALTP)
02700		PUSHJ	P,SCAN
02800	SETPP1:	CAIE	C,","		;PROPER DELIM
02900		POPJ	P,
03000		PUSHJ	P,SCAN		;FETCH NEXT ATOM
03100		TRNN	FL,IDF!NUMF	;ALLOW [,,...]
03200		JRST	[SKIPN T1,MYPPN
03300			 PUSHJ P,USRPPN
03400			 HRRM T1,PTH(ALTP)	;FILL IN DEFAULT
03500			 JRST SETPP2]
03600		PUSHJ	P,RJUST		;GET OCTAL ATOM
03700		  POPJ	P,		;PPN ERROR
03800		HRRM	T1,PTH(ALTP)	;STASH PROG #
03900		PUSHJ	P,SCAN		;MOVE ON
04000	SETPP2:	MOVSI	T3,-<SFDLVL+1>
04100		HRR	T3,ALTP
04200		JRST	STPTH1
04300	
04400	SETPTH:	PUSH	P,T3		;SAVE AOBJN WD
04500		PUSHJ	P,SCAN		;FETCH ATOM
04600		TRNN	FL,IDF!NUMF	;CHECK FOR END OF SPEC
04700		JRST	T1POPJ		;PRUNE PDL AND EXIT
04800		MOVE	T3,0(P)		;FETCH PNTR
04900		MOVE	T1,ACCUM	;FETCH SFD NAME
05000		MOVEM	T1,PTH(T3)	;STORE IN PROPER PLACE
05100		PUSHJ	P,SCAN		;SCAN NEXT
05200		POP	P,T3		;SET UP AOBJN PNTR
05300	STPTH1:	CAIN	C,"]"		;GOOD TERMINATOR?
05400		JRST	CPOPJ1		;YES: EXIT
05500		CAIE	C,","		;MORE TO COME?
05600		POPJ	P,		;NO: ERROR RET
05700		AOBJN	T3,SETPTH	;YES: TRY NEXT
05800		POPJ	P,		;OOPS!
05900	
06000	USRPPN:	GETPPN	T1,
06100		  JFCL			;INCASE JACCT ON
06200		MOVEM	T1,MYPPN	;SAVE FOR LATER
06300		POPJ	P,
06400	
06500	STDPTH:	PUSHJ	P,SCAN		;CHECK PROPER TERM
06600		TRNN	FL,IDF!NUMF
06700		CAIE	C,"]"
06800		POPJ	P,		;LOSE
06900		SETZM	PTH(ALTP)	;USE DEFAULT
07000		JRST	CPOPJ1
     
00100	READN0:	TDZA	T2,T2		;INIT DEVICE TO 0
00200	READNM:	MOVSI	T2,'DSK'	;INIT DEVICE TO DSK
00300		SETZM	TMPBLK		;CLEAR OUT PARSE AREA
00400		MOVE	T1,[TMPBLK,,TMPBLK+1]
00500		BLT	T1,TMPBKE
00600		MOVEI	ALTP,TMPBLK	;SET UP FOR SETPPN
00700		SETZM	RSW		;AND SWITCH FLAGS
00800		SETZM	SSW
00900		MOVEM	T2,TMPDEV
01000		TRNN	FL,IDF!NUMF	;IS IT AN IDENT
01100		POPJ	P,		;ERROR RETURN
01200		PUSH	P,ACCUM		;SAVE ATOM
01300		PUSHJ	P,SCAN		;SCAN FOR DELIM
01400		CAIE	C,":"		;IS IT A DEVICE
01500		JRST	[POP P,TMPNAM	;IT IS A FILE NAME
01600			 JRST NOTDEV]
01700		POP	P,TMPDEV	;YES: SAVE IN CORRECT PLACE
01800		PUSHJ	P,SCAN		;GET NEXT ATOM
01900		TRNN	FL,IDF!NUMF	;IS IT AN IDENT
02000		POPJ	P,		;NO: RETURN
02100		MOVE	T1,ACCUM	;FETCH ARG
02200		MOVEM	T1,TMPNAM
02300		PUSHJ	P,SCAN
02400	NOTDEV:	CAIN	C,"["		;CHECK FOR PPN
02500		JRST	READPP
02600		CAIE	C,"."
02700		JRST	RDTERM
02800		PUSHJ	P,SCAN		;THIS SHOULD BE AN EXTENSION
02900		TRNE	FL,TERMF	;CHECK FOR NULL EXT
03000		JRST	CPOPJ1		;OK IF NOTHING AFTER PERIOD
03100		TRNN	FL,IDF!NUMF
03200		POPJ	P,
03300		MOVE	T1,ACCUM	;GET IT
03400		HLLZM	T1,TMPEXT	;AND PUT IT IN THE EXTENSION FIELD
03500		PUSHJ	P,SCAN
03600		CAIE	C,"["		;NOW LOOK FOR PPN
03700		JRST	RDTERM
03800	READPP:	PUSHJ	P,SETPPN	;FETCH FULL PATH NAME
03900		  POPJ	P,		;ERROR IN PPN
04000		PUSHJ	P,SCAN		;LOOK PAST BRACKET
04100	RDTERM:	TLNN	FL2,INOPTF	;NO SWITCHES IN OPTION FILE
04150		CAIE	C,"/"		;CHECK FOR READ ONLY MODE
04200		JRST	CPOPJ1		;ALL OK
04300		PUSHJ	P,SCAN
04400		TRNN	FL,IDF
04500		POPJ	P,
04600		MOVS	T1,ACCUM
04700		CAIN	T1,'R  '
04800		SETOM	RSW
04900		CAIN	T1,'S  '
05000		SETOM	SSW
05100		PUSHJ	P,SCAN
05200		SKIPN	RSW
05300		SKIPE	SSW
05400		AOS	(P)
05500		POPJ	P,
     
00100	;CREATE A NEW FILE
00200	
00300	NOFILE:	MOVEI	T4,ICRBLK	;SET FOR PRINTING
00400		HRRZ	T1,XBLOCK+1	;GET FAIL CODE
00500		TRNN	FL,READOF	;ERROR IF R/O
00600		JUMPE	T1,NOFIL1	;OK IF FNF CODE
00700		PUSHJ	P,GVNAM0	;PRINT NAME
00800		OUTCHR	["("]
00900		HRRZ	T1,XBLOCK+1	;FAIL CODE
01000		MOVEI	T3,OCHR		;OUTPUT ROUTINE
01100		PUSHJ	P,OCTPR		;PRINT IN OCTAL
01200		PUSHJ	P,FORCE		;DUMP BUFFER
01300		OUTSTR	[ASCIZ /) - LOOKUP failed/]
01400		HRRZ	T1,XBLOCK+1	;FAIL CODE
01500		CAIN	T1,0
01600		OUTSTR	[ASCIZ /, file not found/]
01700		CAIN	T1,1
01800		OUTSTR	[ASCIZ /, no such directory/]
01900		CAIN	T1,2
02000		OUTSTR	[ASCIZ /, protection violation/]
02100		CAIN	T1,6
02200		OUTSTR	[ASCIZ /, RIB or UFD error/]
02300		CAIN	T1,23
02400		OUTSTR	[ASCIZ /, no such SFD/]
02500		OCRLF
02600		EXIT
02700	
02800	NOFIL1:	OUTSTR	[ASCIZ /Input: /]
02900		PUSHJ	P,GVNAM0
03000		MOVE	T1,[%LDSTP,,.GTLDV]
03100		GETTAB	T1,		;GET DEFAULT PTB.
03200		MOVSI	T1,155000	;MUST BE LVL C
03300		LDB	T1,[POINT 9,T1,8]
03400		HRRM	T1,ORGPRT
03500		ANDI	T1,77		;SET UP FOR TEMP
03600		SKIPN	T1		;LOOK FOR X00
03700		MOVEI	T1,100		;AND USE THIS
03800		HRRM	T1,OCRPRT
03900		SETOM	CREATF		;SAY WE ARE CREATING
04000		MOVE	T1,[ORGPTH,,OCRPTH]
04100		BLT	T1,OCRPTH+SFDLVL ;SET UP OUTPUT PATH
04200		MOVE	T4,ORGDEV	;GET DEVICE NAME
04300		JRST	FILRET		;GO OPEN IT
04400	
04500	CRTOK:
04600		XENTR	OUT,OCRBLK	;CREAT TEMP FILE
04700		  JRST	EDFLIN
04800		PUSHJ	P,STRSET	;SETUP STR INFO
04900		SETZM	OPG		;OUTPUT PAGE CNTR
05000	IFN CRYPSW,<
05100		MOVNI	T1,2
05200		MOVEM	T1,OBUF+3
05300	>
05400		SETZM	(PNTR)		;ZERO FIRST WORD OF BUFFER
05500		TRZ	FL,READOF	;CREAT AND READOF ARE NOT POSSIBLE
05600		TRO	FL,BOF!EOF!EOF2	;SAY AT START AND NO MORE TO READ
05700		TLO	FL2,ALLCHG	;NEW FILE - THEREFORE CHANGES
05800		MOVEI	T1,1		;SET BGPG
05900		MOVEM	T1,BGPG
06000		JRST	CRTINS		;AT LAST
06100	
06200	DOSAIL:	OUTSTR	[ASCIZ /
06300	? SAIL FEATURE NOT YET IMPLEMENTED!/]
06400		EXIT
06500	
06600	SUBTTL PARSE CODE
     
00100	;LOOK FOR SYSTEM COMMAND. MAY BE "R SOS" OR "SOS" OR "EDIT"
00200	
00300	PARSE:	MOVEI	ALTP,NEWBLK	;INIT NAME PNTR
00400		PUSHJ	P,ZERNEW	;CLR OUT FILE BLOCK
00500		MOVEI	T1,LDCHR	;SET UP CHIN FOR PARSE
00600		EXCH	T1,CHIN		;SAVE OLD VALUE
00700		MOVEM	T1,SVPCIN	;...
00800		SETZM	PZBEG		;CLEAR PARSE AREA
00900		MOVE	T1,[PZBEG,,PZBEG+1]
01000		BLT	T1,PZEND
01100		MOVSI	T1,'DSK'
01200		MOVEM	T1,DEV(ALTP)	;DEFAULT DEVICE
01300		TRZ	FL,F.ANY	;CLEAR ATOM SEEN
01400		SKIPN	RPGSW
01500		JRST	PARSE1
01600		PUSHJ	P,RDSKIP
01700		PUSHJ	P,RDATOM		;GET FIRST ATOM
01800		TRO	FL,F.LAHD
01900		LDB	T1,[POINT 6,D,5]
02000		CAIE	T1,"R"-40		;RUN CMD?
02100		JRST	PARSE1		;NO: GO PARSE COMMAND LINE
02200		PUSHJ	P,RDSKIP
02300		PUSHJ	P,RDATOM		;SKIP FILE NAME
02400		CAIN	C,":"		;IN CASE DEVICE NAME
02500		JRST	.-3
02600		CAIN	C,"-"		;DASH BREAK?
02700		JRST	[TRZ FL,F.LAHD
02800			 SETOM TMPCF	;SET TO SKIP TMP READ
02900			 JRST FIXUP]
03000		CAIN	C,12		;END OF WORLD?
03100		JRST	RDEOT0		;YES: PROCESS
03200		PUSHJ	P,RDSKIP		;NO: SKIP CORE ARG
03300		PUSHJ	P,RDATOM
03400		TRO	FL,F.LAHD
03500	FIXUP:	MOVE	T1,[ASCII "SOS  "]
03600		MOVEM	T1,CMDBUF	;OVERWRITE RUN CMD
03700		MOVE	T1,[POINT 7,CMDBUF+1]
03800		MOVEI	C," "
03900	FIXUP1:	IBP	T1
04000		CAMN	T1,P.TEXT
04100		JRST	FIXUP2
04200		DPB	C,T1
04300		JRST	FIXUP1
04400	FIXUP2:	TRNN	FL,F.LAHD	;CORRECT # OF SPACES
04500		DPB	C,T1
04600	
04700	PARSE1:	PUSHJ	P,RDSKIP		;RETURN HERE TO SKIP SPACES
04800	PARSE2:	PUSHJ	P,RDATOM
04900		CAIN	C,12
05000		JRST	RDEOT
05100		TRO	FL,F.ANY	;SET ATOM SEEN
05200		CAIN	C,"/"		;SLASH
05300		JRST	RDSLSH
05400		CAIN	C,"."
05500		JRST	RDPER
05600		CAIE	C,"_"
05700		CAIN	C,"="
05800		JRST	RDEQL
05900		CAIE	C,"	"
06000		CAIN	C," "
06100		JRST	RDSPAC
06200	IFN CRYPSW,<
06300		CAIN	C,"("
06400		JRST	RDLPRN
06500	>
06600		CAIN	C,"["
06700		JRST	RDPPN
06800		CAIN	C,":"
06900		JRST	RDCOLN
07000	ILLCHR:	MOVEI	T1,[ASCIZ /Illegal char in cmd/]
07100		JRST	COMERR
07200	
07300	;HERE WHEN COLON SEEN
07400	
07500	RDCOLN:	TRZN	FL,F.SLSH	;IN SWITCH?
07600		JRST	RDCLN1		;NO: TREAT AS DEVICE
07700		TRO	FL,F.LAHD	;YES: SET LOOK AHEAD
07800		JRST	RDSPC1		;AND LOOK AT SWITCH
07900	
08000	RDCLN1:	JUMPE	D,RDCERR	;ERROR IF NULL DEVICE
08100		TROE	FL,F.COLN	;SAY SEEN ONE
08200		JRST	RDCERR
08300		MOVEM	D,DEV(ALTP)	;STASH
08400		JRST	PARSE2		;AND CONT PARSE
08500	
08600	RDCERR:	MOVEI	T1,[ASCIZ /Illegal colon/]
08700		JRST	COMERR
     
00100	;HERE WHEN SPACE SEEN
00200	
00300	RDSPAC:	TRZE	FL,F.SLSH
00400		JRST	RDSPC1		;CHECK SWITCH
00500		PUSHJ	P,RDPLNK	;STORE DESCRIPTOR
00600		TRO	FL,F.ANY	;SAY WE'VE SEEN SOMETHING
00700		JRST	PARSE1
00800	
00900	RDSPC1:	MOVEM	D,ACCUM		;STASH ARG FOR DECODE
01000		PUSHJ	P,DOSET		;CALL ON SET CODE
01100		JRST	SWTERR		;ERROR RETURN
01200		TRO	FL,F.LAHD	;SET LOOK AHEAD
01300		MOVEM	C,SAVCHR	;SAVE INCASE OF TTY INPUT
01400		JRST	PARSE1		;CONTINUE PARSE
01500	
01600	SWTERR:	MOVEI	T1,[ASCIZ /Illegal switch/]
01700		JRST	COMERR
01800	
01900	;HERE WHEN EQUAL SIGN SEEN
02000	
02100	RDEQL:	TROE	FL,F.EQL	;MAKE SURE FIRST ONE
02200		JRST	RDEQLE
02300		PUSHJ	P,CHKFIL	;SEE IF WE HAVE A FILE
02400		JUMPE	D,RDEQL1	;OK IF D .NE. 0
02500		PUSHJ	P,RDPLNK	;STASH REMAINING ATOM
02600	RDEQL1:	TRZ	FL,F.PER!F.COLN!F.PPN!F.CDSN!F.LAHD
02700		MOVEI	ALTP,ORGBLK	;CLR FLAGS AND ADVANCE PNTR
02800		MOVSI	T1,'DSK'
02900		MOVEM	T1,DEV(ALTP)	;DEFAULT DEVICE NAME
03000		JRST	PARSE2		;AND CONTINUE
03100	
03200	RDEQLE:	MOVEI	T1,[ASCIZ /Illegal equal sign/]
03300		JRST	COMERR
03400	
03500	;HERE WHEN SLASH SEEN
03600	
03700	RDSLSH:	PUSHJ	P,CHKFIL
03800		JUMPE	D,RDSLS1
03900		JRST	RDSPAC
04000	RDSLS1:	TRZ	FL,F.LAHD	;CLEAR LOOK AHEAD
04100		TRON	FL,F.SLSH
04200		JRST	PARSE2
04300		MOVEI	T1,[ASCIZ /Illegal slash/]
04400		JRST	COMERR
     
00100	;HERE WHEN LEFT PAREN SEEN
00200	
00300	IFN CRYPSW,<
00400	RDLPRN:	PUSHJ	P,CHKFIL
00500		JUMPE	D,RDLPER
00600		JRST	RDSPAC		;TREAT AS SPACE
00700		TRON	FL,F.CDSN	;GRNTEE UNIQUE CODE
00800		JRST	RDLPR1		;GO SNARF CODE
00900	RDLPER:	MOVEI	T1,[ASCIZ /Illegal code spec./]
01000		JRST	COMERR
01100	RDLPR1:	MOVE	T1,[POINT 7,CODBUF]
01200		MOVEI	T2,CODMAX
01300	RDLPR2:	PUSHJ	P,@CHIN		;FETCH A CHAR
01400		CAIN	C,")"
01500		JRST	RDLPR3
01600		CAIN	C,12
01700		JRST	RDLPER		;ERROR IF EOT
01800		IDPB	C,T1
01900		SOJG	T2,RDLPR2
02000		MOVEI	T1,[ASCIZ /Code too long/]
02100		JRST	COMERR
02200	
02300	RDLPR3:	MOVEI	C,0
02400		IDPB	C,T1
02500		MOVEM	7,S.CRYP+7
02600		MOVEI	7,S.CRYP
02700		BLT	7,S.CRYP+6
02800		MOVEI	7,CODBUF		;GET A SEED
02900		PUSHJ	P,CRASZ.##
03000		MOVEM	5,COD(ALTP)	;STASH AWAY
03100		MOVSI	7,S.CRYP
03200		BLT	7,7
03300		TRZ	FL,F.LAHD
03400		JRST	PARSE1
03500	>
03600	
03700	;HERE WHEN PERIOD SEEN
03800	
03900	RDPER:	JUMPN	D,RDPER1
04000		MOVEI	T1,[ASCIZ /Null name with extension/]
04100		JRST	COMERR
04200	RDPER1:	TROE	FL,F.PER
04300		JRST	[MOVEI T1,[ASCIZ /Illegal period/]
04400			JRST COMERR]
04500		MOVEM	D,NAM(ALTP)
04600		JRST	PARSE2
04700	
04800	;HERE WHEN END OF CMD SEEN
04900	
05000	RDEOT:	PUSHJ	P,CHKFIL
05100		JUMPE	D,RDEOT0
05200		JRST	RDSPAC	;PROCESS AS SPACE IF SOMETHING THERE
05300	RDEOT0:	SETZM	SAVCHR	;CLEAR TTY INPUT
05400		TRNN	FL,F.ANY	;ANYTHING?
05500		JRST	COMER1
05600		TRNE	FL,F.EQL	;EQUAL SIGN SEEN?
05700		SKIPE	ORGNAM		;YES: BETTER SEE FILE NAME
05800		SKIPA
05900		JRST	RDEQLE		;FUNNY EQUAL SIGN
06000		SKIPN	NEWNAM		;WAS A NEW NAME GIVEN?
06100		JRST	RDEOT2		;NO - CHECK FOR DEFAULT
06200		TRNE	FL,F.EQL	;YES - EQUAL SIGN SEEN?
06300		JRST	RDEOTX		;YES - THEN DONE
06400		MOVE	T1,[NEWBLK,,ORGBLK]
06500		BLT	T1,ORGBKE	;PUT INFO IN ORG BLOCK
06600		PUSHJ	P,ZERNEW
06700		JRST	RDEOTX		;AND EXIT
06800	
06900	RDEOT2:	TRNN	FL,F.EQL	;EQUAL SEEN?
07000		JRST	[MOVEI T1,[ASCII /NO FILE GIVEN/]
07100			 JRST COMERR]
07200		HRROI	T1,ORGEXT	;YES - SET INFO
07300		POP	T1,NEWEXT	;INTO DEFAULTS
07400		POP	T1,NEWNAM
07500	RDEOTX:	TRZ	FL,P.FLGS	;CLEAR PARSE FLAGS
07600		MOVE	T1,SVPCIN	;RESTORE CHIN
07700		MOVEM	T1,CHIN
07800		SKIPE	RPGSW		;RPG MODE?
07900		PUSHJ	P,WRTMP		;YES: WRITE OUT TEMP
08000		SKIPN	T1,TECINC	;TECO INCREMENT?
08100		MOVE	T1,[<ASCII /00100/>!1]
08200		MOVEM	T1,TECINC	;SET CORRECT ONE UP
08300		SKIPN	TECFST		;START SEQ # GIVEN?
08400		MOVEM	T1,TECFST	;NO: USE INCREMENT
08500		POPJ	P,		;EXIT PARSE
     
00100	;HERE TO READ PPN'S
00200	
00300	RDPPN:	PUSHJ	P,CHKFIL	;SEE IF FILE SPEC
00400		JUMPE	D,PPERR		;ERROR IF NO ATOM
00500		JRST	RDSPAC		;ELSE TREAT AS SPACE
00600		TRON	FL,F.PPN	;GRNTEE JUST ONE PER FILE SPEC
00700		JRST	RDPPN1
00800	PPERR:	MOVEI	T1,[ASCIZ /Illegal PPN/]
00900		JRST	COMERR
01000	
01100	RDPPN1:	SETZM	SAVCHR		;CLEAR OUT SCAN
01200		SETZM	SAVC
01300		PUSHJ	P,SETPPN	;GO READ PPN
01400		  JRST	PPERR		;ERROR
01500		TRZ	FL,F.LAHD	;CLEAR LOOK-AHEAD
01600		JRST	PARSE1
01700	
01800	;ROUTINE TO ZERO OUT NEWBLK
01900	
02000	ZERNEW:	MOVE	T1,[NEWBLK,,NEWBLK+1]
02100		SETZM	NEWBLK
02200		BLT	T1,NEWBKE
02300		POPJ	P,
     
00100	;COMMAND ERROR ROUTINE
00200	
00300	COMERR:
00400		OUTSTR	[ASCIZ /? /]
00500		OUTSTR	(T1)
00600		OCRLF
00700		SETOM	TMPCF		;MAKE LIKE READ
00800		CLRBFI			;CLEAR TYPE AHEAD
00900		SETZM	TTIBH+2
01000	COMER1:	SKIPN	TMPCF		;HERE ONCE?
01100		SKIPN	RPGSW		;NO: RPG MODE?
01200		SKIPA			;SKIP INTO NORMAL CMD LOOP
01300		PUSHJ	P,RDTMP		;READ TEMP (SKIP IF OK)
01400		SETZM	RPGSW		;CLEAR RPG MODE
01500		TRZ	FL,P.FLGS
01600		MOVE	T1,SVPCIN	;RESTORE CHIN
01700		MOVEM	T1,CHIN
01800		MOVE	P,[IOWD PDLSIZ,PDL] ;RESTORE PDL
01850		JRST	NOCOM1		;TRY SOME MORE
01900	
02000	;HERE TO STASH ATOM IN EITHER NAME OR EXT
02100	
02200	RDPLNK:	JUMPE	D,CPOPJ		;DONE IF NULL ATOM
02300		TRZN	FL,F.PER	;PERIOD?
02400		JRST	RDPLN1		;NO: STASH NAME
02500		HLLZM	D,EXT(ALTP)	;YES: EXTENSION
02600		POPJ	P,
02700	
02800	RDPLN1:	MOVEM	D,NAM(ALTP)
02900		POPJ	P,		;RETURN
     
00100	;HERE TO READ TEMP FILE
00200	
00300	RDTMP:	SETOM	TMPCF		;STATE THAT WE HAVE TRIED
00400		MOVNI	T1,20		;BUFFER SIZE
00500		HRLM	T1,T.IOWD
00600	IFN TEMPC,<
00700		MOVE	T1,[XWD 1,T.HEAD]
00800		TMPCOR	T1,
00900		SKIPA			;IT FAILED - TRY FILE
01000		JRST	RDTMP1
01100	>
01200		MOVSI	T3,(<SIXBIT /EDS/>)
01300		PUSHJ	P,JOBNUM
01400		MOVEM	T3,XBLOCK	;STASH FILE NAME
01500		MOVSI	T1,(<SIXBIT /TMP/>)
01600		MOVEM	T1,XBLOCK+1	;AND EXTENSION
01700		SETZM	XBLOCK+3	;ZERO PPN
01800		MOVE	T1,[1B0+17]	;DUMP MODE + PHYS ONLY
01900		MOVSI	T2,'DSK'	;ON DEFAULT STR
02000		MOVEI	T3,0
02100		OPEN	IN,T1		;PERFORM OPEN
02200		  JRST	RDTMPE		;TREAT AS FNF
02300		LOOKUP	IN,XBLOCK	;IS IT THERE
02400	RDTMPE:	  JRST	[RELEAS IN,0
02500			 POPJ P,]
02600		INPUT	IN,T.IOWD		;FETCH FILE
02700		STATZ	IN,740000	;CHECK ERRORS
02800		JRST	RDTMPE		;YOU LOSE
02900		RELEAS	IN,0
03000	RDTMP1:	MOVE	T1,[POINT 7,CMDBUF]
03100		MOVEM	T1,P.TEXT
03200		AOS	(P)
03300		POPJ	P,
03400	
03500	;HERE TO WRITE TEMP FILE
03600	
03700	WRTMP:	HRRZ	T1,P.TEXT		;CALC LENGTH OF STRING
03800		SUBI	T1,CMDBUF-1
03900		MOVN	T1,T1		;NEG LENGTH
04000		HRLM	T1,T.IOWD
04100	IFN TEMPC,<
04200		MOVE	T1,[XWD 3,T.HEAD]
04300		TMPCOR	T1,
04400		SKIPA
04500		POPJ	P,
04600	>
04700		MOVSI	T3,(<SIXBIT /EDS/>)
04800		PUSHJ	P,JOBNUM
04900		MOVEM	T3,XBLOCK
05000		MOVSI	T1,(<SIXBIT /TMP/>)
05100		MOVEM	T1,XBLOCK+1	;GEN FILE NAME
05200		SETZM	XBLOCK+2
05300		SETZM	XBLOCK+3
05400		MOVE	T1,[1B0+17]	;DUMP MODE + PHYS ONLY
05500		MOVSI	T2,'DSK'	;DEFAULT STR
05600		MOVEI	T3,0
05700		OPEN	OUT,T1		;INIT DSK
05800		  JRST	WRTMP1		;LOSE!
05900		ENTER	OUT,XBLOCK
06000		JRST	WRTMP1		;JUST IGNORE
06100		OUTPUT	OUT,T.IOWD
06200	WRTMP1:	RELEAS	OUT,0		;CLOSE CHL
06300		POPJ	P,
06400	
06500	;GENERAL JOBNUMBER KLUDGE...
06600	
06700	JOBNUM:
06800		PJOB	T1,
06900	JOBNM1:	IDIVI	T1,^D10
07000		IORI	T2,20
07100		LSHC	T2,-6
07200		TRNN	T3,77
07300		JRST	JOBNM1
07400		POPJ	P,
     
00100	;UTILITY ROUTINES
00200	
00300	RDSKIP:	PUSHJ	P,RDSKP1		;SKIP SPACES
00400		TRO	FL,F.LAHD		;SET LOOK AGAIN
00500		POPJ	P,
00600	
00700	RDSKP1:	PUSHJ	P,@CHIN
00800		CAIE	C," "
00900		CAIN	C,"	"	;SPACE OR TAB
01000		JRST	RDSKP1
01100		POPJ	P,
01200	
01300	RDATOM:	MOVE	T1,[POINT 6,D]
01400		MOVEI	D,0		;INIT ATOM
01500	RDATO1:	PUSHJ	P,@CHIN
01600		PUSHJ	P,CKALN		;CHECK ALPHA-NUMERIC
01700		JRST	RDATO2
01800		TLNN	T1,770000		;6 YET?
01900		JRST	RDATO1
02000		SUBI	C,40
02100		IDPB	C,T1
02200		JRST	RDATO1
02300	
02400	RDATO2:	CAIE	C," "
02500		CAIN	C,"	"
02600		PUSHJ	P,RDSKP1
02700		PUSHJ	P,CKALN
02800		POPJ	P,
02900		MOVEI	C," "		;RETURN A SPACE IF
03000		TRO	FL,F.LAHD		;ALPHA-NUMERIC
03100		POPJ	P,
03200	
03300	;SUBROUTINE TO CHECK WHAT TO DO AT BREAK CHAR
03400	;CALL:
03500	;	PUSHJ	P,CHKFIL
03600	;	<HERE IF NAME NOT STORED (CHECK D)>
03700	;	<HERE IF NAME STORED AND PERIOD SEEN>
03800	;	<HERE IF NO FURTHER PROCESSING REQUIRED>
03900	
04000	CHKFIL:	SKIPN	NAM(ALTP)	;SEE IF WE GOT A NAME
04100		JRST	CHKFL1		;NO: SET LAHD AND RETURN
04200		AOS	(P)
04300		TRNN	FL,F.PER
04400		JUMPE	D,CPOPJ1	;DOUBLE SKIP IF OK
04500		MOVEI	C," "		;RETURN SPACE
04600	CHKFL1:	TRO	FL,F.LAHD
04700		POPJ	P,		;SKIP RETURN IF NEED TO STASH 'D'
     
00100	;HERE TO FETCH NEXT CHAR
00200	
00300	LDCHR:	SKIPN	RPGSW		;FROM WHERE
00400		JRST	LDCHR1
00500		TRZN	FL,F.LAHD
00600	LDCHRA:	IBP	P.TEXT
00700		LDB	C,P.TEXT
00800		CAIN	C,15		;PURGE CR'S
00900		JRST	LDCHRA
01000		POPJ	P,
01100	
01200	LDCHR1:	TRZE	FL,F.LAHD
01300		SKIPA	C,SVCCIN
01400	LDCHRB:	PUSHJ	P,TTYCH
01500		CAIN	C,15		;SKIP OVER CR'S
01600		JRST	LDCHRB
01700		MOVEM	C,SVCCIN
01800		POPJ	P,
01900	
02000	;CHECK IF CHAR IS ALPHA-NUMERIC
02100	
02200	CKALN:	CAIG	C,"z"
02300		CAIGE	C,"a"
02400		SKIPA
02500		SUBI	C,40	;CONVERT TO UPPER
02600		CAIL	C,"0"
02700		CAILE	C,"Z"
02800		POPJ	P,
02900		CAILE	C,"9"
03000		CAIL	C,"A"
03100		AOS	(P)
03200		POPJ	P,
03300	
03400	;SPECIAL ROUTINE CALLED FROM SET OPTION IN INITIAL PARSE
03500	
03600	OPTSWT:	TLZ	FL2,INPARS	;TEMP CLR FLAG
03700		PUSHJ	P,DOOPT		;PARSE OPTION FILE
03800		  JRST	OPTSE1		;SAY NOT FOUND
03900		  JRST	OPTSE2		;SAY ERROR IN FILE
04000		TLO	FL2,INPARS	;TURN BACK ON
04100		MOVEI	C," "		;PRETEND LAST CHAR WAS A SPACE
04200		POPJ	P,		;RETURN
04300	
04400	OPTSE1:	MOVEI	T1,[ASCIZ /Option not found/]
04500		JRST	COMERR
04600	OPTSE2:	MOVEI	T1,[ASCIZ /Syntax error in option file/]
04700		JRST	COMERR
04800	
04900	SUBTTL OPTION FILE HANDLER
     
00100	;ROUTINE TO EAT AN OPTION FILE IF ANY
00200	;CALL:	PUSHJ	P,DOOPT
00300	;	<OPTION NOT FOUND>
00400	;	<ERROR IN OPTION FILE>
00500	;	<OK RETURN>
00600	; C(OPTION) = SIXBIT OF DESIRED OPTION OR ZERO IF DEFAULT
00700	
00800	DOOPT:	TLNE	FL2,INOPTF	;TRYING TO REENTER
00900		JRST	WRAPUP		;JUST GIVE CURRENT FAILURE
01000		OPEN	OPT,OPTDVI
01100		  POPJ	P,		;SAY NOT FOUND
01200		MOVEI	T1,OPTBUF	;GET BUFFER ADDR
01300		EXCH	T1,.JBFF##
01400		INBUF	OPT,1		;ONE IS ENUF
01500		MOVEM	T1,.JBFF##	;RESTORE JOBFF
01600		SETZM	OPTFIL+2	;CLEAR OUT ANY TRASH
01700		SKIPN	T1,MYPPN	;GET DEFAULT DIRECTORY
01800		PUSHJ	P,USRPPN
01900		MOVEM	T1,OPTFIL+3	;STASH IN CORRECT PLACE
02000		LOOKUP	OPT,OPTFIL	;GO FIND FILE
02100		  JRST	[RELEAS OPT,
02200			 POPJ P,]	;NOT FOUND
02300		MOVEI	T1,OPTCH	;SET UP INPUT ROUTINE
02400		EXCH	T1,CHIN		;SAVE CURRENT ONE
02500		MOVEM	T1,SVOCIN
02600		TLO	FL2,INOPTF	;SAY WE IS IN OPTION FILE
02700		SETZM	SAVCHR		;CLEAR SCANNER
02800	
02900	RDOPT:	PUSHJ	P,SCAN		;FETCH FIRST ATOM OF LINE
03000		CAIN	C,177		;EOF OR ERROR?
03100		JRST	WRAPUP		;YES: FINISH UP AND RETURN
03200		MOVE	T1,ACCUM	;GET WHAT WE FOUND
03300		CAME	T1,[SIXBIT "SOS"]
03400		JRST	SKPEOL		;NOT WHAT WE WANT - TRY NEXT LINE
03500		PUSHJ	P,SCAN		;FETCH BREAK CHAR
03600		SKIPN	OPTION		;NEED DEFAULT?
03700		JRST	DEFOPT		;YES:
03800		CAIE	C,":"		;LOOK AT BREAK CHAR
03900		JRST	SKPEOL		;SKIP LINE IF NOT COLON
04000		PUSHJ	P,SCAN		;GET NEXT ATOM
04100		TRNE	FL,IDF		;SEE IF IDENT
04200		JRST	OPTONE		;YES: TRY THIS
04300		CAIE	C,"("		;COULD BE LEFTPAREN
04400		JRST	OPTDN1		;NOPE - IT IS TRASH
04500	OPTMOR:	PUSHJ	P,SCAN		;TRY FOR ATOM
04600		MOVE	T1,ACCUM
04700		CAMN	T1,OPTION	;IS THIS THE ONE?
04800		JRST	OPTMR1		;SCAN FOR RT PAREN
04900		PUSHJ	P,SCAN		;GULP DOWN BREAK CHAR
05000		CAIN	C,","		;COMMA MEANS MORE COMING
05100		JRST	OPTMOR
05200		CAIN	C,")"		;RT PAREN MEANS THAT'S ALL
05300		JRST	SKPEOL		;TRY NEXT LINE
05400		JRST	OPTDN1		;TRASHINESS
05500	
05600	OPTMR1:	PUSHJ	P,SCAN		;LOOK FOR RT PAREN
05700		CAIE	C,177		;EOF OR ERROR
05800		TRNE	FL,TERMF	;EOL
05900		JRST	OPTDN1
06000		CAIE	C,")"		;A GOOD THING
06100		JRST	OPTMR1		;KEEP LOOKING
06200		JRST	OPTFN0		;GOT IT
06300	
06400	OPTONE:	MOVE	T1,ACCUM
06500		CAME	T1,OPTION	;IS THIS IT?
06600		JRST	SKPEOL		;NO: KEEP LOOKING
06700	OPTFN0:	AOS	(P)		;ALL ELSE ARE ERRORS OR AOK
06800	OPTFND:	PUSHJ	P,SCAN		;SCAN NEXT
06900		TRNE	FL,IDF		;IDENTS ARE OK
07000		JRST	OPTGOT		;GOT ONE - USE IT
07100	OPTNXT:	CAIE	C,"/"		;CHECK LEGAL DELIMS
07200		CAIN	C,","
07300		JRST	OPTGET		;NEED TO SCAN AGAIN
07400		CAIE	C,"-"		;CHECK LINE CONT.
07500		JRST	OPTDON		;NOPE - CHECK PROPER EOL
07600		PUSHJ	P,SCAN		;SCAN PAST DASH
07700		TRNN	FL,TERMF	;PROPER TERM?
07800		JRST	WRAPUP		;NO: SYNTAX ERROR
07900		JRST	OPTFND		;CONTINUE LOOKING
     
00100	OPTGET:	PUSHJ	P,SCAN		;GET NEXT ATOM
00200		TRNN	FL,IDF		;IDENT?
00300		JRST	WRAPUP		;NO: LOSE
00400	OPTGOT:	PUSHJ	P,DOSET		;SWITCH IN "ACCUM" - CALL SET ROUTINE
00500		JRST	WRAPUP		;ILLEGAL ENTRY IN FILE
00600		JRST	OPTNXT		;CONTINUE
00700	
00800	OPTDON:	TRNE	FL,TERMF	;OK IF PROPER TERM
00900	OPTDN1:	AOS	(P)		;GIVE SKIP RETURN
01000		JRST	WRAPUP		;FINISH UP
01100	
01200	DEFOPT:	CAIE	C,":"		;IF COLON JUST SKIP LINE
01300		JRST	OPTFN0		;ELSE WE HAVE CORRECT LINE
01400	SKPEOL:	PUSHJ	P,GNCH		;GET A CHAR
01500		CAIN	C,177		;CHECK ON EOF
01600		JRST	WRAPUP		;DONE IF SO
01700		TLNN	CS,TERM_16	;TERMINATOR?
01800		JRST	SKPEOL		;NO: KEEP GOING
01900		SETZM	SAVCHR		;CLEAR SCANNER
02000		JRST	RDOPT		;YES: TRY THIS LINE
02100	
02200	WRAPUP:	RELEAS	OPT,		;CLOSE CHL
02300		MOVE	T1,SVOCIN	;RESTORE OLD INPUT ROUTINE
02400		MOVEM	T1,CHIN
02500		TLZ	FL2,INOPTF
02600		POPJ	P,		;RETURN
     
00100	;UTILITY ROUTINES TO READ OPTION FILE
00200	
00300	OPTCH:	SOSG	OPTBHD+2
00400		JRST	OPTINP		;NEED MORE
00500	OPTCH1:	ILDB	C,OPTBHD+1	;GET CHAR
00600		JUMPE	C,OPTCH		;IGNORE NULLS
00700		MOVE	CS,@OPTBHD+1	;CHECK FOR SEQ NOS
00800		TRNN	CS,1
00900		POPJ	P,		;NONE - RETURN
01000		MOVNI	C,5		;YES: SKIP IT
01100		ADDM	C,OPTBHD+2
01200		AOS	OPTBHD+1
01300		CAME	CS,PGMK		;PAGE MARK?
01400		JRST	OPTCH		;NO: GET NEXT CHAR
01500		MOVNI	C,4		;YES: SKIP SOME MORE
01600		ADDM	C,OPTBHD+2
01700		MOVSI	C,(<POINT 7,0,35>)
01800		HLLM	C,OPTBHD+1
01900		JRST	OPTCH		;TRY AGAIN
02000	
02100	OPTINP:	STATZ	OPT,760000	;EOF OR ERROR?
02200		JRST	OPTEOF		;YES: RETURN -1
02300		IN	OPT,0
02400		JRST	OPTCH1		;OK - RETURN
02500		STATZ	OPT,740000	;ERROR?
02600		OUTSTR	[ASCIZ /? Read error in option file/]
02700	OPTEOF:	MOVEI	C,177		;GET A RUBOUT
02800		POPJ	P,		;AND RETURN
02900	
03000	SUBTTL	SPECIAL FILE UUOS
     
00100	;ROUTINE TO SET UP FOR FILE OPERATION
00200	
00300	SETPRM:	PUSH	P,T2		;SAVE T2 - T1 ALREADY SAVED
00400		SETZM	XBLOCK+2	;CLEAR RESIDUALS
00500		HRRZ	T2,40		;GET PARAMS ADDRS
00600		MOVE	T1,NAM(T2)	;FILE NAME
00700		MOVEM	T1,XBLOCK
00800		MOVE	T1,EXT(T2)	;EXTENSION
00900		HLLZM	T1,XBLOCK+1
01000		DPB	T1,[POINT 9,XBLOCK+2,8]
01100		SKIPE	T1,PTH(T2)	;CHECK FOR DEFAULT PATH
01200		SKIPN	PTH+1(T2)	;OR JUST PPN
01300		JRST	STPRM1
01400		MOVEI	T1,PTH(T2)	;ADDRS OF PATH INFO
01500		MOVSS	T1
01600		HRRI	T1,PTHADR+2
01700		BLT	T1,PTHADR+2+SFDLVL
01800		SETZM	PTHADR
01900		SETZM	PTHADR+1
02000		MOVEI	T1,PTHADR	;SET UP XBLOCK INFO
02100	STPRM1:	MOVEM	T1,XBLOCK+3
02200		MOVE	T1,40		;FETCH UUO
02300		AND	T1,[17B12]	;GET AC FIELD
02400		JRST	T2POPJ		;RETURN
02500	
02600	;ROUTINE TO DO LOOKUP
02700	
02800	LKX:	PUSHJ	P,SETPRM	;SETUP
02900		IOR	T1,[LOOKUP 0,XBLOCK]
03000		XCT	T1
03100		  AOS	(P)		;SKIP ON FAIL
03200		POPJ	P,
03300	
03400	;ROUTINE TO DO ENTER
03500	
03600	ENX:	PUSHJ	P,SETPRM	;SETUP
03700		IOR	T1,[ENTER 0,XBLOCK]
03800		XCT	T1
03900		  AOS	(P)		;SKIP ON FAIL
04000		POPJ	P,
04100	
04200	;ROUTINE TO DO RENAME
04300	
04400	RNX:	PUSHJ	P,SETPRM	;SETUP
04500		IOR	T1,[RENAME 0,XBLOCK]
04600		XCT	T1
04700		  AOS	(P)		;SKIP ON FAIL
04800		POPJ	P,
04900	
05000	SUBTTL	ERROR ROUTINES
     
00100	EDFLIN:
00200		OUTSTR [ASCIZ /
00300	? Temporary file nnnSOS in use or protected!
00400	/]
00500		EXIT
00600	
00700	NOTDKI:
00800	NOTDKO:
00900	NODSK:
01000		OUTSTR [ASCIZ /
01100	? No DISK available. Please check the DISK you have requested/]
01200		EXIT
01300	
01400	NOFIL:
01500		OUTSTR [ASCIZ /
01600	? File dissappeared -- LOSE BIG!/]
01700		EXIT
01800	
01900	BADPRV:
02000		OUTSTR	[ASCIZ /
02100	? Cannot edit file with prot .GE. 400/]
02200		EXIT
02300	
02400	PDLOV:	MOVEI	T1,200000
02500		APRENB	T1,		;RESET PDL HANDLING
02600		NERROR	STC		;GRONK USER
     
00100	;	THE ERROR HANDLER & SPECIAL FILE OPERATIONS
00200	
00300	ERRHD0:	MOVEM	T1,SVT1E	;SAVE T1 IN CASE OF RERROR
00400		LDB	T1,[POINT 9,40,8]
00500		CAILE	T1,MAXUUO	;CHECK LEGAL
00600		ERROR	ILUUO
00700		XCT	EDISP(T1)	;DO FUNCTION
00800		  AOS	ERRHD		;NON-SKIP MEANS SKIP
00900		MOVE	T1,SVT1E	;RESTORE T1
01000		JRSTF	@ERRHD		;RETURN
01100	
01200	ERRCON:	HRRZ	T1,40		;PICK UP THE ERROR NUMBER
01300		SKIPE	T1
01400		CAILE	T1,NUMER
01500		ERROR	ILUUO		;WRONG ERROR, CALL SELF
01600		TLNE	FL2,INOPTF!INPARS ;TREAT OPTION FILE AS SPECIAL
01700		JRST	OPTERR		;...
01800		MOVEM	T1,SVERN	;SAVE FOR =ERROR COMMAND
01900		TRNE	FL,EXTOG
02000		SKIPA	T1,ETBL-1(T1)	;(NN ZERO ERRORS) GET MESSAGE
02100		MOVE	T1,ETBL2-1(T1)	;GET LONG FORM
02200		OUTSTR	@T1
02300		TRNN	FL2,COMFLF	;IN COMMAND FILE?
02400		JRST	ERRHD1		;NO: SKIP OVER LINE PRINT
02500		OUTSTR	COMESS		;MSG ADDRS
02600	ERRHD1:	LDB	T1,[POINT 9,40,8] ;GET UUO
02700		XCT	ERND(T1)	;DO GOOD THING
02800		JRST	@ERRHD		;RERROR WILL FALL THROUGH XCT AND RETURN
02900	
03000	ERND:	ERROR	ILUUO		;(0) IS AN ERROR
03100		JRST	LOSER		;(1) DIE
03200		JRST	CKIND		;(2) CHECK IND FILE
03300		MOVE	T1,SVT1E	;(3) RERROR- RESTORE T1
03400	
03500	LOSER:	OCRLF
03600		EXIT	1,
03700		EXIT
03800	
03900	CKIND:	TRZ	FL2,COMFLF	;CLR COMMAND FILE FLAG
04000		CLRBFI			;CLEAR OUT THINGS
04100		SETZM	TTIBH+2
04200		TRZ	FL2,SUPN	;...
04300		JRST	COMND		;GO ON
04400	
04500	EDISP:	ERROR	ILUUO		;(0) ILLEGAL
04600		JRST	ERRCON		;(1) ERROR
04700		JRST	ERRCON		;(2) NERROR
04800		JRST	ERRCON		;(3) RERROR
04900		PUSHJ	P,LKX		;(4) XLOOK
05000		PUSHJ	P,ENX		;(5) XENTR
05100		PUSHJ	P,RNX		;(6) XRENM
05200	
05300	SUBTTL	CONTROL-C INTERCEPT CODE
     
00100	REENT:	TLO	FL2,RENTF	;ONLY IF ALLOWED
00200		POPJ	P,
00300	
00400	OPTERR:	MOVE	T1,SVT1E	;RESTORE T1
00500		POP	P,0(P)		;UP A LEVEL
00600		POPJ	P,		;AND GIVE ERROR RETURN
00700	
00800	;CONTROL C INTERCEPT HANDLERS
00900	
01000	;ENABLE INTERCEPT
01100	
01200	ENBINT:	MOVEI	T1,CNCBLK
01300		MOVEM	T1,.JBINT##
01400		SETOM	CNCLOK		;CLEAR INTERLOCK FOR FIRST TIME
01500		MOVEI	T1,CNCREN	;SET UP REENTER ADDRS
01600		MOVEM	T1,.JBREN##
01700		POPJ	P,
01800	
01900	;DISABLE INTERCEPT
02000	
02100	DISINT:	SETZM	.JBINT##
02200		SETZM	.JBREN##
02300		POPJ	P,
02400	
02500	;INTERUPT HANDLER
02600	
02700	CNCINT:	AOSE	CNCLOK		;TRYING TO RE-ENTER?
02800		JRST	CNCAGN		;YES: SKIP OVER CODE
02900		PUSH	P,CNCBLK+2	;STASH PC FOR RETURN
03000		PUSH	P,T1		;SAVE A REG
03100	CNCAGN:	HLRZ	T1,CNCBLK+3	;GET REASON
03200		CAIE	T1,1B34		;^C ONLY
03300		ERROR	ICN
03400		SETZM	CNCBLK+2	;RE-ENABLE
03500		TLNE	FL2,NORENT	;ARE WE DISABLED?
03600		JRST	CNCREN		;YES: JUST RE-ENTER
03700	CNCIN0:	OUTSTR	[ASCIZ "Yes? "]
03800		TRNN	FL,EXTOG
03900		OUTSTR	[ASCIZ "(Type H for help): "]
04000		INCHRW	T1		;GET REPLY
04100		OCRLF
04200		CLRBFI			;CLEAR OUT TTY TYPE AHEAD
04300		ANDI	T1,137		;FORCE UPPER CASE
04400		CAIN	T1,"H"
04500		JRST	CNCHLP		;GIVE HELP
04600		CAIN	T1,"C"
04700		JRST	CNCCON		;CONTINUE
04800		CAIN	T1,"M"
04900		JRST	MONRET		;PUNT!
05000		CAIN	T1,"E"
05100		JRST	CNCXIT		;DO "E" COMMAND
05200		CAIN	T1,"Q"
05300		JRST	CNCQT		;DO "EQ" COMMAND
05400		CAIN	T1,"R"
05500		JRST	CNCREN		;DO LIKE REENTER
05600		CAIN	T1,"D"
05700		SKIPN	T1,.JBDDT##
05800		JRST	CNCIN0		;TRY AGAIN
05900		HRRZ	T1,T1
06000		EXCH	T1,0(P)		;STASH ON PDL
06100		POP	P,0(P)		;AND PRUNE
06200		SETOM	CNCLOK		;CLEAR INTERLOCK
06300		JRST	@1(P)		;AND GO DEBUG
06400	
06500	;HERE TO DUMMY E CMD
06600	
06700	CNCXIT:	TLO	FL2,DOENDF	;SET DO END REQUEST
06800		JRST	CNCREN		;AND TREAT LIKE RE-ENTER
06900	
07000	;HERE TO DUMMY UP EQ
07100	
07200	CNCQT:	MOVEI	T1,12		;FAKE OUT SCANNER
07300		MOVEM	T1,LIMBO
07400		SETOM	CNCLOK		;CLEAR INTERLOCK
07500		JRST	QUIT		;AND EXIT
07600	
07700	CNCREN:	SKIPGE	CNCLOK		;IS THIS A "REE" CMD?
07800		JRSTF	@.JBOPC##	;TRY THIS ONE
07900		POP	P,T1
08000		SETOM	CNCLOK		;CLEAR INTERLOCK
08100		JRST	REENT		;AND EXIT
08200	
08300	;ROUTINE TO CHECK IF WE HAVE REENTERED, SKIP RETURN IF NOT.
08400	
08500	CHKREN:	TLNN	FL2,NORENT	;ALLOWED?
08600		TLZN	FL2,RENTF	;YES: CHECK FLAG
08700		AOS	(P)		;NO: SKIP RETURN
08800		POPJ	P,		;NO SKIP IF WE DID
08900	
09000	CNCCON:	POP	P,T1		;RESTORE T1
09100		SETOM	CNCLOK		;CLEAR INTERLOCK
09200		POPJ	P,		;AND CONTINUE
09300	
09400	CNCHLP:	OUTSTR	CNCTXT
09500		SKIPE	.JBDDT##
09600		OUTSTR	[ASCIZ "D - transfer to DDT
09700	"]
09800		JRST	CNCIN0
09900	
10000	CNCTXT:	ASCIZ "Type one of:
10100	C - to CONTinue automatically
10200	E - to end edit and close file
10300	Q - to quit (delete temporary files)
10400	M - return to MONITOR now
10500	R - to do REEnter (terminate losing search etc.)
10600	"
10700	
10800	SUBTTL	ERROR MESSAGES
     
00100	DEFINE ERMS (A)
00200	<IRP (A) <EXP [ASCIZ /
00300	A
00400	/]
00500	>>
00600	
00700	ETBL:	ERMS	<?Internal confusion,?Device input error>
00800		ERMS	<?Device output error,%ILC,?ILUUO,%LTL,%NLN,%NSP,%ORDER>
00900		ERMS	<?Device not available,%ILR>
01000		ERMS	<%WAR,%TMS,%STL,%ISS,%ILFMT,%NSG,%FNF,%DNA,%NEC,%IRS,%STC,%ITD>
01100		ERMS	<%NNN,%SRF,?DMERR,%CMEND,%MAR,?Bad "BASIC" file format>
01200	NUMER==.-ETBL
01300	ETBL2:	ERMS	<?Internal confusion,?Device input error>
01400		ERMS	<?Device output error,%Illegal command,?Illegal UUO>
01500		ERMS	<%Line too long>
01600		[ASCIZ	/
01700	%No such line(s)
01800	/]
01900		ERMS	<%No such page>
02000		ERMS	<%Out of order,?Device no available,%Illegal replacement on insert>
02100		ERMS	<%Wrap around,%Too many strings,%String too long>
02200		ERMS	<%Illegal search string,%Illegal line format>
02300		ERMS	<%No string given,%File not found,%DISK not available>
02400		ERMS	<%Insufficient core available,%Illegal replacement string>
02500		ERMS	<%Search string too complex,%Illegal transfer destination>
02600		ERMS	<%No next line,%Search fails>
02700		ERMS	<?Indirect read error,%Indirect EOF>
02800		ERMS	<%Margin error,?Bad "BASIC" file format>
02900	SUBTTL COMMAND DECODER
     
00100	;HERE IS THE COMMAND DECODER AND DISPATCHER
00200	
00300	COMND:	SETZM SAVCHR	;SCAN SHOULD GET RESET AT THIS POINT
00400		SETZM SAVC	;...
00500		ONECHO			;TURN ECHO BACK ON JUST IN CASE
00600		SKIPN T1,TEMINC;TEMP INCR?
00700		MOVE T1,INCR	;NO: USE CURRENT ONE
00800		MOVEM T1,INCR	;YES: RESOTRE OLD ONE
00900		SETZM TEMINC	;CLEAR TEMP
01000		TLNE FL,SRCOP	;THIS CASE IS SPECIAL SINCE WE
01100		SKIPA P,COPDL	;SHOULD NOT DESTROY SAVED ITEMS
01200		MOVE P,[IOWD PDLSIZ,PDL]	;ALSO PDL (IN CASE OF ERRORS)
01300		TLZE	FL2,DOENDF	;NEED END COMMAND?
01400		JRST	CMDEND		;YES: GO DO IT
01500		TLNE FL,SRCOP
01600		JRST NOCPCK	;DO NOT GET OUT OF COPY MODE
01700		TLZE FL,ISCOP	;IN COPY MODE?
01800		JRST COPDON	;YES, DO SPECIAL CLEAR OUT
01900	NOCPCK:
02000		SKPINL
02100		 JFCL
02200		TLZN	FL2,NORENT	;NEED TO CHECK FOR REENTER
02300		JRST	NORNCK		;NO:
02400		TLZE	FL2,RENTF	;SEE IF NEED TO REENTER
02500		JRST	[MOVEI T1,[TLZ FL2,RENTF
02600				   JRST COMND]
02700			 MOVEM T1,CNCBLK+2
02800			 MOVEI T1,1B34
02900			 HRLM T1,CNCBLK+3	;FAKE OUT CNCINT
03000			 JRST CNCINT]
03100	NORNCK:	TRNN	FL,EXTOG	;SKIP THIS HACK IF IN EXPERT MODE
03200		SKIPN	T1,DELCNT#	;  OR IF NO DELETIONS
03300		JRST	CMNDA
03400		MOVEI	T3,OCHR		;SET UP FOR PRINTER
03500		PUSHJ	P,DECPR		;PRINT # OF LINES DELETED
03600		PUSHJ	P,FORCE		;DUMP IT
03700		OUTSTR	[ASCIZ / Lines (/]
03800		MOVE	T1,FDELLN#	;GET FIRST LINE DELETED
03900		MOVEM	T1,LINOUT	;PRINT IT
04000		OUTSTR	LINOUT
04100		MOVE	T1,FDELPG#
04200		PUSHJ	P,DECPR		;AND PAGE #
04300		PUSHJ	P,FORCE
04400		MOVE	T1,LDELLN#	;LAST LINE DELETED
04500		SKIPN	PGDELS		;IF ANY PAGE MARKS DELETED
04600		CAME	T1,FDELLN	;SAME AS FIRST?
04700		JRST	[OUTCHR [":"]	;NO: PRINT IT ALSO
04800			 SETZI T2,
04900			 OUTSTR T1
05000			 SKIPN T1,PGDELS
05100			 JRST .+1
05200			 ADD T1,FDELPG
05300			 OUTCHR ["/"]
05400			 PUSHJ P,DECPR
05500			 PUSHJ P,FORCE
05600			 JRST .+1]
05700		OUTSTR	[ASCIZ /) deleted
05800	/]
05900	CMNDA:	PUSHJ	P,CMDSAV	;CHECK FOR AUTO-SAVE
06000		  JRST	CMND2		;DO IT
06100		TRNE FL2,SUPN!COMFLF	;SUPPRESS * AFTER PRETTY PRINT
06200		JRST	CMNDB
06300		TLNE	FL,SRCOP	;GIVE XTRA PROMPT IF COPY
06400		OUTCHR	["C"]
06500		OUTCHR	["*"]
06600	CMNDB:	TRZ	FL2,SVIT!SUPN	;TURN OFF SOME BITS
06700	IFN EXTEND,<
06800		MOVEI T1,LSNUM	;RESET LINE SEARCH STRINGS
06900		MOVEM T1,LSBUFN
07000	>
07100		TRNN FL2,COMFLF		;COMMAND FILE?
07200		JRST CMND1		;NO
07300		MOVE T2,[ASCII /00001/]	;INCREMENT CMD CNT
07400		MOVE T1,COMCNT
07500		PUSHJ P,ASCIAD		;ASCII ADDDER
07600		MOVEM T1,COMCNT		;STORE
07700	CMND1:	PUSHJ P,GNCH	;READ A CHARACTER
07800		TLZ	FL2,RENTF	;CLEAR FLAG - HE MAY TRY TO REENTER
07900		CAIE C,15
08000		JUMPE CS,CMND1	;IGNORE SPACES ETC
08100		TLNE CS,LETF_16	;CHECK TO SEE IF LETTER
08200		TRZ C,40	;AND CONVERT TO UPPER CASE
08300	CMND2:	MOVSI T1,-CMDLG	;GET LENGTH OF COMMAND TABLE
08400		CAME C,CMD1(T1)	;COMPARE
08500		AOBJN T1,.-1	;CHECK FOR MATCH
08600		SETZM	DELCNT
08700		SETZM	LDELLN
08800		SETZM	FDELLN
08900		SETZM	FDELPG		;INIT DELETE CNTS
09000		JUMPL T1,@CMD2(T1)	;DISPATCH IF FOUND
09100		NERROR ILC	;ELSE ERROR
09200	
09300	CMD1:	EXP "P",15,"E","I","D","M","N","H","/"
09400		EXP "A","_","=","L","R","F",12,200,"C","S"
09500		EXP "G","X","J","T","W","@","Q","K","."
09600	CMDLG==.-CMD1
09700	CMD2:	EXP PRINT,NULCMD,ENDIT,INSERT,DELETE,MARK,NUMBER
09800		EXP HELP,SET,ALTER,SET,GIVE,LIST,REPLAC,SEARCH
09900		EXP NXTLIN,BAKLIN,COPY,SUBST,GEND,XPAND,JUST
10000		EXP TRANS,SVCOD,COMFIL,QCOM,KILL,MOVE
10100	
10200	;COME HERE TO DO AUTO SAVE
10300	
10400	CMDSAV:	TRNE	FL,READOF	;CHECK RO
10500		JRST	CPOPJ1		;YES - SKIP THIS
10600		TLZE	FL2,CCHGF	;DID THIS COMMAND CHANGE THINGS?
10700		SOSE	SAVEN		;YES -- COUNT DOWN
10800		JRST	CPOPJ1		;STILL OK
10900		OUTSTR	[ASCIZ "[Doing auto-save, please wait.]"]
11000		OCRLF
11100		MOVEI	C,"W"		;FUDGE UP W COMMAND
11200		MOVEI	T1,12		;FUDGE UP LINE TERM
11300		MOVEM	T1,LIMBO
11400		POPJ	P,		;PROCESS COMMAND
11500	
11600	NULCMD:	PUSHJ	P,GNCH		;GRNTEE LF AFTER CR COMMAND
11700		CAIE	C,12		;IS IT?
11800		NERROR	ILC		;NO: LOSE
11900		JRST	COMND		;YES: WIN
12000	
12100	CMDEND:	MOVEI	C,"E"		;DUMMY CMD
12200		TLZ	FL2,RENTF	;CLR FLAG
12300		MOVEI	T1,12
12400		TLNN	FL,SRCOP	;NEED DUMMY LF IF NOT COPY
12500		MOVEM	T1,LIMBO
12600		JRST	CMND2		;PROCESS
12700	
12800	SUBTTL MOVE & HELP
     
00100	MOVE:	SETZM LOLN
00200		PUSHJ P,GET1S		;GET A POS.
00300		TRNE FL,TERMF		;CHECK ARG
00400		SKIPN HILN
00500		NERROR ILC
00600		MOVE T1,HIPG
00700		MOVEM T1,DPG
00800		MOVE SINDEX,HILN	;PERFORM SEARCH
00900		PUSHJ P,FIND
01000		MOVE T2,CPG		;FIND THE ONE WE WANT
01100		CAME T2,HIPG
01200		NERROR NSP
01300		CAME T1,HILN
01400		NERROR NLN
01500		MOVEM T1,CLN		;MAKE IT CURRENT
01600		MOVEM T2,CPGL
01700		JRST COMND
01800	
01900	HELP:	PUSHJ	P,SCAN		;CHECK FOR VALID TERM
02000		TRNN	FL,TERMF
02100		NERROR	ILC
02200		HRROI	T1,.GTPRG	;GET NAME OF THIS PROG
02300		GETTAB	T1,
02400		MOVSI	T1,'SOS'	;USE DEFAULT IF NECESSARY
02500		PUSH	P,.JBFF##	;PLACE FOR BUFFER IS NEEDED
02600		HRRZ	T2,.JBREL##	;USE TOP OF CORE
02700		ADDI	T2,1
02800		MOVEM	T2,.JBFF##	;...
02900		PUSHJ	P,.HELPR##	;CALL CONKLINS CROCK
03000		POP	P,.JBFF##	;RESTORE OLD FF
03100		JRST	COMND		;RETURN TO DO USEFUL THINGS
03200	
03300		SUBTTL PRINT
     
00100	;PRINT LINES SPECIFIED
00200	
00300	PRINT:	SETZM LOLN	;AS A FLAG IN CASE OF /C OR /A,/C
00400		TRZ	FL2,SUPN
00500	IFN PPNTSW,<
00600		MOVEI	JF,0		;CLEAR SPECIAL FLAGS
00700		MOVEI T2,1
00800		MOVEM T2,LSTCNT
00900		SETZM LOGPG		;CLEAR COUNTERS AND THINGS
01000	>
01100		PUSHJ P,SCAN
01200		CAIE C,","	;IS THERE A SWITCH?
01300		JRST PRNT5	;NO
01400		PUSHJ P,PRNSCN	;SCAN FOR SWITCHES
01500	PRNT5:	TRNE FL,TERMF
01600		JRST	[MOVE T1,CLN	;MAKE P WITH NO ARGS DO P.!<PLINES>
01700			 MOVEM T1,LOLN
01800			 MOVE T1,CPGL
01900			 MOVEM T1,LOPG
02000			 MOVE T1,PLINES
02100			 MOVEM T1,SVCNT
02200			 TRO FL,CNTF
02300			 TRNE FL,DPYF
02400			 OUTSTR [BYTE (7)32,177,177,177]
02500			 JRST PRCNT]
02600		PUSHJ P,GET2	;GET A DOUBLE STRING
02700		CAIE C,","	;I{S THERE A SWITCH?
02800		JRST PRNT6	;NO
02900		PUSHJ P,PRNSCN	;YES, LOOK AT THEM
03000	PRNT6:	TRNN FL,TERMF	;DID IT END WITH A TERMINATOR
03100		NERROR ILC	;NO, ILLEGAL
03200	PRCNT:	TRZ FL,LINSN	;USE THIS AS A FLAG TO CHECK FOR NULL RANGE
03300		TRNE	FL2,NONUMF	;NEED TO SUPPRESS NUMBERS
03400		TRO	FL2,SUPN	;YES:
03500	IFN PPNTSW,<
03600		TRNE	JF,EJECT!WAIT
03700		PUSHJ P,PGWT	;WAIT FOR USER!
03800	>
03900	RPGPRN:	MOVE T1,LOPG	;FIND THE FIRST LINE WANTED
04000		MOVEM T1,DPG	;SET IT AS THE ONE WE WANT
04100		MOVE SINDEX,LOLN	;PICK UP THE LINE
04200		PUSHJ P,FIND	;GO GET IT
04300		SKIPE LOLN	;DID WE WANT TO PRINT AN ENTIRE PAGE
04400		JRST PRNT1	;NO, GO CHECK BOUNDS
04500		MOVE T2,CPG	;WHICH ONE ARE WE ON
04600		MOVEM T2,CPGL
04700		TRNN	FL2,SUPN
04800		PUSHJ P,PGPRN	;PRINT THE PAGE HEADER
04900		TRO FL,LINSN	;THIS CAN COUNT AS A LINE
05000	PRNT1:	PUSHJ P,ONMOV	;CHECK TO SEE IF STILL IN RANGE
05100		JRST EPRNT	;NO, END
05200		TRO FL,LINSN	;WE HAVE SEEN ONE
05300		CAMN T1,PGMK	;IS IT A PAGE MARK?
05400		JRST PRNT3	;YES, DO SOMETHING SPECIAL
05500		MOVEM T1,CLN
05600		MOVEM T2,CPGL	;SAVE PAGE TOO
05700		MOVE T1,PNTR	;GET THE POINTER TO IT
05800		PUSHJ P,OUTLIN	;AND PRINT
05900	IFN PPNTSW,<
06000		AOSN LSTCNT
06100		PUSHJ P,PAGEND	;END OF PAGE
06200	>
06300	PRNT4:	PUSHJ P,FINDN	;GET THE NEXT LINE
06400		JRST PRNT1	;AND CONTINUE
06500	PRNT3:	MOVEM T2,CPGL
06600	IFN PPNTSW,<
06700		SOS LSTCNT	;ADJUST FOR PAGE MARK
06800		PUSHJ P,PAGEND	;DO END OF PAGE ROUTINE
06900		SETZM LOGPG	;RESET LOGICAL PAGE COUNTER
07000	>
07100		TRNE	FL2,NONUMF	;SPECIAL HACK IF NONUM MODE
07200		OUTCHR	[14]		;WON'T HE BE ...
07300		TRNN	FL2,SUPN	;UNLESS PRINTING A CLEAN COPY,
07400		PUSHJ P,PGPRN	;GO PRINT A PAGE HEADER
07500		AOS CPG
07600		MOVE T2,[<ASCII /00000/>!1]
07700		MOVEM T2,CLN	;SET LINE TO FIRST ON THAT PAGE
07800		JRST PRNT4	;AND CONTINUE
07900	EPRNT:	TRZN FL,LINSN	;DID WE PRINT SOMETHING
08000		NERROR NLN	;NO, ERROR
08100	IFN PPNTSW,<
08200		PUSHJ P,PAGEJT	;EJECT PAGE
08300	>
08400		TRNE	FL2,NONUMF
08500		TRZ	FL2,SUPN	;TURN IT OFF IF IN NONUM MODE
08600		JRST COMND	;YES, RETURN FOR COMMAND
08700	
08800	
08900	
09000	;CHECK TO SEE IF OUT OF LIMITS SKIP RETURN IF OK
09100	ONMOV:	JUMPE T1,CPOPJ	;0, MUST BE EOF SO ALL DONE
09200		PUSHJ	P,CHKREN	;CHECK REENTER
09300		POPJ	P,		;YES: SAY WE ARE THROUGH
09400	ONMOV1:	MOVE T2,CPG	;GET THE CURRENT PAGE
09500		CAMN T1,PGMK	;ARE WE AT A PAGE MARK?
09600		ADDI T2,1	;YES, TREAT AS NEXT PAGE
09700		TRNE FL,CNTF	;IS THIS A ! TYPE COMMAND?
09800		JRST ONCNT
09900		CAMLE T2,HIPG	;HOW DOES IT COMPAGE WITH UPPER LIMIT
10000		POPJ P,		;HIGHER, ALL DONE
10100		CAME T1,PGMK	;IF PAGE MARK, DO NOT COMPARE LINE
10200		CAME T2,HIPG	;OR IF NOT ON LAST PAGE
10300		SKIPA
10400		CAMG T1,HILN	;ARE WE OUT OF LINES?
10500		AOS (P)	;SKIP RETURN ALL OK
10600		POPJ P,		;GO
10700	
10800	ONCNT:	CAMN T1,PGMK	;DO NOT COUNT PAGE MARKS
10900		SKIPG SVCNT	;IF PAGE MARK, GIVE UP IF DONE
11000		SOSL SVCNT	;ARE WE OUT
11100		AOS (P)		;SKIP RETURN FOR OK
11200		POPJ P,
     
00100	;HERE TO EJECT PAGE
00200	
00300	IFN PPNTSW,<
00400	PAGEJT:	TRNN	JF,EJECT	;EJECTING?
00500		POPJ P,		;NO: JUST RETURN
00600		MOVE T5,LSTCNT
00700		ADD T5,PAGESZ	;GET COUNT LEFT
00800		SUBI T5,FULLPG	;EJECT TO TOP OF PAGE
00900		TRNN	JF,WAIT		;IF NOT WAITING
01000		SUBI T5,1	;ONE MORE LINE
01100		SUBI T5,1	;HANDLE ZERO CASE
01200		MOVEI C,15	;PUT OUT CR
01300		PUSHJ P,OCHR
01400		JRST PUTLN1
01500	
01600	PUTLN:	MOVEI C,12
01700		PUSHJ P,OCHR	;OUTPUT LF'S
01800	PUTLN1:	CAMN T5,[-11]	;A BIT WEIRD
01900		PUSHJ P,PUTPG
02000		AOJL T5,PUTLN
02100		AOS LOGPG	;INCR LOGICAL PAGE
02200		PUSHJ	P,FORCE		;OUTPUT
02300		POPJ P,
02400	
02500	;HERE TO WAIT FOR BOTTOM OF PAGE
02600	
02700	PAGEWT:	TRNN	JF,WAIT	;WAITING?
02800		JRST NOWAIT	;NOPE!
02900	PGWT:
03000		OUTSTR [BYTE (7)10,10,10,10,0]
03100	READ1:	PUSHJ P,GNCH	;GET NEXT CHAR
03200		CAIE C,"G"
03300		CAIN C,"g"
03400		TRZ	JF,WAIT
03500		CAIE C,"Q"
03600		CAIN C,"q"
03700		JRST QPRINT
03800		CAIE C,12	;LF?
03900		JRST READ1
04000	NOWAIT:	MOVN T5,PAGESZ	;RESET LINE COUNT
04100		MOVEM T5,LSTCNT
04200		POPJ P,
04300	
04400	QPRINT:	PUSHJ P,GNCH
04500		CAIE C,12	;SKIP TO LF
04600		JRST QPRINT
04700		JRST COMND
04800		;;;; STILL IN IFN PPNTSW
     
00100	;HERE ON END OF PAGE
00200	
00300	PAGEND:	PUSHJ P,PAGEJT	;EJECT A PAGE
00400		JRST PAGEWT	;AND GO WAIT
00500	
00600	;ROUTINE TO OUTPUT FUNNY PAGE NUMBERS
00700	
00800	PUTPG:	TRNN	JF,PGNOS	;ARE WE?
00900		POPJ P,
01000		MOVE T1,RMAR
01100		ADD T1,LMAR
01200		ASH T1,-1	;PUT OUT (R+L)/2 BLANKS
01300	PUTPG1:
01400		OUTCHR [" "]
01500		SOJG T1,PUTPG1
01600		OUTCHR ["-"]
01700		MOVE T2,CPG		;CURRENT PAGE
01800		PUSHJ P,DPRNT
01900		MOVE T2,LOGPG		;LOGICAL PAGE
02000		JUMPE T2,PUTPG2
02100		OUTCHR ["."]
02200		PUSHJ P,DPRNT		;SUB-PAGE
02300	PUTPG2:
02400		OUTSTR [BYTE (7)"-",15]
02500		POPJ P,
02600	>	;;; END IFN PPNTSW
     
00100	;PRINT SWITCH SCANNER
00200	
00300	IFN PPNTSW,<
00400	PRNSCN:	PUSHJ P,SCAN		;GET NEXT CHAR
00500		MOVS T1,ACCUM
00600		CAIN T1,(<SIXBIT /N  />)
00700		TRO	JF,PGNOS
00800		CAIN T1,(<SIXBIT /S  />)
00900		TRO	FL2,SUPN
01000		CAIN T1,(<SIXBIT /W  />)
01100		TRO	JF,WAIT
01200		CAIN T1,(<SIXBIT /E  />)
01300		TRO	JF,EJECT
01400		CAIN T1,(<SIXBIT /F  />)
01500		JRST	[TRO JF,EJECT!WAIT
01600			 TRO FL2,SUPN
01700			 JRST .+1]
01800		PUSHJ P,SCAN		;SCAN PAST IT
01900		TRNE FL,TERMF		;TERMINATOR
02000		JRST	[TRNN	JF,EJECT!WAIT!PGNOS
02100			 TRNE	FL2,SUPN
02200			 POPJ P,
02300			 NERROR ILC]
02400		CAIE C,","		;MORE?
02500		NERROR ILC
02600		JRST PRNSCN		;YES - GET EM
02700	>
02800	
02900	IFE PPNTSW,<
03000	PRNSCN:	PUSHJ	P,SCAN		;GET NEXT ATOM
03100		MOVS	T1,ACCUM
03200		CAIE	T1,(<SIXBIT /S  />)
03300		NERROR	ILC		;ONLY LEGAL SW IS S
03400		PUSHJ	P,SCAN		;SCAN PAST IT
03500		TRNN	FL,TERMF	;MUST BE END
03600		NERROR	ILC
03700		TRO	FL2,SUPN	;SET FLAG
03800		POPJ	P,		;RETURN
03900	>
     
00100	PGPRN:	TRNN	FL,DPYF		;CHECK DPY MODE
00200		OCRLF
00300		OUTSTR	[ASCIZ /Page /]
00400		PUSHJ P,DPRNT	;PRINT THE NUMBER IN T2
00500		OCRLF
00600		AOS LSTCNT
00700		AOS LSTCNT		;PAGE N - TAKES 2 LINES
00800		POPJ P,
00900	
01000	;THE USUAL NUMBER PRINTER
01100	
01200	DPRNT:	JUMPGE	T2,DPRNT0	;OK IF NOT NEG.
01300		MOVN	T2,T2		;ELSE MAKE POSITIVE
01400		OUTCHR	["-"]		;AND OUTPUT A MINUS
01500	DPRNT0:	IDIVI T2,^D10
01600		HRLM T3,(P)
01700		SKIPE T2
01800		PUSHJ P,DPRNT0
01900		HLRZ C,(P)
02000		ADDI C,"0"
02100		OUTCHR C
02200		POPJ P,
02300	
02400	
02500	;CHARACTER OUTPUT
02600	
02700	OCHR:	JUMPE	C,CPOPJ		;IGNORE NULLS
02800		MOVE	CS,CTBL(C)	;GET THE MAJIC BITS
02900		TLNE	CS,LETF_16	;CHECK FOR LETTER
03000		TDC	C,CASEBT	;AND CHANGE CASE AS NECESSARY
03100		TRNE	FL2,SUPN	;IS THIS A PRETTY PRINT? IF SO NO ' CONVERSION
03200		JRST	OCH2
03300		PUSH	P,C		;SAVE THE CHARACTER
03400		LDB	C,[POINT 7,CTBL(C),10]	;GET PRINT EQUIV.
03500		JUMPE	C,OCH1		;NONE, PRINT ORIGINAL
03600		TDNE	CS,[XWD LETF_16,M37]	;IS THIS A LETTER OR SPECIAL
03700		TRNN	FL,M37F		;AND A MODEL 37
03800		TLNE	FL,QMODF
03900		JRST	[MOVE C,(P)	;GET ORIG CHAR
04000			 CAIL C,40	;CHECK FOR CONTROL CHAR
04100			 JRST OCH1	;NO - JUST PRINT IT
04200			 ADDI C,100
04300			 MOVEM C,(P)	;CONVERT TO PRINTING CHAR
04400			 MOVEI C,"^"
04500			 JRST OCH0]
04600		MOVEM	C,(P)		;SAVE IN STACK
04700		MOVEI	C,"'"
04800	OCH0:	PUSHJ	P,OCH2		;PUT OUT CHR
04900	OCH1:	POP	P,C		;GET CHAR TO PRINT
05000	OCH2:	SOSG	TTOCNT
05100		PUSHJ	P,FORCE
05200		IDPB	C,TTOPNT
05300		POPJ	P,		;AND RETURN
05400	
05500	
05600	
05700	OUTLIN:	TRNE	FL2,SUPN!NONUMF	;ARE WE SUPPRESSING LINE NUMBERS?
05800		AOS	T1		;YES, SKIP IT
05900		HRLI	T1,(<POINT 7,0>);GET SET TO PRINT A LINE
06000		TRNE	FL2,SUPN!NONUMF	;IF SUPPRESSING LINE NUMBERS
06100		IBP	T1		;ALSO SUPPRESS THE TAB WHICH FOLLOWS
06200	OUTL1:	ILDB	C,T1		;GET A CHR
06300		JUMPE	C,FORCE		;QUIT ON NUL
06400		PUSHJ	P,OCHR		;AND PRINT IT
06500		CAIE	C,12		;IS IT LINE FEED
06600		JRST	OUTL1		;NO, CONTINUE
06700			;;;		;FALLIN FORCE
06800	
06900	;ROUTINE TO DUMP TTY BUFFER AND SET UP FOR NEXT
07000	
07100	FORCE:	PUSH	P,C		;SAVE CURRENT CHAR
07200		MOVEI	C,0		;GRNTEE NULL
07300		IDPB	C,TTOPNT	;AT END OF STRING
07400		OUTSTR	TTOBUF		;DUMP IT
07500		MOVEI	C,^D80		;NEW COUNT
07600		MOVEM	C,TTOCNT
07700		MOVE	C,[POINT 7,TTOBUF]
07800		MOVEM	C,TTOPNT	;AND PNTR
07900		POP	P,C		;RESTORE C
08000		POPJ	P,		;AND RETURN
08100	
08200	SUBTTL END ROUTINE
     
00100	;CODE TO FINISH OFF EDIT
00200	
00300	ASVINS:	SKIPA	T1,HILN		;LAST LINE INSERTED
00400	ASVREP:	MOVE	T1,LOLN		;...
00500		MOVEM	T1,SVLNUM	;SAVE FOR RESTART
00600		TLO	FL2,AUTOF	;SET TO DO AUTO SAVE
00700		SKIPE	ALTSN		;NEED CRLF?
00800		OCRLF			;YEP
00900		OUTSTR	[ASCIZ "[Doing auto-save, please wait.]"]
01000		OCRLF
01100	SVCOD:	TLNE	FL,SRCOP	;IF INSIDE COPY
01200		JRST	DSCOP		;TREAT LIKE AN E
01300		TRO	FL2,SVIT	;SET TO DO A SAVE
01400		MOVE	T1,SSAVEN	;RESET ALL CNTRS
01500		MOVEM	T1,SAVEN
01600		JUMPN	T1,[TLNN FL2,AUTOF
01700		    	    AOS SAVEN	;FIX CMD COUNT IF NOT AUTO
01800			    JRST .+1]
01900		MOVE	T1,SISAVN
02000		MOVEM	T1,ISAVEN	;...
02100		PUSH	P,UNSEQF	;SAVE CURRENT VALUE
02200		SKIPN	UNSEQF		;CHECK FOR UNSEQ
02300		JRST	END0		;PROCEDE
02400		OUTSTR	[ASCIZ "[WARNING: Sequence numbers preserved.]"]
02500		OCRLF
02600		SETZM	UNSEQF
02700		JRST	END0
     
00100	GEND:	TLOA	FL,GCOM		;GO
00200	ENDIT:	TLZ	FL,GCOM		;NORMAL TYPE END
00300	END0:	TLNE	FL,SRCOP
00400		JRST	DSCOP		;FINISH UP THE COPY COMMAND
00500		TLO	FL2,NORENT	;DISABLE REENTER
00600		TLZ	FL2,RENTF
00700		TRNE	FL,READOF	;IF READ ONLY
00800		JRST	ENDRO		;DO SPECIAL END CODE
00900		TLZ	FL2,BELLF	;DISABLE <BELL><BELL>
01000		TRZ	FL,NEWFL	;SET TO WANTS SAME OLD PROGRAM
01100		PUSHJ	P,NSCAN		;SETUP NEWBLK
01200		NERROR	ILC		;BAD SYNTAX
01300		SKIPE	DELETF		;WANT TO DELETE?
01400		JRST	END1B		;YES - SKIP THIS STUFF
01500		SKIPN	UNSEQF
01600		TRNE	FL,NEWFL
01700		TLO	FL2,PCHGF!FCHGF	;CHANGED IF UNSEQ OR NEW NAME
01800		TLNN	FL2,FCHGF
01900		JRST	[OCRLF
02000			 OUTSTR [ASCIZ "[No changes.]"]
02100			 OCRLF
02200			 SETZB T1,T2	;DELETE OUTPUT FILE
02300			 RENAME OUT,T1
02400			   JFCL
02500			 JRST ENDEND]
02600		JRST	END1
02700	
02800	;CODE TO HANDLE 'E' COMMANDS IN R/O MODE
02900	
03000	ENDRO:	PUSHJ	P,GNCH		;GET A CHAR
03100		ANDI	C,137		;FORCE UPPER
03200		CAIN	C,"D"		;CHECK FOR DELETE REQ
03300		JRST	[SETOM DELETF
03400			 MOVEI C,0	;DON'T BACKUP SCAN
03500			 JRST .+1]
03600		CAIE	C,"Q"		;QUIT OK ALSO
03700		MOVEM	C,SAVC		;BACKUP IF NOT Q
03800		PUSHJ	P,SCAN		;CHECK FOR EOL
03900		TRNN	FL,TERMF
04000		NERROR	ILC
04100		SKIPN	DELETF		;CHECK WHICH
04200		JRST	ENDEND		;JUST QUIETLY EXIT
04300		JRST	END1B		;GO DELETE
     
00100	END1:	PUSHJ	P,OCOMPL	;COMPLETE FILE COPY
00200		RELEAS	IN,		;AND CLOSE OFF INPUT CHL
00300		SKIPE	AUXFIL		;IF NO AUX FILE
00400		TLNE	FL2,PCHGF	; AND NO CHANGES
00500		JRST	[PUSHJ P,OUTDO	;PURGE OUTPUT BUFFERS
00600			 JRST END1A]
00700		MOVSI	T1,'TMP'	;FIXUP CORRECT FILE
00800		HLLM	T1,OCREXT
00900		SETZM	AUXFIL		;NO AUX FILE ANYMORE
01000		SETZB	T1,T2
01100		RENAME	OUT,T1		;DELETE OUTPUT FILE
01200		  JFCL			;CAN'T HAPPEN
01300	END1A:	CLOSE	OUT,		;  AND CLOSE CHL ALSO
01400		MOVE	T1,[ORGBLK,,ICRBLK]
01500		BLT	T1,ICRBKE	;SET UP FOR BACKUP FILE
01600	END1B:	MOVE	T1,ORGDEV	;GET ORIGINAL INPUT DEVICE
01700		MOVEM	T1,INDEVI+1
01800		OPEN	IN,INDEVI	;AND RE-OPEN CHL
01900		  JRST	NODSK		;THIS CAN'T HAPPEN OFTEN
02000		SKIPE	DELETF		;DELETING?
02100		JRST	END3B		;YES -- SKIP MORE
02200	
02300	END2:	XLOOK	OUT,NEWBLK	;SEE IF DEST FILE EXISTS
02400		  JRST	END4		;NOT FOUND - OK
02500		CLOSE	OUT,		;RELEASE FILE NOW
02600		TRNN	FL,NEWFL	;FOUND - IS THIS OK?
02700		JRST	END3		;YES: WE SHOULD HAVE FOUND IT
02800		OUTSTR	[ASCIZ /
02900	Output file exists - delete? /]
03000		PUSHJ	P,CONFRM	;ASK HIM IF OK
03100		  JRST	ASKNAM		;HE SAID NO - ASK FOR NEW NAME
03200		LDB	T1,[POINT 9,XBLOCK+2,8]
03300		CAIL	T1,400		;BETTER CHECK IF OK
03400		JSP	T1,FIU		;SAY ITS PROTECTED
03500		CAIGE	T1,200		;NEED TO CHANGE?
03600		JRST	END2A		;NO - JUST DELETE
03700		PUSHJ	P,FIXPRT	;CORRECT PROTECTION
03800		HRRM	T1,NEWPRT
03900		XRENM	OUT,NEWBLK
04000		  JSP	T1,FIU
04100	END2A:	SETZB	T1,T2		;HE SAID YES - DELETE IT
04200		RENAME	OUT,T1		;...
04300		  JSP	T1,FIU		;OOPS!
04400		JRST	END4		;NOW TREAT IT AS NOT THERE
     
00100	END3:	HLRZ	T1,ICREXT	;GET ORIGINAL EXTENSION
00200		ANDI	T1,7777		;SAVE LAST 2 CHARS
00300		IORI	T1,'Q  '	;MAKE IT INTO QXX
00400		SKIPLE	BAKF		;UNLESS OF CORSE WE NEEDED
00500		XORI	T1,130000	;THE OLD EXTENSION - ZXX
00600		HRLM	T1,ICREXT	;STASH EXTENSION & GET PROT
00700		MOVE	T1,ICREXT
00800		TRZ	T1,700		;CORRECT PROTECTION
00900		PUSH	P,T1		;AND SAVE FOR LATER
01000	
01100		XLOOK	IN,ICRBLK	;IS FILE THERE
01200		  JRST	END3B		;NO: JUST DO RENAME
01300	
01400		SKIPG	BAKF		;YES: NEED OLD ?
01500		JRST	END3A		;NOPE - GO DO RENAME (DELETE FIRST)
01600		MOVSI	T1,130000	;YES - MAKE CORRECT EXTENSION
01700		XORB	T1,0(P)		; TO BE QXX.
01800		HLLM	T1,ICREXT
01900	
02000		XLOOK	IN,ICRBLK	;NOW LOOK FOR THIS ONE
02100		  JRST	END3B		;NOT THERE - IMAGINE THAT
02200	
02300	END3A:	LDB	T1,[POINT 9,XBLOCK+2,8]
02400		CAIL	T1,400		;CHECK IF OK
02500		JRST	[OUTSTR [ASCIZ /% Backup file write protected - ignored/]
02600			 OCRLF
02700			 CLOSE IN,
02800			 SETZM BAKF	;SAY NO BACKUP
02900			 JRST END3B]
03000		HRRM	T1,0(P)		;SAVE OLD FILE PROT.
03100		CAIGE	T1,200		;CHECK GOODNESS OF PROTECTION
03200		JRST	END3R		;OK - JUST DELETE
03300		PUSHJ	P,FIXPRT	;ADJUST INTO RANGE 1XX
03400		HRRM	T1,ICRPRT	;STASH PROT
03500		XRENM	IN,ICRBLK	;CHANGE PROT SO WE CAN DELETE
03600		  JSP	T1,FIU		;OH - WELL
03700	END3R:	SETZB	T1,T2		;PREPARE FOR DELETE
03800		RENAME	IN,T1		;ZAP-A-ROO!
03900		  JSP	T1,FIU		;WHOOPS!
04000			;;;;		;FALIN END3B
     
00100	END3B:	MOVE	T1,[ORGBLK,,TMPBLK]
00200		BLT	T1,TMPBKE	;SET UP COPY OF ORIGINAL
00300	
00400		XLOOK	IN,TMPBLK	;LOOK FOR IT
00500		  JSP	T1,FIU		;SOMEBODY'S CONFUSED
00600		HRRZ	T1,ORGPRT	;GET ORIGINAL PROT.
00700		CAIGE	T1,200		;TOO LARGE?
00800		JRST	END3C		;OK TO JUST RENAME
00900		PUSHJ	P,FIXPRT	;MAKE GOOD
01000		HRRM	T1,TMPPRT	;STASH IN THE RIGHT PLACE
01100		XRENM	IN,TMPBLK	;CHANGE PROT FOR LATER
01200		  JSP	T1,FIU		;BETTER NOT!
01300	END3C:	SKIPE	DELETF		;STILL DELETING?
01400		JRST	ENDDEL		;YES -- FINISH UP
01500		POP	P,TMPEXT	;RESTORE EXT & PROT
01600		SKIPN	BAKF		;IS THIS NECESSARY?
01700		SETZM	TMPNAM		;NO: JUST DELETE THE LOSER
01800		SETSTS	IN,1		;GIVE CORRECT I/O STATIS
01900	
02000		XRENM	IN,TMPBLK	;TRY RENAME
02100		  JSP	T1,FIU		;WHOOPS
02200	
02300	END4:	HRRZ	T1,ORGPRT	;GIVE FILE ORIGINAL PROT
02400		HRRM	T1,NEWPRT	;...
02500		SKIPE	UNSEQF		;SKIP LOOKUP IF UNSEQUENCING
02600		JRST	UNSEQ
02700	
02800		XLOOK	OUT,OCRBLK	;LOOKUP TEMP FILE
02900		  JRST	EDFLIN		;GIVE UP
03000	
03100		PUSHJ	P,ENDNAM	;PRINT FINAL NAME
03200		SETSTS	OUT,1		;CORRECT I/O STATUS
03300		XRENM	OUT,NEWBLK	;RENAME TO DESIRED NAME
03400		  JSP	T1,FIU		;LOSE AGAIN
03500		JRST	ENDEND		;AND FINISH UP
03600	
03700	ENDNAM:	OUTSTR	[ASCIZ "
03800	["]
03900		MOVEI	T4,NEWBLK	;NEW FILE NAME
04000		PUSHJ	P,GVNAM0	;PRINT IT
04100		OUTSTR	[ASCIZ "]
04200	"]
04300		POPJ	P,
04400	
04500	ENDDEL:	SETZB	T1,T2		;SET FOR DELETE
04600		RENAME	IN,T1		;CAN EVERYTHING
04700		  JFCL
04800		RENAME	OUT,T1		;...
04900		  JFCL
05000			;;;;		;FALIN ENDEND
     
00100	ENDEND:	CLOSE	IN,		;TERMINATE INPUT CHL
00200		RELEAS	IN,
00300		CLOSE	OUT,
00400		SKIPE	AUXFIL		;AUX FILE IN USE?
00500		PUSHJ	P,DELAUX	;YES: DETLETE IT
00600		RELEAS	OUT,		;TERMINATE OUTPUT CHL
00700		TRNE	FL2,SVIT	;CHECK FOR SAVE COMMAND
00800		JRST	RESTRT		;YES - GO RESTART
00900		TLNE	FL,GCOM		;IS THIS A 'GO'?
01000		JRST	CREFIT		;YES - DO RUN UUO
01100	MONRET:	EXIT	1,
01200		SKIPGE	CNCLOK		;SEE IF FROM M OPTION
01300		JRST	MONRET
01400		JRST	CNCCON		;OK - IF FROM ^C
01500	
01600	;ROUTINE TO DELETE AUX FILE IF ANY
01700	
01800	DELAUX:	MOVSI	T1,'TMP'	;GET EXTENSION
01900		HLLM	T1,OCREXT	;IN PLACE
02000		SETZM	AUXFIL		;SAY IT'S GONE
02100		XLOOK	OUT,OCRBLK	;THERE?
02200		  POPJ	P,		;DON'T SWEAT IT
02300		SETZB	T1,T2		;SET TO DELETE
02400		RENAME	OUT,T1		;POW!
02500		  JFCL			;DON'T CARE
02600		POPJ	P,		;RETURN
02700	
02800	;HERE TO START WORLD OVER AFTER 'W'
02900	
03000	RESTRT:	RESET			;A GOOD THING
03100		POP	P,UNSEQF	;NOW RESTORE ALL GOOD THINGS
03200		SETZM	RPGSW
03300		TDZ	FL,[TECOF,,BOF!EOF!EOF2!NEWFL]
03400		MOVE	T1,[NEWBLK,,ORGBLK]
03500		BLT	T1,ORGBKE	;SET UP INPUT FILE NAME
03600		MOVE	T1,OCRDEV	;GET CORRECT DEVICE
03700		MOVEM	T1,ORGDEV
03800		PUSHJ	P,ZERNEW	;CLEAR OUT OLD INFO
03900		JRST	RPGRET		;AND START OVER
04000	
04100	;CODE FOR 'ED' COMMAND, CHECK PROPER TERM AND SET FLAG
04200	
04300	ZAPIT:	PUSHJ	P,SCAN		;CHECK EOL
04400		TRNN	FL,TERMF	;
04500		POPJ	P,		;ERROR RETURN FROM NSCAN
04600		SETOM	DELETF		;SET FLAG
04700		JRST	CPOPJ1		;GOOD RETURN
04800	
04900	;ROUTINE TO GET PROT INTO RANGE 1XX
05000	
05100	FIXPRT:	MOVEI	T2,200		;GENERATE XOR CONST
05200		CAIGE	T1,300
05300		IORI	T2,100
05400		XOR	T1,T2		;ZAP IT
05500		POPJ	P,		;RETURN WITH PROT IN T1
     
00100	NSCAN:	TLNE	FL2,AUTOF	;SPECIAL IF AUTO MODE
00200		JRST	NSCAN1
00300	NSCAN0:	PUSHJ	P,GNCH		;LOOK FOR ARGS
00400		CAIN	C,":"		;IS IT A COLON
00500		JRST	NSCAN2		;YES: GO LOOK FOR FILE NAME
00600		ANDI	C,137		;FORCE UPPER CASE
00700		MOVEI	T1,0		;INITIAL VALUE
00800		MOVE	T2,[POINT 7,[ASCIZ "SBQD"]]
00900	NSCNA:	ILDB	T3,T2		;GET CHAR
01000		JUMPE	T3,NSCAN3	;NOT FOUND IF NULL
01100		CAIE	C,(T3)		;MATCH?
01200		AOJA	T1,NSCNA	;NO -- TRY NEXT
01300		XCT	ENDTBL(T1)	;IF SW SEEN - DO ROUTINE
01400		JRST	NSCAN0		;LOOK FOR MORE
01500	
01600	NSCAN2:	PUSHJ	P,SCAN		;GET A FILE NAME
01700		PUSHJ	P,SETNM1	;...
01800		POPJ	P,		;ERROR RETURN
01900		SKIPE	TMPDEV		;ERROR IF DEVICE SPECIFIED
02000		POPJ	P,
02100		MOVE	T1,[TMPBLK,,NEWBLK]
02200		BLT	T1,NEWBKE	;PUT INFO IN NEWBLK
02300	NSCAN1:	SKIPN	NEWNAM		;IF NEW NAME
02400		JRST	NSCN1A
02500		TRO	FL,NEWFL	;THEN INDICATE NEW FILE
02600		HRRZ	T1,ORGPRT	;GET CORRECT PROTECTION
02700		HRRM	T1,NEWPRT	;...
02800		MOVE	T1,OCRDEV	;  AND CORRECT STR NAME
02900		MOVEM	T1,NEWDEV
03000		MOVSI	T2,-<PTH+SFDLVL+1>
03100		MOVE	T1,NEWBLK(T2)	;COMPARE FILE SPECS
03200		CAMN	T1,ORGBLK(T2)	;...
03300		AOBJN	T2,.-2
03400		JUMPL	T2,CPOPJ1	;JUMP IF DIFFERENT
03500		TRZ	FL,NEWFL	;IT AINT NEW
03600		JRST	CPOPJ1
03700	
03800	NSCN1A:	MOVE	T1,[OCRBLK,,NEWBLK]
03900		BLT	T1,NEWBKE	;SET UP NEWBLK FOR CORRECT
04000		HRROI	T1,ORGEXT	;FILE SPEC
04100		POP	T1,NEWEXT
04200		POP	T1,NEWNAM
04300		JRST	CPOPJ1
04400	
04500	NSCAN3:	MOVEM	C,SAVC		;BACK UP SCANNER
04600		PUSHJ	P,SCAN
04700		TRNE	FL,TERMF	;CHECK FOR TERM
04800		JRST	NSCAN1		;PROPER - CHECK NEW NAME
04900		POPJ	P,		;NO TERM - LOSE
     
00100	ENDTBL:	SETOM	UNSEQF		;'S'
00200		SETZM	BAKF		;'B'
00300		JRST	QUIT		;'Q'
00400		JRST	ZAPIT		;'D'
00500	
00600	ASKNAM:	OUTSTR	[ASCIZ /File: /]
00700		SETZM	SAVCHR		;RESET SCAN
00800		CLRBFI
00900		PUSHJ	P,NSCAN2	;GET A NEW NAME
01000		SKIPA
01100		JRST	END2		;TRY AGAIN
01200		OUTSTR	[ASCIZ /? What?
01300	/]
01400		JRST	ASKNAM		;WE CAN DO THIS UNTIL YOU GET IT CORRECT
01500	
01600	FIU:	OUTSTR	[ASCIZ /
01700	? File write protected. Try another name
01800	/]
01900		JRST	ASKNAM
02000	
02100	;CODE FOR 'EQ' COMMAND. JUST DELETE TEMPS AND EXIT
02200	
02300	QUIT:	POP	P,0(P)		;PRUNE PDL
02400		PUSHJ	P,SCAN		;MAKE SURE NO ARGS
02500		TRNN	FL,TERMF
02600		NERROR	ILC
02700		SETZB	T1,T2		;SET TO DELETE OUTPUT SIDE
02800		RENAME	OUT,T1
02900		JFCL			;DON'T CARE
03000		JRST	ENDEND
03100	
03200	
03300	QCOM:	PUSHJ	P,SCAN		;CHECK THAT THIS IS REALLY JUST 'Q'
03400		TRNN	FL,TERMF
03500		NERROR	ILC
03600		OUTSTR	[ASCIZ /% Type 'W' to save world - 'EQ' to quit
03700	/]
03800		JRST	COMND
     
00100	;HERE TO DO UNSEQUENCING
00200	
00300	UNSEQ:	RELEAS	IN,		;PREPARE FOR NEW OPEN
00400		MOVE	T1,OCRDEV	;GET OUTPUT DEVICE
00500		MOVEM	T1,INDEVI+1
00600		OPEN	IN,INDEVI	;OPEN CHL
00700		  JRST	NODSK		;SIGH!
00800		SETSTS	IN,1		;SET UP CORRECT I/O STATUS
00900		SETSTS	OUT,1
01000		MOVSI	T1,(<1B0>)	;SET UP RING BUFFERS
01100		HLLM	T1,OBUF
01200		HLLM	T1,IBUF
01300		MOVSI	T1,(<POINT 7,,>)
01400		HLLZM	T1,OBUF+1
01500		HLLZM	T1,IBUF+1
01600		SETZM	OBUF+2
01700		SETZM	IBUF+2
01800	IFN CRYPSW,<
01900		SETOM	IBUF+3		;INIT BLK CNTR
02000		MOVNI	T1,2
02100		MOVEM	T1,OBUF+3
02200		MOVE	T1,NEWCOD	;GET CORRECT PSWS
02300		EXCH	T1,OCRCOD
02400		MOVEM	T1,ICRCOD	;...
02500	>
02600		XENTR	OUT,NEWBLK	;CREATE NEW FILE
02700		  JSP	T1,FIU		;LOSAGE
02800		XLOOK	IN,OCRBLK	;LOOKUP TEMP FILE
02900		  JRST	EDFLIN		;GROAN
03000		TDZ	FL,[COPFIL,,EOF];CLR FLAGS
03100	
03200	UNSEQL:	PUSHJ	P,GCHAR		;FETCH CHARACTER
03300		JUMPE	T3,UNSEQ5	;DONE IF ZERO RETURNED
03400		MOVE	T1,@IBUF+1	;SEE IF SEQ #
03500		TRNN	T1,1
03600		JRST	UNSEQ2
03700		SKIPE	BASICF		;CHECK BASIC MODE
03800		JRST	UNSEQB
03900		AOS	IBUF+1		;SKIP SEQ #
04000		MOVNI	T3,5
04100		ADDM	T3,IBUF+2
04200		JRST	UNSEQL
04300	
04400	UNSEQ2:	PUSHJ	P,PCHAR		;WRITE CHAR
04500		JRST	UNSEQL		;LOOP UNTIL DONE
04600	
04700	UNSEQ5:	SETZB	T1,T2		;SET FOR DELETE
04800		RENAME	IN,T1
04900		  JFCL
05000		PUSHJ	P,OUTDO		;DUMP LAST BUFFER
05100		PUSHJ	P,ENDNAM	;PRINT FINAL NAME
05200		JRST	ENDEND
05300	
05400	;HERE FOR SPECIAL BASIC UNSEQUENCE
05500	
05600	UNSEQB:	SKIPA	T1,[5]		;DO 5 CHAR SEQ #
05700		PUSHJ	P,GCHAR		;GET NEXT CHAR
05800		PUSHJ	P,PCHAR		;OUTPUT CHAR
05900		SOJG	T1,.-2
06000		PUSHJ	P,GCHAR		;GET TAB
06100		CAIE	T3,11		;IT BETTER BE
06200		ERROR	ICN
06300		MOVEI	T3,40		;PUT IN A SPACE
06400		JRST	UNSEQ2
06500	
06600	SUBTTL SOME GENERAL PURPOSE STUFF
     
00100	;SOME MORE GENERAL ROUTINES
00200	
00300	
00400	RDLIN:	SETZM	LIBUF+1		;READ IN A LINE. FIRST ZERO INPUT BUFFER
00500		MOVE	T1,[XWD LIBUF+1,LIBUF+2]
00600		BLT	T1,LIBUF+MXWPL+1
00700		MOVE	T1,[POINT 7,LIBUF+1]	;SET UP POINTER
00800		MOVEI	T2,5*MXWPL-2	;SET FOR AVAILABLE SPACE
00900		MOVEI	C,11		;START WITH A TAB
01000		JRST	RDL3
01100	RDL1:	PUSHJ	P,GNCH		;GET ANOTHER CHARACTER
01200		CAIN	C,15		;IGNORE RETURN
01300		JRST	RDL1
01400		CAIN	C,12		;LINE FEED IS THE ONLY PROPER END
01500		JRST	RDL2
01600		CAIE	C,200		;ALTMODE IS A SPECIAL CASE
01700		JRST	RDL3		;NOT ALTMODE
01800		SETOM	ALTSN		;FLAG ALTMODE SEEN FOR I AND R
01900		CAIE	T2,5*MXWPL-3
02000		JRST	RDL2		;DO END OF LINE STUFF
02100		POPJ	P,		;EMPTY LINE RETURN
02200	
02300	RDL3:	IDPB	C,T1		;PUT IT IN THE BUFFER
02400		SOJGE	T2,RDL1		;CHECK FOR OVERFLOW AND CONTINUE
02500		RERROR	LTL		;LINE IS TOO LONG
02600		POPJ	P,		;NON-SKIP RETURN
02700	RDL2:	MOVEI	C,15		;PUT IN A CR-LF
02800		IDPB	C,T1
02900		MOVEI	C,12
03000		IDPB	C,T1
03100		HRRZS	T1		;NOW GET THE SIZE
03200		SUBI	T1,LIBUF-1
03300		AOS	(P)		;SKIP RETURN IF OK
03400		POPJ	P,		;AND RETURN
03500	
03600	
03700	
03800	GETLTH:	MOVE	T1,PNTR		;GET THE LENGTH OF THE LINE POINTED AT
03900		ADDI	T1,1
04000	GETLN1:	SKIPN	T2,(T1)		;ANY END IS GOOD ENOUGH
04100		JRST	GETLN2
04200		TRNN	T2,1		;SEQ-NUM?
04300		AOJA	T1,GETLN1
04400	GETLN2:	SUB	T1,PNTR		;FIND LENGTH
04500		POPJ	P,		;AND RETURN
04600	
04700	
04800	OUTSN:	MOVEM	T1,SQBUF	;PUT IT IN SPACE FOLLOWED BY A TAB
04900		OUTSTR	SQBUF
05000		POPJ	P,
     
00100	ASCIAD:	AND	T2,K2A		;CONVERT TO NUMBERS
00200		IOR	T1,K4A		;MAKE SURE THIS IS IN DIGIT FORM
00300		ADD	T1,K1A		;GET EACH DIGIT IN RANGE 166 TO 177 FOR CARRY
00400		ADD	T2,T1		;SUM
00500		AND	T2,K3A		;GET RID OF 100 BITS IF THERE
00600		MOVE	T1,K4A		;FIND OUT WHICH ONES NEED SUBTRACTING
00700		AND	T1,T2
00800		ASH	T1,-3		;CONVIENIENTLY THEY NEED 6 SUBTRACTED
00900		SUBM	T2,T1		;SO DO IT
01000		IOR	T1,K4A		;AND RECONVERT TO DIGITS
01100		POPJ	P,		;WE HAVE ADDED THE ASCII IN T1 AND T2 RESULT IN T1
01200	
01300	K1A:	BYTE (7) 106,106,106,106,106
01400	K2A:	BYTE (7) 17,17,17,17,17
01500	K3A:	BYTE (7) 77,77,77,77,77
01600	K4A:	<ASCII /00000/>!1
01700	K5A:	BYTE (7) 7,7,7,7,7
01800	K6A:	BYTE (1) 1 (7) 77,77,77,77,77
01900	K7A:	BYTE (1) 0 (7) 106,106,106,106,106
02000	
02100	ASCAV:	AND	T2,K2A
02200		IOR	T1,K4A		;THIS ROUTINE AVERAGES 2 ASCII NUMERS
02300		LSH	T1,-1
02400		ADD	T1,K7A		;IT WORKS MOSTLY BY MAJIC
02500		LSH	T2,-1
02600		ADD	T2,T1
02700		AND	T2,K6A
02800		MOVE	T1,T2
02900		ANDCM	T1,K3A
03000		AND	T2,K3A
03100		MOVE	T3,T2
03200		LSH	T3,-3
03300		AND	T3,K2A
03400		AND	T2,K5A
03500		SUB	T2,T3
03600		LSH	T1,-4
03700		ADD	T2,T1
03800		LSH	T1,-2
03900		ADD	T2,T1
04000		IOR	T2,K4A
04100		POPJ	P,
     
00100	;CHECK TO SEE IF BUFFER TOO FULL AND DUMP IF NEEDED
00200	
00300	FILLB:	MOVE T1,WC	;GET WORD COUNT
00400	FILLB3:	CAMGE T1,MAXWC	;AND COMPARE WITH MAX PERMISSIBLE
00500		POPJ P,		;OK, SO RETURN
00600		MOVE T1,BUFP	;GET BUFFER POINTER
00700		ADDI T1,1
00800	FILLB1:	SKIPN T2,(T1)	;FIND END OF FIRST LINE
00900		JRST FILLB2
01000		TRNN T2,1
01100		AOJA T1,FILLB1
01200	FILLB2:	PUSHJ P,NOWFL	;PART OF GETN WILL DUMP AND ADJUST POINTERS
01300		JRST FILLB	;SEE IF IN LIMITS NOW
01400	
01500	
01600	
01700	;INSERT A LINE (IN LIBUF) INTO PLACE POINTED AT BY PNTR
01800	;WORD COUNT OF OLD LINE IN OCNT. OF NEW LINE IN NCNT
01900	
02000	INSED:	TLO	FL2,ALLCHG	;CHANGES
02100		MOVE T1,NCNT	;SEE HOW THE COUNTS DIFFER
02200		SUB T1,OCNT
02300		JUMPE T1,NOBLT	;THEY ARE SAME, NO MOVING NECESSARY
02400		JUMPG T1,BBLT	;NEW IS LARGER, BLT WILL NOT DO
02500		MOVE T2,PNTR	;SET UP BLT POINTER FROM PNTR+OCNT
02600		ADD T2,OCNT
02700		HRLS T2
02800		HRR T2,PNTR	;TO PNTR+NCNT
02900		ADD T2,NCNT
03000		ADDB T1,WC	;ADJUST WC TO OLD WORD COUNT +NCNT-OCNT
03100		ADD T1,BUFP	;LAST TRANSFERED IS BUFP+WC+NCNT-OCNT
03200		BLT T2,(T1)
03300	NOBLT:	SKIPN T1,NCNT	;CHECK FOR 0 NEW COUNT (WE ARE DELETING)
03400		POPJ P,		;IF SO DONE
03500		MOVE T2,PNTR	;GET THE POINTER POSITION FOR BLT
03600		HRLI T2,LIBUF	;FROM LIBUF TO PNTR
03700		ADD T1,PNTR	;STOP AT PNTR+NCNT-1
03800		BLT T2,-1(T1)
03900		POPJ P,		;AND ALL DONE
04000	BBLT:	MOVE T2,BUFP	;FAKE BACKWARDS BLT FROM BUFP+WC
04100		ADD T2,WC
04200		ADDB T1,WC	;TO BUFP+WC+NCNT-OCNT (ALSO FIX WC)
04300		ADD T1,BUFP
04400	BBLT1:	CAMGE T2,PNTR	;STOP HERE (COULD STOP SOONER BUT THIS IS EASIER)
04500		JRST NOBLT	;AND GO MOVE IN NEW STUF
04600		MOVE T3,(T2)	;TRANSFER A WORD
04700		MOVEM T3,(T1)
04800		SUBI T1,1
04900		SOJA T2,BBLT1	;AND KEEP IT UP
05000	
05100	SUBTTL INSERT ROUTINE
     
00100	;INSERT A LINE
00200	
00300	CRTINS:	OCRLF
00400		MOVEI	T1,1		;SET TO START INSERTING AT LINE 100 PAGE 1
00500		MOVEM	T1,HIPG
00600		SKIPN	T1,TECFST	;USE START IF GIVEN
00700		MOVE	T1,[<ASCII /00100/>!1]
00800		MOVEM	T1,HILN
00900		JRST	INSGO		;AND AWAY WE GO
01000	
01100	INSERT:	TRNE	FL,READOF	;ERROR IF READ-ONLY
01200		NERROR	ILC
01300		PUSHJ	P,SCAN
01400		TRNE	FL,TERMF	;CHECK FOR NO ARGUMENTS
01500		JRST	[MOVE T1,IPG
01600			 MOVEM T1,HIPG
01700			 MOVE T1,CURINS
01800			 MOVEM T1,HILN
01900			 JRST INSGO]	;GO BACK TO INSERTING WHERE YOU WERE
02000		PUSHJ	P,GET1		;GET ONE LINE/PAGE NUMBER
02100		TRNN	FL,LINSN	;WAS /N GIVEN
02200		JRST	INSMK		;YES: TREAT SPECIAL
02300		PUSHJ	P,INSINC	;GET INCR IF ANY
02400	INSGO:	PUSHJ	P,DOINS		;DO THE INSERTS
02500		JRST	COMND		;RETURN
02600	
02700	INSINC:	CAIN	C,","		;TRYING TO GIVE PERM INC?
02800		JRST	GETINC		;YES - GO GET IT
02900		CAIE	C,";"		;TEMP INC?
03000		JRST	NOINC		;NOPE
03100		MOVE	T1,INCR		;SAVE OLD INCR
03200		MOVEM	T1,TEMINC
03300		PUSHJ	P,GNCH		;LOOK AT NEXT CHAR
03400		CAIE	C,"!"		;TRYING TO GIVE NUMBER OF LINES?
03500		JRST	[MOVEM C,SAVC	;NO - BACK UP SCANNER
03600			 JRST GETINC]	; AND READ INCR
03700		SETOM	INCR		;YES - SET FLAG
03800	GETINC:	PUSHJ	P,SCAN		;GET THE NUMBER
03900		TRNE	FL,NUMF		;WAS IT A NUMBER?
04000		CAMN	T1,[<ASCII /00000/>!1]	;DO NOT PERMIT 0 INCR
04100		NERROR	ILC		;HE WAS CONFUSED
04200		MOVEM	T2,NLIN1	;STASH DECIMAL
04300		SKIPL	INCR		;SEE IF INCR WANTED
04400		MOVEM	T1,INCR		;SET INCREMENT
04500		PUSHJ	P,SCAN		;SCAN PAST IT
04600	NOINC:	TRNN	FL,TERMF	;TERMINATOR?
04700		NERROR	ILC		;LOSE
04800		SETZM	ALTSN		;CLEAR ALTMODE FLAG
04900		POPJ	P,		;RETURN
05000	
05100	DOINS:	MOVE	T1,HIPG		;GET THE PAGE TO GO TO
05200		MOVEM	T1,DPG		;AND SET IT UP
05300		MOVE	SINDEX,HILN	;ALSO LINE
05400		PUSHJ	P,FIND		;GO GET UM
05500		MOVE	T2,CPG		;DEMAND CORRECT PAGE MATCH
05600		CAME	T2,HIPG
05700		NERROR	NSP
05800		SKIPL	INCR		;NEED TO COMPUTE ONE?
05900		JRST	INSTRY		;NO -- JUST TRY TO INSERT
06000		MOVE	T2,HILN		;YES -- SET UP FOR CALL
06100		MOVE	T3,NLIN1
06200		PUSHJ	P,GETDIF	;GET BEST FIT
06300		  NERROR ILR		;WHOOPS
06400		MOVEM	T1,HILN		;USE THESE VALUES
06500		MOVEM	T2,INCR
06600		JRST	INSLP
06700	INSTRY:	CAME	T1,HILN		;DO THEY MATCH
06800		JRST	INSLP		;YES - GO AHEAD
06900		MOVE	T2,INCR		;NO - GO INVENT A NEW LINE
07000		PUSHJ	P,FIXLIN
07100		  EXP	HILN
07200		 NERROR	ILR		;NO ROOM
07300		MOVEM	T2,HILN		;STORE NEW NUMBER
07400	INSLP:	SETZM	OCNT
07500		SKIPE	ALTSN		;ALTMODE SEEN?
07600		JRST	LVINS		;YES: DONE
07700		MOVE	T1,HILN		;TELL HIM THE LINE HE IS INSERTING
07800		MOVEM	T1,LIBUF	;AND PUT IT IN THE BUFFER
07900		TRNN	FL2,COMFLF!NONUMF	;IGNORE SQ # IF IN CMD FILE
08000		PUSHJ	P,OUTSN		;PUT IT OUT
08100		PUSHJ	P,RDLIN		;READ A LINE
08200		JRST	LVINS		;YES, GET OUT OF INSERT MODE
08300		MOVEM	T1,NCNT		;HERE IS THE COUNT OF THE NEW ONE
08400		PUSHJ	P,INSED		;GO INSERT
08500		SOSN	ISAVEN		;TIME TO SAVE?
08600		PUSHJ	P,ASVINS	;YES: GO DO IT
08700		PUSHJ	P,FINDN		;MOVE UP A LINE
08800		PUSHJ	P,FILLB		;AND DUMP SOME IF NECESSARY
08900		MOVE	T1,CPG		;SET CURRENT LINE AND PAGE TO LAST
09000		MOVEM	T1,CPGL		;ONE REALLY INSERTED
09100		MOVE	T1,HILN
09200		MOVEM	T1,CLN
09300		MOVE	T2,INCR		;GET NEXT LINE TO INSERT
09400		PUSHJ	P,ASCIAD
09500		CAMG	T1,INCR		;HAVE WE WRAPED AROUND
09600		JRST	LVINS1		;YES -- STOP
09700		MOVEM	T1,HILN		;STORE FOR REFERENCE
09800		SKIPN	T1,(PNTR)	;GET THE LINE POINTED TO
09900		JRST	INSLP		;ALWAYS INSERT AT END OF FILE
10000		CAME	T1,PGMK		;OR AT END OF PAGE
10100		CAMLE	T1,HILN		;HAVE WE FOUND A MATCH OR PASSED OVER A LINE?
10200		JRST	INSLP		;NO, INSERT
10300		JRST	LVINS1		;RETURN TO COMMAND LEVEL
10400	
10500	LVINS:	MOVE	T1,HILN
10600		MOVEM	T1,CURINS	;SET PLACE TO INSERT NEXT TIME
10700		MOVE	T1,CPG
10800		MOVEM	T1,IPG
10900		TRNE	FL2,COMFLF	;CMD FILE?
11000		JRST	LVINS2		;YES SKIP CR
11100	LVINS1:	SKIPE	ALTSN		;ALT SEEN?
11200		OCRLF			;YES -- OUTPUT CRLF
11300	LVINS2:	SETZM	ALTSN		;CLEAR ALTMODE FLAG
11400		POPJ	P,		;RETURN
     
00100	;ROUTINE TO COMPUTE INCREMENT AS DIFFERENCE OF
00200	; TWO LINES / # OF LINES TO INSERT
00300	;CALL:
00400	;	MOVE	T1,<RESULT OF FIND>
00500	;	MOVE	T2,<LINE TYPED(DESIRED)>
00600	;	MOVE	T3,<# OF LINES TO INSERT>
00700	;	PUSHJ	P,GETDIF
00800	;	  <ERROR RETURN (IE NO ROOM)>
00900	;	<OK RETURN>
01000	;	  C(T2) := COMPUTED INCR
01100	;	  C(T1) := WHERE TO START INSERTING
01200	
01300	GETDIF:	PUSH	P,T3		;SAVE ARGS
01400		PUSH	P,T2
01500		PUSH	P,T1		;SAVE RESULT OF FIND
01600		TLZE	T3,(1B0)	;CHECK FOR SPECIAL
01700		JRST	[MOVEM T3,-2(P)	;CORRECT ARG
01800			 MOVEI T1,0	;SAY EOF FOR FINDN
01900			 JRST NOFND]
02000		CAMN	T1,T2		;ALREADY HAVE NEXT IF NOT EQUAL
02100		PUSHJ	P,FINDN		;LOOK FOR NEXT LINE
02200	NOFND:	SKIPE	T3,T1		;NONE IF EOF
02300		CAMN	T1,PGMK		;  OR PAGE MARK
02400		JRST	[MOVEI T1,^D100000
02500			 JRST NONXT]	;USE HIGHEST + 1
02600		PUSHJ	P,NUMCON	;NEXT LINE # IN T1
02700	NONXT:	PUSH	P,T1		;SAVE IT
02800		MOVE	T3,-2(P)	;GET WHAT WAS TYPED
02900		CAMN	T3,-1(P)	;DOES IT EXIST?
03000		SOS	0(P)		;YES - ALLOW FOR IT
03100		PUSHJ	P,NUMCON	;CONVERT ARG
03200		MOVE	T2,T1		;MOVE RESULT TO T2
03300		POP	P,T1		;RESTORE <NEXT>
03400		SUB	T1,T2		;GET DIFFERENCE
03500		IDIV	T1,-2(P)	;(<NEXT>-<CURR>)/N
03600		JUMPE	T1,GOTZER	;DON'T FIT IF ZERO
03700		CAIGE	T1,3		;IF 1 OR 2 ITS THE BEST
03800		JRST	GOTIT
03900		MOVE	T2,[-6,,[DEC 2,5,10,20,50,100,100001]]
04000		CAML	T1,1(T2)	;LOOK FOR ITEM .GT. T1
04100		AOBJN	T2,.-1
04200		JUMPGE	T2,GOTZER	;CAN'T HAPPEN
04300		MOVE	T1,0(T2)	;GET AESTHETIC INCR
04400	GOTIT:	PUSHJ	P,ASCON		;CONVERT TO INCR FORM
04500		MOVE	T2,T3		;GET INTO CORRECT AC
04600		POP	P,T1		;GET BACK ARG
04700		MOVEM	T2,-1(P)	;STORE COMPUTED INCR
04800		CAME	T1,0(P)		;FIGURE OUT START POINT
04900		JRST	GETRET		;OK IF NOT FOUND
05000		PUSHJ	P,ASCIAD	;ELSE ADD INCR TO IT
05100		MOVEM	T1,0(P)		;  AND USE IT
05200	GETRET:	POP	P,T1		;STARTING LINE #
05300		POP	P,T2		;INCR
05400		JRST	CPOPJ1		;GIVE GOOD RETURN
05500	
05600	GOTZER:	SUB	P,[3,,3]	;PRUNE PDL
05700		POPJ	P,		;ERROR RETURN
     
00100	;ROUTINE TO GUESS AT A GOOD PLACE TO INSERT IF CURRENT LINE EXISTS
00200	;CALL:
00300	;	MOVE	T1,<CURRENT POSITION>
00400	;	MOVE	T2,<INCREMENT TO USE>
00500	;	PUSHJ	P,FIXLIN
00600	;	<LOC OF HIGH BOUND>
00700	;	  <ERROR RETURN>
00800	;	<OK RETURN>		;NEW NUMBER IN T2
00900	
01000	FIXLIN:	AOS	T4,0(P)		;SKIP OVER ARG
01100		PUSHJ	P,ASCIAD	;ADD
01200		PUSH	P,T1		;SAVE RESULT
01300		PUSHJ	P,FINDN		;GET THE NEXT ONE
01400		POP	P,T2
01500		CAMG	T2,@-1(T4)	;IS THERE A WAR PROBLEM
01600		JRST	FIXBAD		;YES, WE MUST TRY TO COMPUTE ONE
01700		JUMPE	T1,CPOPJ1	;END OF FILE, ANY INC IS OK
01800		CAME	T1,PGMK		;ALSO OK IF A PAGE MARK
01900		CAMGE	T2,T1		;OR IN CORRECT ORDER
02000		JRST	CPOPJ1
02100	FIXBAD:	CAME	T1,PGMK
02200		SKIPN	T1
02300		MOVE	T1,[<ASCII /9999:/>!1]	;ONE OVER THE TOP OF THE WORLD
02400		MOVE	T2,@-1(T4)	;GET CURRENT
02500		PUSHJ	P,ASCAV		;FIND AVERAGE
02600		CAME	T2,@-1(T4)	;THERE MAY HAVE ONLY BEEN A DIF OF 1
02700		AOS	0(P)		;SKIP RETURN
02800		POPJ	P,
02900	
03000	SUBTTL DELETE ROUTINE
     
00100	;DELETE A LINE, A NUMBER OF LINES, OR A PAGE MARK
00200	
00300	DELETE:	SETZM	LOLN		;JUST AS A START
00400		SETZM	PGDELS		;NO PAGES DELETED
00500		TRNE	FL,READOF	;NOT PERMITTED IN READ ONLY
00600		NERROR	ILC
00700		PUSHJ	P,GET2S		;GET TWO PAGE-LINE PAIRS
00800		TRZ	FL,LINSN	;FOR NOW
00900		CAIE	C,","	;CHECK SWITCH
01000		JRST	DELT1
01100		PUSHJ	P,SCAN
01200		MOVS	T1,ACCUM
01300		TRNE	FL,IDF
01400		CAIE	T1,(<SIXBIT /Y  />)
01500		NERROR	ILC
01600		TRO	FL,LINSN	;DON'T ASK
01700		PUSHJ	P,SCAN
01800	DELT1:	TRNN	FL,TERMF	;CHECK FOR TERMINATOR
01900		NERROR	ILC
02000		PUSHJ	P,DELSUB	;DO SOME DELETING
02100		SKIPN	PGDELS		;NEED TO DO ORDER CHECK
02200		JRST	COMND		;NO - ALL OK
02300		JRST	ORDCHK		;YES - DO IT
02400	
02500	;SUBROUTINE TO DELETE LINES FROM A FILE - COUNTS NUMBER OF
02600	;PAGE MARKS DELETED IN PGDELS
02700	
02800	DELSUB:	TRNN	FL,PGSN		;CHECK FOR MASSIVE DELETE
02900		SKIPN	LOLN
03000		JRST	[TRNN FL,EXTOG
03100			 TRNE FL,LINSN
03200			 JRST .+1
03300			 OUTSTR [ASCIZ /Massive delete ok? /]
03400			 PUSHJ P,CONFRM
03500			 JRST COMND	;NO:
03600			 JRST .+1]	;YES:
03700		TRZ	FL,LINSN	;NONE SEEN YET
03800		MOVE	T1,LOPG		;GET THE PAGE NUMBER
03900		MOVEM	T1,DPG
04000		MOVE	SINDEX,LOLN	;AND LINE
04100		PUSHJ	P,FIND
04200		MOVE	T2,CPG		;SEE WHERE WE ARE
04300		CAME	T2,LOPG		;IS THIS OK
04400		NERROR	NSP
04500		SKIPN	LOLN		;WANT WHOLE PAGE?
04600		TRO	FL,LINSN	;YES - SAY WE DID IT
04700	DELSB1:	PUSHJ	P,ONMOV		;CHECK FOR RANGE
04800		JRST	DELEND
04900		TRO	FL,LINSN	;SEEN SOMETHING
05000		CAMN	T1,PGMK		;PAGE MARK
05100		JRST	DELPAG		;YES - DELETE PAGE
05200		MOVEM	T1,CLN		;SAVE CURRENT LINE
05300		PUSHJ	P,DODEL		;GO DO A LINE DELETE
05400	DELSB2:	PUSHJ	P,FINDN1	;FIND NEXT BUT ACCEPT LINE IF ALREADY THERE
05500		JRST	DELSB1		;GO DO NEXT
05600	
05700	DELPAG:	MOVEI	T1,2		;SET TO DELETE PAGE
05800		MOVEM	T1,OCNT
05900		SETZM	NCNT		;NEW SIZE IS 0
06000		PUSHJ	P,INSED		;ZAP
06100		AOS	PGDELS		;INCR COUNT OF PAGES GONE
06200		AOS	CPG		;BEWARE!!!
06300		SETZM	LDELLN		;NO LINES ON THIS PAGE YET
06400		JRST	DELSB2		;CONTINUE
06500	
06600	DELEND:	TRNN	FL,LINSN	;DO ANYTHING?
06700		NERROR	NLN		;NO - GIVE ERROR
06800		MOVE	T1,LOPG		;YES - SET CURRENT PAGE
06900		MOVEM	T1,CPG		;AS THE ONE HE ASKED FOR
07000		MOVEM	T1,CPGL		;...
07100		MOVN	T1,PGDELS	;GET NEG # OF PAGES DELETED
07200		ADDM	T1,BGPG		;ADJUST CNTRS
07300		ADDM	T1,INPG		;TO SHOW CORRECT # OF PAGES
07400		POPJ	P,		;RETURN
     
00100	;DELETE A PAGE MARK
00200	
00300	KILL:	SETZM	LOLN	;A GOOD THING
00400		TRNE	FL,READOF
00500		NERROR	ILC
00600		PUSHJ	P,GET1S
00700		TRZN	FL,LINSN
00800		TRNN	FL,TERMF
00900		NERROR	ILC
01000	DELPG:	MOVE T1,HIPG	;GET THE DESIRED PAGE TO DELETE
01100		MOVEM T1,DPG	;SET IT
01200		SOJLE T1,DELER	;DO NOT TRY PAGE 1
01300		MOVEI SINDEX,0	;GUARENTEED TO FIND LINE IMMEDIATELY AFTER PAGE MARK
01400		PUSHJ P,FIND	;GET IT
01500		MOVE T2,CPG	;CHECK FOR MATCH
01600		CAME T2,HIPG
01700	DELER:	NERROR NSP	;NO SUCH PAGE
01800		PUSHJ P,FINDB	;GO BACK ONE
01900		CAME T1,PGMK	;IS IT A PAGE MARK?
02000		NERROR ICN		;CONFUSED, GIVE FATAL ERROR
02100		MOVEI T1,2	;COUNT IS 2
02200		MOVEM T1,OCNT
02300		SETZM NCNT	;AND NEW IS 0
02400		PUSHJ P,INSED
02500		SOS	CPGL		;ONE LESS ALSO
02600		SOS BGPG	;MAX PAGE IS NOW 1 LOWER
02700		SOS INPG
02800	ORDCHK:	PUSHJ P,FINDN1	;GET THE NEXT LINE
02900		JUMPE T1,COMND	;IF EOF THERE IS NO ORDER ERROR
03000		CAMN T1,PGMK	;OR IF A PAGE MARK
03100		JRST COMND
03200		MOVEM T1,SVWD3	;SAVE IT FOR COMPARE
03300		PUSHJ P,FINDB	;FIND THE PREVIOUS ONE
03400		JUMPE T1,COMND	;START OF FILE, ALL OK
03500		CAME T1,PGMK	;ANOTHER PAGE MARK
03600		CAMGE T1,SVWD3	;CHECK THE ORDER
03700		JRST COMND	;ALL OK
03800		NERROR ORDER	;ALL WRONG
03900	
04000	SUBTTL INSERT PAGE MARK
     
00100	
00200	;INSERT A PAGE MARK AT DESIGNATED LINE
00300	
00400	MARK:	SETZM HILN	;IN CASE OF /A
00500		SKIPN BASICF	;ILLEGAL IN BASIC MODE
00600		TRNE FL,READOF	;NOT PERMITTED IN READ ONLY
00700		NERROR ILC
00800		PUSHJ P,GET1S	;GET ONE LINE/PAGE NUMBER
00900		TRNN FL,TERMF	;CHECK FOR TERMINATOR
01000		NERROR ILC
01100		PUSHJ	P,MARK0		;INSERT PAGE MARK
01200		JRST	COMND		;RETURN TO COMMAND LEVEL
01300	
01400	MARK0:	MOVE T1,HIPG	;GO LOOK FOR IT
01500		MOVEM T1,DPG
01600		MOVE SINDEX,HILN	;AND THE LINE
01700		PUSHJ P,FIND	;GET IT
01800		MOVE T1,CPG
01900		CAME T1,HIPG	;PAGE MUST MATCH
02000		NERROR NSP	;MUST MATCH
02100		AOS T1,CPG	;WILL BE ON HIGHER PAGE WHEN DONE
02200		MOVEM T1,CPGL	;SET UP LOGICAL PAGE
02300		AOS BGPG	;THERE IS NOW ONE MORE
02400		AOS INPG
02500		MOVE T1,[<ASCII /00100/>!1]
02600		MOVEM T1,CLN	;FIRST LINE ON THAA PAGE
02700		MOVE T1,PGMK	;PUT A PAGE MARK IN LIBUF
02800		MOVEM T1,LIBUF
02900		MOVE	T1,PGMKW2	;TEXT OF A PAGE MARK
03000		MOVEM T1,LIBUF+1
03100		SETZM OCNT	;THIS IS A STRAIGHT INSEET
03200		MOVEI T1,2	;OF 2 WORDS
03300		MOVEM T1,NCNT
03400		PUSHJ P,INSED	;GO DO IT
03500		PUSHJ P,FINDN	;SINCE FILLB MAY WANT TO DUMP THIS LINE
03600		JUMPE T1,FILLB		;SKIP IF EOF SEEN
03700		CAME T1,PGMK		;CHECK IF EMPTY
03800		MOVEM T1,CLN		;NO; USE THIS LINE
03900		JRST	FILLB		;FILL BUFFER
04000	
04100	INSMK:	TRNN	FL,TERMF	;GRNTEE TERM
04200		NERROR	ILC
04300		SETZM	ALTSN		;NO ESC SEEN YET
04400		MOVE	T1,[<ASCII /9999:/>!1]
04500		MOVEM	T1,HILN		;ONE PAST END OF WORLD
04600		PUSHJ	P,MARK0		;INSERT PAGE-MARK
04700		MOVE	T1,CLN		;GET CURRENT LINE
04800		MOVEM	T1,HILN
04900		MOVE	T1,CPG		;AND CURRENT PAGE
05000		MOVEM	T1,HIPG		;SET UP FOR INSERT
05100		JRST	INSGO		;GO
05200	
05300	SUBTTL	RENUMBER
     
00100	
00200	;RENUMBER SELECTED LINES
00300	
00400	NUMBER:	MOVE T1,[<ASCII /00100/>!1]	;IF NO INCR IS SEEN
00500		MOVEM T1,REINC		;WE WILL USE 100
00600		MOVEM T1,INCST
00700		MOVEM	T1,REFST	;SAVE FOR NEW PAGE
00800		SETZM LOLN	;GET THIS SET TO START THINGS OFF
00900		TRNE FL,READOF	;NOT PERMITTED IN READ ONLY
01000		NERROR ILC
01100		TRZ	FL2,ACONST!MONOF
01200		PUSHJ	P,GNCH		;GET NEXT CHAR
01300		MOVEM	C,SAVC		;SAVE IN CASE WE NEED IT
01400		ANDI	C,137		;FORCE UPPER
01500		CAIN	C,"A"
01600		TRO	FL2,ACONST	;ADD CONSTANT
01700		CAIN	C,"P"
01800		TRO	FL2,MONOF	;NO RESET ON PAGE MARK
01900		TRNE	FL2,ACONST!MONOF
02000		SETZM	SAVC		;GOT ONE - DON'T BACK UP SCANNER
02100		PUSHJ	P,SCAN		;GET THE RENUMBER INCREMENT
02200		TRNE FL,NUMF	;WAS IT A NUMBER
02300		CAMN T1,[<ASCII /00000/>!1]	;NO 0 RENUMBER INCR
02400		JRST NUMBC	;NO NUMBER, CHECK FOR COMMA
02500		MOVEM T1,REINC	;THE INCREMENT TO USE
02600		MOVEM T1,INCST	;LINE TO START WITH
02700		MOVEM	T1,REFST
02800		PUSHJ P,SCAN	;SCAN PAST NUMBER
02900	NUMBC:	CAIN C,","	;AND CHECK FOR COMMA
03000		JRST NUMB1	;GET A RANGE
03100		MOVEI T1,1	;NO RANGE, DO WHOLE FILE
03200		MOVEM T1,LOPG	;FROM PAGE 1
03300		MOVSI T1,1	;TO IMPOSSIBLY HIGH
03400		MOVEM T1,HIPG
03500		TRZ FL,CNTF	;MAKE SURE THIS IS OFF
03600		JRST NUMBL	;AND CHECK FOR TERMINATOR
03700	NUMB1:	PUSHJ P,GET2S	;GET A RANGE
03800		CAIE C,","	;SEE IF THERE IS A FOURTH ARGUMENT
03900		JRST NUMBL	;NO
04000		PUSHJ P,SCAN	;YES, GET IT
04100		TRNN	FL2,ACONST	;ILLEGAL IF ADD MODE
04200		TRNN FL,NUMF	;IS IT A NUMBER?
04300		NERROR ILC	;HE WOULD HAVE BEEN BETTER OFF WITHOUT IT
04400		MOVEM	T1,REFST
04500		MOVEM T1,INCST	;USS AS STARTING NUMBER
04600		PUSHJ P,SCAN	;SCAN PAST IT
04700	NUMBL:	TRNN FL,TERMF	;ENDS PROPERLY?
04800		NERROR ILC	;LOSE
04900		MOVE T1,LOPG	;GET PLACE TO START
05000		MOVEM T1,DPG
05100		MOVE SINDEX,LOLN	;AND LINE
05200		PUSHJ P,FIND	;GET IT
05300		TRZ FL,LINSN!ORDF	;SET TO NONE SEEN AND NO ORDER ERROR
05400		PUSHJ P,FINDB	;BACK UP AND SEE HOW ORDER LOOKS
05500		JUMPE T1,NUMB5	;START OF FILE IT MUST BE OK
05600		CAME T1,PGMK	;ALSO IF A PAGE MARK
05700		CAMGE T1,INCST	;OR IF IN CORRECT ORDER
05800		SKIPA
05900		TRO FL,ORDF	;WRONG SET FLAG
06000	NUMB5:	PUSHJ P,FIND	;GET THE CORRECT LINE BACK
06100	NUMB2:	PUSHJ P,ONMOV	;CHECK RANGE
06200		JRST NUMB3
06300		CAMN T1,PGMK	;PAGE MARK?
06400		JRST NUMB4	;SPECIAL TREATMENT
06500		TRNE	FL2,ACONST	;JUST ADD CONSTANT
06600		JRST	[MOVE T1,(PNTR)	;YES - USE OLD LINE #
06700			 TRO FL,LINSN	;SAY WE'VE SEEN ONE
06800			 JRST NUMB2A]
06900		MOVE T1,INCST	;GET STAATING NUMBER
07000	NUMB2A:	MOVE T2,REINC	;AND INCREMENT
07100		TRON FL,LINSN	;WAS A LINE SEEN?
07200		JRST FSTLIN	;NO, FIRST ONE IS SPECIAL
07300		PUSHJ P,ASCIAD	;SKIP THIS THE FFRST TIME
07400		CAMGE T1,REINC	;HAVE WE WRAPED
07500		JRST	[RERROR WAR	;TELL HIM HE LOST
07600			MOVE T2,CPG	;PRINT THE PAGE
07700			PUSHJ P,PGPRN
07800			JRST .+1]	;RETURN
07900	FSTLIN:	MOVEM T1,INCST	;SAVE FOR NEXT LINE
08000		MOVEM T1,CLN	;AND THE CURRENT LINE
08100		MOVEM T1,(PNTR)	;PUT IT IN
08200		PUSHJ P,FINDN	;GET NEXT
08300		JRST NUMB2	;AND GO RANGE CHECK
08400	
08500	NUMB3:	TRNN FL,LINSN	;DONE, WAS THERE SOMETHING THERE?
08600		NERROR NLN	;NO,  NULL RANGE ERROR
08700		TLO	FL2,ALLCHG	;CHANGES
08800		MOVE T2,CPG	;SET UP CURRENT PAGE
08900		MOVEM T2,CPGL
09000		TRNE FL,ORDF	;WAS THERE AN ORDER ERROR?
09100		NERROR ORDER	;YES, FLAG IT
09200		JUMPE T1,COMND	;CHECK TO SEE IF LOSAGE NOW
09300		CAME T1,PGMK
09400		CAMLE T1,INCST
09500		JRST COMND
09600		NERROR ORDER
09700	
09800	NUMB4:				;PAGE MARK
09900		AOS	CPG		;NOW ON A HIGHER PAGE
10000		MOVE	T1,[<ASCII /00000/>!1]
10100		MOVEM	T1,CLN		;SET TO FIRST LINE ON PAGE
10200		TRO	FL,LINSN	;WE SAW ONE
10300		PUSHJ	P,FINDN		;GET NEXT LINE
10400		PUSHJ	P,ONMOV	;IN RANGE?
10500		  JRST	NUMB3		;NO - FINISHED
10600		CAMN	T1,PGMK		;ANOTHER P. M.
10700		JRST	NUMB4
10800		MOVE	T1,REFST	;FIRST LINE #
10900		TRNN	FL2,ACONST!MONOF
11000		JRST	FSTLIN		;IF NOT SPECIAL
11100		MOVE	T1,REINC	;ELSE GET INC
11200		TRNN	FL2,MONOF
11300		SKIPA	T2,(PNTR)	;CURRENT LINE FOR "NA"
11400		MOVE	T2,INCST	;ELSE LAST LINE FOR "NP"
11500		PUSHJ	P,ASCIAD	;DO ARITHMETIC
11600		JRST	FSTLIN		;STASH NUMBER
11700	
11800	SUBTTL ALTER COMMAND
     
00100	ALTER:	SETZM LOLN	;FOR START OF PAGE
00200		PUSHJ P,GET2S	;GET THE RANGE
00300		TRNN FL,TERMF	;CHECK FOR PROPER END
00400		NERROR ILC	;UNEND
00500		MOVE T1,LOPG	;START TO PROCESS
00600		MOVEM T1,DPG
00700		MOVE SINDEX,LOLN
00800		PUSHJ P,FIND	;GO GET IT
00900		TRZ FL,LINSN	;NOT SEEN YET
01000	ALT1:	PUSHJ P,ONMOV	;CHECK FOR IN RANGE
01100		JRST ALT2	;NO, FINISH UP
01200		TRO FL,LINSN	;WE DID SEE SOMETHING
01300		CAMN T1,PGMK	;CHEC FOR A PAGE
01400		JRST ALT3	;DO NNT TRY TO CHANGE THIS
01500		MOVEM T1,CLN	;NOW, IN CASE WE SAID ALTMODE
01600		MOVE T1,CPG	;SAME FOR PAGE
01700		MOVEM T1,CPGL
01800		PUSHJ P,ALTLIN	;GO DO THE ALTER
01900		JRST LEVINS	;HE SAID ALTMODE
02000		PUSHJ P,INSED	;GO INSERT
02100	ALT4:	PUSHJ P,FINDN	;GET THE NEXT LINE
02200		PUSHJ P,FILLB	;AND CHECK FOR BUFFER OVERFLOW
02300		MOVE T1,(PNTR)	;GET LINE FOR ONMOV
02400		JRST ALT1	;CONTINUE LOOP
02500	ALT3:	AOS T2,CPG	;WE ARE ON A LATER PAGE NOW
02600		MOVEM T2,CPGL	;SAVE AS .
02700		TRNN	FL2,NONUMF	;SKIP IF IN NONUMBER MODE
02800		PUSHJ P,PGPRN	;PRINT HIM A MESSAGE
02900		MOVE T1,[<ASCII /00000/>!1]	;SET TO FIRST? LINE
03000		MOVEM T1,CLN	;FOR .
03100		JRST ALT4	;CONTINUE PAST IT
03200	ALT2:	TRNN FL,LINSN	;WAS THERE ANYTHING THERE?
03300		NERROR NLN	;NO, GIVE ERROR
03400		MOVE T1,CPG	;|ET CURRENT PAGEE
03500		MOVEM T1,CPGL	;SAVE AS .
03600		JRST COMND	;GO
     
00100	ALTLIN:	PUSHJ P,SETALT	;SET UP LINE FOR ALTERATION
00200	
00300	ALTN1:
00400	ALTLP2:	MOVEI T2,0	;ZERO REPEAT COUNT
00500		TLZ FL,NEGF	;TURN OFF "-" SEEN FLG
00600	ALTLP:	TRZ FL2,ALTDUP	;TURN DUPLEXING BACK OFF
00700		PUSHJ P,GNCH1	;GET ON CHR IN DDT SUBMODE
00800		TLNE CS,LETF_16	;CHECK FOR LETTER
00900		TRZ C,40	;AND CONVERT TO UPPER CASE
01000		MOVSI T1,-ALTLG	;GET LENGTH OF COMMAND TABLE
01100		CAME C,ALTAB1(T1)	;CHECK FOR EQUAL
01200		AOBJN T1,.-1	;NO, TRY AGAIN
01300		JUMPGE	T1,[CAIN C,15		;IGNORE CR'S
01400			    JRST ALTLP
01500			    JRST ALTBEL]
01600		MOVE	T1,ALTAB2(T1)	;GET TABLE ENTRY IN T1
01700		JUMPL	T1,ALTDSP	;"-" ALLOWED IF NEG.
01800		TLNN	FL,NEGF		;NO: IS IT SET?
01900		JRST	ALTDSP		;OK TO EXECUTE COMMAND
02000	ALTBEL:	OUTCHR	[7]		;BONG A GONG
02100		CLRBFI			;CLEAR TYPE AHEAD
02200		JRST	ALTLP2		;TRY AGAIN
02300	
02400	ALTDSP:	TLNN	T1,(1B1)	;OK IN ALL MODES?
02500		TRNN	FL,READOF	;NO -- CHECK R/O
02600		SKIPA			;YES -- DISPATCH
02700		JRST	ALTBEL		;R/O RING BELL
02800		PUSHJ	P,0(T1)		;DISPATCH
02900		JRST	ALTLP2		;RESET REPEAT COUNT AND GET NEW COMMAND
03000		JRST	ALTLP		;SKIP RETURN FROM DIGITS NO COUNT RESET
03100	
03200	ALTAB1:	EXP " ","I","D","S","K","Q",12
03300		EXP "C",177,"U"-100,"W","X"
03400		EXP "R","L","P","J","E","-",10,11
03500		EXP "0","1","2","3","4","5","6","7","8","9","0"
03600	ALTLG=.-ALTAB1
03700	
03800	ALTAB2:	EXP <1B1+ALTSP>,ALTIN
03900		EXP <1B0+ALTDL>,<3B1+ALTSR>,<1B0+ALTKL>
04000		EXP <1B1+ALTALT>,<1B1+ALTFN>,ALTCN
04100		EXP <1B1+ALTBS>,<1B1+ALTCU>,<1B1+ALTWD>,ALTWX,<1B0+ALTRP>
04200		EXP <1B1+ALTLN>,<1B1+APRINT>,AJOIN,<1B1+ALTEX>
04300		EXP <1B1+ALTNEG>,<1B1+ALTBS>,<3B1+ALTTB>
04400		REPEAT ^D10,<<3B1+ALTDG>>
04500	
04600	ALTNEG:	TLO FL,NEGF
04700		JRST CPOPJ1
     
00100	
00200	SETALT:	SETZM LIBUF	;ZERO OUT INTERNAL LINE BUFFER
00300		MOVE T1,[XWD LIBUF,LIBUF+1]
00400		BLT T1,LIBUF+MXWPL+1
00500		MOVEI T1,LIBUF	;SET POINTER TO TRANSFER
00600		MOVE T2,PNTR
00700		MOVE T3,(T2)	;GET THE FIRST WORD (SEQ NUM)
00800		JRST SALT3
00900	SALT2:	SKIPE T3,(T2)	;PICK UP A WORD AND CHECK FOR 0
01000		TRNE T3,1	;CHECK FOR SEQ NTM
01100		JRST SALT1	;END OF THIS LINE
01200	SALT3:	MOVEM T3,(T1)	;SAVE IT AWAY
01300		ADDI T1,1	;INCREMENT POINTERS
01400		AOJA T2,SALT2
01500	SALT1:	MOVE ALTP,[POINT 7,LIBUF+1,13]	;SET UP POINTER
01600		SETZM ALTCNT	;SO FAR WE ARE 0 CHRS INTO LINE
01700		SUBI T1,LIBUF	;GET COUNT OF OLD LINE
01800		HRRZM T1,OCNT	;AND SAVE IT FOR INSED
01900		OFFECHO		;TURN OFF EHCO
02000		TRZ FL2,RUBF!ALTDUP!RUBF2	;TURN OFF IN RUBOUT FALG AND NO DUPLEXING
02100		SETZM ALTFLG	;NOTHING INSERTED SO FAR
02200		TRNE	FL2,NONUMF	;SKIP IF NORMAL
02300		POPJ	P,		;ELSE RETURN
02400		MOVE T1,LIBUF	;PRINT LINE NUMBER AND TAB
02500		JRST OUTSN
02600	
02700	RPSALT=SALT1
02800		DEFINE OFFRUB
02900	<	TRZE FL2,RUBF2
03000		OUTSTR [ASCIZ /\\/]
03100		TRZE FL2,RUBF
03200		OUTCHR ["\"]>
03300	
03400		DEFINE ONRUB
03500	<	TRZE FL2,RUBF2
03600		OUTSTR [ASCII /\\/]
03700		TRON FL2,RUBF
03800		OUTCHR ["\"]>
     
00100	
00200	GNCH1A:	TRNE FL2,COMFLF	;CMD FILE?
00300		JRST	[PUSHJ P,RDCHAR
00400			JRST GNCH1C]
00500		INCHRW C
00600		ANDI C,177
00700	GNCH1C:	CAME C,ESC	;NEVER DUPLEX ESC
00800		TRNN FL2,ALTDUP	;AND NOT UNLESS DESIRED
00900		POPJ P,
01000		CAIE C,12	;NOT LINE FEED
01100		CAIN C,15	;OR RETURN
01200		POPJ P,
01300		CAIN C,177	;AND FINALLY IGNORE RUBOUT
01400		POPJ P,
01500		OFFRUB		;IF WE ARE DUPLEXING WE ARE NOT DELETING
01600		OUTCHR C	;TYPE
01700		POPJ P,
01800	
01900	GNCH1:	PUSHJ P,GNCH1A	;GET A CHR IN DDT MODE
02000		CAMN C,ESC	;CONVERT ALTMODE TO 200
02100		MOVEI C,200
02200		TLNN FL,QMODF
02300		CAIE	C,"'"		;CHECK FOR QUOTE
02400		JRST GNCH1B	;NO, THIS CHR IS OK
02500		PUSHJ P,GNCH1A	;GET ANOTHER
02600		SKIPE CTBL(C)	;IF 0 HN CTBL, KEEP IT
02700		MOVS C,CTBL(C)	;GET ALTERNATE CODE
02800		ANDI C,177	;GET RID OF EXTRA BITS
02900	GNCH1B:	MOVE CS,CTBL(C)	;LOAD CS
03000		TLNE CS,LETF_16	;CHECK FOR LETTER
03100		TDC C,CASEBT	;AND APPLY CASE CONVERRION
03200		POPJ P,		;ALL DONE
03300	
     
00100	ALTDG:	IMULI T2,^D10	;ACCUMULATE REPEAT COUNT
00200		ADDI T2,-"0"(C)
00300		JRST CPOPJ1	;SKIP RETURN SO AT NOT TO 0 RPT. CNT.
00400	
00500	ALTTB:	MOVEI	T2,^D1000	;LOTS OF SPACES
00600	ALTSP:	TLNE FL,NEGF	;CHECK BACKWARDS
00700		JRST ALTBS	;YES: BACK SPACE
00800		OFFRUB
00900	
01000	ALTSP2:	LDB C,ALTP	;GET THE CHR WE ARE POINTING AT
01100		CAIN C,15	;IF RETURN THEN AS FAR AS CAN GO
01200		JRST ALTSP1	;SO QUIT
01300		TRNN FL2,SUPN	;SPECIAL HACK FOR XTEND
01400		PUSHJ P,OCHR	;PRINT IT
01500		IBP ALTP	;ADVANCE POINTER
01600		AOS ALTCNT	;AND COUNT
01700		SOJG T2,ALTSP2	;DO CORRECT NUMBER OF TIMES
01800	ALTSP1:	TRNN FL2,SUPN
01900		PUSHJ	P,FORCE		;DUMP IT
02000		POPJ P,
02100	
02200	
02300	
02400	ALTIN:	TRO FL2,ALTDUP	;TURN ON DUPLEXING
02500		MOVEM T2,ALTINC	;SAVE IN CASE HE INSERTS A RETURN
02600	ALTIN1:	PUSHJ P,GNCH1	;GET A CHARACTER
02700		CAIN C,15	;FINISH ON CR
02800		JRST ALTFNZ
02900		CAIN C,12
03000		JRST INSCR	;GO INSERT A CRLF
03100		CAIN C,200	;FINISH ON ALTMODE
03200		POPJ P,		;GO AWAY
03300		CAIN C,177	;CHECK FOR BACKSPACE
03400		JRST ALTIBS	;AND DELETE CHR TO LEFT
03500		MOVE T3,ALTP	;GET SET TO SHIFT THINGS
03600		PUSH P,ALTCNT	;SAVE THIS FOR LATER
03700		LDB T1,T3	;GET CHR FROM LINE
03800	ALTIN2:	DPB C,T3	;SHIFT LINE
03900		JUMPE C,ALTIN3	;DONE
04000		AOS ALTCNT	;COUNT IT
04100		ILDB C,T3
04200		DPB T1,T3
04300		JUMPE T1,ALTIN3	;DONE
04400		AOS ALTCNT	;COUNT
04500		ILDB T1,T3
04600		JRST ALTIN2
04700	ALTIN3:	MOVE T2,ALTCNT	;SEE IF OVERFLOW HAPPENED
04800		CAIL T2,MXWPL*5
04900		NERROR LTL	;YES
05000		POP P,ALTCNT	;RESTORE OLD COUNT
05100		IBP ALTP	;ADVANCE POINTER
05200		AOS ALTCNT	;AND COUNT
05300		JRST ALTIN1	;GO GET MORE
05400	
     
00100	INSCR:	OFFRUB
00200		OCRLF
00300		SKIPN T1,ALTINC	;DID HE SPECIFY AN INCREMENT?
00400		SKIPA T3,INCR	;NO, USE STANDARD
00500		PUSHJ P,ASCON	;CONVERT TO ASCII
00600		MOVE T1,T3	;FIND THE NEW LINE NUMBER
00700		MOVE T2,LIBUF	;CURRENT ONE
00800		PUSHJ	P,FIXLIN
00900		  EXP	LIBUF
01000		JRST	[RERROR ORDER
01100			 PUSHJ P,FINDB	;GET BACK WHERE WE BELONG
01200			 PUSHJ P,ERCOR	;TYPE OUT LINE TO CURRENT POINT
01300			 JRST ALTIN1]	;AND CONTINUE INSERT
01400		MOVEM	T2,LIBUF2	;SAVE IT
01500		MOVEM T2,CLN	;AND SET AS CURRENT LINE
01600		PUSHJ P,FINDB	;BACK UP TO WHERE WE BELONG
01700		MOVE T1,[XWD LIBUF+1,LIBUF2+1]
01800		BLT T1,LIBUF2+MXWPL+1	;SAVE OLD BUFFER
01900		PUSH P,ALTP	;SAVE POINTER
02000		MOVEI C,15
02100		DPB C,ALTP	;AND TERMINATE THIS LINE
02200		MOVEI C,12
02300		IDPB C,ALTP
02400		MOVEI C,0	;FILL OUT LINE WITH NULLS
02500	AINSC2:	TLNN ALTP,760000
02600		JRST AINSC3
02700		IDPB C,ALTP
02800		JRST AINSC2
02900	AINSC3:	SUBI ALTP,LIBUF-1	;FIND COUNT
03000		HRRZM ALTP,NCNT
03100		PUSHJ P,INSED	;REPLACE OLD LINE
03200		PUSHJ P,FINDN	;MOVE UP TO NEXT
03300		PUSHJ P,FILLB	;AND DUMP IF OVERFLOW
03400		SETZM OCNT	;THIS IS A NEW LINE GOING IN
03500		MOVE T1,LIBUF2	;MOVE LINE NUMBER OVER
03600		MOVEM T1,LIBUF
03700		SETZM LIBUF+1
03800		MOVE T1,[XWD LIBUF+1,LIBUF+2]
03900		BLT T1,LIBUF+MXWPL+1	;ZERO OUT REST
04000		POP P,T2	;RESTORE POINTER TO REST OF LINE
04100		MOVE ALTP,[POINT 7,LIBUF+1]	;DEST POINTER
04200		ADD T2,[XWD 70000,LIBUF2-LIBUF]	;ADJUST INPUT POINTER
04300		MOVEI C,11	;AND SET UP THE TAB
04400	MOVNEW:	IDPB C,ALTP
04500		CAIN C,12
04600		JRST DONNEW	;FINISHED MOVING REST OF LINE
04700		ILDB C,T2	;PICK UP ONE
04800		JRST MOVNEW
04900	DONNEW:	SUBI ALTP,LIBUF			;GET COUNT
05000		MOVEI ALTP,1(ALTP)	;USED TO BE - MOVEI AC,1-LIBUF(AC)
05100		MOVEM ALTP,NCNT
05200		PUSH P,ALTP	;AND SAVE
05300		PUSHJ P,INSED	;INSERT
05400		MOVE ALTP,[POINT 7,LIBUF+1,13]	;SET UP FOR ALTER
05500		SETZM ALTCNT
05600		POP P,OCNT	;SET FOR OLD COUNT
05700		MOVE T1,LIBUF
05800		TRNN	FL2,NONUMF	;SKIP IF NOT PRINTING
05900		PUSHJ P,OUTSN
06000		SETOM ALTFLG	;WE HAVE INSERTED AND ALTALT SHOULD CALL FILLB
06100		JRST ALTIN1	;AND CONTINUE INSERTING
06200	
06300	ALTIBS:	MOVEI T2,0	;SET COUNT TO 0
06400		MOVEM ALTP,SVALTP	;SAVE POINTER
06500		PUSHJ P,ALTBS	;DO A BACKSPACE
06600		EXCH ALTP,SVALTP	;GET BACK AND SAVE CURRENT
06700		PUSHJ P,ALTDL3	;DELETE THAT CHR
06800		JRST ALTIN1	;GET MORE
06900	
     
00100	ALTDL:	TLNE FL,NEGF		;BACKWARDS?
00200		JRST ALTBDL		;YES:
00300		MOVEM ALTP,SVALTP	;SAVE CURRENT POINTER POSITHON
00400	ALTDL1:	LDB C,ALTP	;GET CURRENT CHR
00500		CAIN C,15	;AT END OF LINE?
00600		JRST ALTDL5	;YES, GO FINISH OFF
00700		TRNN	FL,EXTOG	;PRINT ONLY IF NON-EXPERT
00800		PUSHJ P,ALTDPN	;YES: PRINT CHAR
00900		IBP ALTP	;ADVANCE POINTER
01000		SOJG T2,ALTDL1	;CHECK COUNT AND CONTINUE
01100	ALTDL5:	PUSHJ	P,FORCE		;FORCE OUTPUT
01200	ALTDL3:	MOVE T3,SVALTP	;GET BACK POINTER
01300	ALTDL4:	LDB C,ALTP	;MOVE LINE DOWN
01400		DPB C,T3
01500		JUMPE C,ALTDL2	;DONE?
01600		IBP ALTP	;ADVANCE POINTERS
01700		IBP T3
01800		JRST ALTDL4
01900	ALTDL2:	MOVE ALTP,SVALTP	;RESTORE POINTER AGAIN
02000		POPJ P,		;AND LEAVE
02100	
02200	
02300	APRINT:	PUSH P,ALTCNT	;SAVE CURRENT COUNT
02400		PUSHJ P,ALTLN	;PRINT REST OF LINE AND START OVER
02500		POP P,T2	;GET BACK COUNT
02600		CAILE T2,0	;AND SPACE IF NOT 0
02700		JRST ALTSP
02800		POPJ P,
02900	
03000	ALTDPN:	PUSH P,C
03100		MOVEI C,"\"
03200		TRNN FL2,RUBF2
03300		PUSHJ P,OCHR
03400		TRZE FL2,RUBF
03500		PUSHJ P,OCHR
03600		TRON FL2,RUBF2
03700		PUSHJ P,OCHR
03800		POP P,C
03900		JRST OCHR
     
00100	
00200	ALTSR:	OFFRUB
00300		PUSHJ P,GNCH1	;GET THE CHARACTER TO SEARCH FOR
00400	ALTSR1:	PUSH P,T2	;SAVE NUMBER OF TIMES TO SEARCH
00500		PUSHJ P,ALTCS	;CALL COMMON SEARCH ROUTINE
00600		PUSH P,C	;SAVE THE CHARACTER
00700		PUSHJ P,ALTSP	;GO SPACE CORRECT NUMBER
00800		POP P,C		;RESTORE CHR
00900		POP P,T2	;AND COUNT
01000		SOJG T2,ALTSR1	;CONTINUE
01100		POPJ P,
01200	
01300	ALTCS:	MOVEI T2,1	;CREATE A REPEAT COUNT
01400		TLNE FL,NEGF	;BACKWARDS?
01500		JRST ALTBCS	;YES: SEARCH BACKWARDS
01600		LDB T3,ALTP	;CHEC TO SEE IF AT END OF LINE
01700		CAIN T3,15
01800		POPJ P,
01900		MOVE T1,ALTP	;GET A COPY OF THE POINTER
02000	ALTCS1:	ILDB T3,T1	;GET A CHARACTER
02100		CAIE T3,15	;DONE IF END OF LINE
02200		CAMN T3,C	;OR A MATCH
02300		POPJ P,
02400		AOJA T2,ALTCS1	;ELSE KEEP COUNT AND KEEP LOOKING
02500	
02600	ALTKL:	PUSHJ P,GNCH1	;ALMOST LINE ALTSR
02700	ALTKL1:	PUSH P,T2
02800		PUSHJ P,ALTCS
02900		CAIE T3,0	;OFF FRONT END - SKIP
03000		CAIN T3,15	;BUT GIVE UP IF CHR NOT FOUND
03100		JRST T2POPJ
03200		PUSH P,C
03300		PUSHJ P,ALTDL	;DELETE THAT NUMBER
03400		POP P,C
03500		POP P,T2
03600		SOJG T2,ALTKL1
03700		POPJ P,
03800	T2POPJ:	POP P,T2	;NEED TO CLEAR STACK
03900		POPJ P,
04000	
     
00100	ALTALT:	OFFRUB
00200		SKIPN ALTFLG	;SHOULD WE DO A FILLB?
00300		JRST ALTAL1
00400		PUSHJ P,FINDN
00500		PUSHJ P,FILLB	;YES, WE HAVE INSERTED SOMETHING
00600	ALTAL1:
00700		ONECHO			;DUMPLEXING BACK ON
00800		JRST T1POPJ	;AND RETURN
00900	
01000	
01100	ALTFNZ:
01200		PUSHJ P,GNCH1
01300	ALTFN:
01400		MOVEI T2,MXWPL*5+100	;FINISH UP LINE
01500		PUSHJ P,ALTSP	;BY PRINTING A LARGE NUMBER OF SPCAES
01600	ALTFNX:
01700		OCRLF
01800		ONECHO			;GET OUT OF NON-DUPLEX MODE
01900	ALTFN1:	ILDB C,ALTP	;LOOK ONE CHR OVER
02000		CAIE C,12	;THIS SHOULD BE THE LINE FEED
02100		NERROR ILFMT	;SOMETHING IS WRONG
02200		MOVEI C,0	;ZERO REMAINDER OF LINE
02300	ALTFN2:	TLNN ALTP,760000	;ALL DONE?
02400		JRST ALTFN3	;YES
02500		IDPB C,ALTP	;NO, PUT IN ANOTHER 0
02600		JRST ALTFN2
02700	ALTFN3:	SUBI ALTP,LIBUF-1	;GET SIZE OF NEW LINE
02800		HRRZM ALTP,NCNT	;AND SAVE FOR INSED
02900		AOS -1(P)	;SET FOR SKIP RETURN
03000		JRST T1POPJ	;RETURN TO CALLER OF ALTLIN
03100	
03200	
03300	ALTCU:	OFFRUB
03400		OUTSTR [ASCIZ /^U
03500	/]
03600		JRST SETALT	;GO RESTART LINE AND FORGET EDIT SO FAR
03700	
03800	ALTRP:	PUSHJ P,ALTDL	;REPLACE IS DELETE THEN INSERT
03900		TLZ	FL,NEGF
04000		MOVEI T2,0
04100		JRST ALTIN
04200	
04300	
04400	ALTCN:	OFFRUB
04500		TRO FL2,ALTDUP	;TURN ON DUPLEXING
04600	ALTCN2:	LDB C,ALTP	;AT END OF LINE?
04700		CAIN C,15
04800		POPJ P,		;YES, STOP
04900	ALTCN1:	PUSHJ P,GNCH1	;GET A CHARACTER
05000		CAIE C,177	;DO NOT LET HIM INSERT A RUBOUT
05100		CAIN C,15	;IGNORE CRET
05200		JRST ALTCN1
05300		CAIE C,200	;STOP ON ALTMODE AND LINE FEED
05400		CAIN C,12
05500		POPJ P,
05600		DPB C,ALTP	;REPLACE IT
05700		IBP ALTP	;ADVANCE POINTER
05800		AOS ALTCNT	;AND COUNT
05900		SOJG T2,ALTCN2	;CONTINUE
06000		POPJ P,
06100	
06200	
06300	
06400	ALTEX:	OFFRUB
06500	ALTEX1:	LDB C,ALTP
06600		CAIN C,15
06700		JRST ALTFNX
06800		IBP ALTP
06900		AOS ALTCNT
07000		JRST ALTEX1
07100	
     
00100	
00200	AJOIN:	OFFRUB
00300		PUSHJ P,FINDN	;GO SEE IF NEXT LINE IS REALLY THERE
00400		CAME T1,PGMK
00500		SKIPN T1
00600		JRST ILCER	;MAKE IT ILLEGAL IF NO LINE THERE
00700		MOVEM T1,LIBUF2	;SAVE ITS NUMBER
00800		SETZM LIBUF2+1
00900		MOVE T1,[XWD LIBUF2+1,LIBUF2+2]
01000		BLT T1,LIBUF2+MXWPL+1	;CLEAR OUT REST OF BUFFER
01100		PUSH P,ALTP	;SAVE POINTER TO THIS LINE
01200		ADD ALTP,[XWD 70000,0]	;BACK IT UP
01300		MOVE T2,[POINT 7,LIBUF2+1]
01400		MOVEI C,11
01500		MOVEI T1,6	;COUNT THE CHARACTERS
01600	MOVLIN:	IDPB C,T2
01700		ILDB C,ALTP
01800		CAIE C,15	;END OF LINE?
01900		AOJA T1,MOVLIN	;KEEP COUNT
02000		MOVEI ALTP,1(PNTR)	;GET POINTER TO SECOND LINE
02100		HRLI ALTP,(<POINT 7,0,6>)
02200	ATRN1:	ILDB C,ALTP
02300		IDPB C,T2
02400		ADDI T1,1
02500		CAIL T1,MXWPL*5+6	;CHECK SIZE
02600		JRST LTLER
02700		CAIE C,12
02800		JRST ATRN1	;NOT DONE YET
02900		EXCH T2,(P)	;SAVE OUTPUT POINTER AND GET OLD ALTP BACK
03000		SUBI ALTP,-1(PNTR)	;GET OLD COUNT OF SECOND LINE
03100		PUSH P,ALTP	;AND SAVE IT
03200		MOVEI C,15	;FINISH CURRENT LINE
03300		DPB C,T2
03400		MOVEI C,12
03500		IDPB C,T2
03600		MOVEI C,0
03700	INSC2:	TLNN T2,760000
03800		JRST INSC3	;FILL WITH NULLS
03900		IDPB C,T2
04000		JRST INSC2
04100	INSC3:	SUBI T2,LIBUF-1	;GET COUNT
04200		HRRZM T2,NCNT
04300		PUSHJ P,FINDB	;BACK UP TO POINT TO IT
04400		PUSHJ P,INSED
04500		PUSHJ P,FINDN
04600		PUSHJ P,FILLB
04700		POP P,OCNT	;OLD CONT
04800		HRRZS OCNT
04900		POP P,ALTP	;GET OUTPUT POINTER BACK
05000		SUBI ALTP,LIBUF2-1
05100		HRRZM ALTP,NCNT
05200		MOVE T1,[XWD LIBUF2,LIBUF]
05300		BLT T1,LIBUF+MXWPL+1
05400		PUSHJ P,INSED
05500		SETOM ALTFLG	;MARK AS NEED TO DO FILLB
05600		MOVE T1,NCNT	;GET THE COUNT JUST USED
05700		MOVEM T1,OCNT	;AND SET AS THE OLD COUNT
05800		MOVE ALTP,[POINT 7,LIBUF+1,13]	;SET UP
05900		SETZM ALTCNT
06000		OCRLF
06100		MOVE T1,LIBUF
06200		MOVEM T1,CLN	;SET UP CURRENT LINE
06300		TRNE	FL2,NONUMF	;SKIP IF NORMAL
06400		POPJ	P,
06500		JRST OUTSN	;AND PRINT NUMBER
06600	
06700	LTLER:	RERROR LTL
06800		POP P,ALTP	;RESTORE ALTP
06900		SKIPA
07000	ILCER:	RERROR NNN
07100		PUSHJ P,FINDB	;MOVE BACK TO RIGHT PLACE
07200	ERCOR:	PUSH P,ALTCNT	;SAVE COUNT
07300		SETZM ALTCNT
07400		MOVE ALTP,[POINT 7,LIBUF+1,13]	;SET BACK TO START
07500		PUSHJ P,ALTCBS	;PRINT LINE NUMBER
07600		POP P,T2	;COUNT
07700		JUMPN T2,ALTSP	;AND SPACE OVER
07800		POPJ P,		;NO SPACES TO DO
07900	
     
00100	
00200	ALTWD:	OFFRUB
00300	ALTWD1:	PUSH P,T2	;SAVE COUNT IF ANY
00400		PUSHJ P,ALTWS	;SKIP OVER WORD
00500		ANDI T2,-1	;CLR FLAG IN CASE
00600		PUSHJ P,ALTSP	;SPACE CORRECTLY
00700		POP P,T2	;RESTORE COUNT
00800		SOJG T2,ALTWD1	;CONTINUE
00900	
01000	;ROUTINE TO SKIP OVER NEXT WORD
01100	
01200	ALTWS:	HRROI T2,0	;SET FLG AND COUNT
01300		MOVE T1,ALTP	;GET POINTER
01400		LDB T3,T1	;AND FIRST CHAR
01500		JRST .+2	;CHECK FOR CR & GO
01600	ALTWS1:	ILDB T3,T1	;GET A CHARACTER
01700		CAIN T3,15	;DONE IF END OF LINE
01800	ALTWS2:	POPJ P,
01900		MOVE T3,CTBL(T3);FETCH CHARATER TABLE ENTRY
02000		JUMPE T3,ALTWS4	;SKIP BLANKS ETC...
02100		ANDI T2,-1	;CLR FLAG
02200		JUMPG T3,ALTWS3	;SKIP LETTERS & NUMBERS
02300		TRNN FL2,QSEPF	;SEPARATORS
02400		TRNN T3,NSEPF	;TODAY
02500		POPJ P,		;REAL BREAK - QUIT!
02600	ALTWS3:	AOJA T2,ALTWS1	;KEEP COUNT AND CONTINUE
02700	ALTWS4:	JUMPL T2,ALTWS3	;FIRST BLNKS
02800		AOS T2
02900	ALTWS5:	ILDB T3,T1
03000		CAIE T3,15	;QUIT ON CR
03100		SKIPE CTBL(T3)	;OR FIRST NON-BLANK
03200		POPJ P,
03300		AOJA T2,ALTWS5
03400	
03500	ALTWX:	PUSHJ P,ALTWS	;SKIP WORD
03600		ANDI T2,-1	;CLR FLAG
03700		PUSHJ P,ALTDL	;DELETE CHARS
03800		MOVEI T2,0
03900		JRST ALTIN	;DO INSERT
04000	
     
00100	ALTBS:	PUSHJ P,ALTBAK	;GET PREVIOUS CHAR
00200		JUMPE T3,ALTCBS	;JUMP IF DONE
00300		ONRUB
00400		MOVE C,T3
00500		PUSHJ P,OCHR
00600		SOS ALTCNT	;DECREASE COUNT
00700		SOJG T2,ALTBS	;MORE,MORE
00800		PUSHJ	P,FORCE
00900		POPJ P,
01000	
01100	ALTCBS:	PUSHJ	P,FORCE		;FINISH BUFFER
01200		OFFRUB		;NO MORE RUB
01300		OCRLF
01400		TRNE	FL2,NONUMF	;MORE NONUMBER STUFF
01500		POPJ	P,
01600		MOVE T1,LIBUF	;ALSO PRINT SEQ NUM
01700		JRST OUTSN
01800	
01900	
02000	ALTLN:	MOVEI T2,1000	;FINISH PRINTING THE LINE
02100		PUSHJ P,ALTSP
02200		MOVE ALTP,[POINT 7,LIBUF+1,13]	;POINTER TO START
02300		SETZM ALTCNT	;RESET COUNT
02400		JRST ALTCBS	;AND PRETEND A BACKSPACE
     
00100	;COMMON ROUTINES TO MAKE LINE BACKUP
00200	
00300	ALTBAK:	CAMN	ALTP,[POINT 7,LIBUF+1,13]
00400		JRST	ALTRTZ		;RETURN ZERO IF AT BEGINNING
00500		ADD	ALTP,[POINT 0,0,28]
00600		TLNE	ALTP,(<1B0>)	;CHECK WORD OVERFLOW
00700		SUB	ALTP,[POINT 0,1,0]
00800		LDB	T3,ALTP		;GET CHAR
00900		POPJ	P,
01000	
01100	ALTRTZ:	MOVEI	T3,0		;RETURN 0
01200		POPJ	P,
01300	
01400	ALTBCS:	PUSH	P,ALTP		;SAVE PNTR
01500	ALTBC1:	PUSHJ	P,ALTBAK	;PREV CHAR
01600		JUMPE	T3,APOPJ	;END OF LINE
01700		CAMN	T3,C		;MATCH?
01800		JRST	APOPJ		;YES: RETURN
01900		AOJA	T2,ALTBC1	;NO: COUNT AND CONTINUE
02000	
02100	APOPJ:	POP	P,ALTP		;RESTORE PNTR
02200		POPJ	P,		;RETURN
02300	
02400	ALTBDL:	MOVEM	ALTP,SVALTP	;SAVE PNTR
02500	ALTBD1:	PUSHJ	P,ALTBAK	;BACK A CHAR
02600		JUMPE	T3,ALTBD2	;DONE IF NO MORE
02700		MOVE	C,T3		;FOR PRINTING
02800		TRNN	FL,EXTOG	;PRINT IF NON-EXPERT
02900		PUSHJ	P,ALTDPN
03000		SOJG	T2,ALTBD1
03100	ALTBD2:	PUSHJ	P,FORCE		;FORCE PRINTING
03200		PUSH	P,ALTP		;SAVE NEW PNTR
03300		MOVE	T3,SVALTP	;GET SET TO MOVE LINE
03400	ALTBD3:	LDB	C,T3
03500		DPB	C,ALTP		;MOVE CHAR
03600		JUMPE	C,APOPJ		;DONE IF ZERO
03700		IBP	T3		;ADVANCE PNTRS
03800		IBP	ALTP
03900		JRST	ALTBD3
04000	
04100	SUBTTL THE _ COMMAND
     
00100	SET:	PUSHJ	P,SCAN		;GET THE THING TO SET TO
00200		TRNN	FL,IDF		;MUST BE AN IDENT
00300		NERROR	ILC
00400		PUSHJ	P,DOSET		;CALL SUBROUTINE TO DO SET COMMAND
00500		NERROR	ILC		;ERROR RETURN
00600		JRST	COMND		;OK RETURN
00700	
00800	DOSET:	PUSHJ	P,XCODE		;FETCH DISPATCH ARG
00900		TLZ	T1,477777	;CLEAR GIVE ADDRS
01000		PUSH	P,T1		;SAVE DISPATCH
01100		TLNN	FL2,INPARS	;SKIP TERM CHECK IF PARSE
01200		PUSHJ	P,SCAN		;AND CHECK FOR TERMINATOR
01300		CAIE	C,":"		;COLON OK ALSO
01400		CAIN	C,"="		;IS IT AN =?
01500		JRST	SETVAR		;YES: SET SOMETHING
01600		POP	P,T1		;GET DISPATCH ADDR
01700		TLNN	T1,(1B1)	;BETTER NOT REQUIRE ARG
01800		PUSHJ	P,CKTERM	;CHECK LEGAL TERM
01900		POPJ	P,
02000		HRRZ	T1,T1
02100		JUMPE	T1,CPOPJ
02200		PUSHJ	P,0(T1)		;DO ROUTINE
02300		JRST	CPOPJ1		;GIVE OK RETURN
02400	
02500	SETM33:	TRZA	FL,M37F!DPYF	;MODEL 33
02600	SETM37:	TRO	FL,M37F
02700		POPJ	P,
02800	
02900	CLRSEQ:	TDZA	T1,T1
03000	SETSEQ:	MOVNI	T1,1
03100		MOVEM	T1,UNSEQF
03200		POPJ	P,
03300	
03400	SETBAS:	TLNN	FL2,INPARS	;ILLEGAL IF NOT INITIAL
03500		NERROR	ILC
03600		SETOM	BASICF
03700		POPJ	P,
03800	
03900	SETRED:	TLNN	FL2,INPARS	;ILLEAGL IF NOT INITIAL
04000		NERROR	ILC
04100		TRO	FL,READOF
04200		POPJ	P,
04300	
04400	SETDPY:	TRO	FL,DPYF		;SET TO A DISPLAY
04500		POPJ	P,
04600	
04700	QON:	TLZA	FL,QMODF
04800	QOFF:	TLO	FL,QMODF
04900		POPJ	P,
05000	
05100	SETDCD:	TLOA	FL2,PDECID
05200	CLRDCD:	TLZ	FL2,PDECID
05300		POPJ	P,
05400	
05500	SETOLD:	MOVEI	T1,1
05600		JRST	STOBAK
05700	CLRBAK:	TDZA	T1,T1
05800	SETBAK:	MOVNI	T1,1
05900	STOBAK:	MOVEM	T1,BAKF
06000		POPJ	P,
06100	
06200	QSON:	TROA	FL2,QSEPF
06300	QSOFF:	TRZ	FL2,QSEPF
06400		POPJ	P,
06500	
06600	SETCHK:	TLOA	FL2,DSKCK
06700	CLRCHK:	TLZ	FL2,DSKCK
06800		POPJ	P,
06900	
07000	SETNOV:	TRZA	FL,EXTOG
07100	SETEXP:	TRO	FL,EXTOG
07200		POPJ	P,
07300	
07400	SETUPP:	TDZA	T1,T1
07500	SETLOW:	MOVEI	T1,40
07600		MOVEM	T1,CASEBT
07700		POPJ	P,
07800	
07900	SETNUM:	TRZA	FL2,NONUMF
08000	CLRNUM:	TRO	FL2,NONUMF
08100		POPJ	P,
08200	
08300	CLRZAP:	TDZA	T1,T1
08400	SETZAP:	MOVNI	T1,1
08500		MOVEM	T1,DELETF
08600		POPJ	P,
     
00100	SETVAR:	TLNN	FL2,INPARS
00200		JRST	SETV0		;SKIP OVER EXTRA IF NOT PARSE
00300		TRZ	FL,F.LAHD	;CLEAR LOOK-AHEAD
00400		SETZM	SAVCHR		;...
00500		SETZM	SAVC		;...
00600	SETV0:	PUSHJ	P,SCAN		;GET AN ARG
00700		MOVE	T3,0(P)		;GET WHAT TO DO
00800		TLNN	T3,(1B1)	;NEED ARG
00900		JRST	SETV2		;NO: ERROR
01000		TLNN	T3,(1B2)	;NEED NUMERIC ARG?
01100		JRST	SETV1		;NO: JUST DISPATCH
01200		TRNN	FL,NUMF		;YES: IS IT?
01300		JRST	SETV2		;NOPE - LOSE
01400		TLNE	FL2,INPARS
01500		JRST	SETV1		;SKIP TERM CHECK IN PARSE
01600		PUSH	P,T2		;SAVE IT
01700		PUSH	P,T1		;IN BINARY AND ASCII
01800		PUSHJ	P,SCAN		;CHECK FOR TERMINATOR
01900		POP	P,T1	;GET BACK ASCID
02000		POP	P,T2	;BINARY
02100		PUSHJ	P,CKTERM	;WHICH HAD BETTER BE THERE
02200		JRST	SETV2
02300	SETV1:	POP	P,T3		;GET DISPATCH
02400		HRRZ	T3,T3
02500		JUMPE	T3,CPOPJ
02600		PUSHJ	P,0(T3)		;DISPATCH
02700		JRST	CPOPJ1		;AND RETURN TO CMD LOOP
02800	
02900	SETV2:	POP	P,0(P)		;PRUNE PDL
03000		POPJ	P,		;AND GIVE ERROR RETURN
03100	
03200	SETPLN:	MOVEM	T2,PLINES	;PLINES FOR P
03300		POPJ	P,
03400	
03500	SETRMR:	MOVEM	T2,RMAR		;RIGHT MARGIN FOR JUSTIFY
03600		POPJ	P,
03700	
03800	SETLMR:	MOVEM	T2,LMAR		;LEFT MARGIN
03900		POPJ	P,
04000	
04100	SETPMR:	MOVEM	T2,PMAR		;PARAGRAPH MARGIN
04200		POPJ	P,
04300	
04400	SETINC:	MOVEM	T1,INCR		;PERM INCREMENT
04500		MOVEM	T1,TECINC	;SETUP OTHER INCR
04600		POPJ	P,
04700	
04800	SETMLN:	MOVEM	T1,MAXLN	;MAXIMUM LINE NUMBER
04900		POPJ	P,
05000	
05100	SETSAV:	MOVEM	T2,SSAVEN	;STORE IN RESET PLACE TOO
05200		MOVEM	T2,SAVEN
05300		POPJ	P,
05400	
05500	SETISV:	MOVEM	T2,SISAVN
05600		MOVEM	T2,ISAVEN
05700		POPJ	P,
05800	
05900	SETLEN:	MOVEM	T2,PAGESZ
06000		POPJ	P,
     
00100	SETNM1:	PUSHJ	P,READN0	;GET A FILE SPEC
00200		POPJ	P,		;ERROR RETURN
00300		SKIPN	RSW		;ERROR IF SWITCHES SEEN
00400		SKIPE	SSW
00500		POPJ	P,
00600		PUSHJ	P,CKTERM	;GRNTEE EOL
00700		POPJ	P,		;NOPE
00800		JRST	CPOPJ1		;YEP
00900	
01000	SETNAM:	PUSHJ	P,SETNM1	;GET FILE SPEC , CHECK ERRORS
01100		NERROR	ILC
01200		SKIPE	TMPDEV		;DEVICES ILLEGAL
01300		NERROR	ILC
01400		MOVE	T1,[TMPBLK,,NEWBLK]
01500		BLT	T1,NEWBKE	;SET UP NEW BLOCK
01600		POPJ	P,		;RETURN
01700	
01800	SETRUN:	PUSHJ	P,SETNM1	;GET FILE SPEC - CHECK ERRORS
01900		NERROR	ILC
02000		SKIPN	T1,TMPDEV	;SEE IF DEVICE SPECIFIED
02100		MOVSI	T1,'SYS'	;NO: USE SYS
02200		MOVEM	T1,TMPDEV	;SAVE IT
02300		MOVE	T1,[TMPBLK,,RUNBLK]
02400		BLT	T1,RUNBKE	;SET UP FILE ARGS FOR RUN UUO
02500		POPJ	P,		;RETURN
02600	
02700	;ROUTINE TO CHECK PROPER TERMINATION
02800	
02900	CKTERM:	TLNE	FL2,INOPTF	;CHECK IF OPTION FILE
03000		JRST	CKTRM1
03100		TLNE	FL2,INPARS	;SEE IF CMD STRING
03200		JRST	CPOPJ1		;ALWAYS SAY PROPER TERM - PARSE WILL CHECK
03300	CKTRM0:	TRNE	FL,TERMF	;PROPER LINE TERM?
03400		AOS	(P)		;YES
03500		POPJ	P,		;NON-SKIP IF NO
03600	
03700	CKTRM1:	CAIE	C,"/"		;ALLOW SPECIAL CHARS
03800		CAIN	C,","		;IF IN OPTION FILE
03900		JRST	CPOPJ1
04000		CAIN	C,"-"		;IF NO SPEC CHRS FOUND
04100		JRST	CPOPJ1
04200		JRST	CKTRM0		;ALSO CHECK EOL
04300	
04400	;HANDLE OPTION FILES
04500	
04600	SETOPT:	TRNE	FL,IDF		;CHECK FOR IDENT
04700		SKIPN	T1,ACCUM	;AND NON-ZERO ATOM
04800		NERROR	ILC
04900		MOVEM	T1,OPTION	;SET UP OPTION
05000		TLNE	FL2,INPARS	;INITIAL
05100		JRST	OPTSWT		;YES: USE SPECIIAL ROUTINE
05200		PUSHJ	P,SCAN		;CHECK TERM
05300		PUSHJ	P,CKTERM
05400		NERROR	ILC		;LOSE
05500		PUSHJ	P,DOOPT
05600		JRST	SETOP1		;NOT FOUND
05700		JRST	SETOP2		;GROSS ERROR
05800		POPJ	P,		;OK RETURN
05900	
06000	SETOP1:	OUTSTR	[ASCIZ /? Option not found
06100	/]
06200		POPJ	P,
06300	SETOP2:	OUTSTR	[ASCIZ /? Syntax error in option file
06400	/]
06500		POPJ	P,
06600	
06700	SETSTP:	MOVEM	T1,TECINC	;SET UP INCRS
06800		MOVEM	T1,INCR
06900		POPJ	P,
07000	
07100	SETFST:	MOVEM	T1,TECFST	;SET UP START
07200		POPJ	P,
07300	
07400	SUBTTL = COMMAND
     
00100	
00200	GIVE:	PUSHJ P,SCAN	;FIND OUT WHAT HE WANTS TO KNOW
00300		CAIN C,"."	;CURRENT LINE/PAGE?
00400		JRST GVDOT	;YES
00500		TRNN FL,IDF	;IF NOT, MUST BE AN IDENT
00600		NERROR ILC
00700		PUSHJ P,XCODE	;FETCH ACTUAL SIXBIT ARG
00800		HLRZ	T1,T1		;GET GIVE ADDRS
00900		TRZ	T1,3B20		;CLEAR FUNNY BITS
01000		JUMPE	T1,XERR
01100		PUSH	P,T1		;SAVE DISPATCH
01200		PUSHJ P,SCAN	;CHECK FOR TERM
01300		TRNN FL,TERMF
01400		NERROR ILC
01500		POP P,T1	;NOW FIND OUT WHAT HE WANTS
01600		PUSHJ	P,0(T1)		;GIV INFO
01700		JRST	COMND		;AND RETURN
01800	
01900	GIVBIG:	TRNE FL,BGSN	;HAVE WE SEEN THAT PAGE
02000		JRST GVBG1	;YES, ALL IS OK
02100		MOVSI T1,1	;WILL HAVE TO SEARCH FOR IT
02200		MOVEM T1,DPG
02300		MOVEI SINDEX,0
02400		PUSHJ P,FIND
02500		TRNN FL,BGSN	;SHOULD HAVE SEEN IT NOW
02600		ERROR ICN	;WE ARE IN TROUBLE
02700	GVBG1:	MOVE T1,BGPG	;GET IT
02800	GIV2:	MOVEI T3,OCHR	;ROUTINE FOR DECIMAL PRINTER TO OUTPUT TO
02900		PUSHJ P,DECPR	;PRINT DECIMAL
03000	GIV3:	PUSHJ	P,FORCE		;FORCE OUTPUT
03100	GIV1:
03200		OCRLF
03300		POPJ	P,
03400	
03500	GVCASE:
03600		TRNE FL,DPYF
03700		OUTSTR [ASCIZ /Display /]
03800		TRNE FL,M37F
03900		OUTSTR [ASCIZ /Model 37 /]
04000		TLNE FL,QMODF
04100		OUTSTR [ASCIZ /C64 /]
04200		TRNE FL2,QSEPF
04300		OUTSTR [ASCIZ /Separators /]
04400		MOVEI T1,[ASCIZ /Lower
04500	/]
04600		SKIPN CASEBT
04700		MOVEI T1,[ASCIZ /Upper
04800	/]
04900		;PRINT CURRENT CASE
05000		OUTSTR @T1
05100		POPJ	P,
05200	GIVER:	SKIPN T1,SVERN
05300		POPJ	P,
05400		OUTSTR @ETBL2-1(T1)
05500		POPJ	P,
05600	GVRM:	MOVE T1,RMAR	;RIGHT MARGIN
05700		JRST GIV2
05800	GVMLN:	MOVE T1,MAXLN	;MAXIMUM LINE NUMBER
05900		PUSHJ P,OUTSN
06000		JRST GIV1
06100	GVLM:	MOVE T1,LMAR	;LEFT MARGIN
06200		JRST GIV2
06300	GVPM:	MOVE T1,PMAR	;PARAGRAPH LEFT MARGIN
06400		JRST GIV2
06500	GVPG:	MOVE T1,PAGESZ
06600		JRST GIV2
06700	
06800	GVPLN:	MOVE	T1,PLINES
06900		JRST	GIV2
07000	
07100	GVSAV:	SKIPGE	T1,SAVEN	;SAVE LEFT
07200		MOVEI	T1,0
07300		JRST	GIV2
07400	GVISAV:	SKIPGE	T1,ISAVEN	;ISAVE LEFT
07500		MOVEI	T1,0
07600		JRST	GIV2
07700	
07800	GIVDSK:	PUSHJ	P,TELSPC
07900		POPJ	P,
08000	
08100	GIVCHK:	TLNN	FL2,DSKCK
08200		OUTSTR	[ASCIZ "No "]
08300		OUTSTR	[ASCIZ "disk check
08400	"]
08500		POPJ	P,
08600	
08700	GIVDCD:	TLNN	FL2,PDECID
08800		OUTSTR	[ASCIZ "No "]
08900		OUTSTR	[ASCIZ "auto decide
09000	"]
09100		POPJ	P,
09200	
09300	GIVBAK:	SKIPN	BAKF
09400		OUTSTR	[ASCIZ "No "]
09500		OUTSTR	[ASCIZ "backup file will be created
09600	"]
09700		POPJ	P,
09800	
09900	GIVSEQ:	SKIPE	UNSEQF
10000		OUTSTR	[ASCIZ "No "]
10100		OUTSTR	[ASCIZ "sequence numbers will be on output file
10200	"]
10300		POPJ	P,
     
00100	GVINC:	MOVE T1,INCR	;GET CURRENT INCREMENT
00200		PUSHJ P,OUTSN	;GO PRINT IT
00300		JRST GIV1	;AND A CRRET
00400	
00500	GVDOT:	PUSHJ	P,SCAN		;SEE IF A TERMINATOR IS THERE
00600		TRNN	FL,TERMF
00700		NERROR	ILC		;NO TERMINATOR
00800		MOVE	T2,CLN		;GET CURRENT LINE
00900		MOVE	T1,CPGL		;AND CURRENT PAGE
01000	GVDOT1:	MOVEM	T2,LINOUT
01100		OUTSTR	LINOUT		;PRINT IT
01200		PUSHJ	P,GIV2		;PRINT PAGE
01300		JRST	COMND		;AND RETURN
01400	
01500	OCTPR:	SKIPA CS,[^O10]
01600	DECPR:	MOVEI CS,^D10
01700	RDXPR:	IDIVI T1,0(CS)
01800		HRLM T2,(P)
01900		SKIPE T1
02000		PUSHJ P,RDXPR
02100		HLRZ C,(P)
02200		ADDI C,"0"
02300		JRST (T3)	;EXCEPT HAS ARBITRARY OUTPUT ROUTINE
02400	
02500	GVSTR:	MOVEI T1,SRPNT	;GET THE POINTER TO POINTER BLOCK
02600		HRLI T1,-SRNUM	;SET COUNT
02700		OUTSTR [ASCIZ /	Find:
02800	/]
02900		PUSHJ P,GVSTR3
03000		MOVEI T1,R2PNT
03100		HRLI T1,-SRNUM
03200		OUTSTR [ASCIZ /	Substitute:
03300	/]
03400		PUSHJ P,GVSTR3
03500		MOVEI T1,R1PNT
03600		HRLI T1,-SRNUM
03700		OUTSTR [ASCIZ /	For:
03800	/]
03900		PUSHJ P,GVSTR3
04000	IFN EXTEND,<
04100		OUTSTR [ASCIZ /	Line-contents:
04200	/]
04300		MOVEI T4,0
04400		MOVEI T5,LSNUM
04500		MOVEI T3,OCHR
04600	GVST1:	MOVEI T1,1(T4)
04700		PUSHJ P,DECPR
04800		MOVEI C,":"
04900		PUSHJ P,OCHR
05000		PUSHJ	P,FORCE
05100		OCRLF
05200		MOVEI T1,-1(T5)
05300		IMULI T1,SRNUM
05400		ADDI T1,LSPNT
05500		HRLI T1,-SRNUM
05600		PUSHJ P,GVSTR3
05700		ADDI T4,1
05800		SOJG T5,GVST1
05900	>
06000		POPJ	P,
06100	
06200	GIVFST:	MOVE	T1,TECFST	;GET CURRENT START
06300		PUSHJ	P,OUTSN		;PRINT IT
06400		JRST	GIV1		;CRLF AND RETURN
06500	
06600	GIVSTP:	MOVE	T1,TECINC	;GET INPUT INCR
06700		PUSHJ	P,OUTSN		;PRINT
06800		JRST	GIV1		;AND RETURN
06900	
07000	GIVLOC:	MOVE	T2,BUFP		;GIVE HIM FIRST LOC IN BUFFER
07100		SKIPN	T2,0(T2)	;IF ANYTHING THERE
07200		MOVE	T2,[ASCII /00000/]
07300		MOVE	T1,OPG		;OUTPUT PAGE -1
07400		AOJA	T1,GVDOT1
07500	
07600	GIVZAP:	OUTSTR	[ASCIZ "Input file will "]
07700		SKIPN	DELETF		;GIVE CORRECT MESSAGE
07800		OUTSTR	[ASCIZ "NOT "]
07900		OUTSTR	[ASCIZ "be deleted.
08000	"]
08100		POPJ	P,
     
00100	GVSTR3:	SKIPN T2,(T1)	;IS THERE ONE THERE?
00200		POPJ P,		;NO, DONE
00300	GVSTR2:	ILDB C,T2	;NEXT CHR
00400		JUMPE C,GVSTR1	;DONE
00500		PUSHJ P,OCHR	;PRINT IT
00600		JRST GVSTR2	;AND CONTINUE
00700	GVSTR1:	PUSHJ	P,FORCE		;CLEAR OUTPUT DEVICE
00800		OCRLF
00900		AOBJN T1,GVSTR3	;IF THERE IS ONE
01000		POPJ P,
01100	
01200	GVNAM:	MOVEI	T4,ORGBLK
01300		SKIPE	NEWNAM		;NEW NAME GIVEN?
01400		MOVEI	T4,NEWBLK	;YES - USE IT
01500	GVNM1:	PUSHJ	P,GVNAM0
01600		JRST	GIV1
01700	
01800	GVRUN:	SKIPN	RUNNAM		;NEW NAME GIVEN?
01900		JRST	GVRUN1		;NO - JUST TELL HIM OLD INFO
02000		MOVEI	T4,RUNBLK	;YES - USE NEW INFO
02100		JRST	GVNM1		;PRINT & RETURN
02200	
02300	GVRUN1:	OUTSTR	[ASCIZ "SYS:COMPIL"]
02400		JRST	GIV1
02500	
02600	;ROUTINE TO PRINT FILE NAME INFO POINTED TO BY T4
02700	
02800	GVNAM0:	SKIPE	T2,DEV(T4)	;SEE IF A DEVICE
02900		CAMN	T2,[SIXBIT "DSK"]
03000		JRST	GVNAM1		;DON'T PRINT IT IF 'DSK'
03100		PUSHJ	P,PRTSX6	;PRINT DEVICE NAME IN T2
03200		MOVEI	C,":"		;AND A COLON
03300		PUSHJ	P,OCHR
03400	
03500	GVNAM1:	MOVE	T2,NAM(T4)	;GET A NAME
03600		PUSHJ	P,PRTSX6
03700		HLLZ	T2,EXT(T4)	;SEE IF THERE IS AN EXTENSION
03800		JUMPE	T2,GVNAM2	;JUMP IF THERE ISN'T
03900		MOVEI	C,"."		;A PERIOD
04000		PUSHJ	P,OCHR
04100		PUSHJ	P,PRTSX3
04200	
04300	GVNAM2:	SKIPN	PTH(T4)		;LOOK FOR PATH INFO
04400		JRST	FORCE		;NONE - DUMP BUFFER & RETURN
04500		MOVEI	C,"["		;OPEN BRACKET
04600		PUSHJ	P,OCHR
04700		MOVEI	T3,OCHR		;SETUP FOR OCTPR
04800		HLRZ	T1,PTH(T4)	;GET PROJ #
04900		PUSHJ	P,OCTPR
05000		MOVEI	C,","		;A COMMA SEPARATOR
05100		PUSHJ	P,OCHR
05200		HRRZ	T1,PTH(T4)	;GET PROG #
05300		PUSHJ	P,OCTPR		;PRINT IT
05400		HRLI	T4,-<SFDLVL+1>	;SET UP FOR FULL PATH
05500		JRST	GVNAM4
05600	
05700	GVNAM3:	MOVEI	C,","
05800		PUSHJ	P,OCHR		;DUMP A COMMA
05900		PUSHJ	P,PRTSX6	;PRINT ATOM IN T2
06000	GVNAM4:	SKIPE	T2,PTH+1(T4)	;IS THERE MORE?
06100		AOBJN	T4,GVNAM3	;YES - SEE IF COUNT EXPIRED
06200		MOVEI	C,"]"		;CLOSING BRACKET
06300		PUSHJ	P,OCHR
06400		JRST	FORCE		;DUMP BUFFER & EXIT
06500	
06600	PRTSX3:	MOVEI	T3,3		;3 CHARS
06700		TRZA	T2,-1		;CLEAR RH
06800	PRTSX6:	MOVEI	T3,6		;6 CHARS
06900		MOVEI	T5,GVOSX	;OUTPUT ROUTINE
07000		JRST	PRTSX
07100	
07200	GVOSX:	MOVE	C,T1		;COPY CHAR INTO C
07300		JRST	OCHR		;AND OUTPUT IT
     
00100	
00200	COMMENT ! THIS HERE IS THE UNIQUE INITIAL SEGMENT DECODER
00300	   STOLEN FROM THE PDP10 T-S MONITOR (SEE COMCON).
00400	   IT TAKES THE ARGUMENT IN LOC 'ACCUM' AND RETURNS THE
00500	   FULL SIXBIT VALUE IN SAME. !
00600	
00700	DECODE:
00800		MOVE T1,ACCUM		;FETCH ARG
00900		MOVNI T2,1		;SET MASK ALL ONES
01000		LSH T2,-6		;CLEAR OUT ONE MORE CHAR
01100		LSH T1,6		;SHIFT 1 COMMAND CHAR OFF
01200		JUMPN T1,.-2		;LUP UNTIL ALL GONE
01300		EXCH T2,ACCUM		;FETCH ARG IN T2 & SAVE MASK
01400		MOVNI T3,1		;CLEAR FOUND COUNT
01500	LUP:	MOVE T4,@S1		;FETCH TABLE ENTRY
01600		TDZ T4,ACCUM		;MASK OUT CHARS NOT TYPED
01700		CAMN T2,@S1		;EXACT MATCH?
01800		JRST FOUND		;YES: THIS IS IT
01900		CAME T2,T4		;CLOSE MATCH?
02000		JRST LNEXT		;NO: KEEP TRYING
02100		AOJG T3,LNEXT		;FIRST TIME?
02200		HRRZ T5,S2		;YES: REMBER INDEX
02300	
02400	LNEXT:	AOBJN S2,LUP		;NO: KEEP LOOKING
02500		SKIPN T3		;FIND ONLY ONE?
02600		MOVE S2,T5		;YES: OK TO USE SAVED VALUE
02700	FOUND:	POPJ P,			;RETURN
02800	
02900	XCODE:	PUSH	P,S1		;SAVE SPECIAL ACS
03000		PUSH	P,S2
03100		MOVE	S1,[S2,,NAMTAB]
03200		MOVSI	S2,-NAMLEN
03300		PUSHJ	P,DECODE
03400		MOVE	T1,NAMDSP(S2)	;GET DISPATCH ENTRY
03500		POP	P,S2		;RESTORE SPECIAL ACS
03600		POP	P,S1
03700		POPJ	P,
     
00100	;THIS IS THE FULL NAME TABLE
00200	
00300		DEFINE NAMES <
00400	X	(R,SETRED,0,0)
00500	X	(RONLY,SETRED,0,0)
00600	X	(READONLY,SETRED,0,0)
00700	X	(UPPER,SETUPP,0,0)
00800	X	(LOWER,SETLOW,0,0)
00900	X	(M37,SETM37,0,0)
01000	X	(M33,SETM33,0,0)
01100	X	(DPY,SETDPY,0,0)
01200	X	(NOVICE,SETNOV,0,0)
01300	X	(EXPERT,SETEXP,0,0)
01400	X	(C128,QON,0,0)
01500	X	(C64,QOFF,0,0)
01600	X	(SEPARATORS,QSON,0,0)
01700	X	(NONSEPARATORS,QSOFF,0,0)
01800	X	(RMAR,SETRMR,GVRM,XNUMF)
01900	X	(LMAR,SETLMR,GVLM,XNUMF)
02000	X	(PMAR,SETPMR,GVPM,XNUMF)
02100	X	(MAXLN,SETMLN,GVMLN,XNUMF)
02200	X	(INCREMENT,SETINC,GVINC,XNUMF)
02300	X	(ERROR,0,GIVER,0)
02400	X	(CASE,0,GVCASE,0)
02500	X	(STRING,0,GVSTR,0)
02600	X	(BIG,0,GIVBIG,0)
02700	X	(LOCATION,0,GIVLOC,0)
02800	X	(NAME,SETNAM,GVNAM,XVARF)
02900	X	(RUN,SETRUN,GVRUN,XVARF)
03000	X	(LENGTH,SETLEN,GVPG,XNUMF)
03100	X	(SAVE,SETSAV,GVSAV,XNUMF)
03200	X	(ISAVE,SETISV,GVISAV,XNUMF)
03300	X	(CHECK,SETCHK,GIVCHK,0)
03400	X	(NOCHECK,CLRCHK,0,0)
03500	X	(NUMBER,SETNUM,0,0)
03600	X	(NONUMBER,CLRNUM,0,0)
03700	X	(DISK,0,GIVDSK,0)
03800	X	(DSK,0,GIVDSK,0)
03900	X	(DECIDE,SETDCD,GIVDCD,0)
04000	X	(NODECIDE,CLRDCD,0,0)
04100	X	(DELETE,SETZAP,GIVZAP,0)
04200	X	(NODELETE,CLRZAP,0,0)
04300	X	(BAK,SETBAK,GIVBAK,0)
04400	X	(NOBAK,CLRBAK,0,0)
04500	X	(OLD,SETOLD,0,0)
04600	X	(OPTION,SETOPT,0,XVARF)
04700	X	(BASIC,SETBAS,0,0)
04800	X	(UNSEQUENCE,SETSEQ,0,0)
04900	X	(SEQUENCE,CLRSEQ,GIVSEQ,0)
05000	X	(START,SETFST,GIVFST,XNUMF)
05100	X	(STEP,SETSTP,GIVSTP,XNUMF)
05200	X	(PLINES,SETPLN,GVPLN,XNUMF)
05300	>
     
00100		DEFINE	X(A,B,C,D) <
00200		EXP	<SIXBIT /A/>>
00300	
00400	NAMTAB:
00500		NAMES
00600	
00700	NAMLEN==.-NAMTAB
00800	
00900		DEFINE	X(A,B,C,D) <
01000		D+C,,B
01100	>
01200	
01300	XNUMF==3B20		;SET NEEDS NUMERIC ARG
01400	XVARF==1B19		;SET NEEDS ARG
01500	
01600	NAMDSP:
01700		NAMES
01800	
01900		XERR,,XERR
02000	
02100	XERR:	NERROR	ILC
02200	
02300	SUBTTL LIST COMMAND
     
00100	
00200	IFN LSTSW,<
00300	LIST:	TRZ FL2,SUPN	;ASSUME WE ARE GOING TO LIST LINE NUMBERS
00400		SETZM LOLN	;FOR START OF PAGE
00500		PUSHJ P,SCAN	;GET SOME INFORMATION
00600		CAIE C,","	;IS THERE A SWITCH?
00700		JRST LIST9	;NO
00800		PUSHJ P,SCAN	;YES, SCAN FOR IT
00900		MOVS T1,ACCUM
01000		CAIE T1,(<SIXBIT /S  />)	;IS IT S?
01100		NERROR ILC	;NO, LOSE
01200		TRO FL2,SUPN	;YES, SUPPRESS LINE NUMBERS
01300		PUSHJ P,SCAN	;AND SCAN PAST IT
01400	LIST9:	TRNN FL,TERMF	;JUST A TERMINATOR
01500		JRST LIST7	;NO, GO LOOK FOR A COMMAND STRING
01600		MOVEI T1,1	;LIST ENTIRE FILE
01700		MOVEM T1,LOPG
01800		MOVSI T1,1	;FROM 1 TO IMPOSSIBLY HIGH
01900		MOVEM T1,HIPG
02000		TRZ FL,CNTF	;MAKE SURE THAT THIS FLAG IS OFF
02100		JRST LIST8	;GO START WORK
02200	LIST7:	PUSHJ P,GET2	;HAVE ALREADY SCANNED, GET 2 NUMBERS
02300		CAIE C,","	;IS THERE A SWITCH?
02400		JRST LIST10	;NO
02500		PUSHJ P,SCAN	;YES, SCAN FOR IT
02600		MOVS T1,ACCUM
02700		CAIE T1,(<SIXBIT /S  />)	;IS IT S?
02800		NERROR ILC	;NO, LOSE
02900		TRO FL2,SUPN	;YES, SUPPRESS LINE NUMBERS
03000		PUSHJ P,SCAN	;AND SCAN PAST IT
03100	LIST10:	TRNN FL,TERMF	;END OK?
03200		NERROR ILC
03300	LIST8:	TRZ FL,LINSN	;NONE SEEN YET
03400		MOVEI T1,LPTBUF	;GET SET TO INIT THE LPT
03500		EXCH	T1,.JBFF##
03600		PUSH	P,T1		;SAVE OLD
03700		MOVSI	T1,'LPT'	;DEFAULT DEVICE NAME
03800		MOVEM	T1,LPDEVI+1
03900		OPEN LPT,LPDEVI		;GET IT
04000		SKIPA			;FAILED - TRY DSK
04100		JRST	LIST8A		;LPT OK - USE IT
04200		MOVE	T1,OUDEVI+1	;GET DSK NAME
04300		MOVEM	T1,LPDEVI+1
04400		OPEN	LPT,LPDEVI
04500		  NERROR UNA
04600	LIST8A:	OUTBUF LPT,1	;ASK FOR ONE BUFFER
04700		MOVEI T2,LPTBUF	;FIND OUT HOW BIG IT IS
04800		EXCH T2,.JBFF##
04900		SUBI T2,LPTBUF	;THE SIZE
05000		MOVEI T1,203		;THE SPACE RESERVED FOR IT
05100		IDIV T1,T2	;GET NUMBER THAT WILL FIT THERE
05200		OUTBUF LPT,(T1)	;AND ASK FOR THAT MANY
05300		POP	P,.JBFF##	;RESTORE JOBFF
05400		MOVE	T1,[OCRBLK,,TMPBLK]
05500		BLT	T1,TMPBKE	;SETUP OUTPUT SPECS
05600		SKIPN	T1,NEWNAM	;SEE IF NEW NAME
05700		MOVE	T1,ORGNAM	;ELSE USE ORIGINAL
05800		MOVEM	T1,TMPNAM
05900		MOVSI	T1,'LPT'	;USE THIS EXTENSION
06000		HRR	T1,ORGPRT	;AND THIS PROTECTION
06100		MOVEM	T1,TMPEXT
06200		XENTR	LPT,TMPBLK	;GO CREATE FILE
06300		  NERROR UNA		;NOPE!
06400		MOVE T1,[XWD PGHS,PGHD]	;GET A COPY OF THE BLANK HEADER
06500		BLT T1,PGHD+7
06600		MOVE C,[POINT 7,PGHD,27]	;START TO FILL IT
06700		MOVEI T3,6	;6 CHRS IN FILE NAME
06800		MOVEI	T5,HDOSX	;OUTPUT ROUTINE
06900		MOVE T2,ORGNAM	;USE THE ORIGINAL NAME
07000		PUSHJ P,PRTSX	;PUT IT IN THE HEADER
07100		SKIPN T2,ORGEXT	;GET THE EXTENSION
07200		JRST LIST1	;NONE THERE, IGNORE
07300		MOVEI T1,"."	;A DOT BETWEEN
07400		IDPB T1,C
07500		MOVEI T3,3	;ONLY 3 CHRS HERE
07600		TRZ	T2,-1		;CLEAR RH
07700		PUSHJ P,PRTSX
07800	LIST1:	MOVE ALTP,[POINT 7,PGHD+3]	;TIME+DATE (ALTP IS FREE)
07900		DATE T1,	;GET DATE
08000		IDIVI T1,^D31	;LEAVES DAY IN T2
08100		PUSH	P,T1		;SAVE PARTIAL
08200		MOVEI T1,1(T2)	;GET DAY (MUST ADD 1)
08300		MOVEI T3,HDOCH	;PLACE FOR DECPR TO PUT THINGS
08400		PUSHJ P,DECPR
     
00100		MOVEI	C,"-"		;SEPARATE
00200		IDPB	C,ALTP
00300		POP	P,T1		;GET MONTH-YEAR BACK
00400		IDIVI	T1,^D12		;MONTH-1 IN T2
00500		SKIPA	T4,[POINT 7,MONTAB(T2)]
00600		IDPB	C,ALTP
00700		ILDB	C,T4
00800		JUMPN	C,.-2		;LOOP UNTIL NULL
00900		MOVEI	C,"-"		;SEPARATE
01000		IDPB	C,ALTP
01100		ADDI T1,^D64	;CONVERT TO REAL YEAR
01200		PUSHJ P,DECPR
01300		IBP ALTP	;SKIP OVER A SPACE
01400		MSTIME T1,	;GET THE TIME
01500		IDIVI T1,^D60000	;CONVERT TO MINUTES
01600		IDIVI T1,^D60	;NOW TO HOURS
01700		PUSH P,T2	;SAVE MINUTES
01800		PUSHJ P,DECPR	;PRINT
01900		MOVEI T1,":"
02000		IDPB T1,ALTP
02100		POP P,T1	;GET MINUTES BACK
02200		MOVEI T2,"0"	;MAKE SURE THERE ARE 2 DIGITS
02300		CAIG T1,^D9
02400		IDPB T2,ALTP
02500		PUSHJ P,DECPR
02600		SETOM LOGPG	;LOGICAL PAGE TO 0
02700		MOVE T1,LOPG	;GET SET TO PRINT
02800		MOVEM T1,DPG
02900		MOVE SINDEX,LOLN
03000		PUSHJ P,FIND	;GO FIND IT
03100		SETZM LSTCNT	;COUNT OF NUMBER OF LINES PER PAGE
03200	LST2:	PUSHJ P,ONMOV	;CHECK RANGE
03300		JRST LST6	;FINISH UP
03400		TRO FL,LINSN	;YEP, WE HAVE SEEN ONE
03500		CAMN T1,PGMK	;CHECK FOR PAGE MARK AND HANDLE SPECIAL
03600		JRST LST4
03700		MOVEM T1,CLN	;THE CURRENT LINE
03800		MOVEI T2,0	;COUNT OF NUMBER OF CHRS SEEN
03900		SOSLE	LSTCNT		;CHECK TO SEE IF RUN OUT
04000		JRST	LST2A		;NO - PROCEED
04100		MOVEI	C,14		;OUTPUT A FORM-FEED
04200		PUSHJ	P,POCHR
04300		PUSHJ	P,HDPRNT	;GO PRINT HEADING
04400	LST2A:	MOVE T1,PNTR	;GET THE POINTER
04500		TRNN FL2,SUPN	;DO WE WANT TO SUPPRESS LINE NUMBERS?
04600		JRST LST3A	;NO
04700		AOS T1		;YES, SKIP A WORD
04800		HRLI T1,(<POINT 7,0,6>)	;AND A CHARACTER
04900		ADDI T2,6	;AND TELL PEOPLE WE HAVE DONE SO
05000		JRST LST3	;BEFORE GOING ON OUR WAY
05100	LST3A:	HRLI T1,(<POINT 7,0>)	;AND SET UP BYTE POINTER
05200	LST3:	ILDB C,T1	;GET CHR
05300		CAIGE	C,11		;CHECK ALL SPECIAL CASES
05400		JRST	LST3B
05500		CAIGE	C,15
05600		JRST	SPHD
05700		CAIN	C,15
05800		JRST	LST5
05900		CAIE	C,"'"
06000		CAIGE	C,40
06100		JRST	LST3B
06200		CAIGE	C,140
06300		JRST	LST5
06400	LST3B:	TLNE	FL,QMODF	;CHECK QUOTE MODE
06500		JRST	LST5
06600		PUSH	P,C
06700		MOVEI	C,"'"
06800		PUSHJ	P,POCHR
06900		ADDI	T2,1
07000		POP	P,C
07100		LDB	C,[POINT 7,CTBL(C),10]
07200	LST5:	PUSHJ	P,POCHR		;PRINT IT
07300		AOJA	T2,LST3		;COUNT AND CONTINUE
     
00100	SPHD:	CAIN C,12	;LINE FEED IS END OF LINE
00200		JRST	[PUSHJ P,POCHR	;PRINT IT
00300			PUSHJ P,FINDN	;GET NEXT
00400			JRST LST2]	;AND GO
00500		CAIN C,11	;COUNT SPECIAL FOR TAB
00600		JRST	[ADDI T2,10
00700			ANDCMI T2,7
00800			PUSHJ P,POCHR
00900			JRST LST3]
01000		CAIN C,14
01100		JRST	[PUSHJ P,POCHR	;FORM FEED GETS A HEADING
01200			PUSHJ P,HDPRNT
01300			JRST LST3]
01400		CAIN C,"\"	;NEEDS DELETE,DELETE
01500		JRST	[MOVEI C,177
01600			PUSHJ P,POCHR
01700			JRST LST5]	;AND AGAIN
01800		CAIE C,13	;VERT.TAB
01900		ERROR ICN	;CONFUSED
02000		PUSHJ P,POCHR
02100		MOVE T3,LSTCNT
02200		CAIG T3,<%LPP+2>/3
02300		JRST	[PUSHJ P,HDPRNT
02400			JRST LST3]
02500		CAIG T3,<2*<%LPP+2>>/3
02600		MOVEI T3,<%LPP+2>/3
02700		CAIL T3,<2*<%LPP+2>>/3
02800		MOVEI T3,<2*<%LPP+2>>/3
02900		MOVEM T3,LSTCNT
03000		JRST LST3
03100	
03200	LST4:	MOVEI C,14	;PRINT A FORM FEED
03300		SOSLE LSTCNT	;BUT ONLY IF WE ARE NOT ALREADY THERE
03400		PUSHJ P,POCHR
03500		AOS T1,CPG	;GET PAGE CORRECTLY
03600		MOVEM T1,CPGL
03700		SETOM LOGPG	;ZERO LOGICAL PAGE AGAIN
03800		MOVEI T2,0	;THIS MUST BE ZERO SO GET IT THAT WAY
03900		PUSHJ P,HDPRNT	;PRINT A HEADER
04000		AOS LSTCNT	;INCREASE BY 1 TO MAKE IT COME OUT RIGHT
04100		PUSHJ P,FINDN	;ADVANCE
04200		JRST LST2	;AND CONTINUE
04300	
04400	LST6:	RELEAS LPT,0	;GET RID OF IT
04500		TRZ FL2,SUPN	;TURN THIS OFF SO * PRINTS
04600		TRNN FL,LINSN	;WERE ANY SEEN?
04700		NERROR NLN	;NO, ERROR
04800		MOVE T1,CPG	;SET UP PAGE
04900		MOVEM T1,CPGL
05000		JRST COMND	;AND GET MORE COMMANDS
     
00100	POCHR:	SOSG LOBUF+2	;ROOM FOR MORE?
00200		OUTPUT LPT,0
00300		IDPB C,LOBUF+1
00400		POPJ P,
00500	
00600	HDPRNT:	PUSH P,T1	;SAVE POINTER
00700		TRNE FL2,SUPN	;IF PRETTY PRINTING
00800		JRST HDPR3	;WE DON'T REALLY WANT TO DO THIS
00900		MOVEI C,15	;GET TO LEFT OF PAGE
01000		PUSHJ P,POCHR
01100		MOVE T1,[POINT 7,PGHD]	;GET SET TO PRINT HEADER
01200	HDPR1:	ILDB C,T1	;GET A CHARACTER
01300		JUMPE C,HDPR2	;DONE?
01400		PUSHJ P,POCHR	;PRINT IT
01500		JRST HDPR1	;CONTINUE
01600	HDPR2:	PUSH P,T2	;SAVE CHARACTER COUNT
01700		MOVE T1,CPG	;GET CURRENT PAGE
01800		MOVEI T3,POCHR	;WHERE TO PRINT IT
01900		PUSHJ P,DECPR	;PRINT
02000		AOSG	T1,LOGPG	;SEE IF OK TO PRINT
02100		JRST	HDPR3
02200		MOVEI C,"-"
02300		PUSHJ P,POCHR
02400		PUSHJ P,DECPR
02500	HDPR3:	MOVEI C,15	;NOW RET AND 2 LFDS
02600		PUSHJ P,POCHR
02700		MOVEI C,12
02800		PUSHJ P,POCHR
02900		PUSHJ P,POCHR
03000		MOVEI T1,%LPP	;RESET LINE COUNT
03100		MOVEM T1,LSTCNT
03200		TRNN FL2,SUPN	;IF IN SUPPRESS MODE WE DID NOT SAVE
03300		POP P,T2	;GET BACK COUNT OF CHRS
03400		JUMPE T2,T1POPJ		;IF 0 THEN ALL OK
03500		MOVE T3,T2	;GET COPY
03600		MOVEI C," "	;PRINT CORRECT NUMBER OF SPACES
03700		PUSHJ P,POCHR
03800		SOJG T3,.-1
03900	T1POPJ:	POP P,T1	;RESTORE POINTER
04000		POPJ P,
04100	
     
00100	;ROUTINE TO PRINT IN SIXBIT THE ATOM FOUND IN T2
00200	; T5 CONTAINS THE OUTPUT ROUTINE ADDRS
00300	; T3 CONTAINS THE MAX NUMBER TO OUTPUT
00400	
00500	PRTSX:	MOVEI T1,0	;SET TO RECIEVE A CHR
00600		LSHC T1,6	;GQT ONE
00700		ADDI T1,40	;CONVERT
00800		PUSHJ	P,(T5)		;DUMP A CHAR
00900		SKIPE T2	;ONLY SPACES LEFT?
01000		SOJG T3,PRTSX	;OR COUNT RUN OUT?
01100		POPJ P,		;RETURN
01200	
01300	HDOCH:	IDPB C,ALTP	;PUT CHRS FROM DECPR INTO HEADER
01400		POPJ P,
01500	
01600	HDOSX:	IDPB	T1,C
01700		POPJ	P,
01800	
01900	MONTAB:	ASCII	"JAN"
02000		ASCII	"FEB"
02100		ASCII	"MAR"
02200		ASCII	"APR"
02300		ASCII	"MAY"
02400		ASCII	"JUN"
02500		ASCII	"JUL"
02600		ASCII	"AUG"
02700		ASCII	"SEP"
02800		ASCII	"OCT"
02900		ASCII	"NOV"
03000		ASCII	"DEC"
03100	
03200	>
03300	IFE LSTSW,<
03400	LIST:	NERROR ILC
03500	>
03600	
03700	SUBTTL REPLACE COMMAND
     
00100	;RE-TYPE (REPLACE) COMMAND
00200	
00300	REPLAC:	SETZM	LOLN		;I REALLY SHOULD PUT THIS ELSEWHERE
00400		SETZM	PGDELS		;INIT PAGE DELETED COUNTER
00500		TRNE	FL,READOF	;NOT PERMITTED IN READ ONLY
00600		NERROR	ILC
00700		PUSHJ	P,GET2S		;WHAT DO WE WANT TO REPLACE?
00800		TRZ	FL,LINSN	;CLR FOR NOW
00900		PUSHJ	P,INSINC	;GO GET INCR
01000		PUSHJ	P,DELSUB	;DELETE SOME STUFF
01100		SKIPN	T1,LOLN		;WHERE TO START INSERTING
01200		MOVE	T1,[<ASCII /00100/>!1]
01300		MOVEM	T1,HILN		;SET UP FOR INSERT CODE
01400		MOVE	T2,LOPG
01500		MOVEM	T2,HIPG		;...
01600		SKIPE	PGDELS		;OK IF NONE DELETED
01700		SKIPN	T1,(PNTR)	;OR AT EOF
01800		JRST	REPLC1
01900		CAME	T1,PGMK		;ALSO END OF PAGE
02000		CAMLE	T1,FDELLN	;OR REALLY IN ORDER
02100		JRST	REPLC1
02200		AOS	CPG		;INSERT PAGE MARK TO PREVENT INSANITY
02300		AOS	INPG		;ADJUST PAGE COUNTERS
02400		AOS	BGPG
02500		MOVE	T1,PGMK		;SET UP PAGE MARK TO INSERT
02600		MOVEM	T1,LIBUF
02700		MOVE	T1,PGMKW2
02800		MOVEM	T1,LIBUF+1
02900		SETZM	OCNT		;STUFF FOR INSED
03000		MOVEI	T1,2
03100		MOVEM	T1,NCNT
03200		PUSHJ	P,INSED		;PUT IT IN
03300		PUSHJ	P,FINDN		;CREEP PAST IT
03400		PUSHJ	P,FILLB		;IN CASE OVERFLOW
03500		OUTSTR	[ASCIZ /%Page mark inserted to prevent order error
03600	/]
03700	REPLC1:	PUSHJ	P,DOINS		;LET HIM TYPE FOR A WHILE
03800		JRST	COMND		;RETURN
03900	
04000	;SUBROUTINE TO DELETE THE LINE POINTED TO BY PNTR
04100	
04200	DODEL:	SETZM	NCNT		;NEW IS 0
04300		MOVEM	T1,LDELLN
04400		PUSHJ	P,GETLTH	;OLD LENGTH
04500		MOVEM	T1,OCNT
04600		AOS	DELCNT		;COUNT OF LINES DELETED
04700		SKIPE	FDELLN		;FIRST TIME HERE
04800		JRST	INSED		;NO: GO INSERT AND RETURN
04900		MOVE	T1,LDELLN	;YES: SET UP FIRST LINE ETC.
05000		MOVEM	T1,FDELLN
05100		MOVE	T1,CPG
05200		MOVEM	T1,FDELPG
05300		JRST	INSED		;AND GO INSERT
05400	
05500	SUBTTL COMMON SEARCH ROUTINES FOR F AND S
     
00100	COMMENT ! SOME COMMON ROUTINES FOR SEARCHING FILES!
00200	
00300	COMMENT ! THIS ROUTINE GENERATES CODE FOR FINDING A MATCH
00400	FOR THE FIRST CHARACTER OF A SEARCH STRING. THE POINTER
00500	TO A SET OF BYTE POINTERS FOR SEARCH STRINGS IS IN T1 !
00600	
00700	
00800	
00900	CODSR:	MOVEI T2,CODEBF	;SET UP POINTER TO PLACETO PUT CODE
01000		MOVEI ALTP,0	;THE NUMBER OF THE CURRENT STRING
01100		HRLI T1,-SRNUM	;THE NUMBER OF STRINGS
01200	CODS5:	TLZ FL,NEGF!DEMCHR	;TURN OFF THE  SEEN FLAG
01300		MOVE T3,(T1)	;GET A POINTER
01400		JUMPE T3,ENDCOD	;A ZERO BYTE POINTER IS END OF CODE
01500	READCD:	ILDB C,T3	;PICK UP A CHARACTER IN STRING
01600		JUMPE C,[TLNE FL,DEMCHR	;DID WE REALLY WANT ONE
01700			NERROR ISS	;YES, LOSE
01800			SUBI T2,2	;NO, ALWAYS MATCH
01900			JRST COMXCT]
02000		CAIN C,""	;ARBIRARY NUMBER OF SOMETHING
02100		JRST ARBCD
02200		CAIN C,24	;ANY CHARACTER
02300		JRST ANYCD
02400		CAIN C,""	;NOT THIS ONE
02500		JRST	[TLC FL,NEGF
02600			TLO FL,DEMCHR	;WE REALLY JEED IT
02700			JRST READCD]
02800		CAIN C,"|"	;SEPERATOR
02900		JRST SEPCD
03000		CAIN C,""	;QUOTE THE NEXT CHARACTER
03100		JRST QUOTE
03200	COMLET:	MOVE CS,CTBL(C)	;GET THE MAJIC BITS
03300		TLNN FL,EXCTS1!EXCTSR	;IS THIS AN EXACT SEARCH?
03400		TLNN CS,LETF_16	;OR NOT A LETTER
03500		JRST NORMCR	;YES JUST THE TEST
03600		HRLI C,(<CAIE C,>)	;DO A CAIE
03700		MOVEM C,(T2)
03800		XOR C,[XWD 4000,40]	;CAIN .XOR. CAIE = 4000,,0
03900		MOVEM C,1(T2)
04000		TLNE FL,NEGF	; THAT CHR
04100		JRST GENSKP	;GENERATE A SKIPA
04200	COMXCT:	MOVE C,[XCT JSPR]	;THE CALL TO SEARCH FURTHER
04300		DPB ALTP,[POINT 4,C,12]	;AC FIELD GIVES STRING NUMBER
04400		MOVEM C,2(T2)
04500		ADDI T2,3	;ADVANCE OUTPUT POINTER
04600	ENDSTR:	ADDI ALTP,1	;NEXT STRING
04700		AOBJN T1,CODS5	;IF ANY
04800	ENDCOD:	MOVE C,[JRST COMSRT]	;A RETURN
04900		MOVEM C,(T2)
05000		POPJ P,
     
00100	SEPCD:	MOVE C,[SKIPG CS,CTBL(C)]	;GET BITS
00200		MOVEM C,(T2)
00300		MOVE C,[TRNE CS,NSEPF]	;CHECK FOR %,$,OR .
00400		TRNE FL2,QSEPF		;SEPARATORS?
00500		MOVSI C,(<SKIPA>)	;YES;
00600		MOVEM C,1(T2)
00700		TLNE FL,NEGF	;SKIPA IN NORMAL CASE
00800		JRST COMXCT
00900	GENSKP:	MOVSI C,(<SKIPA>)
01000		MOVEM C,2(T2)
01100		AOJA T2,COMXCT	;SO XCT WILL GO IN RIGHT PLACE
01200	
01300	QUOTE:	ILDB C,T3	;GET NEXT CHR
01400		JUMPE C,[NERROR ISS]	;END OF STRING IS ILLEGAL
01500		JRST COMLET	;TREAT AS NORMAL CHARACTER
01600	
01700	NORMCR:	HRLI C,(<CAIN C,>)	;EXACT OR NOT LETTER
01800		TLNE FL,NEGF
01900		TLC C,4000		;CAIN .XOR. CAIE = 4000,,0
02000	NORMC1:	MOVEM C,(T2)
02100		SOJA T2,COMXCT	;MAKE THE XCT GO IN RIGHT PL@CE
02200	
02300	ANYCD:	MOVE C,[CAIE C,15]	;SPECIAL FOR EOL
02400		TLNE FL,NEGF
02500		TLC C,4000		;CAIN .XOR. CAIE = 4000,,0
02600		JRST NORMC1
02700	
02800	ARBCD:	ILDB C,T3	;GET NEXT
02900		CAIN C,""	;JUST CHECK VALIDITY
03000		JRST ARBCD
03100		CAIN C,""
03200		ILDB C,T3
03300		JUMPE C,[NERROR ISS]	;END OF STRING ERROR
03400		JRST READCD	;LOOK FOR FIRST OTHER CHR
03500	
03600	JSPR:	JSP T1,SRCRET	;CALL CONTINUE SEARCH
03700	
03800	
     
00100	;READ INTHE STRING TO SEARCH FOR
00200	;T3 HAS PLACE TO PUT POINTERS T1 A BYTE POINTER FOR STRINGS
00300	
00400	
00500	SSTRNG:	MOVEI T2,SRBLG	;THE PERMISSIBLE LENGTH
00600		HRLI T3,-SRNUM	;T3 HAS POINTER TO PLACE BYTE POINTERS
00700	SSTR0:	MOVEM T1,SVPT	;SAVE THE POINTER FOR END OF STRING
00800	SSTR1:	PUSHJ P,GNCH	;GET A CHR
00900		CAIN C,200	;ALTMODE TERMINATES
01000		JRST SSTEND
01100		CAIN C,15	;IGNORE RETURNS
01200		JRST SSTR1
01300		CAIN C,12	;LINE FEED IS END OF ONE STRING
01400		JRST SSTR2
01500		IDPB C,T1	;PUT IN OUTPUT STRING
01600		SOJG T2,SSTR1
01700	SSTR3:	RERROR STL	;THE STRING WAS TOO LONG
01800	SSTR4:	HRLZ T1,T3	;ZERO OUT FIRST POINTER
01900		MOVNS T1
02000		ADDI T1,-SRNUM(T3)	;FIND START
02100		SETZM (T1)
02200		JRST COMND
02300	SSTR2:	CAMN T1,SVPT	;NULL STRING?
02400		JRST	[HLRZ C,T3	;FIRST ONE?
02500			CAIE C,-SRNUM	;WELL?
02600			JRST .+1	;NO
02700			MOVEI C,12	;RETURN A LINE FEED
02800			POPJ P,]
02900	RETSTR:	MOVEI C,0	;TERMINATE STRING WITH 0
03000		IDPB C,T1
03100		SOJLE T2,SSTR3
03200		MOVE C,SVPT	;SET UP POINTER
03300		MOVEM C,(T3)
03400		AOBJN T3,SSTR0	;IF ROOM FOR MORE, GET THEM
03500		RERROR TMS	;TOO MANY GIVEN
03600		JRST SSTR4
03700	SSTEND:	CAIN T2,SRBLG	;DID WE SEE ANY?
03800		POPJ P,		;NO, RETURN
03900		MOVEI C,0	;YES, TERMINATE LAST
04000		IDPB C,T1
04100		MOVE T1,SVPT
04200		MOVEM T1,(T3)	;SET POINTER
04300	SSTR5:	AOBJP T3,CPOPJ1	;ZERO OUT OTHER POINTERS
04400		SETZM (T3)
04500		JRST SSTR5
04600	
     
00100	;THE SEARCH ITSELF
00200	
00300	
00400	COMSRC:	MOVEM T2,BUFSAV	;SAVE THE POINTER TO STRINGS
00500		MOVNI T3,1	;THE COUNT OF HOW FAR INTO LINE WE ARE
00600		MOVEI ALTP,1(PNTR)	;SET BYTE POINTER
00700		HRLI ALTP,(<POINT 7,0,6>)
00800		MOVEI C,15	;START WITH A LINE DELIMITER
00900		JRST CODEBF	;GO SCAN
01000	COMSRT:	ILDB C,ALTP	;WE RETURN HERE IF NO MATCH FOR THIS ONE
01100		CAIE C,15	;DONE?
01200		AOJA T3,CODEBF	;NO, GO ON
01300		POPJ P,		;YES, NON-MATCH RETUNR
01400	
01500	SRCRET:	PUSH P,T1	;SAVE THE RETURN ADDRESS
01600		PUSH P,ALTP	;AND THE STRING POINTER
01700		PUSH P,C	;AND THE CHARACTER
01800		LDB T1,[POINT 4,-1(T1),12]	;GET STRING NUMBER
01900		ADD T1,BUFSAV	;POINT TO BYTE POINTER
02000		SKIPN T1,(T1)	;GET IT
02100		ERROR ICN	;THERE SHOULD BE ONE THERE
02200		MOVE T2,[POINT 7,ARBBUF]	;SET UP ARBIT MATCH
02300		MOVEI T4,MXWPL*^D10	;POINTER AND COUNT
02400		SETZM ARBCNT	;THE NUMBER OF ARBITRARY MATCHES SEEN
02500		TLZ FL,ARBITG	;OFF AT START
02600		PUSHJ P,LINMAT	;GO CHECK FOR MATCH
02700		JRST LOSE	;WE LOSE, CONTINUE SCAN
02800		MOVEM ALTP,SRCALP	;POINTER TO END OF STRING
02900		POP P,C	;RESTORE
03000		POP P,ALTP
03100		POP P,T1
03200	CPOPJ1:	AOS (P)	;SKIP RETURN
03300		POPJ P,
03400	LOSE:	POP P,C	;RESTORE
03500		POP P,ALTP
03600		POPJ P,	;AND CONTINUE SEARCH
     
00100	NXTCHR:	CAIN C,12	;WAS THAT LAST OF LINE?
00200		POPJ P,	;YES, LOSE 
00300		ILDB C,ALTP	;NO, TRY NEXT
00400	LINMAT:	PUSHJ P,CHRMAT	;CHECK FOR MATCH
00500		POPJ P,	;NONE, RETURN
00600		CAIE CS,0	;IS SO ALL DONE
00700		JRST NXTCHR	;NO, TRY MORE
00800		JRST CPOPJ1	;SKIP RETURN
00900	
01000	
01100	CHRMAT:	TLZ FL,NEGF!DEMCHR	;NO  SEEN AND CHR CAN BE 0
01200	READCH:	ILDB CS,T1	;GET NEXT
01300		JUMPE CS,MATCH	;END OF STRING IS USUALLY GOOD
01400		CAIN CS,""	;CHEC FOR NEGATE
01500		JRST	[TLC FL,NEGF
01600			TLO FL,DEMCHR	;MUST BE FOLLOWED BY A CHR
01700			JRST READCH]
01800		CAIN CS,"|"	;SEPERATOR?
01900		JRST SEP
02000		CAIN CS,""	;ARBITRARY NUMBER
02100		JRST ARBIT
02200		CAIN CS,24	;ANY?
02300		JRST ANY
02400		CAIN CS,""	;QUOTE NEXT?
02500		JRST	[ILDB CS,T1
02600			JUMPN CS,.+1	;MUST HAVE ONE THERE
02700			NERROR ISS]	;ELSE ILLEGAL
02800		CAMN C,CS	;ARE THEY THE SAME
02900		JRST ISTRU1	;YES, CHECK NEGF
03000		MOVE T5,CTBL(CS)	;GET BITS
03100		TLNN FL,EXCTS1!EXCTSR	;EXACT?
03200		TLNN T5,LETF_16	;OR NOT LET
03300		JRST ISFALS	;NO MATCH
03400		XORI CS,40	;CHECK OTHER CASE
03500		CAMN C,CS
03600		JRST ISTRU1
03700		JRST ISFALS	;LOSE
     
00100	MATCH:	TLNE FL,DEMCHR	;DID WE NEED A CHARACTER THERE?
00200		NERROR ISS	;YES, ILLEGAL STRING
00300		JRST CPOPJ1	;OK RETURN
00400	
00500	ANY:	CAIE C,15
00600		JRST ISTRU	;YES THIS IS ANY CHR
00700	ISFALS:	CAIN C,15	;IS IT A RETURN
00800		AOSA T4	;ADJUST COUNT AND ENTER A NULL STRING
00900		IDPB C,T2	;SAVE IN ARBIT
01000		MOVEI T5,0
01100		IDPB T5,T2
01200		SUBI T4,2	;COUNT THEM
01300		JUMPLE T4,ILFMTR	;THIS LINE MUST HAVE ILLEGAL FORMAT
01400		AOS ARBCNT	;ONE MORE SEEN
01500	ISFAL1:	TLNE FL,NEGF	;WAS NEG FLAG ON?
01600		AOS (P)	;YES, A MATCH
01700		POPJ P,
01800	
01900	SEP:	MOVE T5,CTBL(C)		;GET TABLE ENT
02000		JUMPG T5,ISFALS		;NOT A SEP
02100		TRNN FL2,QSEPF		;CHECK . % $
02200		TRNN T5,NSEPF		;CHECKING - DO WE HAVE ONE?
02300		JRST ISTRU		;NO: SEP
02400		JRST ISFALS		;YES: NOT A SEP
02500	ISTRU:	CAIN C,15
02600		AOSA T4
02700		IDPB C,T2	;SAVE CHR
02800		MOVEI T5,0
02900		IDPB T5,T2
03000		SUBI T4,2
03100		JUMPLE T4,ILFMTR
03200		AOS ARBCNT
03300	ISTRU1:	TLNN FL,NEGF	;NEGATE?
03400		AOS (P)	;NO, MATCH
03500		POPJ P,
03600	
03700	ILFMTR:	MOVE T2,CPG	;GIVE HIM AN ERROR MESSAGE AND PAGE
03800		PUSHJ P,PGPRN	;AND LINE
03900		MOVE T1,(PNTR)
04000		PUSHJ P,OUTSN
04100		NERROR ILFMT
     
00100	ARBIT:	TLNN FL,NEGF	;THIS HAS NO MEANING
00200		TLOE FL,ARBITG	;ARE WE SEEING 
00300		NERROR ISS	;YES, ILLEGAL STRING
00400		PUSH P,T1	;SAVE SEARCH POINTER
00500		MOVEI T5,0	;SET ARBITRARY STRING TO NULL
00600		IDPB T5,T2
00700		SOJLE T4,ILFMTR
00800		AOS ARBCNT
00900		PUSH P,ARBCNT	;SAVE IN CASE WE COME BACK WITH NO MATCH
01000		PUSH P,T2
01100		PUSH P,T4
01200		PUSH P,C
01300	CHKTHS:	TLO FL,DEMCHR	;NEED A CHARACTER NOW
01400		PUSHJ P,READCH	;CALL SELF RECURSIVELY
01500		JRST PROCED	;THIS COULD NOT MATCH JUST SCAN ON
01600		MOVE T2,-3(P)	;RESTORE ARBIT COUNT
01700		MOVEM T2,ARBCNT
01800		MOVE T4,-1(P)	;AND ARBIT CHR COUNT
01900		MOVE T2,-2(P)	;AND POINTER
02000		PUSH P,ALTP	;SAVE CHR POINTER
02100		TLZ FL,ARBITG	;CAN SEE ANOTHER  NOW
02200		PUSHJ P,LINMAT	;A MATCH
02300		JRST RECUR	;NO, TRY FOR ANOTHER OF THAT CHR
02400		SUB P,[XWD 7,7]	;GET ALL THAT JUNK OFF STACK
02500		JRST CPOPJ1 	;AND RETURN TO CALLER OF LINMAT
02600	RECUR:	POP P,ALTP	;GET BACK POINTER
02700		POP P,C	;AND CHR
02800		MOVE T4,-2(P)	;RESTORE COUNT
02900		MOVEM T4,ARBCNT
03000		POP P,T4
03100		POP P,T2	;ALSO CHR COUNTER AND POINTER
03200		DPB C,T2	;PUT IN THAT CHR
03300		MOVEI T5,0	;AN@ TERMINATOR
03400		IDPB T5,T2
03500		SOJLE T4,ILFMTR
03600		PUSH P,T2
03700		PUSH P,T4	;RESAVE
03800		MOVE T1,-3(P)	;RESTORE SEARCH POINTER
03900		ILDB C,ALTP	;GET ANOTHER CHR
04000		PUSH P,C	;SAV IT
04100		TLZ FL,NEGF	;TURN THIS OFF FOR RECURSION
04200		CAIE C,12	;END OF WORLD?
04300		JRST CHKTHS
04400		SUB P,[XWD 5,5]	;RECUCE STACK
04500		POPJ P,	;AND ERROR RET
04600	PROCED:	TLZ FL,ARBITG!NEGF	;JUST GO ON
04700		POP P,C
04800		POP P,T4
04900		POP P,T2
05000		POP P,ARBCNT
05100		POP P,(P)	;GET RID OF EXTRA POINTER
05200		JRST CHRMAT	;CONTINUE MATCH SCANNING
05300	
05400	
05500	SUBTTL FIND COMMAND (SEARCHES)
     
00100	
00200	;DO A SEARCH OF A FILE
00300	
00400	SEARCH:	TLZ FL,ASSMF	;CLEAR ALL FLAGS
00500		SETZM LOLN	;JUST LIKE EVERYONE ELSE HAS TO
00600		SETZM SRCNT	;START WITH ZERO
00700		MOVE T1,[POINT 7,SRBUF]	;SET UP BYTE POINTER
00800		MOVEI T3,SRPNT	;AND POINTER TO BYTE POINTER TABLE
00900		PUSHJ P,SSTRNG	;GET A SEARCH STRING
01000		JRST	[SKIPN SRPNT	;WAS STRING SET?
01100			NERROR NSG	;NO, TELL HIM
01200			CAIN C,12
01300			JRST ASSMD1	;SPECIAL CONTINUE MODE
01400			JRST .+1]	;YES, USE OLD ONE
01500		TLZ FL,NUMSRF!ALTSRF!EXCTSR	;CLEAR FLAGS
01600		PUSHJ P,SCAN	;CHECK FOR WHAT COMES AFTER
01700		TRNN FL,TERMF	;IF TERMINATOR
01800		CAIN C,","	;OR ,
01900		JRST ASSMDT	;SET UP LIMITS SPECIALLY
02000		CAIE C,"!"
02100		CAIN C,":"
02200		JRST ASSMDT	;LET HIM SPECIFY 2ND HALF OF RANGE
02300		PUSHJ P,GET2	;ELSE CALL USUAL LIMIT ROUTINE
02400	SRC4:	MOVE T1,HILN	;SAVE END OF RANGE
02500		MOVEM T1,SRHILN
02600		MOVE T1,HIPG
02700		MOVEM T1,SRHIPG
02800		CAIE C,","	;ANY MORE ARGUMENTS?
02900		JRST SRC1	;NO, CHECK TERMINATOR AND PROCEED
03000		PUSHJ P,SCAN	;YES, SEE WHAT IT IS
03100		TRNN FL,IDF	;SHOULD BE IDENT OR NUMBER
03200		JRST SRC2	;NOT IDENT, CHECK FOR NUMBER OF SEARCHES
03300		MOVS T1,ACCUM	;GET THE IDENT
03400		CAIN T1,(<SIXBIT /N  />)	;AND FIND OUT WHAT IT IS
03500		TLO FL,NUMSRF
03600		CAIN T1,(<SIXBIT /A  />)
03700		TLO FL,ALTSRF	;FIRST CHECK FOR A OR N
03800		TRNE FL,READOF	;IF READ ONLY AND ALTER
03900		TLNN FL,ALTSRF
04000		SKIPA
04100		NERROR ILC	;WE DO NOT PERMIT IT
04200		TLNN FL,NUMSRF!ALTSRF	;WAS IT EITHER?
04300		JRST SRC3	;NO, CHECK E
04400		PUSHJ P,SCAN	;CONTINUE LOOKING
04500		CAIE C,","
04600		JRST SRC1	;NO MORE ARGUMENTS
04700		PUSHJ P,SCAN	;WELL WHAT KIND IS THIS ONE?
04800		TRNN FL,IDF	;MORE IDENTS?
04900		JRST SRC2	;NO, MUST BE NUMBER OF SEARCHES
05000		MOVS T1,ACCUM
05100	SRC3:	CAIE T1,(<SIXBIT /E  />)
05200		NERROR ILC	;NO, HE MUST HAVE MADE A MISTAKE
05300		TLO FL,EXCTSR	;YES, REMEMBER IT
05400		PUSHJ P,SCAN	;AND CHECK FOR MORE
05500		CAIE C,","
05600		JRST SRC1	;NO MORE
05700		PUSHJ P,SCAN	;ONLY ONE THING IT CAN BE NOW
05800	SRC2:	TRNN FL,NUMF
05900		NERROR ILC	;NOPE, LOSE
06000		MOVEM T2,SRCNT	;SAVE AS COUNT OF LINES TO FIND
06100		PUSHJ P,SCAN	;GET TERMINATOR (WE HOPE)
06200	SRC1:	TRNN FL,TERMF	;ALLS WELL THAT ENDS WELL
06300		NERROR ILC	;BUT THIS DOSNT
06400	SRCH1A:	MOVEI T1,SRPNT	;GET POINTER TO STRINGS
06500		PUSHJ P,CODSR	;AND GENERATE CODE
     
00100		MOVE T1,LOPG	;GET SET TO HUNT IT
00200		MOVEM T1,DPG
00300		MOVEM T1,SRPG	;FLAG TO SAY IF WE SHOULD PRINT PAGE
00400		MOVE SINDEX,LOLN
00500		PUSHJ P,FIND
00600		TRZ FL,LINSN	;NO LINES YET
00700		SETZM FNDFLG	;NO MATCHES EITHER
00800	ONSRC:	PUSHJ P,ONMOV	;CHECK RANGE
00900		JRST ENDSRC	;DONE
01000		TLZE FL,ASSMF	;FIRST TIME AND WANT .+1?
01100		JRST	[CAME T1,LOLN	;IS THERE EXACT MATCH?
01200			JRST .+1	;NO, THIS IS .+1
01300			AOS SVCNT	;PRETEND WE DIDNT SEE IT
01400			JRST SRNXT]	;AND TAKE NEXT
01500		TRO FL,LINSN	;WE SAW ONE
01600		CAMN T1,PGMK	;PAGES ARE SPECIAL
01700		JRST SRCPAG	;SO TAKE GOOD CARE OF THEM
01800		MOVEI T2,SRPNT	;POINTER TO STRINGS
01900		PUSHJ P,COMSRC	;GO SEARCH THIS LINE
02000		JRST SRNXT	;LOSER
02100		SETOM FNDFLG	;FOUND!
02200		MOVEM T3,SVCCNT	;SAVE AWAY THE CHARACTER COUNT
02300		MOVE T2,CPG	;GET CURRENT PAGE
02400		TRNN	FL2,NONUMF	;DON'T PRINT IF NONUMBER MODE
02500		CAMN	T2,SRPG		;SEE IF WE SHOULD PRINT IT
02600		SKIPA
02700		PUSHJ	P,PGPRN		;YES
02800		MOVE T2,CPG	;NOW SET IT AS CURRENT
02900		MOVEM T2,CPGL
03000		MOVEM T2,SRPG	;ALSO RESET FLAG
03100		MOVE T2,(PNTR)	;ALSO SET LINE
03200		MOVEM T2,CLN
03300		TLNE FL,ALTSRF	;ARE WE GOING TO EDIT?
03400		JRST SRCALT	;YES, GO SET THINGS UP
03500		TLNE FL,NUMSRF	;DO WE WANT ONLY LINE NUMBERS?
03600		JRST SRCNUM	;YES
03700		MOVE T1,PNTR	;GO PRINT LINE
03800		PUSHJ P,OUTLIN
03900	SRNXTC:	SOSG SRCNT	;HAVE WE FOUND ENOUGH
04000		JRST SRFND	;YES, GIVE UP (WE HAVE SEEN AT LEAST ONE)
04100	SRNXT:	PUSHJ P,FINDN	;GET NEXT LINE TO LOOK A
04200		JRST ONSRC
04300	SRCNUM:	MOVE T1,(PNTR)	;PRINT SEQUENCE NUMBER
04400		PUSHJ P,OUTSN
04500		OCRLF
04600		JRST SRNXTC	;AND GO
04700	ENDSRC:	TRZN FL,LINSN	;DID WE SEE ONE?
04800		NERROR NLN	;NULL RANGE
04900	SRFND:	SKIPN FNDFLG	;FIND ANY?
05000		RERROR SRF	;NO: TELL HIM
05100		JRST COMND
05200	SRCPAG:	AOS CPG	;JUST ADVANCE PAGE COUNTER
05300		JRST SRNXT	;AND PROCEED
     
00100	SRCALT:	PUSHJ P,SETALT	;SET THINGS UP
00200		SKIPLE T2,SVCCNT	;GET COUNT (DO NOT CALL IF 0
00300		PUSHJ P,ALTSP	;SPACE OVER CORRECTLY
00400		PUSHJ P,ALTN1	;GO ALTER
00500		JRST LEVINS	;HE SAID ALTMODE
00600		PUSHJ P,INSED	;INSERT IT
00700		PUSHJ P,FINDN
00800		PUSHJ P,FILLB	;MAKE SURE WE HAVE NOT GOTTEN TOO BIG
00900		MOVE T1,(PNTR)	;GET POINTER BACK
01000		SOSG SRCNT
01100		JRST COMND	;DONE
01200		JRST ONSRC	;GO ON
01300	
01400	ASSMD1:	TROA FL,CNTF	;MARK AS KEEP END OF RANGE
01500	ASSMDT:	TRZ FL,CNTF	;JUST IN CASE
01600		TLO FL,ASSMF	;WE ASSUME .+1
01700		MOVE T1,CLN	;SET THINGS UP FOR . TO INFINITY
01800		MOVEM T1,LOLN
01900		MOVEM T1,HILN	;AS GOOD AS ANYTHING WITH THE PAGE WE WILL
02000		MOVE T1,CPGL	;USE
02100		MOVEM T1,LOPG
02200		TRZE FL,CNTF	;KEEP END?
02300		JRST NOSPC	;YES
02400		CAIE C,":"	;IF A : OR !
02500		CAIN C,"!"
02600		JRST HALFSP	;GET THE SECOND HALF (.+1 TO GIVEN)
02700		MOVSI T1,377777	;GET A LARGE PAGE
02800		MOVEM T1,HIPG
02900		JRST SRC4	;BACK INTO THINGS
03000	
03100	HALFSP:	MOVEM T1,HIPG	;SET TOP AS /.
03200		PUSHJ P,GET2HF	;GET THE SECOND HALF
03300		JRST SRC4	;AND GO
03400	
03500	NOSPC:	MOVE T1,SRHIPG
03600		MOVEM T1,HIPG	;PUT BACK END
03700		MOVE T1,SRHILN
03800		MOVEM T1,HILN
03900		JRST SRCH1A
04000	
04100	LEVINS:	OCRLF			;YES - PUT OUT CRLF
04200		SETZM	ALTSN		;CLEAR FLAG
04300		JRST	COMND
04400	
04500	SUBTTL ALTMODE AND LINE FEED COMMANDS
     
00100	NXTLIN:	PUSHJ	P,NBFIND	;GET CURRENT LINE
00200		CAMN T1,CLN	;DID WE REALLY FIND IT
00300		PUSHJ P,FINDN	;YES, GET NEXT ELSE WE ALREADY HAVE IT
00400		JUMPE T1,[NERROR NLN]	;EOF AND NOT FOUND
00500		OUTCHR [15]
00600		TRNE	FL,DPYF
00700		OUTSTR	[BYTE (7)32,177,177,177]
00800	NXTL1:	CAMN T1,PGMK	;IS THIS A PAGE MARK?
00900		JRST NXTPG	;TREAT SPECIALLY
01000	NBPRNT:	MOVEM T1,CLN	;SET AS CURRENT
01100		MOVE T1,PNTR	;GET THE CURRENT POINTE
01200		TRNE	FL2,NONUMF
01300		TRO	FL2,SUPN
01400		PUSHJ	P,OUTLIN	;AND PRINT
01500		TRZ	FL2,SUPN
01600		JRST	COMND		;DONE
01700	
01800	NXTPG:	AOS T2,CPG	;WE ARE ON THE NEXT PAGE
01900		MOVEM T2,CPGL
02000		TRNN	FL2,NONUMF
02100		PUSHJ P,PGPRN	;TELL HIM
02200		PUSHJ P,FINDN	;FIND A LINE ON IT
02300		JUMPN T1,NXTL1	;THERE IS ONE THERE, PRINT IT
02400		MOVE T1,[ASCII /00000/]	;END OF FILE, SET TO THAT PAGE
02500		MOVEM T1,CLN
02600		JRST COMND
02700	
02800	
02900	
03000	BAKLIN:	PUSHJ	P,NBFIND	;GET CURRENT LINE
03100		TRNE FL,BOF	;IF NOT AT START OF FILE
03200		CAME PNTR,BUFP	;OR NOT AT START OF BUFFER
03300		SKIPA
03400		NERROR NLN
03500		OUTCHR	[15]
03600		TRNN	FL,DPYF
03700		OUTCHR	[12]
03800	BAK1:	PUSHJ P,FINDB
03900		CAME T1,PGMK
04000		JRST	NBPRNT
04100		MOVE T2,CPG
04200		MOVEM T2,CPGL
04300		TRNN	FL2,NONUMF
04400		PUSHJ P,PGPRN
04500		TRNE FL,BOF	;CHECK FOR START OF WORLD
04600		CAME PNTR,BUFP
04700		JRST BAK1	;OK, BACK UP SOME MOR
04800		MOVE T1,[<ASCII /00000/>!1]
04900		MOVEM T1,CLN
05000		JRST COMND
05100	
05200	NBFIND:	MOVE	T1,CPGL		;CURRENT PAGE
05300		MOVEM	T1,DPG
05400		MOVE	SINDEX,CLN	;AND CURRENT LINE
05500		JRST	FIND		;GO FETCH
05600	
05700	SUBTTL COPY AND TRANSFER COMMANDS
     
00100	
00200	TRANS:	TLOA FL,TRANFL	;SET AS TRANSFER COMMAND
00300	COPY:	TLZ FL,TRANFL	;JUST TO MAKE SURE
00400		SETZM HILN	;THIS, TOO MAY PROVE USEFUL
00500		SETZM LOLN	;A GOOD THING TO DO
00600		TRNE FL,READOF	;DO NOT LET HIM IN READ ONLY MODE
00700		NERROR ILC
00800		SETZM SVJRL2	;NO SECOND JOBREL SAVED
00900		PUSHJ P,GET1S	;GET PLACE TO PUT LINES
01000		MOVE T1,HIPG	;STORE IT AWAY FOR LATER
01100		MOVEM T1,DESTPG
01200		MOVE T1,HILN
01300		MOVEM T1,DESTLN
01400		CAIE C,"_"	;...
01500		CAIN C,"="	;DOES HE WANT TO COME FROM ANOTHER FILE?
01600		JRST ALTFIL	;YES
01700		TLZ FL,COPFIL	;NO, MAKE SURE FLAG IS OFF
01800	COPY1:
01900		CAIE C,","	;SHOULD BE COMMA EVEN IF FROM ALTFIL
02000		NERROR ILC	;HE MUST SAY WHERE TO PUT IT
02100		PUSHJ	P,COPYP		;PARSE RANGE ARGS
02200	COPY2:	SETOM NLIN1	;LINES ON FIRST PAGE
02300		SETZM NLIN2	;LINES ON LAST PAGE
02400		TLO	FL2,NORENT	;AND REE-ENTER
02500		TLZ	FL2,RENTF	;IN CASE HE HAS
02600		TLO FL,ISCOP	;SO WE WILL DO SPECIAL RESET IF ERROR
02700		MOVE ALTP,.JBREL##	;SET UP SAVE POINTER
02800		MOVEM ALTP,SVJRL	;SO WE CAN RESET IT
02900		MOVEI T1,2000(ALTP)	;ASK FOR ANOTHER 1K
03000		CORE T1,
03100		NERROR NEC	;ALL OUT, GIVE UP
03200		HRLI ALTP,-2000	;SET COUNT OF HOW MUCH IS THERE
03300		SETZM LSTPG	;HAVE SEEN NO PAGES YET
03400		MOVE T1,LOPG	;LOOK FOR SOURCE
03500		MOVEM T1,DPG
03600		MOVE SINDEX,LOLN
03700		PUSHJ P,FIND
     
00100		TRZ FL,LINSN	;AND NO LINES
00200		TLNN FL,TRANFL	;IS THIS A TRANSFER COMMAND?
00300		JRST GOCOP	;NO, IGNORE ALL THIS SPECIAL STUFF
00400		HRRZM ALTP,STARTD	;SAVE THE START OF DELETED CODE
00500		HRRZM ALTP,ENDD	;AND THE END
00600		MOVE T1,CPG	;GET THE PAGE ON WHICH DELETION STARTS
00700		MOVEM T1,TRANST	;AND SAVE IT
00800		SKIPN -1(PNTR)	;ARE WE AT THE START OF THE BUFFER
00900		TRNN FL,BOF	;AND OF THE WORLD
01000		SKIPA
01100		JRST BEGFIL	;YES, DO NOT LOOK BACK
01200		PUSHJ P,FINDB	;GET THE PREVIOUS LINE
01300		CAMN T1,PGMK	;A PAGE IS SPECIAL
01400		JRST SPCPG
01500		MOVEM T1,BOTLIN	;SAVE IT FOR LATER
01600		PUSHJ P,FINDN	;GO FORWARD AGAIN
01700		JRST GOCOP
01800	SPCPG:	SKIPE LOLN	;DO WE INTEND TO ABSORD THIS ONE
01900		JRST BEGFIS	;MOVE FORWARD AND RECORD
02000		SKIPN -1(PNTR)	;CHECK FOR START OF WORLD AGAIN
02100		TRNN FL,BOF
02200		SKIPA
02300		JRST BEGFIS
02400		PUSHJ P,FINDB	;BACK UP
02500		AOS CPG		;FIX PAGE COUNT
02600		PUSH P,T1	;SAVE THAT LINE
02700		PUSHJ P,FINDN
02800		PUSHJ P,FINDN	;AND GO BACK WHERE WE BELONG
02900		POP P,T1	;GET LINE NUMBER BACK
03000		CAMN T1,PGMK	;THERE'S THAT PAGE AGAIN
03100		JRST BEGFIA
03200		MOVEM T1,BOTLIN	;SAVE LINE NUMBER
03300		JRST GOCOP
03400	BEGFIS:	AOSA CPG
03500	BEGFIA:	AOSA CPG
03600	BEGFIF:	PUSHJ P,FINDN
03700	BEGFIL:	SETOM BOTLIN	;A VERY SMALL NUMBER
03800	GOCOP:	SETZM PGDELS	;TOTAL NUMBER OF PAGES DELETED IS 0
03900		SKIPE LOLN	;DID HE ASK FOR THE WHOLE PAGE
04000		JRST NOISTP	;NO
04100		MOVE T1,PGMK	;YES, PUT IN THE PAGE MARK
04200		MOVEM T1,1(ALTP)
04300		MOVE	T1,PGMKW2	;2ND WORD
04400		MOVEM T1,2(ALTP)
04500		HRRZM ALTP,LSTPG
04600		ADD ALTP,[XWD 2,2]
04700		SETZM NLIN1	;NO LINES ON FIRST PAGE
04800		TLNN FL,TRANFL	;IS THIS A TRANSFER
04900		JRST NOISTP	;NO, START TRANSFER OF DATA
05000		MOVE T1,CPG	;CHECK TO SEE IF WE SHOULD REALLY DELETE
05100		CAIN T1,1	;NOT IF PAGE 1
05200		JRST RSTSTP
05300		PUSHJ P,FINDB	;GET THAT PAGE
05400		SETZM NCNT	;DELETE
05500		MOVEI T1,2
05600		MOVEM T1,OCNT
05700		PUSHJ P,INSED
05800		PUSHJ P,FINDN1	;MAKE SURE WE ARE AT THE LINE WE WERE AT
05900		AOS CPG		;KEEP COUNT STRAIGHT
06000		AOSA PGDELS	;ONE DELETED
06100	RSTSTP:	HRRZM ALTP,STARTD	;RESET START IF NONE DELETED
06200		HRRZM ALTP,ENDD	;RESET END
     
00100	NOISTP:	MOVE T1,(PNTR)	;MAKE SURE WE HAVE THAT JUNK BACK
00200	ONCOPY:	PUSHJ P,ONMOV	;STILL IN RANGE?
00300		JRST ENDCOP	;NO, START INSERTING
00400		TRO FL,LINSN	;WE SAW ONE
00500		CAMN T1,PGMK	;IS IT A PAGE?
00600		JRST MOVPG	;YES, TREAT SPECIAL
00700		AOS	NLIN2		;INCR LINE SEEN
00800	MOVLCT:	MOVE T1,PNTR	;START TRANSFER
00900		MOVE T2,(T1)	;PICK UP FIRST WORD (SEQ NUM)
01000		MOVEM T2,LSTLN	;SAVE FOR INC CALC
01100	TRLIN:	MOVEM T2,1(ALTP)	;PUT LINE AWAY
01200		AOBJP ALTP,RESTCR	;NEED MORE CORE?
01300	TRLIN1:	SKIPN T2,1(T1)	;END OF LING?
01400		JRST NXTLCT
01500		TRNN T2,1
01600		AOJA T1,TRLIN	;NO MOVE NEXT WORD
01700	NXTLCT:	TLNN FL,TRANFL	;IS THIS TRANSFER?
01800		JRST NXTLCP	;NO, DON'T DELETE
01900		HRRZM ALTP,ENDD	;SAVE END OF DELETED TEXT
02000		SETZM NCNT
02100		SUBI T1,-1(PNTR)	;GET LENGTH
02200		MOVEM T1,OCNT
02300		PUSHJ P,INSED
02400		PUSHJ P,FINDN1	;MAKE SURE A LINE IS THERE
02500		SKIPA		;SKIP THE FINDN
02600	NXTLCP:	PUSHJ P,FINDN	;YES, GET NEXT
02700		JRST ONCOPY
02800	
02900	MOVPG:	AOS CPG	;WE ARE ON NEXT PAGE
03000		MOVE T1,NLIN2
03100		SKIPGE NLIN1	;PUT ON FIRST PAGE IF NOT SOME ALREADY THERE
03200		MOVEM T1,NLIN1
03300		SETZM NLIN2
03400		HRRZM ALTP,LSTPG	;SAVE RECORD OF WHERE SEEN
03500		AOS PGDELS	;RECORD ONE MORE PAGE DELETED
03600		JRST MOVLCT	;NOW MOVE IT
03700	RESTCR:	MOVE T2,.JBREL##	;GET END
03800		ADDI T2,2000
03900		CORE T2,	;GET MORE
04000		NERROR NEC
04100		HRLI ALTP,-2000
04200		JRST TRLIN1	;AND CONTINUE
04300	
04400	ENDCOP:	TRNN FL,LINSN	;WERE THERE ANY THERE?
04500		NERROR NLN	;NO LOSE
04600		SETZM 1(ALTP)	;MAKE SURE THERG IS AN END FLAG THERE
04700		TLZE FL,COPFIL	;ARE WE COMMING OFF A FILE
04800		PUSHJ P,RSCOP	;YES, RESET POINTERS
04900		MOVE T1,DESTPG	;LOOK FOR DESTINATION
05000		MOVEM T1,DPG
     
00100		TLNN FL,TRANFL	;IS IT A TRANSFER?
00200		JRST DOINS1	;NO, PUT THE COPIED TEXT IN
00300		SETZM PGINSD	;NO EXTRA PAGE MARK INSERTED YET
00400		SKIPN T2,(PNTR)	;ARE WE AT EOF
00500		JRST NOPGIN	;YES, DO NOT INSERT A PAGE MARK
00600		CAME T2,PGMK	;ALSO NOT IF PAGE MARK
00700		CAMLE T2,BOTLIN	;OR GREATER THAN LINE LEFT OVER
00800		SKIPA
00900		SETOM PGINSD	;WE WILL HAVE TO INSERT ONE
01000	NOPGIN:	MOVN T2,PGDELS	;GET MINUS NUMBER OF PAGES DELETED
01100		SUB T2,PGINSD	;ONE LESS IF A PAGE MARK INSERTED
01200		CAMGE T1,TRANST	;(T1 HAS DEST. PAGE) IF SMALLER THAN START
01300		JRST DOSUB	;EVERYTHING IS OK
01400		CAMN T1,TRANST	;IS IT SAME?
01500		JRST DSEQTR	;SPECIAL CHECK REQUIRED
01600		CAMGE T1,CPG	;INSIDE RANGE DELETED?
01700		NERROR ITD	;LOSE BIG
01800		CAMN T1,CPG	;SAME AS TOP PAGE?
01900		JRST DSEQCP
02000		ADDM T2,DESTPG	;ADJUST PGE WE ARE TO FIND
02100		ADDM T2,DPG
02200	DOSUB:	ADDM T2,CPG	;ADJUST FOR REMOVED PAGES
02300		ADDM T2,INPG
02400		ADDM T2,BGPG
02500		SKIPN PGINSD	;SEE IF WE WANT TO INSERT ONE
02600		JRST DOINS1
02700		MOVE T1,PGMK
02800		MOVEM T1,LIBUF
02900		MOVE	T1,PGMKW2
03000		MOVEM T1,LIBUF+1
03100		SETZM OCNT
03200		MOVEI T1,2
03300		MOVEM T1,NCNT
03400		PUSHJ P,INSED
03500		PUSHJ P,FINDN	;ADVANCE OVER IT
03600		PUSHJ P,FILLB	;IN CASE OF OVERFLOW
03700		OUTSTR [ASCIZ /%Page mark inserted to prevent order error
03800	/]
03900		JRST DOINS1
04000	ALLSAM:	SKIPN LOLN
04100		SKIPE PGINSD	;IF DID NOT DELETE PAGE OR INSERTED ONE
04200		JRST DOSUB	;ALL OK
04300		SKIPE T1,(PNTR)	;ELSE MUST BE IN UPPER PART
04400		CAMN T1,PGMK
04500		NERROR ITD	;THERE IS NO UPPER PART
04600		CAMLE T1,DESTLN
04700		NERROR ITD
04800		SOS T1,DESTPG	;THIS WILL BE ON A LOWER PAGE
04900		MOVEM T1,DPG
05000		JRST DOSUB
     
00100	DSEQTR:	CAMN T1,CPG	;IS IT ALL ON SAME PAGE?
00200		JRST ALLSAM	;YES, SPECIAL CHECKING
00300		SKIPN LOLN	;DID WE START WITH A PAGE
00400		NERROR ITD	;YES, LOSE
00500		SKIPE PGINSD	;WAS THERE A PAGE INSERTED?
00600		JRST DOSUB	;YES, ALL OK
00700		SKIPE T1,(PNTR)	;FIND OUT WHAT THE NEXT LINE IS
00800		CAMN T1,PGMK
00900		JRST DOSUB	;THIS WILL BE OK
01000		CAMG T1,DESTLN	;SEE IF WE ARE IN TROUBLE
01100		NERROR ITD
01200		JRST DOSUB	;OK
01300	DSEQCP:	SKIPE PGINSD	;WAS ONE INSERTED
01400		JRST AOSTRA	;SET PAGE PROPERLY
01500		MOVE T1,DESTLN
01600		CAMG T1,BOTLIN
01700		NERROR ITD
01800		SKIPA T1,TRANST
01900	AOSTRA:	AOS T1,TRANST
02000		MOVEM T1,DESTPG
02100		MOVEM T1,DPG	;ALSO SET THIS
02200		JRST DOSUB
02300	DOINS1:	MOVE SINDEX,DESTLN
02400		PUSHJ P,FIND
02500		PUSH P,T1	;SAVE LINE FOUND
02600		MOVE T1,CPG
02700		CAMN	T1,DESTPG	;PAGES MUST MATCH
02800		JRST	DOINS2
02900		TLNN	FL,TRANFL	;ONLY TRANSFER
03000		NERROR	NSP		;ERROR IF COPY
03100		MOVE	T1,PGMK
03200		MOVEM	T1,LIBUF
03300		MOVE	T1,PGMKW2
03400		MOVEM	T1,LIBUF+1
03500		SETZM	OCNT
03600		MOVEI	T1,2
03700		MOVEM	T1,NCNT
03800		PUSHJ	P,INSED
03900		PUSHJ	P,FINDN
04000		PUSHJ	P,FILLB
04100		AOS	CPG
04200		AOS	INPG
04300		AOS	BGPG
04400		OUTSTR	[ASCIZ /%Text inserted at end of file
04500	/]
04600		MOVE	T1,CPG
04700	
04800	DOINS2:	MOVEM	T1,CPGL		;SET THIS AS CURRENT PAGE
04900		POP	P,T1		;RETRIEVE LINE FOUND
05000		MOVE	T2,[<ASCII /00100/>!1]
05100		MOVEM	T2,CLN		;AND THIS AS CURRENT LINE
05200		MOVEM	T2,SVLNUM
05300		MOVE	ALTP,SVJRL	;POINT TO START OF LINES TO COPY
05400		TLZ	FL,TRANFL	;THIS FLAG NO LONGER NEEDED
     
00100	TWOSET:	SKIPGE	NLIN1		;DID WE SEE ANY PAGE MARKS?
00200		JRST	ONSET		;NO -- JUST NEED ONE INCR
00300		MOVEM	T1,HIGH1	;SAVE THIS FOR LATER
00400		MOVE	T3,NLIN2	;NUMBER OF LINES ON LAST PG
00500		MOVE	T2,[<ASCII /00000/>!1]
00600		MOVE	T1,T2		;COMPUTE CORRECT INCR
00700		PUSHJ	P,GETDIF	;CALL ROUTINE
00800		  JRST	ORDSEC		;ORDER PROB
00900		MOVEM	T1,START2	;PLACE TO START FOR LAST PAGE
01000		SKIPN	SINCR		;DID HE SAY ONE
01100		JRST	[MOVE T1,LSTLN	;LAST LINE SEEN
01200			 CAML T1,(PNTR)	;HOW'S IT LOOK?
01300			 JRST ONST3	;NOT GOOD ENOUGH
01400			 JRST OKINC2]
01500		CAML	T2,SINCR	;SEE WHOSE IS BETTER
01600		JRST	OKINC2		;WE'LL USE HIS
01700	ONST3:	MOVEM	T2,SINCR	;OURS IS BETTER
01800	ONST2:	MOVEM	T2,PRNTO2	;INFOR HIM OF THE CHANGE
01900		OUTSTR	ASCIZ2
02000	
02100	OKINC2:	SKIPG	T3,NLIN1	;CHECK FOR P/M ONLY
02200		JRST	INSL2		;ALL SET FIRST THING IS P/M
02300		MOVE	T1,HIGH1	;RETRIEVE WHAT WE FOUND
02400		MOVE	T2,DESTLN	;WHAT HE WANTED
02500		TLO	T3,(1B0)	;DON'T LOOK AT NEXT LINE
02600		PUSHJ	P,GETDIF
02700		  JRST	ORDCP2		;ORDER PROBLEM WILL FOLLOW
02800		MOVEM	T1,CLN		;SET UP GOOD THINGS
02900		MOVEM	T1,SVLNUM
03000		CAML	T2,FINCR	;WHICH IS BETTER
03100		JRST	INSL2		;HIS
03200		MOVEM	T2,FINCR	;OURS
03300		JRST	ONST1		;TELL HIM WE CHANGED HIS MIND
     
00100	ONSET:	SKIPG	T3,NLIN2	;GO ANYTHING TO WORRY ABT
00200		JRST	INSL2		;NO -- DO OUR WORST
00300		MOVE	T2,DESTLN	;HIS DESIRED PLACE
00400		PUSHJ	P,GETDIF	;SEE WHAT THERE IS TO SEE
00500		  JRST	ORDCOP		;ORDER PROBS
00600		MOVEM	T1,SVLNUM	;SET THE GOOD S--T
00700		MOVEM	T1,CLN
00800		CAML	T2,FINCR	;THE MOMENT OF TRUTH
00900		JRST	INSL2		;THAT CRAFTY FELLOW
01000		MOVEM	T2,FINCR	;TELL HIM HE BLEW IT
01100	ONST1:	MOVEM	T2,PRNTO1	;PUT IN IN PRINT POSITION
01200		OUTSTR	ASCZ1
01300		JRST	INSL2		;HE HAS BEEN TOLD
01400	
01500	ORDCP2:	SKIPA	T2,[ASCII /WAR  /]
01600	ORDCOP:	MOVE	T2,[ASCII /ORDER/]
01700		JRST	ONST1
01800	
01900	ORDSEC:	MOVE	T2,[ASCII /ORDER/]
02000		JRST	ONST2
02100	
02200	;CONVERT INTEGER IN T1 TO SEQ # IN T3
02300	
02400	ASCON:	MOVSI	T3,400000	;WILL BECOME LOW ORDER BIT
02500	ASCO2:	IDIVI	T1,^D10
02600		ADDI	T2,"0"
02700		LSHC	T2,-7
02800		TRNN	T3,1		;HAS IT GOTTEN THERE?
02900		JRST	ASCO2
03000		POPJ	P,
03100	
03200	;CONVERT SEQ # IN T3 TO INTEGER IN T1
03300	
03400	NUMCON:	MOVEI	T1,0
03500		TRZ	T3,1		;GET RID OF LOW ORDER BIT
03600	NUMC1:	MOVEI	T2,0
03700		LSHC	T2,7
03800		IMULI	T1,^D10
03900		ADDI	T1,-"0"(T2)
04000		JUMPN	T3,NUMC1
04100		POPJ	P,
     
00100	INSLN:	MOVE T2,FINCR	;GENERATE NEW SEQUENCE NUMBER
00200		SKIPN T1,SVLNUM	;BUT ONLY IF WE ARE SUPPOSED TO
00300		JRST INSL2
00400		PUSHJ P,ASCIAD
00500		MOVEM T1,SVLNUM	;PUT EITHER NGW OR 0 BACK
00600	INSL2:	SETZM LIBUF	;ZERO OUT PLACE TO PUT LINE
00700		MOVE T1,[XWD LIBUF,LIBUF+1]
00800		BLT T1,LIBUF+MXWPL+1
00900		MOVEI T1,LIBUF	;SET UP OUTPUT POINTER
01000		SKIPN T2,1(ALTP)	;AT END?
01100		JRST INSDON	;FINISHED
01200	INS1:	MOVEM T2,(T1)	;PUT IT AWAY
01300		ADDI ALTP,1	;NEXT
01400		SKIPN T2,1(ALTP)	;CHECK FOR END OF LING
01500		JRST INS2
01600		TRNN T2,1	;BY EITHER METHOD
01700		AOJA T1,INS1	;GO ON WITH TRANSFER
01800	INS2:	SUBI T1,LIBUF-1	;GET COUNT
01900		MOVEM T1,NCNT	;AND SET AS NEW
02000		SETZM OCNT	;OLD IS ZERO
02100		MOVE T1,LIBUF	;GET SEQ NUM
02200		CAMN T1,PGMK	;CHECK FOR PAGE
02300		JRST INSPG	;AND DO SPECIAL
02400		SKIPN T1,SVLNUM	;IF A NON-ZERO NUMBER THEN REPLACE
02500		MOVE T1,LIBUF
02600		MOVEM T1,LIBUF
02700	NOINCR:	MOVEM T1,CLN	;SET AS CURRENV LINE
02800		PUSHJ P,INSED	;INSERT IT
02900		PUSHJ P,FINDN	;GET NEXT
03000		PUSHJ P,FILLB	;AND DUMP IF NEEDED
03100		JRST INSLN	;GO PUT IN MORE
03200	
03300	INSPG:	AOS T3,CPG	;WE ARE ON THE NEXT PAGE
03400		MOVEM T3,CPGL	;SET AS CURRENV
03500		MOVE T1,[<ASCII /00000/>!1]	;SET TO SAY LINE 0
03600		AOS BGPG	;ONE MORE PAGE IN FILE
03700		AOS INPG
03800		SETZM SVLNUM	;DO NOT DO ANY MORE SEQUENCE REPLACEMENT
03900		MOVEI T2,-2(ALTP)	;SINCE WE HAVE ALREADY GONE PAST
04000		CAMN T2,LSTPG	;UNLESS STARTING LAST PAGE
04100		SKIPN T3,SINCR	;ANF SECOND SEQUENCE NUMBER GIVEN
04200		JRST NOINCR
04300		MOVEM T3,FINCR	;SET UP INCREMENT
04400		MOVE	T3,START2	;GET LAST PAGE START
04500		MOVEM	T3,SVLNUM
04600		MOVEM	T1,CLN
04700		PUSHJ	P,INSED		;INSERT IT
04800		PUSHJ	P,FINDN		;TO NEXT
04900		PUSHJ	P,FILLB		;SLURP
05000		JRST	INSL2		;GO DO IT
     
00100	INSDON:
00200	COPDON:	RELEASE ALTDV,0	;JUST FOR GOOD MEASURE
00300		TLZE FL,COPFIL	;ARE WE COPYING FROM A FILE (ERRORS ONLY)
00400		PUSHJ P,RSCOP	;YES, CLEAN UP POINTERS
00500		TLZ FL,ISCOP	;RESET COPY FLAG
00600		TLNN FL,TRANFL	;IF TRANSFER, WE MUST REINSERT
00700		JRST COPD1	;NO
00800		MOVE ALTP,STARTD
00900	REINXT:	MOVEI T1,LIBUF
01000		CAMN ALTP,ENDD
01100		JRST COPD1	;ALL DONE
01200		MOVE T2,1(ALTP)
01300		JRST REINWD
01400	REINS:	MOVE T2,1(ALTP)
01500		CAME ALTP,ENDD
01600		TRNE T2,1
01700		JRST ENDLIN	;DONE WITH THIS LINE
01800	REINWD:	MOVEM T2,(T1)
01900		ADDI T1,1
02000		AOJA ALTP,REINS
02100	ENDLIN:	SETZM OCNT
02200		SUBI T1,LIBUF
02300		MOVEM T1,NCNT
02400		PUSHJ P,INSED	;INSERT LINE
02500		PUSHJ P,FINDN
02600		PUSHJ P,FILLB	;IN CASE OF OVERFLOW
02700		JRST REINXT
02800	COPD1:	SKIPN T1,SVJRL2	;USE THIS IF SET
02900		MOVE T1,SVJRL	;ELSE THIS
03000		CORE T1,	;TO RESTORE PROPER AMOUNT OF CORE
03100		ERROR ICN	;THIS SHOULD NEVER HAPPEN
03200		JRST COMND	;FINISH UP
     
00100	ALTFIL:	TLZE	FL,TRANFL	;GIVE WARNING IF TRANSFER
00200		OUTSTR	[ASCIZ /% WARNING - Copy assumed
00300	/]
00400		PUSHJ P,SCAN
00500		PUSHJ P,READNM
00600		NERROR ILC
00700		MOVE	T1,[TMPBLK,,ALTBLK]
00800		BLT	T1,ALTBKE	;SAVE IN CORRECT PLACE
00900	DONNAM:	MOVE T1,.JBREL##	;SET THINGS UP
01000		MOVEM T1,SVJRL2
01100		ADDI T1,4000	;ASK FOR 1 K FOR BUFFERS
01200		TLO FL,ISCOP	;TELL THE WORLD WHAT WE HAVE DONE
01300		CORE T1,	;IS IT THERE?
01400		NERROR NEC
01500		MOVE T1,SVJRL2	;POINT BUFFERS TO RIGHT PLACE
01600		MOVEM T1,.JBFF##
01700		MOVE	T1,ALTDEV	;GET DEVICE
01800		MOVEM	T1,ALDEVI+1
01900		OPEN	ALTDV,ALDEVI	;DO OPEN
02000		 NERROR	DNA		;MAYBE ITS HEREDITARY
02100		XLOOK	ALTDV,ALTBLK	;LOOK FOR FILE
02200		 NERROR	FNF
02300		INBUF ALTDV,0	;GET BUFFER SPACE
02400		PUSH	P,SAVEN		;TURN OFF AUTO-SAVE
02500		SETZM	SAVEN
     
00100		MOVE T1,.JBREL##
00200		SUBI T1,2*MXWPL+2	;SET UP THE VARIOUS POINTERS
00300		PUSH P,FILPT	;SEE STPT FOR MORE INFO
00400		MOVEM T1,FILPT
00500		MOVEI T1,1
00600		PUSH P,CPGL
00700		MOVEM T1,CPGL
00800		MOVE T1,[<ASCII /00000/>!1]
00900		PUSH P,CLN
01000		MOVEM T1,CLN
01100		MOVE T1,.JBFF##
01200		SETZM (T1)
01300		ADDI T1,1
01400		PUSH P,BUFP
01500		MOVEM T1,BUFP
01600		MOVE T1,.JBREL##
01700		SUB T1,BUFP
01800		MOVE T2,T1
01900		SUBI T2,MXWPL+1
02000		PUSH P,MAXWC
02100		MOVEM T2,MAXWC
02200		ASH T1,-1
02300		PUSH P,HLFWC
02400		MOVEM T1,HLFWC
02500		MOVEI T1,1
02600		PUSH P,CPG
02700		PUSH P,INPG
02800		MOVEM T1,CPG
02900		MOVEM T1,INPG
03000		PUSH P,PNTR
03100		MOVE PNTR,BUFP
03200		PUSH P,SVWD
03300		SETZM SVWD
03400		PUSH P,OLDLIN
03500		SETZM OLDLIN
03600		PUSH P,WC
03700		SETZM WC
03800		MOVSI T1,1
03900		PUSH P,BGPG
04000		MOVEM T1,BGPG
04100		PUSH P,BASICF
04200		SETZM BASICF
04300		SKIPE RSW
04400		JRST	[SETZM RSW
04500			 SETOM SSW	;SET BROWSE MODE ALSO
04600			 SETOM BASICF
04700			 JRST .+1]
04800		MOVE T1,FL	;SAVE SELECTED FLAGS
04900		AND T1,[XWD TECOF+FSTOPF,READOF!BOF!EOF!EOF2!BGSN]
05000		PUSH P,T1
05100		TRZ FL,EOF!EOF2
05200		TRO FL,READOF!BOF
05300		TLZ FL,TECOF
05400		TLO FL,FSTOPF
05500		MOVEM P,COPDL	;SAVE PDL FOR LATER
05600		TLO FL,COPFIL	;WE ARE USING OTHER FILE POINTERS
05700		PUSHJ P,FILLBF
05800		SKIPN SSW
05900		JRST COPY1
     
00100		TRNN FL,TERMF	;MUST END HERE
00200		NERROR ILC
00300		TLO FL,SRCOP	;SET THINGS UP
00400		JRST COMND	;AND GO GET COMMANDS
00500	
00600	DSCOP:	PUSHJ	P,GNCH		;GET NEXT CHAR
00700		ANDI	C,137		;FORCE UPPER
00800		CAIN	C,"Q"		;CHECK FOR SPECIAL
00900		JRST	NOCOP		;YES - DO NOTHING
01000		MOVEM	C,SAVC		;BACK UP SCANNER
01100		PUSHJ	P,SCAN
01200		TRNN	FL,TERMF
01300		NERROR	ILC
01400		OUTSTR	[ASCIZ /Source lines=/]
01500		SETZM	LOLN		;THIS MAY HAVE GOTTEN RESET
01600		SETZM	SAVCHR		;CLEAR THINGS OUT
01700		SETZM	SSW		;FORGET THIS SWITCH
01800		PUSHJ	P,COPYP		;GET SOURCE LINES
01900		TLZ	FL,SRCOP	;TURN OFF FLAG
02000		JRST	COPY2		;CONTINUE
02100	
02200	COPYP:	PUSHJ	P,GET2S		;GO GET PLACE TO FIND LINES
02300		MOVE	T1,INCR		;SEV INCREMENT AS CURRENT
02400		MOVEM	T1,FINCR
02500		SETZM	SINCR		;SET NO SECOND INCREMENT
02600		CAIE	C,","		;CHECK FOR MORE ARGUMENTS
02700		JRST	COPYP1		;NO, LOOK FOR TERMINATOR
02800		PUSHJ	P,SCAN
02900		CAME	T1,[<ASCII /00000/>!1]	;AVOID 0 INCREMENTS
03000		TRNN	FL,NUMF		;SHOULD BE INCREMENT, MUST BE NUMBER
03100		NERROR	ILC
03200		MOVEM	T1,FINCR
03300		PUSHJ	P,SCAN
03400		CAIE	C,","
03500		JRST	COPYP1
03600		PUSHJ	P,SCAN
03700		CAME	T1,[<ASCII /00000/>!1]
03800		TRNN	FL,NUMF
03900		NERROR	ILC
04000		MOVEM	T1,SINCR
04100		PUSHJ	P,SCAN
04200	COPYP1:	TRNN	FL,TERMF
04300		NERROR	ILC		;DID NOT END PROPERLY, LOSE
04400		POPJ	P,		;RETURN
04500	
04600	NOCOP:	PUSHJ	P,SCAN		;CHECK EOL
04700		TRNN	FL,TERMF
04800		NERROR	ILC
04900		TLZ	FL,SRCOP	;TURN OFF COPY
05000		JRST	COPDON
     
00100	RSCOP:	POP P,T2
00200		MOVE P,COPDL	;GET PDL BACK
00300		POP P,T1
00400		TRZ FL,READOF!BOF!EOF!EOF2!BGSN	;RESTORE SELECTED FLAGS
00500		TLZ FL,TECOF!FSTOPF
00600		IOR FL,T1
00700		POP P,BASICF
00800		POP P,BGPG
00900		POP P,WC
01000		POP P,OLDLIN
01100		POP P,SVWD
01200		POP P,PNTR
01300		POP P,INPG
01400		POP P,CPG
01500		POP P,HLFWC
01600		POP P,MAXWC
01700		POP P,BUFP
01800		POP P,CLN
01900		POP P,CPGL
02000		POP P,FILPT
02100		POP P,SAVEN		;RESTORE AUTO-SAVE
02200		JRST (T2)	;NOW RETURN
02300	
02400	COPGET:	SOSG ALTBF+2	;GET A WORD FROM COPY FILE
02500		JRST GETDCT
02600	GETWCT:	ILDB T3,ALTBF+1
02700		JUMPE T3,COPGET
02800		POPJ P,
02900	GETDCT:	INPUT ALTDV,0
03000		STATO ALTDV,760000
03100		JRST GETWCT
03200		STATZ ALTDV,740000
03300		ERROR DIE
03400		TRO FL,EOF
03500		MOVEI T3,0
03600		POPJ P,
03700	
03800	
03900	CKTEC2:	SETSTS ALTDV,1
04000		MOVSI T3,(<POINT 7,0>)
04100		HLLM T3,ALTBF+1
04200		MOVEI T3,5
04300		IMULM T3,ALTBF+2
04400		AOS ALTBF+2
04500		JRST RDTECO
04600	
04700	
04800	SUBTTL SUBSTITUTE COMMAND (REPLACES THINGS)
     
00100	
00200		;ALSO KNOWN AS SUBSTITUTE
00300	SUBST:	TLZ FL,ASSMF	;DO NOT ASSUME ANYTHING YET
00400		TRNE FL,READOF
00500		NERROR ILC
00600		SETZM LOLN	;A GOOD THING
00700		SETZM PARCNT	;ZERO COUNT FOR SEQUENTIAL PARTIALS
00800		HRLOI T1,377777	;SET FOR LOTS
00900		MOVEM T1,RPCNT
01000		MOVE T1,[POINT 7,R1BUF]
01100		MOVEI T3,R1PNT
01200		PUSHJ P,SSTRNG	;THIS CODE IS JUST LIKE SEARCH
01300		JRST	[SKIPE R2PNT	;BOTH STRINGS MUST HAVE BEEN GIVEN
01400			SKIPN R1PNT
01500			NERROR NSG	;ELSE THERE HAS BEEN AN ERROR
01600			CAIN C,12	;CHECK FOR JUST A CRRET
01700			JRST ASBMD1	;AND DO A CONTINUE
01800			JRST NOSTR]	;THERE IS NO STRING
01900		MOVE T1,[POINT 7,R2BUF]	;GET STRING TO REPLACE BY
02000		MOVEI T3,R2PNT
02100		PUSHJ P,SSTRNG
02200		JRST	[CAIN C,12
02300			JRST	[PUSH P,[.]	;SET UP RETURN
02400				JRST RETSTR]	;AND READ MORE (FISRT NULL)
02500			MOVEM T1,R2PNT	;NULL STRING MEANS DELETE
02600			MOVEI T2,0	;SO SET A REAL NULL STRING
02700			IDPB T2,T1
02800			JRST .+1]
02900		SUBI T3,R2PNT	;GENERATE NUMBER OF REPLACEMENT STRINGS
03000		MOVEM T3,RSTRCT	;AND SAVE FOR LATER
03100	NOSTR:	TLZ FL,NOPRN!DECID!EXCTS1	;CLEAR FLAGS
03200		PUSHJ P,SCAN	;AND START LOOKING FOR MORE JUNK
03300		TRNN FL,TERMF	;NOTHING
03400		CAIN C,","	;OR JUST A COMMA
03500		JRST ASBMDT	;THEN SEARCH FROM HERE TO ETERNITY
03600		CAIE C,"!"	;HE ONLY WANTS TO GIVE A STOPPING POINT
03700		CAIN C,":"
03800		JRST ASBMDT
03900		PUSHJ P,GET2	;GO GET A RANGE
04000	REP4:	MOVE T1,HILN	;SAVE FOR POSSIBLE CONTINUE
04100		MOVEM T1,RPHILN
04200		MOVE T1,HIPG
04300		MOVEM T1,RPHIPG
04400		CAIE C,","	;IS THERE MORE?
04500		JRST REP1	;NO
04600		PUSHJ P,SCAN	;SEE WHAT IT IS
04700		TRNN FL,IDF	;POSSIBLY AN IDENT
04800		JRST REP2	;NO MAYBE A NUMBER OF TIMES
04900		MOVS T1,ACCUM
05000		CAIN T1,(<SIXBIT /N  />)
05100		TLO FL,NOPRN	;SET FOR NO PRINTING
05200		CAIN T1,(<SIXBIT /D  />)
05300		TLO FL,DECID	;HE WANTS TO BE ABLE TO DECIDE
05400		TLNN FL,DECID!NOPRN	;IF NEITHER
05500		JRST REP3	;THEN TRY FOR E SWITCH
05600		PUSHJ P,SCAN	;SEE IF THERE IS MORE
05700		CAIE C,","
05800		JRST REP1	;END OF LINE
     
00100		PUSHJ P,SCAN	;LOOK FOR STILL MORE
00200		TRNN FL,IDF
00300		JRST REP2
00400		MOVS T1,ACCUM
00500	REP3:	CAIE T1,(<SIXBIT /E  />)	;IS IT THE EXACT SEARCH SWITCH
00600		NERROR ILC	;NO,LOSAGE
00700		TLO FL,EXCTS1
00800		PUSHJ P,SCAN	;ONE LAST TRY
00900		CAIE C,","
01000		JRST REP1	;GO CHECK TERMINATOR
01100		PUSHJ P,SCAN	;ONLY ONE THING LEFT
01200	REP2:	TRNN FL,NUMF
01300		NERROR ILC	;BUT IT WAS NOT
01400		MOVEM T2,RPCNT	;SAVE IT AWAY
01500		PUSHJ P,SCAN
01600	REP1:	TRNN FL,TERMF	;ALLS WELL THAT ENDS WELL
01700		NERROR ILC	;BUT NOT THIS ONE
01800	REP1A:	MOVEI T1,R1PNT	;GET THE SEARCH CODE
01900		PUSHJ P,CODSR
02000		MOVE T1,LOPG
02100		MOVEM T1,DPG
02200		MOVEM T1,RPPG	;FOR PRINT OUTS
02300		MOVE SINDEX,LOLN
02400		PUSHJ P,FIND	;GET THAT LINE
02500		TRZ FL,LINSN	;NOTHING YET
02600		SETZM FNDFLG	;NO HOW
02700		TLNE	FL2,PDECID
02800		TLO	FL,DECID	;SET IF PERM MODE ON
02900	ONREP:	PUSHJ P,ONMOV	;CHECK FOR STILL IN RANGE
03000		JRST ENDREP	;FINALLY
03100		TLZE FL,ASSMF	;SHOULD WE START WITH .+1
03200		JRST 	[CAME T1,LOLN	;IS IT THE ONE WE ASKED FOR
03300			JRST .+1	;NO, USE IT
03400			AOS SVCNT	;JUST IN CASE A ! TYPE OF RANGE
03500			JRST RPNXT]
03600		TRO FL,LINSN	;THIS LINE IS GOOD ENOUGH
03700		CAMN T1,PGMK
03800		JRST RPPAG	;GO TAKE CARE OF PAGE MARKS
03900		MOVEI T2,R1PNT	;DO THE SEARCH
04000		PUSHJ P,COMSRC
04100		JRST RPNXT
04200		SETOM FNDFLG	;FOUND
04300		SKIPGE T3	;PROTECT AGAINS SPECIAL KILLING TAB
04400		IBP ALTP
04500		PUSH P,T3	;SAVE COUNT OF HOW FAR INTO LINE
04600		MOVE T3,(PNTR)	;SET UP CURRENT LINE
04700		MOVEM T3,CLN
04800		MOVE T3,CPG
04900		MOVEM T3,CPGL
05000		MOVE T2,[XWD LIBUF,LIBUF+1]	;CLEAR IT OUT
05100		SETZM LIBUF
05200		BLT T2,LIBUF+MXWPL+1	;WE WILL DO REPLACE HERE
     
00100		MOVE T2,PNTR	;GET THE POINTER TO THE LINE
00200		MOVE T3,(T2)	;PICK UP THE FIRST WORD
00300		MOVEI T4,LIBUF	;THE PLACE TO PUT IT
00400		JRST SBALT3	;TRANSFER
00500	SBALT2:	SKIPE T3,(T2)
00600		TRNE T3,1	;IS IT THE END OF THE LINE
00700		JRST SBALT1
00800	SBALT3:	MOVEM T3,(T4)	;PUT IT AWAY
00900		ADDI T4,1
01000		AOJA T2,SBALT2
01100	
01200	SBALT1:	SUBI T4,LIBUF	;GET SIZE LINE USED TO BE
01300		MOVEM T4,OCNT
01400		POP P,CCNT	;GET THE NUMBER OF CHRS INTO LINE
01500		SKIPGE CCNT	;MUST BE .GE. 0
01600		SETZM CCNT
01700		SUBI ALTP,(PNTR)	;CONVERT POINTER TO LIBUF
01800		ADD ALTP,[XWD 70000,LIBUF]	;AND BACK UP ONE
01900	NXTRPL:	SETZM PARCNT	;ZERO FOR NEXT REP
02000		LDB T1,[POINT 4,-1(T1),12]	;GET STRING NUMBER
02100		CAMLE T1,RSTRCT	;IS IT LARGER
02200		MOVE T1,RSTRCT	;THEN USE LAST
02300		MOVE T1,R2PNT(T1)
02400		MOVSI T4,70000	;DECREMENT POINTER
02500		ADDM T4,SRCALP
02600	REPSTR:	ILDB C,T1	;GET THE NEXT CHR
02700		JUMPE C,ENDRP	;THE END OF THE REPLACE STRING
02800		CAIN C,""	;DOES HE WANT ONE OF THE PARTIAL THINGS
02900		JRST PARSTR	;YES, GO HANDLE THAT
03000		CAIN C,""	;CHECK FOR QUOTING NEXT CHR
03100		JRST INSQT
03200		CAIN C,""	;SEQUENTIAL PARTIAL
03300		JRST PARORD	;YES, GO HANDLE
03400	PUTSTR:	IDPB C,ALTP	;PUT IN THE REPLACEMENT
03500		AOS C,CCNT	;ADVANCE COUNT
03600		CAIL C,MXWPL*5	;CHECK AGAINST MAX
03700		NERROR LTL	;AND LOSE
03800		JRST REPSTR
03900	ENDRP:	MOVE T3,CCNT	;GET COUNT SO SEARCH CAN GO ON
04000		PUSH P,ALTP	;SAVE REPLACE POINTER
04100		PUSH P,SRCALP	;AND THE END OF INPUT POINTER
04200		MOVE ALTP,SRCALP	;CONTINUE FROM HERE
04300		ILDB T1,SRCALP	;SEE WHAT CHAR WE STOPPED ON
04400		CAIE T1,12	;HAVE WE GONE TOO FAR?
04500		PUSHJ P,COMSRT	;THIS WILL CONTINUE
04600		JRST FINLIN	;ALL DONE WITH MATCHES, FINISH UP
04700		CAIL T3,MXWPL*5	;ARE THERE TOO MANY?
04800		NERROR LTL
04900		POP P,T2
05000	DOMOV:	ILDB C,T2	;MOVE THE CHRS THAT DID NOT MATCH
05100		CAMN T2,ALTP	;HAVE WE GOTTEN TO THE NEXT MATCH
05200		JRST DONMOV	;YES
05300		IDPB C,(P)	;THE BYTE POINTER IS STILL IN THE STACK
05400		JRST DOMOV
05500	DONMOV:	MOVEM T3,CCNT	;PUT THE COUNT BACK IN CORE
05600		POP P,ALTP	;THIS IS NOW THE DEPOSIT POINTER
05700		JRST NXTRPL	;GO DO A REPLACE
     
00100	FINLIN:	POP P,SRCALP	;GET SET TO MOVE TO END
00200		POP P,ALTP
00300		ILDB C,2(P)	;WE JUST HAPPEN TO KNOW ITS STILL THERE
00400		CAIE C,12	;IF SO WE HAVE EATEN A RETURN
00500		JRST ENDFIN	;ALL IS OK
00600	FINL2:	MOVEI C,15
00700		SKIPA	;SO PUT IT IN
00800	ENDFIN:	ILDB C,SRCALP
00900		IDPB C,ALTP
01000		AOS CS,CCNT
01100		CAIL CS,MXWPL*5
01200		NERROR LTL
01300		CAIE C,12
01400		JRST ENDFIN	;DONE WHEN WE SEE THE LINE FEED
01500		MOVEI T1,0	;ZERO OUT REST OF THIS LINE
01600	DOZER:	TLNN ALTP,760000	;POINTER AT END OF LINE?
01700		JRST ZEROD
01800		IDPB T1,ALTP
01900		JRST DOZER
02000	ZEROD:	SUBI ALTP,LIBUF	;MOVEI AC,1-LIBUF(AC)
02100		MOVEI ALTP,1(ALTP)	;GET COUNT
02200		MOVEM ALTP,NCNT
02300		TLNE FL,NOPRN	;DID HE WANT PRINTING SUPRESSED
02400		JRST NOPLIN
02500		MOVE	T2,CPG		;GET CURRENT PAGE
02600		TRNN	FL2,NONUMF	;DON'T PRINT IF NONUMBER
02700		CAMN	T2,RPPG		;OR PAGES MATCH
02800		SKIPA
02900		PUSHJ	P,PGPRN
03000		MOVE	T2,CPG
03100		MOVEM	T2,RPPG		;SET AS CURRENT PAGE
03200		MOVEI T1,LIBUF	;PRINT THE LINE
03300		PUSHJ P,OUTLIN
03400		TLNN FL,DECID	;DOES HE WANT THE OPTION OF SAYING NO
03500		JRST NOPLIN	;NO, INSERT IT
03600	NOVCMD:	INCHRW T1
03700		ANDI T1,177
03800		OCRLF
03900		CAIN T1,177	;DID HE SAY RUBOUT(DO NOT INSERT)?
04000		JRST RPNXT1	;YES, JUST IGNORE THIS LINE
04100		CAIN	T1," "	;SPACE MEANS USE IT
04200		JRST	NOPLIN
04300		ANDI	T1,137	;FORCE UPPER CASE
04400		CAIE	T1,"Q"
04500		CAIN	T1,"E"	;DOES HE WANT OUT
04600		JRST	ENDREP	;YES: QUIT
04700		CAIN T1,"A"
04800		JRST RPALT
04900		CAIN T1,"G"	;GET OUT OF DECIDE MODE
05000		JRST	[TLZ FL,DECID	;LEAVE DECIDE MODE
05100			 JRST NOPLIN]
05200		OUTSTR	[BYTE (7) 77,40,7,0,0]
05300		CLRBFI			;CLEAR HIM OUT
05400		JRST	NOVCMD		;TRY AGAIN
05500	
05600	NOPLIN:	PUSHJ P,INSED	;ANYTHING ELSE IS OK
05700		PUSHJ P,FINDN	;GET NEXT
05800		PUSHJ P,FILLB	;IN CASE IT GOT LONGER
05900		SOSG RPCNT	;SEE IF OUT OF COUNT
06000		JRST COMND
06100		MOVE T1,(PNTR)	;GET POINTER BACK
06200		JRST ONREP
06300	
06400	RPALT:	MOVE T1,OCNT	;SAVE COUNT
06500		ADDI T1,LIBUF	;FAKE OUT SETALT
06600		PUSHJ P,RPSALT
06700		PUSHJ P,ALTN1	;DO ALTER
06800		JRST ENDREP	;QUIT
06900		JRST NOPLINE	;USE IT NOW
     
00100	ASBMD1:	TROA FL,CNTF	;MARK AS KEEP END OF RANGE
00200	ASBMDT:	TRZ FL,CNTF	;JUST IN CASE
00300		TLO FL,ASSMF	;WE ASSUME .+1
00400		MOVE T1,CLN
00500		MOVEM T1,LOLN	;SET FOR HERE TO ETERNITY
00600		MOVEM T1,HILN
00700		MOVE T1,CPGL
00800		MOVEM T1,LOPG
00900		TRZE FL,CNTF	;KEEP END?
01000		JRST NOSPSB
01100		CAIE C,":"	;IF A : OR A !
01200		CAIN C,"!"
01300		JRST HALFSB	;GET THE SECOND HALF (.+1 TO GIVEN)
01400		MOVSI T1,377777	;GET A LARGE PAGE
01500		MOVEM T1,HIPG
01600		MOVEI T1,1	;SET FOR ONLY ONE
01700		MOVEM T1,RPCNT
01800		JRST REP4	;ONWARD
01900	HALFSB:	MOVEM T1,HIPG	;SET TO AS /.
02000		PUSHJ P,GET2HF	;GET THE SECOND HALF
02100		JRST REP4	;AND GO
02200	
02300	NOSPSB:	MOVE T1,RPHIPG
02400		MOVEM T1,HIPG
02500		MOVE T1,RPHILN
02600		MOVEM T1,HILN
02700		JRST REP1A
     
00100	INSQT:	ILDB C,T1	;GET NEXT CHR
00200		JUMPN C,PUTSTR	;MUST NOT BE 0
00300		NERROR IRS	;THIS STRING IS ILLEGAL
00400	
00500	PARSTR:	MOVEI CS,0	;FIND OUT THE NUMBER
00600	PARST1:	ILDB C,T1	;GET A CHR
00700		CAIN C,""	;CHECK FOR END
00800		JRST ENDNUM
00900		CAIL C,"0"	;MUST BE A DIGIT
01000		CAILE C,"9"
01100		NERROR IRS
01200		IMULI CS,^D10	;CONVERT
01300		ADDI CS,-"0"(C)
01400		JRST PARST1
01500	ENDNUM:	CAILE CS,0
01600		CAMLE CS,ARBCNT	;IS IT IN RANGE
01700		NERROR IRS	;NO SUCH PARTIAL STRING
01800		MOVE T4,[POINT 7,ARBBUF]	;START LOOKING FOR IT
01900		SOJLE CS,FNDRST	;STARTS WITH STRING 1
02000	NXTST:	ILDB C,T4
02100		JUMPN C,NXTST	;0 IS END OF A PARTIAL STRING
02200		SOJG CS,NXTST	;LOOK FOR CORRECT STRING
02300	FNDRST:	ILDB C,T4	;NOW INSERT THAT STRING
02400		JUMPE C,REPSTR	;GO FINISH THE REPLACEMENT STRING
02500		IDPB C,ALTP
02600		AOS C,CCNT
02700		CAIL C,MXWPL*5
02800		NERROR LTL
02900		JRST FNDRST
03000	
03100	PARORD:	AOS CS,PARCNT	;GET NEXT PARTIAL
03200		JRST ENDNUM
03300	
03400	RPNXT1:	SOSG RPCNT
03500		JRST RPFND
03600	RPNXT:	PUSHJ P,FINDN
03700		JRST ONREP	;CONTINUE LOOKING AT LINES
03800	
03900	ENDREP:	TRZN FL,LINSN	;WERE THERE ANY?
04000		NERROR NLN
04100	RPFND:	SKIPN FNDFLG	;FIND ANY?
04200		RERROR SRF	;NOPE
04300		JRST COMND	;GO ON
04400	
04500	RPPAG:	AOS CPG	;JUST ADVANCE PAGE COUNTER
04600		JRST RPNXT
04700	
04800	
04900	
05000	
05100	SUBTTL XPAND COMMAND
     
00100	
00200	
00300	XPAND:	SETZM LOLN	;AS USUAL, A GOOD THING
00400		TRNE	FL,READOF	;CHECK R/O
00500		NERROR	ILC
00600		SETZM SSW	;CLEAR SWITCH
00700		PUSHJ P,GET2S	;THE RANGE
00800		CAIE C,","	;SWITCH
00900		JRST XPAND0
01000		PUSHJ P,SCAN
01100		MOVS T1,ACCUM
01200		CAIE T1,(<SIXBIT /S  />)
01300		NERROR ILC
01400		SETOM SSW	;SET TO SUPPRESS TYPEOUT
01500		PUSHJ P,SCAN
01600	XPAND0:	TRNN FL,TERMF
01700		NERROR ILC
01800		TRZ FL,LINSN
01900		MOVE T1,LOPG
02000		MOVEM T1,DPG
02100		MOVE SINDEX,LOLN
02200		PUSHJ P,FIND
02300	XPND1:	PUSHJ P,ONMOV	;STILL IN RANGE?
02400		JRST EXPEND
02500		TRO FL,LINSN
02600		CAMN T1,PGMK	;IGNORE THESE
02700		JRST PAGE
02800		SKIPE SSW	;SUPPRESS?
02900		TRO FL2,SUPN	;YES:
03000		MOVEM T1,CLN
03100		MOVE T1,CPG
03200		MOVEM T1,CPGL	;SET LINE AND PAGE
03300		PUSHJ P,SETALT	;SET THINGS UP
03400		MOVSI T2,1	;A LARGE COUNT
03500		PUSHJ P,ALTSP	;SPACES
03600		TRZ FL2,SUPN	;RESET SWITCH
03700		MOVEI T2,0
03800		PUSHJ P,[PUSHJ P,ALTIN
03900			 PUSHJ P,ALTN1
04000			 JRST LEVINS
04100			 AOS (P)
04200			 POPJ P, ]
04300		JRST LEVINS
04400		PUSHJ P,INSED	;PUT IN CHANGED LINE
04500	EXPND2:	PUSHJ P,FINDN
04600		PUSHJ P,FILLB	;IN CASE OF OVERFLOW
04700		MOVE T1,(PNTR)	;GET BACK NEXT LINE
04800		JRST XPND1
04900	PAGE:	AOS T2,CPG
05000		MOVEM T2,CPGL
05100		PUSHJ P,PGPRN	;SEE ALTER COMMAND
05200		MOVE T1,[<ASCII /00000/>!1]
05300		MOVEM T1,CLN
05400		JRST EXPND2
05500	EXPEND:	TRNN FL,LINSN
05600		NERROR NLN
05700		JRST COMND
05800	SUBTTL JUSTIFY COMMAND
     
00100	IFN JUSTSW,<
00200	JUST:	SETZM LOLN	;AS USUAL
00300		MOVEI	JF,0		;CLEAR FLAGS
00400		TRNE FL,READOF	;BETTER NOT BE READ ONLY
00500		NERROR ILC	;SO TELL HIM
00600		PUSHJ P,GNCH	;GET A CHARACTER
00700		MOVEM	C,SAVC		;IN CASE WE NEED IT
00800		ANDI	C,137		;FORCE UPPER
00900		CAIN C,"R"
01000		TRO	JF,JRFLG	;R FOR RIGHT
01100		CAIN C,"L"
01200		TRO	JF,JLFLG	;L FOR LEFT
01300		CAIN C,"C"
01400		TRO	JF,JCFLG	;C FOR CENTER
01500		CAIN C,"U"	;U FOR JUSTIFY
01600		TRO	JF,JFFLG	;WHICH IS THE ONLY THING WHICH FILLS
01700		CAIN C,"W"		;W FOR WORDS
01800		TRO	JF,JWFLG!JFFLG
01900		TRNN	JF,JRFLG!JLFLG!JCFLG!JFFLG!JWFLG
02000		JRST JOIN	;MUST BE LINE NUMBER FOR JOIN
02100		SETZM	SAVC		;DON'T NEED IT
02200		MOVE T1,RMAR	;CHECK THAT THIS GUY IS LARGEST
02300		CAMLE T1,LMAR
02400		CAMG T1,PMAR
02500		NERROR MAR
02600		PUSHJ P,GET2S	;GET RANGE
02700		TRNN FL,TERMF	;THIS HAD BETTER BE A TERMINATOR
02800		NERROR ILC	;HE REALLY BLEW IT
02900		MOVE T1,LOPG	;GET SET TO FIND LINE
03000		MOVEM T1,DPG
03100		MOVE SINDEX,LOLN
03200		MOVEM SINDEX,LIBUF	;ALSO SET NEW FIRST LINE TO SAME
03300		PUSHJ P,FIND	;FIND IT
03400		PUSHJ P,INITOL	;SET IT UP
03500		MOVEM T1,LIBUF	;SET NEW LINE NUMBER SAME AS OLD
03600		PUSHJ P,INITNL	;AND SET UP THE NEW ONE
03700		SETZM TPNT	;TELL JGET THERE IS NOTHING IN LIBUF2
03800		MOVE T1,LMAR	;SET LEFT MARGIN
03900		TRNE	JF,JFFLG	;IF FILLING
04000		MOVE T1,PMAR	;MAKE THIS START OF PARAGRAPH
04100		SOS T1
04200		MOVEM T1,INDNT	;FOR INDENTATION
04300		MOVEM T1,LINL	;AND LINE LENGTH
     
00100	;THIS IS THE PART THAT GETS A CHARACTER FROM THE OLD LINE
00200	
00300	JGET:	SKIPN TPNT	;IS THERE ANY UNPROCESSED TAIL?
00400		JRST JGET1	;NO, GET A CHARACTER
00500		MOVE T1,ELIN	;ARE WE AT END OF LINE?
00600		CAMN T1,TPNT
00700		JRST JGET2	;YES, START GETTING FROM OLD LINE
00800		ILDB T1,TPNT	;NO, GET A CHARACTER
00900		JRST JPUT	;AND PUT.
01000	JGET2:	SETZM TPNT	;END OF TAIL
01100	
01200	JGET1:	ILDB T1,PNTR	;LOAD A CHARACTER
01300		AOS OCNT1	;STEP CHARACTER COUNT
01400		CAIE T1,15	;IS THIS A CR?
01500		JRST JGET3	;NO,TEST FOR END OF LINE
01600		TRNN	JF,JFFLG	;ARE WE FILLING?
01700		JRST JGET4	;NO, WE'RE THROUGH
01800		MOVEI T1," "	;YES, MAKE IT A BLANK
01900		JRST JPUT	;AND GO PUT
02000	JGET3:	CAIE T1,12	;END OF LINE?
02100		JRST JPUT	;NOT YET, SO GO PUT
02200	JGET4:			;END OF LINE
02300		HRRZ T1,PNTR	;CURRENT WORD IN BUFFER FOR DELETION
02400		SUB T1,OPTR	;- START OF OLD LINE
02500		AOS T1		;+1 = WORD COUNT OF OLD LINE
02600		MOVEM T1,OCNT	;FOR INSED
02700		TRNN	JF,JFFLG	;IF WE ARE NOT FILLING
02800		JRST JGETE	;DO WHAT WE HAVE TO DO
02900		SETZM NCNT	;OTHERWISE WE DELETE OLD LINE
03000		MOVE PNTR,OPTR	;WHICH STARTS  HERE
03100		PUSHJ P,INSED	;USING INSED
03200		PUSHJ P,FINDN1	;MAKE SURE WE`RE AT START OF NEXT ONE
03300		PUSHJ P,INITOL	;DO SETUP ON IT AND CHECK RANGE
03400	JGETF:	ILDB T1,PNTR	;GET FIRST CHARACTER
03500		AOS OCNT1	;STEP CHARACTER COUNT
03600		CAIE T1,11	;IS IT A TAB
03700		CAIN T1,15	;OR CR?
03800		JRST PARA	;YES, START A NEW PARAGRAPH
03900		TRNE	JF,JWFLG	;IF WE ARE DOING A "JW"
04000		CAIE T1," "	;AND A LINE STARTS WITH A SPACE
04100		JRST JPUT
04200		JRST JGETF	;THEN IGNORE IT
04300	JGETE:	MOVE T1,LINL	;LINE LENGTH
04400		MOVEM T1,WRDL	;TO WRDL BECAUSE CR AS BLANK WAS DELETED
04500		MOVEM ALTP,LWRD	;ALSO STORE POINTER TO END OF LINE
04600		CAMLE T1,MAXL	;IF LINE WAS TOO LONG,
04700		RERROR LTL	;TELL HIM SO
04800		PUSHJ P,JSUB	;CLEAN UP NEW LINE AND PUT IT OUT
04900		PUSHJ P,INITOL	;SET UP NEXT LINE
05000		MOVEM T1,LIBUF	;SET NEW LINE NUMBER SAME AS OLD
05100		SETZM TPNT	;NOTHING IN LIBUF2
05200		JRST JGET2	;START MUNCHING
     
00100	;THIS IS THE PART THAT PUTS A CHARACTER INTO THE NEW LINE
00200	
00300	
00400	JPUT:	CAIE T1," "	;IS THIS A BLANK?
00500		JRST JPUTN	;NO, CHECK SOME OTHER STUFF
00600		TRNE	JF,JPER		;IF WE HAVE SEEN A PERIOD OR SOMETHING
00700		TRNN	JF,JBLF		;AND THIS IS NOT THE FIRST BLANK
00800		SKIPA
00900		JRST JPUTN1	;PERMIT IT ANYWAY BUT DON'T TELL ANYONE
01000		TROE	JF,JBLF		;WAS THERE ONE BEFORE IT?
01100		JRST JGET	;YES; WE DON`T WANT IT
01200		TRNN	JF,JWFLG	;IF HE WANTS BLANKS THEN CHECK
01300		TRNN	JF,JFFLG	;ARE WE FILLING?
01400		TRZ	JF,JBLF		;NO, PERMIT AN EXTRA BLANK
01500		AOS WCNT	;STEP WORDCOUNT
01600		MOVE T2,LINL	;GET LENGTH SO FAR
01700		MOVEM T2,WRDL	;AND SAVE IT FOR JSUB
01800		MOVEM ALTP,LWRD	;AND STORE POINTER TO END OF WORD
01900		JRST JPUT1	;THEN PUT BLANKIN BUFFER
02000	JPUTN:	TRZ	JF,JBLF!JPER	;NOT A BLANK
02100		CAIN T1,"."	;IS IT A PERIOD
02200		TRO	JF,JPER
02300		CAIN T1,":"	;OR COLON
02400		TRO	JF,JPER
02500		CAIN T1,"?"	;OR QUESTION MARK
02600		TRO	JF,JPER
02700		CAIN T1,"!"	;OR EXCLAMATION?
02800		TRO	JF,JPER		;IF SO PERMIT EXTRA BLANKS
02900	JPUTN1:	MOVE T2,LINL	;LENGTH SO FAR
03000	JPUT1:	IDPB T1,ALTP	;DEPOSIT CHARACTER
03100		ADD T2,@WTBL	;WIDTH OF CHARACTER
03200		CAIN T1,10	;ADJUST BACK-SPACES
03300		SUBI T1,2
03400		CAIE T1,11	;WAS THAT A TAB?
03500		JRST JPUT2	;NO
03600		TRZE T2,7	;YES.  IF LAST 3 BITS ARE NONZERO
03700		ADDI T2,10	;WE WERN'T AT TAB POSITION
03800		SETZM WCNT	;RESET WORDCOUNT
03900		SETZM LWRD	;LAST WORD LOCATION
04000		MOVEM ALTP,BLIN	;AND LOGICAL BEGINNING OF LINE FOR JSUB
04100		TRNE	JF,JFFLG	;IF FILLING
04200		TRO	JF,JBLF		;DELETE A FOLLOWING BLANK
04300	JPUT2:	MOVEM T2,LINL	;STORE NEW LENGTH
04400		CAMLE T2,MAXL	;ARE WE OVER THE END?
04500		JRST JPUTEL	;YES, END LINE WE ARE NOW ON
04600		CAME ALTP,[POINT 7,LIBUF2+MXWPL,34]	;NO, HAVE WE FILLED BUFFER?
04700		JRST JGET	;NOT YET, GET ANOTHER
04800	JPUTEL:	SKIPE LWRD	;ANY WORDS YET?
04900		JRST JPUTE	;YES, PUT OUT LINE
05000		RERROR LTL	;NO, TELL HIM LINE TOO LONG
05100		MOVE T2,MAXL	;SAY LINE IS LONG ENOUGH
05200		MOVEM T2,WRDL
05300	JPUTE:	TRNE	JF,JFFLG	;UNLESS WE'RE NOT FILLING (IN WHICH CASE THIS IS A MISTAKE)
05400		PUSHJ P,JSUB	;MOVE OUT A NEW LINE, AFTER JUSTIFYING IT
05500		JRST JGET	;THEN GET ANOTHER CHARACTER
     
00100	;THIS PUTS OUT A NEW LINE 
00200	
00300	NLOUT:	MOVEI T1,15	;ADD A CR
00400		IDPB T1,ALTP
00500		MOVEI T1,12	;AND A LF
00600		IDPB T1,ALTP
00700		HRRZ T1,ALTP	;LAST WORD OF LINE
00800		SUBI T1,LIBUF	;-FIRST
00900		AOS T1		;+1=WORDCOUNT
01000		MOVEM T1,NCNT	;FOR INSERTION INTO BUFFER
01100		TRNE	JF,JFFLG	;IF FILLING
01200		SETZM OCNT	;INSERT BEFORE
01300		MOVE PNTR,OPTR	;ELSE REPLACE, THE OLD LINE
01400		PUSHJ P,INSED	;DONE BY INSED
01500		PUSHJ P,FINDN	;FIND OLD LINE
01600		PUSHJ P,FILLB	;AND KEEP FROM LOSING IT
01700		TRNN	JF,JFFLG	;IF NOT FILLING
01800		JRST INITNL	;SET UP NEW LINE ON THE WAY BACK
01900		MOVE T2,INCR	;INCR FOR LINE NUMBERS
02000		MOVE T1,LIBUF	;OLD LINE NUMBER
02100		PUSHJ P,ASCIAD	;ADD TO MAKE NEW ONE
02200		MOVEM T1,LIBUF	;AND STORE IT AWAY
02300		CAMG T1,MAXLN	;TOO HIGH?
02400		JRST NLO2	;NO, EXIT
02500		AOS T1,CPG	;YES, WILL SOON BE ON NEXT PAGE
02600		MOVEM T1,CPGL	;AND LOGICAL PAGE
02700		AOS BGPG	;ADD ONE MORE PAGE
02800		AOS INPG
02900		AOS HIPG
03000		MOVE T1,PGMK	;INSERT PAGEMARK
03100		MOVEM T1,LIBUF	;IN LINE BUFFER
03200		MOVE	T1,PGMKW2	;AND TEXT THEREOF
03300		MOVEM T1,LIBUF+1
03400		SETZM OCNT	;INSERT
03500		MOVEI T1,2	;2 WORDS
03600		MOVEM T1,NCNT
03700		PUSHJ P,INSED	;INTO TEXT FILE
03800		MOVE T2,INCR	;INCR AGAIN
03900		MOVEM T2,LIBUF	;TO MAKE FIRST LINE NUMBER
04000		PUSHJ P,FINDN	;MOVE PAST IT
04100		PUSHJ P,FILLB	;FILL BUFFER TO KEEP FROM LOSING IT
04200		OUTSTR [ASCIZ /%Page mark inserted
04300	/]
04400	NLO2:	MOVE T1,OCNT1	;CHARACTERS PROCESSED SO FAR
04500		MOVEM PNTR,OPTR	;REMEMBER WHERE WE ARE
04600		AOS PNTR	;SKIP LINE NUMBER
04700		HRLI PNTR,(<POINT 7,0>)	;MAKE BYTE POINTER
04800	NLO1:	IBP PNTR	;TO MOVE PNTR BACK
04900		SOJGE T1,NLO1	;TO WHERE WE FOUND IT
05000		JRST INITNL	;THEN SET UP NEW LINE ON WAY BACK
     
00100	;THIS SETS UP A NEW OLD LINE FOR GET
00200	
00300	INITOL:	PUSHJ P,FINDN1	;MAKE SURE WE ARE AT START OF LINE
00400	INITO1:	HRRZM PNTR,OPTR	;SAVE POINTER TO START OF LINE
00500		PUSHJ P,ONMOV	;CHECK RANGE
00600		JRST JSTEND	;FINISHED
00700		CAMN T1,PGMK	;IS IT A PAGEMARK?
00800		JRST INITOP	;YES
00900		MOVEM T1,CLN	;NO, SET CURRENT LINE
01000		MOVE T2,CPG	;AND PAGE
01100		MOVEM T2,CPGL
01200		SETZM OCNT1	;NO CHARACTERS YET
01300		SETZM TCHR	;NOT KNOWN TO BE START OF PARAGRAPH
01400		AOS PNTR	;SKIP LINE NUMBER
01500		HRLI PNTR,(<POINT 7,0>)	;MAKE BYTE POINTER
01600		IBP PNTR	;SKIP INITIAL TAB
01700		POPJ P,		;EXIT
01800	INITOP:			;FOUND A PAGEMARK
01900		TRNE	JF,JFFLG	;ARE WE FILLING?
02000		JRST INITOD	;YES, DELETE IT
02100		AOS T2,CPG	;NO, WE ARE ON NEW PAGE
02200		MOVEM T2,CPGL
02300		PUSHJ P,FINDN	;FIND NEXT LINE
02400		PUSHJ P,FILLB	;HANG ON TO IT
02500		JRST INITO1	;AND SEE WHAT'S THERE
02600	INITOD:	SETZM NCNT	;DELETE PAGEMARK
02700		MOVEI T1,2	;2 WORDS LONG
02800		MOVEM T1,OCNT
02900		PUSHJ P,INSED	;USE INSED AS USUAL
03000		SOS BGPG	;NOW HAVE ONE LESS PAGE
03100		SOS INPG
03200		SOS HIPG
03300		JRST INITOL	;LOOK AT NEXT LINE
03400	INITNL:	SETZM LIBUF+1	;CODE TO ZERO THE LINE BUFFER
03500		MOVE T1,[XWD LIBUF+1,LIBUF+2]
03600		BLT T1,LIBUF+MXWPL+1
03700		MOVE ALTP,[POINT 7,LIBUF2]	;POINT ALTP AT START OF LIBUF2
03800		MOVEI T1,11	;TAB TO START LINE
03900		IDPB T1,ALTP	;SO INSERT IT
04000		MOVEM ALTP,BLIN	;AND SAVE LOGICAL BEGINNING OF LINE
04100		TRO	JF,JBLF		; KEEP FROM INSERTING LEADING BLANKS
04200		TRZ	JF,JPER
04300		MOVE T1,LMAR	;SET LEFT MARGIN
04400		SOS T1		;MARGIN -1 = EXTRA BLANKS
04500		MOVEM T1,LINL	;FOR EXTRA LINE LENGTH
04600		MOVEM T1,INDNT	;AND INDENTATION
04700		SETZB T1,WCNT	;AND THERE ARE NO WORDS YET
04800		SETZM WRDL	;NOR CHARACTERS, FOR THAT MATTER
04900		EXCH T1,LWRD	;RESET POINTER TO LAST WORD
05000		MOVEM T1,TPNT	;BUT SAVE IT TO GET TAIL
05100		POPJ P,	;RETURN
     
00100	;THIS STARTS A NEW PARAGRAPH
00200	
00300	PARA:	MOVEM T1,TCHR	;STORE TERMINATING CHARACTER
00400		SKIPE LWRD	;ANY WORDS YET?
00500		PUSHJ P,JSUB	;YES, GET RID OF OLD LINE
00600		MOVE T1,TCHR	;GET TERMINATOR BACK
00700		SETZM TCHR	;DON'T CONFUSE PEOPLE
00800		SETZM TPNT	;TELL JGET NOTHING REMAINS IN LIBUF2
00900		SETZM INDNT	;IF TAB, NO SPECIAL INDENTATION
01000		SETZM LINL
01100		CAIN T1,11	;IS IT A TAB?
01200		JRST JPUT	;YES, PUT IT IN NEW LINE
01300		PUSHJ P,JSUB	;MUST HAVE BEEN BLANK LINE
01400		MOVE T1,PMAR	;SET PARAGRAPH MARGIN
01500		SOS T1
01600		MOVEM T1,INDNT
01700		MOVEM T1,LINL
01800		JRST JGET	;SO GET NEW CHARACTER
01900	
02000	;THIS FINISHES EVERYTHING UP
02100	
02200	JSTEND:	SETOM TCHR	;FAKE END OF PARAGRAPH
02300		SKIPE LWRD	;ANYTHING LEFT?
02400		PUSHJ P,JSUB	;YES, GET RID OF IT
02500		MOVE PNTR,OPTR	;GET BACK OLD POINTER
02600		MOVE T1,(PNTR)	;GET LINE NUMBER
02700		MOVEM T1,LIBUF	;SAVE NUMBER OF NEXT LINE
02800		PUSHJ P,FINDB	;GET LINE LAST FILLED
02900		MOVEM T1,CLN	;SET IT AS CURRENT LINE
03000		EXCH T1,LIBUF
03100		SKIPE T1	;END OF FILE?
03200		CAMN T1,PGMK	;PAGE MARK NEXT?
03300		JRST COMND	;DON'T WORRY ABOUT ORDER
03400		CAMG T1,LIBUF	;ORDER TROUBLE?
03500		NERROR ORDER	;YES
03600		JRST COMND	;NO, WE'RE THROUGH.
     
00100	;AT LAST!  THE JUSTIFICATION OF ALL THIS STUFF!
00200	
00300	JSUB:	MOVEM ALTP,ELIN	;SAVE END OF LINE FOR GET
00400		MOVE ALTP,[POINT 7,LIBUF+1]	;WHERE TO DEPOSIT
00500		MOVE T4,[POINT 7,LIBUF2]	;WHERE TO LOAD
00600		MOVNS JFLOP	;PUT BLANKS IN OTHER SIDE THIS TIME
00700	JSUB1:	ILDB T1,T4	;GET A CHARACTER
00800		IDPB T1,ALTP	;AND MOVE IT
00900		CAME T4,BLIN	;WAS THAT THE LAST TAB?
01000		JRST JSUB1	;NO, MOVE ANOTHER
01100		SKIPN T5,LWRD	;IF NO WORDS THERE
01200		MOVE T5,ELIN	;THIS IS WHERE TO STOP
01300		SKIPN WRDL	;IF NOTHING IS THERE AT ALL
01400		JRST NLOUT	;PUT OUT BLANK LINE
01500	;NOW WE COMPUTE NUMBER OF BLANKS TO INSERT, IF ANY
01600		SETZM T2
01700		SETZM BPW
01800		SETZM REM
01900		TRNE	JF,JLFLG	;IF LEFT JUSTIFYING,
02000		JRST JSUBM1	;WE DON'T WANT ANY
02100		MOVEI T1," "
02200		MOVE T2,MAXL	;DESIRED LENGTH
02300		SUB T2,WRDL	;-LENGTH WE HAVE = WHAT WE WANT
02400		JUMPE T2,JSUBM1	;IF ZERO, GO MOVE REST OF LINE
02500		IDIV T2,@WTBL	;/WIDTH OF BLANK = BLANKS WE NEED
02600		TRNE	JF,JCFLG	;IF CENTERING
02700		ASH T2,-1	;WE ONLY WANT HALF AS MANY
02800		TRNE	JF,JRFLG!JCFLG	;IF NOT JUSTIFYING BOTH MARGINS
02900		JRST JSUBM1	;GO PUT IN SOME BLANKS
03000		SOSLE WCNT	;IF LESS THAN 2 WORDS
03100		SKIPE TCHR	;OR END OF PARAGRAPH
03200		JRST JSUBM	;DON'T BOTHER
03300		IDIV T2,WCNT	;BLANKS/WORDS
03400		MOVEM T2,BPW	;= BLANKS PER WORD
03500		MOVEM T3,REM	;AND REMAINDER
03600		SKIPL JFLOP
03700		JRST JSUBM
03800		AOS BPW		;EVERY OTHER LINE
03900		SUB T3,WCNT	;WE ADD EXTRA BLANKS
04000		MOVNM T3,REM	;ON THE OTHER SIDE
04100	JSUBM:	SETZM T2
04200	;MOVE LINE, INSERTING BLANKS
04300	JSUBM1:	ADD T2,INDNT	;DO INDENTATION
04400	JSUBM3:	SOJL T2,JSUBM2	;QUIT IF NONE
04500		IDPB T1,ALTP	;ELSE DEPOSIT
04600		SOJGE T2,.-1	;AND TRY AGAIN
04700	JSUBM2:	CAMN T4,T5	;WAS IT THE LAST?
04800		JRST NLOUT	;YES, PUT OUT NEW LINE
04900		ILDB T1,T4	;GET ANOTHER CHARACTER
05000		IDPB T1,ALTP	;DEPOSIT IT
05100		TRNE	JF,JWFLG	;LOOP IF NO BLANK FILL
05200		JRST JSUBM2
05300		SKIPN TCHR	;AT END OF PARAGRAPH WE DO NOT LOOK FOR BANKS
05400		TRNN	JF,JFFLG	;ARE WE LOOKING FOR BLANKS?
05500		JRST JSUBM2	;NO, MOVE ANOTHER
05600	JSUBB:	CAIE T1," "	;YES, IS IT A BLANK?
05700		JRST JSUBBN	;NO
05800		TROE	JF,JBLF		;YES, DID WE JUST SEE ONE?
05900		JRST JSUBM2	;YES, MOVE ANOTHER
06000		MOVE T2,BPW	;NO, GET BLANKS PER WORD
06100		SOSL REM	;IF REMAINDER STILL .GT. 0
06200		ADD T2,JFLOP	;ADD ANOTHER ON ALTERNATE LINES
06300		JRST JSUBM3	;AND PUT THEM IN
06400	JSUBBN:	TRZ	JF,JBLF		;NOT A BLANK
06500		JRST JSUBM2	;GET ANOTHER
06600	
06700	>	;;; END OF INF JUSTSW
06800	SUBTTL JOIN COMMAND
     
00100	IFE JUSTSW,<
00200	JUST:	SETZM	LOLN	;AS USUAL
00300		TRNE	FL,READOF
00400		NERROR	ILC
00500	>
00600	JOIN:	PUSHJ P,GET1S	;GET LINE NUMBER
00700		TRNN FL,TERMF
00800		NERROR ILC
00900		MOVE T1,HIPG
01000		MOVEM T1,DPG
01100		MOVE SINDEX,HILN	;FIND THE CORRECT LINE
01200		PUSHJ P,FIND
01300		MOVE T2,CPG
01400		MOVE T1,(PNTR)
01500		CAMN T2,HIPG
01600		CAME T1,HILN
01700		NERROR NLN
01800		MOVEM T2,CPGL
01900		MOVEM T1,CLN
02000		SETZM LIBUF	;TO ELIMINATE GARBAGE AT END OF LINE
02100		MOVE T1,[XWD LIBUF,LIBUF+1]
02200		BLT T1,LIBUF+MXWPL+1
02300		MOVE T2,PNTR	;GET THE POINTER TO THE LINE
02400		MOVE T3,(T2)	;PICK UP THE FIRST WORD
02500		MOVEI T4,LIBUF	;THE PLACE TO PUT IT
02600		JRST JSALT3	;TRANSFER
02700	JSALT2:	SKIPE T3,(T2)
02800		TRNE T3,1	;IS IT THE END OF THE LINE
02900		JRST JSALT1
03000	JSALT3:	MOVEM T3,(T4)	;PUT IT AWAY
03100		ADDI T4,1
03200		AOJA T2,JSALT2
     
00100	JSALT1:	MOVEI T1,(T4)		;MOVEI T1,-LIBUF(T4)
00200		SUBI T1,LIBUF
00300		MOVEM T1,OCNT
00400		IMULI T1,5	;GET COUNT OF CHRS
00500		SUBI T1,6	;WE WILL HAVE TO FIND THE TRUE END
00600		SUBI T4,2
00700		HRLI T4,(<POINT 7,0,27>)	;SET UP POINTER
00800	FEND1:	ILDB T2,T4
00900		CAIE T2,15
01000		AOJA T1,FEND1
01100		PUSH P,T1
01200		PUSHJ P,FINDN	;GET THE LINE TO JOIN IT TO
01300		CAME T1,PGMK
01400		SKIPN T1
01500		NERROR NNN	;NO LINE THERE TO CONNECT TO
01600		POP P,T2	;COUNT
01700		MOVEI T1,1(PNTR)
01800		HRLI T1,(<POINT 7,0,6>)	;SET TO POINT THERE
01900		ADD T4,[XWD 70000,0]
02000	TRN1:	ILDB T3,T1
02100		IDPB T3,T4
02200		ADDI T2,1
02300		CAIL T2,MXWPL*5+6
02400		NERROR LTL
02500		CAIE T3,12
02600		JRST TRN1
02700		SUBI T1,-1(PNTR)
02800		PUSH P,OCNT
02900		HRRZM T1,OCNT	;SIZE OF OLD SECOND LINE
03000		SETZM NCNT
03100		PUSHJ P,INSED
03200		PUSHJ P,FINDB	;BACK UP
03300		POP P,OCNT	;GET ITS SIZE
03400		SUBI T4,LIBUF-1
03500		HRRZM T4,NCNT
03600		PUSHJ P,INSED
03700		JRST COMND
03800	
03900	SUBTTL INDIRECT COMMAND
     
00100	;INPUT ROUTINE FOR COMMAND FILE
00200	
00300	RDCHAR:	SOSG INDBUF+2		;CHECK EMPTY BUFFER
00400		JRST DOINP		;READ FROM FILE
00500	RDCHR1:	ILDB C,INDBUF+1		;GET A CHAR
00600		JUMPE C,RDCHAR		;SKIP NULLS
00700		MOVE CS,@INDBUF+1	;FETCH WORD
00800		TRNN CS,1		;SEQ BIT
00900		POPJ P,			;NO - RETURN
01000		MOVNI C,5		;SKIP 5 MORE CHARS (TAB INCLUDED)
01100		ADDM C,INDBUF+2
01200		AOS INDBUF+1		;ADJUST BYTE POINTER
01300		CAME CS,PGMK		;PAGE MARK
01400		JRST RDCHAR		;NO -GET NEXT CHAR
01500		MOVNI C,4		;YES- SKIP SOME MORE CHARS
01600		ADDM C,INDBUF+2
01700		MOVSI C,(<POINT 7,0,35>)
01800		HLLM C,INDBUF+1		;ADJUST BYTE POINTER AGAIN
01900		JRST RDCHAR
02000	
02100	DOINP:	IN IND,0
02200		JRST RDCHR1		;AOK
02300		MOVE	T1,SVCCIN	;RETSTORE INPUT ROUTINE
02400		MOVEM	T1,CHIN
02500		TRZ FL2,COMFLF		;ERROR - CLR FLAG
02600		GETSTS IND,C
02700		RELEAS IND,		;GET STATUS AND CLOSE CHL
02800		TRNN C,740000
02900		NERROR CMEND		;EOF
03000		NERROR CMERR		;LOSE BIG
03100	
03200	;HANDLE @ COMMAND - READ COMMANDS FROM FILE
03300	
03400	COMFIL:	TRNE FL2,COMFLF		;TRYING TO NEST?
03500		NERROR  ILC
03600		PUSHJ P,SCAN		;READ FILE NAME
03700		PUSHJ	P,SETNM1	;FETCH FILE SPEC
03800		NERROR	ILC		;ERROR RETURN
03900		MOVE	T1,[TMPBLK,,INDBLK]
04000		BLT	T1,INDBKE
04100		SKIPN	T1,INDDEV	;GET DEVICE IF THERE
04200		MOVSI	T1,'DSK'	;ELSE SUPPLY DEFAULT
04300		MOVEM	T1,INDDVI+1
04400		OPEN IND,INDDVI		;OPEN FILE ETC..
04500		NERROR DNA
04600		XLOOK	IND,INDBLK
04700		NERROR FNF
04800		MOVEI T1,COMBUF		;SETUP BUFFER
04900		MOVEM T1,.JBFF##
05000		INBUF IND,1		;***
05100		MOVE T1,[ASCII /00000/]	;SET UP CMD COUNT
05200		MOVEM T1,COMCNT
05300		TRO FL2,COMFLF
05400		MOVEI	T1,RDCHAR	;SET UP INPUT ROUTINE
05500		EXCH	T1,CHIN		;AND SAVE CURRENT
05600		MOVEM	T1,SVCCIN
05700		JRST COMND
05800	
05900	
06000	
06100	SUBTTL LITERALS
06200	XLIST
06300	LIT		;CLEAR ALL LITERALS
06400	LIST
06500	SUBTTL IMPURE AREA
     
00100	;IMPURE SECTION IS DIVIDED INTO TWO AREAS
00200	;1) DATA WHICH IS SEMI CONSTANT
00300	;2) DATA WHICH IS INITIALLY ZEROED
00400	
00500	DATAB:
00600	IFN RENTSW,< RELOC 0	;SWITCH TO LOW SEG
00700	DATABL:	RELOC
00800		PHASE DATABL>
00900	
01000	
01100	INDEVI:	EXP	14
01200		SIXBIT /DSK/
01300		XWD 0,IBUF
01400	
01500	OUDEVI: EXP	14
01600		SIXBIT /DSK/
01700		XWD OBUF,0
01800	
01900	ALDEVI: EXP	14
02000		SIXBIT /DSK/
02100		XWD 0,ALTBF
02200	
02300	TTDEVI:	EXP	1B0+1
02400		SIXBIT	/TTY/
02500		XWD	0,TTIBH
02600	
02700	INDDVI: EXP	1
02800		SIXBIT /DSK/
02900		XWD 0,INDBUF
03000	
03100	OPTDVI:	EXP	1B0+1
03200		SIXBIT	/DSK/
03300		XWD	0,OPTBHD
03400	
03500	OPTFIL:	SIXBIT	/SWITCH/
03600		SIXBIT	/INI/
03700		EXP	0,0
03800	
03900	IFN EXTEND,<
04000	LSBUFN: 	LSNUM
04100	LSPTR:
04200		I==0
04300	REPEAT LSNUM,< POINT 7,LSBUF+<SRBLG/5+2>*I
04400		I==I+1
04500	>
04600	LSPTT:
04700		I==0
04800	REPEAT LSNUM,< EXP LSPNT+SRNUM*I
04900		I==I+1
05000	>
05100	>
05200	PGMK:	<ASCII /     />!1
05300	PGMKW2:	BYTE (7)15,14,0,0,0
05400	SQBUF:	BLOCK 1
05500		ASCII /	/
05600	IFN LSTSW,<
05700	PGHS:	ASCII /				          	/
05800		ASCII /               /
05900		ASCIZ	/		PAGE /
06000	PGHD:	BLOCK	10
06100	
06200	LPDEVI: EXP	1
06300		SIXBIT /LPT/
06400		XWD LOBUF,0
06500	>
06600	
06700	ERRHD:	EXP	0	;UUOHS COME HERE
06800		JRST ERRHD0
06900	
07000	ASCZ1: ASCII /INC1=/
07100	PRNTO1: EXP	0
07200		ASCIZ /
07300	/
07400	ASCIZ2: ASCII /Inc2=/
07500	PRNTO2: EXP	0
07600		ASCIZ /
07700	/
07800	
07900	;STUFF FOR JUSTIFICATION
08000	
08100	PMAR:		1	;PARAGRAPH INDENTATION
08200	LMAR:		1	;NORMAL INDENTATION (LEFT MARGIN)
08300	RMAR:			;RIGHT MARGIN
08400	MAXL:	EXP	^D69	;OTHERWISE KNOWN AS MAX LINE LENGTH
08500	MAXLN:	<ASCII /99999/>!1	;MAXIMUM LINE NUMBER ON A PAGE
08600	WTBL:	 .+1		;FOR NOW, ALL CHARACTERS HAVE WIDTH 1
08700		 1
08800	JFLOP:		1	;FLIPFLOP FOR INSERTING BLANKS ON L OR R
08900	PAGESZ:	EXP	PGSZ
09000	PLINES:		20	;DEFAULT VALUE FOR P CMD
09100	ESC:		33	;DEFAULT ESCAPE CHAR
09200	COMESS: ASCII /COMMAND # /
09300	COMCNT:  EXP	0
09400		BYTE (7) 15,12
09500	LINOUT:  EXP	0
09600		  ASCIZ ./.
09700	
09800	IFN CCLSW,<
09900	IFN TEMPC,<
10000	T.HEAD:	SIXBIT	/EDS   />
10100	T.IOWD:	XWD	0,CMDBUF-1
10200		EXP	0
10300	
10400	RPGR:	SIXBIT	/SYS/
10500		SIXBIT	/COMPIL/
10600		EXP	0,0,0,0
10700	>
10800	
10900	;CONTROL BLOCK FOR CNTRL C TRAPPING
11000	
11100	CNCBLK:	4,,CNCINT
11200		0,,1B34
11300		0
11400		0
11500	CNCLOK:	-1		;INTERLOCK FOR RE-ENTRANT HANDLING
11600	
11700	IFN RENTSW,< DEPHASE >
11800	DATAE==.-1
11900	
12000	;MACRO TO GENERATE FILE-SPEC BLOCKS
12100	
12200	DEV==0		;DEVICE NAME INDEX (MUST BE A DISK)
12300	NAM==1		;FILE NAME INDEX
12400	EXT==2		;FILE EXTENSION (LH)
12500	PRT==2		;FILE PROTECTION (RH)
12600	COD==3		;ENCRYPTION PSW
12700	PTH==4		;PATH AND PPN
12800	
12900		DEFINE FILDES (F) <
13000		IRP F,<
13100	F'BLK==.
13200	F'DEV:	BLOCK	1
13300	F'NAM:	BLOCK	1
13400	F'EXT:	BLOCK	1
13500	F'PRT==.-1
13600	F'COD:	BLOCK	1
13700	F'PTH:	BLOCK	SFDLVL+1
13800	F'BKE==.-1>>
     
00100	;REST IS RANDOM VARIABLES AND BUFFERS
00200	
00300	IFN RENTSW,< RELOC DATABL+<DATAE-DATAB>+1 >
00400	
00500	ZEROB==.
00600	BAKF:	BLOCK	1	;0 := NOBACKUP , -1 := BAK , +1 := OLD
00700	CREATF:	BLOCK	1
00800	SVWD:	BLOCK	1
00900	SVWD2:	BLOCK	1
01000	SVWD3:	BLOCK	1
01100	TMPT1:	BLOCK	1
01200	DELETF:	BLOCK	1		;NON-ZERO FOR DELETE INPUT
01300	BASICF:	BLOCK	1
01400	UNSEQF:	BLOCK	1
01500	RPGSW:	BLOCK	1
01600	PZBEG==.
01700	IFN CRYPSW,<
01800	S.CRYP: BLOCK	10
01900	CODBUF: BLOCK	5
02000	>
02100	MYPPN:	BLOCK	1
02200	FILDES <ORG,NEW,TMP,ICR,OCR,IND,ALT>
02300	
02400	PZEND==.-1
02500	FILDES <RUN>
02600	XBLOCK:	BLOCK	4		;FOR FILE OPS
02700	PTHADR:	BLOCK	<SFDLVL+4>	;FOR PATH UUO
02800	BUFHD:	BLOCK	1	;POINTER TO START OF EDIT BUFFER
02900	BUFP:	BLOCK	1	;POINTER TO CURRENT LOC IN EDIT BUFFER
03000	SSW:	BLOCK	1
03100	RSW:	BLOCK	1
03200	EDNAM:	BLOCK	1
03300	EDBUF:	BLOCK	1
03400	TMPCF:	BLOCK	1
03500	CORTOP:	BLOCK	1
03600	FILPT:	BLOCK	1
03700	MAXWC:	BLOCK	1	;MAX FULL POINT IN EDIT BUFFER
03800	HLFWC:	BLOCK	1	;HALF FULL POINT IN EDIT BUFFER
03900	CLN:	BLOCK	1	;CURRENT LINE
04000	INCR:	BLOCK	1
04100	CURINS:	BLOCK	1
04200	CPG:	BLOCK	1	;CURRENT PAGE
04300	CPGL:	BLOCK	1	;LOGICAL CURRENT PAGE "/."
04400	IPG:	BLOCK	1	;INSERT PAGE
04500	INPG:	BLOCK	1	;CURRENT INPUT PAGE SEEN
04600	OPG:	BLOCK	1	;COUNT OF PAGES OUTPUT
04700	WC:	BLOCK	1	;WORD COUNT IN EDIT BUFFER
04800	OLDLIN:	BLOCK	1
04900	SSAVEN:	BLOCK	1
05000	SAVEN:	BLOCK	1
05100	SISAVN:	BLOCK	1
05200	ISAVEN:	BLOCK	1
05300	ALTSN:	BLOCK	1	;ALTMODE SEEN FLAG (I&R)
05400	ALTINC:	BLOCK	1	;ALTER MODE I CMD INCR
05500	ALTFLG:	BLOCK	1
05600	CASEBT:	BLOCK	1
05700	BGPG:	BLOCK	1
05800	ACCUM:	BLOCK	1
05900	SVT1E:	BLOCK	1
06000	SVERN:	BLOCK	1
06100	SAVCHR:	BLOCK	1
06200	TECINC:	BLOCK	1
06300	TECFST:	BLOCK	1
06400	TEMINC:	BLOCK	1
06500	REINC:	BLOCK	1
06600	INCST:	BLOCK	1
06700	REFST:	BLOCK	1
06800	ALTCNT:	BLOCK	1
06900	LOGPG:	BLOCK	1
07000	LSTCNT:	BLOCK	1
07100	SVCCNT:	BLOCK	1
07200	SAVC:	BLOCK	1
07300	IFN EXTEND,<
07400	LSHIPG:	BLOCK	1
07500	LSHILN:	BLOCK	1
07600	LSCNT:	BLOCK	1
07700	LSPG:	BLOCK	1
07800	LSBUF:	BLOCK	<SRBLG/5+2>*LSNUM
07900	LSPNT:	BLOCK	SRNUM*LSNUM
08000	>
08100	IFN LSTSW,< LOBUF:	BLOCK	3 >
08200	LIMBO:	BLOCK	1	;LIMBO CHAR AFTER BELL
08300	CHIN:	BLOCK	1	;INPUT PNTR
08400	SVCCIN:	BLOCK	1	;SAVED INPUT ROUTINE FOR @ CMDS
08500	SVPCIN:	BLOCK	1	;SAVED INPUT ROUTINE FOR PARSE
08600	TTOBUF:	BLOCK	^D80/5+1
08700	TTOCNT:	BLOCK	1	;OUTPUT CNTR
08800	TTOPNT:	BLOCK	1	;OUTPUT PNTR
08900	TTIBH:	BLOCK	3	;BUFFER RING HEADER
09000	TTIBUF:	BLOCK	23	;TTY INPUT BUFFER
09100	OBUF:	BLOCK	4	;DISK OUTPUT
09200	IBUF:	BLOCK	4	;DSK INPUT
09300	AUXFIL:	BLOCK	1
09400	PDL:	BLOCK	PDLSIZ+1	;PUSHDOWN LIST
09500	P.TEXT: BLOCK	1
09600	CMDBUF:			;COMMAND BUFFER
09700	LIBUF:	BLOCK	MXWPL+2	;LINE INPUT BUFFER
09800	CRSX:	BLOCK	1	;PLACE FOR CR'S
09900	LIBUF2:	BLOCK	MXWPL+2
10000	IFN LSTSW,< LPTBUF:	BLOCK	203>
10100	SVPT:	BLOCK	1
10200	CODEBF:	BLOCK	4*SRNUM+2
10300	BUFSAV:	BLOCK	1
10400	STRNAM:	BLOCK	5
10500	ARBBUF:	BLOCK	MXWPL*2+1
10600	ARBCNT:	BLOCK	1
10700	SRHIPG: BLOCK	1
10800	SRHILN: BLOCK	1
10900	SRCNT:	BLOCK	1
11000	SRBUF:	BLOCK	SRBLG/5+2
11100	SRPG:	BLOCK	1
11200	SRPNT:	BLOCK	SRNUM
11300	BOTLIN:	BLOCK	1
11400	PGDELS:	BLOCK	1
11500	STARTD:	BLOCK	1	;WHERE TO START TO DELETE ON TRANSFER
11600	ENDD:	BLOCK	1	;WHERE TO END DELETING ON TRANSFER
11700	TRANST:	BLOCK	1
11800	PGINSD:	BLOCK	1
11900	DESTLN:	BLOCK	1
12000	DESTPG:	BLOCK	1
12100	ALTBF:	BLOCK	3
12200	FINCR:	BLOCK	1
12300	SINCR:	BLOCK	1
12400	SVLNUM:	BLOCK	1
12500	LSTPG:	BLOCK	1
12600	SVJRL:	BLOCK	1
12700	SVJRL2:	BLOCK	1
12800	COPDL:	BLOCK	1
12900	HIGH1:	BLOCK	1
13000	NLIN1:	BLOCK	1	;# OF LINES ON FIRST PAGE OF C/T
13100	NLIN2:	BLOCK	1	;# OF LINES ON LAST PAGE OF C/T
13200	START2:	BLOCK	1	;STARTING LINE # FOR LAST PG OF C/T
13300	LSTLN:	BLOCK	1	;LAST LINE # SEEN DURING C/T
13400	PARCNT:	BLOCK	1
13500	RPPG:	BLOCK	1
13600	RPCNT:	BLOCK	1
13700	FNDFLG:	BLOCK	1
13800	R1BUF:	BLOCK	SRBLG/5+2
13900	R2BUF:	BLOCK	SRBLG/5+2
14000	RPHILN:	BLOCK	1
14100	RPHIPG:	BLOCK	1
14200	R1PNT:	BLOCK	SRNUM
14300	R2PNT:	BLOCK	SRNUM
14400	CCNT:	BLOCK	1
14500	RSTRCT:	BLOCK	1
14600	IFN JUSTSW,<
14700	OCNT1:	BLOCK	1
14800	OPTR:	BLOCK	1
14900	LINL:	BLOCK	1
15000	LWRD:	BLOCK	1
15100	WRDL:	BLOCK	1
15200	TPNT:	BLOCK	1
15300	ELIN:	BLOCK	1
15400	TCHR:	BLOCK	1
15500	WCNT:	BLOCK	1
15600	BPW:	BLOCK	1
15700	REM:	BLOCK	1
15800	BLIN:	BLOCK	1
15900	INDNT:	BLOCK	1
16000	>
16100	SVOCIN:	BLOCK	1
16200	OPTION:	BLOCK	1
16300	OPTBHD:	BLOCK	3
16400	OPTBUF:	BLOCK	203
16500	COMBUF:	BLOCK	203
16600	INDBUF:	BLOCK	3
16700	SVALTP:	BLOCK	1
16800	DPG:	BLOCK	1
16900	SVINC:	BLOCK	1
17000	SVCNT:	BLOCK	1
17100	OCNT:	BLOCK	1	;OLD WC FOR INSED
17200	NCNT:	BLOCK	1	;NEW WC FOR INSED
17300	SRCALP:	BLOCK	1
17400	VAR		;IF ANY (I HOPE THIS WORKS)
17500	ZEROE==.-1
17600	HILN:	BLOCK	1	;RESULTS OF RANGE PARSE
17700	HIPG:	BLOCK	1	; <LOLN>/<LOPG>:<HILN>/<HIPG>
17800	LOLN:	BLOCK	1
17900	LOPG:	BLOCK	1
18000	IMPEND:
18100	IFN RENTSW,< RELOC >
18200	
18300	
18400	END STPT