Google
 

Trailing-Edge - PDP-10 Archives - tops20tools_v6_9-jan-86_dumper - tools/sed2/sed1su.mar
There are 5 other files named sed1su.mar in the archive. Click here to see a list.
.TITLE	SED1SU - SED General Utility Subroutines

.LIBRARY /SEDITB.MLB/
.ENABLE DEBUG
.DISABLE GLOBAL
.PSECT CODE,NOWRT,EXE,LONG

FLGDEF		;Define the flag bits
PRMDEF		;  and the SED parameters
TRMDEF		;  and the terminal table offsets
SEQDEF		;  and the command sequences
$CHFDEF		;  and the condition handler definitions
$XABFHCDEF	;  and the fixed header XAB offsets

.EXTERNAL LIB$GET_FOREIGN,SS$_ACCVIO,SS$_CONTINUE,SS$_RESIGNAL

;***************************************************************************
;Subroutine to initialize cursor movement parameters
;Put cursor back into text and mark starting position

MARKUP::BITL	#M_XCT!M_XBN,F1	;Doing an execute?
	BEQL	10$		;No
	RSB			;Yes - no display then
10$:	MOVB	R1,-(SP)	;Save character typed by user
	CMPL	#PARBUF,PARPTR	;Pointing to start of parameter buffer?
	BEQL	20$		;Yes
	MOVB	(SP)+,R1	;No - don't want to allow cursor move
	MOVL	(SP)+,R0	;Restore the stack
	BICL	#M_CMV,F	;Restore the stack
	JMP	LOOP		;Ignore the character
20$:	TSTB	MSGFLG		;/NOMESSAGE set?
	BEQL	30$		;Yes - skip message
	JSB	CMVBTM		;Go to start of bottom line
	JSB	PROTON
	MOVAB	CMVMSG,R1	;Point to start of message
	JSB	PUTSTG		;Put it in the type buffer
	JSB	PROTOF
30$:	JSB	POSCUR		;Re-position the cursor
	MOVB	(SP)+,R1	;Restore user's character
	RSB			;And return

CMVMSG:	.ASCIZ	<62>/ *** Parm defined by cursor movement ***/
.SUBTITLE	Squeeze null characters out of the buffer

;Subroutine to squeeze null characters out of the buffer
;Called during editing, to take care of massive deletions

SQUEZW::MOVL	#SQZVAL,SQZCNT	;Reset number of commands to let go by
	BBC	#V_RDO,F,10$	;Is file read-only?
	RSB			;Yes - do nothing
10$:	PUSHR	#^M<R1>		;Save current command
	MOVL	EN,-(SP)	;Save old end of file
20$:	TSTB	@EN		;Is end pointer pointing to a null byte?
	BNEQ	30$		;No
	SOBGEQ	EN,20$		;Yes - back up over it
30$:	INCL	EN		;Step to next byte, which is zero

	MOVAB	BUFFER,R3	;Get two buffer pointers
	MOVL	R3,R4
	MOVL	DISPTR,R2	;Set up address from display pointer
	CMPL	#BUFFER,R2	;Is display pointer at beginning of file?
	BNEQ	SQUEW1		;No
	MOVL	EN,R2		;Yes - set up end pointer instead

SQUEW1:	CMPL	R3,R2		;Reached display or end pointer?
	BEQL	SQUEW2		;Yes - go do something
	MOVZBL	(R3)+,R1	;Get a byte
	BEQL	SQUEW1		;Null?  Yes - skip over it
	MOVB	R1,(R4)+	;No - save it off
	BRB	SQUEW1		;and get another one

SQUEW2:	CMPL	R2,EN		;Found display pointer?
	BEQL	10$		;No
	MOVL	R4,DISPTR	;Yes - save its new address
	MOVL	EN,R2		;Point to end of buffer
	BRB	SQUEW1		;  and continue

10$:	MOVL	@EN,(R4)	;Save last longword of buffer
	MOVL	R4,EN		;Point to the squeezed-out end of buffer
	MOVL	(SP)+,R2	;Restore old end pointer
	SUBL3	R4,R2,R1	;Compute number of bytes to clear
	SUBL	#2,R1
	PUSHR	#^M<R2,R3,R4,R5>
	MOVC5	#0,4(R4),#0,R1,4(R4) ;Clear from end of file to old end of file
	POPR	#^M<R2,R3,R4,R5>
	BISL	#M_XPB!M_XPL!M_XPC,F ;Pointers are no longer valid
	POPR	#^M<R1>		;Restore current command
	RSB			;Done
.SUBTITLE	Format the file for RMS output

;Subroutine called on exit to remove all nulls and trailing spaces
;from the file and insert RMS line descriptors

TRAILL::MOVL	EN,R4		;Search back from end pointer to make sure
	INCL	R4		;  last line ends with <CRLF>
10$:	MOVZBL	-(R4),R1	;Get a character
	BEQL	10$		;Skip it if it's null
	CMPB	R1,#^X0A	;Is it a linefeed?
	BNEQ	20$		;No
	MOVZBL	-(R4),R1	;Yes - check previous character
	CMPB	R1,#^X0D	;Is it a carriage return?
	BEQL	30$		;Yes
20$:	MOVW	#^X0A0D,@EN	;No - make sure last line ends properly
	ADDL	#4,EN		;Make sure end pointer points past end of file
30$:	CLRW	@EN		;and that the word there is null
	CLRW	MAXLRL		;Clear maximum record length
	MOVAB	BUFFER,CHRPTR	;Add nulls to the beginning of the file to
	SUBL3	#BUFFER,EN,R1	;  allow room for changing file to RMS format
	DIVL3	#10,R1,NUMCHR	;(they will be squeezed out later in this
	MOVL	DISPTR,ADJWRD	;Have MAKNUL adjust the display pointer
	BSBW	MAKNUL		;  routine)
	CMPL	#BUFFER,DISPTR	;Is display pointer at the beginning of the file?
	BEQL	40$		;Yes - don't adjust it (it fouls things up later)
	MOVL	ADJWRD,DISPTR	;No - save the new display pointer
40$:	CLRL	ADJWRD		;Clear the address to be adjusted
	MOVAB	BUFFER+2,R6	;Set up target pointer
	MOVL	R6,R4		;and the source pointer
	MOVAB	BUFFER,R3	;Point to the first byte count word
	CLRL	R2		;Clear pointer to trailing spaces
TRAIL1:	CMPL	R4,DISPTR	;Reached DISPTR?
	BNEQ	10$		;No
	MOVL	R6,DISPTR	;Yes - save adjusted pointer
10$:	MOVZBL	(R4)+,R1	;Get a character
	CMPB	R1,#^A" "	;Is it a control char or a space?
	BLEQ	TRAILX		;Yes - check deeper
TRAIL2:	CLRL	R2		;Forget trailing space pointer
TRAIL3:	MOVB	R1,(R6)+	;Save character
	CMPB	R1,#^O14	;Is the character a form-feed?
	BNEQ	TRAIL1		;No, just go get another one
	BRB	TRAIL5		;Yes - treat it as end of line
TRAILX:	TSTB	R1		;Is it a null?
	BNEQ	10$		;No - ignore the null
	CMPL	R4,EN		;Yes - at end of the buffer?
	BLSS	TRAIL1		;No - ignore the null
	SUBL3	#2,R6,EN	;Yes - save adjusted end pointer
	PUSHR	#^M<R0,R1,R2,R3,R4,R5,R7>
	SUBL3	R6,R4,R7	;Compute number of bytes to clear
	ADDL	#2,R7
	MOVC5	#0,-2(R6),#0,R7,(R6) ;Clear the rest of the buffer
	POPR	#^M<R0,R1,R2,R3,R4,R5,R7>
	RSB			;Then return
10$:	CMPB	R1,#^A" "	;Is it a space?
	BEQL	TRAILS		;Yes
	CMPB	R1,#9		;or a tab?
	BEQL	TRAILS		;Yes - mark current position
	CMPB	R1,#^O15	;Is it a carriage return?
	BEQL	TRAIL4
	BRB	TRAIL2

TRAILS:	TSTL	R2		;Is pointer already saved?
	BNEQ	TRAIL3
	MOVL	R6,R2		;No - save it
	BRB	TRAIL3

TRAIL4:	CMPB	(R4),#^O12	;Is the next character a linefeed?
	BNEQ	TRAIL2		;No - save the character
	INCL	R4		;Yes - step past the line feed
	TSTL	R2		;Were there any trailing spaces?
	BEQL	TRAIL5		;No
	MOVL	R2,R6		;Yes - point after last nonspace
	CLRL	R2
TRAIL5:	SUBL3	R3,R6,R0	;Compute the length of the line
	SUBL	#2,R0
	MOVW	R0,(R3)+	;Save the byte count
	ADDL	R0,R3		;Step to start of next line
	BBC	#0,R3,20$	;At an even address?
	CLRB	(R3)+		;No - step to next even address
20$:	ADDL3	#2,R3,R6	;Build pointer to data of next line
	CMPW	R0,MAXLRL	;Is this the new longest record?
	BLEQ	30$		;No
	MOVW	R0,MAXLRL	;Yes - save the new length
30$:	SUBL3	R6,R4,R1	;Do we need to add more space to the file?
	CMPL	#4,R1
	BLEQ	60$		;No
	PUSHR	#^M<R2,R3,R4,R6> ;Yes - save the registers
	SUBL3	R4,EN,R1	;Compute the amount to add
	DIVL	#10,R1
	CMPL	#4,R1		;But always do at least 4 bytes
	BLSS	40$
	MOVL	#4,R1
40$:	MOVL	R1,NUMCHR
	MOVL	R4,CHRPTR	;Add the nulls at (R4)
	CMPL	R4,DISPTR	;Have we reached DISPTR yet?
	BGTR	50$		;Yes - don't adjust it again
	MOVL	DISPTR,ADJWRD	;Not yet - better adjust it
50$:	BSBW	MAKNUL		;Insert the nulls
	POPR	#^M<R2,R3,R4,R6> ;Restore the registers
	TSTL	ADJWRD		;Were we adjusting the display pointer?
	BEQL	60$		;No
	MOVL	ADJWRD,DISPTR	;Yes - restore the display pointer
	CLRL	ADJWRD
60$:	BRW	TRAIL1		;and go do the next line
.SUBTITLE	Subroutines to Manipulate Pointers

