.TITLE	BAPROT
	.IDENT	/V3.08/
	.ENABL	LC
	.NLIST	BEX

;**************************************************************************
;
;	BAPROT.MAC
;
;	This module is the root segment of the batch processor task for
;	Version 3 of the Batch System.
;
;	This batch system assumes a certain minimum amount of support in
;	the Executive. In order for the system as a whole to work, the
;	following support must be SYSGENed into the exec:
;
;	1. RSX-11M V4.0	or V4.1 (will not run on V3.2 and earlier)
;
;	2. M$$MGE	Memory management hardware.
;
;	3. A$$BIO	Asynchronous buffered I/O (always included if
;			the full duplex terminal driver is present).
;
;	4. D$$YNM	Dynamic memory allocation.
;
;	5. P$$OFF	Parent/Offspring tasking.
;
;	6. S$$TOP	Stop-bit support.
;
;	7. M$$MUP	Multi-user support.
;
;	8. L$$DRV	Loadable driver support (this driver can be
;			built as resident if you desire by commenting
;			out the definition of the symbol LD$BS in the
;			file BSTAB.MAC).
;
;	9. C$$SMT	Cancel selective marktimes support.
;
;--------------------------------------------------------------------------
;
;		I M P O R T A N T
;		=================
;
;	If a job is executing, it is VERY important that all FCS-related
;	operations at non-AST state be done with AST recognition disabled.
;	This is because this program does FCS operations at AST level.
;
;--------------------------------------------------------------------------
;
; Version:	V3.08		(V3.00 April 1983)
;
;	Modification History:
;	====================
;
;	SMT301	31-MAY-83	Steve Thompson
;				Update version number due to BAPEOJ
;				edit.
;
;	SMT302	 1-JUN-83	Steve Thompson
;				Update version number due to BAPMSG
;				edit.
;
;	SMT303	16-JUL-83	Steve Thompson
;				Added support for close/reopen of log and
;				history files every 15 minutes instead of
;				the previous .FLUSH mechanism (to prevent
;				data loss in the event of a system crash)
;
;	SMT304	16-JUL-83	Steve Thompson
;				Extended command buffer to 132 bytes (for
;				use by long data lines)
;
;	SMT306	29-JUL-83	Steve Thompson
;				Add *WRITE control card
;
;	SMT308	25-SEP-83	Steve Thompson
;				Update to version V3.08
;
;--------------------------------------------------------------------------
;
;	Steve Thompson
;	School of Chemical Engineering
;	Olin Hall
;	Cornell University
;	Ithaca
;	NY 14850
;	(607) 256 4616 (office)
;	(607) 256 3895 (computer room)
;
;**************************************************************************

	.MCALL	DIR$,   RCVD$,  STSE$,  CLEF$,  USTP$,  USTP$S,	GTIM$
	.MCALL	SDAT$,  SPWN$,  SETF$S, QIO$,	QIOW$
	.MCALL	DSAR$S,	ENAR$S, ASTX$S,	WSIG$S
	.MCALL	MRKT$,	CMKT$
	.MCALL	FDBDF$, FDAT$A, FDRC$A, FDOP$A, FSRSZ$
	.MCALL	NMBLK$,	OPEN$A,	CLOSE$
	.MCALL	GET$,	PUT$

;
; The next three macros are defined in the batch system pre-assembly
; file, BV3PRE.MAC.
;

	BV3DV$	<:>			; Define batch device name
	SOJDF$	<:>,<=>			; Define start-of-job packet offsets
	SOFDF$	<:>,<=>			; Define start-of-file packet offsets

;
; The next two macros are accounting-specific, and are defined in the
; accounting pre-assembly file ACCPRE.MAC.
;

	.IF	DF,B3$ACC

	ACCDF$	<:>,<=>			; Define accounting offsets
	BITDF$	<:>,<=>			; Define accounting bitmasks

	.ENDC	; DF,B3$ACC

BPROT	=	0			; To list pre-assembly file

	.IIF	NDF,M$$MGE, .ERROR	; M$$MGE SUPPORT NOT PRESENT
	.IIF	NDF,A$$BIO, .ERROR	; A$$BIO SUPPORT NOT PRESENT
	.IIF	NDF,D$$YNM, .ERROR	; D$$YNM SUPPORT NOT PRESENT
	.IIF	NDF,P$$OFF, .ERROR	; P$$OFF SUPPORT NOT PRESENT
	.IIF	NDF,S$$TOP, .ERROR	; S$$TOP SUPPORT NOT PRESENT
	.IIF	NDF,M$$MUP, .ERROR	; M$$MUP SUPPORT NOT PRESENT
	.IIF	NDF,L$$DRV, .ERROR	; L$$DRV SUPPORT NOT PRESENT
	.IIF	NDF,C$$SMT, .ERROR	; C$$SMT SUPPORT NOT PRESENT

;
; Logical unit and event flag assignments.
;

LOGLUN	==	1			; Logfile unit
HSTLUN	==	2			; History file unit
CMDLUN	==	3			; Command file unit
VTLUN	==	4			; Virtual terminal unit
COLUN	==	5			; Console terminal unit
MSGLUN	==	6			; Job Start/End message LUN

LOGEFN	==	1			; Event flag, logfile I/O
HSTEFN	==	2			; Event flag, history file I/O
CMDEFN	==	3			; Event flag, command file I/O
VTEFN	==	4			; Event flag, VT: I/O
COEFN	==	5			; Event flag, CO: I/O
RCVEFN	==	6			; Event flag for receive data AST
CLIEFN	==	7			; Event flag for CLI synchronization
EFNMSG	==	8.			; Job Start/End message LUN
TIMEFN	==	9.			; Timer event flag
SAVEFN	==	10.			; File flush event flag
NLGEFN	==	11.			; Login enable wait flag

;
; Other assignments.
;

HSTSIZ	==	132.			; Size of history file buffer
LOGSIZ	==	200.			; Size of logfile buffer
CMDSIZ	==	132.			; Size of command input buffer

;
; Text messages.
;

TTL:	.ASCII	/1/<LF><CR>/School of Chemical Engineering/
	.ASCII	<HT><HT>/Batch System V3.08/<HT>
TTLTIM:	.ASCII	/HH:MM:SS  /
TTLDAT:	.ASCII	/DD-MMM-YY/
	.ASCII	<HT><HT><HT>/Page /
TTLPAG:	.ASCII	/    /<LF>

;
; Buffer allocations.
;

HSTBUF::.BLKB	HSTSIZ			; History file buffer
LOGBUF::.BLKB	LOGSIZ+1		; Logfile buffer (plus null byte)
CMDBUF::.BLKB	CMDSIZ			; Command input buffer

;
; Global variables.
;

	.EVEN

QMGNAM::.RAD50	/QMG.../		; Name of Queue Manager Task
RCVBUF::.BLKW	15.			; Receive buffer
SOJBUF::.BLKW	13.			; Start of job information buffer
FILBUF::.BLKW	13.			; Process file command buffer
SNDBUF::.BLKW	13.			; Send to QMG... buffer
EXSBLK::.BLKW	8.			; Exit status block
EXSEQ::	.WORD	1			; *EXSTAT = flag
	.WORD	EX$SUC			; *EXSTAT = value
