[net.sources] Son of TEco

eric@tekadg.UUCP (eric) (12/13/84)

Okay! here is tecoio.m11!
--------------------------------------------------------------------------------
.NLIST TTM
.TITLE	TECOIO
.SBTTL	GLOBALS, MACROS, DEFINITIONS

.PSECT	TECOIO,SHR
jmp start
.PSECT	$TIOER,SHR	;ORDER PSECTS
.PSECT	TECOIO

.GLOBL	CLSFIL,	CURFRE,	DOCCL,	EOFLAG,	GETBUF,	GETFLS
.GLOBL	GEXIT,	LISTEN,	NI,	NO,	NOCTLO
.GLOBL	P,	PDL,	PRINT,	PUTBUF,	QMAX,	QRSTOR,	QZ
.GLOBL	RWSIZE,	SCHBUF,	SCHSIZ,	SIZER,	SWITCH,	TECO,	TECOPD
.GLOBL	TECOSP,	TEXIT,	TXSTOR,	TYPE,	XITNOW
.GLOBL	ZMAX,	ZZ,	.VVV.V,	ETYPE,	EIFLAG,	EIOFF,	EDFLAG
.globl	lschsz,	yank
.GLOBL	DOCCL
.GLOBL	OFLAG
.GLOBL	CLOSIN,	DELOUT
.GLOBL	OBTOP,	ABEND

.MACRO	CALL	R
	JSR	PC,R
.ENDM	CALL

.MACRO	RETURN
	RTS	PC
.ENDM	RETURN

.macro	push	loc
	mov	loc,-(sp)
.endm

.macro	pop	loc
	mov	(sp)+,loc
.endm

.MACRO	ERROR	R50COD,TEXT
	.PSECT	$TIOER
$$$=.
	.RAD50	/R50COD/
	.ASCIZ	TEXT
	.EVEN
	.PSECT	TECOIO
	JSR	R5,ERR
	.WORD	$$$
.ENDM	ERROR

.MACRO	ERROR1	R50COD,TEXT
	.PSECT	$TIOER
$$$=.
	.RAD50	/R50COD/
	.ASCIZ	TEXT
	.EVEN
	.PSECT	TECOIO
	MOV	#$$$,R2
	MOV	(R2)+,R0
	SEC
	RETURN
.ENDM	ERROR1


; GLOBAL ERROR CODES
NI	= 54171	;RAD 50 OF NFI
NO	= 54177	;RAD 50 OF NFO

; TECO SIZE PARAMETERS
SCHSIZ	= 100	;SIZE OF SEARCH BUFFER
SIZEPD	= 200	;PUSH DOWN SIZE
NMSIZ	= 40.	;MAXIMUM SIZE OF FILENAMES

; VARIOUS ASCII CHARACTERS
BELL	= 7
BS	= 10
TAB	= 11
LF	= 12
FF	= 14
CR	= 15
ALTMOD	= 33
SPACE	= 40
RUBOUT	= 177
.sbttl	MACROS FOR UNIX INTERFACE
.MACRO	$GTTY	.CHAN,.AREA
.IIF NB,<.CHAN>	MOV	.CHAN,R0
	TRAP	32.
.WORD	.AREA
.ENDM

.MACRO	$STTY	.AREA
	TRAP	54.
.WORD	0,116.*256.+10.,.AREA
.ENDM

.MACRO	$IOCTL	.CHAN,.MODE,.AREA
TRAP	54.
.WORD	.CHAN
.BYTE	.MODE,'T+32.
.WORD	.AREA
.ENDM
GETC=18.
SETC=17.
SETO=20.
GETO=21.
RESO=19.

.MACRO	$EXIT
TRAP	1.
.ENDM

.MACRO	$SIGNAL	.SIG,.LABEL
TRAP	48.
.WORD	.SIG,.LABEL
.ENDM

.MACRO	$READ	.CHAN,.AREA,.NBYTE
.IIF NB,<.chan>	MOV	.CHAN,R0
TRAP	3.
.WORD	.AREA,.NBYTE
.ENDM

.MACRO	$WRITE	.CHAN,.AREA,.NBYTE
.IIF NB,<.chan>	MOV	.CHAN,R0
TRAP	4.
.WORD	.AREA,.NBYTE
.ENDM

.MACRO	$INDIR	.REG0,.COMND
.IIF NB,<.REG0>	MOV	.REG0,R0
TRAP	0
.WORD	.COMND
.ENDM

.MACRO	$CLOSE
TRAP	6.
.ENDM

.MACRO	$OPEN	.NAME,.MODE
TRAP	5.
.WORD	.NAME,.MODE
.ENDM

.MACRO	$CREAT	.NAME,.MODE
TRAP	8.
.WORD	.NAME,.MODE
.ENDM

.MACRO	$CHMOD	.NAME,.MODE
TRAP	15.
.WORD	.NAME,.MODE
.ENDM

.MACRO	$LINK	OLDNAM,NEWNAM
TRAP	9.
.WORD	OLDNAM,NEWNAM
.ENDM

.MACRO	$ULINK	NAME
TRAP	10.
.WORD	NAME
.ENDM

.MACRO	$GPID
TRAP	20.
.ENDM

.MACRO	$FORK
TRAP	2.
.ENDM

.MACRO	$WAIT
TRAP	7.
.ENDM

.MACRO	$EXECE	.NAM,.ARG,.ENVP
TRAP	59.
.WORD	.NAM,.ARG,.ENVP
.ENDM

.MACRO $ACCES	.name,.mode
TRAP	33.
.word	.name,.mode
.ENDM
.SBTTL	CORE ORGANIZATION