;Subroutine to back up the display pointer by (R4) lines
;Stops, naturally, if it hits the start of buffer. In that case, R4 has
;number of lines not backed up, so subtract R4 from the distance you
;think you went to get the actual distance

BAKDPT::MOVL	DISPTR,R6	;Get pointer to start of screen
	CMPL	R6,#BUFFER	;At start of buffer?
	BNEQ	10$		;No
	RSB			;Yes - nothing to do at all
10$:	CMPB	-1(R6),#^O12	;Is the first character a line feed?
	BNEQ	BAKDP1		;No
	DECL	R6		;Yes - decrement pointer to make routine work
BAKDP1:	MOVZBL	-(R6),R2	;Get previous character
BAKDP2:	CMPB	#^O12,R2	;Linefeed?
	BNEQ	BAKDP1		;No - ignore it
	CMPL	#BUFFER,R6	;At start of buffer?
	BLSS	10$		;No
	MOVAB	BUFFER,DISPTR	;Yes - point to start of buffer
	MOVAB	BUFFER,R6	;And make sure R6 points there too
	DECL	R4		;Adjust count
	RSB			;and return
10$:	MOVZBL	-(R6),R2	;Decrement pointer and get the <CR>
	CMPB	#^O15,R2	;Is it really?
	BNEQ	BAKDP2		;No - it is not the end of the line
	SOBGTR	R4,BAKDP1	;Yes - loop through desired number of rows
	ADDL	#2,R6		;Skip over that last <CRLF>
	MOVL	R6,DISPTR	;Save set-up display pointer
	RSB			;Done

;Subroutine to advance display pointer by (R4) lines
;If end of file found, sets DISPTR to LINROL lines before end of file

ADVDPT::MOVL	DISPTR,R6	;Get display pointer
	BSBW	ADVLPT		;Advance it
	MOVL	R6,DISPTR	;Save it again
	TSTL	R4		;If not hit end,
	BLSS	10$
	RSB			;  then just return
10$:	BBC	#V_XCT,F1,20$	;Executing?
	BRW	XCEERR		;Yes - say finished prematurely
20$:	ADDL2	ROLLS,R4	;Else find distance of real roll
	SUBL2	LINROL,R4
	DECL	R4
	MOVL	R4,ROLLS	;Save real roll
	MOVL	LINROL,R4	;Back up LINROL lines
	BISL	#M_FLG,F	;Set flag for re-display
	BRW	BAKDPT		;and return with that
;Subroutine to make a pointer to the character where the cursor is
;Cannot use R1, since there may be a live character there
;Returns character pointed to by CHRPTR, in R3
;If that character is a tab, returns ptr to it in TABPTR

MAKCPT::BBSC	#V_XPC,F,MAKCK1	;Is character pointer already good?
	BRW	MAKCOK		;Yes - check for tab (may come back to MAKCK1)
MAKCK1::BBCC	#V_XPL,F,MAKCP0	;Is the line pointer good?
	BSBW	MAKLPT		;No - make it first

MAKCP0:	MOVL	LINPTR,CHRPTR	;Get line pointer as starting character pointer
	ADDL3	R8,SL,R2	;Get column to move to (including slide offset)
	BEQL	MAKCP2		;If zero, just check for a tab
MAKCP1:	CMPL	EN,CHRPTR	;At end of usable buffer?
	BNEQ	10$		;No
	BRW	MAKCCR		;Yes - add a few spaces
10$:	MOVZBL	@CHRPTR,R3	;Get a character
	INCL	CHRPTR
	TSTB	R3		;Ignore if null
	BEQL	MAKCP1
	CMPB	#^O15,R3	;Carriage return?
	BNEQ	20$		;Yes - need to extend line
	BRW	MAKCEL		;Yes - need to extend line
20$:	CMPB	#^O11,R3	;Tab?
	BEQL	MAKCTB		;Yes - need to use the right number of spaces
MKCP1A:	SOBGTR	R2,MAKCP1	;Loop thru desired number of columns
MAKCP2:	MOVL	CHRPTR,R2	;Done - see what character is pointed to
MKCP2A:	CMPL	R2,EN		;At end of buffer?
	BNEQ	10$		;No
	MOVB	#^O15,@EN	;Yes - need a final <CRLF>
	INCL	EN
	MOVB	#^O12,@EN
	INCL	EN
	RSB
10$:	MOVZBL	(R2)+,R3
	BEQL	MKCP2A		;Skip if null
	CMPB	#^O11,R3	;If it's a tab, set up counts and return
	BEQL	20$
	RSB			;Else just return
20$:	SUBL3	#1,R2,TABPTR	;Save pointer to tab
	ADDL3	R8,SL,R2	;Find negative how long this tab should be
	BICL	#^C7,R2
	SUBL2	#^O10,R2
	MNEGL	R2,TABSIZ	;Save length of tab
	CLRL	TABSPC		;Want no spaces to left of tab
	RSB			;Now return
;Here when tab found. Jump the correct number of spaces
;If desired position is within the tab, point to start of tab

MAKCTB:	ADDL3	R8,SL,R3	;Find negative how long this tab should be
	SUBL2	R2,R3
	BICL	#^C7,R3
	SUBL	#8,R3
	BICL	#7,TABSPC
	BICL3	#^C7,R2,R0
	ADDL2	R0,TABSPC
	MNEGL	R3,TABSIZ
	ADDL2	R3,R2		;Move over that many positions
	MOVZBL	#9,R3		;Get the tab back
	TSTL	R2
	BLEQ	10$
	BRW	MAKCP1		;O.K. if still more to go
10$:	BNEQ	20$
	BRW	MAKCP2		;or jump if counted out exactly
20$:	DECL	CHRPTR		;Back pointer up to the tab
	MOVL	CHRPTR,TABPTR
	MOVL	CHRPTR,R2
	RSB			;Then done

;Here if character pointer is O.K. - recalculate if it points to a tab

MAKCOK:	MOVL	CHRPTR,R2	;Done - see what character is pointed to
5$:	CMPL	EN,R2		;At end of buffer?
	BNEQ	10$
	MOVB	#^O15,(R2)+	;Yes, need a final <CRLF>
	MOVB	#^O12,(R2)+
	MOVL	R2,EN
	BRW	MAKCK1
10$:	MOVZBL	(R2)+,R3
	BEQL	5$		;Skip if null
	CMPB	#^O15,R3	;Get a <CR>?
	BNEQ	20$		;No
	BBC	#V_INS,F,15$	;Yes - want to insert if cursor out of range?
	BRW	MAKCK1		;Yes - re-calculate cursor pointer
15$:	RSB			;No - return from MAKCPT
20$:	CMPB	#9,R3		;Tab?
	BNEQ	15$		;No - return from MAKCPT
	BRW	MAKCK1		;Else re-do character pointer
;Here if carriage return is found.  If next character is line feed,
;then it is a true end of line.  If not, it's just another character

MAKCEL:	MOVL	R2,-(SP)	;Save the character pointer
	MOVL	CHRPTR,R2
10$:	MOVZBL	(R2)+,R3	;Get the next character
	BNEQ	20$		;If non-null, check some more
	CMPL	EN,R2		;If null and end of the buffer,
	BNEQ	10$
	MOVL	(SP)+,R2	;Treat it as end of line
	MOVZBL	#^O15,R3	;Restore the original character
	BRB	MAKCCR
20$:	MOVL	(SP)+,R2	;Restore R2
	CMPB	#^O12,R3	;Is it line feed?
	BEQL	30$		;Yes
	MOVZBL	#^O15,R3	;No - restore the original character
	BRW	MKCP1A		;and treat it as just another character
30$:	MOVZBL	#^O15,R3	;Restore the original character
;	BRB	MAKCCR		;and fall into end of line routine

;Here if end of line found, but not enough characters
;If flag INS is set, add spaces to the line, then point beyond them
;Else just point to the <CR>

MAKCCR:	BBC	#V_INS,F,MAKCC1	;Want to extend the line?
	MOVL	R1,-(SP)	;Save character to be eventually added
	DECL	CHRPTR		;Move pointer behind the <CR>
	TSTB	INSTBS		;Okay to add tabs?
	BEQL	MAKCR2		;No - just add spaces
	BICL3	#7,R8,R1	;See if any tabs can be added
	MNEGL	R1,R1
	ADDL	R8,R1
	CMPL	R1,R2		;Can they?
	BGEQ	MAKCR2		;No - just add spaces
	TSTL	R1
	BEQL	MAKCT0		;No spaces if end on a tab boundary
	MOVL	R2,-(SP)	;Else add extra spaces first
	MOVL	R1,NUMCHR	;Add (R2) spaces (and some nulls) to the file
	JSB	MAKSPC		;Punch a hole in the file
	MOVL	(SP)+,R2	;Get total spaces back
MAKCT0:	ADDL	#7,R2		;Find number of tabs to add
	ASHL	#-3,R2,NUMCHR	;and save it
	MOVB	#9,CHARAC	;Set to add tabs
	JSB	MAKCHR		;Add 'em
	MOVL	(SP)+,R1	;Clean up
	BRW	MAKCP0		;Make cursor pointer right; done

MAKCR2:	MOVL	R2,NUMCHR	;Add (R2) spaces (and some nulls) to the file
	JSB	MAKSPC		;Punch a hole in the file
	MOVL	(SP)+,R1
	BRW	MAKCP0		;Make cursor pointer right

MAKCC1:	DECL	CHRPTR		;Back the character pointer one notch
	RSB
;Subroutine to make a pointer to the start of the line the cursor is on
;Cannot use R1, since there may be a live character there

MAKLPT::MOVL	DISPTR,R6	;Get pointer to start of screen
	MOVL	R6,LINPTR	;Save it as original line pointer
	MOVL	R7,R4		;Get row to move to
	BNEQ	10$		;Zero?
	RSB			;Yes - done
10$:	BSBW	ADVLPT		;No - advance the pointer
	TSTL	R4		;Add lines if at end of file
	BLSS	MAKLP2
	MOVL	R6,LINPTR	;Save currect line pointer
	MOVL	R6,R3		;Get fraggable pointer
MAKLP0:	CMPL	R3,EN		;At end of buffer?
	BNEQ	10$
	BRB	ADDCR		;Yes - need to add a <CRLF> at end
10$:	MOVZBL	(R3)+,R2	;No - find a non-null character
	BEQL	MAKLP0
	RSB			;Got one - O.K.