EXSGT::	.WORD	0			; *EXSTAT > flag
	.WORD	0			; *EXSTAT > value
EXSLT::	.WORD	0			; *EXSTAT < flag
	.WORD	0			; *EXSTAT < value
TIMBUF::.BLKW	8.			; Time parameters buffer
EXSTAT::.WORD	EX$SUC			; BAP's exit status
JOBUIC::.WORD	0			; UIC of current job (binary)
VTUCB::	.WORD	0			; Batch stream UCB address
UNIT::	.WORD	0			; Batch stream unit number
ORIGIN::.WORD	0			; Radix-50 history file origin code
BINUFD::.WORD	0			; Binary log and history file UFD
LOGCNT::.WORD	0			; Logfile line count
HSTCNT::.WORD	0			; History file line count
					; (These last two are reset each time
					; the close/reopen cycle completes)
DUMFNB::NMBLK$				; Dummy filename block for use by
					; the FSAVE routine
VTSTAT::.WORD	0,0			; VT read I/O status block

	.IF	DF,B3$TIM

TIMLIM::.WORD	0			; Current time limit from *JOB card
TIMERR::.BYTE	0			; Time limit flag (1=limit exceeded)
	.BYTE	0			; Unused (yet)

	.ENDC	; DF,B3$TIM

	.IF	DF,B3$MEM

MEMLIM::.WORD	0			; Memory requirement from *JOB

	.ENDC	; DF,B3$MEM

	.IF	DF,B3$PAG

LINE::	.WORD	0			; Line counter (current page)
PAGE::	.WORD	0			; Page counter
PAGLIM::.WORD	0			; Page limit from *JOB card
PAGERR::.BYTE	0			; Page limit flag (1=exceeded)
PAGFLG::.BYTE	0			; Page limit check on (1=yes)

	.ENDC	; DF,B3$PAG

	.IF	DF,B3$ACC

CPUTIM::.WORD	0,0			; CPU used so far
TIMTIK::.WORD	0,0			; Time limit in ticks
CPUSOF::.WORD	0,0			; CPU used at start of sub-job
LOGPTR::.WORD	0			; LOG...'s TCB address
PKTADR::.WORD	0			; Pool block address
ACLIST::.WORD	0			; Accounting listhead address
LOGNAM::.RAD50	/LOG.../		; Accounting logging task name
CPUFLG::.BYTE	0			; CPU messages in history file (1=yes)

	.ENDC	; DF,B3$ACC

JOBNAM::.BLKB	9.			; ASCII name of current job
FILNAM::.BLKB	36.			; ASCII current file name
TSKNAM::.BLKB	6.			; Current task name (BAPnn)
RCVFLG::.BYTE	0			; Receive data flag
WAIFLG::.BYTE	0			; Waiting for receive packet (1=yes)
LOGOPN::.BYTE	0			; Logfile open flag (1=yes)
HSTOPN::.BYTE	0			; History file open flag (1=yes)
CMDFLG::.BYTE	0			; Command is in buffer (1=yes)
EODFLG::.BYTE	0			; Must send IE.EOF on read (1=yes)
ERRFLG::.BYTE	0			; Error flag
MCRERR::.BYTE	0			; MCR (spawn) error flag
JOBFLG::.BYTE	0			; Job executing (0=no)
ABOFLG::.BYTE	0			; Requested abort flag (1=yes)
ECHFLG::.BYTE	0			; *ECHO flag (1=*ECHO)
QUIFLG::.BYTE	0			; *QUIET flag (1=*NOISY)
PAUFLG::.BYTE	0			; *PAUSE flag (1=in pause state)
NBRFLG::.BYTE	0			; *NUMBER flag (1=numbering on)

	.EVEN

	.PAGE
	.SBTTL	DIRECTIVE PARAMETER BLOCKS

;
; Directive parameter blocks.
;

STPRCV::STSE$	RCVEFN			; Stop for receive data DPB
RCVD::	RCVD$	QMG...,RCVBUF		; Receive data DPB
SNDQMG::SDAT$	QMG...,SNDBUF		; Send to QMG... DPB
CLFRCV::CLEF$	RCVEFN			; Clear receive data event flag DPB

	.IF	DF,A$$CLI

SPWDPB::SPWN$	CLI...,,,1,2,CLIEFN,,EXSBLK,CMDBUF,0,0,BATDEV	; Spawn DPB

	.IFF

SPWDPB::SPWN$	MCR...,,,1,2,CLIEFN,,EXSBLK,CMDBUF,0,0,BATDEV	; Spawn DPB

	.ENDC	; DF,A$$CLI

STPSPW::STSE$	CLIEFN			; Stop for spawn command
GETTIM::GTIM$	TIMBUF			; Get time parameters
USTQMG::USTP$	QMG...			; Unstop Queue Manager DPB
COWRIT::QIOW$	IO.WVB,COLUN,COEFN,,,,<0,0,40> ; Write to CO: DPB

	.IF	DF,B3$MSG

USWRIT::QIOW$	IO.WBT,MSGLUN,EFNMSG,,,,<0,0,40> ; Send message to user

	.ENDC	; DF,B3$MSG

VTINP:	QIO$	IO.RLB,VTLUN,VTEFN,,VTSTAT,VTRAST,<LOGBUF,LOGSIZ> ; Read
VTKILL::QIOW$	IO.KIL,VTLUN,VTEFN	; Kill I/O to driver

	.IF	DF,B3$TIM

TIMON::	MRKT$	TIMEFN,,2,TIMAST	; Mark time for timer service
					; (magnitude is inserted during
					; execution - value is seconds)
TIMOFF::CMKT$	TIMEFN,TIMAST		; Cancel timer

	.ENDC	; DF,B3$TIM

SAVON::	MRKT$	SAVEFN,15.,3,SAVAST	; Mark time for file flushes
SAVOFF::CMKT$	SAVEFN,SAVAST		; Cancel flush requests

	.PAGE
	.SBTTL	FILE RELATED STORAGE

LGFINI	=	-10.			; Initial size for logfile
LGFEXT	=	-10.			; Extend size for logfile

HSFINI	=	-5			; Initial size for history file
HSFEXT	=	-5			; Extend size for history file

;
; File Descriptor Block definitions.
;

LOGFDB::FDBDF$				; Logfile file descriptor block
	FDAT$A	R.VAR,FD.FTN,,LGFINI,LGFEXT
	FDRC$A	,LOGBUF,LOGSIZ		;
	FDOP$A	LOGLUN,,,FO.WRT		;

HSTFDB::FDBDF$				; History file file descriptor block
	FDAT$A	R.VAR,FD.CR,,HSFINI,HSFEXT
	FDRC$A	,HSTBUF,HSTSIZ		;
	FDOP$A	HSTLUN,,,FO.WRT		;

CMDFDB::FDBDF$				; Command file file descriptor block
	FDRC$A	,CMDBUF,CMDSIZ		;
	FDOP$A	CMDLUN,,,FO.RD		;

