Google
 

Trailing-Edge - PDP-10 Archives - BB-H580E-SB_1985 - metio.mac
There are 5 other files named metio.mac in the archive. Click here to see a list.
; UPD ID= 1991 on 7/30/79 at 5:10 PM by M:<MAYBERRY>                    
TITLE	METIO FOR LIBOL V12C
SUBTTL	D. WRIGHT	JAN, 1979

	SEARCH	COPYRT
	SALL

;COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1979, 1985
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE.

;	HAM	26-JUN-79
;	SET VERSION NUMBER TO 2
	SUBTTL	DEFINITIONS

	SEARCH	LBLPRM			;DEFINE PARAMETERS.
	SEARCH	COMUNI
	SEARCH	FTDEFS
	SEARCH	UUOSYM

IFN TOPS20,<SEARCH	MONSYM, MACSYM>
IFE TOPS20,<SEARCH	UUOSYM, MACTEN>
IFN LSTATS,<SEARCH	METUNV>



IFN LSTATS,<
EXTERN	KILL.,RET.1,RET.2,LMETR.	;CBLIO ROUTINES
IFN TOPS20,<
EXTERN	MRTM.E,MRTM.S		;TOPS20 ROUTINES IN CBLIO
>
EXTERN	LIBVR.,LIBSW.		;ALSO DEFINED IN CBLIO

;LOWSEG LOCATIONS, DEFINED IN COMUNI, (LOADED IN LILOWS)

EXTERN	MROPT.,MROPTT,MRNM6,MRNMA, MRTMB.,MBTIM.,MRHDBP,MRHDFL
EXTERN	MRAFFT,MRFKFT,MRTDBP,MRAPN.,MRBLKO,MRBKO.,MRFPGT
EXTERN	MRKILL,MRBNUM,MRPSTM,MRRERN,MRLDBL
IFE TOPS20,	EXTERN	MRCHNN,MRCHCF
IFN TOPS20,	EXTERN	MRJFN,MRLCJF
IFN DBMS6,<	INTERN	MRDBST,MRDBEN,MRDBDM
		EXTERN	MRDDBP
	>

IFN FTLSDR,<			;FOR LSTATS.DIR STUFF
IFN TOPS20,<
	EXTERN	MRLDJF,MRLDNA
>
IFE TOPS20,<
	EXTERN	MRCHLS,MRLLDR,MRLLDV,MRCFNM,MRCFEX
>
	EXTERN	MRLBPC,MRLSZL,MRLFPR
>;END IFN FTLSDR


;ENTRY POINTS

ENTRY	MRLSET		;SETUP TO WRITE LSTATS FILE
ENTRY	MRDMP		;WRITE ONE LSTATS FILE BLOCK IF THERE IS DATA
ENTRY	MRDMPT		;DUMP ALL LSTATS DATA AND FINISH WRITING METER FILE

>;END IFN LSTATS
ENTRY	MROUT.		;LSTATS ROUTINE TO OUTPUT AN LSTATS BLOCK

	HISEG
	.COPYRIGHT		;Put COPYRIGHT statement in .REL file.

	SALL

T0=0
T1=1
T2=2
T3=3
T4=4
T5=5
AC6=6
AC11=11

SUBTTL	METERING STUFF

IFN LSTATS,<

;WORDS IN LSTATS.DIR
.LDBPC==0	;BYTE PTR TO CURRENT FILENAME
.LDNFL==1	;# FILES IN DIRECTORY,,# OF CURRENT FILE
.LDSZL==2	; SIZE LIMIT OF EACH FILE (BLOCKS OR PAGES)
.LDTML==3	;TIME LIMIT (AS DAYS,,1/3 SECS)
.LDFWR==4	;TIME OF FIRST WRITE TO CURRENT FILE
.LDAFN==5	;ASCIZ FILE SPECS

IFN FTLSDR,<
IFE TOPS20,	MR.BFB==^D128+5  ;ONE BUFFER + A FEW EXTRA WORDS
IFN TOPS20,	MR.BFB==^D128+1	;ONE BUFFER AND BLANK WORD AT END
>;END IFN FTLSDR
IFE FTLSDR,	MR.BFB==^D128	;ONE BUFFER EXACTLY

 IFE TOPS20,<

;TOPS10 LSTATS ROUTINE TO GET A FREE CHANNEL
; RETURNS .+1 IF NONE AVAILABLE, ELSE .+2 WITH NUMBER IN RH(T5)

GMCHAN:	SKIPN	T5,OPNCH.##	;ANY CHANNELS AVAIL?
	 POPJ	PP,		;NO
	MOVE	AC6,OPNCBP##	;GET BYTE PTR
	HRRI	T5,1		;START WITH 1
	MOVEI	T2,17		; UPPER LIMIT
GMCHN2:	ILDB	AC11,AC6
	SOJE	AC11,GMCHN1	; SEE GCHAN. ROUTINE
	CAILE	T2,(T5)
	AOJA	T5,GMCHN2
GMCHN0:	SETZB	T5,AC11		;USE CHANNEL 0 IF NONE OTHER FREE
GMCHN1:	DPB	AC11,AC6	;NOTE CHANNEL UNAVAILABLE
	JRST	RET.2		;GIVE SKIP RETURN
 >;END IFE TOPS20
>;END IFN LSTATS
IFN  LSTATS,<
	SUBTTL	LSTATS SETUP - OPEN METER FILE


;ROUTINE MRLSET IS CALLED AT RESET TIME TO OPEN THE METER FILE
; PNAME.MTO.  IT REMAINS OPEN DURING THE ENTIRE RUN.  ON TOPS10
; THIS REQUIRES ONE OF THE PRECIOUS 16 CHANNELS.

MRLSET:

;GET FILENAME TO WRITE THE DATA TO.
;ON TOPS10 USE NNNMTR.TMP
;ON TOPS20 USE <LAST-SIX-DIGITS-OF-TIME-OF-DAY>.MTO;T

IFE TOPS20,<
	PJOB	T1,
	SETZ	T3,
	MOVEI	T4,3		;WANT 3 DIGITS OF JOB NUMBER
MAKEJN:	IDIVI	T1,^D10
	MOVEI	T2,'0'(T2)
	LSHC	T2,-6
	SOJG	T4,MAKEJN
	HRRI	T3,'MTO'	;(T3) = NNNMTO
	MOVEM	T3,MRNM6	;STORE SIXBIT FILENAME
>;END IFE TOPS20

IFN TOPS20,<
	GTAD			;GET SOME FAIRLY UNIQUE DIGITS
	HRRZ	T1,T1		;JUST SAVE RH
	SETZ	T3,
	MOVEI	T4,6		;WANT 6 DIGITS
MAKEJN:	IDIVI	T1,^D10
	MOVEI	T2,'0'(T2)
	LSHC	T2,-6
	SOJG	T4,MAKEJN
	MOVEM	T3,MRNM6
>;END IFN TOPS20

; NOW SIXBIT NAME IS IN MRNM6
; MAKE AN ASCII NAME OUT OF IT

	MOVE	T2,[POINT 6,MRNM6]
	MOVE	T3,[POINT 7,MRNMA]
MRLST1:	ILDB	T4,T2
	JUMPE	T4,MRLST2
	ADDI	T4,40		;CONVERT SIXBIT CHAR TO ASCII CHAR
	IDPB	T4,T3
	TLNE	T2,760000	;SKIP IF DONE 6 CHARS
	JRST	MRLST1
MRLST2:
IFN TOPS20, 	MOVE 2,[POINT 7,[ASCIZ/.TMP;T/]] ;235123.TMP;T
IFE TOPS20, 	MOVE 2,[POINT 7,[ASCIZ/.TMP/]] ;WRITE TO NNNMTO.TMP

	ILDB	T4,T2
	IDPB	T4,T3
	JUMPN	T4,.-2

;NOW OUTPUT FILE NAME HAS BEEN OBTAINED. IT IS STORED
;IN SIXBIT IN MRNM6, IN ASCII IN MRNMA.
;
;NOW OPEN THE OUTPUT METER FILE

IFE TOPS20,<
	PUSHJ	PP,GMCHAN	;GET A FREE CHANNEL TO USE
	 JRST	[OUTSTR [ASCIZ/?NO FREE CHANNELS TO WRITE METER FILE
/]
		JRST	KILL.]	;THIS SHOULD NEVER HAPPEN!!!
	ANDI	T5,17		;T5:= CHANNEL NUMBER
	DPB	T5,[POINT 4,T5,12] ;SAVE IN AC FIELD OF T5
	HLLZ	T5,T5		;FOR MAKING UUOS
	MOVEM	T5,MRCHNN	;SAVE CHANNEL NUMBER FOR CLOSE LATER

;DO OPEN UUO
	MOVEI	T1,.IODMP	;BINARY DUMP MODE
	MOVSI	T2,'DSK'	; TO DEVICE "DSK"
	SETZ	T3,		;NO BUFFER HEADERS
	MOVE	T0,[OPEN T1]
	OR	T0,T5		;READY TO DO IT
	XCT	T0
	 JRST	MROPNF		;OPEN FAILED!

	SUBTTL	LSTATS SETUP - ENTER METER FILE
;DO ENTER UUO
MRLKPF:	MOVE	T1,MRNM6	;FILENAME
	MOVSI	T2,'TMP'	;.TMP
	SETZB	T3,T4
	MOVE	T0,[ENTER T1]
	OR	T0,T5
	XCT	T0
	 JRST	MRENTF		;ENTER FAILED!
	JRST	MRENOK		;OK

MRENTF:	OUTSTR	[ASCIZ/? ENTER FAILED FOR METER FILE: /]
MRTYPF:	OUTSTR	MRNMA
	OUTSTR	[ASCIZ/
/]
	SETZM	MROPT.		;CLEAR BUCKET POINTER, SO WE DON'T
				; TRY WRITING ANYMORE
	JRST	KILL.		;FATAL ERROR IF THIS HAPPENS

MROPNF:	OUTSTR	[ASCIZ/? OPEN FAILED FOR METER FILE: /]
	JRST	MRTYPF		;TYPE FILE NAME (EVEN THOUGH THIS
				; ERROR IS INDEPENDENT OF THE FILE NAME)

>;END IFE TOPS20
IFN TOPS20,<
	MOVX	1,GJ%SHT
	HRROI	2,MRNMA
	GTJFN
	 ERJMP	MRJSER		;COULDN'T OPEN THE FILE FOR OUTPUT
	MOVEM	1,MRJFN		;REMEMBER JFN
	MOVX	T2,OF%WR
	OPENF
	 ERJMP	MRJSER
	JRST	MRENOK

MRJSER:	HRROI	1,[ASCIZ/?JSYS ERROR: /]
	PSOUT
	MOVEI	1,.PRIOU
	HRLOI	2,.FHSLF
	SETZ	3,
	ERSTR
	 JFCL
	 JFCL
	HRROI	1,[ASCIZ/ FOR METER FILE /]
	PSOUT
MRTYPF:	HRROI	1,MRNMA
	PSOUT
	HRROI	1,[ASCIZ/
/]
	PSOUT
	JRST	KILL.		;FATAL ERROR--DIE OFF


;HERE FOR NON I/O JSYS ERRORS
MRJSSE:	HRROI	1,[ASCIZ/?JSYS ERROR: /]
	PSOUT
	PUSHJ	P,TYPFER	;TYPE LAST ERROR IN THIS FORK
	JRST	KILL.		;FATAL ERROR--DIE OFF

;ROUTINE TO TYPE LAST ERROR IN THIS FORK THEN CRLF
TYPFER:	MOVEI	T1,.PRIOU
	HRLOI	T2,.FHSLF
	SETZ	T3,
	ERSTR
	 JFCL
	 JFCL
	HRROI	T1,[ASCIZ/
/]
	PSOUT
	POPJ	PP,
>;END IFN TOPS20
	SUBTTL	LSTATS SETUP - SETUP CORE

;METER FILE HAS NOW BEEN SUCCESSFULLY OPENED FOR OUTPUT.
;CALL FUNCT. TO GET CORE AT PAGE BOUNDARY
; FOR THE BUCKETS, AND STORE ADDRESS IN MROPT.

