Trailing-Edge
-
PDP-10 Archives
-
LCG_Integration_Tools_Clearinghouse_T20_v7_30Apr86
-
tools/sed-for-vms/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$: 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
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 the 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 - go get another
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$: 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
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$: BSBB ERRDSP ;No - output the message
BBCC #V_JRC,F1,STFER2 ;Recovering a journal?
BICL #M_XBN!M_XCT,F1 ;No longer showing journal recovery
MOVAB JRCERM,R1 ;Yes - point to the message
BSBB ERRDSP ;Output the journal failure message
STFER2: TSTB FILSPC ;Are there any other filespecs?
BNEQ 10$
JMP REDNO ;No - go set up cheery message
10$: TSTL DISPTR ;Yes - need to parse specs?
BNEQ 20$ ;No
BSBW PARSEF ;Yes - do so
20$: JMP SETFL1 ;Go try the other file
JRCERM: .ASCIZ /######Journal recovery aborted/
;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