;
; Specify default (system) directory for log and history files. This can
; be patched (using GBLPAT) at link time.
;

	.PSECT	DEFDIR
$DNAM::	.WORD	"LB			; Default log file device name
$DEVU::	.WORD	0			; Default log file device unit number
$DUFD::	.ASCII	/[001,071]/		; This string gives the directory
					; into which the log file will be
					; written.
$DIRSZ==.-$DUFD
.=.+1					; (UFD string must have an even number
					; of characters for GBLPAT)
	.PSECT

	FSRSZ$	3			; Three files for record I/O
	.PAGE
	.SBTTL	MAIN LINE CODE


;+
; **-$BAPEP-Transfer point for BAP.TSK
;
;	This entry point is entered when the task is activated by means
;	of a QUE BAPn:/BATCH command.
;
;-

	.ENABLE	LSB

$BAPEP:	CALL	$INIEP			; Perform initialization functions
	BCS	302$			; If CS, error, so exit
	ENAR$S				; Enable AST recognition

;
; Stop and wait for a receive data AST to wake us up.
;

100$:	DIR$	#STPRCV			; Wait for data to be sent
	TSTB	RCVFLG			; Did we get any data?
	BEQ	100$			; If EQ no

;
; Now we have data; get the packet from the receive queue.
;

200$:	DSAR$S				; Disable AST recognition
	DIR$	#CLFRCV			; Clear receive data event flag
	CLRB	RCVFLG			; Show no data packets waiting
	DIR$	#RCVD			; Get the packet
	BCC	220$			; If CC good
	ENAR$S				; Enable AST recognition
	BR	100$			; Sleep
220$:	ENAR$S				; Enable AST recognition

;
; Dispatch on function code from Queue Manager.
;

	MOVB	RCVBUF+4,R0		; Get function code
	CMPB	R0,#QP.SOJ		; Start of job?
	BNE	300$			; If NE no
	CALL	$SOJEP			; Yes, process it
	TSTB	ERRFLG			; Any errors?
	BNE	322$			; If NE yes, end the job now
	BR	200$			;

300$:	CMPB	R0,#QP.EXT		; Exit request?
	BNE	310$			; If NE no
302$:	CALL	$EXTEP			; Yes, exit
	BR	200$			;

310$:	CMPB	R0,#QP.FIL		; Sub-job (file) request?
	BNE	320$			; If NE no
	CLRB	ERRFLG			; Reset error flag
	CLRB	WAIFLG			; Show not expecting a packet
	CALL	$FILEP			; Start next sub-job
	MOVB	SP,WAIFLG		; Expecting a packet
	TSTB	ERRFLG			; Any errors?
	BNE	321$			; If NE yes, end the job
	BR	200$			; Else continue

320$:	CMPB	R0,#QP.EOJ		; End of job request?
	BNE	330$			; If NE no
321$:	CLRB	ERRFLG			; This is a normal job end (flag
					; is reset if job has logged on OK)
322$:	CALL	$EOJEP			; Yes, process end of job
	BR	200$			;

330$:	CMPB	R0,#QP.STP		; Stop request?
	BNE	340$			; If NE no
	CALL	$STPEP			; Yes, hold it for a while
	BR	200$			;

340$:	CMPB	R0,#QP.CON		; Continue request?
	BNE	350$			; If NE no
	CALL	$CONEP			; Yes, get going again
	BR	200$			;

350$:					; Ref. label

;
; Ignore all other functions.
;

	BR	200$			;

	.DSABL	LSB

	.PAGE
	.SBTTL	AST SERVICE ROUTINES


;+
; **-RCVAST-Service Receive Data AST.
;
;	This routine is entered as a result of an AST caused by someone
;	doing a SEND DATA to us. If we were expecting a packet, the
;	receive data event flag is set since we may be waiting for it.
;	If we were not expecting a packet, then it has to be processed
;	in this routine. In this case, the function code may be:
;
;	(1) QP.EOJ	Abort current job now
;	(2) QP.STP	Stop current job now
;	(3) QP.CON	Continue current job now
;
;-

RCVAST::TSTB	WAIFLG			; Waiting for a packet?
	BEQ	20$			; If EQ no
10$:	SETF$S	#RCVEFN			; Yes, set receive data event flag
	INCB	RCVFLG			; Show data received
	BR	50$			; That's all
20$:	TSTB	JOBFLG			; Is a job executing?
	BEQ	10$			; If EQ no
	DIR$	#RCVD			; Get the packet
	BCS	50$			;
	CMPB	RCVBUF+4,#QP.EOJ	; Request to abort job now?
	BNE	30$			; If NE no
	CALL	ABORT			; Yes, abort the job
	MOVB	SP,ABOFLG		; Set flag to say what happened
	BR	42$			; Make sure we aren't paused
30$:	CMPB	RCVBUF+4,#QP.STP	; Stop job now?
	BNE	40$			; If NE no
	CALL	$STPEP			; Yes, do it
	BR	42$			; Make sure we aren't paused
40$:	CMPB	RCVBUF+4,#QP.CON	; Continue stopped job?
	BNE	50$			; If NE no, ignore packet
	TSTB	PAUFLG			; Are we paused?
	BEQ	44$			; If EQ no
42$:	CLRB	PAUFLG			; Yes, clear pause flag
	USTP$S				; Wake us up
	BR	50$			;
44$:	CALL	$CONEP			; Continue the job
50$:	ASTX$S				; Exit AST routine


;+
; **-VTRAST-AST routine to service VT read completion.
;
;	This routine is entered as the result of an AST caused by the
;	batch driver finishing a read that we had posted earlier. If the
;	virtual terminal driver returned a status of IE.DAO, a task in
;	the batch stream wants to read from the command file. This is
;	serviced in the JOBRLB routine. If a succes status is returned,
;	the buffer returned (LOGBUF) is formatted as follows:
;
;	+-------------+----------+----------------------+
;	| Byte 1      | Byte 2   | Bytes 3,4,5....      |
;	| Destination | Carriage | Data                 |
;	| Code        | Control  |                      |
;	+-------------+----------+----------------------+
;
;	The byte count returned in the I/O status block includes
;	both the leading bytes.
;
;-

VTRAST:	MOV	R2,(SP)			; Save R2 (overwrite trap parameter)
	CMPB	VTSTAT,#IE.DAO		; Task trying to read?
	BNE	5$			; If NE no
	CALL	JOBRLB			; Yes, service task read
	BR	40$			; and continue as normal
5$:	CMPB	VTSTAT,#IS.SUC		; Read successful?
	BNE	40$			; If NE no, try again
	MOVB	LOGBUF,R2		; Get destination byte
	BEQ	30$			; If EQ, just put in logfile
	BITB	#MD$HST,R2		; Message meant for history file?
	BEQ	20$			; If EQ no
	MOV	#^RSYS,ORIGIN		; Yes, assume SYS-class message
	BITB	#MD$SYS,R2		; Was it SYS-class?
	BNE	10$			; If NE yes
	MOV	#^RUSR,ORIGIN		; No, must be USR-class then
