Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-01 - 43,50153/cfile.mac
There are no other files named cfile.mac in the archive.
	XLIST
	IFDEF LISTM, < IFN LISTM, <LIST	;LIST ID IN FIRST PROGRAM ONLY>>





	PAGE
F=0
AC=1
TAC=2
AC1=3
TAC1=4
XR1=13
XR2=14
XR3=5
PDL1=6
PDL2=7
BPNT1=10
BPNT=11
REGSAV=12

P=PDL2

RESET$==0
DDTIN$==1
STDDT$==2
DDTOU$==3
DEVCH$==4
WAI$==10
CORE$==11
EXIT$==12
UTCLR$==13
DATE$==14
LOGIN$==15
APREN$==16
LOGOU$==17
SWTCH$==20
REASS$==21
TIMER$==22
MTIME$==23
GETPP$==24
TPSET$==25
RNTIM$==27
PJOB$==30
SLEEP$==31
PEEK$==33
GETLN$==34
RUN$==35
SETWP$==36
REMAP$==37
GETSG$==40
GETTB$==41
SPY$==42
SETNM$==43
INCWL$==0
OUTCH$==1
INCHS$==2
OUTST$==3
INCWL$==4
INCSL$==5
GETLI$==6
SETLI$==7
RESCA$==10
CLRBI$==11
CLRBO$==12
SKINC$==13
MTC=340
MTS=344
DTC=320
DTS=324
SKINL$==14


	OPDEF INCHRW [TTCALL 0,]
	OPDEF OUTCHR [TTCALL 1,]
	OPDEF INCHRS [TTCALL 2,]
	OPDEF OUTSTR [TTCALL 3,]
	OPDEF INCHWL [TTCALL 4,]
	OPDEF INCHSL [TTCALL 5,]
	OPDEF GETLIN [TTCALL 6,]
	OPDEF SETLIN [TTCALL 7,]
	OPDEF RESCAN [TTCALL 10,]
	OPDEF CLRBFI [TTCALL 11,]
	OPDEF CLRBFO [TTCALL 12,]
	OPDEF SKPINC [TTCALL 13,]
	OPDEF SKPINL [TTCALL 14,]


JOBREN==124			;REENTER ADDRESS
JOBVER==137			;VERSION NUMBER
	DEFINE READ(CHNO,HDR,ERROR,EOF)<
	JSP	17,GETCHR
	JUMP	CHNO,HDR
	PUSHJ	P,ERROR
	IFNB <EOF>, <JUMP  EOF>
>
	DEFINE	WRITE(CHNO,HDR,ERROR,EOT)<
	JSP	17,PUTCHR
	JUMP	CHNO,HDR
	PUSHJ	P,ERROR
	IFNB <EOT>, <JUMP EOT>
>

	LIST
	TITLE	CFILE - PROGRAM TO INITIATE JOBS FROM COMMAND FILES
	SUBTTL	W METCALF   AUGUST 21,1970  VERSION 2.1

	IFNDEF PURE,<PURE==1>	;FOR NON-REENT. VERS. PURE=0
	IFN PURE, <HISEG>

	LOC	JOBREN		;UPON REENTER, KILL THE OBJECT JOB
	XWD	0,CLEAN		;AND CLOSE OUT TRANSACTION FILE

	RELOC
	LOC	JOBVER
	XWD	2,0		;VERSION 2 OF CFILE
	RELOC

	LISTM==-1	;LIST M HERE

	IFNDEF DEBSW,<DEBSW==0>;NON-ZERO FOR DEBUGGING
	IFNDEF HELPSW,<HELPSW==0>;ZERO IF RUNNING AS CFILE

	EXTERNAL	JOBFF,PUTCHR,GETCHR,JOBDDT

AL=1			;ASCII LINE MODE
IOPTRE==2000		;A RESPONSE IS WAITING ON PTY
IOPTW==4000		;OBJECT JOB HAS DONE AN INPUT UUO
MONMOD==1000		;PTY IS IN MONITOR MODE
IOIMP==400000		;IMPROPER MODE FLAG
EOF==20000		;END OF FILE FLAG
LINRDY==100		;A LINE HAS BEEN TYPED ALREADY
CON==200000		;CTY BIT FOR GETLIN UUO

INFL=0			;DEVICE WHERE JOB STREAM IS LOCATED
PTY=1			;PSEUDO-TELETYPE CHANNEL
OUFL=2			;TRANSACTION DEVICE
F=0			;FLAG REGISTER
RPG==400000		;CALL FROM PROGRAM VIA RUN UUO
TMPFLG=200000		;COMMAND FILE WAS GOTTEN VIA TMPCOR
ERR=100000		;ERROR RESPONSE FROM PTY
CPTY=40000		;WE HAVE CLOSED OUTPUT SIDE OF PTY
BRK==20000		;BREAK CHARACTER FLAG
CWT==10000		;COMMAND WAIT FLAG
FST==4000		;FIRST CHARACTER OF RESPONSE
LKA==2000		;LOOK AHEAD CHARACTER HAS BEEN READ
CTC==1000		;^C WAS LAST CHARACTER TYPED
JLOG==4		;JOB HAS SUCCESSFULLY LOGGED IN

	;USEFUL BYTE POINTERS AND OTHER DATA

TPCJOB:	POINT	7,AC,10		;POINTER TO JOB NUMBER IN TTYTAB

	;******NOTE*******
	;
	;JLOG AND TPCJOB MUST AGREE WITH THE MONITOR


;THIS MACRO SETS UP THE SUBROUTINE FOR CHECKING FOR BREAK CHARACTERS

	DEFINE	BREAK(A)
<	IRP A
 <	CAIN	AC,A
	JRST	CPOPJ1   >
			  >
CFILE:	TDZA	F,F			;START HERE FROM (JOBSA)
	MOVSI	F,RPG		;START HERE FROM (JOBSA)+1

	RESET			;RESET THE WORLD
	MOVE	P,STKWD		;SET UP PUSH-DOWN POINTER
	MOVE	XR1,DFLTWD	;SET UP FOR DEFAULT VALUES
	BLT	XR1,DFLTND	;MOVE IN THE DEFAULT VALUES

	IFE	HELPSW,<
	PUSHJ	P,JBSTS		;GET JOB STATUS WORD
	TLNE	AC,JLOG		;IS USER LOGGED IN?
	JRST	H1		;YES - CONTINUE
	GETLIN	AC		;NO - GET USER'S LINE CHARACTERISTICS
	TLNN	AC,CON		;IS HE ON THE CTY?
	JRST	PLOGIN		;NO - TELL HIM TO LOGIN
	MOVSI	AC,(SIXBIT/SYS/);YES - CHANGE DEVICE TO SYS
	MOVEM	AC,DEV
	MOVSI	AC,(SIXBIT/UP/)	;AND THE FILENAME TO UP
	MOVEM	AC,FILE