;Here if end of buffer found, but not enough <CR>s
;If the INS flag is set, add the desired <CR>s to buffer, plus some nulls
;Then point beyond the <CR>s
;If INS not set, point to last <CR>

MAKLP2:	BBC	#V_INS,F,MAKLP3	;Want to insert stuff?
	MOVL	EN,R3		;Yes - save off <CRLF>s
10$:	MOVB	#^O15,(R3)+
	MOVB	#^O12,(R3)+
	INCL	R4
	BLSS	10$		;until got enough
	MOVL	R3,LINPTR	;Save as pointer to desired line
	MOVB	#^O15,(R3)+	;and a final <CRLF>
	MOVB	#^O12,(R3)+
	CLRB	(R3)+
	MOVL	R3,EN		;Save the final end pointer
	RSB

MAKLP3:	DECL	R6		;Back the line pointer one notch
	MOVB	(R6),R0		;Look for a <CR>
	CMPB	#^O15,R0	;Is it?
	BNEQ	MAKLP3		;No
	DECL	R6		;Back up before the <CR>
	MOVL	R6,LINPTR	;Save line pointer
	BISL	#M_XPL!M_XPC,F	;But say it's invalid
	RSB			;And return

CCREOL::MOVL	R6,R1		;Make sure the file ends with a CRLF
10$:	MOVZBL	(R1)+,R2	;Get a character
	CMPL	R1,EN		;Reached end of the file?
	BGEQ	ADDCR		;Yes - put in carriage return and return
	TSTB	R2
	BEQL	10$		;No - loop until end or non-null character
	RSB			;End of file is now O.K.

ADDCR::	MOVL	EN,R2		;End buffer with a <CRLF>
	MOVW	#^X0A0D,(R2)+
	CLRB	(R2)+		;  and a null
	MOVL	R2,EN
	RSB
;Subroutine to set up the pointer to the last line on the screen
;Works with LINPTR if it's valid (being closer); else uses DISPTR
;Returns bottom pointer both in PT and BOTPTR

;Returns 0 if last line is beyond end of buffer, hence nothing to display
;  (also, if zero, fence should be on screen)

MAKBPT::MOVL	LPP.1,R4	;Get distance of bottom line from top line
	BBC	#V_XPL,F,10$	;Is line pointer valid?
	MOVL	DISPTR,R6	;No - use display pointer
	BRB	MAKBP1
10$:	MOVL	LINPTR,R6	;Yes - use it
	SUBL	R7,R4		;and work a few lines less
	BEQL	MAKBP2		;Already at bottom line. Waddaya know

MAKBP1:	BSBB	ADVLPT		;Advance the pointer
	TSTL	R4		;Beyond the end of the file?
	BGEQ	MAKBP2		;No
	CLRL	R6		;Yes - no pointer then
MAKBP2:	MOVL	R6,BOTPTR	;Save pointer (or non-pointer)
	RSB

;Subroutine to advance the pointer in PT (R4) lines
;R4 is returned with negative number of lines not found (0 if all found)

ADVLPT::CMPL	R6,EN		;At end of usable buffer?
	BNEQ	10$		;No
	MNEGL	R4,R4		;Yes - return negative # lines not found
	RSB			;And return
10$:	MOVZBL	(R6)+,R2	;Get a character
ADVLP1:	CMPB	#^O15,R2	;Carriage return?
	BNEQ	ADVLPT		;No - ignore it

	MOVZBL	(R6)+,R2	;Yes - pick up the <LF>
	CMPB	#^O12,R2	;Is it really?
	BNEQ	ADVLP1		;No - it is not the end of the line
	SOBGTR	R4,ADVLPT	;Yes - loop through desired number of rows
	RSB			;Done
.SUBTITLE	Find if there are any tabs from cursor to EOL

;Subroutine to find if there are any tabs from the cursor to the end
;of the line, or if the line will go off the right of the screen

;Assumes CHRPTR is valid; frags R1, R2
;Returns R0/ 1 if line too long or tab found, else R0/0
;with R1/ position of last character

FNDEOL::MOVL	R8,R1		;Get position of starting character
	MOVL	CHRPTR,R2	;Get the pointer to the first character
10$:	CMPL	R1,CPL(R10)	;At the last column?
	BGTR	70$		;Yes - done now
20$:	MOVZBL	(R2)+,R0	;No - get a character
30$:	TSTB	R0		;Skip it if null
	BEQL	20$
	CMPB	R0,#9		;Tab?
	BEQL	60$		;Yes - handle specially
	CMPB	R0,#^X0D	;End of line?
	BEQL	40$		;Maybe
	INCL	R1		;No - keep looking
	BRB	10$
40$:	MOVZBL	(R2)+,R0	;Is it a linefeed?
	CMPB	R0,#^X0A
	BEQL	50$		;Yes
	INCL	R1		;No - count the CR and check this char further
	BRB	30$
50$:	CLRL	R0		;Indicate no tabs found
	RSB			;Done

60$:	BISL	#7,R1		;Got a tab - tab over
	INCL	R1
70$:	MOVL	#1,R0		;Indicate got a tab or line too long
	RSB			;Done
;*************************************************************************
;Subroutine to overwrite (R4) real characters (not nulls) with nulls
;at (R6), which is fragged
;Stops when counted out, or at end of line
;Saves characters nulled out in DELBUF (up to 160 characters)

WRTNUL::MOVL	R4,WRTNUM	;Save number of chars to null
	CLRL	DELCNT		;Clear size of delete buffer
	MOVAB	DELBUF,R3	;Point to start of delete buffer
10$:	MOVZBL	(R6)+,R2	;Get first character
	BNEQ	20$		;Null?  No
	CMPL	R6,EN		;If null, reached end of buffer?
	BNEQ	10$		;No - just ignore the null
	BRB	WRTNLE		;Yes - return now
20$:	CMPL	R2,#9		;Is it a tab?
	BEQL	30$		;Yes
	BRB	WRTNL2		;No - continue
30$:	MOVB	R2,(R3)+	;Yes - save the tab in the delete buffer
	INCL	DELCNT		;Count it
	SUBL3	TABSIZ,TABSPC,R2 ;Yes - find number of spaces right of cursor
	ADDL	R2,R4		;Count off that many spaces from delete
	CLRB	-1(R6)		;Null out the tab
	TSTL	R4
	BLEQ	WRTNT1		;Jump if done (start and end in the same tab)
	TSTL	NUMCHR		;Start within the tab?
	BEQL	WRTNL1
	BSBW	WRTNLS		;Yes - change the tab in the buffer to spaces

WRTNL1:	MOVZBL	(R6)+,R2	;Get a character
	CMPL	R6,EN		;At end of buffer?
	BNEQ	10$		;No
	BRB	WRTNLE		;Yes - go home early
10$:	TSTB	R2		;Ignore if null
	BEQL	WRTNL1
	CMPB	R2,#9		;Is it a tab?
	BNEQ	WRTNL2
	BRB	WRTNTB		;Yes - see how long the tab is
WRTNL2:	CMPL	R2,#^O15	;Is it a <CR>?
	BNEQ	WRTNL3
	BRB	WRTNLC		;Yes - done if followed by <LF>
WRTNL3:	MOVB	R2,(R3)+	;Else save the deleted character
	CLRB	-1(R6)		;Overwrite it with a null
	INCL	DELCNT		;Count it
	SOBGTR	R4,WRTNL1	;and count it - got enough?
WRTNLE:	CLRB	(R3)+		;End delete buffer with a null
	RSB			;Yes - return

WRTNLC:	MOVL	R6,R0		;Get scratch buffer pointer
	MOVZBL	(R0)+,R2	;Get next character
	CMPL	R2,#^O12	;<LF>?
	BEQL	10$
	BRB	WRTNL3		;No - <CR>'s just another character
10$:	BRB	WRTNLE		;Yes - go finish off

WRTNTB:	MOVB	R2,(R3)+	;Got a tab - save it
	INCL	DELCNT		;Count it
	ADDL3	R8,WRTNUM,R2	;Get starting column and length of delete
	SUBL	R4,R2		;less number to go, gives present position
	BICL	#^C7,R2		;Find negative size of tab
	SUBL	#8,R2
	ADDL	R2,R4		;Count off that many spaces from delete
	CLRB	-1(R6)		;Null out the tab
	TSTL	R4		;Still more to go?
	BLEQ	WRTNT1		;No
	BRB	WRTNL1
WRTNT1:	TSTL	R4		;Leave tab if ended at the end of it
	BEQL	WRTNLE
	MNEGL	R4,R4		;Else add some spaces for this tab, too
	ADDL	R4,NUMCHR
	ADDL	R4,R2		;Find number of spaces this tab represents
	BSBB	WRTNLS		;Change the tab in the buffer to spaces
	CLRL	R4		;Say nothing was left over
	BRB	WRTNLE		;and go finish up

WRTNLS:	MOVB	#^A" ",-1(R3)	;Replace tab with -(R2) spaces
	INCL	R2		;Done if only one space wanted
	BNEQ	10$
	RSB
10$:	MNEGL	R2,R2		;Else count all the additional spaces
	ADDL	R2,DELCNT
20$:	MOVB	#^A" ",(R3)+	;and save them in the buffer
	SOBGTR	R2,20$
	RSB			;Done
;********************************************************************
;Subroutine to calculate RW and LINPTR, given CHRPTR and DISPTR

CALCRW::MOVL	DISPTR,R6	;Start from start of screen
	MOVL	R6,LINPTR	;Save (tentative) line pointer
	CLRL	R7		;Clear row number
CALRW1:	CMPL	R6,CHRPTR	;At desired position?
	BNEQ	10$		;No
	RSB			;Yes - done
10$:	MOVB	(R6)+,R1	;Get character
CALRW2:	CMPB	#^O15,R1	;<CR>?
	BNEQ	CALRW1		;No - skip it
	CMPL	R6,CHRPTR	;At desired position?
	BNEQ	10$		;No
	RSB			;Yes
10$:	MOVB	(R6)+,R1	;Yes - get next character
	CMPB	#^O12,R1	;<LF>?
	BNEQ	CALRW3		;No - skip it
	MOVL	R6,LINPTR	;Save (tentative) line pointer
	INCL	R7		;Count line and loop
	BRB	CALRW1
CALRW3:	CMPL	R6,CHRPTR	;At desired position?
	BNEQ	CALRW2		;No - skip it
	RSB			;Yes