10$:	MOV	R1,-(SP)		; Save R1
	MOV	VTSTAT+2,R1		; Get byte count
	CLRB	LOGBUF(R1)		; Make message ASCIZ
	MOV	#LOGBUF+2,R1		; Get message address for WRHIST
	CALL	WRHIST			; Write message to history file
	MOV	(SP)+,R1		; Restore R1
20$:	BITB	#MD$LOG,R2		; Message meant for logfile also?
	BEQ	40$			; If EQ no
30$:	CALL	WRLOGF			; Yes, write to logfile
40$:	CALL	VTREAD			; Issue another read
	MOV	(SP)+,R2		; Clean stack and restore R2
	ASTX$S				; Exit AST routine


;+
; **-JOBRLB-Service read from batch task.
;
;	This routine is called at AST level when the virtual terminal
;	driver has notified us that a task in the batch stream wants
;	to read some data from the command file. The I/O packet address
;	is in VTSTAT+2. The driver has already verified that it is
;	legal for this read operation to take place.
;	The next line is read from the command file. If it is a control
;	card or CLI command line, the task has exhausted the data that
;	was supplied in the command file and end-of-file must be sent.
;	In this case, the flag CMDFLG is set to inform the CLI command
;	dispatching code that a CLI command or control card is already
;	in the command buffer, and a GET$ operation is not necessary.
;	Otherwise, the data is copied to the task's buffer, and is
;	also echoed in the logfile (if the function was not IO.RNE).
;
;	R2 may be used by this routine. All other registers must be
;	saved.
;
;-

JOBRLB:	MOV	R0,-(SP)		; Save R0
	TSTB	EODFLG			; Need to send end-of-file?
	BNE	90$			; If NE yes, no data left
	GET$	#CMDFDB,#<LOGBUF+2>,#<LOGSIZ-2> ; Read line from file
	BCS	80$			; If CS, none there
	CMPB	LOGBUF+2,#'*		; Did we read a control card?
	BEQ	70$			; If EQ yes, send IE.EOF
	CMPB	LOGBUF+2,#'$		; No, was it a CLI command?
	BEQ	70$			; If EQ yes, send IE.EOF

;
; Echo line in logfile.
;

	TSTB	LOGOPN			; Any logfile?
	BEQ	10$			; If EQ no, can't echo
	TSTB	ECHFLG			; *NOECHO in effect?
	BEQ	10$			; If EQ yes, don't echo
	MOV	VTSTAT+2,R2		; Get I/O packet address
	CMPB	I.FCN(R2),#TF.RNE	; Read with no echo?
	BEQ	10$			; If EQ yes, don't echo then
	MOV	R2,-(SP)		; Save I/O packet address
	CLRB	LOGBUF+1		; Set carriage control
	MOV	CMDFDB+F.NRBD,R2	; Get length of line read
	ADD	#4,R2			; Include carriage control and a
					; non-existant destination byte
					; (which LOGFIL removes from the
					; count) and the <CR><LF> terminators
	MOVB	#CR,LOGBUF-2(R2)	; Add <CR><LF> at end
	MOVB	#LF,LOGBUF-1(R2)	;
	MOV	R2,VTSTAT+2		; Save count for WRLOGF
	CALL	WRLOGF			; Echo line in logfile
	MOV	(SP)+,VTSTAT+2		; Restore I/O packet address
10$:					; Ref. label

;
; Perform the data transfer and terminate the request.
;

	CALL	$SWSTK,92$		; Switch stacks
	MOV	#LOGBUF+2,R2		;; Get address of data
	MOV	VTSTAT+2,R3		;; Get I/O packet address
	MOV	CMDFDB+F.NRBD,R4	;; Get length of data line
	CMP	I.PRM+4(R3),R4		;; Reader want less than this?
	BGE	20$			;; If GE no
	MOV	I.PRM+4(R3),R4		;; Yes, set the byte count
20$:	MOV	R4,-(SP)		;; Save the byte count
	BEQ	40$			;; If EQ, null line
	MOV	I.UCB(R3),R5		;; Get UCB address (same as VTUCB)
	MOV	I.PRM(R3),U.BUF(R5)	;; Set up UCB for $PTBYT
	MOV	I.PRM+2(R3),U.BUF+2(R5)	;;
30$:	MOVB	(R2)+,-(SP)		;; Put next byte on the stack
	CALL	$PTBYT			;; Transfer to reader's buffer
	DEC	R4			;; Any more to transfer?
	BGT	30$			;; If GT yes, loop
40$:	MOV	#IS.CR,R0		;; Set <CR> as terminator
	MOV	(SP)+,R1		;; Get byte count
	CALLR	$IOFIN			;; Terminate the request, and go
					;; back to user state

;
; Come here when a non-data line has been read. The command flag is set
; and the data is transferred to the command buffer.
;

70$:	INCB	CMDFLG			; Set command flag
	MOV	CMDFDB+F.NRBD,R2	; Get length of line
	CMP	R2,#CMDSIZ		; Too big for command buffer?
	BLE	72$			; If LE no
	MOV	#CMDSIZ,R2		; Yes, trim it to fit
72$:	MOV	R1,-(SP)		; Save R1
	MOV	#CMDBUF,R0		; Get command buffer address
	MOV	#LOGBUF+2,R1		; Get address of this line
74$:	MOVB	(R1)+,(R0)+		; Move a byte
	DEC	R2			; Done yet?
	BGT	74$			; If GT no, loop
	CLRB	(R0)			; Make command ASCIZ
	MOV	(SP)+,R1		; Restore R1

;
; Come here when we know that there will be no more data for the current
; task to read.
;

80$:	INCB	EODFLG			; Set no-more-data flag

;
; Come here to terminate the read request with IE.EOF
;

90$:	CALL	$SWSTK,92$		; Switch stacks
	MOV	VTSTAT+2,R3		;; Get I/O packet address
	MOV	I.UCB(R3),R5		;; Get UCB address
	MOV	#IE.EOF&377,R0		;; Set end-of-file code
	CLR	R1			;; No bytes transferred
	CALLR	$IOFIN			;; Terminate the request
92$:	MOV	(SP)+,R0		; Restore R0
	RETURN				; Return to caller


;+
; **-SAVAST-File flush routine
;
;	This routine is entered every 15 minutes while a job is running.
;	The log and history files are closed and then re-opened with
;	append, so that the correct file owner word gets written and
;	a minimum amount of data is lost in the event of a system crash.
;
;	The stack is cleaned. All registers must be preserved (this
;	routine executes at AST level).
;
;-

SAVAST:	MOV	R0,(SP)			; Save R0 and overwrite event flag
	MOV	R1,-(SP)		; Save R1
	MOV	R2,-(SP)		; Save R2
	MOV	R3,-(SP)		; Save R3
	MOV	JOBUIC,R1		; Get job UIC
	CALL	.WFOWN			; Write file owner word
	TSTB	LOGOPN			; Logfile open?
	BEQ	10$			; If EQ no
	TST	LOGCNT			; Anything written since last save?
	BEQ	10$			; If EQ no, no need to do it
	MOV	#LOGFDB,R0		; Get logfile FDB address
	CALL	FSAVE			; Do close/reopen
	CLR	LOGCNT			; Reset line counter