>

	IFN	HELPSW,<
	GETPPN	TAC,		;GET USER'S PPN
	CAME	TAC,HELPPN	;IS IT SPECIAL HELP PPN?
	JRST	H1		;NO - DON'T CHANGE IT
	GETLIN	AC		;YES - GET USER'S LINE CHARACTERISTICS
	TLNN	AC,CON		;IS HE ON THE CTY?
	JRST	PLOGIN		;NO - TELL HIM TO LOGIN
	HRLI	TAC,1		;YES - SET PROJECT NO. TO 1
	MOVEM	TAC,PPN		;STORE NEW PPN
>
H1:

	TLNE	F,RPG		;WERE WE CALLED VIA "RUN" UUO?
	JRST	CMDFL		;YES - GO LOOK FOR A CMD FILE
	IFN DEBSW,<
	CLRBFI			;RESET INPUT BUFFER
	OUTSTR	[ASCIZ/*/]	;PROMPT THE USER
	INCHWL	AC		;READ WHAT HE TYPES
	RESCAN			;BUT WE DON'T WANT THE CHARACTER
	JRST	F1		;GO START PROCESSING
>
	RESCAN			;SET UP TO READ TTY INPUT AGAIN

FLUSH:	PUSHJ	P,TTYIN		;GET CHARACTER FROM TTY
	TLNN	F,BRK		;IS BREAK FLAG SET?
	CAIA			;NO - STILL A GOOD CHARACTER
	JRST	IN1		;NONE LEFT - OPEN DEVICE AS IS
	CAIE	AC," "		;FLUSH UNTIL WE GET A SPACE(TAB)
	CAIN	AC,"	"
	SKIPA
	JRST	FLUSH
F1:	MOVEI	XR1,TTYIN	;GET ADDRESS OF TTYIN
	PUSHJ	P,COMSCN	;DECODE THE COMMAND LINE
	JRST	IN1		;FINISHED GO OPEN INPUT DEVICE


CMDFL:				;HERE IF WE HAVE A COMMAND FILE
	HRRZ	AC,JOBFF	;GET START OF BUFFER AREA
	HRLI	AC,-200		;-LENGTH IN LH FOR TMPCOR IOWD
	MOVEM	AC,TMPFIL+1	;STORE IN TMPCOR IOWD
	SOS	TMPFIL+1	;MAKE IT CONFORM TO IOWD FORMAT
	HRRM	AC,CTIBUF+1	;SET UP DUMMY BYTE POINTER
	MOVSI	AC1,(SIXBIT/CFI/);SET UP TWO WORD BLOCK
	MOVEM	AC1,TMPFIL	;FOR TMPCOR UUO
	MOVE	AC1,[XWD 1,TMPFIL];SET UP FOR READ FROM CORE
	TMPCOR	AC1,		;READ AND DELETE FILE "CFI"
	JRST	TMPEND		;FILE NOT THERE, TRY THE DISC
	ADD	AC,AC1		;GET END OF BUFFER
	MOVEM	AC,JOBFF	;DUMMY UP JOBFF
	MOVEM	AC,SVJFF	;SAVE NEW JOBFF
	IMULI	AC1,5		;CALCULATE CHARACTER COUNT
	ADDI	AC1,1		;MAKE SURE WE GET LAST CHARACTER
	MOVEM	AC1,CTIBUF+2	;DUMMY UP CHARACTER COUNT
				;IN RING HEADER
	MOVEI	AC1,440700	;SET UP REST OF BYTE POINTER
	HRLM	AC1,CTIBUF+1	;HEADER NOW COMPLETE
	TLO	F,TMPFLG	;TURN ON TMPCOR FLAG
	JRST	CMDRD		;GO READ THE COMMAND FILE
;	HERE WE TRY TO LOOK UP A FILE CALLED ###CFI.TMP ON THE
;	DISK.


TMPEND:	MOVEI	AC,AL		;OPEN FILE IN ASCII LINE MODE
	MOVSI	TAC,(SIXBIT/DSK/);DEVICE DSK
	MOVEI	AC1,CTIBUF	;SET UP INPUT BUFFER ADDRESS
	OPEN	INFL,AC		;OPEN INPUT COMMAND FILE
	JRST	IN1		;OPEN FAILURE - USE DEFAULTS
	MOVEM	TAC,DEVTAB+INFL	;STORE DEVICE NAME
	INBUF	INFL,1		;SET UP 1 INPUT BUFFER
	HRRZ	AC,JOBFF	;GET NEXT FREE LOCATION
	MOVEM	AC,SVJFF	;SAVE IT
	PUSHJ	P,CFNAM		;CONSTRUCT ###CFI FILENAME
	MOVEM	TAC1,CTIDIR	;SET UP ###CFI
	MOVSI	AC,(SIXBIT/TMP/);SET UP EXTENSION
	MOVEM	AC,CTIDIR+1
	SETZM	CTIDIR+3	;CLEAR PPN
	LOOKUP	INFL,CTIDIR	;DO LOOK UP ON COMMAND FILE
	JRST	IN1		;LOOKUP FAILURE - USE DEFAULTS



CMDRD:	HRRZ	AC,SVJFF	;GET THE SAVED JOBFF
	MOVEM	AC,JOBFF	;RESTORE JOBFF
	SKIPE	JOBDDT		;NO CORE UUO WHEN USING DDT
	JRST	.+3
	CORE	AC,		;DO CORE UUO FOR TMPCOR
	JRST	IN1		;CORE UUO FAILED - USE DEFAULTS
	MOVEI	XR1,GETCMD	;GET ADDRESS OF GETCMD
	PUSHJ	P,COMSCN	;DECODE THE COMMAND STRING
;	HERE WE INITIALIZE THE TWO DISC FILES( JOB STREAM
;	AND TRANSACTION FILE) AND THE PTY


IN1:
	PUSHJ	P,PTYINI	;INITIALIZE A PTY
	JRST	QUIT		;RETURN TO MONITORY
	MOVEI	AC,AL		;OPEN DISC FILE IN ASCII LINE
	MOVE	TAC,DEV		;GET DEVICE NAME
	MOVEI	AC1,IBUF	;GET BUFFER HEADER
	OPEN	INFL,AC		;OPEN DISC FOR INPUT TEXT
	JRST	NODEV		;ERROR - TELL SOMEBODY
	MOVEM	TAC,DEVTAB+INFL	;STORE DEVICE NAME
	MOVE	AC,FILE		;GET FILENAME
	MOVE	TAC,EXT		;GET EXTENSION
	CLEAR	AC1,		;CLEAR REGISTER
	MOVE	TAC1,PPN	;LOAD PPN
	LOOKUP	INFL,AC		;LOOK UP THIS FILE
	JRST	NOFILE		;ERROR - TELL SOMEBODY


;	INITIALIZE THE DISC OUTPUT FILE (TRANSACTION FILE)

	MOVEI	AC,AL		;OPEN IN ASCII LINE MODE
	MOVSI	TAC,(SIXBIT/DSK/);DEVICE DSK
	MOVSI	AC1,OBUF	;GET RING HEADER
	OPEN	OUFL,AC		;OPEN THE DISK FOR WRITING
	JRST	NODEV		;NO DEVICE
	MOVEM	TAC,DEVTAB+OUFL	;SAVE DEVICE NAME
	PUSHJ	P,CFNAM		;CONSTRUCT ###CFI FILENAME
	MOVE	AC,TAC1		;SET UP FOR ENTER UUO.
	MOVSI	TAC,(SIXBIT/TXT/);WITH EXTENSION TXT
	CLEARB	AC1,TAC1	;CLEAR OTHER REGISTERS
	IFN	HELPSW,<
	GETPPN	TAC1,		;GET PPN WE ARE RUNNING UNDER
	CAMN	TAC1,HELPPN	;IS IT THE HELP NUMBER?
	MOVE	TAC1,PPN	;YES - GET MODIFIED PPN
>
	ENTER	OUFL,AC		;CREATE AN OUTPUT FILE
	JRST	ENTERR		;BAD ERROR - CANNOT CREATE THIS FILE
	;HERE WE START OUR DIALOGUE WITH THE PTY


	MOVEI	TAC,3		;GIVE PTY A ^C TO MAKE SURE
	TLO	F,CWT		;SET CWT ON INITIALLY
				;IT IS LISTENING
PTYPE:	PUSHJ	P,PTYCOM	;GO TALK TO PTY
	JFCL			;IGNORE ERROR RETURN

P1:	JSP	17,GETCHR	;READ A CHARACTER FROM 
	JUMP	INFL,IBUF	;JOB STREAM FILE
	PUSHJ	P,IERROR	;ERROR
	STATZ	INFL,EOF	;END-OF-FILE?
	JRST	NOMORE		;YES - THAT'S ALL FOLKS
	JUMPE	AC,P1		;NO - IGNORE NULL CHARACTERS
	MOVE	TAC,AC		;GET GOOD CHARACTER
	JRST	PTYPE		;GO GIVE IT TO PTY


NOMORE:	MOVEI	TAC,0		;TYPE A NULL CHARACTER TO FORCE
	PUSHJ	P,PTYCOM	;PTYOUT TO WAIT FOR RESPONSE
	JFCL
	CLOSE	PTY,2		;CLOSE OUTPUT SIDE OF PTY
	TLO	F,CPTY		;SET PTY CLOSED FLAG
	PUSHJ	P,PTYOUT	;GO BACK AND PROCESS RESPONSE IF ANY
	JFCL

THEND:	CLOSE	PTY,1		;CLOSE INPUT SIDE OF PTY
	CLOSE	OUFL,		;CLOSE TRANSACTION FILE
	JRST	QUIT		;RETURN TO MONITOR


PTYCOM:	MOVEI	XR3,^D30	;SET TIMEOUT AT 30 SECONDS
	PUSHJ	P,PTYOUT	;CALL PTY OUTPUT ROUTINE
	JSP	17,WAIT		;OBJECT JOB NOT READY
	JRST	CPOPJ1		;RETURN TO CALLER



WAIT:	PUSHJ	P,SLP		;SLEEP FOR A WHILE
	JRST	-2(17)		;GO TRY AGAIN


QUIT:	PUSHJ	P,JBSTS		;GET JOB STATUS WORD
	TLNE	AC,JLOG		;ARE WE LOGGED IN?
	EXIT			;YES - RETURN TO MONITOR
	OUTSTR	[ASCIZ/.KJOB
./]
	LOGOUT			;NO - LOG US OUT
	;ROUTINE TO OUTPUT CHARACTERS ON THE PTY AND HANDLE 
	;ANY RESPONSES.
	;
	;CALLING SEQUENCE -
	;
	;	MOVEI	XR3,(MAX. NO. OF TIMES TO GIVE BUSY RETURN 
	;			BEFORE TYPING A ^C ANYWAY.
	;	LDB	TAC, (BYTE TO TYPED OUT)
	;	PUSHJ	P,PTYOUT
	;	  RETURN HERE IF JOB NOT READY
	;	  RETURN HERE AFTER RESPONSE HAS BEEN READ AND CHARACTER
	;			TYPED.
	;
	;ACCUMULATORS 17,P,AC ARE DESTROYED.
	;
	;ACCUMULATOR XR3 IS DECREMENTED IF THE JOB IS NOT READY AND
	;THE CHARACTER TO BE TYPED WAS A ^C.  THE SUBROUTINE MAKES
	;A NON-SKIP RETURN IN THIS CASE.
	;
	;
PTYOUT:
GETRE:	STATO	PTY,MONMOD	;ARE WE IN USER MODE?
	TLO	F,CWT		;YES - TURN ON COMMAND WAIT BIT
	MOVE	AC,PTI+2	;GET BYTE COUNT
	CAILE	AC,1		;IS THE BUFFER EMPTY?
	JRST	GETR1		;NO - GET NEXT CHARACTER
	STATO	PTY,IOPTRE	;YES - ANY MORE RESPONSES?
	JRST	ENDRE		;NO - END OF RESPONSE
GETR1:	READ	PTY,PTI,PTIERR	;READ A CHARACTER FROM RESPONSE
	JUMPE	AC,GETRE	;IF NULL, IGNORE IT
	WRITE	OUFL,OBUF,OERROR;WRITE IT ON THE XACTION FILE
	STATZ	PTY,MONMOD	;ARE WE IN USER MODE?
	CAIGE	AC,40		;IS CHARACTER NON-PRINTING
	JRST	GETR2		;YES - DON'T MEDDLE WITH CWT
 	TLZ	F,CWT		;RESET COMMAND WAIT FLAG
	CAIN	AC,"."		;NO - IS IT A PERIOD?
	TLO	F,CWT		;YES - SET COMMAND WAIT FLAG
GETR2:	CAIN	AC,"?"		;IS THE CHARACTER A "?"?
	TLO	F,ERR		;YES - FLAG ERROR
	JRST	GETRE		;GO GET NEXT CHARACTER

ENDRE:	TLZE	F,ERR		;WAS THERE ANERROR?
	PUSHJ	P,JBERR		;YES - LET USER KNOW
ENDR1:	TLZE	F,CPTY		;ARE WE CLOSING OUT PTY?
	JRST	CPOPJ1		;YES - RETURN IMMEDIATELY
ENDR2:	TLNN	F,CWT		;IS MONITOR DIDDLING?
	JRST	CPOPJ		;YES - GO WAIT A WHILE
	STATZ	PTY,IOPTW	;NO - IS USER WAITING FOR INPUT?
	JRST	TYPE		;YES - GIVE IT TO HIM
	CAIE	TAC,3		;NO - IS CHARACTER A ^C?
	JRST	ENDR4		;NO - SKIP THIS CODE
	MOVE	AC,PTYLIN	;GET LINE NUMBER OBJECT JOB IS ON
	GETLIN	AC		;GET LINE CHARACTERISTICS
	TLNN	F,CTC		;WAS LAST CHARACTER A ^C?
	TLNN	AC,LINRDY	;NO - IS THERE A LINE WAITING?
	CAIA			;NO - TYPE THIS ^C
	SOJG	XR3,CPOPJ	;YES - DON'T TYPE ^C
	TLOE	F,CTC		;NO - SET CTC FLAG
	SETSTS	PTY,MONMOD	;SECOND ^C - FORCE MONITOR MODE
	JRST	TYPE		;GO TYPE ^C
ENDR4:	STATO	PTY,MONMOD	;IS PTY IN MONITOR MODE?
ENDR3:	JRST	CPOPJ		;NO-SKIP RETURN - BUSY INDICATOR
TYPE:	CAIE	TAC,3		;IS CHARACTER A ^C?
	TLZ	F,CTC		;NO - RESET CTC FLAG
	TLZ	F,LKA		;RESET LOOK AHEAD FLAG
	MOVE	AC,TAC		;GET CHARACTER THAT WAS READ
	JUMPE	AC,CPOPJ1	;IF NULL, IGNORE IT
	WRITE	PTY,PTO,PTOERR	;TYPE OUT CHARACTER ON PTY
	WRITE	OUFL,OBUF,OERROR;WRITE OUT ON XACTION FILE
	PUSHJ	P,BRKCHK	;CHECK FOR BREAK CHARACTER
	JRST	TYPE1		;IT ISN'T - CARRY ON
	CLEARB	AC,PTO+2	;IT IS - FORCE OUTPUT OF CURRENT BUFFER
	WRITE	PTY,PTO,PTOERR	;WRITE IT OUT
	STATZ	PTY,MONMOD	;IS PTY IN MONITOR MODE?
	TLZ	F,CWT		;YES - RESET COMMAND WAIT FLAG
TYPE1:	JRST	CPOPJ1	;RETURN TO CALLER
;ROUTINE TO INITIALIZE PSEUDO-TELETYPE
;WILL TRY PTY0 FIRST, THEN PTY1, PTY2, ETC.
;CALL	PUSHJ P,PTYINI
;	RETURN IF NO PTY'S AVAILABLE (AFTER PRINTING MESSAGE)
;	SUCCESSFUL RETURN

PTYINI:	PUSH	P,TAC1		;SAVE CONTENTS OF TAC1
	PUSH	P,AC1		;SAVE CONTENTS OF AC1
	PUSH	P,XR1		;SAVE CONTENTS OF XR1
	MOVEI	XR1,1		;INITIALIZE LINE NUMBER AT 1
	MOVE	TAC,[SIXBIT /PTY0/]
PTYIN1:	MOVEI	AC,MONMOD	;OPENT PTY IN MONITOR MODE
	MOVE	AC1,[XWD PTO,PTI]	;SET UP RING HEADER ADDRESSES
	OPEN	PTY,AC		;TRY TO INIT PTY
	AOJA	XR1,PTNAVL	;TRY TO INIT EVERY PTY IN SYSTEM
 	MOVEM	TAC,DEVTAB+PTY	;SAVE DEVICE NAME
	OUTBUF	PTY,1		;SINGLE-BUFFER OUTPUT TILL PTYSER FIXED
	INBUF	PTY,2
	PUSHJ	P,CTYSRC	;GO FIND LINE NUMBER OF CTY
	HRRZS	AC		;REMOVE GARBAGE
	ADD	AC,XR1		;ADD UNIT NUMBER OF PTY
	MOVEM	AC,PTYLIN	;STORE AS LINE  NUMBER OF LINKED TTY
	POP	P,XR1		;RESTORE CONTENTS OF XR1
	POP	P,AC1		;RESTORE CONTENTS OF AC1

TPOPJ1:	AOSA	-1(P)		;RESTORE TAC1 AND SKIP RETURN
CPOPJ1:	AOSA	(P)
TPOPJ:	POP	P,TAC1
CPOPJ:	POPJ	P,

;ROUTINE TO SEARCH FOR FREE PTY'S

PTNAVL:	MOVEI	AC,10000	;INCREASE SIXBIT DEVICE NUMBER BY 1
	ADDB	TAC,AC
	DEVCHR	AC,		;DOES NEW DEVICE EXIST?
	JUMPN	AC,PTYIN1	;YES, TRY TO INITIALIZE IT
	OUTSTR	[ASCIZ/?NO PTY'S AVAILABLE
/]
	POPJ	P,


CTYSRC:	MOVSI	TAC,-200	;SET COUNT AT MAXIMUM LINE NUMBER
CTYSR1:	HRRZ	AC,TAC		;GET NEXT LINE NUMBER
	GETLIN	AC		;GET ITS CHARACTERISTICS
	TLNN	AC,CON		;IS IT THE CTY?
	AOBJN	TAC,CTYSR1	;NO - TRY NEXT LINE NUMBER
	JRST	CPOPJ		;YES - RETURN
TTYIN:	INCHRS	AC		;GET CHARACTER FROM TTY IF ANY
	JRST	FLAGIT		;GO SET BREAK CHARACTER FLAG
CHRCHK:	CAIN	AC,15		;IS CHARACTER A CR?
	JRST	TTYIN		;YES - THROW IT AWAY
	TLZ	F,BRK		;RESET BREAK FLAG
	CAIG	AC,14		;CHECK FOR VT
	CAIGE	AC,12		;LF
	CAIN	AC,33		;ESC
	JRST	FLAGIT		;GO SET BREAK FLAG
	CAIG	AC,176		;PREFIX
	CAIGE	AC,175		;ALTMODE
	JRST	ALPHA		;GO SEE IF ALPHANUMERIC
FLAGIT:	TLO	F,BRK		;SET BREAK CHARACTER FLAG
	POPJ	P,		;RETURN TO CALLER

ALPHA:	CAIL	AC,"0"		;IS IT ALPHANUMERIC?
	CAILE	AC,"9"
	SKIPA			;NOT NUMERIC
	JRST	CPOPJ1		;NUMERIC - GIVE GOOD RETURN
	CAIL	AC,"A"		;IS IT ALPHABETIC?
	CAILE	AC,"Z"
	POPJ	P,		;NO - GIVE NON-SKIP RETURN
	JRST	CPOPJ1		;YES - GIVE GOOD RETURN


CLEAN:	MOVE	BPNT,[POINT 7,JBKILL];GET BYTE POINTER TO COMMAND
	CLEAR	XR3,		;DON'T WAIT TO EXECUTE ^C'S
	PUSHJ	P,STRING	;TYPE STRING ON PTY
	JRST	NOMORE		;GO CLOSE ALL FILES AND STOP

JBKILL:	ASCIZ	/KJOB
K
/


	;THE FOLLOWING SUBROUTINE WRITES OUT ASCIZ STRINGS ON THE
	;PTY.
	;CALLING SEQUENCE - MOVE  BPNT, (BYTE POINTER TO COMMAND)
	;		    MOVE  XR3, (TIME LIMIT TO WAIT ON ^C)
	;		    PUSHJ  P,STRING


STRING:	PUSH	P,XR3		;SAVE TIME LIMIT
STRNG1:	ILDB	TAC,BPNT		;GET CHARACTER TO BE TYPED
	JUMPE	TAC,STRET	;IF NULL WE ARE DONE
	PUSHJ	P,PTYOUT	;TYPE CHARACTER ON PTY
	JSP	17,WAIT		;WAIT FOR CHARACTER TO BE TYPED
	MOVE	XR3,0(P)	;GET TIME LIMIT AGAIN
	JRST	STRNG1	;GO BACK FOR NEXT CHARACTER

STRET:	POP	P,XR3		;RESTORE TIME LIMIT
	POPJ	P,		;RETURN TO CALLER
;	THESE ARE THE I/O ERROR ROUTINES FOR CFILE
;
;
;
IERROR:	LDB	TAC,CHPNT	;GET CHANNEL NUMBER
	OUTSTR	[ASCIZ /?INPUT ERROR ON /]
ERROR:	MOVE	AC,DEVTAB(TAC)	;GET SIXBIT DEVICE NAME
	CLEAR	TAC,		;REMOVE GARBAGE
	PUSHJ	P,SBTAS		;CONVERT TO ASCII
	OUTSTR	AC		;WRITE OUT DEVICE NAME
	OUTSTR	CRLF		;WRITE OUT A CARRIAGE RETURN
	EXIT	1,		;RETURN TO MONITOR
	JRST	QUIT		;RETURN PERMANENTLY


PTOERR:
OERROR:	LDB	TAC,CHPNT	;GET CHANNEL NUMBER
	OUTSTR	[ASCIZ /?OUTPUT ERROR ON /]
	JRST	ERROR		;GO WRITE REST OF ERROR MESSAGE


PTIERR:	STATO	PTY,IOIMP	;IS ERROR IMPROPER MODE?
	JRST	IERROR		;NO - WRITE ERROR MESSAGE
	SETSTS	PTY,MONMOD	;YES - RESET STATUS TO MONITOR MODE
	CLEAR	AC,		;CREATE A NULL BYTE SO IT WILL BE IGNORED
	TLO	F,CWT		;TURN ON COMMAND WAIT BIT (NO PERIOD IS
				;PRINTED IF "DETACH" COMMAND)
	POPJ	P,		;RETURN TO USER


CHPNT:	POINT	12,0(17),4	;BYTE POINTER FOR CHANNEL NUMBER
CRLF:	ASCIZ	/

/
;	THIS IS A GENERALIZED COMMAND SCANNER AND DECODER
;
;	THE CALLING SEQUENCE IS AS FOLLOWS:
;
;		MOVEI  XR1, ADDRESS OF ROUTINE TO READ CHARACTER
;		;PUSHJ	P,COMSCN
;
;		AC, AND TAC ARE DESTROYED
;		CONTROL IS RETURNED TO THE CALLING PROGRAM
;		ONLY AFTER AN ENTIRE LINE HAS BEEN SCANNED.
;
;		COMSCN DEPOSITS THE CONVERTED FIELDS
;		INTO LOCATIONS CALLED "DEV", "FILE", "EXT",
;		AND "PPN" RESPECTIVELY, WHICH ARE ASSUMED TO 
;		EXIST IN THE CALLING PROGRAM.


COMSCN:	PUSH	P,BPNT		;SAVE CONTENTS OF BPNT
	PUSH	P,XR2		;SAVE CONTENTS OF XR2

;	HERE WE PROCESS THE DEVICE NAME AND FILENAME

COMDEV:	MOVE	BPNT,[POINT 6,TAC];SET UP BYTE POINTER
	CLEAR	TAC,		;REMOVE GARBAGE
	MOVEI	XR2,6		;DEVICE AND FILE NAMES ARE 6
				;CHARACTERS LONG
COMDV2:	PUSHJ	P,0(XR1)	;READ A CHARACTER
	JRST	COMDV1		;END OF FIELD
	SOJL	XR2,COMDV2	;FLUSH UNTIL WE GET TERMINATORS
	SUBI	AC,40		;CONVERT TO SIXBIT
	IDPB	AC,BPNT		;STORE IT IN TAC
	JRST	COMDV2		;GO BACK FOR NEXT CHARACTER

COMDV1:	JUMPE	TAC,DISP	;IF NULL FIELD, DISPATCH
	CAIE	AC,":"		;IS TERMINATOR A ":"?
	MOVEM	TAC,FILE	;NO - MUST BE A FILENAME
	CAIN	AC,":"
	MOVEM	TAC,DEV		;YES - IT'S A DEVICE NAME
	JRST	DISP		;FINISHED HERE - GO DISPATCH
				;TO NEXT ROUTINE

;	HERE WE PROCESS THE EXTENSION

COMEXT:	MOVE	BPNT,[POINT 6,EXT];GET POINTER TO EXTENSION
	MOVEI	XR2,3		;EXTENSION IS 3 CHARACTERS LONG

COMEX1:	PUSHJ	P,0(XR1)	;READ A CHARACTER
	JRST	DISP		;FINISHED - GO TO NEXT ROUTINE
	SOJL	XR2,COMEX1	;FLUSH REMAINING ALPHANUMERICS
	SUBI	AC,40		;CONVERT TO SIXBIT
	IDPB	AC,BPNT		;STORE IN EXTENSION FILED
	JRST	COMEX1		;GO BACK FOR NEXT CHARACTER

;	HERE WE PROCESS THE PROJECT-PROGRAMMER NO.

COMPPN:
COMPRJ:	MOVEI	XR2,3		;MAXIMUM OF 3 CHARACTERS
	CLEAR	TAC,		;INITIALIZE PROJECT/PROG. NO.

COMPJ1:	PUSHJ	P,0(XR1)	;READ A CHARACTER
	JRST	COMPJ2		;END OF FIELD
	SOJL	XR2,COMPJ1	;FLUSH REMAINING ALPHANUMERICS
	CAILE	AC,67		;GOOD OCTAL DIGIT?
	JRST	ILLPPN		;NO - GIVE ERROR MESSAGE
	SUBI	AC,60		;YES - SAVE DIGIT PORTION
	IMULI	TAC,10		;CONVERT TO BINARY
	ADD	TAC,AC		;ADD IT IN
	JRST	COMPJ1		;GO BACK FOR NEXT CHARACTER

COMPJ2:	JUMPE	TAC,DISP	;IF NULL FIELD, DISPATCH
	CAIN	AC,","		;IS TERMINATOR A COMMA?
	HRLM	TAC,PPN		;YES - PROJECT NO.
	CAIE	AC,","
	HRRM	TAC,PPN		;NO - PROGRAMMER NO.
	JRST	DISP		;GO TO NEXT ROUTINE


;	THIS IS THE DISPATCH TABLE FOR THE TERMINATING
;	SPECIAL CHARACTERS.

DISP:	TLNE	F,BRK		;BREAK CHARACTER
	JRST	COMRET		;RETURN
	CAIN	AC,":"		;COLON
	JRST	COMDEV		;FILENAME
	CAIN	AC,"."		;PERIOD
	JRST	COMEXT		;EXTENSION
	CAIN	AC,"["		;LEFT BRACKET
	JRST	COMPPN		;PROJECT NUMBER
	CAIN	AC,","		;COMMA
	JRST	COMPPN		;PROGRAMMER NO.
	CAIN	AC,"]"		;LEFT BRACKET
	JRST	COMRET		;RETURN

	OUTSTR	[ASCIZ/?UNRECOGNIZABLE CHARACTER IN COMMAND STRING
/]
	JRST	QUIT		;RETURN TO MONITOR
COMRET:	POP	P,XR2		;RESTORE XR2
	POP	P,BPNT		;RESTORE BPNT
	POPJ	P,		;RETURN

ILLPPN:	OUTSTR	[ASCIZ/?ILLEGAL PROJECT-PROGRAMMER NO.
/]
	JRST	QUIT		;RETURN TO MONITOR
SLP:	MOVEI	AC,1		;SLEEP FOR 1 SECOND
	SLEEP	AC,		;ZZZ
	POPJ	P,		;RETURN TO CALLER

;THIS ROUTINE TYPES OUT A MESSAGE IF AN ERROR RESPONSE IS
;FOUND

JBERR:	OUTSTR	[ASCIZ/?ERROR FOUND IN OBJECT JOB
/]
	POPJ	P,		;REUTURN TO CALLER


;	THIS ROUTINE PRINTS OUT AN ERROR MESSAGE IF THE
;	DEVICE SPECIFIED IN THE COMMAND FILE IS NOT AVAILABLE

NODEV:	MOVE	AC,TAC		;PUT DEVICE NAME IN PLACE
	PUSHJ	P,SBTAS		;CONVERT TO ASCII
	OUTSTR	[ASCIZ/?DEVICE /]
	OUTSTR	AC
	OUTSTR	[ASCIZ/ NOT AVAILABLE
/]
	JRST	QUIT		;RETURN TO MONITOR

;	THIS ROUTINE PRINTS OUT AN ERROR MESSAGE IF THE FILE
;	SPECIFIED IN THE COMMAND FILE DOES NOT EXIST

NOFILE:	PUSH	P,TAC		;SAVE CONTENTS OF TAC
	CLEAR	TAC,		;ZERO EXTENSION
	PUSHJ	P,SBTAS		;CONVERT FILENAME TO ASCII
	OUTSTR	[ASCIZ/?FILE /]
	OUTSTR	AC
	POP	P,AC		;GET EXTENSION
	HLLZS	AC		;REMOVE GARBAGE
	JUMPE	AC,NOFL1	;IF NO EXTENSION IGNORE FOLLOWING
	PUSHJ	P,SBTAS		;CONVERT EXTENSION TO ASCII
	OUTSTR	[ASCIZ/./]
	OUTSTR	AC		;TYPE OUT EXTENSION
NOFL1:	OUTSTR:	OUTSTR	[ASCIZ/ DOES NOT EXIST
/]
	JRST	QUIT		;RETURN TO MONITOR

PLOGIN:	OUTSTR	[ASCIZ/
?PLEASE LOGIN.
/]
	JRST	QUIT		;RETURN TO MONITOR



;THIS SUBROUTINE CHECKS FOR A BREAK CHARACTER IN AC.  IF IT IS
;A BREAK CHARACTER, A SKIP RETURN IS EXECUTED.  OTHERWISE A NON-SKIP
;RETURN IS TAKEN

BRKCHK:	TLO	F,BRK		;PRESET THE BREAK FLAG
	BREAK	<3,7,12,13,14,32,33,172,175>
	TLZ	F,BRK		;RESET THE BREAK FLAG
	POPJ	P,		;GIVE NON-SKIP RETURN
;	THIS ROUTINE CONVERTS A SIXBIT STRING IN ACCUMULATORS
;	AC, AND TAC (TERMINATED BY A NULL) TO AN ASCII STRING
;	LEFT JUSTIFIED IN ACCUMULATORS AC AND TAC.

SBTAS:	PUSH	P,BPNT		;SAVE PREVIOUS BPNT
	PUSH	P,AC1		;SAVE CONTENTS OF AC1
	PUSH	P,AC		;SAVE SIXBIT TEXT
	PUSH	P,TAC
	MOVEI	AC,0		;GET A NULL BYTE
	PUSH	P,AC		;MAKE SURE WE END STRING
	PUSH	P,BPNT1		;SAVE BPNT1
	MOVE	BPNT,[POINT 6,-3(P)];SET UP BYTE PNTR FOR INPUT
	MOVE	BPNT1,[POINT 7,AC];SET UP BYTE POINTER FOR OUTPUT
	CLEARB	AC,TAC		;INITIALIZE OUTPUT ACCS

SBTAS2:	ILDB	AC1,BPNT	;GET FIRST CHARACTER
	JUMPE	AC1,SBTAS1	;IF NULL WE ARE DONE
	ADDI	AC1,40		;CONVERT TO ASCII
	IDPB	AC1,BPNT1	;STORE ASCII BYTE
	JRST	SBTAS2		;GO BACK FOR NEXT CHARACTER

SBTAS1:	POP	P,BPNT1		;RESTORE BPNT1
	SUB	P,[XWD 3,3]	;ADJUST PUSH-DOWN STACK
	POP	P,AC1		;RESTORE AC1
	POP	P,BPNT		;RESTOREBPNT
	POPJ	P,		;RETURN TO CALLER

GETCMD:	READ	INFL,CTIBUF,IERROR;READ CHARACTER FROM CMD FILE
	JUMPE	17,FLAGIT	;IF NULL CHARACTER - GO FLAG AS THE END
	HRRZ	17,CTIBUF	;GET FILE STATUS
	MOVE	17,-1(17)
	TRNE	17,EOF		;IS END-OF-FILE SET?
	JRST	FLAGIT		;YES - GO FLAG END OF CHARACTER STRING
	JRST	CHRCHK		;NO - GO CHECK CHARACTER



JBSTS:	PJOB	AC,		;GET OUR JOB NUMBER
	HRLZS	AC		;SET UP TO GET JBTSTS
	GETTAB	AC,		;GET STATUS WORD
	JFCL
	POPJ	P,		;RETURN TO CALLER
	;THIS ROUTINE CONSTRUCTS A SIXBIT FILENAME OF
	;THE FORM ###CFI WHERE ### IS THE JOB NUMBER OF THIS
	;JOB.
	;ACCUMULATORS AC,TAC,AC1,TAC1 ARE DESTROYED; AND THE
	;RESULT IS RETURNED IN ACCUMULATOR TAC1.

CFNAM:	MOVEI	AC,3		;JOB # IS 3 CHARACTERS LONG
	PJOB	TAC,		;GET CURRENT JOB NUMBER
CFN1:	IDIVI	TAC,12		;CONVERT TO DECIMAL
	ADDI	AC1,"0"-40	;CHANGE REMAINDER TO SIXBIT
	LSHC	AC1,-6		;SHOVE DIGITS INTO TAC1
	SOJG	AC,CFN1		;3 DIGITS YET?
	HRRI	TAC1,(SIXBIT/CFI/);GET REST OF FILENAME
	POPJ	P,		;RETURN TO CALLER


ENTERR:	OUTSTR	[ASCIZ/?UNABLE TO CREATE TRANSACTION FILE
/]
	JRST	QUIT		;RETURN TO MONITOR



STKWD:	IOWD	^D16,STACK	;PDL POINTER
DFLTWD:	XWD	DEFALT,DFLTST	;BLT POINTER FOR DEFAULT PARAMS
DEFALT:	SIXBIT	/DSK/
	SIXBIT	/OBJECT/
	0
	0
DUMPPN:	XWD	1,2		;PRIVILEGED PPN
HELPPN:	XWD	2,4		;HELP PPN
	XLIST			;JUST LITERALS HERE

	LIT
	LIST
;THIS IS THE LOW SEGMENT

	IFN PURE, <LOC 140>

STACK:	BLOCK	^D15		;PUSH DOWN STACK
DFLTST:	
	DEV:	BLOCK	1		;THIS IS THE RIB FOR THE
FILE:	BLOCK	1		;JOBSTREAM FILE
EXT:	BLOCK	1
PPN:	BLOCK	1
DFLTND:

TMPFIL:	BLOCK	2		;2 WORD ARRAY FOR TMPCOR UUO

CTIDIR:	BLOCK	4		;RIB FOR COMMAND FILE
CTIBUF:	BLOCK	3		;RING HEADER FOR COMMAND FILE

IBUF:	BLOCK	3		;RING HEADER FOR XACTION FILE
OBUF:	BLOCK	3

PTI:	BLOCK	3		;RING HEADER FOR PTY INPUT
PTO:	BLOCK	3		;RING HEADER FOR PTY OUTPUT

SVJFF:	BLOCK	1		;SAVE AREA FOR JOBFF

DEVTAB:	BLOCK	20		;TABLE FOR DEVICE NAMES

PTYLIN:	BLOCK	1		;LINE NUMBER OF LINKED TTY

PTYJOB:	BLOCK	1		;JOB NUMBER OF OBJECT JOB


	PRGEND	CFILE
	XLIST
	IFDEF LISTM, < IFN LISTM, <LIST	;LIST ID IN FIRST PROGRAM ONLY>>



;***********************************************************************
;***********************************************************************
;**							              **
;**								      **
;**								      **
;**	T H I S  P R I N T O U T   B E L O N G S    T O		      **
;**								      **
;**								      **
;**								      **
;**		W A L T E R   M E T C A L F			      **
;**								      **
;**								      **
;**								      **
;**		   1 0 4 , 1 0 7				      **
;**								      **
;**								      **
;**								      **
;**								      **
;***********************************************************************
;***********************************************************************


	PAGE
F=0
AC=1
TAC=2
AC1=3
TAC1=4
XR1=13
XR2=14
XR3=5
PDL1=6
PDL2=7
BPNT1=10
BPNT=11
REGSAV=12

P=PDL2

RESET$==0
DDTIN$==1
STDDT$==2
DDTOU$==3
DEVCH$==4
WAI$==10
CORE$==11
EXIT$==12
UTCLR$==13
DATE$==14
LOGIN$==15
APREN$==16
LOGOU$==17
SWTCH$==20
REASS$==21
TIMER$==22
MTIME$==23
GETPP$==24
TPSET$==25
RNTIM$==27
PJOB$==30
SLEEP$==31
PEEK$==33
GETLN$==34
RUN$==35
SETWP$==36
REMAP$==37
GETSG$==40
GETTB$==41
SPY$==42
SETNM$==43
INCWL$==0
OUTCH$==1
INCHS$==2
OUTST$==3
INCWL$==4
INCSL$==5
GETLI$==6
SETLI$==7
RESCA$==10
CLRBI$==11
CLRBO$==12
SKINC$==13
MTC=340
MTS=344
DTC=320
DTS=324
SKINL$==14


	OPDEF INCHRW [TTCALL 0,]
	OPDEF OUTCHR [TTCALL 1,]
	OPDEF INCHRS [TTCALL 2,]
	OPDEF OUTSTR [TTCALL 3,]
	OPDEF INCHWL [TTCALL 4,]
	OPDEF INCHSL [TTCALL 5,]
	OPDEF GETLIN [TTCALL 6,]
	OPDEF SETLIN [TTCALL 7,]
	OPDEF RESCAN [TTCALL 10,]
	OPDEF CLRBFI [TTCALL 11,]
	OPDEF CLRBFO [TTCALL 12,]
	OPDEF SKPINC [TTCALL 13,]
	OPDEF SKPINL [TTCALL 14,]


JOBREN==124			;REENTER ADDRESS
JOBVER==137			;VERSION NUMBER
	DEFINE READ(CHNO,HDR,ERROR,EOF)<
	JSP	17,GETCHR
	JUMP	CHNO,HDR
	PUSHJ	P,ERROR
	IFNB <EOF>, <JUMP  EOF>
>
	DEFINE	WRITE(CHNO,HDR,ERROR,EOT)<
	JSP	17,PUTCHR
	JUMP	CHNO,HDR
	PUSHJ	P,ERROR
	IFNB <EOT>, <JUMP EOT>
>

	LIST
	TITLE	IORTN - INPUT/OUTPUT ROUTINES FOR ASCII FILES
;
;
;	CALLING SEQUENCE:
;
;		JSP	17,GETCHR	JSP	17,PUTCHR
;		JUMP	CHNO,BUFFHD	JUMP	CHNO,BUFFHD
;		   ERROR RETURN		   ERROR RETURN
;		JUMP	ADDR		JUMP	ADDR  (OPTIONAL ARGUMENT)
;
;			WHERE	CHNO IS THE SOFTWARE CHANNEL NO.
;				BUFFHD IS THE ADDR. OF THE BUFFER HEADER
;				ADDR IS THE ADDRESS TO BE TRANSFERRED TO
;				    IF EOF OR EOT WAS ENCOUNTERED
;
;		AC  CONTAINS THE CHARACTER TO BE 
;			    DEPOSITED IN THE BUFFER (PUTCHR) OR
;			    IS RETURN CONTAINING THE CHARACTER
;			    THAT WAS FETCHED FROM THE BUFFER.



EOF==20000			;END OF FILE FLAG
EOT==2000			;END OF TAPE FLAG
	IFNDEF PURE,<PURE==1>	;FOR NON-REENTRANT. VERS. PURE=0
	IFN PURE, <HISEG>
	ENTRY	GETCHR
GETCHR:	PUSH	P,TAC		;SAVE CONTENTS OF TAC
	PUSH	P,XR1		;SAVE CONTENTS OF XR1
	MOVE	XR1,0(17)	;GET ADDRESS OF BUFFER HEADER
GETCNT:	SOSG	2(XR1)		;DECREMENT THE BYTE COUNT
	JRST	GETBUF		;BUFFER IS EMPTY (OR FIRST CALL AFTER
				;INIT
GETNXT:	ILDB	AC,1(XR1)	;GET NEXT CHARACTER FROM BUFFER
RET:	POP	P,XR1		;RESTORE CONTENTS OF XR1
	POP	P,TAC		;RESTORE CONTENTS OF TAC
	JRST	2(17)		;RETURN TO CALLER

GETBUF:	MOVSI	TAC,740		;SET UP MASK FOR CHANNEL NO.
	AND	TAC,0(17)	;LOAD CHANNEL NO.
	TLO	TAC,056000	;LOAD IN "IN" OP CODE
	XCT	TAC		;CALL MONITOR TO REFILL THIS BUFFER
	JRST	GETNXT		;RETURN HERE WHEN NEXT BUFFER IS FULL
				;PROBABLY IMMEDIATELY
	TLC	TAC,037000	;SET UP "STATO" OP CODE
	TRO	TAC,EOF		;SET UP ERROR MASK
	XCT	TAC		;CHECK FOUR ERROR BITS FIRST
	SOJA	17,RET		;ERROR ON INPUT - GIVE NON SKIP
	LDB	TAC,PCODE	;GET OP CODE OF POSSIBLE EOF RETURN
	CAIE	TAC,320		;IS AN EOF RETURN SPECIFIED?
	JRST	RET		;NO - GIVE NORMAL RETURN
	HRRZ	17,2(17)	;YES - GET ADDRESS OF RETURN
	MOVEI	17,-2(17)	;DIDDLE IT
	JRST	RET		;RETURN TO CALLER
	ENTRY	PUTCHR
PUTCHR:	PUSH	P,TAC		;SAVE CONTENTS OF TAC
	PUSH	P,XR1		;SAVE CONTENTS OF XR1
	MOVE	XR1,0(17)	;GET ADDRESS OF BUFFER HEADER
	SOSG	2(XR1)		;DECREMENT BYTE COUNT
	JRST	PUTBUF		;NO MORE ROOM OR FIRST CALL AFTER INIT
PUTNXT:	IDPB	AC,1(XR1)	;STORE THIS CHARACTER
	JRST	RET		;RETURN TO CALLER
PUTBUF:	MOVSI	TAC,740		;SET UP MASK FOR CHANNEL NO.
	AND	TAC,0(17)	;LOAD CHANNEL NO.
	TLO	TAC,057000	;LOAD IN "OUT" OP CODE
	XCT	TAC		;CALL MONITOR TO EMPTY THIS BUFFER
	JRST	PUTNXT		;RETURN HERE WHEN NEXT BUFFER IS 
				;EMPTY
	TLC	TAC,036000	;SET UP "STATO" OP CODE
	TRO	TAC,EOT		;CHECK FOR END-OF-TAPE
	XCT	TAC
	SOJA	17,RET		;NOT EOT - GIVE ERROR RETURN
	LDB	TAC,PCODE	;GET OP CODE OF POSSIBLE EOF RETURN
	CAIE	TAC,320		;WAS EOT RETURN ADDRESS GIVEN?
	JRST	RET		;NO - GIVE NORMAL RETURN
	HRRZ	17,2(17)	;YES - GET ADDRESS SPECIFIED
	MOVEI	17,-2(17)	;DIDDLE IT
	JRST	RET		;GO TO EOF RETURN
PCODE:	POINT	9,2(17),8	;BYTE POINTER FOR OP CODE

	END