Trailing-Edge
-
PDP-10 Archives
-
integ_tools_tops20_v7_30-apr-86_dumper
-
tools/sed-for-vms/sed1mv.mar
There are 5 other files named sed1mv.mar in the archive. Click here to see a list.
.TITLE SED1MV - General SED Non-file-modifying Commands
.LIBRARY /SEDITB.MLB/
.ENABLE DEBUG
.DISABLE GLOBAL
.PSECT CODE,NOWRT,EXE,LONG
.NOCROSS ;Don't cross-reference the definitions
FLGDEF ;Define the flag bits
TRMDEF ; and the terminal offsets
PRMDEF ; and the SED parameters
SEQDEF ; and the command codes
$IODEF ; and the I/O symbols
$RABDEF ; and the RAB offset symbols
.CROSS ;Resume cross-referencing
.EXTERNAL LIB$RUN_PROGRAM, LIB$DO_COMMAND
.EXTERNAL SS$_NORMAL
.SUBTITLE Illegal Command Processor
;Here for the illegal command
ILLCMD::JSB ERASPM ;Clear up the parameter stuff on the screen
ICMNPM::JMP ILCER2 ;Say the command is illegal and loop
.SUBTITLE Cursor Control Commands
;If enter was typed, UP goes to UPARG, LEFT to LFTARG
RGTARG::BBSS #V_CMV,F,RIGHT ;Already doing cursor movement?
BSBW MARKUP ;No - put cursor back in text
RIGHT:: BISL #M_XPC,F ;Character pointer is no longer good
RIGHT1::CMPL R8,CPL.1 ;Off the right side?
BGEQ 10$ ;Yes
INCL R8 ;No - just move right
BRW AJDONE
10$: MOVL LMARGN,R8 ;Go to the left margin
BISL #M_XPL!M_XPC,F ;Line pointer is no good either
CMPL R7,LPP.2 ;At bottom?
BGEQ 20$ ;Yes
INCL R7 ;No - drop down one more
BRW AJDON0
20$: INCL R7 ;See if screen should be rolled
BRW RETROL
DWNARG::BBSS #V_CMV,F,DOWN ;Already doing cursor movement?
BSBW MARKUP ;No - put cursor back in text
DOWN:: BISL #M_XPL!M_XPC,F ;Line pointer is no longer good
CMPL R7,LPP.2 ;At bottom?
BLSS 10$ ;No
TSTB RLCFLG ;Yes - want to roll or wrap around?
BEQL 5$ ;Wrap
INCL R7 ;Roll - go do it
BRW DWNROL
5$: CLRL R7 ;Yes - move to top
BRB AJDON0
10$: INCL R7 ;Drop down one more
BRB AJDONE
LEFT0: BBSS #V_CMV,F,LEFT ;Already doing cursor movement?
BSBW MARKUP ;No - put cursor back in text
LEFT:: BISL #M_XPC,F ;Character pointer is no longer good
SOBGEQ R8,AJDONE ;Move left - off the edge? No
MOVL CPL.1,R8 ;Yes - set to right edge and go up one
BISL #M_XPL!M_XPC,F ;Line pointer is no longer good
DECL R7 ;Move up
BGEQ AJDON0 ;Off the top?
BRB UPWRAP ;Yes - always wrap around
UPARG:: BBSS #V_CMV,F,UP ;Already doing cursor movement?
BSBW MARKUP ;No - put cursor back in text
UP:: BISL #M_XPL!M_XPC,F ;Line pointer is no longer good
SOBGEQ R7,AJDONE ;Move up - off the top?
TSTB RLCFLG ;Yes - want to roll or wrap around?
BEQL UPWRAP
BRW UPROLL ;Roll - go do it
UPWRAP: MOVL LPP.2,R7 ;Wrap - set to bottom
AJDON0: MOVL #$CURHM,R9 ;Make cursor position absoluetely
AJDONE::CMPB #$CURLF,R9 ;Else want a cursor left?
BNEQ 10$ ;No
JSB CLEFT ;Yes - handle separately
BRB AJDON1
10$: CMPB R9,#$ENTER+1 ;Got a real cursor move?
BLSS AJDON2 ;No - no output then
SUBL3 #^O34,R9,R0
MOVL CMVTBL[R0],R0 ;Yes
JSB (R0) ;Move the cursor the right way
AJDON1: JSB PUTTYP
AJDON2: BBC #V_FLG,F,10$ ;Want a subroutine return?
RSB ;Yes
10$: JMP LOOP ;No - go get more input
HOMARG::BBSS #V_CMV,F,HOME ;Already doing cursor movement?
BSBW MARKUP ;No - put cursor back in text
HOME:: CLRL R7 ;Set to top and left margin of screen
CLRL R8
BISL #M_XPL!M_XPC,F ;Line and character pointers are invalid
JSB CHOME ;Move the cursor home
JSB PUTTYP ;Else output it now
JMP LOOP
;LFTARG is special: it operates both as cursor movement and to delete
;from the parameter buffer
LFTAG0::MOVZBL #$CURLF,R9 ;Set up the index for cursor left
LFTARG::BBC #V_CMV,F,5$ ;Doing cursor movement?
BRW LEFT
5$: BBCC #V_PST,F1,10$ ;Is this the first character of the parameter?
BRW LEFT0 ;Yes - start cursor movement
10$: CMPL #PARBUF,PARPTR ;User deleted all of parm?
BNEQ 20$ ;No
JMP LOOP ;Yes - just skip it
20$: DECL PARPTR ;Decrement the parameter pointer
JSB CLEFT ;Erase a character of parameter
MOVB #^A" ",(R5)+
JSB CLEFT
JSB PUTTYP
JMP LOOP ;and get a new command
;Here for <CR> - output a carriage return-linefeed
RETARG::BBSS #V_CMV,F,RETUR0 ;Already doing cursor movement?
BSBW MARKUP ;No - put cursor back in text
BRB RETUR0
RETURN::BBS #V_IMD,F,RETIMD ;If in insert mode, act like open-line command
RETUR0: MOVL LMARGN,R8 ;Go to the left margin
INCL R7 ;and down one
BISL #M_XPL!M_XPC,F ;Line and character pointers are invalid
CMPL R7,LPP.2 ;Off the bottom?
BLEQ RETUR1 ;No
BRW RETROL ;Yes - move to the top or roll
RETUR1: JSB POSCUR ;Move to the right line
JMP LOOP ;and get another command
;Here for return in insert mode: insert a line, then return
RETIMD: BBC #V_NCR,F,10$ ;Behave like a normal CR?
BRB RETUR0 ;Yes - go back and return
10$: BBC #V_RDO,F,20$ ;Is file read-only?
JMP RDOERR ;Yes - command is illegal
20$: DECL ISVCNT ;Decrement incremental save counter
JSB CLRLNR ;Clear to end of present line
BSBW MAKCPT ;Re-make cursor position
ADDL3 #2,LMARGN,NUMCHR ;Insert a CRLF plus enough spaces
; to get to the left margin
BSBW MAKSPC
BISL #M_XPB!M_XPC!M_CHG,F ;Say bottom pointer bad; file modified
MOVL CHRPTR,R6 ;Get pointer to cursor position
MOVW #^X0A0D,(R6)+ ;Set up a new line
MOVL R6,LINPTR ;It's now the line pointer, too
MOVL LMARGN,R8 ;Go to the left margin
INCL R7
CMPL R7,LPP(R10) ;Working on the bottom line?
BGEQ RETROL ;Yes - move to the top or roll
MOVL ILN(R10),R3 ;Can terminal open its own lines?
BNEQ 30$ ;Yes
JMP DISDWN ;No - go redisplay from here down
30$: JSB POSLIN ;Position to the beginning of the line
MOVL R3,R1 ;Get the open-lines character sequence
JSB PUTSEQ ;Output it
JSB DISONL ;Re-write the line
JSB FIXBLW ;Put messages, if any, on the bottom line
JMP DISCUR ;Position cursor, output, and loop
;Here if return typed at bottom of screen. If NRC flag is set
;roll the screen one line, position to new bottom. Else go to top
RETROL::BBC #V_NRC,F,DWNROL ;Want to roll?
CLRL R7 ;No - move to the top
BRW RETUR1 ;and continue
DWNROL: BBC #V_ENT,F,20$ ;Entering a parameter?
DECL R7 ;Yes - do nothing
JMP LOOP
20$: MOVZBL #1,R4 ;Set to roll down one line
BRW RFLNP1 ;Do the roll and loop
;Here when RLCFLG is on, the cursor was on the top line, and cursor-up
;was typed. Roll the screen down a line
UPROLL: CMPL DISPTR,#BUFFER ;Already at the top of the file?
BNEQ 10$
INCL R7 ;Yes - do nothing
5$: JMP LOOP
10$: BBS #V_ENT,F,5$ ;No - entering a parameter?
MOVZBL #1,R4 ;No - set to roll one line
BRW RBLNPM ;Do the roll and loop
.SUBTITLE Up-down Tab and Beg/End Line Commands
;*************************************************************************
;UP-TAB: Move the cursor up 6 lines
UPTARG::BBSS #V_CMV,F,UPTAB ;Already doing cursor movement?
BSBW MARKUP ;No - put cursor back in text
UPTAB:: BISL #M_XPL!M_XPC,F ;Line pointer is no longer good
SUBL #6,R7 ;Move up six lines
BGEQ 10$ ;Wrap around the top?
ADDL LPP(R10),R7 ;Yes - wrap back to the bottom
10$: JMP DISCUR ;Re-position the cursor; done
;DOWN-TAB: Move the cursor down 6 lines
DNTARG::BBSS #V_CMV,F,DNTAB ;Already doing cursor movement?
BSBW MARKUP ;No - put cursor back in text
DNTAB:: BISL #M_XPL!M_XPC,F ;Line pointer is no longer good
ADDL #6,R7 ;Move down six lines
CMPL R7,LPP.1 ;Wrap around the bottom?
BLEQ 10$ ;No
SUBL LPP(R10),R7 ;Yes - come back down the top
10$: JMP DISCUR ;Re-position cursor; done
;Move to start of the current line
BLIARG::BBSS #V_CMV,F,BLINE ;Already doing cursor movement?
BSBW MARKUP ;No - put cursor back in text
BLINE:: MOVL LMARGN,R8 ;Go to the left margin
BISL #M_XPC,F ;Character pointer is bad
JMP DISCUR ;Display the cursor and loop
;Move to the end of the current line
ELIARG::BBSS #V_CMV,F,ELINE ;Already doing cursor movement?
BSBW MARKUP ;No - put cursor back in text
ELINE:: BISL #M_XPC!M_XPL,F ;Character and line pointers are bad
CLRL R8 ;Move to the beginning of the next line
INCL R7
BRW WBTAB ;and do a wordwise backtab from there
.SUBTITLE Tab and Backtab Commands
;Here for tab - move cursor pointer and cursor on screen
TABARG::BBSS #V_CMV,F,TAB ;Already doing cursor movement?
BSBW MARKUP ;No - put cursor back in text
TAB:: BBS #V_WTB,F,WTAB ;Want word-wise tabs? Yes - go do them
TAB0: BISL #M_XPC,F ;Mark character pointer as bad
BBC #V_STB,F1,20$ ;Want settable tabs?
BRW TABTB ;Yes - go do them
20$: MOVL TABLEN,R3 ;Get length of a tab
CMPB #8,R3 ;Is it the usual?
BNEQ TAB0A ;No - handle it specially
BICL #7,R8 ;Yes - tab over
ADDL #8,R8
BRB TAB1
TAB0A: TSTL R3 ;Zero-length tab?
BNEQ 10$ ;No
BRW RETUR0 ;Yes - go to start of next line
10$: DIVL R3,R8 ;Move back to previous user-set tab stop
MULL R3,R8
ADDL R3,R8 ;Then jump to the next one
TAB1: CMPL R8,CPL.1 ;Off the right side?
BLSS 10$
BRW RETUR0 ;Yes - go to start of next line
10$: JMP DISCUR ;No - position the cursor and get new command
;Here for doing a tab in word-processing mode: move to start of next word
;ie, look for next space or tab; point to non-space or tab after that
;If beyond end of line just do regular tabs
;If tab would go off screen move to start of next line
WTAB: BBC #V_XPC,F,10$ ;Got pointer to current position?
BSBW MAKCPT ;No - re-make it
10$: MOVL CHRPTR,R6
MOVL R8,R3 ;Save current position
WTAB1: CMPL R6,EN ;At end of the usable buffer?
BNEQ 10$ ;No
5$: BRW WTABT ;Yes - do a normal tab
10$: MOVZBL (R6)+,R1 ;Get first character
BEQL WTAB1 ;Ignore if null
CMPB R1,#^O15 ;Carriage return?
BEQL 5$ ;Yes - do a normal tab
CMPB R1,#^A" " ;Space?
BNEQ 20$ ;No
INCL R8 ;Yes - check for trailing spaces
BRB WTABS
20$: CMPL R1,#9 ;Tab?
BNEQ 30$ ;No
BRW WTABS1 ;Yes - check for trailing spaces
30$: INCL R8 ;Bump position number
MOVL R8,R3
BRB WTABC1
WTABC: MOVL R8,R3 ;Save position number
WTABC1: MOVL R6,R2 ;and character pointer
10$: MOVZBL (R6)+,R1 ;Get next character
BEQL 10$ ;Ignore if null
CMPB R1,#^A" " ;Is it a space?
BNEQ 20$ ;No
INCL R8 ;Yes - phase two
BRB WTABCS
20$: CMPB R1,#9 ;No - is it a tab?
BEQL WTABCT ;Yes - count it and skip spaces
CMPB R1,#^O15 ;No - got a carriage return?
BEQL WTABX ;Yes
INCL R8 ;No - skip it
BRB WTABC
WTABX: MOVL R3,R8 ;Get position before trailing spaces
WTABX0: MOVL R2,CHRPTR ;Save character pointer
BRW TAB1 ; and finish off
WTABCT: BICL #7,R8 ;Tab over
ADDL #8,R8
WTABCS: MOVL R8,SAVEAC ;Save position
MOVL R6,R0 ; and character position
10$: MOVB (R6)+,R1 ;Get next character
BEQL 10$ ;Ignore if null
CMPB R1,#^O15 ;Got a carriage return?
BEQL WTABX ;Yes - position to end of line
CMPB R1,#^A" " ;Space?
BNEQ 20$ ;No
INCL R8 ;Yes - skip until not one of those
BRB WTABCS
20$: CMPB R1,#9 ;Tab?
BNEQ 30$ ;No
BRB WTABCT ;Yes - count the tab and skip it
30$: MOVL SAVEAC,R8 ;Get pointer to this character
MOVL R0,CHRPTR
BRW TAB1 ;and move cursor here
;Here if character at cursor is space or tab
WTABS: MOVL R6,R2 ;Save position
10$: MOVZBL (R6)+,R1 ;Get character after <CR>
BEQL 10$ ;Ignore if null
CMPB R1,#^A" " ;Space?
BNEQ 20$ ;No
INCL R8 ;Yes - count and skip it
BRB WTABS
20$: CMPB R1,#^O15 ;Carriage return?
BEQL WTABT ;Yes - position to end of line
CMPB R1,#9 ;Tab?
BEQL WTABS1 ;Yes
BRB WTABX0 ;No - position to current character
WTABS1: BICL #7,R8 ;Yes - tab over
ADDL #8,R8
BRB WTABS ;and keep skipping
WTABT: MOVL R3,R8 ;Here if at end of line - get starting CM
BRW TAB0 ; and do a normal tab
;Here to do a tab using the user's settings
;Does a carriage return if no tabs are left on this line
TABTB: ADDL3 #1,R8,R1 ;Get the column
CLRL R2 ;Prepare for EDIV
EDIV #32,R1,R4,R3 ;Get longword & position in longword
MULL #4,R4 ;Convert offset to bytes
SUBL3 R3,#32,R2
FFS R3,R2,L^TABTBL(R4),R1 ;Find the next "1" bit
BNEQ TABTB2 ;Found the bit
TABTB1: ADDL #4,R4 ;Increment to the next longword
CMPL R4,#16 ;Done enought longwords?
BLEQ 10$ ;No
BRW RETUR0 ;Yes - go to start of nextline
10$: TSTL L^TABTBL(R4) ;Any tabs in the next longword?
BEQL TABTB1 ;No
FFS #0,#32,L^TABTBL(R4),R1 ;Yes - find the next one
BNEQ TABTB2 ;Was it found? Yes
BRB TABTB1 ;No
TABTB2: MULL #8,R4 ;Convert longword & position back to cursor value
ADDL3 R1,R4,R8 ;Change column position
CMPL R8,CPL.1 ;Off the right side?
BLSS 10$ ;No
BRW RETUR0 ;Yes - go to start of next line
10$: JMP DISCUR ;Done
;Here to handle a back-tab - move back to the nearest tab stop
BTBARG::BBC #V_CMV,F,10$ ;Doing cursor movement?
BRW BAKTAB ;Yes - move the cursor
10$: CMPL PARPTR,#PARBUF ;Is this the 1st character of the parameter?
BNEQ 20$ ;No
BRW BAKTBA ;Yes - start cursor movement
20$: MOVL PARPTR,R2 ;Set up the pointer into the parameter buffer
MOVL #1,R3 ;and set up count of characters deleted
BTBAG1: BSBB BTBGET ;Get next most-recent character
CMPB R1,#^A" " ;Space?
BEQL 10$ ;Yes
CMPB R1,#9 ;or tab?
BNEQ 20$ ;No
10$: INCL R3 ;Yes - skip over it
BRB BTBAG1
20$: CMPB R1,#^A"0" ;Numeric?
BLSS 30$ ;No - keep checking
CMPB R1,#^A"9"
BGTR 30$
BRB BTBAG2 ;Yes - phase two
30$: CMPB R1,#^A"A" ;Alphabetic?
BLSS 40$
CMPB R1,#^A"Z"
BLEQ BTBAG2 ;Yes - phase two
40$: BRB BTBGX0 ;No - stop on the special character
BTBAG2: BSBB BTBGET ;Get next-most-recent character
CMPB R1,#^A"0" ;Numeric?
BLSS 20$ ;No - keep checking
CMPB R1,#^A"9"
BGTR 20$
10$: INCL R3 ;Yes - skip over it
BRB BTBAG2
20$: CMPB R1,#^A"A" ;Alphabetic?
BLSS BTBAGX ;No - stop here
CMPB R1,#^A"Z"
BGTR BTBAGX
BRB 10$ ;Yes - skip over it
BTBGX0: BSBB BTBGET ;Back over one more character
BTBAGX: ADDL3 #1,R2,PARPTR ;Save adjusted parameter pointer
MOVZBL #^A" ",R4
BTBGX1: JSB CLEFT ;Erase a character of parameter
MOVB R4,(R5)+
JSB CLEFT
SOBGTR R3,BTBGX1 ;Loop through all characters
JSB PUTTYP
JMP LOOP ;Then get a new command
;Backtab subroutine to get the next-latest parameter character
BTBGET: CMPL R2,#PARBUF ;Reached beginning of the parameter buffer?
BNEQ 10$ ;No
JMP KILPAR ;Yes
10$: MOVZBL -(R2),R1 ;Get the next character
CMPB R1,#^A"a" ;Lower case (maybe)?
BLSS 20$ ;No
SUBB #^O40,R1 ;Yes - convert to (maybe) upper
20$: RSB ;Done
;Here to do a backtab on the screen
BAKTBA: BISL #M_CMV,F ;Set up for cursor movement
BSBW MARKUP
BAKTAB::BBC #V_WTB,F,10$ ;Want word-wise backtabs?
BRB WBTAB ;Yes - go do them
10$: BBC #V_STB,F1,20$ ;Has the user defined any tabs?
BRW BTBTB ;Yes - go handle them
20$: BISL #M_XPC,F ;Character pointer is bad
CMPL #8,TABLEN ;Is length of tab the usual?
BNEQ BAKTB0 ;No - handle it specially
BITL #7,R8 ;Yes - tab backward
BNEQ 30$
SUBL #8,R8
30$: BICL #7,R8
BRB BAKTB1 ;Finish off
BAKTB0: DECL R8 ;Decrement position. If at left,
BLSS BAKTB2 ; move to right of previous line
TSTL TABLEN ;Tab length of zero?
BNEQ 10$ ;No
CLRL R8 ;Yes - move to left margin
BRB BAKTB1
10$: DIVL TABLEN,R8 ;Else move to previous tab stop
MULL TABLEN,R8
BAKTB1: TSTL R8 ;If on screen,
BLSS BAKTB2
JMP DISCUR ; then done
BAKTB2: MOVL CPL.1,R8 ;Else move to right
SOBGEQ R7,10$ ; of next higher line
MOVL LPP.2,R7 ;If at top, move to bottom
10$: JMP DISCUR
;Here for doing a back-tab in word-processing mode
;Move to start of previous word
;ie, look for next space or tab; point to next non-space or tab
;If at start of line, move to end of previous line (but not off screen)
WBTAB:: BBC #V_XPC,F,10$ ;Got pointer to current position?
BSBW MAKCPT ;No - re-make it
10$: BBC #V_XPL,F,20$ ;Is cursor beyond end of buffer?
BRW WBTABO ;Yes - move it to end of last line
20$: TSTL R8 ;If at start of line, move to end of previous
BNEQ 30$
BRB WBTABB
30$: MOVL CHRPTR,R6 ;Start with character at cursor
WBTABS: DECL R6 ;Skip spaces after word
WBTBS1: MOVB (R6),R1
BEQL WBTABS ;Ignore if null
CMPB R1,#^A" " ;Space?
BEQL WBTABS ;Yes - ignore it
CMPB R1,#9 ;or tab?
BEQL WBTABS ;Yes - skip until not one of those
CMPB R1,#^O12 ;No - got a line feed?
BNEQ WBTABC ;No
BRB WBTABL ;Yes - check for end of line
WBTABC: MOVZBL -(R6),R1 ;Skip to beginning of previous word
WBTBC1: CMPB R1,#^A" " ;Is it a space?
BEQL WBTABX ;Yes - done
CMPB R1,#9 ;or a tab?
BEQL WBTABX ;Yes
CMPB R1,#^O12 ;No - got a linefeed?
BNEQ WBTABC ;No - keep skipping
BRB WBTABL ;Yes - check for end of line
WBTABX: INCL R6
MOVL R6,CHRPTR ;Save pointer to start of next word
MOVL LINPTR,R6 ;Get pointer to start of line
BRW WBTABE ; and finish off
WBTABL: MOVZBL -(R6),R1 ;Get character before <LF>
CMPB R1,#^O15 ;Carriage return?
BEQL WBTBL1 ;Yes
BRB WBTBC1 ;No - keep looking
WBTBL1: CLRL R8 ;Yes - position to start of line
BISL #M_XPC,F ;Make char ptr get re-made
JMP DISCUR ;Position cursor; done
WBTABB: SOBGEQ R7,10$ ;Move up a line - already at top?
BRW HOME ;Yes - just go home
10$: MOVL DISPTR,R3 ;Fudge pointer to start of line
MOVL LINPTR,DISPTR ; to be display pointer
MOVL #1,R4 ;Back up to start of previous line
TSTL SL ;Slide in effect?
BEQL 20$ ;No
MOVL LINPTR,CHRPTR ;Yes - pretend pointing to start of line
20$: BSBW BAKDPT
MOVL R3,DISPTR ;Save real display pointer again
MOVL R6,LINPTR ;Save re-done line pointer
SUBL3 #1,CHRPTR,R4 ;Now find end of line
WBTBB1: DECL R4 ;Point to previous character
WBTBB2: MOVZBL (R4),R1 ;Get previous character
CMPB R1,#^O15 ;Carriage return?
BEQL WBTBB1 ;Yes - skip it
CMPB R1,#^A" " ;Trailing space?
BEQL WBTBB1
CMPB R1,#9 ; or tab?
BEQL WBTBB1 ;Yes - skip it
CMPB R1,#^O12 ;Nothing on this line?
BNEQ 20$
BBCC #V_FLG,F,10$ ;Yes - want to re-do row?
BSBW CALCRW ;Yes (only if beyond end of buffer)
10$: BRB WBTBL1 ;Move to start of line
20$: INCL R4 ;Point 1 past the end of the line
MOVL R4,CHRPTR ;Save character pointer
BBCC #V_FLG,F,30$ ;Want to re-do row?
BSBW CALCRW ;Yes (only if beyond end of buffer)
30$: MOVL LINPTR,R6 ;Save re-done line pointer
WBTABE: CLRL R8 ;Clear column number
WBTBE0: CMPL R6,CHRPTR ;Up to character position?
BEQL WBTBE1 ;Yes - finish off
MOVZBL (R6)+,R1 ;Get next character
BEQL WBTBE0 ;Ignore if null
CMPB R1,#9 ;Tab?
BEQL 10$ ;Yes
INCL R8 ;No - count as one character
BRB WBTBE0
10$: BICL #7,R8 ;Yes - count the tab
ADDL #8,R8
BRB WBTBE0
WBTBE1: SUBL SL,R8 ;Remove the slide from the column
BLSS WBTBE2 ;Jump if off the left
CMPL R8,CPL.1 ;Off the right?
BGTR 10$
JMP DISCUR ;No - go display
10$: MOVL CPL.1,R8 ;Position cursor at right
BRB WBTBE3
WBTBE2: CLRL R8 ;Position cursor at left
WBTBE3: BISL #M_XPC,F ;Column pointer is not good
JMP DISCUR
WBTABO: BISL #M_FLG,F ;Set flag so row will be re-made
MOVL CHRPTR,R4 ;Get pointer to current character
BRW WBTBB2 ;Back up to end of last line
;Here to do a tab using the user's settings. If no tabs left, goes to
;start of line. If at start, goes to last tab on previous line
BTBTB: TSTL R8 ;At beginning of line?
BNEQ 30$ ;No
TSTL R7 ;Yes - already at home position?
BNEQ 20$ ;No
JMP DISCUR ;Yes - freeze there
20$: BISL #M_XPL,F ;Else mark line pointer as bad
MOVL CPL.1,R8 ;and find last tab on previous line
DECL R7
BRB BTBTB
30$: BISL #M_XPC,F ;Character pointer is no good
SUBL3 #1,R8,R4 ;Compute previous column number
BEQL 50$ ;At beginning of line? Yes
40$: EXTZV R4,#1,TABTBL,R1 ;Is a tab stop set here?
BNEQ 60$ ;Yes
SOBGTR R4,40$ ;Go check the next column
50$: CLRL R8 ;No previous tab stop - go to start of line
JMP DISCUR
60$: MOVL R4,R8 ;Set up the right column number
JMP DISCUR ;and go finish off
.SUBTITLE Tab-set and Tab-clear Routines
;Here for settable tab stops - set a stop
TABSET::BBSS #V_STB,F1,10$ ;Are settable tabs already in effect?
BSBW TABINI ;No - preset /T:n tabs
10$: MOVL R8,R1 ;Get the column
CLRL R2 ;Prepare for EDIV
EDIV #32,R1,R4,R3 ;Get longword and position in longword
MULL #4,R4 ;Convert offset to bytes
INSV #1,R3,#1,L^TABTBL(R4) ;Set the tab bit
JMP DISCUR ;Done
;Here to clear a tab stop, or do special functions
TABCLR::MOVQ SAVPOS,R7 ;Restore saved position
BBSC #V_CMV,F,TBSERR ;Did user use cursor movement?
CMPL #PARBUF,PARPTR ;No - got a parameter?
BEQL TBCLR1 ;No - just clear one tab
CLRB @PARPTR ;Yes - end parameter buffer with a null
MOVZBL PARBUF,R1 ;Get 1st character of parameter
CMPB R1,#^A"C" ;Some type of "C"?
BEQL TBCLRC ;Yes - clear all tab settings
CMPB R1,#^A"c"
BEQL TBCLRC
CMPB R1,#^A"D" ;Want to display the settings and a ruler?
BEQL TBCLRD
CMPB R1,#^A"d"
BEQL TBCLRD ;Yes - go do so
TBSERR: MOVAB TBSERM,R1
JMP ERROR
TBCLR1: BBSS #V_STB,F1,10$ ;Are settable tabs already in effect?
BSBW TABINI ;No - preset /T:n tabs
10$: MOVL R8,R1 ;Get the column
CLRL R2 ;Prepare for EDIV
EDIV #32,R1,R4,R3 ;Get longword and position in longword
MULL #4,R4 ;Convert offset to bytes
INSV #0,R3,#1,L^TABTBL(R4) ;Clear the tab bit
TBCLRX::JSB ERASPM ;Erase the parameter
JSB PUTTYP ;Output the erasure
JMP LOOP ;Done
TBCLRC: CLRQ TABTBL ;Zero the entire tab table
CLRQ TABTBL+8
CLRL TABTBL+16
BISL #M_STB,F1 ;Insure settable tabs in effect
BRB TBCLRX
;Here to display the current tab settings and a ruler
;on the bottom line of the screen
TBCLRD: JSB SWHBOT ;Set up the bottom line
MOVL R5,SAVEAC ;Save pointer to start of ruler
MOVZBL #14,R4 ;Output 14 copies of the ruler
10$: MOVAB TBCLRM,R1
JSB PUTSTG
SOBGTR R4,10$
CLRL R1 ;Initialize the column counter
MOVL LMARGN,R6 ;Get the left margin setting
MOVZBL #^A"/",R0 ;and the left-margin-marking character
TBCRD0: MOVZBL #32,R3 ;Count through all the bits in the longword
MOVL L^TABTBL(R4),R2 ;Get a longword from the table
TBCRD1: CMPL R1,R6 ;At the left or right margin?
BEQL TBCRDL ;Yes - mark this position
BITL #1,R2 ;Test the bit
BEQL TBCRD2 ;Was it set?
MOVB #^A"-",@SAVEAC ;Yes - mark it as having a tab set
TBCRD2: INCL SAVEAC ;Step to next ruler character
INCL R1 ;and count the character position
ROTL #-1,R2,R2 ;Go to the next tab bit
SOBGTR R3,TBCRD1 ;Count it and loop
CMPL R4,#16 ;Any more longwords in the table?
BGEQ 20$ ;No
ADDL #4,R4 ;Yes - step to the next one
BRB TBCRD0
20$: JMP SWHNPE ;Finish off, output ruler, and loop
TBCRDL: MOVB R0,@SAVEAC ;Mark the left or right margin
MOVZBL #^A"\",R0 ;Get the right-margin-marking character
MOVL RMARGN,R6 ;and the right margin setting
BRB TBCRD2
TBCLRM: .ASCIZ /1234567890/
TBSERM: .ASCIZ /####Bad parameter for <TAB-SET>/
;Subroutine to initialize the tab table to the current /T:n tabs
TABINI::CLRQ TABTBL ;Clear any previous tab stops
CLRQ TABTBL+8
CLRL TABTBL+16
TSTL TABLEN ;Any tabs defined?
BNEQ 10$ ;Yes
RSB ;No
10$: PUSHR #^M<R2,R4> ;Save the necessary registers
CLRL R4 ;Clear the index into the tab table
CLRL R2 ;and the pointer to the bit
TABIN1: INSV #1,R2,#1,L^TABTBL(R4) ;Set a tab stop
ADDL TABLEN,R2 ;Step to the next tab stop
CMPL R2,#32 ;End of the word?
BLSS TABIN1 ;No - continue
SUBL #32,R2 ;Yes - step to the next longword
ADDL #4,R4
CMPL R4,#20 ;Done enough longwords?
BLSS TABIN1 ;No
POPR #^M<R2,R4> ;Yes - restore the registers
RSB ;and return
.SUBTITLE Percent-goto Command Processor
;************************************************************************
;Here to go to some given percent of the file
;Exception: GOTO 100% puts up the lst LINROL lines invariably
PERCEN::MOVL GOPERC,PARG1 ;Set up last time's nominal
BSBW PEEL.1 ;Read new parm, if any
MOVL #100,R4 ;Assume just enter-percent typed
TSTL R1 ;Was it?
BEQL 10$ ;Yes
MOVL PARG1,R4 ;No - get percent to move
10$: JSB RESTPM
TSTL R4 ;Negative percentage?
BGEQ 20$ ;No
15$: BRW PERERR ;Yes - error
20$: CMPL R4,#100 ;Also error if larger than 100
BGTR 15$
MOVL R4,GOPERC ;Else save as new nominal
BBC #V_XCI,F1,PERNPM ;Initializing for an execute?
JMP LOOP ;Yes - done now
PERNPM::BSBW PUSMKS ;Push display pointer on the marker stack
CLRQ R7 ;Put cursor in upper left
MOVL GOPERC,R4 ;Set up last time's nominal
BNEQ 10$ ;Goto 0 percent?
BRW PERCST ;Yes
10$: BISL #M_XPL!M_XPC!M_XPB,F ;No - mark no pointers as valid
CMPL R4,#100 ;Goto 100 percent?
BEQL PERCND ;Yes - handle specially
SUBL3 #BUFFER,EN,R1 ;Get size of file
MULL R4,R1 ;Times distance user wants to go
DIVL #100,R1 ;Divided into 100 pieces
ADDL #BUFFER,R1 ;gives pointer into file
MOVL R1,DISPTR ;Save as new display pointer
MOVL #1,R4 ;Go to the start of the next line
CMPL #BUFFER,R1 ;Don't back up if at the start
BEQL PERDIS
BSBW ADVDPT
BRB PERDIS ;Re-display and get another command
PERCND: MOVL EN,DISPTR ;Display from one rolls-worth from end of file
MOVL LINROL,R4
BSBW BAKDPT
MOVL EN,R2 ;Point to last real file character
PERCD1: MOVZBL -(R2),R1 ;Back it up a notch and get character
CMPB R1,#^A" " ;Is it a real character?
BLSS PERCD1 ;No - keep looking
CMPL DISPTR,R2 ;Is character pointer on screen?
BLSS 10$
CLRQ R7 ;No - move cursor home
BISL #M_XPC,F ;Character pointer is bad
BRB PERCD2 ;Finish off
10$: MOVL R2,CHRPTR ;Position cursor to the very end of file
BSBW CALCRW ;Calculate proper value of r7
BSBW CALCML ;Calculate proper value of r8
BLBC R0,20$ ;Did slide take place?
INCL R8 ;No - move two columns away from last character
BRB PERCD2
20$: INCL R7 ;Yes - move to start of next line
CLRL R8
CLRL SL
BISL #M_XPL!M_XPC!M_XPB,F ;Mark no pointers as valid
BRB PERDIS
PERCD2: BISL #M_XPC!M_XPB,F ;Line pointer is the only one O.K.
PERDIS: BBC #V_RST,F,10$ ;Want to restore nominals?
CLRL GOPERC ;Yes - set back to zero percent
10$: TSTL R9 ;If user command,
BNEQ 20$ ; re-display and loop
JMP NEWFL0 ;Else if /GO switch do it startup-wise
20$: JMP DISALL
PERCST: BSBW PNTSTT ;Set up pointers to start of file
BRB PERDIS ;Re-display and get another command
PERERM: .ASCIZ /#Percent must be between 0 and 100/
PERERR: MOVAB PERERM,R1
JMP ERROR
.SUBTITLE Slide Left and Right Commands
;***********************************************************************
;Here to slide the viewing window to the left
SLIDEL::MOVL SLIDES,PARG1 ;Set up last time's slide as nominal
BSBW PEEL.1 ;Read new parm, if any
MOVL PARG1,R4 ;Get lines to roll
MOVL R4,SLIDES ;Save as new nominal
JSB ERASPM
BBC #V_XCI,F1,SLLNPM ;Initializing for an execute?
JMP LOOP ;Yes - done now
SLLNPM::TSTL SLDFLG ;Never want to slide?
BNEQ 10$
5$: JMP LOOP ;Right - don't
10$: TSTL SL ;Nothing to do if at left margin
BEQL 5$
MOVL SLIDES,R4 ;Get distance to slide
ADDL R4,R8 ;Keep cursor in same position in text
SUBL R4,SL ;Slide to the left
BGEQ 20$ ;Gone too far?
ADDL SL,R8 ;Yes - stop at left edge
ADDL SL,R4
CLRL SL
20$: CMPL R8,CPL.1 ;Has cursor gone off the right?
BLSS SLREND ;No - O.K.
MOVL CPL.1,R8 ;Yes - move it to the edge of the screen
BISL #M_XPC!M_XPB,F ; (Pointers are now bad)
BRB SLREND ;No - re-display screen and loop
;Here to slide the viewing window to the right
SLIDER::MOVL SLIDES,PARG1 ;Set up last time's slide as nominal
BSBW PEEL.1 ;Read new parm, if any
MOVL PARG1,R4 ;Get lines to roll
BBC #V_CMV,F,10$ ;Cursor movement?
MOVL PARG2,R4 ;Yes - get change in columns
10$: MOVL R4,SLIDES ;Save as new nominal
JSB ERASPM
BBC #V_XCI,F1,SLRNPM ;Initializing for an execute?
JMP LOOP ;Yes - done now
SLRNPM::TSTL SLDFLG ;Never want to slide?
BNEQ 10$
JMP LOOP ;Right - don't
10$: MOVL SLIDES,R4 ;Get the distance to slide
ADDL R4,SL ;Slide to the left
SUBL R4,R8 ;Keep cursor in same position in text
BGEQ SLREND ;Has cursor gone off the left?
MOVL LMARGN,R8 ;Go to the left margin
BISL #M_XPC!M_XPB,F ; (Pointers are now bad)
SLREND: BBC #V_RST,F,10$ ;Want to restore the nominal parameter?
MOVL SLIDNM,SLIDES ;Yes - set it back to the default
10$: JMP DISALL ;Yes - re-display screen and loop
.SUBTITLE Roll Commands
;***********************************************************************
;Here to roll forward a given number of pages (the easy way)
ROLFWP::MOVL ROLPGS,PARG1 ;Set up last time's roll as nominal
BSBW PEEL.1 ;Read new parm, if any
MOVL PARG1,R4 ;Get lines to roll
MOVL R4,ROLPGS ;Save as new nominal
JSB RESTPM ;Erase parameter first
BBC #V_XCI,F1,RFPNPM ;Initializing for an execute?
JMP LOOP ;Yes - done now
RFPNPM::MOVL ROLPGS,R4 ;Set up last time's nominal
BEQL 10$ ;Any? No
BSBW PUSMKS ;Yes - push tie display ptr on the marker stack
10$: MULL LPP(R10),R4 ;Get number of lines to roll
BBC #V_WDW,F1,20$ ;In a window?
TSTL HOMPOS ;Yes - in top window?
BNEQ 20$ ;No
DECL R4 ;Yes - do one line fewer
20$: MOVL R4,ROLLS ;Save as parm to ROLFW
BSBW ROLFW ;Do the roll
RFPEND: BBC #V_RST,F,10$ ;Want to restore the nominal parameter?
MOVL #1,ROLPGS ;Yes - set it back to one
10$: JMP LOOP ;Then get another command
;Here to roll backward a given number of pages (also the easy way)
ROLBKP::MOVL ROLPGS,PARG1 ;Set up last time's roll as nominal
BSBW PEEL.1 ;Read new parm, if any
MOVL PARG1,R4 ;Get lines to roll
MOVL R4,ROLPGS ;Save as new nominal
JSB RESTPM ;Erase parameter first
BBC #V_XCI,F1,RBKNPM ;Initializing for an execute?
JMP LOOP ;Yes - done now
RBKNPM::MOVL ROLPGS,R4 ;Set up last time's nominal
BEQL 10$ ;Any? No
BSBW PUSMKS ;Yes - push tie display ptr on the marker stack
10$: MULL LPP(R10),R4 ;Get number of lines to roll
BBC #V_WDW,F1,20$ ;In a window?
TSTL HOMPOS ;Yes - in top window?
BNEQ 20$ ;No
DECL R4 ;Yes - do one line fewer
20$: MOVL R4,ROLLS ;Save as parm to ROLBK
BSBW ROLBK ;Go do the work
BRB RFPEND ;and get another command
;Here to roll forward a given number of lines
ROLFWL::MOVL ROLLIN,PARG1 ;Set up last time's roll as nominal
BSBW PEEL.1 ;Read new parm, if any
TSTL R1 ;Want scan mode?
BNEQ 10$ ;No
BISL #M_SCN,F ;Yes - set flag
BRB RFLNP0
10$: MOVL PARG1,R4 ;Get lines to roll
MOVL R4,ROLLIN ;Save as new nominal
RFLNP0: JSB ERASPM ;Erase parameter first
BBC #V_XCI,F1,RFLNPM ;Initializing for an execute?
JMP LOOP ;Yes - done now
RFLNPM::MOVL ROLLIN,R4 ;Set up last times roll as nominal
RFLNP1: MOVL R4,ROLLS ;Save also as parm to ROLFW
BSBB ROLFW ;Go do the actual rolling
BBS #V_SCN,F,10$ ;Scanning?
JMP RFLEND ;No - get another command
10$: SNOOZE 1200 ;Sleep for 1.2 seconds
BBC #V_FNC,F,RFLNPM ;Is fence on screen?
BICL #M_SCN,F ;Yes - time to stop scanning
MOVZBL #15,R7 ;Put cursor near center of screen
MOVZBL #40,R8
BRB RFLNPM ;and do the last one
RFLEND: BBC #V_RST,F,10$ ;Want to restore the nominal parameter?
MOVL LINROL,ROLLIN ;Yes - set it back to 1/3 the screen
10$: JMP LOOP ; and go get another command
;Subroutine to do the actual rolling forward (called by ROLFWL, ROLFWP)
ROLFW:: TSTL R4 ;Any to roll?
BGTR 10$ ;Yes
JMP POSCUR ;No - just reposition the cursor
10$: BISL #M_XPB,F ;Say bottom pointer is invalid
BSBW ADVDPT ;Move display pointer forward
MOVL ROLLS,R4 ;Get lines to roll again
SUBL R4,R7 ;Adjust cursor position
BGEQ 20$ ;Off the screen?
BISL #M_XPL!M_XPC,F ;Yes - line and character pointers are invalid
CLRL R7 ;Put cursor at upper left
CLRL R8
20$: BBCC #V_FLG,F,30$ ;Hit end of file?
BRW ROLFW2 ;Yes - go rewrite screen
30$: MOVL R4,R1 ;Get fraggable lines to roll
BITL #M_FNC!M_FBL,F ;Is bottom line on screen bad?
BNEQ 33$
BBC #V_NEL,F1,35$
33$: INCL R1 ;Yes - fudge the count one higher
35$: TSTL RUP(R10) ;Any roll-up sequence?
BNEQ 40$ ;Yes
50$: BRW ROLFW3 ;No - go rewrite screen
40$: CMPL R1,LPP(R10) ;Want to roll more than a screenful?
BGEQ 50$ ;Yes - go rewrite screen
ROLFW0::JSB CMVBTM ;Move to bottom line
BBS #V_NEL,F1,10$ ;Is bottom line fragged somehow?
BITL #M_FNC!M_FBL,F
BEQL 20$
10$: JSB CLRLNA ;Yes - erase it
20$: JSB ROLLUP ;Do a roll
SOBGTR R4,20$ ;Loop through proper number of lines
SUBL3 ROLLS,LPP(R10),R4 ;Position to start of lines to rewrite
MOVL R4,SAVEAC ;Save position count
ROLFW1::MOVL DISPTR,R6
BITL #M_FBL!M_FNC,F ;Is bottom line on screen bad?
BNEQ 10$
BBC #V_NEL,F1,20$ ;..
10$: DECL R4 ;Yes - write from one higher
20$: BSBW ADVLPT ;Else get pointer to start of new stuff
TSTL R4 ;If beyond the file,
BGEQ 30$
JSB FIXBLW ;Output the fence
JMP POSCUR ;Position cursor and return
30$: MOVL SAVEAC,R4 ;Restore position count
BITL #M_FBL!M_FNC,F ;Is bottom line on screen bad?
BNEQ 40$
BBC #V_NEL,F1,50$ ;..
40$: DECL R4 ;Yes - write from one higher
50$: JSB POSLIN ;Position cursor at the line
MOVL ROLLS,R4 ;Display the missing lines
BITL #M_FNC!M_FBL,F ;Is bottom line on screen bad?
BEQL 60$ ;No
INCL R4 ;Yes - write one more line
60$: BICL #M_FNC!M_FBL,F ;Fence will be re-drawn, bottom line is O.K.
JSB DISPLY ;Rewrite bottom of the screen
BBC #V_IMD,F,70$ ;In insert mode?
JSB INSMSG ;Yes - put message up
70$: JMP POSCUR ;Re-position the cursor and return
ROLFW2: ADDL R4,R7 ;De-adjust cursor position (at EOF)
ROLFW3: JSB DISPLL ;Re-display screen
JMP POSCUR ;Reposition cursor and return
;Here to roll backward a given number of lines
ROLBKL::MOVL ROLLIN,R4 ;Set up last time's roll as nominal
BBS #V_ENT,F,10$ ;Is there a parameter typed?
BRB RBLNPM ;No - use the one already set up
10$: MOVL R4,PARG1
BSBW PEEL.1 ;Read new parm, if any
TSTL R1 ;Want scan mode?
BNEQ 20$ ;No
BISL #M_SCN,F ;Yes - set flag
MOVL ROLLIN,R4 ;Get size of scan
BRB RBLNP0
20$: MOVL PARG1,R4 ;Get lines to roll
MOVL R4,ROLLIN ;Save as new nominal
RBLNP0: JSB RESTPM ;Erase parameter
BBC #V_XCI,F1,RBLNPM ;Initializing for an execute?
JMP LOOP ;Yes - done now
RBLNPM::MOVL R4,ROLLS ;Save also as parm to ROLBK
BSBB ROLBK ;Do the actual work
10$: BBS #V_SCN,F,20$ ;Scanning?
JMP RFLEND ;No - get another command
20$: SNOOZE 1200 ;Sleep for 1.2 seconds
MOVL ROLLIN,R4 ;Get size of roll again
BRB RBLNPM ;and continue (until user types something)
;Subroutine to roll backwards (called by ROLBKL and ROLBKP)
ROLBK: TSTL R4 ;Any to roll?
BGTR 10$ ;Yes
JMP POSCUR ;No - done
10$: BISL #M_XPB,F ;Say bottom pointer is invalid
BSBW BAKDPT ;Move display pointer backward (R4) lines
TSTL R4 ;Hit start of file?
BEQL ROLBK1 ;No
BBCC #V_SCN,F,20$ ;Yes - scanning?
MOVZBL #5,R7 ;Yes - put cursor near center of screen
MOVZBL #40,R8
20$: BBC #V_XCT,F1,ROLBK1 ;Executing?
BRW XCEERR ;Yes - give special message
ROLBK1: SUBL R4,ROLLS ;Subtract from lines rolled
MOVL ROLLS,R4 ; (both in ROLLS and in R4)
BNEQ 10$
JMP POSCUR ;If already at start of buffer, quit
10$: ADDL R4,R7 ;Adjust cursor position
CMPL R7,LPP(R10) ;Will cursor be off the screen?
BLSS ROLBK2 ;No - O.K.
CLRL R7 ;Yes - put it at upper left
CLRL R8
BICL #M_FBL,F ;Bottom line is all right
ROLBK2: BISL #M_XPL!M_XPC,F ;Line and character pointers are invalid
TSTL RLD(R10) ;Any rolldown sequence?
BEQL ROLBK3 ;No - just rewrite the screen
CMPL R4,LPP(R10) ;Want to roll more than a screenful?
BGEQ ROLBK3 ;Yes - just rewrite the screen
JSB CHOME ;Home the cursor
50$: JSB ROLLDN ;Roll and clear a line
SOBGTR R4,50$ ;Do the physical roll of the screen
MOVL DISPTR,R6 ;Point to the desired position in buffer
MOVL ROLLS,R4 ;Get number of lines to rewrite
JSB DISPLY ;Rewrite them
JSB FIXBLW ;Display fence or insert mode message
JMP POSCUR ;Re-position cursor and return
ROLBK3: JSB RESTPM ;Erase parameter
BRW ROLFW3 ;Re-do the screen, re-position, and return
.SUBTITLE Reset Command
;***********************************************************************
;Here on RESET (alias rubout) resets enter mode, or re-writes screen
RESET:: JSB ERSPM2 ;Restore saved position
BICL #M_PST,F1 ;Clear starting-parameter flag
CMPL PARPTR,#PARBUF ;Did user type just enter reset?
BEQL RESET1 ;Yes - leave buffer alone
CLRB @PARPTR ;No - end parameter buffer with a null
INCL PARPTR
CMPB #^O136,PARBUF ;1st character of parameter up-arrow?
BNEQ RESET2 ;No
JMP DISRES ;Yes - go re-display the entire screen
RESET2: JSB ERASPM ;Erase the parameter
BRB RESNP1 ;and join the flow
RESNPM::BBCC #V_FBL,F,RESNP1 ;Is the bottom line fragged?
JSB FIXBLN ;Yes - repair it
RESNP1: JSB POSCUR ;Re-position the cursor
BBC #V_XSV,F1,10$ ;Saving in an execute buffer?
MOVL XCTPTW,R1 ;Yes - point to the last byte stored
MOVB #^O77,-1(R1) ;Overwrite the real code with execute code
10$: JMP LOOP ;Get another command
RESET1: BBS #V_CMV,F,RESET2 ;If cursor move, it's not a token
BBCC #V_XPL,F,10$ ;Else re-do current line
BSBW MAKLPT ;Re-make line pointer, if needed
10$: JSB DISONL
BRB RESET2 ;Continue
.SUBTITLE Handle the Enter-Rewrite command
;Here on enter-rewrite - re-write the screen with the line the cursor
;is on at the center of the screen
;(Rewrite, without the enter, jumps to DISALL)
RWRARG::JSB RESTPM ;Clear the parameter quickly
MOVL R7,R4
ASHL #-1,LPP(R10),R7 ;Get number of lines on screen div by 2
SUBL R7,R4 ;Find difference between center and cursor
BGTR RWRTDN ;Jump if the cursor is below the center
BNEQ 10$
JMP DISALL ;Jump if the cursor is already at the center
10$: MNEGL R4,R4 ;Else get number of lines to back up
BSBW BAKDPT ;Back up the display pointer
SUBL R4,R7 ;Adjust row in case start of file was reached
JMP DISALL ;Re-write the screen and loop
RWRTDN: BSBW ADVDPT ;Advance the display pointer
JMP DISALL ;Re-write the screen and loop
.SUBTITLE Recall Command
;**********************************************************************
;Here to do a recall command -
;Gives back previous parameter for editing and reuse
;Also enter F recall forces back the filespecs
;and enter A recall the alternate filespecs
;and enter S recall the search key
;and enter O recall the old (previous) search key
;and enter R recall the substitute (replace) string
RECARG::CLRB @PARPTR ;End parameter buffer with a null
MOVAB PARBUF,R6
BSBW SWHLUR ;Read parameter character
CMPB R1,#^A"A" ;Alphabetic?
BGEQ 5$ ;Yes
BRW RECAR1 ;No - just do a normal recall
5$: CMPB R1,#^A"F" ;Want to set up filespecs?
BNEQ 10$
BRB RECFIL ;Yes - go do it
10$: CMPB R1,#^A"A" ;Want to set up alternate filespecs?
BNEQ 20$ ;No
BRB RECAFL ;Yes - go do it
20$: CMPB R1,#^A"R" ;Want to set up substitute string?
BNEQ 30$
BRB RECSCR ;Yes - go do it
30$: CMPB R1,#^A"O" ;Want to set up old search key?
BEQL RECSCO ;Yes - go do it
CMPB R1,#^A"S" ;Want to set up the search key?
BEQL 40$ ;Yes
BRB RECAR1 ;No - just do a normal recall
40$: MOVAB SRCKEY,R1 ;Transfer search key
BRB RECSC1
RECSCO: MOVAB SROKEY,R1 ;Transfer old search key
RECSC1: PUSHR #^M<R2,R3,R4,R5> ;Save needed registers
MOVC3 #35,(R1),PARBUF ; to parameter buffer
POPR #^M<R2,R3,R4,R5> ;Restore them
BRB RECAR1 ;Continue to recall the key
RECSCR: MOVAB SUBSTG,R1 ;Transfer substitute string
BRB RECSC1
RECAFL: PUSHR #^M<R5>
MOVC3 OLDLEN,OLDSPC,PARBUF ;Transfer alternate filespecs to parm buffer
POPR #^M<R5>
MOVL OLDLEN,R1 ;Get length of the filespec
CLRB L^PARBUF(R1) ;Put a null at the end of the filespec
BRB RECAR1
RECFIL: PUSHR #^M<R5>
MOVC3 FSPLEN,FILSPC,PARBUF ;Transfer filespecs to parameter buffer
POPR #^M<R5> ;and fall into normal recall code
MOVL FSPLEN,R1 ;Get length of the filespec
CLRB L^PARBUF(R1) ;Put a null at the end of the filespec
RECAR1::BSBW ENTRMK ;Mark the bottom of the screen
BRB RECAL0 ;Continue to recall the key
RECALL::BISL #M_ENT,F ;Pretend enter was typed
BSBW ENTER0 ;Set up like an enter
RECAL0: MOVAB PARBUF,R1
10$: MOVZBL (R1)+,R2 ;Re-make the parameter pointer
BNEQ 10$ ; to point to the first null
MOVL R1,PARPTR
RECAL1::DECL PARPTR ;Get rid of null at end of parameter buffer
BITL #M_XCT!M_XBN,F1 ;Executing?
BNEQ 10$ ;Yes - done
MOVAB PARBUF,R1 ;Output current parameter
JSB PUTSTS
JSB PUTTYP ;Type it all out now
10$: JMP LOOP ;Let user edit it
.SUBTITLE Search Backward
;Here for the search backward command
SRCBAK::BSBW SRGTKY ;Set up the new search key
SRBNPM::BSBW MAKCPT ;Re-make cursor pointer
SUBL3 #1,DISPTR,SAVEAC ;Save pointer to top of screen
MOVL CHRPTR,R6 ;Get pointer to current position
MOVAB SRCKEY,R4 ;and pointer to start of search key
MOVZBL (R4)+,R1 ;Get the first key character
BBC #V_NLC,F,10$ ;Want case independence?
BSBW SRCUPP ;Yes - check the case
10$: MOVL R1,R3 ;Put character in the right AC
BNEQ SRCBK1 ;Something to search for?
BRW SRXERR ;No - error
SRCBK1: MOVZBL -(R6),R1 ;Get a character
CMPL R6,#BUFFER-1 ;At start of file yet?
BNEQ 10$ ;No
BRW SRCERR ;Yes - not-found error
10$: CMPL R6,SAVEAC ;Back to start of screen?
BNEQ 20$ ;No
BSBW SRCDKY ;Yes - remind user what key is
20$: BBC #V_NLC,F,30$ ;Want case independence?
BSBB SRCUPP ;Yes - check the case
30$: CMPB R1,R3 ;Same as first char of key?
BEQL SRCB2A ;Yes - check rest of match
CMPB R3,#^O37 ;Got a wild key character?
BNEQ SRCBK1 ;No - keep going
SRCB2A: MOVL R6,SRCPTR ;Save pointer to buffer
BSBB SRCIPT ;See if user wants to interrupt
BLBC R0,10$ ;Does he?
BRW SABERR ;Yes - stop the search
10$: INCL R6 ;Point to the next character
SRCBK2: MOVZBL (R4)+,R1 ;Get next character of key
BNEQ 10$
BRW SRCMAT ;If null, got a match
10$: BBC #V_NLC,F,20$ ;Want case independence?
BSBB SRCUPP ;Yes - check the case
20$: MOVL R1,R2 ;Put the character in the right AC
30$: MOVZBL (R6)+,R1 ;Get one from the buffer
BEQL 30$ ;Ignore if null
BBC #V_NLC,F,40$ ;Want case independence?
BSBB SRCUPP ;Yes - check the case
40$: CMPB R1,R2 ;Same?
BEQL SRCBK2
CMPB R2,#^O37 ; or key char is wild?
BEQL SRCBK2 ;Yes - O.K. so far
MOVL SRCPTR,R6 ;No - no match - restore buffer pointer
MOVAB SRCKEY+1,R4 ;and pointer to start of search key
BRB SRCBK1 ;and continue looking for the entire key
SRCUPP: CMPB R1,#^A"a" ;Lower case?
BLSS 10$ ;No
CMPB R1,#^A"z" ;Maybe - is it?
BGTR 10$ ;No
SUBB #^O40,R1 ;Yes - convert to upper
10$: RSB ;Done
;Subroutine to see if the user has typed a rubout
;Returns R0/1 if so, else R0/0
SRCIPT::$QIOW_S FUNC=#IO$_TTYREADALL!IO$M_NOECHO!IO$M_TIMED,-
CHAN=TTCHAN,-
P1=TTYBUF,-
P2=#1,-
P3=#0
BLBS R0,20$ ;Was it?
10$: CLRL R0 ;No
RSB
20$: CMPB TTYBUF,#^O177 ;Yes - is it a rubout?
BNEQ 10$ ;No - continue
MOVL #1,R0 ;Yes - indicate it
RSB ;Then return
;Subroutine to set up a new search key
SRGTKY: MOVL R5,-(SP) ;Save type buffer pointer
MOVC3 #35,SRCKEY,SROKEY ;Save current key as previous one
MOVL (SP)+,R5 ;Restore type buffer pointer
MOVAB SRCKEY,R3
BSBW PELS.1 ;Get search key
MOVL R1,SRCKLN ;Save its length for the substitute command
JSB ERASPM ;Erase parameter
BBS #V_XCI,F1,10$ ;Initializing for an execute?
RSB ;No - return
10$: MOVL (SP)+,R0 ;Yes - done now
JMP LOOP
.SUBTITLE Search Forward
;Here for the search forward command
SRCFWD::BSBB SRGTKY ;Set up the new search key
SRFNPM::JSB MAKCPT ;Re-make cursor pointer
CMPL R7,LPP.1 ;Is cursor on the bottom line?
BNEQ 10$ ;No
BSBW SRCDKY ;Yes - screen will be re-done
BRB SRFNP1
10$: BBC #V_XPB,F,20$ ;Got a valid bottom pointer?
BSBW MAKBPT ;No - re-make it
20$: MOVL BOTPTR,SAVEAC ;Get bottom ptr to see when srch is off screen
SRFNP1: MOVL CHRPTR,R6 ;Get pointer to current position
10$: MOVZBL (R6)+,R1 ;Skip first real character
BEQL 10$ ; at this location
MOVAB SRCKEY,R4 ;and point to start of search key
MOVZBL (R4)+,R1 ;Get the first key character
BBC #V_NLC,F,20$ ;Want case independence?
BSBW SRCUPP ;Yes - check the case
20$: MOVL R1,R3 ;Put character in the right AC
BNEQ SRCFW1 ;Got one?
BRW SRXERR ;No - error if nothing to search for
SRCFW1: CMPL R6,EN ;At end of file yet?
BNEQ 10$ ;No
BRW SRCERR ;Yes - not-found error
10$: MOVZBL (R6)+,R1 ;Else get a character
CMPL R6,SAVEAC ;Going off the bottom of the screen?
BNEQ 20$ ;No
BSBB SRCDKY ;Yes - remind user what key is
20$: BBC #V_NLC,F,30$ ;Want case independence?
BSBW SRCUPP ;Yes - check the case
30$: CMPB R1,R3 ;Same as first char of key?
BEQL SRCF2A ;Yes - check rest of key
CMPB R3,#^O37 ;Wild search character?
BNEQ SRCFW1 ;No - keep going
SRCF2A: SUBL3 #1,R6,SRCPTR ;Save pointer to current position
BSBW SRCIPT ;See if user wants to interrupt
BLBC R0,SRCFW2 ;Does he?
BRW SABERR ;Yes - stop the search
SRCFW2: MOVZBL (R4)+,R1 ;Get next character of key
BBC #V_NLC,F,10$ ;Want case independence?
BSBW SRCUPP ;Yes - check the case
10$: MOVL R1,R2 ;Get character in the right register
BNEQ SRCFW3 ;Got one?
BRW SRCMTF ;No - found the match
SRCFW3: MOVZBL (R6)+,R1 ;Now get one from the buffer
BNEQ 10$ ;Null?
CMPL R6,EN ;Yes - at end of file?
BNEQ SRCFW3 ;No - skip the null
BRW SRCERR ;Yes - no match
10$: BBC #V_NLC,F,20$ ;Want case independence?
BSBW SRCUPP ;Yes - check the case
20$: CMPB R1,R2 ;Same?
BEQL 30$ ;Yes
CMPB R2,#^O37 ; or key char is wild?
BNEQ 40$
30$: BRB SRCFW2 ;Yes - O.K. so far
40$: ADDL3 #1,SRCPTR,R6 ;No - no match - restore buffer pointers
MOVAB SRCKEY+1,R4 ; and pointer to start of search key
BRW SRCFW1 ;and continue looking for the entire key
;Subroutine for when the search has gone beyond the limits of the screen
;Display search key on bottom line and set SAVEAC to 0
;(Thus SAVEAC/0 if match not on screen, else nonzero). Frags R1 only.
SRCDKY: CLRL SAVEAC ;Clear on-screen indicator
BBC #V_XCT,F1,10$ ;Executing?
BRB 20$ ;Yes - don't display
10$: CMPL R9,#^O63 ;Doing a substitute?
BEQL SRCDK1 ;Yes - do it differently
MOVAB SRCDKM,R1
JSB PUTBTM ;Display search key on bottom of screen
MOVAB SRCKEY,R1
JSB PUTSTC
JSB PROTOF ;Turn protection off
JMP PUTTYP ;Output all this and return
20$: RSB
SRCDK1: TSTL SAVEAC+4 ;Yes - first time through here?
BEQL 10$ ;Yes
RSB ;No - once is enough
10$: MOVAB SRCDKM,R1
JSB PUTBTM ;Display substitute on bottom of screen
MOVAB SRCKEY,R1
JSB PUTSTC
MOVAB SRCDKS,R1
JSB PUTSTG
MOVAB SUBSTG,R1
JSB PUTSTC
JSB PROTOF ;Turn protection off
JMP PUTTYF ;Force all this out and return
SRCDKM: .ASCIZ /SEARCH FOR: /
SRCDKS: .ASCIZ / SUBSTITUTE: /
;Here when a searcher has found a match - display a few lines before match
SRCMTF: BBC #V_FNC,F,SRCMAT ;If searching forward, is fence on screen?
CVTBL #-1,SAVEAC ;Yes - match must be, too
SRCMAT: MOVL SRCPTR,R6 ;Restore ptr to start of match
CMPL R9,#$SUBST ;Doing a substitute?
BEQL SRCMT0 ;Yes - don't fudge the linefeed, then
CMPB (R6),#^O12 ;First character of match linefeed?
BNEQ 10$ ;No
INCL R6 ;Yes - point to first character
10$: MOVL R6,SRCPTR ;Save adjusted pointer
SRCMT0: TSTL SAVEAC ;Is match on screen?
BEQL SRCMT1 ;No - go re-display
;Here if match is on screen - just position cursor at match
MOVL R6,CHRPTR ;Character position will be start of the match
BSBW CALCRW ;Calculate proper value of row (R7)
BSBW CALCML ;Calculate proper value of column (R8)
BLBS R0,30$ ;Was there a slide?
JSB DISPLL ;Yes - re-display
30$: BICL #M_XPL!M_XPC,F ;Line and cursor pointers are good
CMPL R9,#$SUBST ;Doing a substitute?
BEQL 40$ ;Yes
JMP DISCUR ;No - position cursor to start of match; return
40$: RSB ;Yes - return
;Here if match is not on the screen
SRCMT1: CMPL R9,#$SUBST ;Doing a substitute?
BEQL SRCST0 ;Yes - set pointers and return
BSBW PUSMKS ;No - push the display ptr on the marker stack
BSBB SRCSET ;Set up the right pointers
JMP DISALL ;Re-display the screen and loop
SRCST0: CVTBL #-1,SAVEAC+4 ;Say the display has moved over the file
SRCSET: ADDL3 #1,LINROL,R4 ;Back up one roll's worth
ADDL3 #1,R6,DISPTR ; from the match
MOVL R6,CHRPTR ;Character position will be start of the match
JSB BAKDPT
SUBL3 R4,LINROL,R7 ;Point to start of line with match
; (which may not be the full distance down)
JSB MAKLPT ;Make line ptr (in LINPTR and R6)
BSBW CALCCM
BICL #M_XPL!M_XPC!M_FBL,F ;Row and column pointers are right
BISL #M_XPB,F ; bottom pointer is not good
RSB
SABERR: MOVAB SABERM,R1
JMP ERROR
SRXERR: MOVAB SRXERM,R1
JMP ERROR
SRCERR: MOVAB SRCERM,R1 ;Point to the error message
BITL #M_XBN!M_XCT,F1 ;Executing?
BEQL 10$ ;No - report the error
TSTL XCTPTR ;Yes - is there an execute pointer?
BEQL 10$ ;No - it's still an error
MOVZBL @XCTPTR,R2 ;Yes - get the next execute command
INCL XCTPTR
CMPB R2,#^A"^" ;Special character flag?
BNEQ 10$ ;No - it's still an error
MOVZBL @XCTPTR,R2 ;Yes - is it the on-search-error construct?
INCL XCTPTR
CMPB R1,#^O21
BNEQ 10$ ;No - it's still an error
JMP LOOP ;Yes - continue processing commands
10$: JMP ERROR
SRXERM: .ASCIZ /#######Nothing to search for/
SRCERM: .ASCIZ /##########Search failure/
SABERM: .ASCIZ /##########Search aborted/
.SUBTITLE Enter Parameter Command
;**********************************************************************
;Here to enter a parameter to a command
ENTERA::BBCS #V_ENT,F,10$ ;Say enter typed - was it already?
BRW ENTHLP ;Yes - maybe give some help
10$: MOVAB PARBUF,PARPTR ;Point to the start of parameter buffer
MOVQ R7,SAVPOS ;Save position, in case of cursor move
BSBB MRKCUR ;Mark the current cursor position
BISL #M_FBL,F ;Note that bottom line is fragged
BISL #M_PST,F1 ;Indicate starting a parameter
ENTERM::BSBB ENTRMK ;No - make the mark on the bottom line
JSB PUTTYP ;Type it out and get a new command
JMP LOOP
ENTER0: MOVQ R7,SAVPOS ;Save position, in case of cursor move
BSBB MRKCUR ;Mark the current cursor position
BISL #M_FBL,F ;Note that bottom line is fragged
ENTRMK::BITL #M_XCT!M_XBN,F1 ;Executing?
BEQL 10$ ;No
RSB ;Yes - do nothing
10$: JSB CBOTOM ;Move to bottom of screen
ENTMK1: JSB PROTON ;Turn highlighting on
MOVB #^A">",(R5)+ ;Put up enter mark
JMP PROTOF ;Turn off highlighting and return
;Subroutine to mark current cursor position
;Note: expects caller to call PUTTYP to output all this
MRKCUR::JSB MAKCPT ;Make pointer
MOVL CHRPTR,SAVCPT ;Save cursor pointer for after enter
BITL #M_XCT!M_XBN,F1 ;Executing?
BEQL 10$ ;No
RSB ;Yes - done now
10$: CMPB #^A" ",R3 ;Pointing to a control character?
BLEQ 30$ ;No
CMPB #^O15,R3 ;Yes - got a <CR>?
BEQL 20$ ;Yes
CMPB #^O11,R3 ;or a tab?
BNEQ 30$ ;No
20$: MOVZBL #^A" ",R3 ;Yes - use a space instead
30$: MOVB R3,CHRCUR ;Save character for later
BBC #V_MRK,F1,40$ ;Want to put up a special mark?
MOVB MAR(R10),(R5)+ ;Yes - get the mark
RSB
40$: CMPB #^A" ",R3 ;Got a control character?
BLEQ 50$ ;No
RSB ;Yes - its already reversed
50$: JSB PROTON ;Turn protection on
MOVB R3,(R5)+
JMP PROTOF ;Turn off protection and return
.SUBTITLE Help Command Processor
;Here on ENTER ENTER. If a parameter was typed, save a 177 character
;else prepare to give help (unless no help (NHP) flag is set)
ENTHLP::MOVAB PARBUF,R1
BITL #M_NHP!M_CMV,F ;Really don't want help, cursor movement,
BNEQ 10$ ; or has part of a parameter been typed?
CMPL R1,PARPTR
BEQL HELPR0
10$: BRW ENTHLD ;Either - save a delimiter character
HELPR0: MOVL #^O1000,R9 ;Neither - note that help is being given
BSBW PIKFRG ;Save pick buffer if it's about to be fragged
ENTHL0: JSB PROTON ;Say help is on the way
MOVAB HLPMSG1,R1
JSB PUTSTG
ENTH0A: MOVAB HLPMSG2,R1
JSB PUTSTG
JSB PROTOF
JSB PUTTYP ;Type out the message
BISL #M_FBL,F ;Bottom line is fragged
$QIOW_S FUNC=#IO$_TTYREADALL!IO$M_NOECHO,- ;Input a character
CHAN=TTCHAN,-
P1=TTYBUF,-
P2=#1,-
IOSB=TTY_STATUS_BLOCK
MOVZBL TTYBUF,R1 ;Get the character
CMPB R1,#^A"G" ;Got a "G"?
BEQL 10$
CMPB R1,#^A"g"
BNEQ 20$
10$: BRW ENTHLE ;Yes - end of help
20$: CMPB R1,#^A" " ;Some control character?
BLSS ENTHL2 ;Yes
BRW HLPERR ;No - can't give help
ENTHL2: MULL #4,R1 ;Convert offset from bytes to words
ADDL ITB(R10),R1 ;Get offset in terminal table
MOVL (R1),R1 ;Is it a normal command?
BGEQ 10$ ;Yes - continue
JSB SUBTAB ;No - read more characters
BLBS R0,10$ ;Legal - continue
BRW HLPERR ;Illegal - try again
10$: BBC #V_LSD,F1,ENTHL3 ;Are linefeed and cursor down alike?
CMPB R1,#^O12 ;Yes - got a linefeed?
BNEQ ENTHL3 ;No
MOVZBL #^O34,R1 ;Yes - it's really a cursor-down
ENTHL3: BBC #15,R1,5$ ;Is the command an execute buffer pointer?
BSBW HLPXCT ;Yes - find which command it is, if it is
5$: BICL #M_ENT,F ;Say no longer entering a parameter
MOVL R1,R6 ;Save index of command to help with
$OPEN FAB=HELP_FAB ;Open the help file
BLBS R0,20$ ;Any errors?
10$: BRW NHPERR ;Yes - scream
20$: $CONNECT RAB=HELP_RAB ;Connect the record block
BLBC R0,10$ ;Scream if errors
MULL3 #3,R6,R1 ;Compute block to start with
INCL R1
MOVL R1,HELP_RAB+RAB$L_BKT ;Save it in the RAB
$READ RAB=HELP_RAB ;Read the record
BLBC R0,10$
$DISCONNECT RAB=HELP_RAB
$CLOSE FAB=HELP_FAB
JSB CLRALL ;Go home and clear the screen
JSB PUTTYP ;(now)
LOCC #0,#1536,PIKBUF+PCBSIZ-1536 ;Find the null at the end
SUBL3 #PIKBUF+PCBSIZ-1536,R1,TBFSIZ ;Find the length of the string
$QIOW_S CHAN=TTCHAN,- ;Output it to the screen
FUNC=#IO$_WRITEVBLK!IO$M_NOFORMAT,-
P1=PIKBUF+PCBSIZ-1536,-
P2=TBFSIZ
JSB CBOTOM
BRW ENTHL0 ;Loop to get the next help command
ENTHLE: BBS #V_ENT,F,10$ ;Has help been given?
JMP DISALL ;Yes - redisplay the entire screen
10$: JSB ERASPM ;No - just fix bottom line
JMP DISCUR ;Re-position cursor, and loop
HLPERR: CMPB R1,#^O177 ;Rubout?
BNEQ 10$ ;No
CVTBL #-1,R1 ;Yes - give help after all
BRW ENTHL2
10$: MOVAB HLPEMS1,R1
HLPERX: JSB PUTBTM ;Output message
BRW ENTH0A ;and try again
;Here if the command is really an execute buffer - give help if it's one
;command long, else error
HLPXCT: BBS #14,R1,HLXERR ;More than one command here? Yes
BICL #^C^O77,R1 ;No - keep only good index bits
MOVL XCTADR[R1],R2 ;Point to the execute buffer
BEQL HLXERR ;If none there, can't help
MOVZBL (R2)+,R1 ;Get first character from buffer
CMPB R1,#^A"^" ;Special character flag?
BNEQ 10$ ;No
MOVZBL (R2)+,R1 ;Yes - get command from execute buffer
CMPB R1,#^O37 ;Is it a real command?
BLEQ HLXERR ;No (an execute construct) - can't help
10$: TSTB (R2) ;Is there a second command?
BNEQ HLXERR ;Yes - can't help with it
RSB ;If there's only one command, go use it
HLXERR: MOVL (SP)+,R1 ;Clean up the stack
MOVAB HLXERM,R1 ;Point to the error message
BRB HLPERX
HLXERM: .ASCIZ /Can't help with an execute buffer. Try again /
NHPERR: $CLOSE FAB=HELP_FAB ;Make sure the file is closed
MOVAB HLPEMS2,R1
BRW ERROR
HLPMSG1: .ASCIZ /Type any command to get help for it /
HLPMSG2: .ASCIZ /(or G to get out): /
HLPEMS1: .ASCIZ /Illegal command. Try again /
HLPEMS2: .ASCIZ /########No help file. Sorry./
;Here to save a delimiter character (177) in the parameter buffer
;(user typed enter within a parameter)
;Delimiter is ignored while parsing unless the command is substitute
ENTHLD: BBS #V_PST,F1,20$ ;Has anything been typed?
BBS #V_CMV,F,20$ ; or doing cursor movement?
MOVL PARPTR,R2 ;No, get the parameter pointer
CMPB #^O177,-1(R2) ;Was latest parameter character a delimiter?
BEQL 20$ ;Yes - don't allow it twice in a row
MOVB #^O177,(R2)+ ;No - save a delimiter
MOVL R2,PARPTR
BSBW ENTMK1 ;Put in another mark
JSB PUTTYP ;Type it out and get a new command
20$: JMP LOOP
;Subroutine to see if pick buffer will be fragged, and save it if so
;Preserves R1
;@@ well, for now it just invalidates the buffer
PIKFRG::BBS #V_POV,F,10$ ;Is pick buffer safely on disk
MOVL PIKCNT,R2 ; or is it not loaded?
BEQL 20$
CMPL R2,#PCBSIZ-1536 ;Will tail of buffer get fragged?
BLSS 10$ ;No
CLRL PIKCNT ;Yes - pretend pick buffer is empty
10$: TSTL APPFLG ;Appending to the pick buffer?
BEQL 20$ ;No
MOVAB PIKBUF,APPFLG ;Yes - wipe what's already there
20$: RSB ;Done
;Give help
HELPER::JSB CBOTOM ;Move to bottom of screen
JSB PROTON ;Turn protection on
BBSS #V_ENT,F,10$ ;Pretend enter was typed - was it?
CLRB CHRCUR ;No - there's no character to de-blip
10$: BRW HELPR0 ;Jump into enter-enter code (near ENTHLP)
.SUBTITLE Exit and Abort Routines
EXIPAR::BISL #M_FLG,F ;Set flag to do a run on COMPIL
EEXIT:: BBCC #V_WDW,F1,5$ ;Windowing?
JSB WNCLST ;Yes - stop
5$: MOVAB FILSPC,R4 ;Point to name of current file
MOVAL FSPLEN,R6
TSTB INJFN ;Is there a file?
BEQL 10$ ;No
JSB SAVFIL ;Yes - save the file
10$: BBC #V_JRW,F1,EEXIT1 ;Writing a journal?
JSB JRNCLS ;Yes - close and delete it
EEXIT1: TSTB FILSPC ;Got a current file?
BNEQ 10$ ;Yes - continue
TSTB OLDSPC ;No - got an old file?
BNEQ 10$ ;Yes
BRW ABORT ;No
10$: MOVL R5,SAVEAC ;Save R5
MOVAB PIKBUF+PCBSIZ-400,R5 ;Point to the buffer for output
MOVAB FILSPC,R1 ;Get the current file specs
MOVL DISPTR,R4 ;and the display pointer
BSBW EXIFIL ;Output the status of the active file
MOVAL FILESPEC_DESC,R4 ;Point to the symbol descriptor block
JSB WRTSYM ;Write the symbol
TSTB OLDSPC ;Is there an alternate filespec?
BEQL 20$ ;No - don't output its status
MOVAB PIKBUF+PCBSIZ-400,R5 ;Point to the buffer for output
MOVL F,R1 ;Get alternate file's flags
MOVL SAVEFG,F
MOVL R1,SAVEFG
MOVAB OLDSPC,R1 ;Get the alternate file specs
MOVL SAVEDP,R4 ;and the display pointer
MOVQ SAVERW,R7
MOVL SAVESL,SL
BSBW EXIFIL ;Output the status of the alternate file
MOVAL OLDSPEC_DESC,R4 ;Point to the old spec symbol
JSB WRTSYM ;Write the symbol
MOVL F,R1 ;Get current file's flags
MOVL SAVEFG,F
MOVL R1,SAVEFG
BRB 30$
20$: MOVAL OLDSPEC_DESC,R4 ;Delete any old symbol left around
JSB DELSYM
30$: MOVL SAVEAC,R5 ;Restore R5
EEXIT0:
ABORT1::JSB @RTX(R10) ;Call the user's exit routine
MOVL #SS$_NORMAL,R0 ;Indicate success return
BBS #V_FLG,F,EXITGO ;Want to run COMPIL? YES
RET ;No, return to DCL level
EXITGO: BBS #V_PST,F1,10$ ;Any parameter given?
CLRB @PARPTR ;Make sure parameter buffer ends with a null
MOVAB PARBUF,R6 ;Yes - go parse it
BSBW SET_PROG
10$: TSTB PROG_NAME ;Do we have a program to run?
BNEQ 20$ ;Yes
PUSHAL GOBLK ;No - point to the program name to be run
CALLS #1,G^LIB$RUN_PROGRAM ;Go run COMPIL
RET ;Return with error if can't run COMPIL
20$: PUSHAL PROG_BLOCK ;Point to the argument block
TSTB PROG_FLAG ;Run program or do command?
BEQL 30$ ;Run program
CALLS #1,G^LIB$DO_COMMAND ;Execute a command procedure
RET ;Exit if any errors happened
30$: CALLS #1,G^LIB$RUN_PROGRAM ;Run the indicated program
RET ;Exit if any errors happened
ABOPAR::BISL #M_FLG,F ;Set flag to do a run on COMPIL
ABORT:: BBS #V_CHG,F,5$ ;Changes made to file? No
BRW 50$
5$: MOVAB ABOMSG,R1 ;Point to the message
JSB PUTBTM ;Put message on bottom line
JSB PROTOF
JSB PUTTYP
$QIOW_S FUNC=#IO$_TTYREADALL!IO$M_NOECHO,-
CHAN=TTCHAN,P1=TTYBUF,P2=#1
CMPB #3,TTYBUF ;Was it a control-C?
BEQL 50$ ;Yes, go exit
BBS #V_NEL,F1,30$ ;If bottom line is scratch, don't erase it
BBC #V_IMD,F,10$ ;In insert mode?
BBS #V_BEP,F1,10$ ;Yes - just want to beep?
JSB INSMSG ;No - restore insert message
BRB 40$
10$: BICL #M_FBL,F ;Bottom line is O.K. now
JSB CBOTOM ;Move to bottom of screen
BBCC #V_XPB,F,20$ ;Is pointer to last line valid?
JSB MAKBPT ;No - make it
20$: MOVL BOTPTR,R6 ;Get bottom pointer
BNEQ 30$ ;If zero, put up fence
JSB FNCPUT ;Output the fence
BRB 40$
30$: JSB DISONE ;Else re-do the bottom line
40$: JSB POSCUR ; position the cursor,
JMP LOOP ; and return
50$: BBCC #V_WDW,F1,60$ ;Windowing?
JSB WNCLST ;Yes - stop
60$: MOVAB FILSPC,R4 ;Tell user that file is not changed
JSB SAVMGN
BRW ABORT1 ;Then go finish off
ABOMSG: .ASCII <7>/Unsaved change has been made; type ctrl-C/
.ASCIZ / to abort edit; other char to continue/
;Subroutine to output a filespec status line.
;Enter with R1/addr filespec, R4/DISPTR; also R7, R8, SL set up
;Uses R1, R2, R3
EXIFIL::BSBW PUTFIL ;Put filespecs in buffer
TSTL R4 ;If display ptr is zero, just end the line
BEQL EXIFL1
SUBL3 #BUFFER,R4,R2 ;Set character position for display ptr
MOVAB EXIFDM,R1
BSBB EXINUM ;Always output display pointer
MOVAB EXIFRM,R1
MOVL R7,R2 ;Is row zero?
BEQL 10$ ;Yes
BSBB EXINUM ;No - output it
10$: BBC #V_RDO,F,15$ ;Is the file read-only?
MOVAB EXIRDO,R1 ;Yes
BRB 18$
15$: MOVAB EXIWRI,R1 ;No
18$: JSB PUTSTG ;Mark the file read-only or writable
MOVAB EXIFCM,R1
MOVL R8,R2 ;Is column zero?
BEQL 20$ ;Yes
BSBB EXINUM ;No - output it
20$: MOVAB EXIFSM,R1
MOVL SL,R2 ;Is slide zero?
BEQL EXIFL1 ;Yes
BSBB EXINUM ;No - output it
EXIFL1::CLRB (R5)+ ;End the line with a null
RSB
EXINUM: JSB PUTSTG ;Output the switch name (in R1)
MOVL R2,R1 ;Get the value
JMP PUTNUM ;Output it and return
EXIFDM: .ASCIZ ?/FD:?
EXIFRM: .ASCIZ ?/FR:?
EXIFCM: .ASCIZ ?/FC:?
EXIFSM: .ASCIZ ?/FS:?
EXIRDO: .ASCIZ ?/READ?
EXIWRI: .ASCIZ ?/WRITE?
.SUBTITLE Marker command routines
;Here for the marker command
;Sets and goes to markers of the given name at the screen position;
;kills some or all markers; lists the marker names
;also pops, or moves forward in, the marker stack
MARNPM::MOVL DISPTR,MRKPTB-4 ;Save the marked display ptr as default marker
JMP LOOP ;and go get a new command
MARKER::BBCC #V_CMV,F,10$ ;Did user use cursor movement?
JMP SUMERR ;Yes - error
10$: CLRB @PARPTR ;End buffer with a null
MOVZBL PARBUF,R1 ;Get first character of parameter
BNEQ 20$ ;If token format,
BRW MRKDGO ; go to the default marker
20$: CMPB R1,#^A"a" ;If it's lower case,
BLSS 30$
SUBB #^O40,R1 ; make it upper
30$: CMPB R1,#^A"S" ;Set a marker?
BEQL MARKST ;Yes - do it
CMPB R1,#^A"G" ;Go to a marker?
BNEQ 40$ ;No
BRW MARKGO ;Yes - do it
40$: CMPB R1,#^A"K" ;Kill a marker?
BNEQ 50$ ;No
BRW MARKKL ;Yes - do it
50$: CMPB R1,#^A"N" ;Display the marker names?
BNEQ 60$ ;No
BRW MARKNM ;Yes - do it
60$: CMPB R1,#^A"P" ;Pop the marker stack?
BNEQ 70$ ;No
BRW POPMKS ;Yes - do it
70$: CMPB R1,#^A"F" ;"Pop" the marker stack forward?
BNEQ 80$ ;No
BRW POPMKF ;Yes - do it
80$: MOVAB MRKERM,R1 ;No - unknown command
JMP ERROR ;Error if none of the above
MRKERM: .ASCIZ /#######Unknown MARKER command/
;Here to set a marker
MARKST: BSBW GTMNAM ;Get the name of the marker in R2, R3
BSBW FNMNAM ;Find the name in the table (index in R4)
BLBS R0,MRKST2 ;It's there - replace the definition
INCL MRKEND ;Not there - add it
MOVL MRKEND,R4
CMPL R4,#MRKSIZ ;Got too many?
BGTR MRKSTH ;Yes - look for a hole - error if none
MRKST1: MOVL R2,MRKNTB-4[R4] ;No - save the new name in the table
MOVL R3,MRKNT1-4[R4]
MRKST2: MOVL DISPTR,R1 ;Save the marked display pointer
MOVL R1,MRKPTB-4[R4]
MOVL R1,MRKLAT ;Save also as the latest-set marker
JMP LOOP ; and go get a new command
MRKSTH: MOVL #MRKSIZ,R4 ;Look for a hole in the marker table
DECL MRKEND ;Set the end index back to the max value
MRKSH1: TSTL MRKNTB-4[R4] ;Is this a hole?
BEQL MRKST1 ;Yes - use it
SOBGTR R4,MRKSH1 ;No - loop until counted out
MOVAB MRKEM2,R1
JMP ERROR
MRKEM2: .ASCIZ /######All markers in use/
GOMERR: MOVAB GOMERM,R1
JMP ERROR
GOMERM: .ASCIZ /######Can't find that marker/
;Here for the goto-marker command - position to the marker of the given name
;<ENTER>G<MARKER> goes to the latest-set marker
MARKGO: BSBW GTMNAM ;Get the name of the marker in R2, R3
CMPL R2,#^A" "
BEQL MRKGO1 ;If no name, use latest-set marker
BSBW FNMNAM ;Find the name in the table (index in R4)
BLBS R0,10$ ;Was it there?
BRW SMXERR ;Not there - error
10$: MOVL MRKPTB-4[R4],R3 ;Found - get the marked display pointer
BRB MRKGO2
MRKGO1: MOVL MRKLAT,R3 ;No name - use latest-set marker
BNEQ MRKGO2 ;Is there a latest-set marker?
BRW GOMERR ;No - can't find the marker
MRKGO2: CMPL R3,EN ;At the end of the buffer?
BLSS 10$ ;No
BRW GOMERR ;Yes - can't find the marker
10$: BSBW PUSMKS ;Push the display ptr on the marker stack
MRKGO3: MOVL R3,DISPTR ;Save the current pointer
CLRQ R7 ;Put the cursor home
BISL #M_XPL!M_XPC!M_XPB,F ;Say no pointers are good
MOVZBL -1(R3),R1 ;Is the display ptr at the start of line?
CMPB R1,#^X0A
BEQL 10$ ;Yes
MOVL #1,R4 ;No - move to the start of the next line
JSB ADVDPT
10$: JMP DISALL ;Re-display the screen and get a new command
;Here on enter-marker - go to the default marker
MRKDGO: JSB RESTPM ;Clean up the parameter
MOVL MRKPTB-4,R3 ;Get the default marker - is it set?
BNEQ MRKGO2 ;Yes - go set it up
BRW GOMERR ;No - error
;Here to kill the given marker
MARKKL: BSBW GTMNAM ;Get the name of the marker in R2, R3
CMPL R2,#^A"* " ;Want to clear all the markers?
BEQL MRKKLA ;Yes - do so
BSBW FNMNAM ;Find the name in the table (index in R4)
BLBS R0,10$
BRW SMXERR ;Not there - error
10$: CLRL MRKNTB-4[R4] ;Found - kill it
JMP LOOP ;Go get a new command
MRKKLA: MOVL MRKEND,R1 ;Clear all the markers in use - are any?
BLEQ 20$ ;No - nothing to do
CLRL MRKEND ;Yes - reset the highest in use
10$: CLRL MRKNTB-4[R1] ;Clear a marker
SOBGEQ R1,10$ ;Loop through all the markers
20$: JMP LOOP ;Then go get a new command
;Here to output the names of all the defined markers
MARKNM: JSB SWHBOT ;Set up the bottom line
TSTL MRKPTB-4 ;Is there a default marker?
BEQL MRKNMX ;No - handle specially
MOVAB MNMSG1,R1 ;Yes - output "<Default>"
JSB PUTSTG
MRKNM0: MOVL MRKEND,R2 ;Start with the last defined one
MRKNM1: MOVL MRKNTB-4[R2],R1 ;Get a name - any?
BEQL MRKNM2 ;No - skip this entry
JSB PUTSQ1 ;Yes - output the name
MOVL MRKNT1-4[R2],R1 ;Is there a second part?
BEQL 10$ ;No
JSB PUTSQ1 ;Yes - output it too
10$: MOVB #^A" ",(R5)+ ;Separate name from next name
MRKNM2: SOBGTR R2,MRKNM1 ;Loop through all the names
JMP SWHNPE ;Then output them and loop
MRKNMX: TSTL MRKEND ;Are any markers defined?
BGTR MRKNM0 ;Yes - continue
MOVAB MNMSG2,R1 ;No - tell him
JSB PUTSTG
JMP SWHNPE ;Done
MNMSG1: .ASCIZ /<Default> /
MNMSG2: .ASCIZ /(None defined)/
SMXERR: MOVAB SMXERM,R1
JMP ERROR
SMXERM: .ASCIZ /#######Marker name not found/
;Subroutine to get the name of the marker in R2, R3
GTMNAM: JSB ERASPM ;Clean up the parameter from the screen
JSB PUTTYP ;Output the cursor positioning
MOVAB SAVEAC,R4 ;Get pointers to source and target
MOVAB PARBUF+1,R6
MOVL #^A" ",SAVEAC
MOVL SAVEAC,SAVEAC+4
MOVL #8,R0 ;Set to get at most 8 characters
GTMNM1: MOVZBL (R6)+,R1 ;Get a character of the name
BEQL 20$ ;Done if null
CMPB R1,#^A"a" ;Lower case?
BLSS 10$ ;No
CMPB R1,#^A"z"
BGTR 10$
SUBL #^O40,R1 ;Yes - convert to upper
10$: MOVB R1,(R4)+ ;Save the character
SOBGTR R0,GTMNM1 ;Loop thru all characters (up to 8)
20$: MOVQ SAVEAC,R2 ;Get the name
RSB ;Done
;Subroutine to find the marker whose name is given in R2, R3
;Returns R0/ 1 if found, with index in R4; returns R0/ 0 if not found
FNMNAM: MOVL MRKEND,R4 ;Get index of last entry in marker table
BLEQ 30$ ;Any? No - return failure
10$: CMPL R2,MRKNTB-4[R4] ;Is this the mark?
BEQL 40$ ;Maybe - check the second part
20$: SOBGTR R4,10$ ;No - loop through the table
30$: CLRL R0 ;Return failure
RSB
40$: CMPL R3,MRKNT1-4[R4] ;Does the second part match?
BNEQ 20$ ;No - keep looking
MOVL #1,R0 ;Yes - return success
RSB
;Subroutines to work with the marker stack
;Clear the entire stack (on a set-file)
CLRMKS::CLRL MRKSTP ;Point to the top of the stack
PUSHR #^M<R1,R2,R3,R4,R5>
MOVC5 #0,MRKSTK,#0,#<MRKSTL*4>,MRKSTK ;Clear the stack
POPR #^M<R1,R2,R3,R4,R5>
RSB ;Done
;Subroutine to push a display pointer on the marker stack
PUSMKS::MOVL MRKSTP,R2 ;Get the stack pointer
MOVL DISPTR,MRKSTK[R2] ;Save the display pointer on the stack
DECL MRKSTP ;Bump the stack - wrapped around?
BGTR 10$ ;No - done
MOVL #MRKSTL-1,MRKSTP ;Yes - point to the top of the stack
10$: RSB ;Done
;Subroutine to pop a display pointer from the marker stack
POPMKS: JSB RESTPM ;Clean up the parameter on the screen
INCL MRKSTP ;Bump the stack pointer
MOVL MRKSTP,R1 ;Get it
CMPL R1,#MRKSTL-1 ;Wrapped around?
BLEQ POPMK1 ;No
CLRL R1 ;Yes - set to the bottom of the stack
CLRL MRKSTP
POPMK1: MOVL MRKSTK[R1],R3 ;Get display pointer from the stack
BEQL 10$ ;Any?
BRW MRKGO3 ;Yes - go set up the screen
10$: INCL MRKSTP ;No - bump and get the stack pointer
MOVL MRKSTP,R1
CMPL R1,#MRKSTL-1 ;Wrapped around?
BLEQ POPMK1 ;No - see if there's something more
POPMK2: CLRL MRKSTP ;Point to the start of the marker list
MOVAB POPERM,R1
JMP ERROR
POPERM: .ASCIZ /##########Stack is empty/
;Subroutine to go back to the previous entry on the marker stack
;(alias pop forward)
POPMKF: JSB RESTPM ;Clean up the parameter on the screen
DECL MRKSTP ;De-bump the stack pointer
BGEQ 10$ ;Warpped around?
MOVL #MRKSTL-1,MRKSTP ;Yes - set to the top of the stack
10$: MOVL MRKSTP,R1 ;Fetch the pointer
POPMF1: MOVL MRKSTK[R1],R3 ;Get the display pointer from the stack
BEQL 10$ ;Any?
BRW MRKGO3 ;Yes - go set up the screen
10$: DECL MRKSTP ;No - bump and get stack pointer
DECL R1
BGEQ POPMF1 ;If not wrapped around, check again
BRB POPMK2 ;Else give stack-is-empty error
GLOB ;Define the global symbols
.END