10$:	TSTB	HSTOPN			; History file open?
	BEQ	20$			; If EQ no
	TST	HSTCNT			; Anything written since last save?
	BEQ	20$			; If EQ no, no need to do it
	MOV	#HSTFDB,R0		; Get history file FDB address
	CALL	FSAVE			; Do close/reopen
	CLR	HSTCNT			; Reset line counter
20$:	MOV	(SP)+,R3		; Restore R3
	MOV	(SP)+,R2		; Restore R2
	MOV	(SP)+,R1		; Restore R1
	MOV	(SP)+,R0		; Restore R0
	DIR$	#SAVON			; Propagate cycle
	ASTX$S				; Exit AST routine

;+
; **-FSAVE-Do file close/reopen
;
;	This routine is called every so often to close a file (log or
;	history) and then to re-open with append access. The filename
;	block must be saved for this to work.
;
;	Inputs:
;		R0	File FDB address
;
;	Registers R1,R2 and R3 may be used.
;
;-

FSAVE:	MOV	R0,R1			; Copy FDB address
	ADD	#F.FNB,R1		; Point to filename block
	MOV	#DUMFNB,R2		; Get address of dummy filename block
	MOV	#S.FNBW,R3		; Set size of FNB in words
10$:	MOV	(R1)+,(R2)+		; Move a word
	DEC	R3			; Done yet?
	BGT	10$			; If GT no, loop
	CLOSE$	R0			; Close file
	MOV	#S.FNBW,R3		; Set size of FNB again
20$:	MOV	-(R2),-(R1)		; Move a word back
	DEC	R3			; Done yet?
	BGT	20$			; If GT no, loop
	OPEN$A	R0			; Now re-open with append access
	RETURN				; Return to SAVAST
	.PAGE
	.SBTTL	TIMER ROUTINES


;+
; **-SETTIM-Set Job Timer.
;
;	This routine is called to set up the mark time that is used to
;	enforce the time limit on the job.
;
;	Inputs:
;		R2	Time to next check (seconds)
;
;	Outputs:
;		New timer is set
;		All registers preserved
;
;-

	.IF	DF,B3$TIM

SETTIM::DIR$	#TIMOFF			; Make sure any previous timer is off
	MOV	R2,TIMON+M.KTMG		; Set limit in DPB
	DIR$	#TIMON			; Set the timer
	RETURN				; Return to caller

	.ENDC	; DF,B3$TIM


;+
; **-TIMAST-Service timer AST.
;
;	This routine is called at AST level when the current timer
;	interval expires. A new interval is established, or the job
;	is terminated. Specifically:
;
;	1. If time limit is supported but not accounting, then the
;	   time limit is enforced in terms of elapsed time. Hence
;	   entering this routine implies that the time limit has
;	   expired and the job has not yet ended. It must be aborted
;	   right away.
;
;	2. If time limit is supported and accounting is also supported,
;	   the time limit is enforced in terms of CPU time. Since a
;	   60-minute job cannot possibly exceed its time limit for at
;	   least 60 minutes after it started, the timer interval is
;	   initially set for this interval. When (if) this expires,
;	   we check to find out how much CPU time was used by the
;	   job. Suppose this was 42 minutes for a 60-minute job. Hence
;	   we must start another interval for 18 minutes, and so on
;	   until the job either ends or exceeds the time limit. In
;	   practice, the timer is always set for 15 seconds larger than
;	   the current interval, to avoid a race condition when the job
;	   is very near its time limit.
;
;	The time limit is enforced for each sub-job separately. When
;	a sub-job starts, the time used by any previous sub-jobs in
;	that job is taken into account. CPU time used in logging on
;	the job is not included in the time limit.
;
;-

	.IF	DF,B3$TIM

TIMAST:					;

	.IF	DF,B3$ACC

	MOV	R0,(SP)			; Save R0 (overwrite event flag)
	MOV	R1,-(SP)		; Save R1
	MOV	R2,-(SP)		; Save R2
	CALL	GETCPU			; Find out how much CPU used
	MOV	TIMTIK,R1		; Get time limit in ticks
	MOV	TIMTIK+2,R2		;
	ADD	CPUSOF+2,R2		; Add time to last sub-job start
	ADC	R1			;
	ADD	CPUSOF,R1		;
	SUB	CPUTIM+2,R2		; Subtract time used so far
	SBC	R1			;
	SUB	CPUTIM,R1		;
	BLT	10$			; If LT, time limit exceeded
	MOV	#K$$TPS,R0 		; Get ticks per second
	CALL	$DDIV			; Convert to seconds
	ADD	#15.,R2			; Allow 15 seconds grace
	CALL	SETTIM			; Set timer
	BR	20$			; Cleanup and go away

	.IFF

	TST	(SP)+			; Clean the stack

	.IFTF

10$:	INCB	TIMERR			; Show time limit expired
	CALL	ABORT			; Abort the job

	.IFT

20$:	MOV	(SP)+,R2		; Restore R2
	MOV	(SP)+,R1		; Restore R1
	MOV	(SP)+,R0		; Restore R0

	.IFTF

	ASTX$S				; Exit AST routine

	.ENDC	; DF,B3$ACC

	.ENDC	; DF,B3$TIM
	.PAGE
	.SBTTL	I/O ROUTINES


;+
; **-VTREAD-Issue read to virtual terminal driver.
;
;	This routine issues a QIO without wait to the driver. This read
;	is satisfied whenever a job does some output.
;	This routine is called at both AST and non-AST level.
;
;-

VTREAD::DIR$	#VTINP			; Issue read
	BCC	10$			; If CC good
	CMP	$DSW,#IE.UPN		; Lack of dynamic memory?
	BNE	10$			; If NE no (bad news)
	WSIG$S				; Wait a while
	BR	VTREAD			; Then try again
10$:	RETURN				;

	.PAGE
	.SBTTL	COMMAND ISSUANCE ROUTINE


;+
; **-GIVMCR-Send command to MCR for execution.
; **-GIVCLI-Send command to current CLI for execution.
;
;	These routines send a command to the system for execution, and wait
;	for it to complete. Exit status is returned to BAP.
;	The spawn directive is used to issue the command.
;
;	Inputs:
;		R0	ASCIZ command string address
;
;	Outputs:
;		R0	Used
;		R5	Used
;		Command is executed
;		Exit status block EXSBLK is filled in.
;
;-

	.IF	DF,A$$CLI

GIVMCR::MOV	#^RMCR,SPWDPB+S.PWTN	; Spawn MCR...
	BR	GIVCMD			;
GIVCLI::MOV	#^RCLI,SPWDPB+S.PWTN	; Spawn CLI...

	.IFF

GIVMCR::				; (DPB already contains MCR...)
GIVCLI::				;

	.ENDC	; DF,A$$CLI

GIVCMD:	CLRB	MCRERR			; Assume no error
	MOV	R0,-(SP)		; Save command address
10$:	TSTB	(R0)+			; Look for end of command
	BNE	10$			; If NE not yet, loop
	DEC	R0			; Remove null byte
	SUB	(SP),R0			; Calculate command length
	CMP	R0,#79.			; Command too long?
	BLE	20$			; If LE no
	MOV	#79.,R0			; Yes, trim it