;Subroutine to calculate the number of lines and pages, and total lines
;since the start of the file

FINDRW::CLRL	R3		;Clear page number
	CLRL	SAVEAC		;and total lines
	BRB	FNDR0A		;Skip summing the first time
FNDRW0:	ADDL2	R7,SAVEAC	;Add up total lines passed over
FNDR0A:	CLRL	R7		;Clear row number
FNDRW1:	CMPL	R6,CHRPTR	;At desired position?
	BNEQ	20$		;No
10$:	ADDL2	R7,SAVEAC	;Yes - add in lines from last page
	RSB			;Done
20$:	CMPL	R6,EN		;At end of the buffer?
	BEQL	10$		;Yes - better quit now
	MOVZBW	(R6)+,R1	;No - get character
FNDRW2:	CMPB	#^O14,R1	;Formfeed?
	BNEQ	10$		;No
	INCL	R3		;Yes - bump pages
	BRB	FNDRW0		;and zero lines
10$:	CMPB	#^O15,R1	;<CR>?
	BNEQ	FNDRW1		;No - skip it
	MOVZBL	(R6)+,R1	;Yes - get next character
	CMPB	#^O12,R1	;<LF>?
	BNEQ	FNDRW2		;No - skip it
	INCL	R7		;Yes - count line
	BRB	FNDRW1		;and loop
;Subroutine to calculate column (R8), given CHRPTR, and LINPTR in R6
;(Alternate entry: CALCML - puts LINPTR into R6)
;If CM is beyond screen limits, does a slide to put it within limits
;R0 = 0 on return if slide, else R0 = 1

CALCML::MOVL	LINPTR,R6	;Get pointer to start of line
CALCCM::CLRL	R8		;Clear column number
	MOVL	#1,R0		;Assume there won't be a slide
CALCM1:	CMPL	R6,CHRPTR	;At character position?
	BEQL	CALCCD		;Yes - done
	MOVZBL	(R6)+,R1	;No - get character
	BEQL	CALCM1		;Ignore if null
	CMPB	#9,R1		;Tab?
	BNEQ	10$		;No
	BISL	#7,R8		;Yes - count it
10$:	INCL	R8		;Count character and loop
	BRB	CALCM1

CALCCD:	SUBL2	SL,R8		;Account for the slide
	CMPL	R8,CPL(R10)	;Off the right side?
	BLSS	CALCD1		;No - check left
	MOVL	R8,R1		;Yes - slide a bit to show the match
	MOVL	CPL(R10),R2
	DIVL2	#3,R2
	ASHL	#1,R2,R2
	SUBL2	R2,R1
	ADDL2	R1,SL
	SUBL2	R1,R8
	CLRL	R0		;Indicate slide took place
	RSB			;Return

CALCD1:	TSTL	R8		;Off the left side?
	BGEQ	10$		;No
	ADDL2	R8,SL		;Yes - move left so key is on screen
	CLRL	R8
	CLRL	R0		;Indicate sliding
10$:	RSB			;Then return
.SUBTITLE Subroutine to Insert Things in the Buffer
;**************************************************************************
;Subroutines to fill with spaces or nulls (or contents of CHARAC)
;Enter with NUMCHR/ number of characters to insert
;	    CHRPTR/ place to start inserting them (preserved)
;If enter at MAKCHR, set up character in CHARAC
;On return, CHRPTR will point to the start of the stuff added,
;	    R4 points to the first character after the new stuff
;	    MAKPTR points to last real character added

;Note: This is the ONLY place where things are inserted into the buffer

;A pointer can be stored in ADJWRD.  If the file byte at that address
;is moved the adress will be adjusted so it still points to the byte.
;The caller must clear ADJWRD when this routine returns.
;If ADJWRD is zero here and the bottom pointer is valid, it is adjusted.
;If ADJWRD is non-zero BOTPTR is marked invalid.

MAKSPC::MOVB	#^A" ",CHARAC	;Save space as the fill character
	BRB	MAKCHR		;Go put them in
MAKNUL::CLRB	CHARAC		;Set to fill with nulls

MAKCHR::MOVL	NUMCHR,R3	;Get count of characters to put in
	BNEQ	10$		;Any there?
	RSB			;No - just return
10$:	DIVL	#4,R3		;Convert it to longwords
	INCL	R3		;Add one more for good measure
	MOVL	R3,NUMWDS	;Save number of longwords to add
	MULL3	#4,NUMWDS,NUMBYT ;Compute number of bytes to add
	MOVL	CHRPTR,R4	;Get address of start of insert

	TSTL	ADJWRD		;Did the user give an address to adjust?
	BEQL	11$		;No
	BISL	#M_XPB,F	;Yes - then bottom line pointer is invalid
11$:	BBS	#V_XPB,F,13$	;Is the bottom line pointer invalid?
	MOVL	BOTPTR,ADJWRD	;No - save bottom pointer for adjusting
13$:	TSTL	ADJWRD		;Do we have any word for adjusting?
	BEQL	20$		;No
	SUBL3	ADJWRD,EN,R1	;Is the place we're looding within a longword
	CMPL	R1,#4		;  of the end pointer?
	BGEQ	15$		;No
	ADDL	#4,EN		;Yes - move the end pointer beyond this longword
	CLRL	@EN		;Make sure the longword is clear
15$:	TSTL	@ADJWRD		;Are the contents of that longword zero?
	BNEQ	20$		;No
	CVTBL	#-1,@ADJWRD	;Yes - turn on all the bits

;First see if there are enough null longwords right where the cursor is
;If so, just go and write them

20$:	TSTL	(R4)		;Count consecutive nulls at start
	BNEQ	MAKCH0		;Got one?  No
	ADDL	#4,R4		;Increment the pointer
	SOBGTR	R3,20$		;Yes - check if found enough
30$:	CMPL	R4,EN		;Moved beyond end of buffer?
	BLSS	40$		;No
	ADDL3	#4,R4,EN	;Yes - extend end by that plus one longword
40$:	BRW	MAKCH4		;Go put data in

;Here if not enough nulls words at cursor. Look (nobyte) words ahead and
;shuffle those up to the top

MAKCH0:	MOVL	#NOBYTE,R2	;Get # of longwords to look ahead for nulls
MAKCH1:	CMPL	R4,EN		;At end of buffer?
	BLSS	10$		;No
	CLRL	@EN		;Make sure new longword is null
	ADDL2	#4,EN		;Yes - extend buffer a longword
10$:	TSTL	(R4)		;Is this longword null?
	BNEQ	20$		;No
	SOBGTR	R3,20$		;Yes - count it - counted out?
	BRB	MAKCH2		;Yes
20$:	ADDL2	#4,R4		;No - point to the next longword
	SOBGEQ	R2,MAKCH1	;and loop, if not looked far enough

;Here if not enough nulls found in range - shuffle rest of file down
;If any nulls have been found, leave them alone

	MOVL	EN,R3		;Get address of end of file
	ADDL	NUMBYT,EN	;Extend file by that amount
	MOVL	EN,R4		;Get address of new end of file
	MOVL	CHRPTR,R2	;Get address of last longword to move
	BICL3	#^C3,R2,R1	;Get position within longword
	BICL	#3,R3		;Make pointers start at same byte
	BICL	#3,R4
	BISL	R1,R3
	BISL	R1,R4

	CMPL	R2,ADJWRD	;Need to adjust the adjustable word?
	BGTR	MAKADD		;No - skip this
	SUBL3	R3,R4,R1	;Yes - find distance the longword will move
	ADDL	R1,ADJWRD	;Adjust the word forward by that amount

MAKADD:	MOVL	(R3),(R4)	;Move a longword
	SUBL	#4,R4
	CMPL	R3,R2		;Back to start
	BEQL	10$
	SUBL	#4,R3		;No - keep going
	BRB	MAKADD
10$:	ADDL	#4,R4		;Yes - put stuff in that new gap
	CLRL	@EN		;Make sure end pointer points to nulls
	BRW	MAKCH4

;Now squeeze all the null words up to the location of the file pointer

MAKCH2:	BICL3	#^C3,CHRPTR,R2	;Compute byte offset of start
	BICL3	#^C3,ADJWRD,R1	;  and byte offset of adjusting word
	SUBL	R2,R1		;Compute the difference
	BGEQ	10$
	ADDL	#4,R1		;Let it wrap if negative
10$:	MOVL	R1,-(SP)	;Save the offset
	SUBL	R1,ADJWRD	;Align ADJWRD with CHRPTR
	MOVL	CHRPTR,R2	;Get address of last longword to shuffle
	MOVL	R4,R3		;Point to end of shuffle
MAKCH3:	CMPL	R3,R2		;At starting longword?
	BGEQ	10$		;No
	ADDL	#4,R4		;Yes - done shuffling bytes
	TSTL	@EN		;Is there any data at the end pointer
	BEQL	MKCH3A		;No - just continue
	ADDL	#4,EN		;Yes - skip past it
	CLRL	@EN		;and make sure the new longword is null
	BRB	MKCH3A
10$:	MOVL	(R3),R1		;Get a longword
	BNEQ	20$		;Null?
	SUBL	#4,R3		;Yes - don't shuffle
	BRB	MAKCH3
20$:	MOVL	R1,(R4)		;No - save farther down
	CMPL	R3,ADJWRD	;Is this the word that needs adjusting?
	BNEQ	30$		;No
	MOVL	R4,ADJWRD	;Yes - adjust it
30$:	SUBL	#4,R4
	SUBL	#4,R3		;De-bump both pointers
	BRB	MAKCH3		;and loop

;Now write the desired stuff into the opened-up area

MKCH3A:	MOVL	(SP)+,R1	;Retrieve the amount to be added in
	ADDL	R1,ADJWRD	;Correct ADJWRD

MAKCH4:	BBS	#V_XPB,F,MAKCH5	;Got an adjusted bottom pointer?
	MOVL	ADJWRD,BOTPTR	;Yes - save it
	BEQL	MAKCH5		;Was there one?  No
	CMPL	#-1,@ADJWRD	;Yes - was the value doctored up?
	BNEQ	10$		;No
	CLRL	@ADJWRD		;Yes - un-doctor it
10$:	CLRL	ADJWRD

MAKCH5:	TSTL	ADJWRD		;Was there any adjustment word?
	BEQL	5$		;No - skip this
	CMPL	#-1,@ADJWRD	;Was the value doctored up?
	BNEQ	5$		;No
	CLRL	@ADJWRD		;Yes - un-doctor it
