Trailing-Edge
-
PDP-10 Archives
-
BB-H506D-SM_1983
-
cobol/source/creld.mac
There are 4 other files named creld.mac in the archive. Click here to see a list.
; UPD ID= 1875 on 5/1/79 at 9:05 AM by W:<WRIGHT>
TITLE CRELD -- PROGRAM TO CREATE/MODIFY AN LSTATS DIRECTORY FILE
SUBTTL COBOL-68/74 PROJECT
;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
; THIS PROGRAM IS USED TO CREATE AND MAINTAIN AN LSTATS DIRECTORY FILE.
;THE DIRECTORY FILE CONTAINS OUTPUT FILESPECS AND PARAMETERS USED BY COBOL
;PROGRAMS TO WRITE THE LSTATS DATA THEY ARE COLLECTING.
;THE FILE HAS THE SAME FORMAT ON TOPS10 AND TOPS20:
;WORD ;CONTENTS
;---- ---------
.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
;UNIVERSALS
SEARCH LBLPRM ;LIBOL PARAMETERS (INC. "TOPS20" F.T.)
SEARCH METUNV ;LSTATS DEFINITIONS
;TOPS20==0 ;FOR EASILY TESTING TOPS10 CODE ON TOPS20 SYSTEM
IFN TOPS20,<
SEARCH MONSYM,MACSYM ;MONITOR-SPECIFIC DEFINITIONS
.REQUIRE SYS:MACREL ;AND GET MACREL
>
IFE TOPS20,<
SEARCH UUOSYM,MACTEN ; . .
.TEXT @ REL:SCAN/SEARCH/INCL:.TOUTS @ ;TELL LINK TO LOAD SCAN
>
SALL
SUBTTL DEFINITIONS
;DEFAULT OUTPUT DIRECTORIES ARE DEFINED IN METUNV.MAC.
PDLSIZ==^D100 ;PUSHDOWN STACK SIZE
FILLEN==5*^D512 ;FILE LENGTH IN 36-BIT BYTES
LINLEN==^D100 ;MAX TTY INPUT LINE (CHARACTERS)
DSK==1 ;CHANNEL FOR FILE LSTATS.DIR
IFE TOPS20,<
DSKO==2 ;OUTPUT CHANNEL FOR BACKUP/DUMPER COMMAND FILE
FSP==3 ;FILE-SPEC FILE
>
DEFINE TMSG(TEXT),<
IFE TOPS20,<
OUTSTR [ASCIZ/TEXT/]
>
IFN TOPS20,<
HRROI T1,[ASCIZ/TEXT/]
PSOUT
>
>
DEFINE PRSTRG,<
BYTE(7)"C","R","E","L","D",76
>
DEFINE TCRLF,<
IFE TOPS20,< OUTSTR [ASCIZ/
/]
>
IFN TOPS20,< HRROI T1,[ASCIZ/
/]
PSOUT
>
>
;ACS
F=0 ;FLAGS
T1=1 ;STANDARD AC DEFS..
T2=2
T3=3
T4=4
P1=5
P2=6
P3=7
CO=10 ;A COUNTER
FP=11 ;RH = FILE POINTER
C=12 ;TTY INPUT CHARACTERS
P=17 ;PUSHDOWN PTR
;FLAGS IN "F"
F.NTY==1B0 ;NUMBER WAS TYPED
F.NFL==1B1 ;NO PREVIOUS LSTATS.DIR
F.WAI==1B2 ;WE'VE BEEN WAITING FOR THE FILE TO STOP
; BEING MODIFIED BY SOMEONE ELSE
F.EXH==1B3 ;OLD FILE IS EXHAUSTED
F.FEF==1B4 ;EOF ON FILE-SPEC FILE SEEN
F.SOL==1B5 ;STUFF ON LINE
SUBTTL STARTUP
;SETUP DATA AREAS, READ OLD DIRECTORY FILE IF ANY.
ST: RESET ;CLEAR I/O
TDZ F,F ;CLEAR FLAGS
SETZM STBEG ;CLEAR DATA STORAGE AREA
MOVE T1,[STBEG,,STBEG+1]
BLT T1,STEND ;. .
MOVE P,[IOWD PDLSIZ,PDL] ;MAKE A PUSHDOWN POINTER
PUSHJ P,FILSET ;SETUP FILES INITIALLY AND SETUP FLAGS
TMSG <Type "H" for help
>
; HERE WHEN EITHER THE OLD INFO IS IN CORE, OR WE HAVE SETUP
;DEFAULTS. (FLAG F.NFL IS ON IN THE LATTER CASE).
NEWCMD:
IFE TOPS20,<
OUTSTR [PRSTRG] ;OUTPUT PROMPT
>
IFN TOPS20,<
HRROI T1,[PRSTRG] ;OUTPUT PROMPT
MOVEM T1,TXTIBL+.RDRTY ;SETUP CONTROL-R BUFFER
PSOUT
>;END IFN TOPS20
PUSHJ P,GETLIN ;READ A LINE
PUSHJ P,GETC ;GET CHAR
CAIN C,12
JRST NEWCMD
CAIN C,"H"
JRST HELP
CAIN C,"E"
JRST EXITT
CAIN C,"W"
JRST WRITT
CAIN C,"C"
JRST CHANG
CAIN C,"F"
JRST RFILES
CAIN C,"L"
JRST LIST
CAIN C,"R" ;REINIT
JRST REINIT
IFE TOPS20, CAIN C,"B" ;BACKUP
IFN TOPS20, CAIN C,"D" ;DUMPER
JRST DUMPER
TMSG <? Commands are:
>
JRST HLP1
HELP: TMSG <Commands are:
>
HLP1: TMSG <W Write out LSTATS.DIR and exit
E Exit without doing anything
C Change defaults
F Change the list of output files
L List current information
R Re-initialize file with all defaults
H Type this text
>
IFN TOPS20,<
HRROI T1,[ASCIZ/D Write out a DUMPER command file
to save the files used up so far. Also deletes the
used-up filespecs from LSTATS.DIR
/]
PSOUT
>
IFE TOPS20,<
OUTSTR [ASCIZ/B Write out a BACKUP command file
to save the files used up so far. Also deletes the
used-up filespecs from LSTATS.DIR
/]
>
JRST NEWCMD
SUBTTL COMMANDS - WRITE, EXIT
;WRITE OUT CURRENT INFO.
WRITT: USETO DSK,1
MOVE T1,[IOWD FILLEN,FILINF]
SETZ T2,
OUT DSK,T1 ;WRITE INFO
JRST OUTOK
OUTSTR [ASCIZ/? OUT UUO FAILED
/]
JRST EXITT ;GO EXIT
OUTOK: CLOSE DSK,
RELEAS DSK,
TXNE F,F.NFL ;WAS FILE NOT FOUND WHEN WE STARTED?
JRST WROTEK ;YES, SAY "WRITTEN"
TMSG <[LSTATS.DIR rewritten]
> ;SAY "REWRITTEN"
JRST EXITT ;AND GO EXIT
WROTEK: TMSG <[LSTATS.DIR written]
>
EXITT: RELEAS DSK, ;RELEASE CHANNEL SO OTHERS CAN USE
RESET
IFE TOPS20,<
EXIT 1,
JRST ST
>
IFN TOPS20,<
HALTF
JRST ST
>
SUBTTL COMMANDS - CHANGE
;CHANGE DEFAULTS
CHANG: TMSG <(Type CRLF to retain old values, "0" to set no limit)
>
TMSG <Size limit of the output files in >
IFE TOPS20, TMSG <blocks (>
IFN TOPS20, TMSG <pages (>
SKIPN T2,FILINF+.LDSZL
JRST [TMSG <No limit>
JRST .+2]
PUSHJ P,TYPDEC
TMSG <): >
IFN TOPS20, SETZM TXTIBL+.RDRTY ;CLEAR CONTROL-R BUFFER
PUSHJ P,GETLIN ;READ A LINE
PUSHJ P,RDNUM ;READ NUMBER
MOVE T1,FILINF+.LDSZL ;CRLF TYPED, GET DEFAULT
MOVEM T1,FILINF+.LDSZL ;AND STORE IT
TMSG <
Time limit for writing to any one output file
( >
SKIPN FILINF+.LDTML ;SEE IF ANY LIMIT NOW
JRST [TMSG <No limit> ;NO
JRST CHNG1]
HLRZ T2,FILINF+.LDTML ;TIME LIMIT IN DAYS
PUSHJ P,TYPDEC ;TYPE NUMBER
TMSG <D >
HRRZ T2,FILINF+.LDTML ;GET SECS
IDIVI T2,3
SKIPE T2 ;DON'T TYPE HH:MM:SS IF UNNECESSARY
PUSHJ P,HHMMSS ;TYPE HH:MM:SS
CHNG1: TMSG < ): >
IFN TOPS20, SETZM TXTIBL+.RDRTY ;CLEAR CONTROL-R BUFFER
PUSHJ P,GETLIN ;READ LINE
PUSHJ P,RDTIM ;READ DATE & TIME
MOVE T1,FILINF+.LDTML ;GET DEFAULT IF ERROR OR CRLF TYPED
MOVEM T1,FILINF+.LDTML ;STORE NEW VALUE
ASKCUR: TMSG <Current file number (>
HRRZ T2,FILINF+.LDNFL
PUSHJ P,TYPDEC
TMSG <): >
IFN TOPS20, SETZM TXTIBL+.RDRTY ;CLEAR CONTROL-R BUFFER
PUSHJ P,GETLIN ;READ LINE
PUSHJ P,RDNUM ;READ DECIMAL NUMBER
JRST [CAIN C,12
JRST CHNG2 ;USE OLD VALUE
TMSG <? Bad decimal number, try again
>
JRST ASKCUR] ;GO ASK AGAIN
;HE WANTS TO CHANGE THE CURRENT FILE. T1=NEW FILE NUMBER
JUMPE T1,[TMSG <? Must be between 1 and >
HLRZ T2,FILINF+.LDNFL
PUSHJ P,TYPDEC
TCRLF
JRST ASKCUR]
HLRZ T2,FILINF+.LDNFL ;; GET TOTAL # OF FILES
CAMGE T2,T1 ;BIGGER THAN MAX FILES?
JRST [TMSG <? Too large - only >
PUSHJ P,TYPDEC
TMSG < files in the directory
>
JRST ASKCUR] ;GO ASK AGAIN
HRRM T1,FILINF+.LDNFL ;STORE NEW CURRENT FILE
;FIX BYTE PTR TO CURRENT FILE.
MOVE P1,[POINT 7,FILINF+.LDAFN] ;BYTE PTR TO FIRST
MOVEI T2,1 ;T2= FILE NUMBER
CURLP1: CAMN T2,T1 ;ARE WE THERE YET?
JRST CURLP2 ;YES, STORE NEW BYTE PTR
ILDB T3,P1 ;GET CHAR
JUMPN T3,.-1 ;LOOK FOR END OF THIS ONE
ADDI T2,1 ;NEXT FILE
JRST CURLP1 ;SEE IF WE GOT IT YET
CURLP2: SUBI P1,FILINF ; GET A RELATIVE B.P.
MOVEM P1,FILINF+.LDBPC ;STORE NEW BYTE PTR TO CURRENT
SETZM FILINF+.LDFWR ;DELETE "FIRST WRITE" TIME.
CHNG2: JRST NEWCMD
SUBTTL COMMANDS - F
;CHANGE LIST OF OUTPUT FILENAMES
RFILES: TMSG <File to read filespecs from: >
IFE TOPS20,<
PUSHJ P,GETLIN
SETZM FILDEV
SETZM INFIL
SETZM INFIL+1
SETZM INFIL+2
SETZM INFIL+3
PUSHJ P,RDFILS ;READ FILESPEC
JRST NEWCMD ;ERROR, FORGET IT
MOVE T1,['CRELD'] ;DEFAULT NAME
SKIPN INFIL
MOVEM T1,INFIL
RFILE1: SKIPN T2,FILDEV ;ANY DEVICE GIVEN?
MOVSI T2,'DSK' ;NO, USE DSK
MOVEI T1,0 ;ASCII MODE
MOVEI T3,FSPBUF ;INPUT BUFFER HEADER
OPEN FSP,T1
JRST [OUTSTR [ASCIZ/? CAN'T OPEN DEVICE
/]
JRST NEWCMD] ;FORGET IT
LOOKUP FSP,INFIL ;LOOKUP THE FILE
JRST [OUTSTR [ASCIZ/? LOOKUP ERROR FOR INPUT FILE
/]
RELEAS FSP,
JRST NEWCMD] ;GIVE UP
;READ FILENAMES FROM THE FILE, AND STORE THEM IN THEIR PLACE
MOVE P1,[POINT 7,.LDAFN] ;RESET CURRENT POINTER TO FILE #1
MOVEM P1,FILINF+.LDBPC
MOVEI P1,1 ;0,,1
MOVEM P1,FILINF+.LDNFL ;0 FILES SO FAR, CURRENT FILE IS #1
MOVE P1,[POINT 7,FILINF+.LDAFN] ;P1:=POINTER TO FILESPECS
MOVEI P2,0 ;P2 = FILE NUMBER WE'RE AT NOW
TXZ F,F.FEF ;CLEAR END-OF-FILE FLAG
RFILE2: PUSHJ P,GETFLN ;READ A LINE FROM THE FILE
JRST RFILEE ;END OF FILE
SETZM FILDEV ;CLEAR DEFAULTS
SETZM INFIL
SETZM INFIL+1
SETZM INFIL+2
SETZM INFIL+3
PUSHJ P,RDFILS ;GET FILE-SPEC
JRST CHKECR ;ERROR OR CRLF, CHECK
SKIPE INFIL+3 ;BETTER NOT HAVE SPECIFIED A PPN
JRST [OUTSTR [ASCIZ/? PPN MAY NOT BE SPECIFIED
/]
JRST CHKECR]
MOVE T1,INFIL ;BETTER HAVE A GOOD NAME
TLNE T1,770000
JRST NAMOK
OUTSTR [ASCIZ/? FILENAME MUST BE GIVEN
/]
JRST CHKECR
; WE ARE SURE WE HAVE A REASONABLE FILE SPEC NOW
NAMOK: SKIPN T2,FILDEV ;ANY DEVICE GIVEN?
JRST RDMOR1 ;NO
OUTSTR [ASCIZ/? DEVICE MAY NOT BE SPECIFIED
/]
JRST CHKEC1
RDMOR1: MOVE T2,INFIL ;NAME
RDMOR2: SETZ T1,
JUMPE T2,RDMRV2 ;DONE
LSHC T1,6
ADDI T1,40
IDPB T1,P1
JRST RDMOR2
RDMRV2: MOVEI T1,"."
IDPB T1,P1
MOVE T2,INFIL+1 ;EXTENSION
RDMOR3: SETZ T1,
JUMPE T2,RDMRV3 ;DONE
LSHC T1,6
ADDI T1,40
IDPB T1,P1
JRST RDMOR3
RDMRV3: SKIPN INFIL+3 ;PPN?
JRST RDMRV4 ;NO
MOVEI T1,"[" ;BRACKET TO START PPN
IDPB T1,P1
HLRZ T1,INFIL+3 ;GET PROJECT #
PUSHJ P,OCTP1 ;PUT OCTAL NUMBER
MOVEI T1,","
IDPB T1,P1
HRRZ T1,INFIL+3 ;GET PROGRAMMER #
PUSHJ P,OCTP1
MOVEI T1,"]"
IDPB T1,P1
RDMRV4: MOVEI T1,0
IDPB T1,P1 ;NULL TO END FILENAME
ADDI P2,1 ;COUNT ANOTHER FILE
HRLM P2,FILINF+.LDNFL ;BUMP COUNTER
CAIE P2,^D100 ;HAVE 100 YET?
JRST RFILE2 ;NO, KEEP INPUTTING
JRST NEWCMD
;WRITE OCTAL NUMBER IN T1 TO STRING WHOSE BYTE PTR IS IN "P1"
OCTP1: IDIVI T1,10
PUSH P,T2
SKIPE T1
PUSHJ P,OCTP1
POP P,T1
ADDI T1,"0"
IDPB T1,P1
POPJ P,
CHKECR: LDB C,[POINT 7,LINE,6] ;GET 1ST CHAR
CAIN C,12 ;IF JUST <CR>
JRST RFILE2 ;THEN JUST READ MORE
CHKEC1: OUTSTR [ASCIZ/[ Stopping after reading /]
HRRZ T2,P2 ;HOW MANY FILESPECS WE'VE COMPLETED
PUSHJ P,TYPDEC
CAIN P2,1
JRST [OUTSTR [ASCIZ/ filespec./]
JRST .+2]
OUTSTR [ASCIZ/ filespecs./]
OUTSTR [ASCIZ/]
/]
RFILEE: SETZ T1,
IDPB T1,P1 ;STORE LAST NULL
JRST NEWCMD ;GO ON TO NEW COMMAND
>;END IFE TOPS20
IFN TOPS20,<
MOVX T1,GJ%SHT!GJ%CFM!GJ%OLD!GJ%FNS
MOVE T2,[.PRIIN,,.PRIOU]
GTJFN
ERJMP [JSERR
JRST NEWCMD]
MOVEM T1,CMDJFN ;STORE COMMAND FILE JFN
MOVX T2,7B5+OF%RD ;READ NORMALLY
OPENF ;OPEN THE FILE
ERJMP [JSERR
JRST NEWCMD] ;RELEASE JFN AND LEAVE
MOVE P1,[POINT 7,.LDAFN] ;RESET CURRENT POINTER TO FILE #1
MOVEM P1,FILINF+.LDBPC
MOVEI P1,1 ;0,,1
MOVEM P1,FILINF+.LDNFL ;0 FILES SO FAR, CURRENT FILE IS #1
MOVE P1,[POINT 7,FILINF+.LDAFN] ;P1:=POINTER TO FILESPECS
MOVEI P2,0 ;P2 = FILE NUMBER WE'RE AT NOW
TXZ F,F.FEF ;CLEAR END-OF-FILE FLAG
RFILE2: PUSHJ P,GETFLN ;READ A LINE FROM THE FILE
JRST RFILEE ;END OF FILE
MOVX T1,GJ%SHT
MOVE T2,[POINT 7,LINE]
GTJFN ;READ JFN FROM LINE
ERJMP RFILE4 ;ERROR READING JFN
HRRZM T1,TJFN ;SAVE IT
NAMOK: MOVE T2,T1 ;JFN IN T2
MOVE T1,P1 ; STORE IT HERE
SETZ T4, ;NO PREFIX
MOVX T3,1B8+1B11+JS%PAF ;JUST FILENAME, FILETYPE, AND .
;NOTE THAT IF HE TYPED A DEVICE NAME, WE AREN'T SMART ENOUGH TO FIGURE
; THAT OUT AND WARN HIM THAT IT WON'T BE USED.
;TO DO SO WOULD REQUIRE US TO PARSE THE TOPS20 FILESPEC OURSELVES.
JFNS ;GET ASCII STRING FOR IT
ERJMP [JSERR
JRST NEWCMD]
MOVE P1,T1 ;GET UPDATED STRING POINTER
LDB T1,P1 ;STORE NULL ON END IF THERE ISN'T ONE
TDZE T1,T1
IDPB T1,P1
MOVE T1,TJFN
RLJFN ;NOW RELEASE JFN
JFCL ;IGNORE ERRORS
ADDI P2,1 ;READ ANOTHER ONE
HRLM P2,FILINF+.LDNFL ;BUMP OFFICIAL COUNTER
CAIE P2,^D100 ;100 YET?
JRST RFILE2 ;NO, KEEP INPUTTING
JRST NEWCMD
RFILEE: SETZ T2,
IDPB T2,P1 ;STORE LAST NULL
JRST NEWCMD
RFILE4: JSERR
HRROI T1,[ASCIZ/ - THE LINE WAS:
/]
PSOUT
HRROI T1,LINE
PSOUT
JRST NEWCMD
>;END IFN TOPS20
SUBTTL COMMANDS - REINIT
REINIT: PUSHJ P,REFRES ;REFRESH DATA AREA
JRST NEWCMD ;DONE
REFRES: SETZM FILINF ;CLEAR OLD INFO
MOVE T1,[FILINF,,FILINF+1]
BLT T1,FILINF+FILLEN-1
PUSHJ P,DEFSET ;SETUP DEFAULTS
POPJ P, ;AND RETURN
SUBTTL COMMANDS - DUMPER/BACKUP
;WRITE DUMPER/BACKUP COMMAND FILE, UPDATE IN-CORE DIRECTORY
DUMPER: HRRZ T1,FILINF+.LDNFL ;NUMBER OF CURRENT FILE
CAIN T1,1
JRST [TMSG <% Nothing to do.. current file is #1
>
JRST NEWCMD]
DUMP1: TMSG <Output command file: >
IFN TOPS20,<
MOVE T1,[POINT 7,[ASCIZ/Output command file: /]]
MOVEM T1,TXTIBL+.RDRTY
PUSHJ P,GETLIN
MOVX T1,GJ%SHT!GJ%FOU ;OUTPUT FILESPEC BITS
MOVE T2,[POINT 7,LINE] ;READ IT FROM HERE
GTJFN
ERJMP [JSERR
JRST DUMP1] ;ERROR, GO TRY AGAIN
MOVEM T1,OJFN ;SAVE OUTPUT FILE JFN
MOVX T2,7B5+OF%WR ;WRITE TO FILE, 7 BIT BYTES
OPENF
ERJMP [JSERR ;TYPE ERROR MESSAGE
JRST DMERR0] ;CAN'T OPEN FILE
>;END IFN TOPS20
IFE TOPS20,<
PUSHJ P,GETLIN
PUSHJ P,RDFILS ;READ THE FILESPEC
SKIPN T2,FILDEV ;GET DEVICE
MOVSI T2,'DSK' ;NULL, USE DSK:
MOVEI T1,0 ;ASCII MODE
MOVSI T3,OBUF ;BUFFER HEADER
OPEN DSKO,T1 ;OPEN COMMAND FILE DEVICE
JRST [OUTSTR [ASCIZ/? OPEN FAILED FOR BACKUP COMMAND FILE
/]
JRST DUMP1] ;TRY AGAIN
MOVE T1,INFIL ;GET NAME
TLNN T1,770000 ;BETTER BE NON-NULL IN FIRST CHAR
JRST [OUTSTR [ASCIZ/? NULL FILENAME.. TRY AGAIN
/]
JRST DUMP1] ;WOULD YOU BELIEVE.
SKIPN T2,INFIL+1 ;EXTENSION
MOVSI T2,'CMD' ;DEFAULT IS .CMD
MOVE T3,INFIL+2
MOVE T4,INFIL+3 ;PPN
ENTER DSKO,T1 ;ENTER FILE
JRST [OUTSTR [ASCIZ/? ENTER FAILED FOR BACKUP COMMAND FILE
/]
RELEAS DSKO, ;FORGET THIS
JRST NEWCMD] ;TRY ANOTHER COMMAND
>;END IFE TOPS20
MOVE P1,[POINT 7,[ASCIZ/INTERCHANGE
FILES
/]]
PUSHJ P,WRTSTR ;WRITE THE STRING
;NOW WRITE OUT 'SAVE' COMMANDS FOR ALL THE OLD FILENAMES
SAVOFN: HRRZ P2,FILINF+.LDNFL ;CURRENT FILE
MOVEI P3,1 ;P3= NUMBER OF THE FILE WE'RE ON
MOVE T4,[POINT 7,.LDAFN] ;START AT 1ST
ADDI T4,FILINF
SAVOF1: MOVE P1,[POINT 7,[ASCIZ/SAVE /]]
PUSHJ P,WRTSTR ;WRITE "SAVE "
MOVE P1,T4 ;GET STRING PTR
PUSHJ P,WRTSTR ;WRITE IT
ILDB T1,T4 ;GET CHAR
JUMPN T1,.-1 ;LOOK FOR THE NULL
MOVE P1,[POINT 7,[ASCIZ/
/]]
PUSHJ P,WRTSTR ;WRITE CRLF
ADDI P3,1 ;NEXT FILE
CAME P3,P2 ;AT CURRENT FILE YET?
JRST SAVOF1 ;NO, LOOP
IFE TOPS20,<
CLOSE DSKO,
RELEASE DSKO,
>
IFN TOPS20,<
MOVE T1,OJFN ;NOW CLOSE FILE & RELEASE JFN
CLOSF
ERJMP SYSERR
JRST CLOSOK
DMERR0: HRROI T1,[ASCIZ/? CAN'T OPEN FILE:
/]
PSOUT
JSERR
MOVE T1,OJFN
RLJFN
ERJMP .+1
JRST NEWCMD
CLOSOK:
>;END IFN TOPS20
;COMMAND FILE IS WRITTEN.. NOW UPDATE THE INCORE TABLE
; TO DELETE THE FINISHED FILES FROM THE DIRECTORY.
TMSG <[Command file written]
>
MOVE T1,FILINF+.LDBPC ;T1=PTR TO CURRENT
ADDI T1,FILINF
MOVE T2,[POINT 7,FILINF+.LDAFN] ;T2=PTR TO WHERE IT GOES
ILDB T3,T1 ;GET CHAR
JUMPE T3,ONENUL ;END OF THIS FILESPEC
NEXFS: IDPB T3,T2 ;STORE CHAR
JRST .-3 ;KEEP GOIN'
ONENUL: IDPB T3,T2 ;STORE THAT
ILDB T3,T1 ;GET FOLLOWING CHAR
JUMPN T3,NEXFS ;NOT END OF LIST YET
REPEAT 5,<IDPB T3,T2> ;STORE SOME NULLS
SETZM (T2) ;CLEAR OUT REST OF BUFFER
HRL T1,T2
HRRI T1,1(T2)
BLT T1,FILINF+FILLEN-1 ;ZAP
MOVE T1,[POINT 7,.LDAFN] ;CURRENT FILE IS AT THE TOP NOW
MOVEM T1,FILINF+.LDBPC
HLRZ T1,FILINF+.LDNFL ;FIX # FILES IN DIRECTORY
HRRZ T2,FILINF+.LDNFL
SUBI T2,1
SUB T1,T2
HRLM T1,FILINF+.LDNFL
MOVEI T1,1 ;CURRENT FILE IS NOW #1
HRRM T1,FILINF+.LDNFL
JRST NEWCMD
SUBTTL COMMANDS - LIST
;LIST CURRENT PARAMETERS
LIST: TMSG <Output file size limit:
>
SKIPN T2,FILINF+.LDSZL
JRST [TMSG <No limit.>
JRST LIST0]
PUSHJ P,TYPDEC
IFE TOPS20, TMSG < BLOCKS>
IFN TOPS20, TMSG < PAGES>
LIST0: TMSG <
Time limit for writing to any one "CURRENT" file:
>
MOVE T1,FILINF+.LDTML
JUMPE T1,NOTLM ;JUMP IF NONE
HLRZ T2,T1 ;GET DAYS
JUMPE T2,NODYS ;LESS THAN 1 DAY
CAIN T2,1 ;EXACTLY 1 DAY
JRST [TMSG <1 Day>
JRST NODYS]
PUSHJ P,TYPDEC
TMSG < Days>
NODYS: HRRZ T1,FILINF+.LDTML ;GET 1/3'S OF SECONDS
JUMPE T1,NOSCS ;JUMP IF NO SECS.
TMSG <, > ;SEPARATE DAYS FROM TIME
HRRZ T1,FILINF+.LDTML ;GET AGAIN
IDIVI T1,3 ;GET SECONDS
IDIVI T1,^D60*^D60 ;T1=HRS
PUSH P,T2
JUMPE T1,NOHRS
MOVE T2,T1
PUSHJ P,TYPDEC
TMSG < Hrs. >
NOHRS: POP P,T1
IDIVI T1,^D60 ;T1=MINS, T2=SECS
JUMPE T1,NOMNS
PUSH P,T2
MOVE T2,T1
PUSHJ P,TYPDEC
TMSG < Mins. >
POP P,T2
NOMNS: JUMPE T2,NOSCS
PUSHJ P,TYPDEC
TMSG < Secs.>
NOSCS: TMSG <
>
JRST LIST1
NOTLM: TMSG < No limit
>
LIST1: TMSG <
# Files in directory: >
HLRZ T2,FILINF+.LDNFL
PUSHJ P,TYPDEC
TMSG <, the current file is number >
HRRZ T2,FILINF+.LDNFL
PUSHJ P,TYPDEC
TMSG <
The current file is >
MOVE T1,FILINF+.LDBPC
ADDI T1,FILINF
IFN TOPS20, PSOUT
IFE TOPS20, PUSHJ P,TTYSTR ;TYPE STRING TO TTY
SKIPN FILINF+.LDTML ;ANY TIME LIMIT?
JRST LIST2 ;NO
SKIPN T2,FILINF+.LDFWR ;GET TIME OF FIRST WRITE TO THE FILE
JRST [TMSG < (No data written into it yet)>
JRST LIST2]
TMSG < First written: >
IFN TOPS20,<
MOVEI T1,.PRIOU
SETZ T3,
ODTIM
>
IFE TOPS20,<
MOVE T1,T2 ;GET TIME IN T1
PUSHJ P,.TDTTM## ; CALL SCAN ROUTINE TO TYPE IT
>
LIST2: TMSG <
Files in the directory: (f = finished, * = current file)
>
MOVEI T3,1 ;T3=NUMBER OF THE FILE
HLRZ T4,FILINF+.LDNFL ;GET # FILES TOTAL
HRRZ P1,FILINF+.LDNFL ;P1= # OF CURRENT FILE
MOVE P3,[POINT 7,FILINF+.LDAFN]; FIRST ONE IS HERE
TYPONE: CAMLE T3,T4 ;DONE?
JRST LIST5 ;YES
MOVE P2,[POINT 7,OUTLIN] ;MAKE AN OUTPUT LINE
MOVEI T2,[ASCIZ/f /] ;ASSUME FILE IS FINISHED
CAMLE T3,P1 ;PAST CURRENT FILE
MOVEI T2,[ASCIZ/ /] ;YES, GET SPACES
CAMN T3,P1 ; .EQ. CURRENT FILE?
MOVEI T2,[ASCIZ/* /] ;YES, GET *
HRLI T2,(POINT 7,) ;T2=BYTE PTR TO STARTER STRING
ILDB T1,T2 ;GET CHAR
JUMPE T1,.+3 ;JUMP WHEN NULL FOUND
IDPB T1,P2 ;AND STORE IN OUTPUT LINE
JRST .-3
;COPY FILENAME
ILDB T1,P3 ;GET NEXT FILENAME
JUMPE T1,.+3 ;DONE AT NULL
IDPB T1,P2 ;STORE IN OUTPUT LINE
JRST .-3
MOVEI T1,15
IDPB T1,P2
MOVEI T1,12
IDPB T1,P2
MOVEI T1,0
IDPB T1,P2 ;<CRLF><NUL> ENDS IT
;TYPE THE LINE
IFE TOPS20,<
OUTSTR OUTLIN ;TYPE THE LINE
>
IFN TOPS20,<
HRROI T1,OUTLIN
PSOUT ;TYPE THE LINE
>
ADDI T3,1 ;GO ON TO NEXT FILE
JRST TYPONE
LIST5: JRST NEWCMD
SUBTTL FILSET -- INITIAL SETUP ROUTINE
;FILSET OPENS THE FILE FOR I/O, AND SETS UP THE DATA AREA IN CORE.
FILSET: OPEN DSK,[17 ;THIS IS ALL DONE WITH TOPS10 CODE,
SIXBIT /DSK/ ; PA1050 DEPENDED ON FOR TOPS20
0]
JRST NODSK ;CAN'T OPEN THE DEVICE
DOLKE: MOVE T1,['LSTATS']
MOVSI T2,'DIR'
SETZB T3,T4 ;ON [,]
LOOKUP DSK,T1
JRST NOFIL ;ANALYZE LOOKUP ERROR
TXNN F,F.WAI ;DON'T TYPE MESSAGE MORE THAN ONCE
OUTSTR [ASCIZ/[Reading file DSK:LSTATS.DIR]
/]
HLRE T1,T4 ;GET FILE SIZE
JUMPG T1,FILBIG ;.GT. 1024 BLOCKS! MUCH TOO BIG - GIVE UP
MOVM T2,T1 ;GET MAGNITUDE
CAIE T2,FILLEN ; NOT EQUAL TO ASSUMED FILE LENGTH?
JRST FILBG1 ;YES, DON'T EVEN ALLOW THAT
HRLM T1,OLDSIZ ;SAVE OLD SIZE AS LEFT HALF OF IOWD
PUSHJ P,ENTFIL
JRST NOENT ;ANALYZE ENTER ERROR
TXZN F,F.WAI ;HAVE WE BEEN WAITING
JRST ENTOK ;ALL OK
OUTSTR [ASCIZ/[File open for updating]
/]
JRST ENTOK
NODSK: OUTSTR [ASCIZ/? CAN'T OPEN "DSK"!
/]
EXIT
NOFIL: HRRZ T2,T2 ;GET LOOKUP ERROR CODE
JUMPE T2,FILNFD ;FILE NOT FOUND--OK
OUTSTR [ASCIZ/? LOOKUP ERROR /]
PUSHJ P,TYPOCT
OUTSTR [ASCIZ/ FOR FILE LSTATS.DIR
/]
EXIT ;DIE
FILBIG: OUTSTR [ASCIZ/? FILE LARGER THAN 1024 BLOCKS!
(THERE MUST BE SOMETHING WRONG)
/]
EXIT ;DIE
FILBG1: OUTSTR [ASCIZ/? FILE LENGTH NOT EQUAL TO 20 BLOCKS!
(THERE MUST BE SOMETHING WRONG)
/]
EXIT ;DIE
FILNFD: OUTSTR [ASCIZ/[Can't find DSK:LSTATS.DIR - creating one]
/]
TXO F,F.NFL ;FILE DOESN'T YET EXIST
PUSHJ P,ENTFIL ;ENTER IT FOR UPDATING
JRST NOENT ;CAN'T
PUSHJ P,DEFSET ;SETUP DEFAULTS
POPJ P, ;ALL SETUP NOW
NOENT: HRRZ T2,T2 ;GET ENTER ERROR CODE
CAIN T2,3 ;FILE BEING MODIFIED?
JRST FILMOD ;YES, TRY AGAIN IN A SEC
OUTSTR [ASCIZ/? ENTER ERROR /]
PUSHJ P,TYPOCT
OUTSTR [ASCIZ/ FOR FILE LSTATS.DIR
/]
EXIT ;DIE
;FILE IS BEING MODIFIED. (QUITE POSSIBLE -- TRY AGAIN IN A SEC).
FILMOD: CLOSE DSK, ;CLOSE FILE
TXOE F,F.WAI ;WAITING FOR IT..
JRST FILMD1 ;BEEN WAITING
OUTSTR [ASCIZ/[FILE BEING MODIFIED -- WAITING]
/]
MOVEI CO,^D10 ;WAIT FOR 10 SECONDS, THEN COMPLAIN AGAIN
FILMD1: SOJLE CO,FILMD2 ;WAITED TOO LONG!
MOVEI T1,1 ;NA.. WAIT A SEC
SLEEP T1,
JRST DOLKE ;LOOKUP/ENTER AGAIN
FILMD2: OUTSTR [ASCIZ/? LSTATS.DIR BEING UPDATED-- TIMOUT
/]
EXIT ;DIE -- SOMETHING WRONG PROBABLY
;FILE IS OPEN FOR I/O. READ PREVIOUS INFO.
ENTOK: MOVEI T1,FILINF-1 ;PLACE TO START
HRRM T1,OLDSIZ ;FINISH IOWD
MOVE T1,OLDSIZ ;GET IOWD
SETZ T2, ;END OF LIST
IN DSK,T1 ;READ IT
JRST INOK ;GREAT
OUTSTR [ASCIZ/? CAN'T READ OLD LSTATS.DIR -- IN UUO FAILED
/]
EXIT ;GIVE UP
;CHECK CONSISTANCY, AND REPORT ANY OBVIOUS PROBLEMS
INOK: PUSHJ P,CSTCHK
JRST INCON ;FILE IS INCONSISTANT
POPJ P, ;ALL SET
INCON: OUTSTR [ASCIZ/[STARTING FRESH]
/]
PUSHJ P,REFRES ;REFRESH DATA AREA
POPJ P, ;AND RETURN
;ROUTINE TO READ NEXT LINE FROM TTY
GETLIN: MOVE T1,[POINT 7,LINE]
MOVEM T1,LINBP
IFN TOPS20,<
MOVEI T1,TXTIBL ;USE TEXTI BLOCK
MOVE T2,[POINT 7,LINE] ;BUFFER POINTER
MOVEM T2,.RDDBP(T1) ;STORE IT
MOVEI T2,LINLEN ;SIZE
MOVEM T2,.RDDBC(T1) ;STORE THAT
MOVX T2,RD%JFN!RD%BEL ;BREAK ON END OF TTY LINE
MOVEM T2,.RDFLG(T1) ;STORE FLAGS
TEXTI ;DO TEXTI
ERJMP [JSERR
POPJ P,]
MOVE T2,[POINT 7,LINE] ;LOOK AT LINE, TRANSFORM CR INTO LF
ILDB T1,T2
JUMPE T1,CPOPJ ;ALL DONE WHEN WE HAVE NUL
CAIE T1,15 ;HAVE CR?
JRST .-3 ;NO, LOOP UNTIL WE GOT IT OR NULL
MOVEI T1,12
DPB T1,T2 ;STORE LF ON TOP OF IT
SETZ T1,
IDPB T1,T2 ;THEN STORE NUL
POPJ P, ;RETURN OK
>
MOVEI T2,LINLEN ;MAX SIZE OF LINE
GETL1: PUSHJ P,INCH ;GET NEXT CHAR
JRST BRKCH ;BREAK CHAR
SOJL T2,BIGLIN ;COMPLAIN IF LINE TOO LONG
IDPB C,T1 ;STORE CHAR
JRST GETL1 ;LOOP
BIGLIN: OUTSTR [ASCIZ/? INPUT LINE TOO LONG - TRUNCATED
/]
PUSHJ P,INCH
JRST BRKCH
JRST .-2 ;EAT LINE UNTIL BREAK FOUND
BRKCH: MOVEI C,12 ;STORE LF
IDPB C,T1
POPJ P, ;RETURN, LINE DONE
;ROUTINE TO GET NEXT CHAR
GETC: ILDB C,LINBP
POPJ P, ;RETURN
;ROUTINE TO READ A DECIMAL NUMBER.
; POPJ'S IF FIRST NON-SPACE CHARACTER IS NOT A DIGIT.
RDNUM: SETZ T1, ;INTO T1
RDNUM1: PUSHJ P,GETC ;GET 1ST NON-SPACE CHARACTER
CAIE C,11
CAIN C,40
JRST RDNUM1
CAIL C,"0"
CAILE C,"9"
POPJ P, ;NOT A DIGIT, POPJ
AOS (P) ;WILL TAKE SKIP RETURN NOW
RDNUM2: IMULI T1,^D10
ADDI T1,-"0"(C) ;ADD IN DIGIT
PUSHJ P,GETC
CAIL C,"0"
CAILE C,"9"
POPJ P,
JRST RDNUM2 ;MORE DIGITS, KEEP GOING
;ROUTINE TO READ AN OCTAL NUMBER.
; POPJ'S IF FIRST NON-SPACE CHARACTER IS NOT A DIGIT.
RDOCT: SETZ T1, ;INTO T1
RDOCT1: PUSHJ P,GETC ;GET 1ST NON-SPACE CHARACTER
CAIE C,11
CAIN C,40
JRST RDOCT1
CAIL C,"0"
CAILE C,"7"
POPJ P, ;NOT A DIGIT, POPJ
AOS (P) ;WILL TAKE SKIP RETURN NOW
RDOCT2: LSH T1,3
ADDI T1,-"0"(C) ;ADD IN DIGIT
PUSHJ P,GETC
CAIL C,"0"
CAILE C,"7"
POPJ P,
JRST RDOCT2 ;MORE DIGITS, KEEP GOING
;ROUTINE TO READ A TIME LIMIT AS [NNND] [,] [HH:MM:SS]
; PUTS INTO T1 AS THE UNIVERSAL DATE/TIME FORMAT.
;THUS "1D" = 1,,0 "5D 3:00:00" = 5,,4231, ETC.
;RETURNS POPJ IF ERROR OR JUST "CRLF" TYPED
RDTIM: SETZM INTIM
PUSHJ P,RDNUM ;READ # DAYS OR HH
POPJ P, ;NOTHING, JUST POPJ
CAIN C,"D" ;DAYS?
JRST STRDYS ;YES
CAIN C,":" ;TIME?
JRST STRTM ;YES
CAIN C,12 ;CRLF?
JRST [HRLZM T1,INTIM ;STORE # DAYS
JRST DONDTM] ;AND DONE
BADFMT: TMSG <? FORMAT IS NNND HH:MM:SS
>
POPJ P, ;BAD RETURN
STRDYS: HRLZM T1,INTIM ;STORE # DAYS
STRDY1: PUSHJ P,RDNUM ;NEXT GET TIME
JRST [CAIN C,12
JRST DONDTM ;ALL DONE, OK
CAIN C,"," ;COMMA IS OK HERE
JRST STRDY1
JRST BADFMT] ;PROBLEMS
STRTM: HRRZ T2,INTIM ;GET OLD TIME
IMULI T2,^D60
ADDI T2,(T1)
HRRM T2,INTIM
PUSHJ P,RDNUM ;GET NEXT NN
JRST [CAIN C,12
JRST DONDTM ;ALL DONE, OK
JRST BADFMT] ;PROBLEMS
HRRZ T2,INTIM
IMULI T2,^D60
ADDI T2,(T1)
HRRM T2,INTIM
CAIN C,12
JRST DONDTM
PUSHJ P,RDNUM ;GET LAST NN
JRST [CAIN C,12
JRST DONDTM
JRST BADFMT]
HRRZ T2,INTIM
IMULI T2,^D60
ADDI T2,(T1)
HRRM T2,INTIM
DONDTM: HRRZ T1,INTIM ;GET SECS
IMULI T1,3 ;GET 1/3'S OF SECONDS
HRRM T1,INTIM ;DONE
MOVE T1,INTIM
CPOPJ1: AOS (P)
CPOPJ: POPJ P,
; TOPS10 ROUTINE TO READ A FILESPEC.
; RETURNS INFO IN "INFIL", "FILDEV".
IFE TOPS20,<
RDFILS:
PUSHJ P,RDSIX ;READ SIXBIT WORD
POPJ P, ;NOTHING THERE, RETURN
CAIN C,":" ;COLON?
JRST SAWDEV ;YES, SAW DEVICE NAME
CHKFNM: CAIE C,"." ;END OF FILENAME?
CAIN C,"["
JRST SAWFIL ;YES
CAIN C,12 ;END OF EVERYTHING?
JRST [MOVEM T1,INFIL ;YES, SAVE NAME
JRST CPOPJ1] ;AND RETURN OK
BADFNM: OUTSTR [ASCIZ/? FORMAT IS DEV:FILE.EXT[P,PN]
/]
POPJ P, ;BAD RETURN
SAWDEV: MOVEM T1,FILDEV ;SAVE DEVICE NAME
PUSHJ P,RDSIX ;READ NEXT SIXBIT WORD
JRST CPOPJ1 ;END--RETURN OK
JRST CHKFNM ;GO CHECK FILENAME
SAWFIL: MOVEM T1,INFIL ;SAVE FILENAME
CAIN C,"."
JRST GETEXT ;GO GET EXT
CAIN C,"["
JRST GETPPN ;GO GET PPN
JRST CPOPJ1 ;MUST BE LF, RETURN OK
GETEXT: PUSHJ P,RDSIX ;READ EXT
JRST [SETZM INFIL+1 ;NULL
JRST CPOPJ1]
CAIE C,"[" ;NOW CAN HAVE PPN
CAIN C,12 ;OR END
CAIA
JRST BADFNM ;ELSE COMPLAIN
HLLZM T1,INFIL+1 ;ELSE STORE EXT
CAIN C,12
JRST CPOPJ1 ;END IS OK
GETPPN: PUSHJ P,RDOCT ;READ OCTAL NUMBER
JRST [CAIN C,","
JRST PPNCMA ;COMMA IS OK
JRST BADFNM] ;ELSE BAD
CAIN C,"," ;COMMA IS OK
JRST PPNCMA
JRST BADFNM ;EVERYTHING ELSE IS BAD
PPNCMA: HRLM T1,INFIL+3
PUSHJ P,RDOCT ;READ NEXT NUMBER
JRST [CAIE C,"]"
CAIN C,12 ;END IS OK
JRST PPNOK
JRST BADFNM] ;ELSE BAD
CAIE C,"]"
CAIN C,12
JRST PPNOK
JRST BADFNM ;COMPLAIN IF SOMETHING FUNNY
PPNOK: HRRM T1,INFIL+3
JRST CPOPJ1 ;RETURN OK
>;END IFE TOPS20
;ROUTINE TO READ A SIXBIT WORD INTO T1
;RETURNS .+1 IF NOTHING THERE.
RDSIX: SETZ T1,
MOVE T2,[POINT 6,T1]
PUSHJ P,GETC
CAIN C,12
POPJ P, ;NOTHING THERE.
NXTLTR: CAIL C,"0"
CAILE C,"9"
JRST [CAIL C,"A"
CAILE C,"Z"
JRST CPOPJ1 ;NOT LETTER OR DIGIT
JRST .+1] ;OK
SUBI C,40 ;MAKE SIXBIT CHAR
TLNE T2,760000 ;UNLESS T1 FULL,
IDPB C,T2 ;STORE CHAR
PUSHJ P,GETC
JRST NXTLTR
;ROUTINE TO INPUT A CHAR FROM THE TERMINAL.
;SKIPS IF NOT A BREAK CHARACTER
INCH: INCHWL C ;READ INTO C
CAIN C,15
JRST INCH ;IGNORE CR
CAIN C,12
POPJ P, ;BREAK CHAR
CAIE C,33
CAIN C,175
JRST INCHLF ;ALTMODE--TYPE <LF> AND POPJ
CAIE C,7
CAIN C,13
POPJ P,
CAIE C,14
CAIN C,32
POPJ P,
CAIL C,"A"+40 ;UPPER CASE?
CAILE C,"Z"+40
CAIA
SUBI C,40 ;YES, MAKE LOWER CASE
AOS (P)
POPJ P, ;RETURN
INCHLF: OUTSTR [ASCIZ/
/]
POPJ P,
;TOPS10 SUBROUTINES
;ROUTINE TO ENTER THE FILE FOR UPDATING
ENTFIL: MOVE T1,['LSTATS'] ;ALSO USED BY TOPS20
MOVSI T2,'DIR' ; SINCE IT IS EASIER
SETZB T3,T4
ENTER DSK,T1 ;PREPARE TO UPDATE FILE
POPJ P, ;ENTER ERROR
AOS (P)
POPJ P,
IFE TOPS20,<
;TYPE NUMBER IN T2 IN OCTAL
TYPOCT: IDIVI T2,10
PUSH P,T3
SKIPE T2
PUSHJ P,TYPOCT
POP P,T2
ADDI T2,"0"
OUTCHR T2
POPJ P,
TYPDEC: IDIVI T2,^D10
PUSH P,T3
SKIPE T2
PUSHJ P,TYPDEC
POP P,T2
ADDI T2,"0"
OUTCHR T2
POPJ P,
;TYPE A STRING TO TTY
;BP IN T1
TTYSTR: ILDB T2,T1
JUMPE T2,CPOPJ ;DONE IF NULL SEEN
OUTCHR T2 ;TYPE CHAR
JRST TTYSTR ;LOOP FOR ALL
;TYPE A TIME IN UNIVERSAL DAY/TIME FORMAT
;IN T2, OUTPUT AS DD-MMM-YY HH:MM:SS
TYPTIM: PUSH P,T2 ;SAVE IT
HLRZ T1,T2 ;GET DAY
POP P,T2 ;RESTORE DAY/TIME
HRRZ T2,T2 ;SAVE 1/3'S OF SECONDS
IDIVI T2,3
PUSHJ P,HHMMSS ;TYPE HH:MM:SS
POPJ P, ;RETURN
>;END TOPS10 SUBROUTINES
SUBTTL TOPS20 SUBROUTINES
IFN TOPS20,<
TYPDEC: HRRZI T1,.PRIOU
MOVEI T3,^D10
NOUT
JSERR ;JSYS ERROR COMPLAIN
POPJ P, ;RETURN, NUMBER OUTPUT
TYPOCT: HRRZI T1,.PRIOU
MOVEI T3,^D8
NOUT
JSERR
POPJ P,
>;END TOPS20 SUBROUTINES
SUBTTL COMMON SUBROUTINES
;CONSISTANCY CHECK
CSTCHK: HRRZ T2,FILINF+.LDNFL ;GET # OF CURRENT FILE
HLRZ T3,FILINF+.LDNFL ;GET # OF FILES
CAILE T2,(T3) ;IS FILE EXHAUSTED?
JRST FILEXH ;YES--GO SET FLAG
CAILE T2,^D100 ;MORE THAN 100 FILES?
JRST TOOMNY ;YES
CAILE T3,^D100 ;MORE THAN 100 FILES ALLOWED?
JRST TOOMN1 ;YES! (HOW DID THIS HAPPEN??)
AOS (P) ;ALL OK
POPJ P,
FILEXH: TXO F,F.EXH ;REMEMBER FILE EXHAUSTED
OUTSTR [ASCIZ/[OLD FILE IS EXHAUSTED]
/]
AOS (P)
POPJ P,
TOOMNY: OUTSTR [ASCIZ/? CURRENT FILE NUMBER IS TOO LARGE
/]
POPJ P,
TOOMN1: OUTSTR [ASCIZ/? # FILES COUNTER IS GREATER THAN 100
/]
POPJ P,
;WRITE CHARACTERS AND STRINGS TO DUMPER/BACKUP OUTPUT COMMAND FILE.
OCH: ;CHARACTER TO BE OUTPUT IS IN T2
IFE TOPS20,<
SOSG OBUF+2
JRST OCHBUF
IDPB T2,OBUF+1
POPJ P,
OCHBUF: OUT DSKO,
JRST OCH+2
OUTSTR [ASCIZ/? OUT FAILED FOR BACKUP COMMAND FILE
/]
EXIT ;DIE OFF NOW!!
>
IFN TOPS20,<
MOVE T1,OJFN
BOUT
ERJMP BUTERR ;?BOUT FAILED - WE DON'T EXPECT THIS!
POPJ P,
BUTERR: HRROI T1,[ASCIZ/? BOUT FAILED WHILE WRITING DUMPER COMMAND FILE!
/]
PSOUT
SYSERR: JSERR ;TYPE ERROR
HALTF
JRST ST ;RESTART IF "CONTINUE"
>;END IFN TOPS20
WRTSTR: ILDB T2,P1 ;GET CHAR
JUMPE T2,CPOPJ ;RETURN AT NULL
PUSHJ P,OCH ;WRITE THE CHARACTER
JRST WRTSTR ;LOOP UNTIL NULL
;GET CHAR / LINE FROM FILE-SPEC FILE
IFE TOPS20,<
GETFSP: SOSG FSPBUF+2
JRST GETFBF
ILDB C,FSPBUF+1
JUMPE C,GETFSP ;IGNORE NULLS
AOS (P)
POPJ P,
GETFBF: IN FSP,
JRST GETFSP+2
POPJ P, ;ASSUME EOF
>
IFN TOPS20,<
GETFSP: MOVE T1,CMDJFN
BIN
ERJMP GETFS1 ;BIN ERROR - CHECK FOR EOF
JUMPE T2,GETFSP ;IGNORE NULLS
AOS (P)
POPJ P, ;RETURNS BYTE IN AC2
GETFS1: CAIN T2,0
POPJ P, ;EOF
JSERR ;SOME BAD ERROR!
JRST NEWCMD
GETFLN: TXNE F,F.FEF ;EOF SEEN?
POPJ P, ;YES, RETURN POPJ
MOVEI T3,LINLEN
MOVE T4,[POINT 7,LINE]
MOVEM T4,LINBP
TXZ F,F.SOL ;NO STUFF ON LINE YET
GETFL1: PUSHJ P,GETFSP ;GET CHAR FROM FILE
JRST EOFFSP ;EOF
CAIN T2,15 ;IGNORE CR
JRST GETFL1
CAIN T2,12 ;IS IT LF?
JRST EOLFSP ;YES
SOJL T3,BIGFLN ;LINE TOO LONG, TRUNCATED
TXO F,F.SOL ;THERE IS STUFF ON LINE
IDPB T2,T4 ;STORE CHAR
JRST GETFL1 ;LOOP
EOLFSP: IDPB T2,T4 ;STORE EOL
MOVEI T2,0 ;GET NULL
IDPB T2,T4 ;STORE THAT TOO
TXNN F,F.SOL ;ANY STUFF ON LINE?
JRST GETFLN ;NO, TRY AGAIN
AOS (P) ;GOT SOMETHING
POPJ P, ;RETURN, LINE DONE
EOFFSP: MOVEI T2,12 ;GET EOL
TXO F,F.FEF ;EOF ON FILE-SPEC-FILE
MOVE T1,CMDJFN
CLOSF ;CLOSE FILE (RELEASES JFN)
ERJMP [JSERR
POPJ P,]
JRST EOLFSP ;STORE EOL AND NULL
>;END IFN TOPS20
IFE TOPS20,<
;GET LINE
GETFLN: TXNE F,F.FEF ;EOF SEEN?
POPJ P, ;YES, RETURN POPJ
MOVEI T2,LINLEN
MOVE T1,[POINT 7,LINE] ;INTO "LINE"
MOVEM T1,LINBP
TXZ F,F.SOL ;NOTHING ON LINE SO FAR
GETFL1: PUSHJ P,GETFSP ;GET CHAR FROM FILE
JRST EOFFSP ;EOF
CAIN C,15 ;IGNORE CR
JRST GETFL1
CAIN C,12 ;IS IT LF?
JRST EOLFSP ;YES
SOJL T2,BIGFLN ;LINE TOO LONG, TRUNCATED
TXO F,F.SOL ;SAW SOMETHING ON LINE
IDPB C,T1 ;STORE CHAR
JRST GETFL1 ;LOOP
EOLFSP: IDPB C,T1 ;STORE EOL
MOVEI C,0 ;GET NULL
IDPB C,T1 ;STORE THAT TOO
TXNN F,F.SOL ;SKIP IF SOMETHING ON LINE
JRST GETFLN ;NOPE, TRY AGAIN
AOS (P) ;GOT SOMETHING
POPJ P, ;RETURN, LINE DONE
EOFFSP: MOVEI C,12 ;GET EOL
TXO F,F.FEF ;EOF ON FILE-SPEC-FILE
RELEAS FSP, ;RELEASE CHANNEL
JRST EOLFSP ;STORE EOL AND NULL
>;END IFE TOPS20
;LINE TOO LONG -- TRUNCATE BUT DON'T BOTHER TO GIVE WARNING
BIGFLN: PUSHJ P,GETFSP ;GET CHARS
JRST EOFFSP ;UNTIL EITHER EOF
CAIE C,12
JRST BIGFLN ;OR EOL
JRST EOLFSP
;TYPE A TIME (# SECS IN T2) AS HH:MM:SS
HHMMSS: IDIVI T2,^D60*^D60
PUSH P,T3
PUSHJ P,TYPNN
TMSG <:>
POP P,T2
IDIVI T2,^D60
PUSH P,T3
PUSHJ P,TYPNN
TMSG <:>
POP P,T2
PUSHJ P,TYPNN
POPJ P,
;TYPE 2 DIGITS OF NUMBER IN T2
TYPNN:
IFE TOPS20,<
IDIVI T2,^D10
ADDI T2,"0"
ADDI T3,"0"
OUTCHR T2
OUTCHR T3
POPJ P,
>
IFN TOPS20,<
IDIVI T2,^D10
MOVEI T1,"0"(T2)
PBOUT
MOVEI T1,"0"(T3)
PBOUT
POPJ P,
>
;SETUP DEFAULTS
DEFSET: MOVE T1,[1,,0] ;TIME LIMIT ON BOTH SYSTEMS IS 1 DAY
MOVEM T1,FILINF+.LDTML
IFE TOPS20,<
MOVEI T1,^D4000 ;4000 BLOCK LIMIT FOR TOPS10 FILES
>
IFN TOPS20,<
MOVEI T1,^D1000 ;1000 PAGE LIMIT FOR TOPS20 FILES
>
MOVEM T1,FILINF+.LDSZL
SETZM FILINF+.LDFWR ;NOBODY WROTE TO 1ST FILE YET
MOVE T1,[DEFLEN,,1] ;DEFLEN FILES IN DIRECTORY, CURRENT FILE IS #1
MOVEM T1,FILINF+.LDNFL
MOVE T1,[POINT 7,.LDAFN] ;POINTER TO 1ST FILE
MOVEM T1,FILINF+.LDBPC
ADDI T1,FILINF ;MAKE ACTUAL BYTE PTR
;STICK IN DEFAULT FILENAMES
SETZ T2, ;POINTER INTO FILE NAME TABLE
FILLP: HRRZ T3,DEFFTB(T2) ;GET A DEFAULT FILENAME FROM LIST
HRLI T3,(POINT 7,) ;MAKE BP TO IT
FILLP1: ILDB T4,T3
IDPB T4,T1
JUMPN T4,FILLP1 ;JUMP IF MORE CHARS IN THIS ONE
AOJ T2, ;GO ON TO NEXT
CAIE T2,DEFLEN ;DONE 'EM ALL?
JRST FILLP ;NO, MORE.
POPJ P, ;DEFAULTS ALL DONE, RETURN
DEFINE DD(FILE),<
[ASCIZ/FILE/]
>
DEFFTB: DD OUT1.MTO
DD OUT2.MTO
DD OUT3.MTO
DD OUT4.MTO
DD OUT5.MTO
DD OUT6.MTO
DD OUT7.MTO
DD OUT8.MTO
DD OUT9.MTO
DD OUT10.MTO
DD OUT11.MTO
DD OUT12.MTO
DD OUT13.MTO
DD OUT14.MTO
DD OUT15.MTO
DD OUT16.MTO
DD OUT17.MTO
DD OUT18.MTO
DD OUT19.MTO
DD OUT20.MTO
DD OUT21.MTO
DD OUT22.MTO
DD OUT23.MTO
DD OUT24.MTO
DD OUT25.MTO
DD OUT26.MTO
DD OUT27.MTO
DD OUT28.MTO
DD OUT29.MTO
DD OUT30.MTO
DD OUT31.MTO
DD OUT32.MTO
DD OUT33.MTO
DD OUT34.MTO
DD OUT35.MTO
DD OUT36.MTO
DD OUT37.MTO
DD OUT38.MTO
DD OUT39.MTO
DD OUT40.MTO
DD OUT41.MTO
DD OUT42.MTO
DD OUT43.MTO
DD OUT44.MTO
DD OUT45.MTO
DD OUT46.MTO
DD OUT47.MTO
DD OUT48.MTO
DD OUT49.MTO
DD OUT50.MTO
DD OUT51.MTO
DD OUT52.MTO
DD OUT53.MTO
DD OUT54.MTO
DD OUT55.MTO
DD OUT56.MTO
DD OUT57.MTO
DD OUT58.MTO
DD OUT59.MTO
DD OUT60.MTO
DD OUT61.MTO
DD OUT62.MTO
DD OUT63.MTO
DD OUT64.MTO
DD OUT65.MTO
DD OUT66.MTO
DD OUT67.MTO
DD OUT68.MTO
DD OUT69.MTO
DD OUT70.MTO
DD OUT71.MTO
DD OUT72.MTO
DD OUT73.MTO
DD OUT74.MTO
DD OUT75.MTO
DD OUT76.MTO
DD OUT77.MTO
DD OUT78.MTO
DD OUT79.MTO
DD OUT80.MTO
DD OUT81.MTO
DD OUT82.MTO
DD OUT83.MTO
DD OUT84.MTO
DD OUT85.MTO
DD OUT86.MTO
DD OUT87.MTO
DD OUT88.MTO
DD OUT89.MTO
DD OUT90.MTO
DD OUT91.MTO
DD OUT92.MTO
DD OUT93.MTO
DD OUT94.MTO
DD OUT95.MTO
DD OUT96.MTO
DD OUT97.MTO
DD OUT98.MTO
DD OUT99.MTO
DD OUT100.MTO
DEFLEN==.-DEFFTB
SUBTTL DATA STORAGE
XLIST ;DUMP LITERALS
LIT
LIST
IFN TOPS20,<
;TEXTI BLOCK FOR READING LINES
TXTIBL: .RDRTY ;LAST WORD GIVEN
0 ;FLAGS
.PRIIN,,.PRIOU ;INPUT,,OUTPUT JFNS
0 ;DESTINATION PTR (FILLED IN)
0 ;BYTES AVAILABLE (FILLED IN)
0 ;USE START OF BUFFER AS ABOVE
0 ;CONTROL-R BUFFER (FILLED IN)
>;END IFN TOPS20
STBEG==.
PDL: BLOCK PDLSIZ ;PUSHDOWN STACK
OLDSIZ: BLOCK 1 ;-LEN,,0 FOR OLD FILE SIZE
FILINF: BLOCK FILLEN ;FILE INFO
LINBP: BLOCK 1
LINE: BLOCK <LINLEN+4>/5
OUTLIN: BLOCK <LINLEN+4>/5
IFE TOPS20,<
FILDEV: BLOCK 1 ;INPUT DEVICE
INFIL: BLOCK 4 ;INPUT FILESPEC
OBUF: BLOCK 3 ;OUTPUT BUFFER HEADER
FSPBUF: BLOCK 3 ;FILE-SPEC FILE BUFFER HEADER
>
IFN TOPS20,<
CMDJFN: BLOCK 1 ;JFN OF COMMAND FILE ("F" COMMAND)
TJFN: BLOCK 1 ;TEMP JFN
OJFN: BLOCK 1 ;OUTPUT JFN FOR DUMPER COMMAND FILE
>;END IFN TOPS20
INTIM: BLOCK 1 ;INPUT DATE/TIME
STEND==.-1
END ST