20$:	MOV	#SPWDPB,R5		; Get spawn DPB address
	MOVB	JOBUIC,S.PWUM(R5)	; Set member code
	MOVB	JOBUIC+1,S.PWUG(R5)	; Set group code
	MOV	R0,S.PWCL(R5)		; Set command line length
	MOV	(SP)+,S.PWCA(R5)	; Set command line address
30$:	DIR$	R5			; Issue spawn directive
	BCC	40$			; If CC good
	CMP	$DSW,#IE.UPN		; Insufficient pool?
	BNE	50$			; If NE no, other error
	WSIG$S				; Wait for pool to become available
	BR	30$			; and try again
40$:	DIR$	#STPSPW			; Wait for task to complete (or
					; possibly time or output limit)
	BR	60$			; and return
50$:	INCB	MCRERR			; Set error flag
60$:	RETURN				; Return to caller
	.PAGE
	.SBTTL	JOB ABORT ROUTINE


;+
; **-ABORT-Abort all tasks running in batch stream.
;
;	This routine is called when the Batch Processor wants to stop
;	all activity. The reason may be due to a number of factors,
;	such as the time or output limits being exceeded.
;
;	Inputs:
;		none
;
;	Outputs:
;		All tasks aborted.
;		All registers preserved.
;
;-

ABORT::	CALL	$SWSTK,30$		; Switch stacks
	MOV	$TSKHD,R5		;; Get start of task list (and skip
					;; the loader)
10$:	TST	T.TCBL(R5)		;; Null task TCB?
	BEQ	30$			;; If EQ yes, done
	TST	T.STAT(R5)		;; Task active?
	BMI	20$			;; If MI no, skip it
	CMP	VTUCB,T.UCB(R5) 	;; Task in batch stream?
	BNE	20$			;; If NE no, skip it
	CMP	$MCRPT,R5		;; MCR...?
	BEQ	20$			;; If EQ yes, skip it
	TSTB	T.ST2(R5)		;; Task being aborted?
	BMI	20$			;; If MI yes, leave it alone
	MOV	R5,R1			;; Copy TCB address to R1
	MOV	#S.CABO,R0		;; Set abort code for TKTN
					;; "ABORTED BY DIRECTIVE OR CLI"
	CALL	$ABTSK			;; Abort the task
20$:	MOV	T.TCBL(R5),R5		;; Point to next task in list
	BR	10$			;; Keep going
30$:	RETURN				;; Back to task level and then
					;; to caller.
	.PAGE
	.SBTTL	QUEUE MANAGER INTERFACE


;+
; **-QMGEOJ-Send end of job packet to Queue Manager
; **-QMGFIL-Send end of file packet to Queue Manager
; **-QMGMSG-Send general message to Queue Manager.
;
;	Inputs:
;		R0	Function code and modifier (QMGMSG only)
;
;	Outputs:
;		Message sent to Queue Manager. QMG... is
;		unstopped.
;		R0 is used.
;
;-

QMGEOF::MOV	#<<QM.FIL*400>!QM.DUN>,R0	; Set end-of-file code
	BR	QMGMSG				; Continue in common code
QMGEOJ::MOV	#<<QM.JOB*400>!QM.DUN>,R0	; Set DONE code
QMGMSG::MOV	R0,SNDBUF		; Put function in the send data buffer
10$:	DIR$	#SNDQMG			; Send to Queue Manager
	BCC	30$			; If CC, good
	CMP	$DSW,#IE.UPN		; Lack of dynamic memory?
	BNE	30$			; If NE no
	WSIG$S				; Yes, wait a while
	BR	10$			; Try again
30$:	DIR$	#USTQMG			; Make sure QMG... is not stopped
	RETURN				; Return to caller
	.PAGE
	.SBTTL	FILE WRITE ROUTINES


;+
; **-WRLOGF-Write line to logfile
;
;	This routine is called to write a line of data to the logfile.
;	The data buffer is examined for linefeeds, formfeeds, etc, and
;	the page counter is incremented if necessary.
;
;	Inputs:
;		LOGBUF	contains the record to write, starting at
;			LOGBUF+1 with the carriage control byte.
;
;		VTSTAT+2 contains the byte count, plus 1.
;
;	Outputs:
;		Record written to logfile.
;		All registers preserved.
;
;-

WRLOGF::TSTB	LOGOPN			; Any logfile?
	BEQ	10$			; If EQ no, skip it
	MOV	R0,-(SP)		; Save R0
	MOV	R1,-(SP)		; Save R1
	CALL	SCNLIN			; Count lines (may be LF, FF etc)
	MOV	VTSTAT+2,R1		; Get length of line
	DEC	R1			; Remove destination byte
	PUT$	#LOGFDB,#<LOGBUF+1>,R1	; Write message to logfile
	INC	LOGCNT			; Increment line counter for SAVAST
	MOV	(SP)+,R1		; Restore R1
	MOV	(SP)+,R0		; Restore R0
10$:	RETURN				; Return to caller


;+
; **-SCNLIN-Control pagination of logfiles.
;
;	This routine scans a line about to be written into the logfile
;	and examines it for linefeeds, formfeeds, etc, and updates the
;	line count. If a formfeed is encountered, a new page is started,
;	the page counter is incremented and the line counter is reset.
;	If this line causes the previous page to overflow onto the next
;	page, a new page is started in the same way and a title is
;	written in addition. The carriage control character is examined
;	also.
;
;	Inputs:
;		LOGBUF	Contains line to be written, starting at
;			LOGBUF+2. LOGBUF+1 contains the carriage
;			control character.
;
;	Outputs:
;		Counters are incremented.
;		R0 and R1 are used (any other registers must be saved).
;
;-

SCNLIN:	MOV	#LOGBUF+1,R0		; Point to carriage control
	CMPB	(R0),#'1		; Page eject?
	BNE	10$			; If NE no
	CALL	NEWPAG			; Yes, give a new page
	MOVB	#SPA,(R0)		; Alter carriage control to prevent
					; another page feed
	BR	40$			; Look for LF, FF etc
10$:	CMPB	(R0),#'0		; Double spacing?
	BNE	20$			; If NE no
	INC	LINE			; Yes, count an extra line
	BR	30$			; Go check buffer
20$:	CMPB	(R0),#'+		; Same line as before?
	BEQ	40$			; If EQ yes
	TSTB	(R0)			; No carriage control?
	BEQ	40$			; If EQ that's right
30$:	INC	LINE			; Update line counter
40$:	INC	R0			; Point past carriage control byte

;
; Now examine the output line.
;

	MOV	VTSTAT+2,R1		; Get byte count
	SUB	#2,R1			; Remove carriage control + dest. byte
50$:	CMPB	(R0),#FF		; Formfeed?
	BNE	52$			; If NE no
	CALL	INCPAG			; Yes, increment page counter
	BR	54$			; Continue along line
52$:	CMPB	(R0),#LF		; Linefeed?
	BNE	54$			; If NE no
	INC	LINE			; Yes, increment line counter