5$:	MOVL	R4,NUMNUL	;Save pointer to first char after insert
	MOVL	CHRPTR,R4	;Point to start of inserted stuff
	MOVL	NUMCHR,R3	;Get the number of characters to write
	BBCC	#V_WRH,F,10$	;Want to read from the pick or close buffer?
	BRB	MAKPTP		;Yes - handle separately
10$:	MOVZBL	CHARAC,R1	;No - get the character to put in
20$:	MOVB	R1,(R4)+	;Put the character in
	SOBGTR	R3,20$		;Loop <NOCH> times

;Pad out the remainder of the last longword with nulls; then return

MAKPT1:	MOVL	R4,MAKPTR	;Save pointer to last real thing added
5$:	CMPL	R4,NUMNUL	;Reached good stuff?
	BNEQ	10$		;No
	RSB			;Yes - done
10$:	CLRB	(R4)+		;No - put the null in
	BRB	5$		;and loop through the desired number

;Here to write from the pick or close buffer into the opened-up space

MAKPTP:	TSTL	PUTJFN		;Want to read from disk?
	BEQL	MAKPT2		;No - don't initialize
	BSBB	MAKPB0		;Yes - initialize
MAKPT0:	BSBB	MAKPTB		;Set up a piece in the buffer
MAKPT2:	MOVL	PUTPTR,R6
MAKPPT:	MOVZBL	(R6)+,R1	;Get character from the pick buffer
MAKPP0:	MOVB	R1,(R4)+	;Save it in the file buffer
	CMPB	#^O15,R1	;<CR>?
	BNEQ	10$		;no
	SOBGTR	R3,MAKPP1	;Yes - see if end of line
10$:	SOBGTR	R3,MAKPPT	;Loop <NOCM> times
	TSTL	MAKCNT		;Got more to read from buffer?
	BGTR	MAKPT0		;Yes - get and put it
	BRB	MAKPT1		;No - put ending nulls in, if any

MAKPP1:	MOVB	(R6)+,R1	;Pick up line feed
	CMPB	#^O12,R1	;Is it really?
	BNEQ	MAKPP0		;No
	INCL	MAKLNS		;Yes - bump count of lines found
	BRB	MAKPP0		;Continue

;Subroutine for when reading from disk: read next bufferful of text
;and set up counts.

MAKPB0::CVTBL	#<-<PCBSIZ/512>+1>,PTMBLK ;Initialize the block number
	MOVL	PUTJFN,R0	;Point to the RAB
	$RAB_STORE UBF=@PUTPTR,USZ=#PCBSIZ,-
		   RSZ=#0,RBF=#0 ;Initialize the RAB for reading
	MOVL	R3,MAKCNT	;Save count of characters to add
	RSB

MAKPTB:	ADDL	#<PCBSIZ/512>,PTMBLK ;Increment the block number
	MOVL	PUTJFN,R0	;Point to the RAB
	$RAB_STORE BKT=PTMBLK	;Load the block number
	MOVL	#PCBSIZ,R3	;Set up the count
	SUBL	R3,MAKCNT	;Decrement the number of bytes yet to do
	BGEQ	10$		;If not finished, don't alter read byte count
	ADDL3	#PCBSIZ,MAKCNT,R3 ;  else compute bytes in last block
	PUSHR	#^M<R3>		;Save the byte count
	ADDL	#^X177,R3	;Round to next block boundary
	BICL	#^X177,R3
	$RAB_STORE USZ=R3
	POPR	#^M<R3>		;Restore the count
	CLRL	PUTJFN		;Clear the RAB pointer
10$:	$READ	RAB=R0		;Read a record
	BLBS	R0,20$		;Any errors?
	HALT			;Yes - fatal
20$:	RSB			;No - return
.SUBTITLE	Replace a tab with spaces

;*******************************************************************
;Subroutine for when the user wants to do something in the middle of a tab
;Change the tab to spaces, re-adjust cursor position, and drive on
;Call with R2/pointer to the tab

RPLTAB::TSTL	TABSPC		;Sitting at start of tab?
	BNEQ	10$
	RSB			;Yes - don't bust the tab this time
10$:	MOVL	TABSIZ,NUMCHR	;Else get number of characters to make
	CLRB	(R2)+		;Null out the tab
	BSBW	MAKSPC		;Add those spaces
	BISL	#M_XPC,F
	BRW	MAKCPT		;Re-make cursor pointer and return
.SUBTITLE	Parameter parsing routines

;************************************************************************
;PEEL routines - these convert a part of the parameter buffer to
;a number (PEEL.1), or move a file spec to its own spec-ial area (PELS.1)

;Can enter in one of three situations:
;Enter, Parameter
;Enter, no parameter		PARPTR unchanged; get token (or special)
;Enter, cursor move		CMV set; two parms set up

;Can return in one of three situations:
;No enter typed			ENT flag is not set
;Enter, but no parameter typed	ENT set; R1/0
;Enter and parameter typed	ENT set; R1/non-0

;Subroutine to read a decimal number from buffer. Return is in PARG1
;Returns R1/0 if parm null; else -1

PEEL.1::CLRL	PARG2		;Clear parm set by cursor move
	CLRL	R1
	BBC	#V_CMV,F,10$	;Was parm defined using cursor movement?
	BRB	PEEL.M		;Yes - that's a whole nuther story
10$:	MOVAB	PARBUF,R4
	CMPL	R4,PARPTR	;Enter - no parm typed?
	BNEQ	20$		;No
	BRW	PEEL.C		;Yes - may want to count up a token
20$:	CLRB	@PARPTR		;Make sure parameter ends with a null
	CLRL	R1		;Clear flag and return value
	CLRL	R3

PEEL1::	MOVZBL	(R4)+,R2	;Get a character
PEEL1A::TSTB	R2		;Check for null
	BEQL	PEEL3		;Done if null
	CMPB	R2,#^O177	;Delimiter character?
	BEQL	PEEL2		;Yes - end or ignore
	CVTBL	#-1,R1		;Else indicate a non-null parameter
	SUBL	#^O60,R2	;Convert to octal
	BLSS	PGTERR		;Is it really a number?  No
	CMPL	R2,#^O12
	BGEQ	PGTERR		;No - give error message
	MULL	#10,R3		;Yes - shift in target
	ADDL	R2,R3		;Add in new digit
	BRB	PEEL1

PEEL2:	CMPL	R9,#$SUBST	;Got delimiter - is this substitute command?
	BNEQ	PEEL1		;No - just ignore it (else finish off)
PEEL3:	TSTL	R1		;If null parm found, just return
	BEQL	10$
	MOVL	R3,PARG1	;Save parm
10$:	RSB

PGTERR:	MOVAB	PGTERM,R1
	BRW	ERROR
PGTERM:	.ASCIZ	/#####Argument must be numeric/
;Here if parameter was made using cursor movement
;Set PARG1 to rows moved and PARG2 to columns
;Caller should restore mark at (R7,R8), then get (R7,R8) from (SAVPOS,+1)

PEEL.M:	MOVQ	R7,SAVEAC	;Save ending position
	SUBL	SAVPOS,R7	;Find difference in row
	MOVL	R7,R2		;Get actual difference
	MOVL	R7,PARG1	;Save magnitude of difference
	BGEQ	10$
	MNEGL	R7,PARG1
10$:	TSTL	R7
	BLSS	20$		;Positive?
	MOVL	SAVPOS,R7	;Yes - go from starting position
	BRB	PEL.M1		;Now check column
20$:	MOVL	SAVPOS,R7	;If negative go from ending position
	MOVL	SAVEAC,SAVPOS
	BISL	#M_XPL!M_XPC,F	;Re-do row and column pointers

PEL.M1:	SUBL	SAVPOS+4,R8	;Find difference in column
	CMPL	#$INSLN,R9	;Open-lines command?
	BNEQ	10$		;No
5$:	BRB	PEL.M4		;Yes - handle specially
10$:	CMPL	#$DELLN,R9	;or close-lines command?
	BEQL	5$		;Yes
	CMPL	#$PICK,R9	;Same with pick command
	BEQL	5$
	CMPL	#$CASE,R9	;and case command
	BEQL	5$
PEL.M2:	MOVL	R8,PARG2	;Save magnitude of difference
	BGEQ	10$
	MNEGL	R8,PARG2
10$:	TSTL	R8		;If negative,
	BLSS	PEL.M5		;jump
PEL.M6:	MOVL	SAVPOS+4,R8	;If positive go from starting position
PEL.M3:	MOVL	SAVCPT,R1	;Re-set original character pointer
	CMPL	R1,CHRPTR	;Has it changed any (w-wise tabs)?
	BEQL	10$		;No
	BISL	#M_XPL!M_XPC,F	;Yes - re-do it
10$:	RSB			;and let the caller worry about it

PEL.M4:	TSTL	R2		;If no row change,
	BEQL	PEL.M2		;do it the old way
	MOVL	R8,PARG2	;Else use actual column difference
	TSTL	R2		;Continue, if row change positive
	BGTR	PEL.M6
	MNEGL	R8,PARG2	;Negative - save negative difference

PEL.M5:	MOVL	SAVPOS+4,R8	;Negative - go from ending position
	MOVL	SAVEAC+4,SAVPOS+4
	BISL	#M_XPC,F	;Re-do column pointer
	BRB	PEL.M3		;Now finish off
;Subroutine to count the size of the current file token

PEEL.C:	CMPB	#$RLFWL,R9	;Is it a roll lines command?
	BNEQ	20$		;No
10$:	RSB			;Yes - special non-token case
20$:	CMPB	#$RLBKL,R9
	BEQL	10$
	CMPB	#$GOTO,R9	;Is it a percent command
	BEQL	10$		;Yes
	CMPB	#$EXEC,R9	;  or an execute command?
	BEQL	10$		;Yes - another non-token case
	CMPB	#$JUSTI,R9	;How about justify?
	BEQL	10$		;Yes - likewise
	BSBW	MAKCPT		;Make pointer to cursor location
	MOVL	CHRPTR,R6	;Get cursor pointer
	CLRL	R2		;Clear count

PEL.C1:	MOVZBL	(R6)+,R1	;Get character from the buffer
	BEQL	PEL.C1		;Ignore if null
	CMPB	R1,#^A"0"	;Too small for a number?
	BGEQ	20$