MRENOK:	MOVEI	16,1+[-5,,0
			XWD 0,FUN.A0##
			XWD 0,[ASCIZ/LBL/]
			XWD 0,FUN.ST##
			XWD 0,FUN.A1##
			XWD 0,FUN.A2##]
F.PAG==15
	MOVEI	T1,F.PAG	;FUNCTION WE WANT
	MOVEM	T1,FUN.A0##	;STORE FUNCTION
	SETZM	FUN.ST##	;CLEAR STATUS
	SETZM	FUN.A1##	; AND ADDRESS RETURNED
	MOVEI	T1,.MBFSZ	;NUMBER OF WORDS TO ALLOCATE
	IMULI	T1,^D16
	ADDI	T1,.MBHSZ+.MBTSZ ;ACCOUNT FOR HEADER BLOCK & TRAILER BLOCK
	ADDI	T1,MBHISL	;CORE FOR FILE/PAGE TABLE
IFN DBMS6, ADDI	T1,.MBDSZ	;AND DBMS BLOCK
	ADDI	T1,MR.BFB	;200 OR MORE WORDS FOR LSTATS.DIR BLOCK
	MOVEM	T1,FUN.A2##	;STORE AS ARG #2
	PUSHJ	PP,FUNCT.##	;CALL FUNCT. ROUTINE...
	SKIPE	FUN.ST##	; STATUS MUST BE 0...
	 JRST	MRNCR		; ? NOPE - NO CORE AVAIL
	HRRZ	T1,FUN.A1##	;GOT IT -- GET ADDRESS OF START
	MOVEM	T1,MROPT.	;STORE IN MROPT.

;SETUP THE TABLE OF BUCKET ADDRESSES INDEXED BY CHANNEL NUMBER.

	SETZ	T2,		;T2=BUCKET BLOCK NUMBER
MRSBA:	MOVEM	T1,MROPTT(T2)	;STORE ADDRESS OF THIS BLOCK
	ADDI	T1,.MBFSZ	;NEXT BUCKET BLOCK ADDRESS
	CAIGE	T2,17		;DONE ALL?
	 AOJA	T2,MRSBA	;NO, LOOP
	MOVEM	T1,MRHDBP	; STORE POINTER TO HEADER BLOCK
	ADDI	T1,.MBHSZ
	MOVEM	T1,MRTDBP	; STORE POINTER TO TRAILER BLOCK
	ADDI	T1,.MBTSZ	;TRAILER SIZE
	MOVEM	T1,MRFPGT	;STORE POINTER TO FILE/PAGE # TABLE
	..NXAD==MBHISL
IFN DBMS6,<
	..NXAD==.MBDSZ
	ADDI	T1,MBHISL
	MOVEM	T1,MRDDBP	;STORE POINTER TO DBMS BLOCK
>
	ADDI	T1,..NXAD
	MOVEM	T1,MRLDBL	;STORE POINTER TO LSTATS.DIR BLOCK
	SUBTTL	LSTATS SETUP - SETUP HEADER BLOCK
;STORE HEADER BLOCK INFORMATION

	DEFINE STOR1H(OFFSET),<
	HRRZ	T2,MRHDBP	;GET OFFSET
	MOVEM	T1,OFFSET(T2)	;STORE THE WORD
	>

	MOVEI	T1,2		;VERSION NUMBER OF LSTATS STUFF
	STOR1H	(MB.VNO)	; STORE IT

;HEADER BLOCK LENGTH IN WORDS
	MOVEI	T1,.MBHLN
	STOR1H	(MB.HLN)

;PER-FILE BLOCK LENGTH IN WORDS
	MOVEI	T1,.MBFLN	;ACTUAL SIZE OF THE BLOCK
	STOR1H	(MB.FLN)

;MONITOR TYPE (%CNMNT WORD ON TOPS10, BIT 21=1 ON TOPS20)
IFN TOPS20,<
	MOVEI	T2,4B23		;MONITOR TYPE 4 = TOPS20
>
IFE TOPS20,<
	MOVE	T2,[%CNMNT]
	GETTAB	T2,
	 MOVEI	T2,1B23		;ASSUME TOPS10
>

;NOW FIND PROCESSOR TYPE. THIS ALGORITHM IS TAKEN
;DIRECTORY FROM THE HARDWARE REFERENCE MANUAL.

	MOVNI	T1,1		;MAKE AC ALL 1'S
	AOBJN	T1,.+1		;INCREMENT BOTH HALVES
	JUMPN	T1,MRKA10	;KA10 IF AC= 1000000 (CARRY BETWEEN HALVES)
	BLT	T1,0
	JUMPN	T1,MRKL10	;KL10 IF AC=1,,1
MRKI10:	MOVEI	T1,2		;KI10 - SET PROCESSOR TYPE TO 2
	JRST	MRSTRP
MRKA10:	MOVEI	T1,1		;KA10 - SET PROCESSOR TYPE TO 1
	JRST	MRSTRP
MRKL10:	MOVEI	T1,3		;KL10 - SET PROCESSOR TYPE TO 3
MRSTRP:	DPB	T1,[POINT 3,T2,17] ;STORE IN 7B17
	MOVE	T1,T2		;COPY PROCESSOR/OPERATING SYSTEM INFO TO T1
	STOR1H	(MB.MON)	;STORE IT IN HEADER WORD

;LIBOL VERSION NUMBER
	MOVE	T1,LIBVR.
	STOR1H	(MB.LBV)

;LIBOL SWITCH WORD
	MOVE	T1,LIBSW.
	STOR1H	(MB.LSW)

;PROGRAM NAME
IFE TOPS20,<
	HRROI	T1,-3
	GETTAB	T1,
	 MOVE	T1,['METER']
>
IFN TOPS20,<
	GETNM
	SKIPN	T1		;IF NO NAME,
	 MOVE	T1,['METER']	;USE METER
>
	STOR1H	(MB.PNM)	;STORE IT

;CPU SERIAL NUMBER
IFN TOPS20,<
	MOVEI	T1,.APRID	;LH=0 (TABLE OFFSET), RH=.APRID TABLE
	GETAB			; GET THE WORD
	 SETO	T1,		;SET TO -1 IF CAN'T GET IT
	STOR1H	(MB.SER)
>
IFE TOPS20,<
	MOVE	T1,[%CNSER]
	GETTAB	T1,
	 SETO	T1,
	STOR1H	(MB.SER)
>

;MONITOR VERSION NUMBER
IFE TOPS20,<
	MOVE	T1,[%CNVER]
	GETTAB	T1,
	 SETZ	T1,		;SET TO ZEROES IF CAN'T GET
	STOR1H	(MB.MVR)
>

;DATE/TIME PROGRAM STARTED
IFN TOPS20,<
	GTAD
	STOR1H	(MB.DTM)
>
IFE TOPS20,<
	MOVE	T1,[%CNDTM]
	GETTAB	T1,
	  SETO	T1,		;COMPATIBLE WITH TOPS20
	STOR1H	(MB.DTM)
>

;SYSTEM NAME IN ASCIZ
	HRRZ	T5,MRHDBP	;GET POINTER TO HEADER BLOCK
	ADDI	T5,MB.SYN	;RH (T5) = PTR TO SYSTEM NAME
	HRLI	T5,(POINT 7,)	;GET ASCIZ BYTE PTR TO IT
IFN TOPS20,<
	HRLZI	T4,-32		;MAX SIZE
MRVRS1:	HRRI	T1,.SYSVE	;SYSTEM VERSION TEXT
	HRL	T1,T4		;WORD NUMBER
	GETAB
	 SETZ	T1,		;CLEAR IF CAN'T GET IT
	MOVE	T2,T1
	MOVEI	T3,5		;5 CHARS/WORD
MRVRS2:	SETZ	T1,
	LSHC	T1,7
	JUMPE	T1,MRVRS3	;END OF STRING
	IDPB	T1,T5		;STORE BYTE
	SOJG	T3,MRVRS2	;LOOP FOR CHARS IN THIS WORD
	AOBJN	T4,MRVRS1	;LOOP FOR MORE WORDS
>;END IFN TOPS20
IFE TOPS20,<
	HRLZI	T4,-5		;MAX SIZE
MRVRS1:	HRRI	T1,.GTCNF	;FROM CONFIG TABLE
	HRL	T1,T4		;WORD NUMBER
	GETTAB	T1,
	 SETZ	T1,		;CLEAR IF CAN'T GET IT
	MOVE	T2,T1
	MOVEI	T3,5		;5 CHARS/WORD
MRVRS2:	SETZ	T1,
	LSHC	T1,7		;GET NEXT CHAR
	JUMPE	T1,MRVRS3	;END OF STRING
	IDPB	T1,T5		;STORE BYTE
	SOJG	T3,MRVRS2	;LOOP FOR CHARS IN THIS WORD
	AOBJN	T4,MRVRS1	;LOOP FOR MORE WORDS
>;END IFE TOPS20
MRVRS3:

;BATCH JOB INDICATOR
IFE TOPS20,<
	HRROI	T1,.GTLIM	;.GTLIM WORD FOR MY JOB
	GETTAB	T1,
	 SETZ	T1,		;ASSUME NOT A BATCH JOB
	TXNN	T1,JB.LBT	;BATCH JOB?
	TDZA	T1,T1		;NO
	SETO	T1,		;YES
	STOR1H	(MB.BAT)
>
IFN TOPS20,<
	SETO	T1,		;GET INFORMATION FOR CURRENT JOB
	HRROI	T2,T4		;ONE WORD TABLE, IN T4
	MOVEI	T3,.JIBAT	;FIRST (AND ONLY) ENTRY
	GETJI			; GET INFO IN T4
	 ERJMP	MRJSSE
	MOVE	T1,T4		;GET THE WORD
	STOR1H	(MB.BAT)
>

;SYSTEM STATUS BITS
IFE TOPS20,<
	MOVE	T1,[%CNSTS]
	GETTAB	T1,
	 SETZ	T1,		;ZERO IF CAN'T GET
	STOR1H	(MB.STS)
>

;SOFTWARE CONFIGURATION INDICATORS
IFE TOPS20,<
	MOVE	T1,[%CNST2]
	GETTAB	T1,
	 SETZ	T1,
	STOR1H	(MB.ST2)
>

;AVERAGE OVERHEAD TIME
; DO IT OHTMS TIMES AND DIVIDE BY OHTMS
OHTMS==^D10			;NUMBER OF TIMES TO DO IT TO GET THE
				; AVERAGE
	MOVEI	T2,MRFKFT-D.CN	; FAKE FILE TABLE WORD
	MOVEM	T2,MRAFFT	;SAVE THE FAKE FILE TABLE ADDRESS
	SETOM	MRFKFT		;(CHANNEL 17 WILL BE RETURNED)
	XLIST			;CALL MACROS OHTMS TIMES
REPEAT OHTMS,<
	MRTMS.	(T1)		;START
	MOVEI	T2,400+MB.OVH	;BUCKET OFFSET
	MOVE	T1,MRAFFT	;GET FAKE FILE TABLE ADDRESS
	PUSHJ	PP,LMETR.	;CALCULATE BUCKET ADDRESS
	MRTME.	(T1)		;STOP
	>
	LIST
	MOVE	T1,@MRTMB.	;GET TOTAL TIME
	IDIVI	T1,OHTMS	; DIVIDE BY # TIMES DONE
	STOR1H	(MB.OVH)	;STORE IN HEADER BLOCK

  IFN TOPS20,<
	SETZ	T0,		;CLEAR FOR SHIFT
	ASHC	T0,^D12		;SHIFT TIME LEAVING 12 0'S FOR 
				;JSYS 776 FORMAT
	DMOVEM	T0,MRBKO.	;SAVE FIXED OVERHEAD TIME
  >;END IFN TOPS20


  IFE TOPS20,<
	MOVEM	T1,MRBKO.	;SAVE FIXED OVERHEAD TIME
  >


	POPJ	PP,		;ALL DONE, RETURN

MRNCR:
IFE TOPS20,<
	OUTSTR	[ASCIZ/? Not enough core available for METERing
/]
>
IFN TOPS20,<
	HRROI	T1,[ASCIZ/? Not enough core available for METERing
/]
	PSOUT
>
	JRST	KILL.		;SORRY ABOUT THAT, CHIEF.
	SUBTTL	LSTATS - ROUTINE TO DUMP A FILE BLOCK

;ROUTINE MRDMP IS CALLED BEFORE EVERY OPEN TO WRITE THE
; DATA COLLECTED ON THE FILE PREVIOUSLY OPEN ON THIS CHANNEL.
; IF THERE WASN'T ANY FILE PREVIOUSLY OPEN ON THIS CHANNEL,
; THERE IS NO WORK TO BE DONE.
;
; CALLED WITH T1/ CHANNEL NUMBER (0 THRU 17)

MRDMP:	MOVE	T4,MROPTT(T1)	; T4 POINTS TO FIRST LOCATION
	SKIPN	MB.BAS+0(T4)	;SKIP IF ANY OLD INFO THERE
	POPJ	PP,		;NOTHING TO DO, RETURN

;WRITE OUT THIS CHUNK, AND THEN ZERO IT
	PUSHJ	PP,MRWONE	;CALL ROUTINE TO WRITE ONE
;NOW ZERO OUT THE BLOCK
	SETZM	(T4)		;CLEAR FIRST WORD
	HRL	T4,T4
	MOVEI	T3,.MBFSZ-1(T4)
	ADDI	T4,1
	BLT	T4,(T3)
	POPJ	PP,		;DONE, RETURN

;ROUTINE MRDMPT IS CALLED AT THE "STOP RUN" TO WRITE
; THE DATA COLLECTED ON ALL FILES WHICH WE HAVEN'T WRITTEN
; OUT YET.  MOST OF THE I/O SHOULD BE DONE HERE.

MRDMPT:	SKIPN	MROPT.		;BUCKETS SETUP?
	  POPJ	PP,		;NO, RETURN AND DO NOTHING

	MOVEI	T5,17		;T5=CHANNEL NUMBER TO DO
MRDMT1:	MOVE	T4,MROPTT(T5)	;GET ADDRESS
	SKIPE	MB.BAS+0(T4)	;SKIP IF NO INFO TO WRITE
	PUSHJ	PP,MRWONE	;WRITE ONE
	SOJGE	T5,MRDMT1	;LOOP FOR ALL CHANNELS

;IF WE HAVEN'T WRITTEN A HEADER YET, CHECK FOR ACCEPT/DISPLAY
; DATA IN THE TRAILER.. IF ANY WAS RECORDED, WRITE THE HEADER.

	SKIPE	MRHDFL		;HEADER WRITTEN?
	 JRST	MRWTRL		; YES, WRITE TRAILER NOW

	HRRZ	T2,MRTDBP	;GET POINTER TO TRAILER
	SKIPN	MB.ACP(T2)	;ACCEPT DATA?
	SKIPE	MB.DSP(T2)	; OR DISPLAY DATA?
	 TRNA			;YES
	JRST	MRCLOS		;NO, DON'T WRITE HEADER OR TRAILER THEN
;SKIP INTO "WRITE TRAILER" ROUTINE
	SUBTTL	LSTATS - TRAILER BLOCK SETUP AND WRITE ROUTINE

; WRITE TRAILER BLOCK

	DEFINE STOR1T(OFFSET),<
	HRRZ	T2,MRTDBP	;GET OFFSET
	MOVEM	T1,OFFSET(T2)	;STORE THE WORD
	>
	DEFINE STOR2T(OFFSET),<
	HRRZ	T3,MRTDBP	;GET OFFSET
	DMOVEM	T1,OFFSET(T3)	;STORE THE WORD
	>

MRWTRL:	MOVE	T1,[MBBT.T,,.MBTSZ] ;TRAILER BLOCK TYPE,,LENGTH
	MOVEM	T1,@MRTDBP	;STORE IN THE BLOCK

;SIZE OF HISTOGRAM BLOCK
	MOVEI	T1,MBHISL	;LENGTH OF HISTOGRAM BLOCK
	STOR1T	(MB.HSL)

;DATE/TIME PROGRAM ENDED

IFN TOPS20,<
	GTAD
	STOR1T	(MB.DTF)
>
IFE TOPS20,<
	MOVE	T1,[%CNDTM]
	GETTAB	T1,
	  SETO	T1,		;COMPATIBLE WITH TOPS20
	STOR1H	(MB.DTF)
>
;KILL FLAG (-1 IF PROGRAM WAS ABORTED, 0 FOR NORMAL TERMINATION)

	MOVE	T1,MRKILL
	STOR1T	(MB.KIL)

;TOTAL RUNTIME OF PROGRAM (TICKS)
; ON TOPS20 THIS IS STORED AS A DOUBLE-WORD NUMBER OF TICKS
; ON TOPS10 IT IS JUST ONE WORD.

IFN TOPS20,<
	JSYS	776		;GET TICKS NOW IN T1,T2
	ERJMP	MRWTRX		;DO NOTHING IF NO CLOCK
	DSUB	T1,MRPSTM	;SUBTRACT STARTING TICKS
	ASHC	T1,-^D12	;SHIFT ZEROES OUT
	STOR2T	(MB.TRT)	;STORE DOUBLE WORD QUANTITY
MRWTRX:>
IFE TOPS20,<
	SETZ	T1,
	RUNTIME	T1,
	SUB	T1,MRPSTM	;SUBTRACT STARTING TICKS
	STOR1T	(MB.TRT)
>

; NOW WRITE IT

	HRRZ	T1,MRTDBP	;START ADDRESS
	HRLI	T1,-.MBTSZ	;-SIZE
	PUSHJ	PP,MROUT.	;OUTPUT THE BLOCK
	JRST	MRCLOS		;OK--GO CLOSE FILE

	SUBTTL	LSTATS - DBMS SUPPORT ROUTINES
IFN DBMS6,<
;ROUTINES FOR DBMS V6 TO WRITE IN LSTATS FILE
;ALL ROUTINES MUST SAVE ALL ACS EXCEPT T0

;START TIMING, BUCKET NUMBER IN T0
MRDBST:	MRTMS.	(T0)		;START METER TIMING

	POPJ	PP,

;STOP TIMING, BUCKET NUMBER IN T0
MRDBEN:	ADD	T0,MRDDBP	;ADD DBMS BLOCK ADDRESS
	MOVEM	T0,MRTMB.	;SAVE TIMING BUCKET ADDRESS
	MRTME.	(T0)		;END METER TIMING

	POPJ	PP,

;DUMP AND CLEAR DBMS BLOCK
MRDBDM:	PUSH	PP,T1		;SAVE ACS WE WILL USE
	PUSH	PP,T2
	PUSH	PP,T3
	MOVE	T1,[MBBT.D,,.MBDSZ]; BLOCK TYPE,, LENGTH
	MOVEM	T1,@MRDDBP	;STORE HEADER WORD
	HRRZ	T1,MRDDBP	;GET POINTER TO BLOCK
	PUSHJ	PP,MROUT.	;WRITE IT

;CLEAR THE BLOCK
	HRR	T1,MRDDBP	;MAKE T1 = BLT POINTER
	MOVEI	T2,.MBDSZ(T1)	;LAST LOCATION+1
	HRL	T1,T1
	ADDI	T1,1
	SETZM	@MRDDBP		;CLEAR FIRST LOC
	BLT	T1,-1(T2)	;FINISH CLEARING BLOCK
	POP	PP,T3		;RESTORE SAVED ACS
	POP	PP,T2
	POP	PP,T1
	POPJ	PP,
>;END IFN DBMS6

	SUBTTL	LSTATS - ROUTINE TO OUTPUT ANY LSTATS BLOCK
;ROUTINE TO OUTPUT AN LSTATS BLOCK
;CALL:	MOVE	T1,[-LENGTH,,ADDRESS]
;	PUSHJ	PP,MROUT.
;	USES T0,T1,T2,T3
;	<RETURNS HERE>

MROUT.:	SKIPN	MRRERN		;SKIP IF RERUNNING AND WE CAN'T DO I/O
				;TO MTO FILE
	SKIPN	MROPT.		;SKIP IF BUCKETS ARE SETUP
	  POPJ	PP,		; CAN'T DO I/O - RETURN AND DO NOTHING
	PUSH	PP,T1		;SAVE THE CALLING ARG
	SKIPN	MRHDFL		;HAVE WE WRITTEN THE HEADER YET?
	  PUSHJ	PP,MRWRTH	;NO, WRITE IT NOW
	HRRZ	T1,(PP)		;GET ADDRESS FROM STACK
	HLRZ	T1,(T1)		;GET BLOCK TYPE
	CAIN	T1,MBBT.F	;A FILE BLOCK?
	 JRST	MROUF		;YES
	CAIN	T1,MBBT.D	;A DBMS BLOCK?
	 JRST	MROUD		;YES
	CAIN	T1,MBBT.S	;A SORT BLOCK?
	 JRST	MROUS		;YES
MROUB:
IFN TOPS20,<
	POP	PP,T2		;GET ADDRESS BACK
	HLRE	T3,T2		;SIZE IN T3
	HRLI	T2,(POINT 36,)
	MOVE	T1,MRJFN	;JFN IN T1
	SOUT			;WRITE IT
	POPJ	PP,		;RETURN
>
IFE TOPS20,<
	POP	PP,T1		;GET ARG BACK
	SOJA	T1,MRWRT1	;FORM IOWD AND OUTPUT BLOCK
>;END IFE TOPS20
MROUF:	HRRZ	T1,MRTDBP	;POINT TO TRAILER BLOCK
	AOS	T2,MB.NFB(T1)	; ANOTHER FILE BLOCK, HOW MANY SO FAR?
	CAILE	T2,^D100	;IF .GT. 100, DON'T WRITE ANOTHER ONE.
	 JRST	[POP	PP,(PP)	;THROW AWAY SAVED VALUE
		 POPJ	PP,    ];AND RETURN
	JRST	MROUB		;GO OUTPUT IT
MROUS:	HRRZ	T1,MRTDBP	;POINT TO TRAILER BLOCK
	AOS	T2,MB.NSB(T1)	; ANOTHER SORT BLOCK, HOW MANY SO FAR?
	CAILE	T2,^D100	;IF .GT. 100, DON'T WRITE ANOTHER ONE.
	 POPJ	PP,
	JRST	MROUB		;GO OUTPUT IT
MROUD:	HRRZ	T1,MRTDBP	;COUNT TOTAL DBMS BLOCKS
	AOS	MB.NDB(T1)
	JRST	MROUB		;AND GO OUTPUT IT

	SUBTTL	LSTATS - FINISH WRITING METER DATA
;ALL DONE, CLOSE THE METER OUTPUT FILE
MRCLOS:	SKIPE	MRRERN		;IF RERUN WAS USED, DON'T CLOSE
	  JRST	MRRERC		;BECAUSE FILE IS NOT OPEN!!
IFE TOPS20,<
;DO CLOSE UUO
	MOVSI	T0,(CLOSE 0,)
	OR	T0,MRCHNN	;OR IN CHANNEL NUMBER
	XCT	T0
>;END IFE TOPS20

IFN TOPS20,<
	MOVE	T1,MRJFN	;GET JFN OF METER FILE
	TXO	T1,CO%NRJ	;DON'T RELEASE JFN
	CLOSF
	 ERJMP	MRJSER
>;END IFN TOPS20
	SKIPN	MRHDFL		;DID WE WRITE ANYTHING?
	 JRST	MRNOWR		;NO

REPEAT 0,<
; MOST USERS WILL NOT WANT THIS PRINTED OUT.
; IN ANY CASE, IT SHOULDN'T BE PRINTED OUT UNLESS THE DIRECTORY
;FILE LSTATS.DIR IS NOT BEING USED.

	OUTSTR	[ASCIZ/[LIBOL: METER file (/]
	OUTSTR	MRNMA
	SKIPN	MRAPN.		;DID WE APPEND?
	 JRST	[OUTSTR	[ASCIZ/) written]
/]
		POPJ	PP,]	;DONE

	OUTSTR	[ASCIZ/) appended]