54$:	INC	R0			; Increment pointer
	DEC	R1			; Any bytes left?
	BGT	50$			; If GT yes, loop
	CMP	LINE,#$LINPP		; Overflowed to next page?
	BLE	60$			; If LE no
	CALL	NEWPAG			; Yes, print title
60$:	RETURN				; That's it


;+
; **-NEWPAG-Increment page counter and write title.
;
;	This routine increments the page counter and writes a title at
;	the top of the new page.
;
;-

NEWPAG::MOV	R0,-(SP)		; Save R0
	MOV	R1,-(SP)		; Save R1
	CALL	INCPAG			; Update counters
	TSTB	NBRFLG			; Write page title?
	BEQ	10$			; If EQ no, skip it
	MOV	#TTLTIM,R0		; Put time in title
	CALL	TIME			;
	MOV	#TTLDAT,R0		; Put date in title
	CALL	DATE			; (must be after call to TIME)
	MOVB	#SPA,(R0)+		; Just in case only 1 digit in day
	MOV	#TTLPAG,R0		; Get place for page number
	MOV	PAGE,R1			; Get page number
	CLR	R2			; No leading zeroes
	CALL	$CBDMG			; Convert page number to decimal
	MOVB	#LF,(R0)+		; Add a linefeed
	SUB	#TTL,R0			; Calculate length of line
	MOV	R0,R1			; Move it to R1
	PUT$	#LOGFDB,#TTL,R1		; Write new title
	ADD	#2,LINE			; It's two lines
	INC	LOGCNT			; Increment line counter for SAVAST
10$:	MOV	(SP)+,R1		; Restore R1
	MOV	(SP)+,R0		; Restore R0
	RETURN				;


;+
; **-INCPAG-Increment page counter.
;
;	This routine increments the current page counter and resets
;	the line-on-page counter. If the new page count exceeds the
;	page limit for the current file (when output limit support
;	is included), the job will be terminated.
;
;-

INCPAG:	INC	PAGE			; Show a new page
	CLR	LINE			; Start at top of page

	.IF	DF,B3$PAG

	TSTB	PAGFLG			; Page limit check on?
	BEQ	10$			; If EQ no
	CMP	PAGE,PAGLIM		; Too many pages?
	BLE	10$			; If LE no
	INCB	PAGERR			; Set flag for error handler
	CALL	ABORT			; Stop the job
10$:					; Ref. label

	.ENDC	; DF,B3$PAG

	RETURN				; That's it


;+
; **-WRHIST-Write message to history file.
;
;	This routine writes a message to the history file.
;
;	Inputs:
;		R1	ASCIZ message address
;		ORIGIN	Radix-50 origin code
;
;	Outputs:
;		Line is written to history file complete with time
;		of day, CPU time used, and orgin code.
;		All registers are preserved.
;-

WRHIST::CALL	$SAVAL			; Save all registers
	TSTB	HSTOPN			; Any history file?
	BEQ	50$			; If EQ no, skip it
	MOV	R1,-(SP)		; Save message address
	MOV	#HSTBUF,R0		; Get buffer address
	MOVB	#SPA,(R0)+		; Start with a space (to fix up
					; carriage control handling in
					; the event of a crash)
	CALL	TIME			; Fill in time

	.IF DF	B3$ACC

	MOV	#2,R2			; Add two spaces
	TSTB	CPUFLG			; CPU time required?
	BNE	10$			; If NE yes
	MOV	#15.,R2			; No, make it 15 spaces
10$:	MOVB	#SPA,(R0)+		; Insert a space
	DEC	R2			; Done yet?
	BGT	10$			; If GT no, loop
	TSTB	CPUFLG			; CPU time required?
	BEQ	20$			; If EQ no
	CALL	GETCPU			; Find out how much CPU used
	CALL	FMTCPU			; Format CPU usage
	MOVB	#SPA,(R0)		; Add two more spaces
	MOVB	(R0)+,(R0)+		;
20$:					; Ref. label

	.IFF

	MOVB	#SPA,(R0)		; Add three spaces
	MOVB	(R0)+,(R0)		;
	MOVB	(R0)+,(R0)+		;

	.ENDC	; DF B3$ACC

	MOV	ORIGIN,R1		; Get origin code
	CALL	$C5TA			; Convert to ASCII
	MOVB	#SPA,(R0)		; Add two spaces
	MOVB	(R0)+,(R0)+		;
	MOV	#<HSTBUF+HSTSIZ-1>,R2	; Set address of last available byte
	MOV	(SP)+,R1		; Restore message address
30$:	MOVB	(R1)+,R3		; Get next byte of message
	BEQ	40$			; If EQ, end of message
	CMPB	R3,#CR			; Carriage return?
	BEQ	30$			; If EQ yes, ignore it
	CMPB	R3,#LF			; Linefeed?
	BEQ	30$			; If EQ yes, ignore it
	MOVB	R3,(R0)+		; Put in the buffer
	CMP	R0,R2			; Space left in buffer for more?
	BLO	30$			; If LO yes
40$:	SUB	#HSTBUF,R0		; Calculate total length
	MOV	R0,R1			; Copy it
	PUT$	#HSTFDB,#HSTBUF,R1	; Write to history file
	INC	HSTCNT			; Increment line counter for SAVAST
50$:	RETURN				; Return to caller
	.PAGE
	.SBTTL	ACCOUNTING INTERFACE ROUTINES


;+
; **-GETCPU-Obtain CPU time used so far.
;
;	This routine determines the CPU usage by the current job.
;
;	Inputs:
;		none
;
;	Outputs:
;		CPUTIM	CPU used in ticks (2 words)
;		R1	Used
;
;-

	.IF	DF,B3$ACC

GETCPU::CLR	CPUTIM			; Set zero time used (in case of
	CLR	CPUTIM+2		; pool allocation failure)
	CALL	$SWSTK,140$		; Switch stacks
	CLR	PKTADR			;; Zero address of DSR packet
	MOV	#B.LTSF,R1		;; Get length of block to allocate
	CALL	$ALOCB			;; Get a block
	BCS	130$			;; If CS then allocation failure
	MOV	R0,PKTADR		;; Save address of control block
	MOV	#<AC.TSF!AC.CMD>,B.MASK(R0)	;; Set command mask
	MOV	$TKTCB,B.TTCB(R0) 		;; Insert our TCB address
	MOV	#<AC.RUN!AC.STP>,B.TTYP(R0)	;; And request bit mask
	MOV	VTUCB,B.UCB(R0)		;; Set UCB address of target terminal
	MOV	R0,R1			;; Copy packet address to R1
	MOV	LOGPTR,R0		;; Get LOG...'S TCB address
	CALL	$EXRQF			;; Queue packet and start LOG...
	CALLR	$STPCT			;; Stop us until we get a reply
130$:	RETURN				;; Return to user level
140$:	MOV	PKTADR,R1		; Get address of DSR packet
	BEQ	160$			; If EQ no can do
	MOV	B.CSF(R1),CPUTIM	; Save result returned by LOG...
	MOV	B.CSF+2(R1),CPUTIM+2	;
	CALL	$SWSTK,160$		; Switch stacks
	MOV	PKTADR,R0		;; Get packet address
	MOV	#B.LTSF,R1		;; Get length of packet
	CALLR	$DEACB			;; Return to pool