;THE CORE OBTAINED BY TECOIO AND GIVEN TO TECO IS
;	ORGANIZED AS FOLLOWS:
;
;	*********************************
;	*				*
;	*	READ/WRITE AREA		*
;	*	SIZE = RWSIZE		*
;	*				*
;	*	CLEARED BY TECOIO	*
;	*				*
;	*********************************
;	*				*
;	*	PUSH DOWN LIST		*
;	*	POINTED TO BY TECOPD	*
;	*	SIZE = SIZEPD (GLOBAL)	*
;	*				*
;	*********************************
;	*				*
;	*	SEARCH BUFFER		*
;	*	POINTED TO BY SCHBUF	*
;	*	SIZE = SCHSIZ (GLOBAL)	*
;	*				*
;	*********************************
;	*				*
;	*	TEXT STORAGE AREA	*
;	*	POINTED TO BY TXSTOR	*
;	*	SIZE IN ZMAX(RW AREA)	*
;	*				*
;	*********************************
;	*				*
;	*	Q-REGISTER STORAGE	*
;	*	POINTED TO BY QRSTOR	*
;	*	SIZE IN QMAX(RW AREA)	*
;	*				*
;	*********************************
;	*				*
;	*	FREE STORAGE		*
;	*	SIZE IN CURFRE 		*
;	*	NO POINTER		*
;	*				*
;	*********************************
;
; ALL POINTERS IN TECOIO ARE RELATIVE TO THE BEGINNING OF
;	THE IMPURE AREA, WHICH IS POINTED TO BY FREEST IN TECOIO.
; THE TEXT STORAGE AREA AND Q-REGISTER STORAGE AREAS
;	ALSO HAVE AN ASSOCIATED WORD IN THE R/W AREA TELLING HOW
;	MUCH OF THE ALLOCATED STORAGE IS IN USE.
;	THE POINTERS ARE ARRANGED AS:
;		TXSTOR, ZZ, ZMAX
;	AND	QRSTOR, QZ, QMAX
.SBTTL	SAVE, RESTORE, ERROR

.ENABL	LSB

SAVREG:	MOV	R4,-(SP)
	MOV	R3,-(SP)
	MOV	R2,-(SP)
	MOV	R1,-(SP)
	MOV	SP,SPSAVE	;SAVE FOR ERROR RETURN
	MOV	R0,-(SP)
	MOV	R5,-(SP)	;RETURN ADDRESS
	MOV	6*2(SP),R5
	CALL	@(SP)+		;EXCHANGE HIM FOR US

	CLC			;SAY NORMAL RETURN
	MOV	(SP)+,R0
2$:	MOV	(SP)+,R1
	MOV	(SP)+,R2
	MOV	(SP)+,R3
	MOV	(SP)+,R4
	MOV	(SP)+,R5
	RETURN

ERR:	SEC			;TELL TECO THINGS ARE NO GOOD
	MOV	(R5)+,R1	;POINT TO RAD50 CODE
	MOV	(R1)+,R0	;GET CODE IN R0, POINTER IN R1
	MOV	SPSAVE,SP	;RESTORE STACK
	MOV	R1,2(SP)	;POINTER IS RETURNED IN R2
	BR	2$		;AND EXIT

.DSABL	LSB
.SBTTL	LISTEN FOR TTY

LISTEN:	TST	EIFLAG(R5)	;READING FROM FILE?
	BNE	10$
	MOV	CRFLG,R0	;READING A CRLF IN RT MODE?
	BNE	3$
	CLR	R0		;READ FROM CHANNEL 0
	push	r1
	$READ	,SCRACH,1
	pop	r1
	tst	r0		;anything read?
	bne	5$
	jmp	texit		;no--exit teco!
5$:	MOVB	SCRACH,R0	;PUT CHAR IN R0
	BIC	#177600,R0
	BEQ	LISTEN		;IGNORE NULLS
	CMPB	#BS,R0		;BACKSPACE?
	BNE	1$		;NO
	RETURN			;DONT ECHO BACKSPACE ON INPUT
1$:	CMPB	#CR,R0		;NOT CR?
	BNE	4$		;THEN TYPE IT
	BIT	#4,ETYPE(R5)	;RT MODE?
	BNE	2$
	MOV	#LF,R0		;UNIX MODE--CR MAPS INTO LF
	BR	4$		;TYPE IT OUT
2$:	MOV	#LF,CRFLG	;DO LF LATER
	BR	4$		;DO CR NOW
3$:	CLR	CRFLG		;NOW DO THE LF
4$:	tst	abend(r5)		;are we echoing crap?
	bne	6$
	BIT	#10,ETYPE(R5)	;SHOULD WE EECCHHOO IT?
	BEQ	TYPE
6$:	RETURN

10$:	MOVB	@EIPNT,R0		;GET CHARACTER FROM BUFFER
	INC	EIPNT			;GOTO NEXT
	DEC	EICNT			;ONE LESS
	BEQ	11$			;NO MORE SO READ NEXT BUFFER
13$:	BIC	#177600,R0		;DELETE JUNK
	BEQ	10$			;THROW OUT NULLS
	RETURN
11$:	MOV	R0,-(SP)		;READ NEXT BUFFER
	MOV	#EIBUF,EIPNT		;RESET POINTER
	push	r1
	$READ	EIFLAG(R5),EIBUF,EIBSIZ
	pop	r1
	BCS	12$			;CLOSE FILE ON ERRORS
	MOV	R0,EICNT		;NUMBER OF BYTES ACTUALLY READ
	BEQ	12$			;CLOSE FILE ON EOF
	MOV	(SP)+,R0		;RESTORE REGISTER
	BR	13$			;AND CONTINUE
12$:	CALL	EIOFF			;TURN OFF FILE
	MOV	(SP)+,R0		;RESTORE REGISTER
	BR	13$			;AND RETURN
.SBTTL	TYPE CHARACTER

TYPE:	bit	#16.,etype(R5)	;reset control-O?
	beq	10$
	call	noctlo
	bic	#16.,etype(r5)
10$:	CALL	TYPEOU		;TYPE CHARACTER
	tst	piped		;if piped, dont dump buffer!
	bne	11$
	CALL	DUMP		;AND THEN DUMP BUFFER
11$:	RETURN

TYPEOU:	MOV	R0,-(SP)	;SAVE A REG
	BIT	#1,ETYPE(R5)	;IS ET SET FOR EXACT TYPEOUT?
	BNE	1$		;IF SO, DONT MESS WITH OUTPUT.
	CMP	R0,#RUBOUT	;SPECIAL CASE?
	BEQ	5$		;NO
	CMP	R0,#SPACE	;NEED WE EDIT IT?
	BHIS	1$
	CMP	R0,#ALTMOD	;ALTMODE?
	BEQ	20$
	CMP	R0,#TAB		;TAB?
	BEQ	1$
	CMP	R0,#CR		;RETURN?
	BEQ	6$
	CMP	R0,#LF		;LINE FEED?
	BEQ	1$
	CMP	R0,#FF		;FORM FEED?
	BEQ	3$
	CMP	R0,#BELL	;BELL?
	BNE	2$		;NO, SPECIAL ECHOS AS ^..
	CALL	TTYOUT			;BELL ECHOS AS DING ^G