/]
>;END REPEAT 0
IFN FTLSDR,<
IFE TOPS20,	JRST	GOLSPN	;APPEND TO THE APPROPRIATE FILE
IFN TOPS20,	JRST	GOLSDR	;APPEND TO THE APPROPRIATE FILE
>;END IFN FTLSDR

IFE FTLSDR,<			;NO LSTATS.DIR
IFE TOPS20,	JRST	DOAP10	;GO APPEND TO JOBNAME.MTO
IFN TOPS20,	JRST	DOAP20	;. .
>;END IFE FTLSDR

MRNOWR:;	OUTSTR	[ASCIZ .[LIBOL: No METER data was recorded, because no I/O was done]
;.]
	POPJ	PP,		;ALL DONE, RETURN

MRRERC:	;OUTSTR	[ASCIZ .[LIBOL: No METER data was recorded, because
;program was RERUN]
;.]
	POPJ	PP,		;RETURN

	SUBTTL	LSTATS - ROUTINE TO WRITE ONE FILE BLOCK
;MRWONE WRITES OUT ONE CHUNK OF BUCKETS, USING THE
; START ADDRESS IN T4.

MRWONE:	MOVE	T1,[MBBT.F,,.MBFSZ]; BLOCK TYPE,, LENGTH
	MOVEM	T1,(T4)	;STORE HEADER WORD
	HRRZ	T1,T4		;GET ADDRESS
	HRLI	T1,-.MBFSZ	;-SIZE IN LH
	JRST	MROUT.		;WRITE THE BLOCK AND RETURN

	SUBTTL	LSTATS - ROUTINE TO WRITE THE HEADER
; ROUTINE TO WRITE THE HEADER
;CALL: PUSHJ PP,MRWRTH
;	RETURN HERE
;USES T0,T1,T2, T3

MRWRTH:	SETOM	MRHDFL		;REMEMBER WE WROTE THE HEADER
	MOVE	T1,[MBBT.H,,.MBHSZ] ;HEADER BLOCK TYPE,,LENGTH
	MOVEM	T1,@MRHDBP	;STORE IN THE BLOCK
	SKIPE	MRRERN		;IS THIS A 'RERUN' OF THE PROGRAM?
	 POPJ	PP,		;YES, DON'T DO I/O TO MTO FILE
IFN TOPS20,<
	MOVE	T1,MRJFN
	HRLI	T2,(POINT 36,)
	HRR	T2,MRHDBP	;START ADDRESS
	MOVNI	T3,.MBHSZ	; 128 WORDS
	SOUT			;WRITE IT
	POPJ	PP,		;RETURN
>

IFE TOPS20,<
	HRR	T1,MRHDBP	;GET POINTER
	SUBI	T1,1		;ADDRESS-1
	HRLI	T1,-.MBHSZ	;-NO. WORDS
MRWRT1:	SETZ	T2,
	MOVE	T0,[OUT T1]
	OR	T0,MRCHNN	;LOAD UUO WITH CHANNEL NUMBER
	XCT	T0
	  POPJ	PP,		;WORKED OK
	OUTSTR	[ASCIZ/? OUT UUO FAILED FOR METER FILE /]
	JRST	MRTYPF		;TYPE FILE NAME AND DIE OFF
>;END IFE TOPS20
;; ** END OF MRWRTH ROUTINE **

	SUBTTL	LSTATS - TOPS10 DIRECTORY FILE ROUTINE
;ALWAYS RETURNS .+1.  IF SOME FATAL ERROR HAPPENS, TYPES
; A WARNING AND RETURN .+1 ALSO.

IFE TOPS20,<
  IFN FTLSDR,<

GOLSPN:
;NOW LOOKUP THE ONE WE WROTE TO FOR READ NOW
;IF ANY ERRORS HAPPEN NOW, THE .TMP FILE WILL GET DELETED
; BY SIMPLY DOING A RENAME TO 0.

	MOVE	T1,MRNM6
	MOVSI	T2,'TMP'
	SETZB	T3,T4
	MOVE	T5,[LOOKUP T1]
	OR	T5,MRCHNN
	XCT	T5		;LOOKUP
	  JRST	LLKPF3		;CAN'T!!

