Google
 

Trailing-Edge - PDP-10 Archives - LCG_Integration_Tools_Clearinghouse_T20_v7_30Apr86 - 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