2$:	MOV	#'^,R0
	CALL	TTYOUT
	MOV	@SP,R0
	ADD	#100,R0
1$:	CALL	TTYOUT
RTS0=.
	MOV	(SP)+,R0
	RETURN

; HERE FOR ALTMODE
20$:	MOV	#'$,R0
	BR	1$

; HERE FOR FORM FEED
3$:	MOV	#8.,-(SP)		;ECHO AS EIGHT LINE FEEDS
4$:	MOV	#LF,R0
	CALL	TTYOUT
	DEC	@SP
	BNE	4$
	INC	(SP)+
	BR	RTS0

5$:	MOV	#'^,R0		;ECHO RUBOUT AS "^?"
	CALL	TTYOUT
	MOV	#'?,R0
	BR	1$

6$:	BIT	#4,ETYPE(R5)	;RT11 MODE?
	BNE	1$
	BR	2$		;CONTROL CHARACTER FOR UNIX MODE
.SBTTL	PRINT STRING, TEXIT, NOCTLO, SWITCH

PRINT:	MOV	R0,-(SP)
	MOV	R3,-(SP)
	bit	#16.,etype(R5)	;reset control-O?
	beq	10$
	call	noctlo
	bic	#16.,etype(r5)
10$:	MOV	R4,-(SP)
1$:	DEC	R4		;COUNT LENGTH
	BMI	3$		;NO MORE
	tst	abend(r5)	;has <rubout> been struck?
	bne	3$		;then stop printing
	MOVB	(R3)+,R0
	CALL	TYPE
	BR	1$
3$:	tst	piped		;dont dump buffer if piped
	bne	4$
	CALL	DUMP		;DUMP BUFFER
4$:	MOV	(SP)+,R4
	MOV	(SP)+,R3
	BR	RTS0

TEXIT:				;EXIT FROM TECO
finis:	cmp	#tbuf,tbufp	;do we need to dump buffer?
	beq	1$		;no
	call	dump
1$:	CALL	DELOUT		;DELETE ANY OUTPUT FILE
	CALL	xitnow		;AFTER COOKING
	CLR	R0		;NO ERROR TO RETURN
	$EXIT

NOCTLO:	MOV	R0,-(SP)
	mov	r1,-(sp)
	$IOCTL	0,RESO,GTTY
	MOV	(SP)+,R1
	MOV	(SP)+,R0	;RESTORE THE REGISTER
	RETURN

SWITCH:	$gpid		;return process number
	RETURN

CLOSIN:	MOV	IBTOP,R0		;CLOSE THE INPUT FILE
	BEQ	1$			;ALREADY CLOSED
	push	r1
	$CLOSE
	pop	r1
	CLR	IBTOP			;MARK AS CLOSED
1$:	RETURN

DELOUT:	MOV	OBTOP,R0		;CLOSE THE OUTPUT FILE
	BEQ	1$			;ALREADY CLOSED
	CLR	OBTOP			;mark it as closed
	bic	#40,edflag(r5)		;not ebing anymore!
	push	r1
	$CLOSE				;CLOSE AND THEN DELETE IT!
	$ULINK	TEMPNM
	pop	r1
1$:	RETURN

.SBTTL	TYPEOUT PROCESSING

;THIS IS MAINLY HERE FOR TAB PROCESSING!

TTYOUT:	CMPB	#SPACE,R0	;PRINTABLE CHARACTER?
	BLE	10$
	CMPB	#CR,R0		;CR?
	beq	10$		;yes
	bit	#4,etype(r5)	;if rt mode then dont convert lf into cr
	bne	4$
	CMPB	#LF,R0		;NOT A LINE FEED?
	BNE	4$
	MOVB	#CR,R0		;LF -> CRLF (just to be sure)
	CALL	10$		;WRITE CR
	MOVB	#LF,R0		;NOW WRITE LF
4$:	BICB	#200,R0		;FAKE FOR TRICKY BACKSPACE
10$:	CMP	TBUFP,#TBUFE	;AT END?
	BNE	11$
	CALL	DUMP		;THEN DUMP BUFFER
11$:	MOVB	R0,@TBUFP	;PUT CHAR IN BUFFER
	INC	TBUFP
	RETURN

DUMP:	MOV	R0,-(SP)	;DUMP TTYOUT BUFFER
	MOV	R1,-(SP)	;SAVE this register too
	MOV	TBUFP,R1	;START OF OUTPUT
	SUB	#TBUF,R1	;LENGTH OF OUTPUT
	MOV	R1,WRITRM+4	;FILL IN NBYTE FIELD
	MOV	#TBUF,TBUFP	;RESET POINTER
	$INDIR	#1,WRITRM	;WRITE IT TO CHANNEL 1
	MOV	(SP)+,R1	;restore register
	MOV	(SP)+,R0	;RESTORE REGISTER
	RETURN			;AND RETURN

.SBTTL	SIZER GETS MORE CORE

SIZER:	MOV	R0,-(SP)	;SAVE SOME REGISTERS
	MOV	R3,-(SP)
	MOV	R4,-(SP)
	MOV	R1,R3
	ADD	#1024.,R3	;ROUND UP TO 1K INCREMENTS
	add	memtop,r3	;we want efficient allocation
	bcs	10$		;won'T fit
	BIC	#1023.,R3
	sub	#2,r3
	MOV	R3,R4		;SAVE VALUE
	sub	memtop,r4	;amount of adjustment
	MOV	R3,SPREQ+2	;GET READY
	push	r1
	$INDIR	,SPREQ		;REQUEST SPACE
	pop	r1
	BCS	10$		;NO LUCK
	MOV	R3,MEMTOP	;FILL IN TOP VALUE
	ADD	R4,CURFRE(R5)	;ADJUST TOP VALUE
	MOV	#'0-1,R0	;WE WANT TOWRITE NEW SIZE
1$:	INC	R0
	SUB	#10240.,R3
	BCC	1$		;LOOP UNTIL FINISHED
	ADD	#10240.,R3	;RESTORING DIVIDE
	MOVB	R0,TENS
	MOV	#'0-1,R0	;DO UNITS POSITION
2$:	INC	R0
	SUB	#1024.,R3
	BCC	2$
	MOVB	R0,UNITS
	MOV	#MESSAG,R3	;WRITE OUT MESSAGE
	MOV	#MESSIZ,R4
	bit	#128.,etype(R5)	;do we want to print it?
	bne	9$
	CALL	PRINT