;TRY TO FIND LSTATS.DIR
	PUSHJ	PP,GMCHAN	;GET A FREE CHANNEL TO USE
	  JRST	NFC1		;CAN'T
	ANDI	T5,17
	DPB	T5,[POINT 4,T5,12] ;SAVE IN AC FIELD  OF T5
	HLLZM	T5,MRCHLS	;SAVE CHANNEL

;AND WHILE WE'RE AT IT.. GET CHANNEL FOR "COMMON" FILE TOO
	PUSHJ	PP,GMCHAN
	 JRST	NFC1		;CAN'T
	ANDI	T5,17
	DPB	T5,[POINT 4,T5,12]
	HLLZM	T5,MRCHCF	;CHANNEL NUMBER IN AC FIELD

IFE LSPPN,<
	MOVSI	T1,'COB'	;FIND PPN FOR 'COB'
	DEVPPN	T1,
	  MOVE	T1,[XWD 5,2]	;DEFAULT
>
IFN LSPPN, MOVE T1,[LSPPN]	;PPN WAS SPECIFIED
	MOVEM	T1,MRLLDR	;SAVE PPN WHERE LSTATS.DIR IS

;SEARCH THRU SYSTEM SEARCH LIST, AND TRY A LOOKUP ON EACH DEVICE

	SETO	T4,		;START AT THE BEGINNING
NXTGBS:	MOVE	T1,[3,,T2]	;SET UP FOR GOBSTR
	SETZB	T2,T3		;CLEAR JOB NUMBER, PPN ARGS
	GOBSTR	T1,
	  JRST	GOBSTE		;?FAILED!
	JUMPE	T4,NXTGBS	;IGNORE "FENCE"
	CAMN	T4,[-1]		;NOT FOUND?
	 JRST	NOLSTS		;YES
	MOVEM	T4,MRLLDV	;SAVE DEVICE NAME

;OPEN THE DEVICE

	MOVEI	T1,.IODMP	;DUMP MODE
	MOVE	T2,T4		;THAT DEVICE
	SETZ	T3,		;NO BUFFERS
	MOVE	T4,[OPEN T1]	; PLAIN OPEN UUO
	OR	T4,MRCHLS	;"OR" IN CHANNEL
	XCT	T4		;DO OPEN
	 JRST	LOPNF1		;OPEN FAILED

;LOOKUP UUO
	MOVE	T1,[SIXBIT/LSTATS/]
	MOVSI	T2,'DIR'
	SETZ	T3,
	MOVE	T4,MRLLDR	;PPN
	MOVE	T5,[LOOKUP T1]
	OR	T5,MRCHLS
	XCT	T5		;DO LOOKUP
	  CAIA			;FAILED - GO CHECK
	JRST	RD1200		;FOUND IT

	HRRZ	T2,T2		;GET LOOKUP ERROR CODE
	CAIE	T2,1		;NO DIRECTORY, OR "NOT FOUND"?
	JUMPN	T1,LLKPE1	;NO--OTHER LOOKUP ERROR, COMPLAIN
	MOVSI	T1,(RELEAS)	;RELEAS THE CHANNEL
	OR	T1,MRCHLS
	XCT	T1
	MOVE	T4,MRLLDV	; GET LAST DEVICE NAME WE TRIED
	JRST	NXTGBS		;AND DO ANOTHER GOBSTR

;READ IN FIRST 200 WORDS .. AND COPY INFORMATION

RD1200:	HRRZ	T1,MRLDBL	;POINTER TO BLOCK
	SUBI	T1,1
	HRLI	T1,-200		;FORM IOWD
	SETZ	T2,
	MOVE	T3,[IN T1]
	OR	T3,MRCHLS
	XCT	T3
	 CAIA			;OK
	JRST	LSINF		;PROBLEMS

	SETZM	MRLFPR		;FILE IS AT BEGINNING NOW
	MOVE	T4,MRLDBL	;T4 = PTR TO THE BLOCK
	MOVE	T1,.LDBPC(T4)	;BYTE PTR TO CURRENT FILENAME
	MOVEM	T1,MRLBPC
	MOVE	T1,.LDSZL(T4)	;SIZE LIMIT
	MOVEM	T1,MRLSZL	;SAVE
	SKIPN	.LDTML(T4)	;ANY TIME LIMIT?
	 JRST	TMLMOK		;NO

;CHECK TIME LIMIT
	SKIPN	T3,.LDFWR(T4)	;GET TIME OF FIRST WRITE
	 JRST	SETTFW		;NONE THERE--SET TO NOW
	ADD	T3,.LDTML(T4)	;ADD TIME LIMIT
	MOVX	T1,%CNDTM	;GET TODAY'S DATE/TIME
	GETTAB	T1,
	 SETO	T1,

	CAML	T1,T3		;IS IT TIME TO INCREMENT?
	 JRST	NXTFLE		;YES!
;TIME LIMIT IS OK -- OPEN FILE FOR APPEND AND CHECK SIZE LIMIT

TMLMOK:	MOVE	T4,MRLBPC	;BYTE PTR TO CURRENT FILE
	PUSHJ	PP,LDPOST	;POSITION LD FILE
	 JRST	LRLLC0		;ERROR - RELEASE CHANNEL AND QUIT
	ADD	T4,MRLDBL	; NOW GET ACTUAL BYTE PTR TO THE FILE
	SUB	T4,MRLFPR

;READ FILENAME AND PUT SIXBIT IN MRCFNM,MRCFEX

	MOVE	T3,T4		;COPY PTR INCASE ERROR
	MOVE	T1,[POINT 6,MRCFNM]
TMLMO1:	ILDB	T2,T3		;GET ASCII CHARACTER
	JUMPE	T2,ENDFN1	;NULL ENDS STRING
	CAIN	T2,"."		;. STARTS EXTENSION
	 JRST	ENDFN2
	SUBI	T2,40		;MAKE SIXBIT CHARACTER
	IDPB	T2,T1		;STORE
	JRST	TMLMO1		;LOOP
ENDFN2:	MOVE	T1,[POINT 6,MRCFEX]
TMLMO2:	ILDB	T2,T3		;GET ASCII CHARACTER
	JUMPE	T2,ENDFN1	;NULL ENDS STRING
	SUBI	T2,40		;ELSE STORE CHARACTER
	IDPB	T2,T1
	JRST	TMLMO2

ENDFN1:	MOVEI	T1,.IODMP	;OPEN OLD DEVICE IN DUMP MODE
	MOVE	T2,MRLLDV
	SETZ	T3,
	MOVE	T4,[OPEN T1]
	OR	T4,MRCHCF	;COMMON FILE CHANNEL
	XCT	T4
	 JRST	LOPNFC		;OPEN FAILED FOR COMMON FILE

;TO APPEND:  DO LOOKUP. IF NO ERROR OR ERROR CODE 0,
;	DO ENTER AND USETO.

	MOVE	T1,MRCFNM	;FILENAME
	MOVE	T2,MRCFEX	;EXTENSION
	SETZ	T3,
	MOVE	T4,MRLLDR	;DIRECTORY
	MOVE	T5,[LOOKUP T1]
	OR	T5,MRCHCF
	XCT	T5		;DO LOOKUP
	 JRST	LLKPEC		;LOOKUP FAILED FOR COMMON FILE

;CHECK SIZE LIMIT

	HLRE	T1,T4		;GET SIZE
	JUMPL	T1,[MOVM T1,T1	;SOME # OF WORDS-- ROUND UP TO BLOCKS
		  IDIVI T1,200
		  JUMPE T2,.+1
		  AOJA  T2,.+1]
	MOVEI	AC11,1(T1)	;GET BLOCK # TO USETO TO
	SKIPN	MRLSZL		;SKIP IF A SIZE LIMIT TO WORRY ABOUT
	  JRST	DOENT		;NONE
	CAML	T1,MRLSZL	;SIZE TOO BIG?
	 JRST	SIZTBG		;YES: GO ON TO NEXT FILE
	
DOENT:	MOVSI	T1,(RELEAS)	;CLOSE & RELEAS LSTATS.DIR
	OR	T1,MRCHLS
	XCT	T1

	MOVEI	T0,^D10		;# TIMES TO TRY ENTER
DOENTA:	MOVE	T1,MRCFNM	;NAME
	MOVE	T2,MRCFEX	;EXTENSION
		;NOTE: T3 HAS PROTECTION CODE RETURNED FROM LOOKUP
	AND	T3,[777000,,0]	;JUST SAVE PROTECTION CODE
	MOVE	T4,MRLLDR	;DIRECTORY
	MOVE	T5,[ENTER T1]
	OR	T5,MRCHCF
	XCT	T5		;DO ENTER
	 JRST	LENTEC		;ENTER FAILED FOR COMMON FILE

;DO USETO TO APPEND TO THE FILE

	CAIN	AC11,1		;IF BLOCK 1, DON'T BOTHER
	 JRST	NXTRDD
	MOVSI	T5,(USETO)
	OR	T5,MRCHCF
	HRR	T5,AC11		;BLOCK NUMBER
	XCT	T5

;READ/WRITE FROM OUR 200 WORD BUFFER UNTIL WE HIT EOF ON THE FIRST FILE

NXTRDD:	MOVE	T1,MRLDBL	;POINTER TO BLOCK
	SUBI	T1,1
	HRLI	T1,-200
	SETZ	T2,
	MOVE	T3,[IN T1]
	OR	T3,MRCHNN
	XCT	T3
	 CAIA
	 JRST	LINER1		;UNTIL ERROR
;OUT UUO
	MOVE	T1,MRLDBL
	SUBI	T1,1
	HRLI	T1,-200
	SETZ	T2,
	MOVE	T3,[OUT T1]
	OR	T3,MRCHCF	;TO COMMON FILE
	XCT	T3
	JRST	NXTRDD		;OK--LOOP
	 JRST	LOUTF1		;OUT FAILED!

;COME HERE WHEN "IN" FAILS - ASSUME EOF

LINER1:	PUSHJ	PP,DELOF	;DELETE OLD FILE
	MOVSI	T1,(RELEAS)	;CLOSE THE INPUT FILE
	OR	T1,MRCHNN
	XCT	T1
	MOVSI	T1,(RELEAS)	;CLOSE THE OUTPUT FILE
	OR	T1,MRCHCF
	XCT	T1
	POPJ	PP,		;DONE OK, RETURN

;HERE IF SIZE LIMIT WAS EXCEEDED
; OPEN LSTATS.DIR FOR UPDATING, CHANGE THE THINGS
; AND GO WRITE TO THE NEW FILE

SIZTBG:	MOVSI	T1,(RELEAS)
	OR	T1,MRCHCF	;RELEASE OLD COMMON FILE CHANNEL
	XCT	T1		;THEN FALL INTO "NXTFLE"

;HERE FROM ABOVE, OR TIME LIMIT WAS EXCEEDED
; OPEN LSTATS.DIR FOR UPDATING, CHANGE THE THINGS
; AND GO WRITE TO THE NEW FILE

NXTFLE:	PUSHJ	PP,OPNUPD	;OPEN FILE FOR UPDATING
	 POPJ	PP,		;IF ERRORS, JUST RETURN
	PUSHJ	PP,NEWINF	;PUT IN NEW INFO
	 POPJ	PP,		;ERRORS
	JRST	TMLMOK		;GO WRITE TO THAT MTO FILE

;HERE IF DATE/TIME OF FIRST WRITE HAS NOT BEEN PUT IN LSTATS.DIR
;DO SO, AND GO WRITE TO THAT MTO FILE

SETTFW:	PUSHJ	PP,OPNUPD	;OPEN FILE FOR UPDATING
	 POPJ	PP,		;IF ERRORS, JUST RETURN
	MOVX	T1,%CNDTM	;CURRENT DATE/TIME
	GETTAB	T1,
	 SETZ	T1,		;IF CAN'T GET IT, MAKE SURE THE NEXT GUY TRIES
	HRRZ	T4,MRLDBL
	MOVEM	T1,.LDFWR(T4)	;STORE THE INFO
	PUSHJ	PP,NEWIOT	;WRITE OUT THE UPDATED DATA BLOCK
	 POPJ	PP,		;PROBLEMS--GIVE IT UP
	JRST	TMLMOK		;CONTINUE
;ROUTINE TO OPEN LSTATS.DIR FOR UPDATING
;POPJ IF ERROR, SKIP RETURN IF OK.

OPNUPD:	MOVEI	T0,^D10		;# TIMES WE WILL TRY
OPNUP0:	MOVE	T1,['LSTATS']
	MOVSI	T2,'DIR'
	SETZ	T3,
	MOVE	T4,MRLLDR	;PPN
	MOVE	T5,[ENTER T1]
	OR	T5,MRCHLS
;ENTER MAY FAIL BECAUSE OF SIMULTANEOUS UPDATE
	XCT	T5
	 JRST	OPNEU2		;HOPEFULLY JUST SIMULTANEOUS UPDATE

;HERE WHEN FILE HAS BEEN OPENED
	
OPNUP1:	SETZM	MRLFPR		;SET FILE PTR TO ZERO
	MOVE	T1,[USETI 1]	; AND REALLY DO IT
	OR	T1,MRCHLS
	XCT	T1
	HRRZ	T1,MRLDBL	;NOW READ 1ST 200 WORDS
	SUBI	T1,1
	HRLI	T1,-200		;FORM IOWD
	SETZ	T2,
	MOVE	T3,[IN T1]
	OR	T3,MRCHLS
	XCT	T3		;DO IN UUO
	  JRST	RET.2		;ALL OK
	JRST	LSINF		;ERROR- GO COMPLAIN AND POPJ

