Son of TEco (part 2)
eric
eric at tekadg.UUCP
Thu Dec 13 09:25:09 AEST 1984
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, at 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)+, at 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, at 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, at 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, at 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)+, at 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, at 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
More information about the Comp.sources.unix
mailing list