9$:	CLC			;CLEAR CARRY
10$:	MOV	(SP)+,R4
	MOV	(SP)+,R3
	MOV	(SP)+,R0
	RETURN
.SBTTL	EI FILE OPENING

EIFILE:	TST	R2		;NAME NULL?
	BGE	1$		;NO--INSTRUCTION FILE
2$:	JMP	EIOFF		;CLOSE FILE AND RETURN
1$:	CALL	EIOFF		;CLOSE FILE BEFORE OPENING NEW
	push	r1
	$OPEN	FILSPC,0
	pop	r1
	BCC	10$		;OPS!
	jmp	einofl
10$:	MOV	R0,EIFLAG(R5)	;SAVE FILE NUMBER
	MOV	#EIBUF,EIPNT	;RESET POINTER
	push	r1
	$READ	,EIBUF,EIBSIZ	;READ FIRST BUFFER (CHECK FOR NULL FILE)
	pop	r1
	BCS	2$		;BAD PROBLEM--CLOSE FILE
	MOV	R0,EICNT	;NUMBER OF BYTES
	BEQ	2$		;EMPTY FILE--CLOSE IT
	RETURN			;FINISHED
	.sbttl	Call to Shell
;note--most of this is swiped from a UNIX TECO
.enabl	lsb
calsh:	mov	r0,r3		;save pointer
	call	xitnow
	$signal	2,1		;let shell handle this!
	tst	r2		;null arg?
	beq	15$		;then invoke real shell (?)
	add	r3,r2		;point to end
	movb	(R2),-(sp)		;save it
	clrb	(R2)			;delimit string (use -c flag in shell)
	mov	r3,msharg+4		;move location into arglist
	$fork				;better than $spoon or $knife
	br	mshell			;child process
	bcs	8$			;we failed
	$wait				;wait for child to finish
	movb	(sp)+,(r2)		;restore pointer
	br	16$

8$:	movb	(sp)+,(r2)		;restore pointer
9$:	call	sysini			;initialize terminal again
	error	UNX,<"Unix fork or shell failed">

15$:	$fork
	br	rshell			;child process
	bcs	9$			;fork failed
	$wait				;wait for child termination
16$:	bcs	9$			;errors here 
	swab	r0			;check for returned error code
	blt	9$			;one of our errors--bad news
	jmp	sysini			;initialize and return

mshell:	$signal	2,0			;die on interupts
	$signal	3,0
	mov	#msharg,exec+4		;argument list
	$indir	,exec
	mov	#-1,r0			;error!
	$exit

rshell:	mov	#rsharg,exec+4		;argument list
	$indir	,exec		;execute shell
	mov	#-1,r0			;error!
	$exit
.dsabl	lsb
.SBTTL	GETFLS - ENTRY FOR ER, EI, EW, AND EB

FNER1:	JMP	FNERR		;OUT OF BRANCH RANGE
GETFLS:	JSR	R5,SAVREG	;CAREFUL WITH THESE
	MOV	R4,R2		;MOVE LENGTH TO WHERE WE WANT IT
	cmp	r1,#-256.	;e!?
	beq	calsh		;then call shell
	MOV	#FILSPC,R3	;COPY FILE SPEC BEFORE LOCKING USR
	CMP	R2,#NMSIZ-1	;IS THE STRING TOO LONG?
	BHI	FNER1		; YES, BOOT HIM
1$:	MOVB	(R0)+,(R3)+	;MOVE A BYTE
	DEC	R2		;COUNT DOWN
	BGT	1$		; TO 0 (-1 IF ORIGINALLY 0)
	CLRB	(R3)+		;AND  END IT
	CMP	#256.,R1	;EI?
	BEQ	EIFILE
	TST	R1		;WHAT ARE WE DOING?
	BEQ	EREAD
	BPL	EWRITE

; EDIT BACKUP:
;	CLOSE ANY EXISTING OUTPUT FILE (AND FIX EB)
;	DO AN EDIT READ
;	FUDGE THE NAME, AND FALL THROUGH TO AN EDIT WRITE

	bit	#40,edflag(r5)	;dont do it if already in backup mode
	bne	eberr
	tst	r2		;must be real name
	bne	fnerr		;file name invalid
	CALL	FLUSH		;CLOSE OUTPUT FILE, IF ANY
	CALL	EREAD		;START AN INPUT FILE
	BIS	#40,EDFLAG(R5)	;Mark for backup
	BR	EWRIT1		;AND ENTER THE OUTPUT FILE
FNERR:	ERROR	IFN,<'FILE NAME "'<-2>'" INVALID'>
.SBTTL	EDIT WRITE

; EDIT WRITE:
;	IF AN OUTPUT FILE IS OPEN, CLOSE IT (AND FIX EB)
;	SCAN THE FILE NAME

EWRITE:	bit	#40,edflagi+freest	;WE CAN'T DO THIS IF EB-ING
	BNE	EBERR		;SO CLOBBER HIM
	tst	r2		;check for valid name
	blt	fnerr
	CALL	FLUSH		;YES, CLOSE IT
				;NOTE THAT FLUSH SETS R5 TO OUTBLK
EWRIT1:	MOV	#FILSPC,R0	;CREATE TEMP AND BACKUP FILE NAMES
	MOV	#TEMPNM,R1	;WE WILL  FAKE HAVING "EBSPC" IN REGISTER
EBNM	=	EBSPC-TEMPNM	;OFFSET FROM R1 VALUE
	MOV	R1,R2		;SAVE START OF NAME
10$:	MOVB	(R0),EBNM(R1)
	CMPB	#'/,(R0)	;SLASH?
	BNE	11$
	MOV	R1,R2		;SAVE LOCATION AFTER IT
	INC	R2
11$:	MOVB	(R0)+,(R1)+	;MOVE INTO TEMPNAME
	BNE	10$
9$:	DEC	R1
	MOVB	EBNM-1(R1),EBNM(R1)	;MOVE BACKUP NAME OVER 1 BYTE
	CMP	R1,R2		;UNTIL SLASH
	BNE	9$
	MOVB	#',,EBNM(R1)	;PREPEND "," AT LAST LEVEL OF NAME
	$GPID			;GENERATE TEMP FILE NAME
	MOV	R2,R1
	MOVB	#'T,(R1)+	;NAME IS TNNNN
	MOV	#4,R3