10$:	INCL	R2		;Yes - end of token
	BRB	PEL.C3
20$:	CMPB	R1,#^A"9"	;Is it a number?
	BGTR	40$		;No
30$:	INCL	R2		;Yes - good
	BRB	PEL.C1
40$:	CMPL	R1,#^A"A"	;Too small for a UC letter?
	BLSS	10$		;Yes - end of token
	CMPL	R1,#^A"Z"	;Is it a UC letter?
	BLEQ	30$		;Yes - good
	CMPL	R1,#^A"a"	;Too small for a lc letter?
	BLSS	10$		;Yes - end of token
	CMPL	R1,#^A"z"	;Is it a lc letter?
	BLEQ	30$		;Yes - good
	INCL	R2		;End of token

PEL.C3:	MOVL	R2,PARG1	;Save size of token
	CMPL	#$PICK,R9	;Doing a pick?
	BNEQ	10$		;No
	CLRL	R1		;Yes - clear got-an-arg flag
10$:	RSB			;Done
;Subroutine to peel off a string (for searches, set-file, put)
;Call with R3/ ascii pointer to string save area
;Returns R1/length of string

PELS.1::BBCC	#V_CMV,F,10$	;Got a cursor movement parameter?
	BRB	PELS.M		;Yes - handle it
10$:	CLRL	R1		;Clear got-a-parm flag
	MOVAB	PARBUF,R4	;Point to the parameter buffer
	BBCC	#V_PST,F1,20$	;Enter - no parm typed?
	BRW	PEEL.T		;Yes - may want to pick up a token
20$:	CLRB	@PARPTR		;Make sure parameter ends with a null
	MOVZBL	(R4)+,R2	;Get the first character
	BNEQ	PELS2A		;If null, just enter was typed
	RSB			;  so just return

PELST2::MOVZBL	(R4)+,R2	;Get a character
PELS2A:	CMPB	R2,#^O177	;Delimiter character?
	BEQL	PELST3		;Yes - ignore it or end
	MOVB	R2,(R3)+	;Save it wherever user wants
	BEQL	30$		;Done if null
	INCL	R1		;Else count character
	BRB	PELST2		;  and loop
30$:	RSB

PELST3:	CMPL	R9,#^O63	;Got delimiter - is this substitute command?
	BNEQ	PELST2		;No - just ignore it
	CLRB	(R3)+		;Yes - end string with a null
	RSB			;Done

;Here to peel a cursor movement string
;Caller should restore mark at (R7,R8), then get (R7,R8) from (SAVPOS,+4)

PELS.M::CMPL	R8,SAVPOS+4	;Only legal if not on the same column
	BEQL	10$
	CMPL	R7,SAVPOS	;  but on the same line
	BEQL	20$
10$:	BRW	CMVERR		;No - illegal
20$:	MOVL	R3,-(SP)	;Save pointer to place to save string
	SUBL3	SAVPOS+4,R8,R1	;Get length of string to pick up
	BLSS	30$		;Is count negative?
	MOVL	SAVPOS+4,R8	;No - get original position back
30$:	BISL	#M_XPC,F	;Always re-do character pointer
	BSBW	MAKCPT		;Re-do it, already
	MOVL	(SP)+,R3
	TSTL	R1		;Count negative?
	BGEQ	40$		;No
	BISL	#M_XPC,F	;Yes - get correct starting column
	MOVL	SAVPOS+4,R8
40$:	MOVL	R1,R4		;Set up size of pick
	BGEQ	50$		;If negative,
	MNEGL	R1,R4		;  get positive size
50$:	MOVL	CHRPTR,R6	;Get that pointer
	JSB	SPCBUF		;Pick up the string from the buffer
	MOVL	SPCCNT,R1	;Get count of characters picked
	CLRB	(R3)+		;End parameter with a null
	RSB			;Done
;Subroutine to peel off a token from the file.
;The token is defined as extending from the cursor location to the
;next non-alphanumeric character
;Token is stored at area pointed to by R3

PEEL.T:	CMPL	R9,#$PUT	;Got a put command?
	BNEQ	10$		;No
	RSB			;Yes - don't read token
10$:	MOVL	R3,PARPTR	;Save save pointer
	BSBW	MAKCPT		;Make pointer to cursor location
	MOVL	PARPTR,R3	;Restore save pointer
	MOVAB	PARBUF,PARPTR
	CMPL	R9,#$SETFI	;Is command a setfil?
	BNEQ	20$		;No
;	BRW	PEEL.F		;Yes - get a filespec-flavored token
20$:	MOVL	CHRPTR,R6	;Get cursor pointer
	BRB	PEL.T2

PEL.T1:	MOVB	R1,(R3)+	;Save character in callers buffer
	MOVB	R1,@PARPTR	;Save character in parameter buffer
	INCL	PARPTR
PEL.T2:	MOVZBL	(R6)+,R1	;Get character from the buffer
	BEQL	PEL.T2		;Ignore if null
	CMPB	R1,#^A"0"	;Too small for a number?
	BLSS	10$		;Yes - end of token
	CMPB	R1,#^A"9"	;Is it a number?
	BLEQ	PEL.T1		;Yes - good
	CMPB	R1,#^A"A"	;Too small for a UC letter?
	BLSS	10$		;Yes - end of token
	CMPB	R1,#^A"Z"	;Is it a UC letter?
	BLEQ	PEL.T1		;Yes - good
	CMPB	R1,#^A"a"	;Too small for a lc letter?
	BGEQ	20$		;No
10$:	BRW	PEL.T3		;Yes - end of token
20$:	CMPL	R1,#^A"z"	;Is it a lc letter?
	BGTR	10$		;No
	BRB	PEL.T1		;Yes - get another one

;Subroutine to peel off a filespec string.
;Call with R3/ ascii pointer to string save area
;Returns R1/length of string

PELS.F::BBCC	#V_CMV,F,10$	;Got a cursor movement parameter?
	BRW	PELS.M		;Yes - handle it
10$:	BICL	#M_CRE!M_FLG,F	;Assume file is not to be created
	MOVAB	PARBUF,R4
	CMPL	R4,PARPTR	;Enter - no parm typed?
	BNEQ	20$
	BRW	PEEL.T		;Yes - may want to pick up a token
20$:	PUSHR	#^M<R2,R3,R4,R5>
	MOVC5	#0,FILSPC,#0,#100,FILSPC ;Clear out previous filespecs
	POPR	#^M<R2,R3,R4,R5>
	CLRB	@PARPTR
	INCL	PARPTR
	CLRL	R1		;Clear character count
	MOVZBL	(R4)+,R2	;Get the first character
	BNEQ	PELSF1		;If null, just enter was typed,
	RSB			;  so just return

PELSF0:	MOVZBL	(R4)+,R2	;Get a character
PELSF1:	BBS	#V_FLG,F,20$	;Already seen start of switches?  Yes
	CMPB	R2,#^A"="	;No - Want to create a file?
	BNEQ	10$
	BISL	#M_CRE,F	;Yes - flag as such
	BRB	PELSF0		;  and get another character
10$:	CMPB	R2,#^A"@"	;Want to use the files given in this file?
	BNEQ	15$
	BISL	#M_IND,F	;Yes - flag as such
	BRB	PELSF0		;  and get another character
15$:	CMPB	R2,#^A"/"	;Start of switches?
	BNEQ	20$		;No
	BISL	#M_FLG,F	;Yes - remember it
20$:	MOVB	R2,(R3)+	;Save it wherever user wants
	BNEQ	30$		;Done, if null
	BICL	#M_FLG,F	;Make sure flag is off
	RSB
30$:	INCL	R1		;Else count character
	BRB	PELSF0		;  and loop

PEL.T3:	CLRB	(R3)+		;End buffer with a null
	CLRB	@PARPTR
	INCL	PARPTR
	RSB			;Done

CMVEMS:	.ASCIZ	/######Stay on the same line/
CMXEMS:	.ASCIZ	/###Can't mix characters and moves/
CMVERR:	MOVAB	CMVEMS,R1
	BRB	CMXER1
CMXERR::MOVAB	CMXEMS,R1
CMXER1:	MOVL	SAVPOS,R7	;Restore saved position
	MOVL	SAVPOS+4,R8
	BRW	ERROR

;Subroutine to parse the switches in the filespec buffer

PARSEF::MOVAB	FILSPC,R2	;Point to the filespec buffer
10$:	MOVZBL	(R2)+,R1	;Get a byte
	BNEQ	20$		;Done if null
	BSBB	PRSFSP		;Parse the filespecs
	RSB
20$:	CMPB	R1,#^A"/"	;Reached start of the switches yet?
	BNEQ	10$		;No
	CLRB	-1(R2)		;Null out the first slash
	BSBB	PRSFSP		;Parse the filespec
	BRW	SWHMNY		;Handle the switches and return

PRSFSP:	SUBL3	#FILSPC,R2,R1	;Compute the length of the filespec
	$FAB_STORE FAB=INPUT_FAB,FNS=R1
	CLRW	FAB$W_IFI(R0)	;Make sure IFI is clear
	$PARSE	FAB=INPUT_FAB	;Analyze the filespec
	BLBC	R0,PRSERR	;Any errors?  Yes - report them
	RSB

PRSERR:	MOVAB	PRSEM1,R1	;Point to the bad file spec message
	TSTB	OUTFLG		;Parsing specs from an /OUT: switch?
	BGTR	10$		;Yes
	BRW	STFERR		;No - output the error and continue
10$:	PUSHR	#^M<R2,R3,R4,R5>
	MOVC3	#100,SVASPC,FILSPC ;Yes - restore original filespecs
	MOVL	SVALEN,FSPLEN
	MOVL	SVATYP,FSPTYP
	MOVL	SVATYP_SIZE,FSPTYP_SIZE
	CLRL	OUTFLG		;Say no longer parsing /OUT: switch
	MOVAB	PRSEM2,R1	;Say bad file specs in switch
	BRW	ERROR		;and give the right error message
PRSEM1:	.ASCIZ	/###########Bad file specs/
PRSEM2:	.ASCIZ	/######Bad file specs in switch/

;Subroutine to rescan user's run line to see if he typed a filename
;If so, assume it is specs.  Move spaces to parm buffer and set flag
;so they will be parsed