;HERE FOR PROBLEMS

;ENTER FAILED
OPNEU2:	HRRZ	T2,T2		;ISOLATE ERROR CODE
	CAIN	T2,3		; SIMULATEOUS UPDATE PROBLEM?
	 JRST	OPNEU3		;YES--WAIT A LITTLE
	OUTSTR	[ASCIZ/%LIBOL: Can't OPEN LSTATS.DIR for updating: (/]
	PUSHJ	PP,TYPOT2	;TYPE ERROR CODE
	OUTSTR	[ASCIZ/)
/]
	JRST	LRLLC		;RELEASE LSTATS CHANNEL AND POPJ
OPNEU3:	SOJLE	T0,OPNEU4	;WAITED TOO LONG?
	MOVEI	T1,1		;SLEEP A SEC
	SLEEP	T1,
	JRST	OPNUP0		;GO TRY AGAIN
OPNEU4:	OUTSTR	[ASCIZ/%LIBOL: Can't OPEN LSTATS.DIR for updating:
% Someone has it open for UPDATING
/]
	JRST	LRLLC		;RELEASE LSTATS CHANNEL AND POPJ
;ROUTINE TO PUT NEW INFO IN THE HEADER WHICH SAYS WE
;BUMPED TO THE NEXT FILESPEC.
; IF I/O ERRORS, OR FILE IS EXHAUSTED, POPJ, ELSE POPJ1
;WITH FILE POSITIONED AT 0, NEW INFO IN PLACE, AND 1ST
;DISK BLOCK UPDATED.
; IF POPJ RETURN TAKEN, THE CHANNEL HAS BEEN RELEASED, TOO.

NEWINF:	MOVE	T4,MRLDBL	;POINTER TO BLOCK
	MOVE	T1,.LDNFL(T4)	;# FILES,,# OF CURRENT
	HLRZ	T2,T1		;# FILES
	CAIG	T2,(T1)		;IS FILE EXHAUSTED?
	 JRST	FILEXH		; YES, SAY THAT
	AOS	.LDNFL(T4)	;BUMP # OF CURRENT FILE

	MOVX	T1,%CNDTM
	GETTAB	T1,
	  SETZ	T1,
	MOVEM	T1,.LDFWR(T4)	;SAVE TIME OF FIRST WRITE

;BUMP CURRENT POINTER

	MOVE	T1,.LDBPC(T4)	;BYTE PTR TO CURRENT
	HRRZ	T3,T1
	CAIL	T3,200		;POINTING TO FIRST BLOCK?
	 JRST	NEWIN1		;NO, REPOSITION FILE
	ADD	T1,MRLDBL	;MAKE ABSOLUTE PTR
	ILDB	T2,T1		;GET A BYTE
	JUMPN	T2,.-1		;LOOK FOR NULL
	SUB	T1,MRLDBL	;GET RELATIVE BP
	MOVEM	T1,.LDBPC(T4)	;THAT'S THE STARTING BP ALL RIGHT
	MOVEM	T1,MRLBPC

;WRITE OUT THE UPDATED BLOCK TO DSK
NEWIOT:	MOVE	T0,[USETO 1]	;PREPARE TO WRITE 1ST BLOCK
	OR	T0,MRCHLS
	XCT	T0
	HRRZ	T1,MRLDBL
	SUBI	T1,1
	HRLI	T1,-200
	SETZ	T2,		;END OF IO LIST
	MOVE	T3,[OUT T1]
	OR	T3,MRCHLS
	XCT	T3
	  JRST	RET.2		;EVERYTHING IS COOL .. SKIP RETURN
	JRST	OUERRL
;CURRENT FILE STARTS OR ENDS IN ANOTHER BLOCK.  WE HAVE TO REPOSITION
; THE FILE TO GET THE START OF THE NEXT ONE, REPOSITION AGAIN TO 0,
; AND STORE THE STARTING BP.

NEWIN1:	MOVE	T4,MRLBPC	;GET BP TO CURRENT NOW
	PUSHJ	PP,LDPOST	;REPOSITION FILE
	 JRST	LRLLC0		;ERROR - DELETE OLD FILE, RELEASE, RETURN
	MOVE	T1,MRLBPC
	SUB	T1,MRLFPR	;INDEX INTO BLOCK
	ADD	T1,MRLDBL	; ADD START OF DATA BLOCK
	ILDB	T2,T1		;LOOK FOR FIRST NULL
	JUMPN	T2,.-1
	SUB	T1,MRLDBL
	ADD	T1,MRLFPR	;GET RELATIVE BP ADDRESS
	MOVEM	T1,MRLBPC	;SAVE IT HERE


;NOW WE MUST REPOSITION THE FILE TO WORD 0 AGAIN

	SETZ	T4,
	PUSHJ	PP,LDPOST
	 JRST	LRLLC0		;DELETE OLD FILE, RELEASE STUFF
	HRRZ	T4,MRLDBL	;T4= START OF BLOCK
	MOVE	T1,MRLBPC	;STORE AWAY NEW "CURRENT BP"
	MOVEM	T1,.LDBPC(T4)
	JRST	NEWIOT		;GO WRITE UPDATED BLOCK TO DSK

;HERE IF WE ARE ALREADY POINTING TO THE LAST FILE IN THE DIRECTORY
FILEXH:	OUTSTR	[ASCIZ/%LIBOL: LSTATS.DIR is exhausted
/]
	JRST	LRLLC		;RELEAS LSTATS CHANNEL AND POPJ


;ROUTINE TO POSITION LD FILE
;CALLED WITH BYTE PTR TO THE FILE NAME IN T4 (OR 0)
;RETURNS: PROPER BLOCK IN THE 200 WORD BUFFER
;	MRLFPR= NUMBER OF THE 1ST WORD IN THE BLOCK
; POPJ IF ERROR, SKIP RETURN IF OK

LDPOST:	HRRZ	T3,T4		;GRAB START OF BYTE PTR
	SKIPN	T2,MRLFPR	;ZERO IS SPECIAL
	 JRST	LDPST1		;WE ARE NOW AT START OF FILE

;SET FILE POSITION TO BLOCK WE WANT, READ NEXT 205 WORDS IN
;(THIS ENSURES THAT THE BYTE PTR WILL END WITHIN THE BUFFER).

LDPST0:	TRZ	T3,177		;MAKE EVEN START OF BLOCK
	MOVEM	T3,MRLFPR	;THIS WILL BE FILE POINTER
	LSH	T3,-7		;MAKE BLOCK NUMBER
	ADDI	T3,1
	MOVE	T0,[USETI (T3)]
	OR	T0,MRCHLS	;LSTATS CHANNEL
	XCT	T0		;POSITION TO THE BLOCK
	HRRZ	T1,MRLDBL	;POINT TO BLOCK
	SUBI	T1,1		;IOWD
	HRLI	T1,-204		;READ 204 WORDS IN
	SETZ	T2,
	MOVE	T3,[IN T1]
	OR	T3,MRCHLS
	XCT	T3
	 JFCL			;EOF CONDITION IS OK--ASSUME WE GOT THAT
	JRST	RET.2

;WE ARE POSITIONED AT THE START OF THE FILE

LDPST1:	JUMPE	T3,RET.2	;IF WE ARE ALREADY HERE, DON'T BOTHER
	JRST	LDPST0		;JUST GO READ IN WHAT WE WANT

;I/O ERRORS FOR LSTATS.DIR