13$:	CLR	R2
	.REPT	4
	ROL	R0
	ROL	R2
	.ENDR
	ADD	#'A,R2		;A-O
	MOVB	R2,(R1)+
	SOB	R3,13$
	CLRB	(R1)		;DELIMIT THE STRING
	$CREAT	TEMPNM,600	;CREATE TEMP FILE WITH MODE RW FOR OWNER
	BCS	OUTE		;OPS!
	MOV	R0,OBTOP		;SAVE NAME
	$ACCESS	FILSPC,0	;SEE IF OUTPUT FILE EXISTS
	BCS	14$		;NO--BRANCH
	CALL	NOCTLO		;TURN OFF CTLO NONSENSE
	MOV	#SUPER,R3	;MESSAGE
	MOV	#SLEN,R4	;LENGTH OF IT
	CALL	PRINT		;PRINT IT OUT
14$:	MOV	#OUTFNM,R1	;POINT TO AREA FOR SAVED NAME
	MOV	#FILSPC,R0	;POINT TO INPUT NAME
1$:	MOVB	(R0)+,(R1)+	;GET A BYTE
	BNE	1$		;LOOP UNTIL FINISHED
	RETURN			;RETURN (WHAT A COMMENT!)
EBERR:	ERROR	EBK,<"EDIT BACKUP STILL OPEN">
OUTE:	BIC	#40,EDFLAG(R5)	;NOT EBING!
	JMP	FNERR		;OUTPUT ERROR (FOR NOW)
.SBTTL	EDIT READ, READ NEXT BLOCK

; EDIT READ:
;	FIX UP ANY EB FILES
;	LOOKUP FILE, READ A BUFFER FULL

EREAD:	MOV	#IBUF1+512.,R4	;WE WILL BE NEEDING PTR TO BUFFER TOP
	TST	R2		;IS FILE NAME NULL?
	BGE	1$		;NO, DO AN EDIT READ
;	MOV	#SSINFO,R3	;YES, DO A REOPEN
;	TST	@R3		;IS THERE A SAVED FILE?
;	BEQ	NOFSAV		;NO, ERROR
;	MOV	#INBLK,R5	;POINT TO INPUT BLOCK
;	.CLOSE	12		;GET RID OF OLD INPUT FILE
;	CALL	RELEAS		;GET RID OF OLD HANDLER
;	MOV	(R3)+,@R5	;PUT BACK DEVICE NAME
;	CALL	FETCH		;MAKE SURE HANDLER IS IN
;	MOV	R4,-(R5)	;SET TOP-OF-BUFFER
;	MOV	(R3)+,-(R5)	;SET BUFFER OFFSET
;	ADD	R4,@R5		;MAKE ABSOLUTE BUFFER POINTER
;	MOV	(R3)+,-(R5)	;RESTORE BLOCK NUMBER
;	MOV	(R3)+,-(R5)	; AND EOF FLAGS
;	.REOPEN	12,R3		;REOPEN THE FILE
;	BR	2$		;AND REPRIME BUFFERS
	RTS	PC		;IGNORE THIS FOR NOW

1$:	CALL	CLOSIN		;CLOSE INPUT FILE
	$OPEN	FILSPC,0	;OPEN SPECIFIED FILE FOR READING, ONLY
	BCS	EINOFL		;BRANCH IF FAILED
	MOV	R0,IBTOP	;SAVE FILE NUMBER
	MOV	#-1,EFFLG	;CLEAR END OF FILE FLAG
2$:	MOV	#FREEST,R0	;SET TECO'S EOF FLAG
	CLR	EOFLAG(R0)	; IN HIS AREA
;	CALL	BREAD		;GET A BLOCK IN CORE

;BUFFER READ: READS NEXT BLOCK INTO DESIGNATED AREA

BREAD:	TST	EFFLG		;ARE WE SWITCHED TO EOF BUFFER?
	BGT	1$		;YES, BOOT HIM
	push	r1
	$READ	IBTOP,IBUF1,512.	;READ A 512 BYTE BUFER LOAD
	pop	r1
	BCS	INERR		;READ FAILED FOR SOME REASON
	MOV	#IBUF1,IBPTR	;RESET BUFFER POINTER
	MOV	R0,ICCNT	;NUMBER OF CHARACTERS READ (IN ACTUALITY)
	BNE	1$		;SOME READ, ELSE EOF REACHED
	INC	EFFLG		;EOF, SOFT ERROR
1$:	RETURN
EINOFL:	ERROR	FNF,<'FILE "'<-2>'" NOT FOUND'>
INERR:	ERROR	INP,<"INPUT ERROR">
.SBTTL	CLOSE FILE, FLUSH OUTPUT BUFFER

;END FILE
;	DO ANY EB CLOSING NEEDED
;	RELEASE HANDLER FOR OUTPUT, CLEAR FLAG

CLSFIL:	TST	OBTOP		;IS AN OUTPUT FILE OPEN?
	BEQ	NOOFIL		;ERROR IF NOT
	JSR	R5,SAVREG
;	BR	FLUSH		; CLOSE FILE

;FLUSH:
;	CLOSE FILE, DO EB RENAME IF NEEDED

FLUSH:	MOV	OBTOP,R0	;FILE NUMBER
	BEQ	ERTN		;RETURN IF NO FILE OPEN
	bit	#100,EDFLAG+freest	;are we in update mode?
	beq	1$		;branch if normal
	$access	outfnm,2	;can we write to file?
	bcc	10$
	$access	outfnm,0	;we cannot, but maybe it doesn't exist
				;(we know  our directory is ok)
	bcs	1$		;no update necessary
	br	uperr
10$:	bit	#40,EDFLAG+freest	;are we doing backup?
	beq	11$
	$ulink	ebspc		;delete file of backup name
	mov	#outfnm,r2
	mov	#ebspc,r3
	call	cat		;do backing up
	bic	#40,edflag+freest	;clear indication
	mov	obtop,r0
11$:	$close			;close output file
	clr	obtop
	mov	#tempnm,r2	;move temp file into output file
	mov	#outfnm,r3
	call	cat
	$ulink	tempnm		;we dont want to keep this around
	return

1$:	bit	#40,edflag+freest	;backup?
	beq	2$
	$ulink	ebspc		;relink to do backup	
	$link	outfnm,ebspc
	$ulink	outfnm
	bic	#40,edflag+freest	;clear backup flag
	mov	obtop,r0
