Trailing-Edge
-
PDP-10 Archives
-
integ_tools_tops20_v7_30-apr-86_dumper
-
tools/sed-for-vms/sedvax.mar
There are 5 other files named sedvax.mar in the archive. Click here to see a list.
.TITLE SED - VAX-11 Screen Editor
.SUBTITLE Definitions
;This VAX version of SED is a translation of the DEC-10/20 version
;of SED written by Chris Hall. The translation was done at
;Brigham Young University by Paul Malquist
.LIBRARY /SEDITB.MLB/ ;Define SED's macro library
.ENABLE DEBUG
.DISABLE GLOBAL ;Show undefined variables as errors
.PSECT CODE,NOWRT,EXE,LONG
.NOCROSS ;Disable cross-referencing of definitions
$IODEF ;Define the I/O function values
$TTDEF ; and the terminal status values
$CHFDEF ; and the condition handler values
$DVIDEF ; and the $GETDVI symbols
$DCDEF ; and the device class symbols
$DSCDEF ; and the string descriptor symbols
$LIBCLIDEF ; and the library symbols
FLGDEF ;Define the flag bits
SEQDEF ;And the character sequence definitions
TRMDEF ;And the words in the terminal output table
PRMDEF ;Define the SED parameters
.CROSS ;Re-enable cross-referencing
.EXTERNAL TERMNL,TRMERR
.EXTERNAL LIB$GET_SYMBOL,LIB$SET_SYMBOL,LIB$DELETE_SYMBOL
.EXTERNAL LIB$DISABLE_CTRL,LIB$ENABLE_CTRL,LIB$RUN_PROGRAM
.EXTERNAL NAMLEN,TRMNAM,NAMTAB
;Define the registers we will use
;T0=R0 ;Scratch registers
;T1=R1
;T2=R2
;T3=R3
;T4=R4
;TY=R5 ;Pointer into the type buffer
;PT=R6 ;General pointer into the file
;RW=R7 ;Row cursor is on
;CM=R8 ;Column cursor is on
;DO=R9 ;Command user typed
;TM=R10 ;Terminal index
.SUBTITLE Startup Routine
START: .WORD 0 ;Entry mask
CLRL R9 ;Make sure function is clear
CVTBL #-1,STTFLG ;Say SED is initializing
MOVAB TYPBUF,R5 ;Set up the type buffer pointer
MOVL SP,STACK ;Save the stack pointer for later use
JSB INITTY ;Make the editor receive what's really typed
JSB CHECK_TERM_LOGICAL ;See if user has defined the terminal
; type by logical name
MOVL #XBFNUM-1,XCTACW ;Make last (null) execute buffer active
MOVAB XCTFRE,XCFPTR ;Save pointer to start of free space
ADDL3 #XCFSIZ-1,XCFPTR,XCTOVF ; and end of f.s. for overflow checking
MOVL #1,XCTSNM ;Set up nominal for execute counter
MOVL #1,XCTITR ;Set up number of times to iterate an execute
CVTBL #-1,ISVNUM
CVTBL #-1,SAVNUM
CVTBL #-1,SLDFLG
MOVB #-1,BAKFLG
CVTBL #-1,GOPRCT
MOVB #-1,MSGFLG ;Set /MESSAGE
MOVB #-1,INSTBS ;Set /INSTBS
MOVB #-1,KEYPAD ;Indicate no KEYPAD switch has been seen
CLRL F ;Clear flags
CLRL F1 ;and second flag word
CLRB UPPFLG ;Upper case flag is initially off
CLRL PREDP ;Say there's no pre-set display pointer
CLRL PIKOPN ;Clear the pick file open flag
CLRL CLSOPN ;Clear the close file open flag
BISL #M_NLC,F ;Searches are case independent
CLRL SL ;Clear slide offset
MOVAB BUFFEN,EN ;Set up end of buffer pointer
BISL #M_RST!M_NCR,F ;Reset nominals, don't insert CR in insert mode
MOVL #1,SAVEAC+36 ;set set-file's r-w flag positive (ie none)
JSB TABINI ;Preset tabs for ruler
MOVL TERMNL,R10 ;Set up right type of terminal
JSB REDSWH ;Go read SED.INI, if available
JSB REDTMP ;Read SED.TMP if any
JSB RSCANL ;If user entered with filespecs, set them up
;The error routine jumps to INIERR when there is an error in the command
;line (like a bad switch). It goes to REDNO (below) when the user has erred
;while editing the cheery message
INIERR::JSB @RTE(R10) ;Call user's entry routine
BISL TCH(R10),F1 ;Set terminal-specific flags
TSTL RUP(R10) ;Can terminal roll up?
BNEQ 10$ ;Yes
BISL #M_NRC,F ;No - don't automatically roll from last line
10$: CLRL JRNBIT ;Make sure journal flag is clear
TSTL JRNFLG ;Want to restore a journal?
BEQL JRSTNO ;No - skip this
BISL #M_JRC,F1 ;Yes - say journal restore is happening
TSTB XSHFLG ;Want to display the execute?
BNEQ 20$
BISL #M_XCT,F1 ;No - just display when done
BRB 30$
20$: BISL #M_XBN,F1 ;Yes - set up show it all
30$: CLRB XSHFLG ;Clear execute display flag
BBCC #V_JRW,F1,40$ ;Don't journal while recovering - want to?
CVTBL #-1,JRNBIT ;Yes - remember for later
40$: JSB JRNGET ;Set up and read the journal
JRSTNO: JSB INITT1 ;Do TTY init stuff which comes after entry rtn
MOVL LPP(R10),R1 ;Set lines per roll
MOVL R1,LPP.0 ;Save in case of change
JSB SETLPP ;Set up lines per page
MOVL CPL(R10),R1 ;Set up characters per line variables
MOVL R1,CPL.0 ;Save in case of change
DECL R1
MOVL R1,CPL.1
TSTL RMARGN ;Has user set the right margin?
BNEQ 10$ ;Yes
MOVL R1,RMARGN ;No - set it at the right of the screen
10$: MOVL F1,SAVFLG ;Save terminal flags
CVTWL STTFLG+2,R3 ;Has the terminal length changed?
BLEQ 20$ ;No
JSB SWHLPP ;Yes - set it in the right table
20$: CVTWL STTFLG,R3 ;Has the terminal width changed?
BLEQ 30$ ;No
JSB SWHWID ;Yes - set it in the right table
30$: CLRL STTFLG ;Say no longer initializing
JSB CMDSET ;Set up changes to command table, if any
JSB SETXCB ;Likewise execute buttons, if any, in new table
BSBW RSTNOM ;Set up default parameters
TSTB RSCANF ;Got a file from rescan?
BEQL 40$ ;No
JMP SETSCN ;Yes - set it up and go to LOOP1
40$: TSTL FILSPC ;Got a file from nnnSED.TMP?
BEQL REDNO ;No - start out with cheery message
INDIRE::MOVL R10,-(SP) ;Yes - disable error messages
CLRL R10
JSB PARSEF ;Parse the filespecs
MOVL (SP)+,R10
MOVL #$SETFI+^X80000000,R9
JMP SETFL1 ;and go set up that file
REDNO:: JSB PNTSTT ;Else display cheery message
TSTB MSGFLG ;Want cheery message?
BNEQ NEWFIL ;Yes - (message is in the buffer)
MOVAB NFTEDT,R1 ;No - say why
JSB ERRDSP
JMP ABORT1 ;and just abort
NFTEDT: .ASCIZ /##########No file to edit/
NEWFIL::BICL #M_ENT!M_CHG,F ;File unchanged, enter off
NEWFL1::BISL #M_XPB,F ;Last-line pointer is invalid
MOVQ ISVNUM,ISVCNT ;Set up # of commands between ISAVEs
;and # of typein chars between SAVEs
MOVL #SQZVAL,SQZCNT ;Set up # of commands to skip between squeezes
TSTL GOPRCT ;Yes - want to start some percent in?
BLSS NEWFL0 ;No
MOVL GOPRCT,GOPERC ;Yes - set up the right percent
CVTBL #-1,GOPRCT ;Forget that it was given
CLRL R9
JMP PERNPM ;and let the percentage command do the display
NEWFL0::TSTB DSPFLG ;Want to omit starting display?
BNEQ 10$ ;Yes
JSB DISPLL ;No - display a screenful
10$: CLRB DSPFLG ;Clear omit-display flag
JSB POSCUR ;Position the cursor
.SUBTITLE Fetch and Dispatch Commands
;Now accept characters and do things
;All commands eventually loop back to loop
LOOP:: TSTL CLAFLG ;Remembering a delete-lines?
BEQL 5$ ;No
BSBW DLLCHK ;Yes - see if it's time to forget
5$: TSTL SAVCNT ;Time to do an incremental save?
BEQL 10$ ;Yes
TSTL ISVCNT
BNEQ 20$ ;No
10$: JSB INCSAV ;Yes - do it
20$: CLRL R9 ;Say no command is being handled
BBC #V_RST,F,30$ ;Restore nominals?
BSBW RSTNOM ;Yes - do so
30$: BITL #M_CWT,F ;Anything special?
BEQL 40$ ;Yes
35$: BRW LOPSPC
40$: BITL #M_XCT!M_XBN,F1
BNEQ 35$ ;Yes - do it specially (maybe go to LOOP0)
$QIOW_S FUNC=#IO$_TTYREADALL!IO$M_NOECHO,- ;Read a physical block
CHAN=TTCHAN,- ;from the terminal channel
P1=TTYBUF,- ;into the terminal buffer
P2=#1,- ;reading 1 byte
IOSB=TTY_STATUS_BLOCK ;with status in the terminal status block
MOVZBL TTYBUF,R1 ;Get the character
;Need to have an error check here...
LOOP1: BBC #V_CCH,F,LOOPC2 ;Canceled enter-control-char flag - on?
BRW LOOPCC
LOOPC2: CMPB R1,#^A/ / ;Some control character?
BLSS LOOPC3 ;Yes
BRW ALPNUM ;No - just put in the file or buffer
LOOPC3::MOVAB COMAND,R6 ;Yes - point to the command buffer
CLRQ COMAND ;and clear the buffer
MOVB R1,(R6)+ ;Save the start of command
BICL #M_ERF!M_CCH,F ;Clear consecutive error flag
MULL #4,R1 ;Convert offset from bytes to words
ADDL2 ITB(R10),R1 ;Get offset in terminal table
MOVL (R1),R1 ;Is it a normal command?
BGEQ LOOP2 ;Yes
BSBW SUBTAB ;No - read more characters
BLBS R0,LOOP2 ;Legal - continue
BRW ILCERR ;Illegal command - error
LOOP2:: BBC #15,R1,10$ ;Is this command really an execute buffer?
BRW ILCERT ;Yes - set buffer up
10$: BBC #V_XSV,F1,20$ ;Save command in execute buffer?
CMPB R1,#^A" " ;Got a high-numbered command?
BGEQ 15$
TSTB R1 ; or reset (==0)?
BNEQ 16$
15$: MOVB #^A"^",@XCTPTW ;Yes - save up-arrow as flag
INCL XCTPTW
16$: MOVB R1,@XCTPTW ;Save command
INCL XCTPTW
CMPL XCTPTW,XCTOVF ;See if buffer will overflow
BNEQ 20$ ;No overflow - continue
JMP XCTERR ;Else give error message
20$: BBS #V_ENT,F,30$ ;Entering a parameter?
MOVL CMDTB2[R1],R2 ;No - get proper dispatch address
BRB 40$
30$: MOVL CMDTB1[R1],R2 ;Yes - get proper dispatch address
40$: MOVL R1,R9 ;Save the command that was typed
BBC #V_JRW,F1,50$ ;Saving a journal?
JSB JRNSVC ;Yes - save the command
50$: TSTL R2 ;Is there an address?
BNEQ 60$
BRW ILCER1 ;No - error
60$: JMP (R2) ;Yes - go to it and do it
LOOPCC: CMPB R1,#^O33 ;CCH is on - was an escape typed?
BEQL 10$
BRW LOOPC2 ;No - continue
10$: MOVZBL #^A"[",R1 ;Yes - handle it like ECC "["
BRW ALPNUM
;Subroutine to see if close buffer should be appended to or not if the next
;command is delete-lines. This allows "consecutive" delete-lines to act as
;if they were all typed as one big delete (to help recovering).
DLLCHK: BITL #M_ENT!M_PCM,F ;Entering a parameter or got a mark?
BNEQ 10$ ;Yes
CMPL R9,#$DELLN ;No - got a delete-lines command?
BEQL 10$ ;Yes
CMPL R9,#$RESET ;Got a reset command?
BEQL 10$ ;Yes
CLRL CLAFLG ;No - clear consecutive-delete flag
10$: RSB ;Done
;Here if command sequence is not found in terminal input table
;Scan the execute buffers to see if it is one of them
ILCERR: MOVL #1,R3 ;Convert lower case to upper in command string
MOVAB COMAND+1,R2 ;Point to the command buffer
ILCCAP: MOVZBL (R2)+,R1 ;Get the next character
BEQL ILCCP2 ;Done if null
CMPB R1,#^A"a" ;Lower case?
BLSS ILCCP1 ;No - loop
CMPB R1,#^A"z" ;Is it really lower?
BGTR ILCCP2 ;No
SUBL #^O40,R1 ;Yes - convert to upper
MOVB R1,-1(R2) ;Store the corrected character
ILCCP1: ACBB #8,#1,R3,ILCCAP ;Loop thru the command characters
DECL R3 ;Adjust character count if fall through
ILCCP2: MOVL R3,SAVEAC ;Save the number of characters found
MOVL #XBFNUM-1,R4
ILCXLP: MOVAQ XCTKEY[R4],R3 ;Point to a buffer name
CMPC SAVEAC,COMAND,(R3) ;Is this what the user typed?
TSTL R0
BEQL 10$ ;Yes
SOBGEQ R4,ILCXLP ;No - loop
BRW ILCER1 ;No match - command is illegal
10$: MOVAQ XCTKEY[R4],R3 ;Point to the key sequence
CMPL COMAND,(R3) ;Got the entire command sequence?
BNEQ 20$
CMPL COMAND+4,4(R3)
BEQL ILCE00 ;Yes - execute the buffer
20$: $QIOW_S FUNC=#IO$_TTYREADALL!IO$M_NOECHO,-
CHAN=TTCHAN,- ;No - read a character from the terminal
P1=TTYBUF,-
P2=#1,-
IOSB=TTY_STATUS_BLOCK
MOVZBL TTYBUF,R1 ;Get the character
CMPB R1,#^A"a" ;Lower case?
BLSS 30$ ;No
CMPB R1,#^A"z" ;Is it really lower?
BGTR 30$
SUBB #^O40,R1 ;Yes - convert it to upper
30$: MOVB R1,(R6)+ ;Save the character in COMAND
INCL SAVEAC ;Increment the number of characters
BRW ILCXLP ;Go find a longer sequence
;Here if the command is an execute buffer - go do it
ILCE00: MOVL R4,R1 ;Get execute index
ILCER0::BICL #^C^O77,R1 ;Keep only good index bits
MOVL XCTADR[R1],R2 ;Get pointer to this buffer
MOVL R2,XCTPTR ;Save as active pointer
MOVL R1,R9 ;Save execute index for journaling
MOVZBL (R2)+,R1 ;Get first character from buffer
CMPB R1,#^A"^" ;Special character flag?
BNEQ 10$
MOVZBL (R2)+,R1 ;Get command from execute buffer
CMPB R1,#^O37 ;Is it a real command?
BLEQ ILCE0A ;No (an execute construct) - handle normally
CMPB R1,#^O77 ;Got a reset command?
BNEQ 10$ ;No
CLRL R1 ;Yes - get the real code
10$: MOVZBL (R2)+,R0 ;Get the next command
BNEQ ILCE0A
BRW LOOP2 ;If there's only one command, go use it
ILCE0A: BBC #V_JRW,F1,10$ ;Writing a journal?
JSB JRNSVX ;Yes - save the execute index
10$: MOVL #1,XCTNUM ;Do one iteration of buffer
PUSHR #^M<R1,R2,R3,R4,R5>
MOVC3 #SAVPML,PARAMS,SAVPRM ;Save all parameters
POPR #^M<R1,R2,R3,R4,R5>
MOVL F,SAVFGS ;Save flag longword 1
MOVL F1,SAVFGS+4 ; and longword 2
BICL #M_XCT!M_JRC,F1 ;Clear journal-restore flags
BISL #M_XBN,F1 ;Set to execute and display
BBC #V_ENT,F,20$ ;Got a parameter?
JSB ERSPM0 ;Yes - clean up screen; don't clear flag
JSB PUTTYP ;Output everything now
20$: BRW LOOP ;Go take commands from buffer
;Here if command really is illegal = give error
ILCER1: BBC #V_ENT,F,ILCER2 ;Is there a parameter to clean up?
CLRB @PARPTR ;Yes, save a null at the end of the paramete
INCL PARPTR
JSB ERSPM2 ;Restore the saved position
ILCER2::MOVAB ILCMSG,R1 ;Point to the error message
JMP ERROR ;and go output it
ILCMSG: .ASCIZ /#########Illegal command/
ILCERT: BBC #14,R1,10$ ;Got enough type-in?
BRW ILCERR ;No - get more
10$: BRW ILCER0 ;Yes - go execute buffer
;Here for special handling: restore nominals, read from execute buffer,
;or get typed-ahead (or journaled) character
LOPSPC: BITL #M_XCT!M_XBN,F1 ;Execute buffer or journal restore?
BEQL 10$ ;No
JMP XCTGET ;Yes - take commands from an execute buffer
10$: BICL #M_CWT,F ;No - say no character is waiting
MOVZBL TYPCHR,R1 ;Pick up typed character
BRW LOOP1 ;and use it as current terminal input
;Subroutine to restore nominals, if RST flag is set
RSTNOM::CLRL GOPERC ;Reset %GOTO
CLRL ADDLSP ;and lines to do rectangular open/close on
CLRL PICKSP ;and spaces to pick
CLRL CASLNS ;and lines to case
MOVL #1,SUBCNT ;and substitutes to do
MOVL #1,ADDLNS ;and lines to add or delete
MOVL #1,ADDSPC ;and spaces to add or delete
MOVL #1,PICKLN ;and number of lines to pick
MOVL #1,ROLPGS ;and pages to roll
MOVL #1,CASSPS ;and spaces to change the case of
MOVL #1,JUSLNS ;Justify one line
MOVL LINROL,ROLLIN ;Set default lines to roll
MOVL SLIDNM,SLIDES ;Set user's default slide size
BNEQU 10$ ;Did he have one?
MOVL #8,SLIDES ;No - set it to 8
10$: RSB ;Then return
;Subroutine to reference a terminal's subtables
;Return success if sequence found, else return error
SUBTAB::MOVL R1,TEMP ;Set up address of subtable
SUBTB1: $QIOW_S FUNC=#IO$_TTYREADALL!IO$M_NOECHO,-
CHAN=TTCHAN,- ;from the terminal channel
P1=TTYBUF,- ;into the terminal buffer
P2=#1,- ;reading 1 byte
IOSB=TTY_STATUS_BLOCK ;with status in the terminal status block
MOVZBL TTYBUF,R1 ;Get the character
;Need to have an error check here...
BBS #9,R9,10$ ;In the help processor? Yes, don't save char
MOVB R1,(R6)+ ;Save the character
10$: CVTWL TEMP,R4 ;Compute address of subtable
ADDL R10,R4
CVTWL TEMP+2,R3 ;Get the length of the subtable
SUBTB2: TSTL (R4) ;End of the subtable?
BNEQ 10$ ;No
5$: CLRL R0 ;Yes - indicate illegal command
RSB ;and return
10$: CVTWL (R4),R2 ;Get character from subtable
BEQL SUBTB3 ;Match any character? Yes
CMPB R1,R2 ;Do user's and table's chars match?
BEQL 20$ ;Yes
ADDL #4,R4 ;Increment to next entry
ADDL #4,R3 ;Also increment the count
BLSS SUBTB2 ;Not at end yet
20$: TSTL R3 ;Error if end of table and not found
BGEQ 5$
SUBTB3: CVTWL 2(R4),R2 ;Get the command
CMPL #^O137,R2 ;Found it - want another level?
BLEQU SUBTBS ;Yes - set it up
SUBTB4: MOVL R2,R1 ;Set up real command
MOVZBL #1,R0 ;Indicate success return
RSB
SUBTBS: BBS #15,R2,SUBTB4 ;Got an execute command? Yes
MOVW 2(R4),TEMP ;Point to the new subtable
MOVW #-160,TEMP+2 ;Indicate the maximum length
BRW SUBTB1 ;Go read another character from terminal
.SUBTITLE Put Characters in the Buffer
;*************************************************************************
;Here if a non-control character was typed - put it in file or
;parameter buffer, and adjust cursor position one to the right
ALPNUM::CMPB R1,#^O173 ;Got a high character?
BLSS ALPNU0 ;No
BRW ALPHGH ;Yes - maybe it's a command
ALPNU0: BBC #V_JRW,F1,5$ ;Writing a journal?
JSB JRNSVA ;Yes - save the character
5$: CVTBL #-1,R9 ;Note that a command is active
TSTB UPPFLG ;Want upper case alphabetics?
BEQL 10$ ;No
CMPL R1,#^A"a" ;Yes - is character lower case?
BLEQ 10$ ;No
CMPL R1,#^A"z"
BGTR 10$ ;No - O.K.
SUBL #^O40,R1 ;Yes - convert to upper
10$: BBC #V_XSV,F1,20$ ;Save command in execute buffer?
MOVB R1,@XCTPTW ;Yes - do so
INCL XCTPTW
CMPB R1,#^A"^" ;Is character a real up-arrow?
BNEQ 15$ ;No
MOVB R1,@XCTPTW ;Yes - save two of them
INCL XCTPTW
15$: CMPL XCTPTW,XCTOVF ;See if buffer will overflow
BNEQ 20$ ;No overflow - continue
JMP XCTERR ;Otherwise give error message
20$: BBCC #V_CCH,F,ALPNU1 ;Want a control character?
BICB #^C^O37,R1 ;Yes - make it one
ALPNU1::BBC #V_ENT,F,40$ ;Entering a parameter?
BRW ALPENT ;Yes - handle separately
40$: BBC #V_RDO,F,50$ ;No - is file read-only?
JMP ALPERR ;Yes - command is illegal
50$: DECL SAVCNT ;De-bump typein save counter
BISL #M_CHG!M_INS,F ;Let line be extended if necessary
JSB MAKCPT ;Re-make cursor position
BICL #M_INS!M_PCM,F
CMPB R3,#^X0D ;At end of line?
BEQL 60$ ;Yes
BBC #V_IMD,F,60$ ;No - in insert mode?
BRW ALPIMD ;Insert mode, not at EOL - handle separately
;Here to put character in file (non-insert-mode)
60$: CLRL R4 ;Clear (maybe) pointer to first null
ALPNM2: MOVZBL @CHRPTR,R2 ;Get character that will be overwritten
INCL CHRPTR
TSTL R2 ;If null, save pointer
BNEQ 10$
BRW ALPNUL
10$: CMPL R2,#9 ;Tab?
BNEQ 20$
BRW ALPTAB ;Yes - need to break the tab apart
20$: CMPL R2,#^O15 ;Carriage return?
BNEQ ALPNM3
BSBW ALPEXT ;Yes - may need to extend line
ALPNM3: MOVL CHRPTR,R2 ;Get character pointer
MOVB R1,-1(R2) ;Save character in buffer
CMPL EN,CHRPTR ;At the end of the file?
BNEQ ALPDIS ;No
INCL EN ;Yes - increase file size by one character
;Here to display character, from replace mode or parameter
ALPDIS: MOVB R1,CHARAC ;Save user's character
BBS #V_XCT,F1,ALPDS1 ;Executing? Yes - position, but no echo
CMPL R7,LPP.1 ;At last line?
BNEQ 20$ ;No
BBCC #V_FNC,F,20$ ;Yes - is fence up?
MOVL R1,-(SP) ;Yes - save character typed
JSB CBOTOM ;Take fence down
JSB POSCUR ;Re-position cursor
MOVL (SP)+,R1 ;Get the character back
20$: CMPB R1,#^A" " ;Got a control character?
BGEQ 30$ ;No
BRW ALPCCH ;Yes - display specially
30$: MOVB R1,ECHBUF ;Echo the character
$QIOW_S CHAN=TTCHAN,-
FUNC=#IO$_WRITEVBLK!IO$M_NOFORMAT,-
P1=ECHBUF,-
P2=#1
ALPDS1: CMPL R8,RMARGN ;Beyond the right margin?
BGEQ 10$ ;Yes
BRW ALPPOS
10$: CLRL SAVEAC+8 ;Clear count of characters backed over
MOVL CHRPTR,R6 ;Get current character pointer
MOVZBL -(R6),R1 ;Get current character
CMPL R1,#^A" " ;Is it a space?
BEQL ALPDS2
CMPB R1,#9 ;or a tab?
BEQL ALPDS2 ;Yes - put new line here
MOVL #1,R2 ;No - set not-space flag
20$: BSBW ALPBAK ;Else back up over the last word
TSTL R2
BGTR 20$
BEQL 40$
30$: BRW ALPNSP ;If no spaces in line just wrap last char
40$: MOVL R6,R3 ;Save pointer to start of word
50$: BSBW ALPBKS ;See what's before the spaces
TSTL R2
BEQL 50$
BLSS 30$ ;If line starts with spaces wrap last char
MOVL R3,R6 ;Else get back pointer to start of word
INCL R6
MOVL R6,CHRPTR ;Save pointer to start of last word
ALPDS2: MOVL #2,NUMCHR ;Set to insert two characters:
; a return and a linefeed
MOVB #^O12,CHARAC
JSB MAKCHR ;Insert two linefeeds
MOVL CHRPTR,R6 ;Restore the character pointer
MOVB #^O15,(R6)+ ;and change one of them to a return
INCL R6 ;Jump over the linefeed, for redisplay
MOVL LMARGN,R1 ;Get the left margin offset
BEQL ALPDS3 ;Any ? No - skip this
MOVL R1,NUMCHR ;Yes - add that many spaces
MOVL R6,CHRPTR ; at the start of the new line
JSB MAKSPC
ALPDS3: MOVL SAVEAC+8,R1 ;Was anything moved?
BEQL ALPDS4 ;No - don't erase
SUBL R1,R8 ;Erase the last word - position to it
JSB POSCUR
JSB CLRLNR ;and erase to the end of the line
ALPDS4: INCL R7 ;Position to the start of the next line
MOVL R7,R4
CMPL R7,LPP.1 ;Moved to the last line?
BNEQ 5$ ;No
BICL #M_FNC,F ;Yes - fence will be cleared, if it's there
5$: ADDL3 SAVEAC+8,LMARGN,R8 ;and set cursor pos'n to the end of the line
; (adding in the margin offset)
BISL #M_XPC!M_XPB,F ;Character and bottom pointers are bad
MOVL R6,LINPTR ;Save pointer to the start of the new line
CMPL R7,LPP(R10) ;About to move off the screen?
BLSS 10$
JMP RETROL ;Yes - do a roll
10$: JSB POSLIN ;Else position to the start of the new line
MOVL #1,R4 ;Set to insert one line
MOVL ILN(R10),R1 ;Can terminal do an insert-lines?
BNEQ 20$ ;Yes
JMP DISDWN ;No - re-draw the screen from there down
20$: PUSHR #^M<R8> ;Yes - fudget the column position to zero
CLRL R8
JSB PUTSEQ ;Insert the line
POPR #^M<R8> ;Get the column position back again
JSB DISPLY ;Display the new line
JSB FIXBLW ;Put back fence and insert mode messages
JMP DISCUR ;Position to the end and loop (whew)
ALPNSP: CLRL SAVEAC+8 ;If no spaces in line just wrap last char
MOVL CHRPTR,R6
BRW ALPDS2
;Subroutine to read the character previous to R6.
;Returns character in R1; R2/0 if character is space, tab, -1 if LF
;Also keeps a count of characters backed over in SAVEAC+8
ALPBKS: MOVL #1,R2 ;Set found-a-character flag
ALPBAK: MOVZBL -(R6),R1 ;Get the previous character
BEQL ALPBAK ;Skip it, if null
CMPB R1,#^A" " ;Is it a space?
BEQL 10$ ;Yes
CMPB R1,#9 ;or a tab?
BEQL 10$ ;Yes
CMPB R1,#^O12 ;How about a linefeed?
BNEQ 20$ ;Nope
CVTBL #-1,R2 ;Yes - mark it specially
BRB 20$
10$: CLRL R2 ;Flag it as a spacer
20$: TSTL R2 ;Got a real character?
BLEQ 30$ ;No
INCL SAVEAC+8 ;Yes - count up one more character skipped
30$: RSB ;Done
;Here to see if a high character is really a command
ALPHGH: BBC #V_HTB,F1,ALPHGR ;Got a high table to use? No - check for rubout
MOVZBL R1,R2 ;Save character
ADDL ITB(R10),R1 ;Get table entry
SUBL #^O200,R1
MOVL (R1),R1 ;Is there one?
BLSS 20$ ;No
BRW LOOPC3 ;Yes - handle as a command
20$: MOVL R2,R1 ;No - get character back
BRW ALPNU0 ;and go put it in file
ALPHGR: CMPB #^O177,R1 ;Got a rubout?
BEQL 10$ ;Yes
BRW ALPNU0 ;No - treat like a character
10$: MOVL ITB(R10),R1 ;Yes - get its command
MOVL -4(R1),R1
BRW LOOP2 ;and process it
;Here to output a protected control character
ALPCCH: ADDB3 #^O100,R1,R2 ;Get character as a real character
CMPB R1,#^O11 ;Got a tab?
BEQL ALPDTB ;Yes - handle specially
MOVL R1,-(SP) ;Save knocked character
JSB PROTON ;Output the character protected
MOVB R2,(R5)+
JSB PROTOF
JSB PUTTYP ;Output it now
MOVL (SP)+,R1 ;Get control char back again
JMP RIGHT1
ALPDT1: MOVZBL #$CURHM,R9 ;Cause positioning to occur
ALPDTB: DECL CHRPTR ;Move pointer behind the latest character
JSB DISLIN ;Rewrite remainder of line
INCL CHRPTR ;Make character position right
MOVZBL CHARAC,R1 ;Get latest-typed character
ALPPOS: CMPB #^O11,R1 ;Tab?
BEQL 10$ ;Yes
JMP RIGHT1 ;No - move to the right and loop
10$: BICL #7,R8 ;Point to character after tab
ADDL #8,R8
JMP DISCUR ;Re-position and loop
;Here if null found where character pointer points
ALPNUL: TSTL R4 ;If not the first null, don't save pointer
BNEQ 10$
MOVL CHRPTR,R4 ;Else save pointer to first null
10$: CMPL EN,CHRPTR ;At end of file?
BEQL 20$ ;Yes
BRW ALPNM2 ;No - loop
20$: MOVL CHRPTR,R4 ;Point back to first null
BNEQ 30$ ;Error if no null found (shouldn't happen)
MOVAB ALPERM,R1
JMP ERROR
30$: BRW ALPNM3 ;Save character there
ALPERM: .ASCIZ /########BUG - No null found/
;Here if character to overwrite is a tab - precede it with spaces and char
;If character is going into the 7th position of the tab, take the tab out
ALPTAB: MOVL R1,-(SP) ;Save character user typed
DECL CHRPTR ;Back pointer up before the tab
ALPTB0: INCL TABSPC ;Increment spaces (+ char) to add before tab
MOVL TABSPC,NUMCHR ;Add that many spaces to the file
JSB MAKSPC ;Note: R4 has ptr to last thing added
;CHRPTR points to start of added spaces
;MAKPTR " one beyond last space added
;R4 " the tab
CLRB (R4) ;Null out the former tab
MOVL (SP)+,R1 ;Get user's character back again
SUBL3 #1,MAKPTR,R4
MOVB R1,(R4)+ ;Save character over the last thing typed
MOVL R4,CHRPTR ;Save as current position
SUBL3 TABSPC,TABSIZ,R2 ;See if an entire tab has been used up
CLRL TABSPC ;No longer any spaces to left of tab
MOVL R2,TABSIZ
BGTR 10$ ;Is tab now expressed entirely in characters?
CLRL R2 ;Yes - null out the tab
BRB 20$
10$: MOVZBL #9,R2 ;No - move tab over
20$: MOVB R2,(R4)+
BRW ALPDIS ;Done - go display
ALPTBI: MOVL R1,-(SP) ;Save character user typed
BRB ALPTB0 ;Jump into the break-up-tab routine
;Subroutine for if going to overwrite a <CR>. If it's <CRLF> extend line
;However, if a null was passed over, save character there; leave <CR> alone
ALPEXT: TSTL R4 ;If found a null, save character there
BNEQ ALPEX1
MOVL CHRPTR,R3
MOVZBL (R3)+,R2
CMPL R2,#^O12 ;Is it a linefeed?
BNEQ 20$
MOVL R1,-(SP) ;Yes - save the character user typed
DECL CHRPTR ;Move pointer behind the <CR>
MOVL #24,NUMCHR ;Go add 24 nulls to the file
JSB MAKNUL ;Put in those nulls
MOVL (SP)+,R1 ;Get character back
INCL CHRPTR ;Point back to real character position
20$: RSB ;and go put it into the buffer
ALPEX1: MOVL R4,CHRPTR ;Go save character over that null
RSB
;Here if editor is in insert mode - add character at cursor; don't replace
ALPIMD::CMPL R8,CPL.1 ;At 80th column?
BGEQ ALPIBP ;Yes - insert not allowed
MOVL CHRPTR,R6 ;Get character position
MOVB R1,CHARAC ;Save user's character
MOVZBL (R6),R2 ;Get character at pointer
BNEQ 20$ ;If null,
BRW ALPIM4 ; save new char there
20$: CMPB R2,#9 ;Is it a tab?
BNEQ 25$ ;No
BRW ALPTBI ;Yes - break the tab apart
25$: MOVZBL -(R6),R2 ;Else get character before pointer
BNEQ 30$ ;If null,
BRW ALPIM5 ;save new char there
;Else need to insert some space:
30$: MOVL #1,NUMCHR ;Tell MAKCHR to insert one character
JSB MAKCHR ;Insert that character
INCL CHRPTR ;Point to character after this one
ALPIM1: CMPB CHARAC,#9 ;Is latest-typed character a tab?
BNEQ 10$ ;No
BRW ALPDTB ;Yes - rewrite the rest of the line
10$: MOVL #1,R4 ;Set to open line one character
MOVL ISP(R10),R3 ;Can terminal open spaces on its own?
BEQL 20$ ;No
JSB OPNSPI ;Yes - open up the line
BLBC R0,30$
20$: BRW ALPDT1 ;No - rewrite the line cursor is on
30$: JSB POSCUR ;Get back to start of newly-opened space
MOVZBL CHARAC,R1 ;Get latest-typed character
CMPL R1,#^A" " ;Got a control character?
BGEQ 40$
BRW ALPCCH ;Yes - display specially
40$: MOVB R1,(R5)+ ;Display it
INCL R8
JMP DISCUR ;Re-display the cursor; done
ALPIBP: MOVB #7,ECHBUF ;If at 80th column just beep
$QIOW_S CHAN=TTCHAN,-
FUNC=#IO$_WRITEVBLK!IO$M_NOFORMAT,-
P1=ECHBUF,-
P2=#1
BRW LOOP
;Here if null found at (ALPIM4) or before (ALPIM5) cursor position
;Save new character there; no insert necessary
ALPIM4: INCL CHRPTR ;Skip over this new character
ALPIM5: MOVB CHARAC,(R6) ;Save new character just before pointer
BRB ALPIM1 ;Go display what happened
;Here for a character typed as part of a parameter
ALPENT: BBCC #V_CMV,F,10$ ;Doing cursor movement?
JMP CMXERR ;Yes - can't mix cursor and otherwise
10$: CMPL PARPTR,#PARBUF+PARBLN ;Is buffer about to overflow?
BGEQ ALPIBP ;Yes - beep and don't save the character
MOVB R1,@PARPTR ;Save this character in parameter buffer
INCL PARPTR
BICL #M_PST,F1 ;Clear start-of-parameter flag
BITL #M_XCT!M_XBN,F1 ;Executing?
BNEQ 20$ ;Yes - no output
CMPB R1,#^A" " ;Got a control character?
BLSS ALPENC ;Yes - output it protected
MOVB R1,ECHBUF ;Save it in the echo buffer
$QIOW_S CHAN=TTCHAN,- ;Echo the character
FUNC=#IO$_WRITEVBLK!IO$M_NOFORMAT,-
P1=ECHBUF,-
P2=#1
20$: BRW LOOP
ALPENC: MOVL R1,R4 ;Save character
JSB PROTON ;Protect character
ADDB3 #^O100,R4,(R5)+ ;Get real character back and save it
JSB PROTOF
JSB PUTTYP
BRW LOOP ;Get another command
.SUBTITLE Routines to manipulate DCL CLI symbols
;Routine to write a new CLI symbol for restart
;Pointer to the descriptor for the name is in R4
WRTSYM::BSBB DELSYM ;Delete the old symbol
SUBL3 #PIKBUF+PCBSIZ-400,R5,R1 ;Compute length of the string
MOVW R1,SYMBOL_DESC+DSC$W_LENGTH ;Save it
PUSHAL SYMBOL_DESC
PUSHL R4
CALLS #2,G^LIB$SET_SYMBOL ;Define the new symbol value
RSB ;and return
DELSYM::PUSHL R4 ;Save descriptor block address
CALLS #1,G^LIB$DELETE_SYMBOL ;Delete the old symbol
RSB
;Subroutine to read the value of a symbol
;Call with the pointer to the symbol name descriptor in R4
REDSYM::MOVW #400,SYMBOL_DESC+DSC$W_LENGTH ;Set length of buffer
PUSHAL SYM_BUFF_LEN ;Put the arguments on the stack
PUSHAL SYMBOL_DESC
PUSHL R4
CALLS #3,G^LIB$GET_SYMBOL ;Read the value of the symbol
BLBS R0,10$
RSB
10$: ADDL3 #PIKBUF+PCBSIZ-400,SYM_BUFF_LEN,R1
CLRB 1(R1) ;Make sure it ends with a null
RSB ;then return
.SUBTITLE Terminal Initialization Routines
;Subroutine to initialize the TTY for input and output
INITTY::$TRNLOG_S LOGNAM=SYSDEV,RSLLEN=TTYLEN,RSLBUF=TTYDESC
;Translate the logical name for SYS$INPUT
CMPB TTYNAM,#^X1B ;Does name begin with an escape?
BNEQ 10$ ;No
SUBL #4,TTYLEN ;Yes, drop first four characters
ADDL #4,TTYADDR
10$: $ASSIGN_S DEVNAM=TTYDESC,CHAN=TTCHAN ;Assign the channel
$GETCHN_S CHAN=TTCHAN,- ;Get the terminal characteristics
PRILEN=SETCHLEN,- ;into buffer of length 12 bytes
PRIBUF=SET_CHAR_BUFF ;located at this address
CMPB #DC$_TERM,SETCHBF+DVI$_DEVCLASS ;Is this really a terminal?
BEQL 15$
JMP TRMERR ;No - give him the message and exit
15$: MOVZBL SETCHBF+5,TERMTYPE ;Save the terminal type code
MOVQ SETCHBF+4,SAVE_TTY_BITS ;Save the old characteristics
;For now, don't disable TTSYNC, so VT100's will work either way
BICL #TT$M_HOSTSYNC!- ;Want ^S and ^Q disabled
TT$M_READSYNC!- ;...
TT$M_TTSYNC!- ;...
TT$M_WRAP!- ;and no wrap-around
TT$M_NOTYPEAHD,- ;and allowing typeahead
SETCHBF+8 ;Clear all these bits in the buffer
; BISL #TT$M_PASALL!- ;Set passall mode
; TT$M_NOECHO,- ;and no echo
; SETCHBF+8
$QIOW_S FUNC=#IO$_SETMODE,-
CHAN=TTCHAN,-
P1=SETCHBF+4 ;Set up the correct parameters
PUSHAL OLD_CTRL_MASK ;Disable ^T
PUSHAL #LIB$M_CLI_CTRLT
CALLS #2,G^LIB$DISABLE_CTRL
BLBS R0,20$
HALT
20$: BITL #LIB$M_CLI_CTRLY,OLD_CTRL_MASK ;Is ^Y disabled?
BNEQ 30$ ;No - no need to enable it
PUSHAL #LIB$M_CLI_CTRLY ;Yes - enable it
CALLS #1,G^LIB$ENABLE_CTRL
BLBS R0,30$
HALT
30$: RSB
INITT1::$SETEXV_S VECTOR=#1,- ;Enable the condition handler
ADDRES=GETAK ;for the secondary conditions
$DCLEXH_S DESBLK=EXITBLOCK ;Set up the exit handler
RSB ;Then return
;Exit handler to restore the terminal settings to their original state
RESTORE_TTY:: .WORD ^M<> ;Don't use any registers in this routine
$QIOW_S FUNC=#IO$_SETMODE,- ;Restore the terminal mode
CHAN=TTCHAN,-
P1=SAVE_TTY_BITS
BITL #LIB$M_CLI_CTRLT,OLD_CTRL_MASK ;Was ^T enabled?
BEQL 10$ ;No
PUSHAL #LIB$M_CLI_CTRLT;Yes - re-enable it
CALLS #1,G^LIB$ENABLE_CTRL
10$: BITL #LIB$M_CLI_CTRLY,OLD_CTRL_MASK ;Was ^Y enabled?
BNEQ 20$ ;Yes - don't disable it
PUSHAL #LIB$M_CLI_CTRLY
CALLS #1,G^LIB$DISABLE_CTRL
20$: RET ;Then return
;Subroutine to check for the existence of the logical name "SED_TERMINAL"
;and set up the terminal type according to the translation of that logical
;name. If the name does not exist, or does not translate to a known terminal
;type, just returns without modifying anything
CHECK_TERM_LOGICAL: ;Get the logical name translation
MOVL #^A" ",RESCAN_LINE ;Pre-clear the receiving buffer
MOVL #^A" ",RESCAN_LINE+4 ; to spaces
$TRNLOG_S LOGNAM=SEDTERM,RSLBUF=RESCAN_DESC,RSLLEN=RESCAN_LENGTH
BLBS R0,20$ ;Any logical name found?
10$: RSB ;No
20$: CMPW #8,RESCAN_LENGTH ;Is the length greater than 8?
BLSS 10$ ;Yes - it couldn't be a valid terminal type then
PUSHR #^M<R5,R6> ;Save some registers
MOVL #NAMLEN,R6 ;Get the number of entries
DIVL #4,R6
30$: MOVAQ TRMNAM[R6],R4 ;Point to the name
CMPC3 #8,RESCAN_LINE,(R4) ;Is this the one?
TSTL R0
BEQL 40$ ;Yes
SOBGEQ R6,30$ ;No - loop through the table
POPR #^M<R5,R6> ;Not found - just return
RSB
40$: MOVL NAMTAB[R6],TERMTYPE ;Save the terminal type code
POPR #^M<R5,R6>
RSB ;and return
GLOB ;Define external symbols from other modules
.END START