;LOOKUP FAILED FOR THE OLD FILE WE HAD BEEN WRITING
LLKPF3:	OUTSTR	[ASCIZ/%LIBOL: LOOKUP failed (/]
	HRRZ	T2,T2
	PUSHJ	PP,TYPOT2	;THIS IS WIERD, AND "CAN'T HAPPEN"
	OUTSTR	[ASCIZ/ for the .TMP file we'd been writing
/]
	JRST	CNTWLS		;TYPE FINAL MSG AND POPJ

;NO FREE CHANNELS
NFC1:	OUTSTR	[ASCIZ/%LIBOL: No free channels to write LSTATS data
/]
	PUSHJ	PP,DELOF	;DELETE OLD FILE
	POPJ	PP,

;GOBSTR UUO FAILED
GOBSTE:	OUTSTR	[ASCIZ/%LIBOL: GOBSTR UUO failed
/]
	PUSHJ	PP,DELOF	;DELETE OLD FILE
	JRST	CNTWLS

CNTWLS:	OUTSTR	[ASCIZ/% Can't write LSTATS data
/]
	POPJ	PP,

;COULDN'T FIND AN LSTATS.DIR
NOLSTS:	OUTSTR	[ASCIZ/%LIBOL: LSTATS.DIR not found
/]
	PUSHJ	PP,DELOF	;DELETE OLD FILE
	JRST	CNTWLS

;OPEN FAILED FOR A SYSTEM DEVICE
LOPNF1:	OUTSTR	[ASCIZ/%LIBOL: OPEN failed for device /]
	PUSHJ	PP,TYP6T2	;TYPE SIXBIT FROM T2
	OUTSTR	[ASCIZ/
/]
	PUSHJ	PP,DELOF	;DELETE OLD FILE
	JRST	CNTWLS

;LOOKUP FAILED FOR LSTATS.DIR - ERROR CODE IN T2
LLKPE1:	OUTSTR	[ASCIZ/%LIBOL: LOOKUP ERROR (/]
	PUSHJ	PP,TYPOT2
	OUTSTR	[ASCIZ/) FOR LSTATS.DIR
/]
LRLLC0:	PUSHJ	PP,DELOF	;DELETE OLD FILE
LRLLC:	MOVSI	T1,(RELEAS)	;RELEASE LSTATS CHANNEL
	OR	T1,MRCHLS
	XCT	T1
	JRST	CNTWLS		;THEN GO FINISH MESSAGE

;IN UUO FAILED READING LSTATS.DIR
LSINF:	OUTSTR	[ASCIZ/%LIBOL: IN UUO failed reading LSTATS.DIR
/]
	JRST	LRLLC0		;DELETE OLD FILE, RELEASE CHANNEL, FINISH MSG

;OUT UUO FAILED TRYING TO WRITE THE 1ST BLOCK

OUERRL:	OUTSTR	[ASCIZ/%LIBOL: OUT UUO failed updating LSTATS.DIR
/]
	JRST	LRLLC0		;RELEASE CHANNEL, FINISH MSG

;THIS ROUTINE TYPES OCTAL FROM T2
TYPOT2:	IDIVI	T2,10		;YE OLDE
	PUSH	PP,T3		; RECURSIVE
	SKIPE	T2		;NUMBER PRINT
	PUSHJ	PP,TYPOT2	; ROUTINE
	POP	PP,T2
	ADDI	T2,"0"
	OUTCHR	T2
	POPJ	PP,

;THIS ROUTINE TYPES THE SIXBIT WORD IN T2
TYP6T2:	JUMPE	T2,RET.1	;RETURN IF NO MORE CHARACTERS TO TYPE
	SETZ	T1,
	LSHC	T1,6		;SHIFT BYTE INTO RIGHT 6 BITS
	ADDI	T1,40		;MAKE ASCII CHARACTER
	OUTCHR	T1		;TYPE IT
	JRST	TYP6T2		;LOOP AS LONG AS THERE IS SOMETHING TO DO

;I/O ERRORS FOR THE COMMON FILE

;OPEN FAILED FOR COMMON FILE DEVICE

LOPNFC:	OUTSTR	[ASCIZ/%LIBOL: Can't OPEN device /]
	PUSHJ	PP,TYP6T2	;TYPE DEVICE NAME FROM T2
	OUTSTR	[ASCIZ/
/]
	JRST	LRLLC0		;DELETE OLD FILE,
				;RELEASE LSTATS.DIR AND POPJ

;LOOKUP FAILED FOR COMMON FILE - THIS IS PROBABLY OK (JUST START A NEW FILE)
; UNLESS THE ERROR IS NOT FILE-NOT-FOUND

LLKPEC:	HRRZ	T2,T2		;GET ERROR CODE
	JUMPN	T2,LLKPEA	;FILE NOT FOUND, NO, BAD ERROR
	MOVSI	T3,111000	;LOAD PROTECTION
	MOVEI	AC11,1		;USETO TO BLOCK 1
	JRST	DOENT		;GO DO ENTER
LLKPEA:	PUSHJ	PP,DELOF	;DELETE OLD FILE
	OUTSTR	[ASCIZ/%LIBOL: LOOKUP ERROR (/]
	PUSHJ	PP,TYPOT2
	OUTSTR	[ASCIZ/ on LSTATS file /]

;TYPE FILE NAME

LLKPE2:	MOVE	T2,MRCFNM
	PUSHJ	PP,TYP6T2
	OUTCHR	["."]
	MOVE	T2,MRCFEX
	PUSHJ	PP,TYP6T2
	OUTSTR	[ASCIZ/
/]
	PUSHJ	PP,LRCF		;RELEASE COMMON FILE
	JRST	LRLLC		;RELEASE LSTATS.DIR AND POPJ

;RELEASE COMMON FILE
LRCF:	MOVSI	T1,(RELEAS)
	OR	T1,MRCHCF	;COMMON FILE CHANNEL
	XCT	T1
	POPJ	PP,		;SILENTLY, RETURN

;RELEASE OLD FILE WITHOUT DELETING IT
LROLD:	MOVSI	T1,(RELEAS)
	OR	T1,MRCHNN
	XCT	T1
	POPJ	PP,

;ENTER FAILED FOR COMMON FILE
LENTEC:	HRRZ	T2,T2		;GET ERROR CODE RETURNED
	CAIN	T2,3		;SIMULATEOUS UPDATE?
	 JRST	LENTE3		;YES
	OUTSTR	[ASCIZ/%LIBOL: ENTER failed (/]
	PUSHJ	PP,TYPOT2	;TYPE ENTER ERROR CODE
	OUTSTR	[ASCIZ/) for LSTATS output file /]
	PUSHJ	PP,DELOF	;DELETE OLD FILE
	JRST	LLKPE2		;TYPE FILE NAME AND RELEASE CHANNELS

LENTE3:	SOJLE	T0,LENTE4	;TRIED TOO LONG--GIVE UP
	MOVEI	T1,1		;NO, SLEEP A SEC
	SLEEP	T1,
	JRST	DOENTA		;THEN TRY AGAIN
LENTE4:	OUTSTR	[ASCIZ/%LIBOL: Can't append to LSTATS output file -
(Someone else has it open for updating)
/]
	PUSHJ	PP,LRCF		;RELEASE COMMON FILE CHANNEL
	JRST	LRLLC0		;DELETE OLD FILE,
				;RELEASE LSTATS.DIR AND POPJ


;OUT FAILED TO THE COMMON FILE
LOUTF1:	OUTSTR	[ASCIZ/%LIBOL: OUT uuo failed for LSTATS common file
/]
	PUSHJ	PP,LROLD	;RELEASE OLD FILE (NOT DELETED)
	PUSHJ	PP,LRCF		;RELEASE COMMON FILE
	JRST	CNTWLS		;TYPE FINAL MSG AND POPJ

>;END IFN FTLSDR
>;END IFE TOPS20

	SUBTTL	LSTATS - TOPS20 DIRECTORY FILE ROUTINES

;IF ALL OK, RETURNS .+1.  IF SOME FATAL ERROR HAPPENS, TYPES A
; WARNING TO THE USER AND RETURNS .+1 ALSO.

IFN TOPS20,<
IFDEF LSDIR,<
GOLSDR:

;TRY TO FIND LSTATS.DIR

	MOVE	T2,[POINT 7,[LSDIR]] ;LSTATS DIRECTORY
	MOVE	T1,[POINT 7,MRLDNA] ;POINTER TO ASCII STRING TO MAKE
	ILDB	T3,T2		;GET A CHAR
	JUMPE	T3,.+3		; IF NULL, STOP
	IDPB	T3,T1		;STORE IT
	JRST	.-3		;AND LOOP
	MOVE	T2,[POINT 7,[ASCIZ/LSTATS.DIR/]] ;THE FILENAME
	ILDB	T3,T2		;GET A CHAR
	IDPB	T3,T1		;STORE
	JUMPN	T3,.-2		;LOOP, UNTIL WE'VE STORED LAST NULL

	MOVX	T1,GJ%SHT!GJ%OLD ;MUST BE AN OLD FILE
	MOVE	T2,[POINT 7,MRLDNA] ;POINTER TO FILENAME STRING WE JUST MADE
	GTJFN
	 ERJMP	LGTJNE		;GTJFN FAILED - GO SEE WHY
	MOVEM	T1,MRLDJF	;REMEMBER IT'S JFN

;FOUND IT! - OPEN FOR READING
	MOVX	T2,OF%RD	;JUST OPEN FOR READING
	OPENF
	 ERJMP	LOPNFF		;OPENF FAILED
;LSTATS.DIR IS OPEN FOR READING
;READ IN FIRST 200 WORDS .. AND COPY INFORMATION

	MOVE	T1,MRLDJF
	HRRZ	T2,MRLDBL	;POINTER TO BLOCK
	HRLI	T2,(POINT 36,)
	MOVNI	T3,200		;-# WORDS
	SIN			;COMMIT A SIN
	 ERJMP	LSINF		;UH OH WE'RE IN TROUBLE NOW!
	SETZM	MRLFPR		;REMEMBER FILE POINTER IS 0
	MOVE	T4,MRLDBL	;T4 = INDEX TO THE BLOCK
	MOVE	T1,.LDBPC(T4)	;BYTE PTR TO CURRENT FILENAME
	MOVEM	T1,MRLBPC	;SAVE FOR LATER
	MOVE	T1,.LDSZL(T4)	;SIZE LIMIT
	MOVEM	T1,MRLSZL	;SAVE
	SKIPN	.LDTML(T4)	; SKIP IF ANY TIME LIMIT TO WORRY ABOUT
	 JRST	TMLMOK		;NO
	SKIPN	T3,.LDFWR(T4)	;GET TIME OF FIRST WRITE
	 JRST	SETTFW		;NONE THERE--SET TO NOW
	ADD	T3,.LDTML(T4)	;ADD TIME LIMIT
	GTAD			; AND TODAY'S DATE/TIME
	CAML	T1,T3		;IS IT TIME TO INCREMENT?
	 JRST	NXTFLE		;YES!

;TIME LIMIT IS OK -- OPEN FILE FOR APPEND AND CHECK SIZE LIMIT

TMLMOK:	MOVE	T4,MRLBPC	;BYTE PTR TO CURRENT FILE
	PUSHJ	PP,LDPOST	;POSITION LD FILE
	  JRST	RLDFJ		;ERROR - RELEASE JFN AND QUIT
	ADD	T4,MRLDBL	; NOW GET ACTUAL BYTE PTR TO THE FILE
	SUB	T4,MRLFPR

;BUILD FILENAME IN MRLDNA
	MOVE	T2,[POINT 7,[LSDIR]] ;DIRECTORY, OR LOGICAL DEVICE
	MOVE	T1,[POINT 7,MRLDNA]
	ILDB	T3,T2
	JUMPE	T3,.+3
	IDPB	T3,T1
	JRST	.-3

	MOVE	T2,T4		;COPY BP
	ILDB	T3,T2		;NOW STORE THE FILENAME
	IDPB	T3,T1
	JUMPN	T3,.-2

	MOVE	T2,[POINT 7,MRLDNA] ;POINT TO FILESPEC
	MOVX	T1,GJ%SHT
	GTJFN
	 ERJMP	FJFNF		;GTJFN FAILED -- COMPLAIN!!
	MOVEM	T1,MRLCJF	;SAVE JFN OF THIS COMMON FILE
	SKIPN	MRLSZL		;SKIP IF A SIZE LIMIT TO WORRY ABOUT
	 JRST	SIZIOK		;NO - SIZE OK
	SIZEF			; SEE IF SIZE LIMIT EXCEEDED
	 ERJMP	SZEFF		;FAILED -- GO SEE WHY
	CAML	T3,MRLSZL	; SIZE TOO BIG?
	 JRST	SIZTBG		;YES: GO ON TO NEXT FILE

;IT IS OK TO WRITE INTO THIS FILE! OPEN FOR APPEND, AND COPY THE INFO
; INTO IT.

SIZIOK:	MOVE	T1,MRLDJF	;CLOSE AND RELEASE LSTATS.DIR
	CLOSF
	 ERJMP	CLSFE		; * FAILED * ... ???
	MOVE	T1,MRLCJF	;JFN OF THIS FILE
	MOVX	T2,OF%APP
	OPENF
	 ERJMP	COPNFF		;CAN'T OPEN FOR APPEND!
	MOVE	T1,MRJFN	;OPEN THE ONE WE WROTE TO FOR READ NOW
	MOVX	T2,OF%RD
	OPENF
	 ERJMP	OOPNFF		;CAN'T!!

;READ/WRITE FROM OUR 200 WORD BUFFER UNTIL WE HIT EOF ON THE FIRST FILE

NXTRDD:	MOVE	T1,MRJFN	;READ FROM HERE
	HRRZ	T2,MRLDBL	;POINTER TO BLOCK
	HRLI	T2,(POINT 36,)
	MOVNI	T3,200		;-# WORDS
	SIN			;COMMIT A SIN
	 ERJMP	NXTRD1		;UNTIL ERROR
	MOVE	T1,MRLCJF	;WRITE TO HERE
	HRRZ	T2,MRLDBL
	HRLI	T2,(POINT 36,)
	MOVNI	T3,200
	SOUT
	 ERJMP	NXTRD2
	JRST	NXTRDD		;LOOP...

;COME HERE WHEN SIN FAILS - ASSUME EOF

NXTRD1:	MOVE	T1,MRJFN	;CLOSE THE INPUT FILE
	TXO	T1,CO%NRJ	;DON'T RELEASE JFN
	CLOSF
	 ERJMP	.+1		;IGNORE ERRORS
	MOVE	T1,MRLCJF	;CLOSE THE OUTPUT FILE
	CLOSF
	 ERJMP	.+1		;IGNORE ERRORS
	PUSHJ	PP,DELOF	;DELETE OLD FILE
	POPJ	PP,

;HERE IF SOUT FAILS FOR THE COMMON FILE
NXTRD2:	HRROI	T1,[ASCIZ/%LIBOL: Can't append to LSTATS file because:
/]
	PSOUT
	PUSHJ	PP,TYPFER	;PRINT LAST ERROR IN THIS FORK
	JRST	NXTRD1		;CLOSE FILES AND RETURN
; HERE IF SIZE LIMIT WAS EXCEEDED
; OPEN LSTATS.DIR FOR UPDATING, CHANGE THE THINGS
; AND GO WRITE TO THE NEW FILE

SIZTBG:	MOVE	T1,MRLCJF	;RELEASE OLD JFN
	RLJFN
	 ERJMP	.+1		;IGNORE ERROR HERE

; HERE IF TIME LIMIT WAS EXCEEDED
;OPEN LSTATS.DIR FOR UPDATING, CHANGE THE THINGS
; AND GO WRITE TO THE NEW FILE

NXTFLE:	PUSHJ	PP,OPNUPD	;OPEN FILE FOR UPDATING
	  POPJ	PP,		;IF ERRORS, JUST RETURN
	PUSHJ	PP,NEWINF	;PUT IN NEW INFO
	  POPJ	PP,		;?FILE IS EXHAUSTED!
	JRST	TMLMOK		;GO WRITE TO THAT MTO FILE

;HERE IF DATE/TIME OF FIRST WRITE HAS NOT BEEN PUT IN LSTATS.DIR
;DO SO, AND GO WRITE TO THAT MTO FILE

SETTFW:	PUSHJ	PP,OPNUPD	;OPEN FILE FOR UPDATING
	 POPJ	PP,		;IF ERRORS, JUST RETURN
	GTAD			;GET DATE/TIME NOW
	HRRZ	T4,MRLDBL
	MOVEM	T1,.LDFWR(T4)	;STORE THE INFO
	PUSHJ	PP,NEWIOT	; WRITE OUT THE UPDATED DATA BLOCK
	 POPJ	PP,		;PROBLEMS-- GIVE IT UP
	JRST	TMLMOK		;CONTINUE

;ROUTINE TO OPEN LSTATS.DIR FOR UPDATING
;POPJ IF ERROR, SKIP RETURN IF OK.

OPNUPD:	MOVE	T1,MRLDJF	;CLOSE FILE
	TXO	T1,CO%NRJ	;DON'T RELEASE JFN!
	CLOSF
	 ERJMP	OPNEU1		;CLOSF SHOULDN'T FAIL!
	MOVEI	T4,^D10		;# TIMES WE WILL TRY
OPNUP0:	MOVE	T1,MRLDJF
	MOVX	T2,OF%RD!OF%WR	;READ/WRITE ACCESS
	OPENF
	 ERJMP	OPNEU2		;OPENF MAY FAIL BECAUSE OF SIMULATANEOUS ACCESS

;HERE WHEN FILE HAS BEEN OPENED

OPNUP1:	SETZM	MRLFPR		;SET FILE PTR TO ZERO
	MOVE	T1,MRLDJF	;GET READY TO READ IT
	HRRZ	T2,MRLDBL
	HRLI	T2,(POINT 36,)
	MOVNI	T3,200		;-# WORDS
	SIN
	 ERJMP	OPNUP2		;FAILED
	JRST	RET.2		;SIGNAL ALL OK
; HERE FOR PROBLEMS

OPNUP2:	HRROI	T1,[ASCIZ/%LIBOL: Can't update LSTATS.DIR - SIN failed:
/]
	PSOUT
OPNERC:	PUSHJ	PP,TYPFER	;TYPE THE ERROR
OPNERD:	MOVE	T1,MRLDJF	;NOW RELEASE JFN
	RLJFN
	 ERJMP	.+1		;OH WELL, WE TRIED
	POPJ	PP,		;RETURN
OPNEU1:	HRROI	T1,[ASCIZ/%LIBOL: CLOSF failed for LSTATS.DIR: /]
	PSOUT
	JRST	OPNERC

;OPENF FAILED FOR READ/WRITE ACCESS

OPNEU2:	CAIN	T1,OPNX9	;INVALID SIMULTANEOUS ACCESS?
	 JRST	OPNEU3		;YES--WAIT A LITTLE
	HRROI	T1,[ASCIZ/%LIBOL: Can't OPENF LSTATS.DIR for updating: /]
	PSOUT
	JRST	OPNERC		;TYPE REASON, AND RELEASE JFN
OPNEU3:	SOJLE	T4,OPNEU4	;WAITED TOO LONG?
	MOVEI	T1,^D1000	;NO, SLEEP A SEC
	DISMS
	JRST	OPNUP0		;GO TRY AGAIN

OPNEU4:	HRROI	T1,[ASCIZ/%LIBOL: Can't OPENF LSTATS.DIR for updating: /]
	PSOUT
	HRROI	T1,[ASCIZ/
% Someone has it open for UPDATING
/]
	PSOUT
	JRST	OPNERD		;RELEASE JFN AND POPJ
;ROUTINE TO PUT NEW INFO IN THE HEADER WHICH SAYS WE
;BUMPED TO THE NEXT FILESPEC.
; IF I/O ERRORS, OR FILE IS EXHAUSTED, POPJ, ELSE POPJ1
;WITH FILE POSITIONED AT 0, NEW INFO IN PLACE, AND 1ST DSK BLOCK UPDATED.
; IF POPJ RETURN TAKEN, THE JFN HAS BEEN RELEASED, TOO.

NEWINF:	MOVE	T4,MRLDBL	;POINTER TO BLOCK
	MOVE	T1,.LDNFL(T4)	;# FILES,,# OF CURRENT
	HLRZ	T2,T1		;# FILES
	CAIG	T2,(T1)		;IS FILE EXHAUSTED
	 JRST	FILEXH		; YES, SAY THAT
	AOS	.LDNFL(T4)	;BUMP # OF CURRENT FILE

	GTAD			;SAVE LATEST DATE/TIME IN HEADER
	MOVEM	T1,.LDFWR(T4)	;SAVE TIME OF FIRST WRITE
;BUMP CURRENT POINTER

	MOVE	T1,.LDBPC(T4)	;BYTE PTR TO CURRENT
	HRRZ	T3,T1
	CAIL	T3,200		;POINTING TO FIRST BLOCK?
	 JRST	NEWIN1		;NO, REPOSITION FILE
	ADD	T1,MRLDBL	;MAKE ABSOLUTE PTR
	ILDB	T2,T1		;GET A BYTE
	JUMPN	T2,.-1		;LOOK FOR NULL
	SUB	T1,MRLDBL	;GET RELATIVE BP
	HRRZ	T3,T1
	CAIL	T3,200		;SKIP IF STILL IN 1ST BLOCK
	 JRST	NEWIN1		;NO, HAVE TO REPOSITION FILE
	MOVEM	T1,.LDBPC(T4)	;THAT'S THE STARTING BP ALL RIGHT
	MOVEM	T1,MRLBPC	; SAVE AS BP TO CURRENT

;WRITE OUT THE UPDATED BLOCK TO DSK
NEWIOT:	MOVE	T1,MRLDJF	;TO SFPTR TO 0 TO MAKE SURE
	SETZ	T2,
	SFPTR
	 ERJMP	SFPTE2		;ERROR...?
	MOVE	T1,MRLDJF	;NOW GET READY FOR SOUT
	HRRZ	T2,MRLDBL
	HRLI	T2,(POINT 36,)
	MOVNI	T3,200
	SOUT			;WRITE THE 1ST BLOCK
	 ERJMP	NEWIES		;ERROR...?

;EVERYTHING IS COOL .. SKIP RETURN
	JRST	RET.2

;CURRENT FILE STARTS OR ENDS IN ANOTHER BLOCK. WE HAVE TO
;REPOSITION THE FILE TO GET THE START OF THE NEXT ONE,
;REPOSITION AGAIN TO 0, AND STORE THE STARTING BP.

NEWIN1:	MOVE	T4,MRLBPC	;GET BP TO CURRENT NOW
	PUSHJ	PP,LDPOST	;REPOSITION FILE
	 POPJ	PP,		;ERROR - POPJ
	HLLZ	T1,MRLBPC	; GET LH OF BYTE PTR (RH = 0)
	ADD	T1,MRLDBL	;GET ABSOLUTE BP TO START OF OLD CURRENT
	ILDB	T2,T1		;LOOK FOR FIRST NULL
	JUMPN	T2,.-1
	SUB	T1,MRLDBL	;GET REL ADDRESS IN THIS BLOCK
	ADD	T1,MRLFPR	;T1= RELATIVE PTR TO CURRENT FILE
	MOVEM	T1,MRLBPC	;SAVE HERE FOR A SEC..

;NOW WE MUST REPOSITION THE FILE TO WORD 0 AGAIN
	SETZ	T4,
	PUSHJ	PP,LDPOST
	 POPJ	PP,		;ERROR - POPJ
	HRRZ	T4,MRLDBL
	MOVE	T1,MRLBPC	;GET SAVED BP
	MOVEM	T1,.LDBPC(T4)	;STORE IT
	JRST	NEWIOT		;GO WRITE UPDATED BLOCK TO DSK

;ERROR - SFPTR FAILED TRYING TO GET TO 0
SFPTE2:	HRROI	T1,[ASCIZ/%LIBOL: SFPTR failed trying to update LSTATS.DIR:
/]
	PSOUT
	PUSHJ	PP,TYPFER
	JRST	RLDFJ		;RELEASE JFN AND POPJ

;ERROR - SOUT FAILED TRYING TO UPDATE 1ST BLOCK
NEWIES:	HRROI	T1,[ASCIZ/%LIBOL: SOUT failed trying to update LSTATS.DIR:
/]
	PSOUT
	PUSHJ	PP,TYPFER
	JRST	RLDFJ		;RELEASE JFN AND POPJ

;HERE IF WE ARE ALREADY POINTING TO THE LAST FILE IN THE DIRECTORY
FILEXH:	HRROI	T1,[ASCIZ/%LIBOL: LSTATS.DIR is exhausted
/]
	PSOUT
	MOVE	T1,MRLDJF
	RLJFN
	 ERJMP	.+1
	POPJ	PP,

; ROUTINE TO POSITION LSTATS.DIR
;CALL: T4/ BYTE PTR TO IT
;	PUSHJ PP,LDPOST
; RETURNS: PROPER BLOCK IN THE 200 WORD BUFFER
;	MRLFPR = NUMBER OF THE FIRST WORD IN THE BLOCK
;  RETURNS POPJ IF ERROR,  SKIP RETURN IF OK

LDPOST:	HRRZ	T3,T4		;GRAB START OF BLOCK
	SKIPN	T2,MRLFPR	;ZERO IS SPECIAL
	 JRST	LDPST1		;WE ARE NOW AT START OF FILE

;SET FILE POSITION TO WORD WE WANT, READ NEXT 200 WORDS IN.

LDPST0:	MOVEM	T3,MRLFPR	;NEW FILE POINTER
	MOVE	T1,MRLDJF	; SET FILE PTR - GET JFN IN T1
	MOVE	T2,T3		;T2= BYTE NUMBER
	SFPTR
	 ERJMP	SFPTRE		;SFPTR FAILED!
	MOVE	T1,MRLDJF	;GET READY TO READ IT
	HRRZ	T2,MRLDBL
	HRLI	T2,(POINT 36,)
	MOVNI	T3,200		;-# WORDS
	SIN
	 ERJMP	.+1		;EOF CONDITION IS OK -- ASSUME WE GOT THAT
	JRST	RET.2		;GIVE SKIP RETURN

;WE ARE POSITIONED AT THE START OF THE FILE

LDPST1:	JUMPE	T3,LDPST0	;GO READ 1ST 200 WORDS
	
;WE ARE AT START OF FILE, BUT WANT SOMETHING IN THE MIDDLE SOMEWHERE.
;IF IT IS WITHIN THE FIRST 200 WORDS, DON'T BOTHER REPOSITIONING THE FILE.
;HOWEVER, BE CAREFUL THAT THE WHOLE FILESPEC FITS IN THE FIRST 200 WORDS..
;ELSE WE MUST GO TO LDPST0.

	MOVE	T2,T4		;GET POINTER NOW
	ADD	T2,MRLDBL	;MAKE ACTUAL BYTE PTR
	ILDB	T1,T2
	JUMPN	T1,.-1		;LOOK FOR FIRST NULL
	HRRZ	T2,T2
	SUB	T2,MRLDBL
	CAIGE	T2,200		;IF LESS THAN 200, WE'RE OK
	 JRST	RET.2		;IT ALL FITS IN THE BLOCK
	JRST	LDPST0		;GO REPOSITION, ETC.

;SFPTR FAILED
SFPTRE:	HRROI	T1,[ASCIZ/%LIBOL: SFPTR failed for LSTATS.DIR: /]
	PSOUT
	JRST	TYPFER		;TYPE MESSAGE
;I/O ERRORS FOR LSTATS.DIR

;HERE IF GTJFN FAILS FOR LSTATS.DIR
LGTJNE:	CAIN	T1,GJFX24	;IF FILE-NOT-FOUND
	 JRST	LGTJN1		;GO SAY THAT
	HRROI	T1,[ASCIZ/%LIBOL: GTJFN failed for LSTATS.DIR: /]
	PSOUT
	JRST	TYPFER		;TELL USER

LGTJN1:	HRROI	T1,[ASCIZ/%LIBOL: LSTATS.DIR not found
/]
	PSOUT
	POPJ	PP,		;RETURN

;HERE IF OPENF FAILED FOR LSTATS.DIR (BUT THE GTJFN HAD WORKED!)

LOPNFF:	HRROI	T1,[ASCIZ/%LIBOL: Can't OPEN LSTATS.DIR for read: /]
	PSOUT
	PUSHJ	PP,TYPFER	;TYPE REASON
RLDFJ:	MOVE	T1,MRLDJF	;RELEASE JFN
	RLJFN
	 ERJMP	.+1
	POPJ	PP,		;RETURN

;HERE IF SIN FAILED TRYING TO READ FIRST 200 WORDS OF LSTATS.DIR

LSINF:	HRROI	T1,[ASCIZ/%LIBOL: Can't read LSTATS.DIR: /]
	PSOUT
	PUSHJ	PP,TYPFER	; EVERYTHING THAT COULD HAPPEN IS WRONG
	JRST	RLDFJ		;RELEASE JFN AND POPJ

;HERE IF CLOSF FAILED AFTER WE DID ALL WE HAD TO DO IN LSTATS.DIR

CLSFE:	HRROI	T1,[ASCIZ/%LIBOL: CLOSF failed for LSTATS.DIR: /]
	PSOUT
	PUSHJ	PP,TYPFER	;TYPE WHY
	JRST	NXTRD1		;CLOSE INPUT, OUTPUT FILES, AND RETURN
;I/O ERRORS FOR THE COMMON FILE

;HERE IF GTJFN FAILS FOR THE COMMON FILE THE DIRECTORY POINTS US TO

FJFNF:	HRROI	T1,[ASCIZ/%LIBOL: GTJFN failed for LSTATS file: /]
	PSOUT
CMMERR:	PUSHJ	PP,TYPFER	;TYPE WHAT IS WRONG
	HRROI	T1,[ASCIZ/% Filespec is: /]
	PSOUT
	MOVE	T1,[POINT 7,MRLDNA] ;STRING WAS HERE
	PSOUT
	JRST	RLDFJ		;RELEASE JFN OF LSTATS.DIR AND POPJ

;THIS ROUTINE IS SIMILAR TO CMMERR, BUT ALSO RELEASES JFN OF COMMON FILE
CMMER1:	PUSHJ	PP,TYPFER	;TYPE WHAT IS WRONG
	HRROI	T1,[ASCIZ/% Filespec is: /]
	PSOUT
	MOVE	T1,[POINT 7,MRLDNA]
	PSOUT
	MOVE	T1,MRLCJF	;RELEASE COMMON FILE JFN
	RLJFN
	 ERJMP	.+1		;HOPE WE DID
	JRST	RLDFJ		;RELEASE JFN OF LSTATS.DIR AND POPJ

;HERE IF SIZEF FAILS FOR COMMON FILE

SZEFF:	HRROI	T1,[ASCIZ/%LIBOL: SIZEF failed for LSTATS file: /]
	PSOUT
	JRST	CMMERR		;GO TYPE REASON AND FILESPEC

;HERE IF OPENF FAILED - CAN'T OPEN IT FOR APPEND

COPNFF:	HRROI	T1,[ASCIZ/%LIBOL: Can't append to LSTATS file: /]
	PSOUT
	JRST	CMMER1		;GO TYPE REASON AND FILESPEC

;HERE IF OPENF FAILED FOR FILE WE HAD WRITTEN

OOPNFF:	HRROI	T1,[ASCIZ/%LIBOL: Can't append to LSTATS file - /]
	PSOUT
	HRROI	T1,[ASCIZ/OPENF failed for old file:
/]
	PSOUT
	PUSHJ	PP,TYPFER	;TYPE REASON
	MOVE	T1,MRLCJF	;RELEASE JFN OF COMMON FILE
	RLJFN
	 ERJMP	.+1		;HOPE WE DID
	JRST	RLDFJ		;RELEASE JFN OF LSTATS.DIR AND POPJ
	
>;END IFDEF LSDIR
>;END IFN TOPS20
; ROUTINES TO APPEND TO <JOBNAME>.MTO ON DSK:
;(NO LSTATS.DIR IS USED)

SUBTTL	TOPS10 JOBNAME.MTO APPEND CODE

IFE FTLSDR,<
IFE TOPS20,<
DOAP10:	PUSHJ	PP,GMCHAN	;GET A CHANNEL FOR THE .MTO FILE
	 JRST	AP1NFC		;?CAN'T
	ANDI	T5,17
	DPB	T5,[POINT 4,T5,12] ;STORE IN AC FIELD
	HLLZM	T5,MRCHCF	;SAVE CHANNEL NUMBER

;OPEN 'DSK' ON THAT CHANNEL
	MOVEI	T1,17		;DUMP MODE
	MOVSI	T2,'DSK'
	SETZ	T3,
	MOVE	T4,[OPEN T1]
	OR	T4,MRCHCF
	XCT	T4
	 JRST	AP1ODF		;?OPEN OF DSK FAILED

;OPEN PREVIOUS FILE FOR READING
	MOVE	T1,MRNM6	;NAME
	MOVSI	T2,'TMP'	;EXTENSION
	SETZB	T3,T4		;ON DSK:
	MOVE	T5,[LOOKUP T1]
	OR	T5,MRCHNN
	XCT	T5
	 JRST	AP1LKF		;?CAN'T FIND FILE WE'VE BEEN WRITING

;LOOK FOR JOBNAME.MTO
	HRROI	T1,3
	GETTAB	T1,		;GET MY PROGRAM NAME
	 MOVE	T1,[SIXBIT/METER/] ;FAILED--GET 'METER'
	MOVSI	T2,'MTO'
	SETZB	T3,T4
	MOVE	T5,[LOOKUP T1]	;SEE IF ALREADY TEHRE
	OR	T5,MRCHCF
	XCT	T5
	 JRST	AP1LF1		;FAILED-- HOPEFULLY JUST NOT THERE

;IT IS THERE, OPEN FOR APPEND
	HLRE	T1,T4		;GET SIZE
	JUMPL	T1,[MOVM T1,T1	;SOME # OF WORDS-- ROUND UP TO BLOCKS
		   IDIVI T1,200
		   JUMPE T2,.+1
		   AOJA T2,.+1]
	MOVEI	AC11,1(T1)	;START WRITING TO NEXT BLOCK
	MOVEI	T0,^D5		;# OF TIMES TO TRY
DOAPE:	MOVSI	T2,'MTO'
	SETZB	T3,T4
	MOVE	T5,[ENTER T1]
	OR	T5,MRCHCF
	XCT	T5
	 JRST	AP1EN0		;FAILED-- BAD ERROR

	MOVSI	T1,(USETO)	;PREPARE TO APPEND
	OR	T1,MRCHCF
	HRR	T1,AC11		;GET BLOCK NUMBER TO START AT
	XCT	T1
	JRST	CENTOK		;COMMON ENTER OK

;HERE IF LOOKUP FAILED
AP1LF1:	HRRZ	T2,T2		;GET ERROR CODE
	JUMPN	T2,AP1LFF	;OOPS.. SOMETHING BESIDES "FILE NOT FOUND"!

;JUST DO ENTER
	MOVSI	T2,'MTO'
	SETZB	T3,T4
	MOVE	T5,[ENTER T1]
	OR	T5,MRCHCF
	XCT	T5
	 JRST	AP1CN1		;NORMAL ENTER FAILED! (STRANGE!)

;HERE WHEN FILES ARE OPEN - COPY THE DATA
CENTOK:	MOVE	T1,MRLDBL	;PREPARE FOR "IN" UUO
	SUBI	T1,1		; TO OUR 200-WORD BUFFER
	HRLI	T1,-200
	SETZ	T2,
	MOVE	T3,[IN T1]
	OR	T3,MRCHNN
	XCT	T3
	 CAIA			;OK
	JRST	AP1INE		;FAILED--ASSUME EOF
;OUT
	MOVE	T1,MRLDBL
	SUBI	T1,1
	HRLI	T1,-200
	SETZ	T2,
	MOVE	T3,[OUT T1]
	OR	T3,MRCHCF
	XCT	T3
	 JRST	CENTOK		;WORKED--GO DO SOME MORE
	JRST	AP1OUF		;?OUT FAILED!

;HERE WHEN "IN" FAILS, ASSUMING EOF
AP1INE:	PUSHJ	PP,DELOF	;DELETE OLD FILE
	JRST	RLCMF		;AND RELEASE COMMON FILE CHANNEL	

;ERRORS
AP1NFC:	OUTSTR	[ASCIZ/%LIBOL: No free channels to append LSTATS data
/]
	POPJ	PP,		;GIVE UP AND RETURN

;OPEN OF 'DSK' FAILED?
AP1ODF:	OUTSTR	[ASCIZ/%LIBOL: Can't OPEN DSK to append LSTATS data
/]
	POPJ	PP,		;GIVE UP AND RETURN

;LOOKUP FAILED FOR FILE WE'VE BEEN WRITING
AP1LKF:	OUTSTR	[ASCIZ/%LIBOL: LOOKUP faile for .TMP file we wrote!
/]
RLOF:	MOVSI	T1,(RELEAS)
	OR	T1,MRCHNN
	XCT	T1
	POPJ	PP,

;ENTER FAILED FOR UPDATE OF JOBNAME.MTO
AP1EN0:	HRRZ	T2,T2		;GET ERROR CODE
	CAIN	T2,3		;SIMULATANEOUS PROBLEM?
	 JRST	AP1EN3		;YES, WAIT A SEC
	OUTSTR	[ASCIZ/%LIBOL: ENTER failed for .MTO file on DSK:
/]
	PUSHJ	PP,DELOF	;DELETE OLD FILE
RLCMF:	MOVSI	T1,(RELEAS)
	OR	T1,MRCHCF
	XCT	T1
	POPJ	PP,

AP1EN3:	SOJLE	T0,AP1EN4	;WAITED TOO LONG
	MOVEI	T2,1
	SLEEP	T2,
	JRST	DOAPE		;TRY ENTER AGAIN
AP1EN4:	OUTSTR	[ASCIZ/%LIBOL: ENTER failed for .MTO file on DSK:
% Someone else has it OPEN for update
/]
	PUSHJ	PP,DELOF	;DELETE OLD FILE
	JRST	RLCMF		;GO RELEASE COMMON CHANNEL

;LOOKUP FAILED OTHER THAN ERROR CODE 0 FOR DSK:JOBNAME.MTO
AP1LFF:	OUTSTR	[ASCIZ/%LIBOL: LOOKUP failed for .MTO file on DSK:
/]
	PUSHJ	PP,DELOF	;DELETE OLD FILE
	JRST	RLCMF		;GO RELEASE COMMON CHANNEL

;NORMAL ENTER FAILED FOR DSK:JOBNAME.MTO
AP1CN1:	OUTSTR	[ASCIZ/%LIBOL: ENTER failed for .MTO file on DSK:
/]
	PUSHJ	PP,DELOF	;DELETE OLD FILE
	JRST	RLCMF		;GO RELEASE COMMON CHANNEL
;"OUT" FAILED FOR .MTO FILE
AP1OUF:	OUTSTR	[ASCIZ/%LIBOL: OUT failed while appending to .MTO file
/]
	PUSHJ	PP,DELOF	;TRY TO DELETE OLD FILE
	JRST	RLCMF		;GO RELEASE COMMON CHANNEL

>;END IFE TOPS20
SUBTTL	TOPS20 JOBNAME.MTO APPEND CODE

IFN TOPS20,<
DOAP20:	MOVE	T1,MRJFN
	MOVX	T2,OF%RD
	OPENF
	 ERJMP	AP20RF

;OPEN (FOR UPDATE) JOBNAME.MTO
	GETNM
	MOVE	T2,[POINT 6,T1]
	MOVE	T3,[POINT 7,MRNMA] ;BUILD ASCII FILE NAME
DOAP21:	ILDB	T4,T2
	JUMPE	T4,DOAP22
	ADDI	T4,40
	IDPB	T4,T3
	TLNE	T2,760000
	JRST	DOAP21		;LOOP FOR ALL CHARS
DOAP22:	MOVE	T2,[POINT 7,[ASCIZ/.MTO/]]
	ILDB	T4,T2
	IDPB	T4,T3
	JUMPN	T4,.-2

;GTJFN
	MOVX	T1,GJ%SHT
	MOVE	T2,[POINT 7,MRNMA]
	GTJFN
	 ERJMP	AP2GJF		;GTJFN FAILED
	MOVEM	T1,MRLCJF	;SAVE JFN
;OPENF
	MOVEI	T5,^D5		;TIMES WE WILL TRY
DOAP25:	MOVE	T1,MRLCJF	;GET JFN
	MOVX	T2,OF%APP	;APPEND ACCESS
	OPENF
	 ERJMP	AP25ER		;FAILED (PROBABLY SIMULTANEOUS ACCESS)

;OK--BOTH FILES OPEN -- COPY THE DATA
DOAP26:	MOVE	T1,MRJFN	;OUR FAMILIAR READ/WRITE LOOP
	HRRZ	T2,MRLDBL
	HRLI	T2,(POINT 36,)	;BYTE PTR TO BLOCK
	MOVNI	T3,200
	SIN			;READ DATA FROM .TMP FILE
	 ERJMP	DOAP27		;UNTIL ERROR
	MOVE	T1,MRLCJF	; APPEND IT TO COMMON FILE (.MTO)
	HRRZ	T2,MRLDBL
	HRLI	T2,(POINT 36,)
	MOVNI	T3,200
	SOUT
	 ERJMP	AP26ER		;SOUT FAILED - COMPLAIN!
	JRST	DOAP26		;LOOP

;HERE WHEN SIN FAILS -- ASSUME EOF
DOAP27:	MOVE	T1,MRJFN	;CLOSE THE INPUT FILE
	TXO	T1,CO%NRJ	;BUT DON'T RELEAS JFN
	CLOSF
	 ERJMP	.+1		;IGNORE ERRORS CLOSING
	MOVE	T1,MRLCJF	;CLOSE COMMON FILE
	CLOSF			; AND RELEASE JFN
	 ERJMP	.+1		;IGNORE ERRORS CLOSING
	JRST	DELOF		;DELETE THE .TMP FILE
				;AND RETURN (TO EXIT THE PROGRAM)
;HERE FOR PROBLEMS THAT OCCUR ABOVE

;OPENF FAILED FOR OLD FILE
AP20RF:	HRROI	T1,[ASCIZ/%LIBOL: OPENF failed for LSTATS .TMP file: /]
	PSOUT
	PUSHJ	PP,TYPFER
	MOVE	T1,MRJFN
	RLJFN			;TRY TO RELEAS JFN
	 ERJMP	.+1		;IGNORE ERRORS
	POPJ	PP,		;RETURN

;GTJFN FAILED FOR THE COMMON FILE
AP2GJF:	HRROI	T1,[ASCIZ/%LIBOL: GTJFN failed for output .MTO file: /]
	PSOUT
	PUSHJ	PP,TYPFER	;WHAT IS IT EXACTLY
	JRST	DELOF		;DELETE THE OLD FILE AND RETURN

;OPENF FAILED FOR COMMON FILE
AP25ER:	CAIE	T1,OPNX9	;SIMULTANEOUS UPDATE?
	 JRST	AP25E1		;NO -- SOME BAD ERROR
	SOJLE	T5,AP25E2	;TRIED SEVERAL TIMES, GIVE UP
	MOVEI	T1,^D1000	;SLEEP A SEC
	DISMS
	JRST	DOAP25		;AND TRY OPENF AGAIN

AP25E1:	HRROI	T1,[ASCIZ/%LIBOL: OPENF failed for output .MTO file: /]
	PSOUT
	PUSHJ	PP,TYPFER	;WHAT IS IT??
AP25E3:	PUSHJ	PP,DELOF	;DELETE OLD FILE
	MOVE	T1,MRLCJF	;AND RELEAS THIS JFN
	RLJFN
	 ERJMP	.+1
	POPJ	PP,		;THEN RETURN
AP25E2:	HRROI	T1,[ASCIZ/%LIBOL: OPENF failed for output .MTO file
% Someone has it OPEN for updating
/]
	PSOUT
	JRST	AP25E3		;FINISH ERROR HANDLING

;SOUT FAILED
AP26ER:	HRROI	T1,[ASCIZ/%LIBOL: SOUT failed trying to append to .MTO file:
/]
	PSOUT
	PUSHJ	PP,TYPFER	;TYPE WHY
	JRST	DOAP27		;PRETEND WE ARE AT THE END OF THINGS
>;END IFN TOPS20
>;END IFE FTLSDR

;ROUTINE TO DELETE OLD .TMP FILE
IFE TOPS20,<
DELOF:	MOVE	T5,[RENAME T1]
	OR	T5,MRCHNN
	SETZB	T1,T2
	SETZB	T3,T4
	XCT	T5
	 JRST	RENFAI		;RENAME FAILED!
DELOFR:	MOVSI	T1,(RELEAS)
	OR	T1,MRCHNN
	XCT	T1
	POPJ	PP,
RENFAI:	OUTSTR	[ASCIZ/%LIBOL: Can't DELETE DSK:/]
	OUTSTR	MRNMA		;TYPE FILENAME
	OUTSTR	[ASCIZ/
/]
	JRST	DELOFR		;GO RELEAS CHANNEL
>;END IFE TOPS20
IFN TOPS20,<
DELOF:	MOVE	T1,MRJFN	;DELETE THIS FILE
	DELF
	 ERJMP	.+2
	JRST	DELOF1		;OK, RELEASE JFN AND RETURN
	HRROI	T1,[ASCIZ/% Can't delete LSTATS .TMP file: /]
	PSOUT
	PUSHJ	PP,TYPFER
DELOF1:	MOVE	T1,MRJFN
	RLJFN
	 ERJMP	.+1		;IGNORE ERRORS
	POPJ	PP,		;RETURN
>;END IFN TOPS20

>;END IFN LSTATS

IFE LSTATS,<MROUT.==:RET.1##	;FOR SORT>

END