2$:	$close			;close output file
	clr	obtop
	$ulink	outfnm		;rename output file
	$link	tempnm,outfnm
	$ulink	tempnm
	mov	freest+oflag,chmod+4
	$indir	,chmod		;fix mode of output file
ERTN:	return
UPERR:	error	FWP,<'FILE IS WRITE PROTECTED'>
NOOFIL:	ERROR1	NFO,<"NO OUTPUT FILE">
.SBTTL	CLOSE EI FILE
EIOFF:	MOV	R0,-(SP)	;SAVE REGISTER
	MOV	EIFLAG(R5),R0	;GET FILE NUMBER
	BEQ	1$		;ALREADY CLOSED
	push	r1
	$CLOSE
	pop	r1
	CLR	EIFLAG(R5)	;MARK AS CLOSED
1$:	MOV	(SP)+,R0
	RETURN
.SBTTL	NON-IMPLEMENTED COMMANDS
GEXIT:	;NO EDIT GO
INPSAV:	;NO INPUT SAVE
OUTSAV:	;NO OUTPUT SAVE (THERE NEVER WAS!)
	ERROR	ILL,<"ILLEGAL COMMAND">
.SBTTL	GETBUF - READ A TECO BUFFER LOAD

;GETBUF:
;	READS BUFFER LOAD, AS PER TECO'S DESIRES

GETBUF:	TST	IBTOP		;IS A FILE OPEN?
	BEQ	NOIFIL		;NO, RETURN AN ERROR
	TST	EOFLAG(R5)	;ARE WE AT END-OF-FILE?
	BNE	51$		;YES, SAY SO
	TST	EFFLG		;ARE WE ABOUT TO BE AT EOF?
	BGT	50$		;YES, RETURN INDICATION
	JSR	R5,SAVREG	;SAVE EVERYTHING
	MOV	R0,R2		;HOLD ON TO DESTINATION POINTER
	CLR	6(SP)		;CLEAR RETURNED R2 FORM FEED FLAG
	TST	R1		;DID THE FOOL WANT US TO READ 0?
	BEQ	4$		;  WELL, THAT'S EASY
	MOV	R0,-(SP)	;SAVE START FOR LENGTH COMPUTE
7$:	MOV	#IBPTR,R3	;GET POINTERS
	MOV	(R3)+,R5	;R5 -> BUFFER
	MOV	@R3,R4		;R4 -> TOP
1$:	DEC	R4		;IS THE BUFFER EMPTY
	BLT	10$		;  IF SO, GO FILL IT
	MOVB	(R5)+,R0	;GET THE BYTE
	BIC	#177600,R0	;MAKE IT GOOD ASCII
	BEQ	1$		;IGNORE NULLS
	CMPB	R0,#FF		;IF FORM FEED
	BEQ	30$		;   GO SET FLAG AND EXIT
	MOVB	R0,(R2)+	;PUT BYTE, ADVANCE POINTER
	DEC	R1		;IS THERE ANY ROOM LEFT
	BEQ	3$		;IF NOT, WE OUGHT TO LEAVE NOW
	CMP	R1,#128.	;IF FEWER THAN 128 BYTES LEFT
	BHIS	1$		;  KEEP GOING
	CMP	R0,#LF		;ELSE STOP AT LINE FEED
	BNE	1$		;  IF WE GOT ONE
3$:	MOV	R4,@R3		;SAVE COUNT
	MOV	R5,-(R3)	;   AND BUFFER POINTER
8$:	SUB	(SP)+,R2	;COMPUTE NUMBER OF CHARACTERS READ
	MOV	R2,4(SP)	;RETURN IT IN R1
	BNE	4$		;NO EOF IF WE GOT STUFF
	TST	EFFLG		;NULL PAGE: IS IT THE END?
	BLE	4$		;  NO, JUST A NULL PAGE
	MOV	#FREEST,R5	;POINT TO RW AREA
50$:	COM	EOFLAG(R5)	;TURN ON EOF INDICATION
51$:	CLR	R1		;SET NO CHARACTERS
	CLR	R2		;SET NO FORM FEED
4$:	RETURN

30$:	COM	10(SP)		;SET FORM FEED FLAG (R2)
	BR	3$		;EXIT (NOTE FF IS NOT IN BUFFER)

10$:	CALL	BREAD		;GET BUFFER LOAD (NOTE R4->TOP)
;				;R4 NOW -> TOP OF OTHER BUFFER
	TST	EFFLG		;DID WE SWITCH TO EOF?
	BLE	7$		;NOPE
	BR	8$		;YEP--FINISHED
NOIFIL:	ERROR1	NFI,<"NO INPUT FILE">
.SBTTL	PUTBUF - OUTPUT A TECO BUFFER LOAD

;PUTBUF:
;	OUTPUTS A BUFFER THE WAY TECO WANTS TO

PUTBUF:	TST	OBTOP		;IS AN OUTPUT FILE OPEN?
	BEQ	NOOFIL		;ERROR IF NAE
	JSR	R5,SAVREG	;SAVE REGS
	MOV	R1,R3		;SAVE LENGTH (UNIX WANTS TO KNOW IT)
	ADD	R0,R1		;POINT TO END OF TEXT STRING
	MOV	R0,WRITEB+2	;start location
	TST	R2		;FF REQUIRED?
	BMI	1$		;GO IF YES
	MOVB	-(R1),-(SP)	;SAVE LAST CHAR IN TEXT
	MOV	R3,WRITEB+4	;LENGTH FOR UNIX
	BR	2$
1$:	MOVB	@R1,-(SP)	;SAVE CHAR AFTER LAST
	MOVB	#FF,@R1		;AND REPLACE IT WITH FF
	INC	R3		;GET LENGTH FOR UNIX
	MOV	R3,WRITEB+4
2$:	push	r1
	$INDIR	OBTOP,WRITEB	;WRITE IT OUT! (MUCH EASIER THAN RT!)
	pop	r1
	MOVB	(SP)+,@R1	;RESTORE LAST CHAR
	BCS	OUTERR		;ERROR
6$:	RETURN
OUTERR:	ERROR	OUT,<"OUTPUT ERROR">
.SBTTL	CONCATENATE
CAT:	call	closin		;unfortunately, we must close file
	mov	r2,incom+2
	mov	r3,outcom+2
	mov	oflag(r5),outcom+4
	$indir	,incom		;open input file
	mov	r0,r2
	$indir	,outcom		;open output file
	mov	r0,r3
	mov	#ibuf1,writeb+2	;use input buffer for this!
