Trailing-Edge
-
PDP-10 Archives
-
tops20tools_v6_9-jan-86_dumper
-
tools/sed2/sed1ds.mar
There are 5 other files named sed1ds.mar in the archive. Click here to see a list.
.TITLE SED1DS - Screen Display, Control, and Update Routines
.LIBRARY /SEDITB.MLB/
.ENABLE DEBUG
.DISABLE GLOBAL
.PSECT CODE,NOWRT,EXE,LONG
$IODEF ; and the I/O function values
PRMDEF ;Define the SED parameters
TRMDEF ;Define the words in the terminal output table
FLGDEF ;and the flag bits
.EXTERNAL SS$_TIMEOUT
.SUBTITLE Display Subroutines
;**********************************************************************
; Utility Subroutines
;**********************************************************************
;The routines below deal with displaying part of the buffer on the screen
;JMP DISDWN - From cursor position to end of screen
;JMP DISALL - Entire screen
;JSB DISPLL - Entire screen
;JMP DISCUR - Reposition cursor
;JSB DISLIN - Position, remainder of line
;JSB DISONL - Position, entire line
;JSB DISONE - Entire line
;Here to display from the line the cursor is on to the bottom,
;position the cursor where it belongs, and go get a new command
DISDWN::BBC #V_XCT,F1,10$ ;If doing an execute,
BRW DISCUR ; no display
10$: TSTL CPG(R10) ;Is there a sequence for clear to EOP?
BEQL DISDWC ;No - see if clear-to-eol's will work
MOVL R7,R4 ;Yes, move cursor to start of line
JSB POSLIN
JSB CLEARP ;Clear to end of page
DISDW1: MOVL LINPTR,R6
SUBL3 R7,LPP(R10),R4 ;Find number of lines to display
BBC #V_WDW,F1,10$ ;Windowing?
BSBW DISWDW ;Yes - (maybe) adjust count
10$: BICL2 #M_FNC!M_FBL,F ;Fence will be re-drawn; bottom line OK
BSBW DISPLY ;Re-display all lines after cursor position
BBC #V_IMD,F,DISCUR ;In insert mode?
BSBW INSMSG ;Yes, put up insert message
BRB DISCUR ;Position cursor and loop
;Here if there's no clear-to-end-of-screen - use c-eol's if possible
DISDWC: TSTL CLN(R10) ;Can the terminal clear a line?
BEQL DISALL ;No - go display the entire page
SUBL3 R7,LPP(R10),R4 ;Yes - clear each line separately
;Find number of lines to display
BBC #V_WDW,F1,10$ ;Windowing?
BSBW DISWDW ;Yes - (maybe) adjust count
10$: MOVL R4,R3
MOVL R7,R4
DISDCL: BSBW POSLIN ;Move to the start of another line
BSBW CLRLNA ;Clear it out
INCL R4 ;Move to next line
SOBGTR R3,DISDCL ;Loop through all lines
MOVL R7,R4 ;Move cursor to start of first line
BSBW POSLIN
BRB DISDW1 ;Re-join the flow
;DISRES: Entry point for the re-display screen option of the reset command
DISRES::BSBW RESTPM ;Reset enter mode
BBC #V_XSV,F1,DISALL ;Saving an execute buffer?
MOVB #^O77,@XCTPTW ;Yes - overwrite real code with execute code
DISALL::BSBB DISPLL ;(Enter here to display all and loop)
DISCUR::BSBW POSCUR ;Re-position the cursor and return
JMP LOOP ;and get another command
;Subroutine to display a screenful of data, starting from DISPTR
;R1-R4 and R6 are fragged
DISPLL::BBS #V_XCT,F1,4$ ;Doing an execute? Yes - no display
BSBW CLRALL ;Go home and clear the screen
MOVL DISPTR,R6 ;Get pointer to start of display
MOVL LPP(R10),R4 ;Set to display entire screen
BBC #V_WDW,F1,15$ ;Windowing?
BSBB DISWDW ;Yes - (maybe) adjust count
15$: BSBW DISPS0 ;Do the display
MOVL DISPPT,BOTPTR ;Save pointer to last line as bottom pointer
BITL #M_FNC,F ;Is the fence on the screen?
BNEQ 2$ ;Yes
BICL #M_XPB,F ;No, mark bottom pointer as good
BRB 3$
2$: BISL #M_XPB,F ;Mark bottom pointer as bad
3$: BICL #M_FBL,F ;But bottom line itself is O.K.
BBC #V_IMD,F,4$ ;In insert mode?
BRW INSMSG ;Yes - put insert message up
4$: RSB ;No - done
;Subroutine if windowing - if top window display one fewer line
DISWDW: TSTL HOMPOS ;In the top window?
BNEQ 10$ ;No
DECL R4 ;Yes - display one fewer line
10$: RSB
;Subroutine to display one line, from cursor position to end
;Cursor does not have to be positioned; CHRPTR must be right
DISLIN::BBC #V_XCT,F1,1$ ;Doing an execute?
RSB ;Yes, no display
1$: BSBW POSCUR ;Move cursor to its rightful position
TSTL CLN(R10) ;Can terminal clear to end of line?
BNEQ 2$ ;Yes
MOVL F1,SAVEAC+16 ;No - make tabs come out as spaces
BICL #M_TBS,F1
BRB 3$ ; and clear line later
2$: BSBW CLRLNR ;Let the terminal clear the line
3$: MOVL CHRPTR,R6 ;Set to write one line where cursor is
MOVZBL #1,R4 ;Say one line will be displayed
MNEGL CPL(R10),R2 ;Compute negative character count
ADDL2 R8,R2 ;Count: chars remaining in line
BBC #V_WRP,F1,4$ ;Will lines wrap around?
CMPL R7,LPP.1 ;Yes, on last line?
BLSS 4$
DECL R2 ;No - do one more character
4$: DECL R2
MOVL R2,CHRCNT ;Save it as the character count
ADDL3 SL,R8,R2 ;Offset: slide + chars not remaining
BSBW DISPL0
DISCLR: TSTL CLN(R10) ;Could terminal clear to end of line?
BEQL 10$
11$: RSB ;Yes - done
10$: MOVL F1,SAVEAC+16 ;No - restore correct TBS flag
MOVL CHRCNT,R0 ;Get ending position in line
BEQL 11$ ;Nothing to clear if line is full
ADDL2 CPL(R10),R0
SUBL #2,R0
BRW CLRLN2 ;Clear remainder of line and return
;Here to display one entire line pointed to by (R6)
;If cursor is already positioned enter at DISONE
DISONL::BBC #V_XCT,F1,1$ ;Doing an execute?
RSB ;Yes - no display
1$: MOVL R7,R4
BSBW POSLIN ;Move cursor to start of line
MOVL LINPTR,R6
DISONE::TSTL CLN(R10) ;Can terminal clear to end of line?
BNEQ 10$ ;Yes
MOVL F1,SAVEAC+16 ;No
BICL #M_TBS,F1 ;Make tabs come out as spaces
BRB 20$ ;and clear line later
10$: BSBW CLRLNA ;Let terminal clear the whole line
20$: MOVZBL #1,R4 ;Display one entire line
BSBB DISPLY ;Display the line
BRB DISCLR ;Clear rest of line and return
;Subroutine to display (R4) lines starting at where R6 points in buffer
;Cursor is assumed to be at the right position
;R1-R4 and R6 are fragged
DISPLY::BBC #V_XCT,F1,1$ ;Doing an execute?
RSB ;Yes - no display
1$: BICL #M_LFF,F
BRB DISPS1
DISPS0::BICL #M_FNC!M_LFF,F
DISPS1: BSBW DISSLD ;Skip over, if there's a slide
DISPL0: MOVAB TYPBUF+TYPSIZ+1,R3 ;Set up end-of-type-buffer address
;Now copy line into display buffer
DISPL1: CMPL R6,EN ;At end of buffer?
BLEQ 10$
BRW DISPEN ;Yes - display the rest, then done
10$: MOVZBL (R6)+,R1 ;Get a character from the file buffer
BEQL DISPL1 ;Ignore a null
INCL R2 ;Count the character
INCL CHRCNT ;Increment the character count
BGEQ DISSKP ;Jump if line has filled the screen
BBCC #V_LFF,F,DISPL2 ;Looking for a line feed?
BRW DISPLF ;Yes - see if this is one
DISPL2: CMPB R1,#^A" " ;Some kind of control character?
BLSS DISCTL ;Yes - handle it separately
CMPB R1,#^O177 ;Is it a rubout?
BEQL DISRUB ;Yes - display as highlighted "?"
DISPL3: MOVB R1,(R5)+ ;Store character in type buffer
DISPL4: CMPL R3,R5 ;Is buffer filled?
BGEQ DISPL1 ;No
BSBW PUTTYP ;Yes - finish buffer and output it
BRB DISPL1 ;Either way, get some more
;Here if a full line of characters has been found; ignore rest of line
DISSKP: CMPB R1,#^O12 ;Is last character a <LF>?
BNEQ 10$ ;No
BICL #M_LFF,F ;Yes - clear linefeed flag
BRW DISPLF ;and end line
10$: CMPB R1,#^O15 ;Use this char if it's a <CR>
BEQL DISKP2
MOVL OVF(R10),R1 ;Get string to indicate line overflow
BEQL DISKP1 ;Anything there? No - don't output anything
BSBW PUTSEQ ;Yes - output it
DISKP1: MOVZBL (R6)+,R1 ;Ignore rest of line
DISKP2: CMPB R1,#^O15 ;End of line?
BNEQ DISKP1 ;No - ignore another character
MOVZBL (R6)+,R1 ;Found <CR> - get <LF>
CMPB R1,#^O12 ;Is it really?
BNEQ DISKP2 ;Of course not - keep ignoring
BBS #V_WRP,F1,10$ ;Need a carriage return at end of long line?
BRW DISPF1 ;Yes - finish line with <CR>
10$: DECL R4 ;No - working on last line?
BLSS 20$ ;No
BRW DISPF2 ;No
20$: CLRB (R5) ;Yes - overwrite last char with null
BRW PUTTYP ;Finish the display and return
;Here if character is a control character
;If not <CR>, <LF>, or <TB>, display as reversed-ascii character
DISCTL: CMPB R1,#^O15 ;Just a <CR>?
BNEQ 10$
BISL2 #M_LFF,F ;Maybe - set flag to look for <LF>
BRB DISPL4 ;and check no further
10$: CMPB R1,#9 ;Tab?
BEQL DISTAB ;Yes - treat specially
BSBB DISREV ;Else output reversed character
BRB DISPL4
;Here if character is a rubout - display as protected "?"
DISRUB: MOVB #^A"?"-64,R1 ;Set it up so it comes out as a space
BSBB DISREV ;Output it in reversed-ascii
BRB DISPL4 ;and go check the buffer
;Here to handle a tab - de-bump position by size of tab
;If slide is a multiple of 8, work with tab; else convert to spaces
DISTAB: BITL #7,SL ;Is slide a multiple of 8?
BNEQ DISTBX ;No - simulate with spaces
BBC #V_TBS,F1,DISTBX ;Got hardware tabs?
BBS #V_DTB,F,DISTBA ;Want to display tabs?
DISTB0: BITL #7,R2 ;Move over to tab boundary
BEQL 10$
INCL R2
INCL CHRCNT
BLSS DISTB0
10$: BRW DISPL3 ;Save tab in display buffer
DISTBA:
DISTBB: BSBW PROTON ;Turn protection on
MOVB #^A"T",(R5)+ ;Indicate with a T followed by dots
BRB 15$ ;Skip one dot
10$: MOVB #^A".",(R5)+ ;Output protected dots over the length of the tab
15$: BITL #7,R2 ;At a tab boundary?
BEQL 20$ ;Yes
INCL R2 ;No - keep going
INCL CHRCNT
BNEQ 10$
20$: BSBW PROTOF ;Turn protection off
BRW DISPL4 ; and return
;DISTBA: BSBB DISREV ;Output a reversed "I"
; BITL #7,R2 ;Is tab really only one space long?
; BNEQ 10$
; BRW DISPL4 ;Yes - don't output the tab
;10$: MOVB #9,R1 ;Else get the tb back again
; BRB DISTB0 ;and output it
DISTBX: BBS #V_DTB,F,DISTBB ;Want to display tabs?
DISTX1: MOVB #^A" ",(R5)+ ;Simulate tab: get a space
BITL #7,R2 ;Save until at a tab boundary
BEQL 10$
INCL R2
INCL CHRCNT
BNEQ DISTX1
10$: BRW DISPL4
;DISTBB: BSBB DISREV ;Output a reversed "I"
; BITL #7,R2 ;At a tab boundary?
; BNEQ 10$
; BRW DISPL4 ;Yes - continue
;10$: INCL R2
; INCL CHRCNT
; BRB DISTX1 ;No - output some spaces, too
;Subroutine to output the character in R1 as highlighted ASCII
DISREV: PUSHR #^M<R1> ;Save R1
BSBW PROTON ;Turn on background mode
POPR #^M<R1> ;Restore reversable character
ADDB2 #^A"A"-1,R1 ;Make it a character
MOVB R1,(R5)+ ;Save it
BSBW PROTOF ;Turn off background mode
CMPL R3,R5 ;Is buffer filled?
BGEQ 10$ ;Yes - finish buffer and output it
BRW PUTTYP
10$: RSB ;No - just return
;Here if EOF reached before E.O. Screen. Output fence; done
DISPN1: POPR #^M<R0> ;Restore the stack (here from DISSLD)
DISPEN: BSBW PUTTYP ;Finish buffer and output it
BRW FIXBLW ;Display fence and return
;Here if expecting a <LF> after a <CR>. If got one, count an end of line
DISPLF: CMPB #^O12,R1 ;Is this character a <LF>?
BNEQ DISPCR ;No - reverse the <CR> and continue
DISPF1: SOBGTR R4,10$ ;Count lines output - not finished
BSBW PUTTYP ;Empty the buffer
BBS #V_SCN,F,DISTST ;Scanning? Yes - see if user wants to stop
RSB ;No - just return
10$: MOVB #^O15,(R5)+ ;Save the old <CR>
BSBW CDOWN ;Move to next line down
DISPF2: BSBB DISTST ;Interrupt display if it's a command
CMPL R6,EN ;At the end of the buffer?
BGEQ DISPEN ;Yes - finish the display
MOVL R6,DISPPT ;Save pointer to the start of this line
BSBW DISSLD ;Skip over, if there's a slide
BRW DISPL4 ;and continue
;Here if character following <CR> is not <LF> - make <CR> reversed CTRL-M
DISPCR: PUSHR #^M<R1> ;Save current character
MOVB #^O15,R1 ;Set to output reversed <CR>
JSB DISREV
POPR #^M<R1> ;Restore current character
BRW DISPL2
;Here if user typed a character during the display - stop it if
;enter or command, else drive on
DISTST: $QIOW_S FUNC=#IO$_TTYREADALL!IO$M_NOECHO!IO$M_TIMED,-
CHAN=TTCHAN,-
IOSB=TTY_STATUS_BLOCK,-
P1=TTYBUF,-
P2=#1,-
P3=#0 ;Read with zero timeout to test for input
BLBS R0,20$ ;Go if no errors
10$: RSB ;Otherwise, just return
20$: CMPW TTY_STATUS_BLOCK,#SS$_TIMEOUT ;Check for timeout error
BEQL 10$ ;Return if so
BBSS #V_CWT,F,10$ ;Say character has been read - has one already?
BBCC #V_SCN,F,30$ ;Scanning?
BICL #M_CWT,F ;Yes - no waiting command
MOVL #12,R7 ;Put cursor near center of screen
MOVL #40,R8
BISL #M_XPL!M_XPC,F ;Line and character pointers are no good
RSB ;and quit
30$: MOVB TTYBUF,TYPCHR ;Save character for later
CMPB TYPCHR,#^A" " ;Control character?
BGEQ 10$ ;No - just continue with the display
MOVL STACK,SP ;Yes - clean up the stack
MOVAB TYPBUF,R5 ;Purge any unsent output
JMP LOOP ;Get another command
;Subroutine to skip over a slide's worth of spaces
DISSLD: TSTL SL ;If no slide,
BEQL DISSLE ;just set up size
MNEGL SL,CHRCNT ;Else skip that many characters
CLRL R2
DISSL1: MOVZBL (R6)+,R1 ;Get a character from the file buffer
CMPL R6,EN ;At end of buffer?
BLEQ 5$ ;No
BRW DISPN1 ;Yes - display the rest, then done
5$: TSTB R1 ;Null character?
BEQL DISSL1 ;Yes, ignore it
CMPB #^O15,R1 ;If <CR>, see if end of line
BNEQ 10$
MOVZBL (R6),R1 ;Get linefeed
CMPB #^O12,R1 ;Is it really?
BNEQ DISSL2 ;No - skip the <CR>
INCL R6 ;Yes - skip <CRLF>
MOVL (SP)+,R0 ;Kill call to DISSLD
MOVAB TYPBUF+TYPSIZ+1,R3 ;Set up end-of-type-buffer address
BRW DISPLF ;and end the line
10$: CMPB #9,R1 ;Tab?
BEQL DISSLT ;Yes - count it
DISSL2: INCL R2 ;Go until skipped out
INCL CHRCNT
BLSS DISSL1
DISSLE: MNEGL CPL(R10),CHRCNT ;Get character count
DECL CHRCNT
MOVL SL,R2 ;And column number
RSB ;Then return
DISSLT: BICL3 #^C7,R2,R1 ;Here if tab - find its size
SUBL #8,R1
10$: INCL R2 ;Count a space, jump if end of slide
INCL CHRCNT
BGEQ DISLFP
INCL R1 ;Loop through tab
BLSS 10$
BRB DISSL1 ;Get another character
DISLFP: INCL R1 ;If exactly counted out,
BEQL DISSLE ; put nothing in
CLRL CHRCNT
10$: MOVB #^A" ",(R5)+ ;Slide ends in middle of tab
INCL CHRCNT
INCL R1 ;Put in all extra spaces
BLSS 10$
SUBL CPL(R10),CHRCNT ;Set up length of remainder of line
DECL CHRCNT
CLRL R2
RSB ;Then done
.SUBTITLE Undo Damage Caused by Enter Mode
;***************************************************************************
;Routines to undo the damage caused by enter mode, which can be:
; 1. Reversed-space at cursor position (cover with character from buffer)
; 2. Enter line at bottom of screen (re-write with line from buffer)
; 3. Enter flag (reset it)
; 4. Cursor is ill-positioned (re-position it)
;The enter flag must always be cleared. The other things may not need to
;be undone, depending on how much of the screen has been overwritten.
;Thus the above are handled by different subroutines, so no more work needs
;to be done than necessary.
;The line at the bottom must be re-done quickly if it needs to be done at all.
;The text mark should also be done quickly, so CHRPTR may not need re-making.
;Cursor positioning should be the last thing done by the command routine
;Subroutine to reset enter mode (Note: can't frag R4)
RESTPM::BBSC #V_ENT,F,RESTP1 ;Was enter typed?
RSB ;No - nothing to do
RESTP1::BITL #M_XCT!M_XBN,F1 ;Executing?
BNEQ ERSPM2 ;Yes - don't output anything
MOVL R4,-(SP) ;Else save old R4
BRB ERSPM1 ;and de-blip the blip
;Subroutine to write last line of screen over entered parameter
ERASPM::BBSC #V_ENT,F,10$ ;Was enter typed?
RSB ;No - nothing to do
10$: BITL #M_XCT!M_XBN,F1 ;Executing?
BNEQ ERSPM2 ;Yes - don't output anything
ERSPM0::MOVL R4,-(SP) ;Save old R4
BSBW FIXBLN ;Re-do the bottom line
ERSPM1: MOVZBL CHRCUR,R1 ;Got a blip to de-blip?
BEQL ERSP2A ;No - don't de-blip it
CMPB R1,#^A" " ;Is char a control char?
BGEQ 10$ ;No
BBC #V_MRK,F1,ERSP2A ;Yes - got a mark there?
ADDB3 #^O100,R1,CHRCUR ;Yes - make character a real character
10$: BSBW POSCUR ;Else position the cursor
MOVB CHRCUR,(R5)+ ;and put proper character back there
BSBW CLEFT ; and position over the character
ERSP2A: MOVL (SP)+,R4 ;Restore R4
ERSPM2::BBSC #V_CMV,F,10$ ;Clear cursor movement flag - was it on?
RSB ;No - return
10$: CMPL R7,SAVPOS ;Yes - was row changed?
BEQL 20$ ;No
BISL #M_XPL!M_XPC,F ;Yes - pointers are no good
MOVL SAVPOS,R7 ;Restore saved row position
20$: CMPL R8,SAVPOS+4 ;Was column changed?
BEQL 30$ ;No
BISL #M_XPC,F ;Yes - cursor position is no good
MOVL R8,R1 ;Save change in columns in SAVEAC
MOVL SAVPOS+4,R8 ; and restore saved column pointer
SUBL R8,R1
MOVL R1,SAVEAC
BGEQ 30$
MNEGL R1,SAVEAC
30$: BRW PUTTYP ;Output the positioning and return
.SUBTITLE Output the fence
;Subroutines to fix up the bottom line of the screen
;Erase it if NEL flag is set
;else puts up insert mode message, fence, or both
FIXBLC::BSBW CLEARP ;Clear to end of screen
FIXBLN::BBC #V_NEL,F1,FIXBLF ;Can bottom line remain fragged?
CLRL R0 ;Yes - flag it for later
BRB FIXBLX
FIXBLF::CVTBL #1,R0 ;Flag bottom line to be re-done
FIXBLX: BBC #V_IMD,F,10$ ;No - in insert mode?
BBC #V_BEP,F1,20$ ;Yes - but beeping?
10$: BICL #M_FBL,F ;Not insert, or beeping - repair bottom line
BRB 30$
20$: JMP INSMSG ;Insert, not beep - put up insert mode message
30$: BBCC #V_XPB,F,40$ ;Is pointer to last line valid?
BSBW MAKBPT ;No - make it
40$: MOVL BOTPTR,R6 ;Is there really a bottom line?
BEQL FNCPUT ;No - put up the fence and return
TSTL R0 ;Need to re-do bottom line?
BEQL 50$ ;No - just clear it
BSBW CBOTOM ;Else move to bottom of screen
BRW DISONE ;Re-do the bottom line and return
50$: BRW CBOTOM ;Clear bottom line and return
;Subroutine to put up the fence or insert mode message,
;but not repair the bottom line if no message should be displayed
FIXBLW::BBC #V_IMD,F,10$ ;In insert mode?
BBS #V_BEP,F1,10$ ;Yes - but beeping?
JMP INSMSG ;Insert, not beep - put up insert mode message
10$: BICL #M_FBL,F ;Not insert, or beeping - repair bottom line
BBCC #V_XPB,F,20$ ;Is pointer to last line valid?
BSBW MAKBPT ;No - make it
20$: MOVL BOTPTR,R6 ;Is there really a bottom line?
BEQL FNCPUT ;No - put up the fence
RSB ;Yes - do nothing
;*****************************************************************************
;Subroutine to output the fence (FNCCLR clears to end of screen)
FNCCLR::BSBW CLEARP ;Clear to end of screen
FNCPUT::ADDL3 #3,R7,R1 ;Get row + 3
CMPL R1,LPP.1 ;Close to the bottom of the screen?
BLSS 10$ ;No
BRW CBOTOM ;Yes - just clear the bottom line
10$: MOVAB FENCE,R1 ;Output the fence on the bottom line
TSTB FNCFLG ;/FENCE set?
BNEQ 20$ ;Yes
MOVAB FENCE1,R1 ;No - print shorter fence
20$: BSBW PUTBTM
BSBW PROTOF
BISL #M_FNC,F ;Set flag to say fence is up
BRW POSCUR ;Re-position the cursor; done
;Subroutine to output insert mode message
INSMSG::BBC #V_BEP,F1,10$ ;Beeping?
RSB ;Yes - no message
10$: BBCC #V_XPB,F,20$ ;Is pointer to last line valid?
BSBW MAKBPT ;No - make it
20$: MOVL BOTPTR,R6 ;Is there really a bottom line?
BNEQ 30$ ;Yes
MOVAB INSMS2,R1 ;No - put up fence as well as insert mode
BISL #M_FNC,F
BRB 40$
30$: MOVAB INSMS1,R1 ;Yes - output just insert mode
BICL #M_FNC,F
40$: BSBW PUTBTM
BSBW PROTOF
BISL #M_FBL,F ;Mark bottom line as fragged
BRB POSCUR ;Re-position the cursor and return
INSMS1: .ASCIZ / *INSERT MODE* /
INSMS2: .ASCIZ / *INSERT MODE ** FENCE* /
.SUBTITLE Subroutines to Position the Cursor
;*****************************************************************************
;Subroutines to position the cursor
;These just call the actual positioning routines in the terminal-dependent
;code, output idles as desired, and type out the type buffer
POSLIN::ADDL HOMPOS,R4 ;Make position relative to home
JSB @PSL(R10) ;Position to the right line
SUBL HOMPOS,R4 ;Restore proper position
BRB POSEND ;Go finish off
POSCUR::ADDL HOMPOS,R7 ;Make row position relative to home
JSB @PSC(R10) ;Position to the right character
SUBL HOMPOS,R7 ;Restore proper position
POSEND::BBC #V_NLP,F1,20$ ;Follow with some nulls? No
MOVB NUL(R10),R1 ;Yes - get null character
CVTWL NUL+2(R10),R2 ; and number of nulls to output
10$: MOVB R1,(R5)+ ;Output a null
SOBGTR R2,10$ ;Output all nulls, in fact
20$: BRW PUTTYP ;Then send it all out and return
.SUBTITLE Terminal Dependent Output Section
;Store various character sequences in the type buffer
CBOTOM::BSBW CMVBTM ;Move to bottom line
;and fall into clear it code
CLRLNA::CVTBL #-1,R0 ;Set to clear entire line
BRB CLRLN2
CLRLNR::MOVL R8,R0 ;Set to clear to end of line
CLRLN2: MOVL CLN(R10),R1 ;Can terminal clear to end of line?
BEQL 5$ ;No
BRW PUTSEQ ;Yes - go do it
5$: MOVL R2,-(SP) ;No - do it in software
MOVL R0,-(SP) ;Save some registers
BGEQ 10$ ;Is R0/-1?
CLRL R0 ;Yes - make it zero
10$: SUBL2 CPL(R10),R0 ;Find number of spaces to output
MNEGL R0,R0
MOVZBL #^A" ",R1 ;Get a space
MOVAB TYPBUF+TYPSIZ+1,R2 ;Set up end-of-type-buffer address
BSBB CLRLN1 ;Space over
MOVL R8,-4(SP) ;Exchange CM and last stack item
MOVL (SP),R8
MOVL -4(SP),(SP)
TSTL R8
BGEQ 20$ ;Want a CR?
MOVB #^O15,(R5)+ ;Yes - output it
BSBW PUTTYP ;and output the buffer
BRB 30$
20$: BSBB POSCUR ;Re-position the cursor
30$: MOVL (SP)+,R8 ;Get real column back
MOVL (SP)+,R2 ;Restore R2 too
RSB
CLRLN1: SUBL #2,R0
10$: MOVB R1,(R5)+ ;Space over
CMPL R2,R5 ;Is type buffer full?
BGTR 20$ ;No
BSBW PUTTYP ;Yes - output it
MOVB #^A" ",R1 ;Get the space again
20$: SOBGTR R0,10$ ;Do all the spaces
RSB ;Done
CHOME:: TSTL HOMPOS ;Is home really home?
BNEQ 10$ ;No
MOVL CHM(R10),R1 ;Yes - get sequence for cursor home
BRW PUTSEQ ;and output it
10$: CLRL R4 ;No - position to the fake home
BRW POSLIN
CLRALL::BBS #V_WDW,F1,10$ ;In a window?
MOVL HCP(R10),R1 ;No - go home and clear page
BRW PUTSEQ
10$: CLRL R4 ;Yes - position to fake home
BSBW POSLIN ;Position home
TSTL HOMPOS ;In lower window?
BEQL 15$ ;No
MOVL CPG(R10),R1 ;Yes - can terminal clear to EOP?
BEQL 20$ ;No - continue
BRW PUTSEQ ;Yes - do it
15$: SUBL3 #1,LPP(R10),R4 ;In upper window - clear one line fewer
BRB 40$
20$: MOVL LPP(R10),R4 ;No - output a bunch of clear lines
BRB 40$
30$: BSBB CDOWN
40$: BSBW CLRLNA
SOBGTR R4,30$
BRB CHOME ;Go home, output, and return
CLEARP::MOVL CPG(R10),R1 ;Clear to end of page
BRW PUTSEQ
IMODON::MOVL IMO(R10),R1 ;Turn insert-mode on
BISL #M_TIM,F1 ;and flag it as on
BRB PUTSEQ
IMODOF::MOVL IMF(R10),R1 ;Turn insert-mode off
BICL #M_TIM,F1 ;and flag it as off
BRB PUTSEQ
IMDOFN::MOVL IMF(R10),R1 ;Turn insert-mode off now
BICL #M_TIM,F1 ;and flag it as off
BSBB PUTSEQ
BRW PUTTYP
PROTON::MOVL PON(R10),R1 ;Can protection be turned on?
BNEQ PUTSEQ ;Yes - do it
RSB ;No - nothing to do
PROTOF::MOVL POF(R10),R1 ;Can protection be turned off?
BNEQ PUTSEQ ;Yes - do it
RSB ;No - nothing to do
CMVBTM::MOVL MVB(R10),R1 ;Cursor to bottom
BRB PUTSEQ
CRIGHT::MOVL CRG(R10),R1 ;Cursor right
BRB PUTSEQ
CLEFT:: MOVL CLF(R10),R1 ;Cursor left
BRB PUTSEQ
CURUP:: MOVL CUP(R10),R1 ;Cursor up
BRB PUTSEQ
CDOWN:: MOVL CDN(R10),R1 ;Cursor down
BRB PUTSEQ
ROLLUP::MOVL RUP(R10),R1 ;Roll up and clear line
BRB PUTSEQ
ROLLDN::MOVL RLD(R10),R1 ;Roll down and clear line
;Subroutine to output up to 4 characters in R1 (PUTSQ1)
PUTSEQ::BITL #^XFFFF,R1 ;Got a routine address?
BNEQ 10$ ;No
ASHL #-16,R1,R1 ;Yes - position the address offset
ADDL R10,R1 ;Add in the base address
JMP (R1) ;and dispatch to it
10$: BITL #^XFF,R1 ;Got the address of a long ascii string?
BNEQ PUTSQ1 ;No
ASHL #-16,R1,R1 ;Yes - position the string address
ADDL R10,R1 ;Add in the base address
BRB PUTSTG ;and go output the string
PUTSQ1::MOVL R1,TEMP ;Prepare to output the string
MOVAB TEMP,R1 ;Point to the string
BRB PUTSTG ;and go output it
;Subroutine to move to bottom, clear, protect, and output (R1)
PUTBTM::MOVL R1,SAVEAC+48 ;Save the message address
BSBW CBOTOM ;Put message on bottom line
BSBB PROTON ;Protect
MOVL SAVEAC+48,R1 ;Get address back
;Subroutine to output a string. Address in R1 (fragged)
PUTSTG::TSTB (R1) ;Check for null character
BEQL 10$ ;If so, done
MOVB (R1)+,(R5)+ ;Save character in type buffer
BRB PUTSTG ;and loop
10$: RSB ;Return on null character
;Subroutine to output a string ending in either space or null
;(Don't output the space). String to be output is in R1
PUTSPCL::MOVL R1,TEMP ;Save the string to be output
MOVAB TEMP,R1 ;Point to the string
10$: TSTB (R1) ;Check for null character
BEQL 20$
CMPB (R1),#^A" " ;Also check for space
BEQL 20$
MOVB (R1)+,(R5)+ ;Save character in type buffer
BRB 10$
20$: RSB ;Return on null or space
;Subroutine to output a string, address in R1 (fragged). Uses R0, R2
;Same as PUTSTG, but control characters are simulated by being protected
;If string being output is already protected enter PUTSTC; else PUTSTS
PUTSTS::CLRL R2 ;Clear flag to get simulation
BRB PUTSC1
PUTSTC::CVTBL #-1,R2 ;Set flag so no simulation
PUTSC1: MOVZBL (R1)+,R0 ;Get a character
CMPB R0,#^O177 ;Got a delimiter?
BEQL PUTSCD ;Yes - simulate it
CMPB R0,#^A" " ;Got a printing character?
BLSS PUTSC2 ;No - simulate it
MOVB R0,(R5)+ ;Save character in type buffer
BRB PUTSC1 ;and loop
PUTSCD: MOVZBL #^A">"-64,R0 ;Make 177 come out as protected ">"
PUTSC2: TSTB R0 ;Check for null
BNEQ 10$ ;No
RSB ;Yes - return
10$: MOVL R1,-(SP) ;Else save character and string address
MOVL R0,-(SP)
TSTL R2 ;Want to protect?
BNEQ 20$ ;No
BSBW PROTON ;Yes - do so
20$: MOVL (SP)+,R0 ;Restore the character
ADDB #^O100,R0 ;Convert to printing character
MOVB R0,(R5)+ ;Save it in the type buffer
TSTL R2 ;Want to protect?
BNEQ 30$ ;No
BSBW PROTOF ;Yes - do so
30$: MOVL (SP)+,R1 ;Restore the string address
BRB PUTSC1 ;and continue
;Subroutine to output an error message (address in R1, fragged)
;Same as PUTSTG, but #'s are converted to spaces
PUTSTX::MOVZBL (R1)+,R0 ;Get a character
BNEQ 10$
RSB ;Done if null
10$: CMPB #^A"#",R0 ;Else got an artificial space?
BNEQ 20$
MOVB #^A" ",R0 ;Yes - make it a real one
20$: MOVB R0,(R5)+ ;Save in type buffer
BRB PUTSTX ;and loop
;Subroutine to output "more informative" error messages.
;Output a string, similar to PUTSTX, but expanding special codes
;in the string according to the values of ERRCOD and longwords following.
; ^A output value in ASCII
; ^D output value in decimal
; ^x output character x (as long as x NE A,D)
;The first occurance of one of these symbols is expanded from ERRCOD/,
;the second from ERRCOD+4, the third from ERRCOD+8, etc.
PUTSTE::CVTBL #-4,ERRCTR ;Set the error code counter
MOVL R1,ERRPTR ;Save the pointer
PTSTE0: MOVZBL @ERRPTR,R0 ;Get a character
BNEQ 10$
RSB ;Done if null
10$: INCL ERRPTR ;Increment to next character
CMPB R0,#^A"#" ;Got an artificial space?
BNEQ 20$
MOVB #^A" ",R0 ;Yes - make it a real one
BRB PTSTE1
20$: CMPB R0,#^A"^" ;Got an up-arrow?
BEQL PTSTE2 ;Yes - handle special
PTSTE1: MOVB R0,(R5)+ ;Save character in type buffer
BRB PTSTE0 ;and loop
PTSTE2: MOVZBL @ERRPTR,R0 ;Peek at the next character
BNEQ 10$
RSB ;Done if null (not normal)
10$: INCL ERRPTR
CMPB R0,#^A"A" ;Ascii expansion?
BEQL PTSTEA ;Yes
CMPB R0,#^A"D" ;Decimal expansion?
BEQL PTSTED ;Yes
BRB PTSTE1 ;No - just output the character
PTSTEA: MOVAL PUTSTG,R0 ;Routine to put ASCII characters in type buffer
BRB PTSTE3 ;Set up for and use routine
PTSTED: MOVAL PUTNUM,R0 ;Routine to put Decimal number in type buffer
; BRB PTSTE3
PTSTE3: ADDL #4,ERRCTR ;Increment pointer to ERRCOD block
MOVL ERRCTR,R1
MOVL L^ERRCOD(R1),R1 ;Load next ERRCOD longword into R1
JSB (R0) ;Output code via appropriate routine
BRB PTSTE0 ;Go for another character
;Subroutine to output filespecs (for the switch command)
;Same as PUTSTG, but outputs only until first "/"
PUTSTF::MOVZBL (R1)+,R0 ;Get a character
BNEQ 10$ ;Done if null
5$: RSB
10$: CMPB R0,#^A"/" ;Else got start of switches?
BEQL 5$ ;Yes - done
MOVB R0,(R5)+ ;Save in type buffer
BRB PUTSTF ;and loop
;Subroutine to output the type buffer
PUTTYP::BBS #V_XCT,F1,PUTTY2 ;If executing, throw the buffer away
CMPL #TYPBUF,R5 ;Anything in the buffer?
BNEQ PUTTYF ;Yes
RSB ;No - just return
PUTTYF::SUBL3 #TYPBUF,R5,TBFSIZ ;Compute size of the record
MOVL R0,-(SP) ;Save R0
$QIOW_S CHAN=TTCHAN,- ;Output the record
FUNC=#IO$_WRITEVBLK!IO$M_NOFORMAT,-
P1=TYPBUF,-
P2=TBFSIZ
;Test for errors here
MOVL (SP)+,R0 ;Restore R0
PUTTY2: MOVAB TYPBUF,R5 ;Restore the buffer pointer
RSB ;and return
;Subroutine to output a decimal number
;Enter with number in R1, uses R0, R1
PUTNPO::INCL R1 ;Output (R1) + 1
PUTNUM::PUSHR #^M<R0,R1,R2,R3,R4,R5> ;Save registers
CVTLP R1,#8,TMPSTR ;Convert to packed decimal
EDITPC #8,TMPSTR,FIXPATTERN,DEC_STRING ;Convert to ascii string
POPR #^M<R0,R1,R2,R3,R4,R5> ;Restore registers
MOVAB DEC_STRING,R1 ;Point to the ascii string
MOVZBL #8,R0 ;Get the length
10$: CMPB #^A"0",(R1) ;Get rid of leading zeros
BNEQ 20$
INCL R1 ;Step to next character
SOBGTR R0,10$
MOVB #^A"0",(R5)+
RSB
20$: MOVB (R1)+,(R5)+ ;Copy the rest of the string
SOBGTR R0,20$
RSB ;Then return
;Pattern for the EDITPC command above
FIXPATTERN: EO$SET_SIGNIF ;Set the significance flag
EO$MOVE 8 ;Move 8 bytes
EO$END ;End the edit
;Subroutine to output filespecs (for the Save File command)
;Same as PUTSTG, but outputs only until first ";"
PUTFIL::MOVZBL (R1)+,R0 ;Get a character
BNEQ 10$ ;Done if null
5$: RSB
10$: CMPB R0,#^A";" ;Else got start of version number?
BEQL 5$ ;Yes - done
MOVB R0,(R5)+ ;Save in type buffer
BRB PUTFIL ;and loop
GLOB ;Define the external routines
.END