RSCANL::CLRB	RSCANF
	PUSHAW	RESCAN_LENGTH
	PUSHAL	#0
	PUSHAL	RESCAN_DESC
	CALLS	#3,G^LIB$GET_FOREIGN ;Get the command line
	BLBS	R0,10$		;Any errors?
	RSB			;If so, just return
10$:	MOVZWL	RESCAN_LENGTH,R4 ;Get the number of characters found
	MOVAB	RESCAN_LINE,R6	;Point to the rescan buffer
	MOVAB	CLSBUF,PARPTR	;Yes - point to start of close buffer
RSCAN1:	SOBGEQ	R4,10$		;Any more characters?  Yes
	RSB
10$:	MOVZBL	(R6)+,R1	;Skip characters
	CMPB	R1,#^A"/"	;  until start of switches,
	BEQL	RSCA1B
	CMPB	R1,#^A" "	;  or space
	BNEQ	RSCA1B

RSCA1A:	DECL	R4		;Get first file character
	BLSS	RSCAN3		;Done if nothing waiting
	MOVZBL	(R6)+,R1
	CMPB	R1,#^A" "	;Skip any leading spaces
	BEQL	RSCA1A
RSCA1B:	MOVB	#-1,RSCANF	;Set the enter-parameter flag
	BRB	RSCA2A		;Go save the filename
RSCAN2:	DECL	R4		;Save from here on as a parameter
	BLSS	RSCAN3		;Done if nothing left
	MOVB	(R6)+,R1	;Get the character
RSCA2A:	MOVB	R1,@PARPTR	;Save the character
	INCL	PARPTR
	BRB	RSCAN2		;and get another one

RSCAN3:	CLRB	@PARPTR		;End buffer with a null
	BICL	#M_SMF,F	;Clear same-file flag
	MOVAB	CLSBUF,R2	;Now look over specs again
RSCAN4: MOVZBL	(R2)+,R1	;See if there are any switches
	BNEQ	10$		;If end of buffer,
	RSB			;  done
10$:	CMPB	R1,#^A"/"	;Else got start of switches?
	BNEQ	RSCAN4		;No - keep looking
	CLRB	-1(R2)		;Yes - null out the first slash
	CMPL	#CLSBUF+1,R2	;Switches only; no filespecs?
	BNEQ	20$
	CLRB	RSCANF		;Yes - pretend user didn't type anything
20$:	BRW	SWHMNY		;Go handle the switches and return

;Here on entry to transfer rescanned specs to parm buffer

SETSCN::MOVAB	PARBUF,R1
	MOVAB	CLSBUF,R2
10$:	MOVB	(R2)+,(R1)+	;Move clsbuf to parbuf
	BNEQ	10$		;  until a null is moved
	MOVL	R1,PARPTR	;Save the parameter pointer
	MOVL	#2,R9		;Pretend a set-file command was typed
	PUSHR	#^M<R5>
	MOVC3	#100,FILSPC,OLDSPC ;Save current specs into old specs
	MOVL	FSPLEN,OLDLEN	;Also save the length of the filespec
	POPR	#^M<R5>
	JMP	SETFLC

;Here to find the length of a filespec - R4 points to filespec,
;length is returned in R2

FNDLEN:	CLRL	R2		;Clear the byte counter
10$:	MOVZBL	(R4)+,R1	;Get a character
	BEQL	20$		;Quit if it's null
	CMPB	R1,#^A"/"	;or if it's a slash
	BEQL	20$
	INCL	R2		;Else count it
	BRB	10$		;and loop
20$:	RSB			;Then return

;Here to read the symbol names defining the temporary storage and set up
;the file status there.  If none, sets up for the default "welcome to sed"
;message

REDTMP::MOVL	R5,-(SP)	;Save R5 for a while
	MOVC5	#0,PIKBUF,#0,#400,PIKBUF+PCBSIZ-400 ;Clear the buffer
	MOVL	(SP)+,R5
	MOVAL	FILESPEC_DESC,R4 ;Point to the symbol name
	JSB	REDSYM		;Go read the symbol
	BLBS	R0,10$		;Any found?
	RSB			;No - just return
10$:	CLRL	INDFLG
	MOVAB	PIKBUF+PCBSIZ-400,R6
	MOVAB	FILSPC,R4
	MOVL	R4,MFLPT1	;Save pointer to 1st spec
	BSBW	TMPGET		;Read active specs into active area
	MOVAB	FILSPC,R4
	BSBB	FNDLEN		;Find the length of the filespec
	MOVL	R2,FSPLEN	;and save it
	MOVL	R5,-(SP)
	MOVC5	#0,PIKBUF,#0,#400,PIKBUF+PCBSIZ-400
	MOVL	(SP)+,R5
	MOVAL	OLDSPEC_DESC,R4	;Point to the symbol name for alternate file
	JSB	REDSYM		;Read the value of this symbol
	BLBC	R0,REDTM1
	MOVAB	PIKBUF+PCBSIZ-400,R6
	MOVAB	OLDSPC,R4
	MOVL	R4,MFLPT0	;Save pointer to 2nd spec
	BSBB	TMPGET		;Read alternate specs into old area
	MOVAB	OLDSPC,R4
	BSBW	FNDLEN		;Find the length of the filespec
	MOVL	R2,OLDLEN	;and save it
REDTM1:	CLRL	MFLPTR
	CLRL	DISPTR		;Clear pointers
	CLRL	SAVEDP		;  to note that parsing must be done
	BISL	#M_XPL!M_XPC!M_XPB,F ;Say no pointers are valid and fall into:

;Subroutine to see if file and alternate are the same
;Sets flag SMF if files are the same, else clears SMF

SAMFIL::BICL	#M_SMF,F	;Assume files aren't the same
	TSTB	OUTFLG		;Changing the name of the new file?
	BEQL	10$		;No
	RSB			;Yes - files aren't the same
10$:	MOVAB	FILSPC,R3
	MOVAB	OLDSPC,R4
SAMFL1:	MOVZBL	(R3)+,R1	;See if both file specs are the same
	MOVZBL	(R4)+,R2
	CMPB	R1,#^A"/"	;Treat start of switches
	BNEQ	10$		;  line end of specs
	CLRL	R1
10$:	CMPB	R2,#^A"/"
	BNEQ	20$
	CLRL	R2
20$:	CMPB	R1,R2		;Are specs the same so far?
	BEQL	30$
	RSB			;No - done
30$:	TSTB	R1		;Else loop thru entire string
	BNEQ	SAMFL1
	BISL	#M_SMF,F	;Files are the same if control gets here
	RSB			;Done

;Subroutine to read from (R6) and save in (R4).

TMPGET::CLRL	R0		;Clear "got /FD" flag
	MOVZBL	(R6)+,R1
	BNEQ	TMPGT0
	RSB			;If null, we must be done

TMPGT2:	MOVZBL	(R6)+,R1	;Read specs into active or alternate area
	BEQL	TMPGT3		;If null, go finish off
TMPGT0:	CMPB	R1,#^A"/"	;Got the /FD switch, maybe?
	BNEQ	10$
	BSBB	TMPGTS		;Maybe - check it out
10$:	CMPB	R1,#9		;Got a tab?
	BEQL	TMPGT3		;Yes - say line ends here
	MOVB	R1,(R4)+	;No - save character
	BRB	TMPGT2		;and get another

TMPGT3:	TSTL	R0		;Got an /FD?
	BNEQ	TMPGTE		;Yes
	MOVAB	TMPFD0,R1	;Else set it up now
	MOVL	R5,R0
	MOVL	R4,R5
	MOVL	R0,R4
	JSB	PUTSTG
	MOVL	R5,R0
	MOVL	R4,R5
	MOVL	R0,R4

TMPGTE:	CLRB	(R4)+		;Put null at end of string
	RSB

TMPGTS:	MOVB	R1,(R4)+	;Save the slash
	MOVZBL	(R6)+,R1	;Get next character
	CMPB	R1,#^A"F"	;File switch?
	BEQL	10$		;Yes
	RSB			;No - continue
10$:	MOVB	R1,(R4)+	;Yes - save it
	MOVZBL	(R6)+,R1	;Get next character
	CMPB	R1,#^A"D"	;Still file switch?
	BNEQ	20$		;No
	INCL	R0		;Yes - set flag
20$:	RSB			;Return either way

TMPFD0:	.ASCII	?/FD:0?

;Subroutine to move pre-set file status information into the active places
;PNTSTT can be called to set up pointers to start of file (PERCEN, NEWFIL)

PRESET::TSTL	PREDP		;If no display pointer, point to start of file
	BEQL	PNTSTT
	CMPL	PREDP,EN	;Does it point beyond end of file?
	BGEQ	PNTSTT		;Yes - point to start of file
	BISL	#M_XPL!M_XPC!M_XPB,F ;No - no pointers are good
	MOVQ	PRERW,R7	;Get pre-set row and column
	MOVL	PRESL,SL	;  and slide
	MOVL	PREDP,DISPTR	;Get display pointer
	CLRL	PREDP		;  and clear previous
	RSB

PNTSTT::MOVAB	BUFFER,R2
	MOVL	R2,DISPTR	;Point to the start of the file
	MOVL	R2,LINPTR
	MOVL	R2,CHRPTR
	CLRL	R7
	CLRL	R8
	CLRL	SL
	BICL	#M_XPC!M_XPL,F	;Line and character pointers are O.K.
	BISL	#M_XPB,F	;But bottom pointer is bad
	RSB
.SUBTITLE	Process SED.INI

REDSWH::CVTBL	#-1,INIFLG	;Assume file will be found in default path
	$FAB_STORE FAB=INI_FAB,FNA=INI_NAM_2,FNS=#INI_LEN_2

10$:	$OPEN	FAB=INI_FAB	;Open the file
	BLBS	R0,30$		;Go if successful
	TSTL	INIFLG		;Already tried SYS$LOGIN:?
	BNEQ	20$		;No
	RSB			;Yes - return

20$:	$FAB_STORE FAB=INI_FAB,FNA=INI_NAM_1,FNS=#INI_LEN_1
	CLRL	INIFLG		;Indicate tried the alternate
	BRB	10$

30$:	$CONNECT	RAB=INI_RAB ;Connect to the input stream
	BLBS	R0,40$
	HALT			;Unable to connect
40$:	MOVL	INI_XAB+XAB$L_EBK,R1	;Get end of file block number
	MULL	#^X200,R1	;Compute butes to be read
	CMPL	#PCBSIZ,R1	;If it's too large,
	BGEQ	50$
	MOVL	#PCBSIZ,R1	;Cut it down to maximum