1$:	$read	r2,ibuf1,512.	;read a bufferfull
	mov	r0,writeb+4	;number of bytes
	beq	2$		;finished
	$indir	r3,writeb	;write it out
	br	1$
2$:	mov	r2,r0		;close files
	$close
	mov	r3,r0
	$close
3$:	return
.SBTTL	DATA AREA
.ENABLE LC
.PSECT	TECODT	;DATA AREA

; DATA AREA

outcom:	$creat	0,0		;for cat routine
incom:	$open	0,0

ntchars:	.byte	3,255.,255.,255.,255.,255.
ntxchars:	.byte	255.,255.
		.word	0,0
exec:	$exece	mshnam,0,0		;invoke shell

msharg:	.word	mshnam
	.word	mshflg	;"-c"
	.word	0	;filled in with argument string
	.word	0

SPREQ:	TRAP	17.		;BREAK
	.WORD	0

SPSAVE:	.WORD	0		;SP FOR ERROR RETURN
piped:	0		;are we in pipeline (input wise)
SCRACH:	.BLKW	5
OUTFNM:	.BLKB	NMSIZ		;SAVED OUTPUT FILE NAME IN ASCIZ
.EVEN

TBUF:	.BLKB	100.		;OUTPUT BUFFER
TBUFE=.-2
TBUFP:	TBUF
CRFLG:	0
WRITRM:	$WRITE	,TBUF,0

WRITEB:	$WRITE	,0,0


; INPUT

EBFLG:	.WORD	0
EFFLG:	.WORD	-1
IBPTR:	.WORD	0
ICCNT:	.WORD	0
IBTOP:	.WORD	0		;HAS FILE NUMBER NOW
IBUF1:	.BLKW	257.

; OUTPUT

chmod:	$chmod	outfnm,0

OBTOP:	.WORD	0	;NOW IS FILENUMBER
FILSPC:	.BLKB	NMSIZ
TEMPNM:	.BLKB	NMSIZ+5
EBSPC:	.BLKB	NMSIZ+1
MESSAG:	.ASCII	<LF>/[/
TENS:	.BYTE	0
UNITS:	.BYTE	0
	.ASCII	/K CORE]/
MESSIZ= .-MESSAG
.EVEN

.PSECT	BSS,BSS	;UNINITIALIZED DATA
tchars:	.blkb	8.
txchars:	.blkb	8.
savett:	.blkw	1
GTTY:	.BLKW	3
MEMTOP:	.BLKW	1
EIPNT:	.BLKW	1
EICNT:	.blkw	1
EIBSIZ=512.
EIBUF:	.BLKB	EIBSIZ
FREEST:	.BLKB	4096.	;START WITH 4096 BYTE BUFFER
TOP=.
.PSECT	TECOIO
.NLIST	BEX
rsharg:	.word	minus,0
comnam:	.word	'e,emake	;make
	.word	'g,emung	;mung
	.word	'o,eteco	;teco
	.word	't,einspe	;inspect
	.word	255.	;end of table
d.tec:	.asciz	%/.teco%
mshnam:	.asciz	%/bin/sh%
mshflg:	.asciz	/-c/
home:	.asciz	/HOME/
minus:	.asciz	/-/
notwar:	.ascii	/NOT WAR?/<lf>
notwl=.-notwar
love:	.asciz	/love/
SUPER:	.ASCII	/%SUPERSEDING EXISTING FILE/<LF>
SLEN=.-SUPER
	.EVEN
.LIST	BEX
.SBTTL	START AND REENTER CODE

START:	MOV	#TOP,R1		;TOP OF FREE AREA (FOR NOW)
	MOV	R1,MEMTOP
	MOV	#FREEST,R2	;START OF FREE AREA
	MOV	R2,R5
	MOV	#RWSIZE,R3	;GET SIZE OF R/W AREA
	ASR	R3		;MAKE IT WORDS
SYMBOL:	CLR	(R2)+
	DEC	R3
	BNE	SYMBOL
	MOV	R2,TECOPD(R5)	;START OF PUSH DOWN LIST
	MOV	R2,PDL(R5)	;AND AGAIN
	ADD	#SIZEPD,R2	;SKIP OVER PD SPACE
	MOV	R2,SCHBUF(R5)	;START OF SEARCH BUFFER
	MOVB	#-1,@R2		;SET UP A NULL SEARCH BUFFER
	ADD	#SCHSIZ,R2	;SKIP OVER SEARCH BUFFER
	MOV	SP,TECOSP(R5)	;START HIS STACK
	MOV	R2,TXSTOR(R5)	;START OF TEXT AREA
	SUB	R2,R1		;SIZE OF TEXT AND QREG AREAS
	CLC
	ROR	R1		;HALVSIES
	MOV	R1,ZMAX(R5)
	MOV	R1,QMAX(R5)
	ADD	R1,R2
	MOV	R2,QRSTOR(R5)
	CLR	CURFRE(R5)	;WE'VE GIVEN HIM ALL FOR NOW
	MOV	#202,ETYPE(R5)	;ET=202 INITIALLY
	MOV	#644,OFLAG(R5)	;EO=644 (OCTAL) INITIALLY
	mov	#5.,edflag(R5)	;ed=5 initially
	call	sysini
	mov	(sp),r1				;find environment list
	add	r1,r1
	cmp	(r1)+,(r1)+
	add	sp,r1				;address of it
	mov	r1,exec+6			;in case of shell invokation
	cmp	#1,(sp)			;any arguments?
	beq	1$			;none but file name
	mov	4(sp),r0		;examine first for "-"
	cmpb	#'-,(r0)+		;first not a minus sign?
	bne	1$
	tstb	(r0)			;only a minus sign?
	beq	44$
1$:	mov	(R1)+,r2		;get argument
	beq	not.te			;HOME not found
	mov	#home,r3		;string "HOME"
5$:	cmpb	(r2)+,(r3)+		;compare strings
	beq	5$
	cmpb	-1(r2),#'=		;equal sign?
	bne	1$			;no--check next
	tstb	-(r3)			;end of string?
	bne	1$
	mov	#ibuf1,r3		;move string into buffer
6$:	movb	(r2)+,(r3)+
	bne	6$
	mov	#ibuf1,r1		;pointer to it
	mov	r1,r2			;check for <logindir>/.teco
