Trailing-Edge
-
PDP-10 Archives
-
BB-H580C-SB_1981
-
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 - LSTATS METER I/O CODE
SUBTTL D. WRIGHT JAN, 1979
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1979, 1981 BY DIGITAL EQUIPMENT CORPORATION
; 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
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