50$:	$RAB_STORE RAB=INI_RAB,USZ=R1 ;Save the size to be read
	$READ	RAB=INI_RAB	;Read the file
	BLBS	R0,60$
	HALT			;Stop on errors
60$:	$DISCONNECT RAB=INI_RAB
	$CLOSE	FAB=INI_FAB

	SUBL3	#1,INI_XAB+XAB$L_EBK,R1	;Compute the ending byte address
	MULL	#^X200,R1
	ADDW	INI_XAB+XAB$W_FFB,R1
	ADDL3	#PIKBUF,R1,END_INI ;Compute the ending byte address
	MOVAB	PIKBUF,R2	;Point to the buffer
	MOVZWL	PIKBUF,SAVEAC	;Save the byte count
	MOVL	R2,SAVEAC+4	;and its address

REDSW1:	MOVL	SAVEAC+4,R2	;Get address & byte count of next line
	MOVL	SAVEAC,R3
	CMPW	#-1,R3		;If byte count = -1, end of file
	BEQL	REDSWE
	CMPL	R2,END_INI	;Or if at the end of data, call it end of file
	BGEQ	REDSWE		;Yes
	ADDL	R2,R3		;Compute address of the next line
	ADDL	#2,R3
	BBC	#0,R3,10$	;At an odd address?
	INCL	R3		;Yes - step to the next one
10$:	MOVL	R3,SAVEAC+4	;Save it for next time
	MOVZWL	(R3),SAVEAC	;Also save the byte count
	CLRW	(R3)		;Make sure line ends with a null
	ADDL	#2,R2		;Go to the start of the line
REDSW2:	TSTB	(R2)		;Is first char a null?
	BEQL	REDSW1		;Yes - the line is blank
	CMPB	(R2),#^A"/"	;or is it a slash
	BNEQ	10$		;No
	INCL	R2		;Yes - step past the slash
10$:	BSBW	SWHMNY		;Process all switches on the line
	BRB	REDSW1		;Go get the next line

REDSWE:	MOVL	R5,-(SP)	;Save the type buffer pointer
	MOVC5	#0,PIKBUF,#0,#PCBSIZ,PIKBUF ;Clear the pick buffer
	MOVL	(SP)+,R5	;Restore the pointer
	RSB			;and return

REDCHR:	MOVZBL	(R2)+,R1	;Get next character
	CMPB	R1,#^A"a"	;Lower case?
	BLSS	10$
	CMPB	R1,#^A"z"
	BGTR	10$
	SUBB	#^O40,R1	;Yes - convert to upper
10$:	RSB
.SUBTITLE	Error Routines

;Here to clear screen, output an error message, rewrite screen, and
;go get another command. The command that caused the error is ignored

;This routine can be called from any level since it resets the stack pointer

CNIERM:	.ASCIZ	/####Command not yet implemented!/
SETIND::
SETMFE::
CNIERR::MOVAB	CNIERM,R1
	BRW	ERROR

CBMMSG:	.ASCIZ	/######File cannot be modified/

ALPERR::BBS	#V_ERF,F,RDOERR	;Just had an error?  Yes - skip this
	BSBW	MAKCPT		;No - make sure the character pointer is O.K.
	JSB	DISLIN		;and repair the fragged line

RDOERR::MOVAB	CBMMSG,R1	;Point to the message

ERROR::	BBS	#V_JRC,F1,ERRORZ ;Recovering a journal?  Yes
	BBSS	#V_ERF,F,ERRORX	;No - just had an error?  Yes
	BITL	#M_XCT!M_XBN,F1	;Executing?
	BNEQ	15$		;Yes
	BICL	#M_FLG,F	;No - clear XCT and FLG
	BRB	20$
15$:	BISL	#M_FLG,F	;Yes - clear XCT and set FLG
20$:	BICL	#M_XCT!M_XBN,F1
	BSBW	ERRDSP		;Else display the error message
	BBC	#V_GFL,F,ERRORY	;Got a file to edit?
	BBS	#V_SLW,F1,30$	;Slow terminal?
	JSB	DISPLL		;No - rewrite screen
30$:	JSB	ERASPM		;If enter typed clean line up
ERRORX:	JSB	POSCUR
ERRORZ:	MOVL	STACK,SP	;Clean up the stack
	BICL	#M_FLG!M_ENT,F	;Stop doing commands, clear enter mode
	JMP	LOOP		;and get another command

ERRORY:	MOVL	STACK,SP	;Clean up the stack
	BICL	#M_FLG!M_ENT,F	;Stop doing commands, clear enter mode
	JMP	INIERR		;Display cheery message

;Here to handle errors from setting files. They are special since SED can't
;just redisplay the screen - there might not be a file to redisplay
;Action: move old specs back to current; clear old specs
;If GFL do a normal error, else get current file or cheery message

STFERR::PUSHR	#^M<R1,R5>	;Save some registers
	MOVC3	#100,OLDSPC,FILSPC ;Restore previous file specs
	MOVC5	#0,OLDSPC,#0,#100,OLDSPC ;  and clear previous
	POPR	#^M<R1,R5>
	MOVL	OLDLEN,FSPLEN	;Restore the filespec length
	MOVQ	SAVERW,R7	;Get row and column back
	MOVL	SAVEDP,DISPTR	;Get display pointer
	MOVL	SAVESL,SL	;Set up slide
	BISL	#M_XPC!M_XPL!M_XPB,F ;No pointers are valid
	CVTBL	#-1,GOPRCT	;If user gave a /G: switch cancel it
	CLRB	OUTFLG		;Ditto an /OUT: switch
	MOVL	MFLPTR,R6	;Got another spec in tmp file?
	BEQL	STFER1		;No
	PUSHR	#^M<R1>		;Yes - save error message
	BSBW	SETMFE		;Read new specs into OLDSPC
	POPR	#^M<R1>		;Get error message back
STFER1::BBC	#V_GFL,F,10$	;Got a file to redisplay?
	BRW	ERROR		;Yes - output the error normally
10$:	BICL	#M_FLG,F	;No - turn off error routine's execute flag
	BSBB	ERRDSP		;Output the message
	TSTB	FILSPC		;Are there any other filespecs?
	BNEQ	20$
	JMP	REDNO		;No - go set up cheery message
20$:	TSTL	DISPTR		;Yes - need to parse specs?
	BNEQ	30$		;No
	BSBW	PARSEF		;Yes - do so
30$:	JMP	SETFL1		;Go try the other file

;Subroutine to output the error message in (R1)

ERRDSP::MOVL	R1,-(SP)	;Save message address
	BBC	#V_SLW,F1,10$	;Got a slow terminal?
	BRW	ERRDSW		;Yes - output only on first line
10$:	JSB	CLRALL		;Home and clear screen
	MOVAB	STARS,R1	;Put up upper stars
	JSB	PUTSTG
	MOVL	(SP)+,R1	;Restore message address
	BSBW	PUTSTE
	MOVAB	STARS,R1	;Put up lower stars
	JSB	PUTSTG
	JSB	PUTTYP		;Output the message
	SNOOZE	1500		;Sleep for 1.5 seconds
	TSTB	LNGSLP		;Need to do a long sleep?
	BEQL	ERRDS1		;No
	SNOOZE	5000		;Sleep for 5 seconds
ERRDS1:	CLRB	LNGSLP		;Reset long sleep flag
	BICL	#M_FLG,F	;Clear (execute) flag
	RSB			;Done

;If terminal is slow (SLW flag) put error message on bottom line

ERRDSW:	JSB	CBOTOM		;Go to bottom line
	MOVB	#7,(R5)+	;Beep once
	JSB	PROTON		;Turn protection on
	MOVL	(SP)+,R1	;Restore message address
	BSBW	PUTSTE		;Output message
	JSB	PROTOF		;Turn protection off again
	JSB	PUTTYP		;Output the message
	TSTB	LNGSLP		;Always delay when LNGSLP is set
	BNEQ	ERRDS3		;Even if NEL is set
	BBC	#V_NEL,F1,ERRDS3 ;Can bottom line stay fragged?
	BRB	ERRDW1		;Yes - no delay then
ERRDS3:	SNOOZE	1500		;Sleep for a second
	TSTB	LNGSLP		;Sleep even longer to read error message
	BEQL	ERRDS2
	SNOOZE	5000		;Sleep for five seconds
ERRDS2:	CLRB	LNGSLP		;Reset long sleep flag
ERRDW1:	BBCC	#V_FLG,F,10$	;Executing?
	JMP	DISPLL		;Yes - re-display the screen and return
10$:	BISL	#M_FBL,F	;Say bottom line will be fragged
	BBS	#V_NEL,F1,20$	;No - can bottom line remain fragged?
	BBC	#V_ENT,F,30$	;or has enter been typed?
20$:	RSB			;Any of these - done
30$:	TSTL	DISPTR		;Is there a current file?
	BEQL	20$		;No - done
	BBC	#V_GFL,F,20$	;(ditto)
	JMP	FIXBLN		;Yes - repair the bottom line and return

;*********************************************************
;Condition handler to expand memory by 1 page

GETAK::	.WORD	^M<R2,R3,R4>	;Entry mask for handler
	MOVL	CHF$L_SIGARGLST(AP),R4 ;Get address of signal array
	CMPL	#SS$_ACCVIO,CHF$L_SIG_NAME(R4)
				;Was it an access violation?
	BNEQ	10$		;No - I can't handle it
	ADDL	#4,R4
	MOVL	CHF$L_SIG_ARG1(R4),R2 ;Get address to change protection on
	CMPL	R2,#EDIT_BUFF_END ;Is the address within the edit buffer?
	BGTR	10$		;No
	CMPL	R2,#EDIT_BUFF_START ; ...
	BLSS	10$		;No
	MOVL	R2,PAGE_RANGE_TABLE ;Yes - prepare to create it
	MOVL	R2,PAGE_RANGE_TABLE+4
	$CRETVA_S INADR=PAGE_RANGE_TABLE ;Create the page
	BLBC	R0,10$		;Test for success
20$:	MOVZWL	#SS$_CONTINUE,R0 ;Indicate to continue on
	RET			;Return to dispatcher
10$:	MOVZWL	#SS$_RESIGNAL,R0 ;Indicate need to resignal
	RET			;Return to dispatcher

GLOB		;Define the global symbols
.END