40$:	tstb	(R2)+			;find end of string
	bne	40$
	dec	r2
	mov	#d.tec,r3		;"/.teco"
41$:	movb	(R3)+,(r2)+
	bne	41$
	mov	r1,-(sp)
	$access	ibuf1,4			;check to see if file exists
	mov	(sp)+,r1
	bcs	not.te
	mov	r1,r0			;start of string
	sub	r1,r2
	dec	r2			;length of string
	mov	r2,r4
	mov	#256.,r1		;signal this is "EI"
	call	doccl
	mov	sp,r4			;copy of stack pointer
	mov	(sp),r3			;number of arguments
	mov	txstor(r5),r2		;text buffer start
2$:	tst	(R4)+			;goto next string
	mov	(r4),r1
3$:	movb	(r1)+,(r2)+		;move argument into text buffer
	bne	3$
	movb	#lf,-1(r2)		;insert line feed
	dec	r3			;one less argument
	bne	2$			;loop for more
	sub	txstor(r5),r2		;length of text
	mov	r2,zz(r5)		;is end of buffer
	mov	r2,p(r5)		;pointer at end of buffer
	neg	r2
	mov	r2,lschsz(r5)		;minus length into size of last insert
	bic	#200,etype(r5)		;turn off this flag now
	jmp	teco			;go to it!
44$:	mov	2(sp),4(sp)
	mov	(sp)+,(sp)		;delete first argument ("-")
	dec	(sp)
not.te:
	.page
	.enabl	lsb
	mov	(sp),r3		;number of arguments
	dec	r3		;less the first
	beq	30$		;no args, so go to it
	mov	2(sp),r0	;file name string
20$:	tstb	(r0)+		;find end of string
	bne	20$
	movb	-2(r0),r0	;last byte of command name
	mov	#comnam,r1	;command table
21$:	cmp	(r1)+,r0	;is this it?
	beq	22$
	bgt	30$		;strange command
	tst	(r1)+		;goto next entry
	br	21$
22$:	mov	(R1),r1		;get command name
	mov	4(sp),r0	;file name
31$:	mov	r0,r4
23$:	tstb	(R4)+		;get length of file name
	bne	23$
	sub	r0,r4
	dec	r4
	jmp	@r1		;go to appropriate routine
30$:	bic	#200,etype(r5)		;turn off this flag now
	jmp	teco
emake:	mov	#love,r2	;check for making love
	mov	r0,r3
24$:	cmpb	(R3)+,(r2)
	bne	tecoc		;making something else
	tstb	(R2)+
	bne	24$		;not at end of string
	$write	#1,notwar,notwl	;old joke
	mov	4(sp),r0	;restore r0
tecoc:	mov	#1,r1		;ew
	call	doccl		;do it
	br	30$		;go to it!

EINSPE:	clr	r1		;inspect <filename>
1$:	call	doccl		
	call	yank
	br	30$

ETECO:	dec	r3		;number of arguments
	bgt	2$		;more than one
	mov	#-1,r1		;do EBfilename
	br	1$
2$:	clr	r1		;do er filename
	call	doccl
	call	yank		;and yank
	mov	#tecoc,r1	;get next arg and do ew on it
	mov	6(sp),r0
	br	31$

EMUNG:	dec	r3		;number of args
	beq	9$		;only one?
	mov	6(sp),r1	;data string into buffer
	mov	txstor(R5),r2
3$:	movb	(R1)+,(R2)+	;loop until null char reached
	bne	3$
	dec	r2
	sub	txstor(R5),r2	;get length of string
	mov	r2,zz(r5)	;point to end
	mov	r2,p(r5)	;pointer at end
	neg	r2		;minus length
	mov	r2,lschsz(R5)	;into last insert size
9$:	mov	#256.,r1	;specify ei
	call	doccl		;go do it
	br	30$		;and return
	.dsabl	lsb
	.SBTTL	XITNOW, RUN, NORUN, AND ABORT
.globl	run,norun
SYSINI:	push	r1
	$GTTY	#0,GTTY		;GET OUR STATISTICS
	ror	r0
	ror	piped		;piped status
	bne	10$		;yes--dont stty!
	mov	gtty+4,savett
	bic	#30,gtty+4	;no echo or crlf conversion
	bis	#2,gtty+4	;use cbreak mode
	$stty	gtty		;set it up
	bit	#10,savett	;half duplex terminal?
	bne	1$
	bis	#10,etype(r5)	;we won't echo then!
1$:	$SIGNAL	2,ABORT		;"RUBOUT", WHILE EXECUTING GOES HERE
	$SIGNAL	3,1		;WE WANT FS's IGNORED
	$IOCTL	1,GETC,TCHARS	;Set up to cancel all controlling chars
	$IOCTL	1,GETO,TXCHARS
	movb	tchars,ntchars	;interupt character still works
	mov	txchars+2,ntxchars+2	;special flags unchanged
	mov	txchars+4,ntxchars+4	;expansion unchanged
	pop	r1
	return
10$:	$signal	2,finis		;exit if rubout typed
	pop	r1
	return


XITNOW:	tst	piped
	bne	1$		;if not piped then we are finished
	mov	savett,gtty+4	;restore and return
	$stty	gtty
1$:	return

ABORT:	BIT	#100000,freest+etype	;see if caught
	beq	1$
	BIC	#100000,freest+etype	;cancel bit
	br	2$
1$:	INC	FREEST+ABEND	;SIGNAL PROGRAM
2$:	mov	r0,-(sp)	;save registers
	push	r1
	$SIGNAL	2,ABORT		;RESIGNAL FOR FURTHER INTERUPTS
	pop	r1
	mov	(sp)+,r0	;restore register
	RTI

RUN:	tst	piped		;if piped, dont do this
	bne	1$		;Piped
	mov	r0,-(sp)
	mov	r1,-(sp)
	$IOCTL	1,SETC,TCHARS
	$IOCTL	1,SETO,TXCHARS
	mov	(sp)+,r1
	mov	(sp)+,r0
1$:	return

NORUN:	tst	piped
	bne	1$		;piped
	mov	r0,-(sp)
	mov	r1,-(sp)
	$IOCTL	1,SETC,NTCHARS
	$IOCTL	1,SETO,NTXCHARS
	mov	(sp)+,r1
	mov	(sp)+,r0
1$:	return
.END	START