160$:	RETURN				; Return to caller


;+
; **-FMTCPU-Format CPU usage.
;
;	This routine formats the CPU time found in the CPUTIM field in
;	the format HH:MM:SS.SS
;
;	Inputs:
;		R0	Buffer address
;		CPUTIM	High order CPU time (ticks)
;		CPUTIM+2 Low order CPU time
;
;	Outputs:
;		R0	Updated
;		All other registers may be used.
;
;-

FMTCPU:	MOV	R0,R5			; Copy buffer pointer
	MOV	CPUTIM,R1		; Get high order CPU time
	MOV	CPUTIM+2,R2		; Get low order CPU time
	MOV	#K$$TPS,R0	 	; Get ticks per second
	CALL	$DDIV			; Convert to seconds
					; $DDIV leaves result in R1 and R2
					; and remainder in R0.
	MOV	R0,-(SP)		; Push remaining ticks on stack
	MOV	#60.,R0			; Get seconds per minute
	CALL	$DDIV			; Convert to minutes
	MOV	R0,-(SP)		; Push remaining seconds on stack
	MOV	#60.,R0			; Set minutes per hour
	CALL	$DDIV			; Convert to hours
	MOV	R0,-(SP)		; Push remaining minutes on stack

	MOV	R5,R0			; Restore buffer pointer to R0
	MOV	R2,R1			; Move hours to R1 (high order=zero)
	CALL	F2DECC			; Format as HH:

	MOV	(SP)+,R1		; Get number of minutes
	CALL	F2DECC			; Format as MM:

	MOV	(SP)+,R1		; Get number of seconds
	CALL	F2DEC			; Format as SS
	MOVB	#'.,(R0)+		; Insert a period
	MOV	R0,R5			; Save buffer pointer again

	MOV	(SP),R1			; Get ticks
	ASL	R1			; Multiply by five...
	ASL	R1			;
	ADD	(SP)+,R1		;
	INC	R1			; Round up last digit
	MOV	R1,R0			; Divide by three...
	MOV	#3,R1			;
	CALL	$DIV			;
	MOV	R0,R1			; ...to get 1/100th seconds
	MOV	R5,R0			; Restore buffer pointer
	CALLR	F2DEC			; Format as SS and return

	.ENDC	; DF,B3$ACC

	.PAGE
	.SBTTL	MISCELLANEOUS FORMATTING ROUTINES


;+
; **-EXPFNM-Expand file specification.
;
;	This routine is called to expand a file specification into a
;	form suitable for printing.
;
;	Inputs:
;		R0	Buffer address for output
;		R1	File FDB address
;		R3	Binary UFD where file sits
;
;	Outputs:
;		R0	Updated
;		All other registers are used.
;
;-

EXPFNM::ADD	#F.FNB,R1		; Point to filename block
	MOV	R1,R5			; Copy it to R5
	MOVB	N.DVNM(R5),(R0)+	; Insert device name
	MOVB	N.DVNM+1(R5),(R0)+	;
	MOV	N.UNIT(R5),R1		; Get unit number
	CLR	R2			;
	CALL	$CBOMG			; Convert to octal
	MOVB	#':,(R0)+		; Add device/UFD separator
	MOV	R0,R2			; Move buffer pointer to R2
	MOV	#1,R4			; Set flags for [ggg,mmm] UFD format
	CALL	.PPASC			; Convert to ASCII
	MOV	R2,R0			; Restore new buffer pointer
	ADD	#N.FNAM,R5		; Point to filename
	CALL	R50TA			; Convert first word to ASCII
	CALL	R50TA			; Convert second word to ASCII
	CALL	R50TA			; Convert third word to ASCII
	MOVB	#'.,(R0)+		; Insert name/type separator
	CALL	R50TA			; Convert filetype to ASCII
	MOVB	#';,(R0)+		; Insert type/version separator
	MOV	(R5)+,R1		; Get binary version number
	CLR	R2			; No leading zeroes
	CALLR	$CBOMG			; Convert to octal and return


;+
; **-R50TA-Radix-50 to ASCII conversion.
;
;	This routine converts a single Radix-50 word to ASCII and removes
;	all blanks.
;
;	Inputs:
;		R0	Buffer pointer
;		R5	Address of Radix-50 word
;
;	Outputs:
;		R0	Updated
;		R1,R2	Used
;		R5	Input R5+2
;
;-

R50TA::	MOV	(R5)+,R1		; Get Radix-50 word
	BEQ	10$			; If EQ it's all blanks
	CALL	$C5TA			; Convert to ASCII
	SUB	#2,R0			; Backup pointer to second character
	CMPB	(R0),#SPA		; Was it a space?
	BEQ	10$			; If EQ yes, leave pointer where it is
	INC	R0			; No, point to 3rd character
	CMPB	(R0),#SPA		; Was this one a space?
	BEQ	10$			; If EQ yes, leave pointer where it is
	INC	R0			; No, go back to where we started
10$:	RETURN				; Return to caller


;+
; **-F2DEC-Format binary as 2 decimal digits.
; **-F2DECC-As F2DEC but add a colon as well.
;
;	This routine converts a binary number to two decimal digits, with
;	a leading zero if necessary. The number is assumed to be less
;	than 100(10).
;
;	Inputs (both routines):
;		R0	Buffer address
;		R1	Number to convert
;
;-

F2DECC:	CALL	F2DEC			; Do the formatting
	MOVB	#':,(R0)+		; Add a colon
	RETURN				; And return

F2DEC:	CMP	R1,#10.			; Number less than 10?
	BGE	10$			; If GE no
	MOVB	#'0,(R0)+		; Yes, put in leading zero
10$:	CLR	R2			; Set no leading zeroes from $CBDMG
	CALLR	$CBDMG			; Do the conversion and return


;+
; **-TIME-Format current time.
;
;	This routine gets the current time and formats it in the
;	supplied buffer in the form HH:MM:SS.
;
;	Inputs:
;		R0	Buffer pointer
;
;	Outputs:
;		R0	Updated
;		R1	Used
;
;-

TIME::	DIR$	#GETTIM			; Get date and time
	MOV	TIMBUF+G.TIHR,R1	; Get current hour
	CALL	F2DECC			; Format as HH:
	MOV	TIMBUF+G.TIMI,R1	; Get current minute
	CALL	F2DECC			; Format as MM:
	MOV	TIMBUF+G.TISC,R1	; Get current seconds
	CALLR	F2DEC			; Format as SS and return to caller


;+
; **-DATE-Format current date.
;
;	This routine formats the date contained in the time parameters
;	buffer in the format DD-MMM-YY. The current date and time
;	parameters are assumed to be already in TIMBUF.
;
;	Inputs:
;		R0	Buffer pointer
;		TIMBUF	Contains date and time in GTIM$ format.
;
;	Outputs:
;		R0	Updated
;		R1	Used
;
;-

DATE::	MOV	#TIMBUF,R1		; Point to time parameters buffer
	CALLR	$DAT			; Format date

	.END	$BAPEP