Trailing-Edge
-
PDP-10 Archives
-
decuslib20-06
-
decus/20-159/dstats.mac
There are no other files named dstats.mac in the archive.
COMMENT \
MODIFICATIONS TO PROGRAM (VERSION/EDIT CHANGES)
[75] 31-Jul-81 Install "TAKE" command
[76] 4-Aug-81 Fix bug where second thru Nth OUTPUT was ignored,
causing output to be written to default output file
[77] 23-Sep-81 Fix bug, if logical name given for directory, infinite
loop would occur
\ ;End revision history
TITLE DSTATS
SEARCH MACSYM,MONSYM,ACTSYM
AC1==1 ;\
AC2==2 ; \
AC3==3 ; / USED FOR MONITOR CALLS
AC4==4 ;/
AC5==5
AC6==6
AC7==7
AC10=10
AC11=11
AC12==12
AC13==13
AC14==14
AC15==15
CX==16
P=17
; define bit positions
; all definations in the format KW%xxx are for Keywords. If on, then that info
; is to be written to the output file.
KW%DEF==1B0 ;default-account
KW%HDR==1B1 ;header
KW%PAG==1B2 ;pages in use
KW%PCT==1B3 ;percent of permanent allocation used.
KW%PER==1B4 ;permenant allocation
KW%SUM==1B5 ;summary
KW%WOR==1B6 ;working allocation
KW%CRM==1B7 ;cram (or don't) output into 80 columns
KW.ALL==KW%HDR+KW%PAG+KW%PCT+KW%PER+KW%SUM+KW%WOR
.PDLSZ==^D50 ;PUSH-DOWN-LIST SIZE.
BUF.SZ==5000 ;bytes in buffer
ATM.SZ==5000 ;bytes in atom buffer
DIR.CR==^D28 ;bytes to output for directory name (crammed)
DIR.NC==^D50 ;bytes to output for directory name (not crammed)
ACC.CR==^D20 ;bytes to output for default account (crammed)
ACC.NC==^D40 ;bytes to output for default account (not crammed)
; DEFINES FOR EDIT/VERSION NUMBERS.
PRGVER==3 ;VERSION NUMBER
PRGMIN==2 ;MINOR VERSION NUMBER.
PRGEDT==77 ;EDIT NUMBER.
PRGWHO==0 ;WHO EDITED
%PRG==<BYTE (3)PRGWHO(9)PRGVER(6)PRGMIN(18)PRGEDT>
LOC 137
.JBVER::EXP %PRG
DSTATS:
; Initialization
RESET ;CLOSE AND EXPUNGE OPEN FILES.
MOVE P,[IOWD .PDLSZ,PDLST] ;SET UP PUSH DOWN STACK.
SETZ AC1, ;clear out garbage from ac1
TLO AC1,(KW.ALL) ;turn on all bits to start out with
MOVEM AC1,KW.FLG ;save all turned on bits
MOVEI AC1,DIR.NC ;get number of byte to write for <dir>
MOVEM AC1,DIRLEN ;save it for later use.
MOVEI AC1,ACC.NC ;get number of bytes to write account
SETZB DIRNUM,DIRSPC ;clear out directory number(s)
; SET UP FUNCTION BLOCKS
; SET UP KEYWORD BLOCK
MOVE AC1,[0B8] ;this is a keyword
MOVEM AC1,KEYBLK+.CMFNP ;save it
HRROI AC1,KWLST ;pointer to keyword list
MOVEM AC1,KEYBLK+.CMDAT ;save it
; SET UP "NO" BLOCK
MOVE AC1,[0B8] ;more keywords
MOVEM AC1,NOBLK+.CMFNP ;save it
HRROI AC1,NOLST ;pointer to "NO" keywords
MOVEM AC1,NOBLK+.CMDAT ;save it
; SET UP GUIDE BLOCK
; (Pointer to string to be provided before call for guide-word parsing.)
MOVE AC1,[2B8] ;guide word
MOVEM AC1,GDBLK+.CMFNP ;save it
; SET UP OUTPUT BLOCK
MOVE AC1,[5B8+CM%DPP+CFMBLK] ;output spec, default and confirm
MOVEM AC1,OUTBLK+.CMFNP ;save it
HRROI AC1,OUTDEF ;pointer to default
MOVEM AC1,OUTBLK+.CMDEF ;save it
; SET UP DIRECTORY BLOCK
MOVE AC1,[11B8+CM%DPP+CFMBLK] ;directory spec, default
MOVEM AC1,DIRBLK+.CMFNP ;save it
HRROI AC1,DIRDEF ;pointer to default
MOVEM AC1,DIRBLK+.CMDEF ;save it
MOVE AC1,[CM%DWC] ;allow wild-cards
MOVEM AC1,DIRBLK+.CMDAT ;save it.
; SET UP THE INITIALIZATION BLOCK
MOVE AC1,[14B8] ;initialization
MOVEM AC1,INIBLK+.CMFNP ;save it
; SET UP THE CONFIRMATION BLOCK
MOVE AC1,[10B8] ;for confirmation
MOVEM AC1,CFMBLK+.CMFNP ;save it
;**;[75] Add 4 lines at DSTATS + 33L RWW 31-JUL-81
;[75] SET UP INPUT BLOCK FOR "TAKE"
MOVE AC1,[4B8+CM%DPP+CFMBLK] ;[75]input file, default, confirm
MOVEM AC1,TAKBLK+.CMFNP ;[75]save it
HRROI AC1,TAKDEF ;[75]pointer to take default
MOVEM AC1,TAKBLK+.CMDEF ;[75]save it
; SET UP COMMAND STATE BLOCK
MOVEI AC1,REPARS ;reparse address
TLO AC1,(CM%RAI) ;raise all input
MOVEM AC1,CMDBLK+.CMFLG ;save it
MOVE AC1,[.PRIIN,,.PRIOU] ;input/output for parsing
MOVEM AC1,CMDBLK+.CMIOJ ;save it
HRROI AC1,PROMPT ;pointer to prompt
MOVEM AC1,CMDBLK+.CMRTY ;save it
HRROI AC1,INPUT ;pointer to user input
MOVEM AC1,CMDBLK+.CMBFP ;save it
MOVEM AC1,CMDBLK+.CMPTR ;save it for buffer too
MOVEI AC1,BUF.SZ ;get buffer size
MOVEM AC1,CMDBLK+.CMCNT ;save it
SETZM CMDBLK+.CMINC ;clear count of bytes
HRROI AC1,ATMBUF ;pointer to atom buffer
MOVEM AC1,CMDBLK+.CMABP ;save it
MOVEI AC1,ATM.SZ ;size of atom buffer
MOVEM AC1,CMDBLK+.CMABC ;save it
MOVEI AC1,JFNBLK ;address of GTJFN block
MOVEM AC1,CMDBLK+.CMGJB ;save it
; COMMAND STATE BLOCK ALL SET...
COMAND: ;here to start parsing
MOVEI AC1,CMDBLK ;address of command state block
MOVEI AC2,INIBLK ;address of initialization block
COMND ;initialize COMND jsys
;**;[75]Change one line at COMAND: + 3L RWW 31-JUL-81
ERCAL EOFTST ;[75]test if EOF on "TAKE"
REPARS: ;here to re-parse
MOVEI AC1,CMDBLK ;address of command state block
MOVEI AC2,KEYBLK ;address of keywork block
COMND ;parse a keyword
;**;[75]Change one line at REPARS: + 3L RWW 31-JUL-81
ERCAL EOFTST ;[75]test if EOF on "TAKE"
TLNE AC1,(CM%NOP) ;is it a valid command?
JRST NOCMND ;no
HRRZ AC1,@AC2 ;yes
PUSHJ P,@AC1 ;go to dispatch location for keyword
JRST COMAND ;get next command
NOCMND: ;here on invalid command
TLNE AC1,(CM%EOC) ;was command ended with <CR>?
JRST .+3 ;yes
HRROI AC1,CRLF ;no
PSOUT ;write out a <CR/LF>
HRROI AC1,NCOMND ;write out error message
PSOUT ;do it
HRROI AC1,CRLF ;write out another <CR/LF>
JRST COMAND ;go back and get next command
KW010D: ;dispatch address for keyword #10
HRROI AC1,KW010G ;pointer guide word for command
PUSHJ P,GDWORD ;parse it
POPJ P, ;error, return (not parsed)
PUSHJ P,CNFRM ;get confirmation on command
POPJ P, ;not confirmed, return
TSTJFN: ;confirmed
MOVE AC1,OUTJFN ;get output jfn
MOVE AC2,[7B5+OF%WR] ;7 bit, write
OPENF ;try to open it
ERJMP .+2 ;no, skip next instruction
;this error occures when the
;command "OUTPUT" has not
;be given. so the default is used
JRST HAVJFN ;opened ok, go on
MOVE AC1,[GJ%SHT+GJ%NEW+GJ%FOU] ;short,new,next generation
HRROI AC2,OUTDEF ;use default output file
GTJFN ;get a jfn
ERJMP FATAL ;oops.
MOVEM AC1,OUTJFN ;save the jfn
JRST TSTJFN ;go back and try again
HAVJFN:
MOVE AC1,DIRNUM ;get the directory number specified
CAIE AC1,0 ;is it 0?
JRST HAVDIR ;no, good
MOVE AC1,[RC%PAR+RC%AWL] ;yes, no directory spec given, use
;default
HRROI AC2,DIRDEF ;pointer to default directory
RCDIR ;get directory number of it.
ERJMP FATAL ;oops...
MOVEM AC3,DIRNUM ;save it
HRROI AC1,DIRNAM ;pointer to where to store name
HRROI AC2,DIRDEF ;pointer to default
SETZ AC3, ;all characters
SOUT ;write the default
ERJMP FATAL ;oops...
HAVDIR:
MOVE AC15,KW.FLG ;get the flag word for the keywords
TLNN AC15,(KW%HDR) ;is HEADER wanted?
JRST NOHEAD ;no, skip header routine
TLNN AC15,(KW%PAG) ;yes, test of pages in used is set?
JRST .+6 ;no skip that part of header
MOVE AC1,OUTJFN ;yes, get output jfn
HRROI AC2,H1 ;pointer to header 1
SETZ AC3, ;don't care
SOUT ;write it
ERJMP FATAL ;oops.
TLNN AC15,(KW%PER) ;test for permanent allocation
JRST .+6 ;no, skip header 2
MOVE AC1,OUTJFN ;get output jfn
HRROI AC2,H2 ;pointer to header 2
SETZ AC3, ;don't care
SOUT ;write it
ERJMP FATAL ;oops.
TLNN AC15,(KW%WOR) ;test for working allocation
JRST .+6 ;no, skip header 3
MOVE AC1,OUTJFN ;get output jfn
HRROI AC2,H3 ;pointer to header 3
SETZ AC3, ;all of it
SOUT ;write it
ERJMP FATAL ;oops...
TLNN AC15,(KW%PCT) ;test for percent used
JRST .+6 ;no
MOVE AC1,OUTJFN ;get output jfn
HRROI AC2,H4 ;pointer to header 4
SETZ AC3, ;all of it
SOUT ;write it
ERJMP FATAL ;oops...
TLNE AC15,(KW%CRM) ;test for cramming output
JRST .+6 ;yes
MOVE AC1,OUTJFN ;get output jfn
HRROI AC2,SPC2 ;write 2 spaces
SETZ AC3, ;all of it.
SOUT ;write them
ERJMP FATAL ;oops...
MOVE AC1,OUTJFN ;get output jfn
HRROI AC2,H5 ;pointer to header 5
SETZ AC3, ;all of it.
SOUT ;write it
ERJMP FATAL ;oops...
TLNN AC15,(KW%DEF) ;test if default account wanted
JRST NODEFH ;no.
TLNE AC15,(KW%CRM) ;test for cram
JRST .+6 ;yes
MOVE AC1,OUTJFN ;output jfn
HRROI AC2,SPC22 ;write 22 spaces
SETZ AC3, ;all of them
SOUT ;write them
ERJMP FATAL ;oops.
MOVE AC1,OUTJFN ;output jfn
HRROI AC2,H6 ;pointer to header 6
SETZ AC3, ;all of it
SOUT ;write it.
ERJMP FATAL ;oops...
NODEFH:
MOVE AC1,OUTJFN ;get output jfn
HRROI AC2,CRLF ;pointer to <CR/LF>
SETZ AC3, ;all of it
SOUT ;write it
ERJMP FATAL ;oops...
NOHEAD:
LOOPA: ;main loop
MOVE AC1,DIRNUM ;get the current directory number
GTDAL ;get disk allocation
ERJMP FATAL ;oops...
MOVEM AC1,WRKALL ;save the working allocation
MOVEM AC2,PAGUSE ;save the pages in use
HRRZ AC2,AC2 ;clean out left half
ADDM AC2,DTOTAL ;add it to total for this spec
MOVEM AC3,PRMALL ;save the permanent allocation
TLNN AC15,(KW%PAG) ;test if "PAGUSE" is wanted
JRST NOPAG ;no, skip
MOVE AC1,OUTJFN ;yes, get output jfn
; MOVE AC2,PAGUSE
HRRZ AC2,PAGUSE ;get pages in use
MOVE AC3,[NO%MAG+NO%LFL+NO%OOV+NO%AST+6B17+12]
NOUT ;write it
ERJMP FATAL ;oops...
NOPAG:
TLNN AC15,(KW%PER) ;test if "PRMALL" is wanted
JRST NOPER ;no, skip
MOVE AC1,OUTJFN ;yes, get output jfn
MOVE AC2,PRMALL ;get permanent allocation
TLNE AC2,(-1B17) ;test for +INF
JRST INFPRM ;yes, skip
MOVE AC3,[NO%MAG+NO%LFL+NO%AST+7B17+12]
NOUT ;no, write out allocation
ERJMP FATAL ;oops...
JRST WRKCHK ;skip to testing to work all.
INFPRM:
HRROI AC2,INFMSG ;pointer to +INF
SETZ AC3, ;all of it
SOUT ;write it
ERJMP FATAL ;oops...
NOPER:
WRKCHK:
TLNN AC15,(KW%WOR) ;test it working allocation is wanted
JRST NOWOR ;no, skip
MOVE AC1,OUTJFN ;yes, output jfn
MOVE AC2,WRKALL ;get working allocation
TLNE AC2,(-1B17) ;is it +INF?
JRST INFWRK ;yes, say so
MOVE AC3,[NO%MAG+NO%LFL+NO%AST+7B17+12]
NOUT ;no, write it out
ERJMP FATAL ;oops...
JRST PCTCHK ;go check for percent
INFWRK:
HRROI AC2,INFMSG ;pointer to +INF message
SETZ AC3, ;all of it
SOUT ;write it
ERJMP FATAL ;oops...
NOWOR:
PCTCHK:
TLNN AC15,(KW%PCT) ;test if percent wanted
JRST NOPCT ;no, skip
FLTR AC2,PRMALL ;yes, make prmall floating
MOVEM AC2,PRMFLT ;save it as floating
MOVE AC2,PAGUSE ;get inuse
IMULI AC2,^D100 ;multiply it by 100
FLTR AC2,AC2 ;make it floating
FDV AC2,PRMFLT ;devide it for %
MOVE AC1,OUTJFN ;get output jfn
MOVE AC3,[FL%PNT+FL%ONE+7B23+2B29]
FLOUT ;write percent
ERJMP FATAL ;oops...
TLNE AC15,(KW%CRM) ;test for cram
JRST .+5 ;yes, skip
HRROI AC2,SPC1 ;no, pointer to a space
SETZ AC3, ;write it all
SOUT ;write it
ERJMP FATAL ;oops...
HRROI AC2,PERCNT ;pointer to "%"
SETZ AC3, ;all of it.
SOUT ;write it
ERJMP FATAL ;oops...
NOPCT:
TLNE AC15,(KW%CRM) ;test for cram
JRST .+6 ;yes, skip
MOVE AC1,OUTJFN ;get output jfn
HRROI AC2,SPC1 ;get ready to write a space
SETZ AC3, ;all of it.
SOUT ;write it.
ERJMP FATAL ;oops...
; write out directory name
MOVE AC1,OUTJFN ;output jfn
HRROI AC2,SPC1 ;pointer to 1 space
SETZ AC3, ;write all of it
SOUT ;write it.
ERJMP FATAL ;oops...
MOVE AC1,SPC5 ;move 5 space to ac1
MOVEM AC1,DIROUT+0 ;put the spaces in dirout
MOVEM AC1,DIROUT+1 ; !!
MOVEM AC1,DIROUT+2 ; !!
MOVEM AC1,DIROUT+3 ; !!
MOVEM AC1,DIROUT+4 ; !!
MOVEM AC1,DIROUT+5 ; !!
MOVEM AC1,DIROUT+6 ; !!
MOVEM AC1,DIROUT+7 ; !!
MOVEM AC1,DIROUT+10 ; !!
MOVEM AC1,DIROUT+11 ;_______\/______
HRROI AC1,DIROUT ;pointer to where to write directory
MOVE AC2,DIRNUM ;directory number
DIRST ;write directory name
ERJMP FATAL ;oops...
MOVEI AC2," " ;fill in the nul with a space
BOUT ;do it
ERJMP FATAL ;oops...
MOVE AC1,OUTJFN ;get output jfn
HRROI AC2,DIROUT ;write the directory name to it
MOVE AC3,DIRLEN ;but only these may letters
SETZ AC4, ;or until a <NUL>
SOUT ;do it to it
ERJMP FATAL ;oops...
TLNN AC15,(KW%DEF) ;test if default account is wanted
JRST NODEF ;no, skip
MOVE AC1,SPC5 ;yes, move 5 space to ac1
MOVEM AC1,DEFACC+0 ;save them in defacc
MOVEM AC1,DEFACC+1 ; !!
MOVEM AC1,DEFACC+2 ; !!
MOVEM AC1,DEFACC+3 ; !!
MOVEM AC1,DEFACC+4 ; !!
MOVEM AC1,DEFACC+5 ; !!
MOVEM AC1,DEFACC+6 ; !!
MOVEM AC1,DEFACC+7 ;_______\/_______
HRROI AC1,DEFACC ;pointer where to write default account
MOVEM AC1,DIRINF+.CDDAC ;save it
MOVE AC1,DIRNUM ;get directory number
MOVEI AC2,DIRINF ;get address of block for gtdir
SETZ AC3, ;no password
GTDIR ;get directory stats.
ERJMP .+1 ;for disabled users only, ignore
MOVE AC1,DIRINF+.CDDAC ;get pointer for last byte
MOVEI AC2," " ;write a space over trailing <NUL>
BOUT ;do it to it
ERJMP FATAL ;oops...
MOVE AC1,OUTJFN ;get output jfn
HRROI AC2,DEFACC ;pointer to default account
MOVE AC3,ACCLEN ;this many characters.
SETZ AC4, ;or until <NUL>
SOUT ;write it
ERJMP FATAL ;oops...
NODEF:
MOVE AC1,OUTJFN ;get output jfn
HRROI AC2,CRLF ;pointer to <CR/LF>
SETZ AC3, ;all of it
SOUT ;write it
ERJMP FATAL ;oops...
MOVE AC1,[RC%PAR+RC%STP+RC%AWL]
HRROI AC2,DIRNAM ;pointer to directory name
MOVE AC3,DIRNUM ;dirnum of current directory
RCDIR ;get next directory number
ERJMP FATAL ;oops...
MOVEM AC3,DIRNUM ;save it.
;**;[77] CHANGE ONE LINE AT NODEF: +11 LINES 23-SEP-81 RWW
TLNN AC1,(RC%NMD+RC%NOM) ;[77]test if no-more-directories
JRST LOOPA ;no, do next directory
MOVE AC1,DTOTAL ;get total pages for this spec
ADDM AC1,GTOTAL ;add it to grand total
TLNN AC15,(KW%SUM) ;test if summary wanted
JRST NOSUM ;no, skip
MOVE AC1,OUTJFN ;get output jfn
HRROI AC2,CRLF ;yes, extra <CR/LF>
SETZ AC3, ;all of it
SOUT ;write it
HRROI AC2,SUM1A ;first half of sum line 1
SETZ AC3, ;all of it.
SOUT ;write it
ERJMP FATAL ;oops...
MOVE AC2,DTOTAL ;get total disk usage for specs
MOVE AC3,[NO%LFL+10B17+12] ;in decimal
NOUT ;write it
ERJMP FATAL ;oops...
HRROI AC2,SUM1B ;2nd half of sum lin 1
SETZ AC3, ;all of it.
SOUT ;write it
ERJMP FATAL ;oops...
HRROI AC2,DIRNAM ;pointer to directory spec
SETZ AC3, ;all of it
SOUT ;write it out
ERJMP FATAL ;oops...
HRROI AC2,CRLF ;pointer to <CR/LF>
SETZ AC3, ;all of it
SOUT ;write it
ERJMP FATAL ;oops...
HRROI AC2,SUM2A ;1st half of sum line 2
SETZ AC3, ;all of it.
SOUT ;write it
ERJMP FATAL ;oops...
MOVE AC2,GTOTAL ;get grand total
MOVE AC3,[NO%LFL+10B17+12] ;in decimal
NOUT ;write it
ERJMP FATAL ;oops...
HRROI AC2,SUM2B ;write the 2nd half of line 2
SETZ AC3, ;al of it
SOUT ;write it
ERJMP FATAL ;oops...
HRROI AC2,CRLF ;pointer to <CR/LF>
SETZ AC3, ;all of it
SOUT ;write it
ERJMP FATAL ;oops...
NOSTR:
HRROI AC1,DIRNAM ;pointer to directory name
STDEV ;get device designator for it
ERJMP .+2 ;no structure given skip instr.
JRST OKSTR ;structure ok, proceed
COMMENT/
if this section of code is reached, it is because the user
didn't specify a structure name. Therefore, the connected
structure is assumed.
The method of getting the connected structure is quite simple,
1) just get the connected directory
2) write the connected directory to memory ("DIRNAM")
3) get the structure from memory ("DIRNAM" is STR:<DIRECTORY>)
4) go back and try again.
/
GJINF ;get connected directory
ERJMP FATAL ;oops...
HRROI AC1,DIRNAM ;pointer where to store directory name
DIRST ;get the directory name
ERJMP FATAL ;oops...
JRST NOSTR ;go back and try again
OKSTR:
MOVE AC1,AC2 ;move the structure's device # to ac1
GDSKC ;get disk usage for that structure
ERJMP FATAL ;oops...
MOVEM AC1,USED ;save the pages in use
MOVEM AC2,FREE ;save the count of free pages
MOVE AC1,OUTJFN ;get output jfn
HRROI AC2,SUM3A ;get ready to write summary line
SETZ AC3, ;write 1st half of it
SOUT ;do it
ERJMP FATAL ;oops...
MOVE AC2,USED ;retrieve the pages in use
MOVE AC3,[NO%LFL+10B17+12] ;want decimal, 8 chars
NOUT ;write it
ERJMP FATAL ;oops...
HRROI AC2,SUM3B ;write the 2nd half of message
SETZ AC3, ;all of it
SOUT ;write it
ERJMP FATAL ;oops...
HRROI AC2,DIRNAM ;pointer to directory spec
MOVEI AC3,7 ;write a max of 7 chars
MOVEI AC4,":" ;or until a colon
SOUT ;write it (structure name only)
ERJMP FATAL ;oops...
HRROI AC2,CRLF ;pointer to <CR/LF>
SETZ AC3, ;all of it
SOUT ;write it
ERJMP FATAL ;oops...
HRROI AC2,SUM3A ;pointer to 1st half of sum #4
SETZ AC3, ;all of it
SOUT ;write it
ERJMP FATAL ;oops...
MOVE AC2,FREE ;get the number of free pages
MOVE AC3,[NO%LFL+10B17+12] ;decimal, 8 chars
NOUT ;write it
ERJMP FATAL ;oops...
HRROI AC2,SUM4B ;pointer to 2nd half of sum 4
SETZ AC3, ;all of it.
SOUT ;write it
ERJMP FATAL ;oops...
HRROI AC2,DIRNAM ;pointer to structure name
MOVEI AC3,7 ;only first 7 chars
MOVEI AC4,":" ;or until a colon
SOUT ;write it.
ERJMP FATAL ;oops...
HRROI AC2,CRLF ;pointer to <CR/LF>
SETZ AC3, ;all of it.
SOUT ;write it
ERJMP FATAL ;oops...
HRROI AC2,CRLF ;pointer to <CR/LF> (2 of them)
SETZ AC3, ;all of it
SOUT ;write it
ERJMP FATAL ;oops...
NOSUM:
SETZM DTOTAL ;clear output the total for spec
SETZB DIRNUM,DIRSPC ;clear out dirnum, and the spec
MOVE AC1,OUTJFN ;get the output jfn
CLOSF ;close it
ERJMP FATAL ;oops...
SETZB AC6,AC7 ;[76]clear out old jfns
SETZM OUTJFN ;[76]at this address too
POPJ P, ;return, get next command
KW020D:
HRROI AC1,KW020G ;pointer to guide word
PUSHJ P,GDWORD ;parse it
POPJ P, ;error, return
PUSHJ P,CNFRM ;confirm?
POPJ P, ;no, return
SETZM GTOTAL ;yes, clear grand total
POPJ P, ;return
KW030D:
HRROI AC1,KW030G ;pointer to guide word
PUSHJ P,GDWORD ;parse it
POPJ P, ;error, return
PUSHJ P,CNFRM ;confirm?
POPJ P, ;no, return
MOVE AC1,KW.FLG ;yes, get flag word
TLO AC1,(KW%CRM) ;turn on "CRAM"
MOVEM AC1,KW.FLG ;save flag word
MOVEI AC1,DIR.CR ;get no of chars to output for dir
MOVEM AC1,DIRLEN ;save it
MOVEI AC1,ACC.CR ;get # chars to output for account
MOVEM AC1,ACCLEN ;save it
POPJ P, ;return
KW030N:
PUSHJ P,CNFRM ;confirm?
POPJ P, ;no, return
MOVE AC1,KW.FLG ;get flag word.
TLZ AC1,(KW%CRM) ;turn off "CRAM"
MOVEM AC1,KW.FLG ;save flag word
MOVEI AC1,DIR.NC ;get # chars for directory
MOVEM AC1,DIRLEN ;save it
MOVEI AC1,ACC.NC ;get # chars for accounts
MOVEM AC1,ACCLEN ;save it
POPJ P, ;return
KW040D:
HRROI AC1,KW040G ;pointer to guide word
PUSHJ P,GDWORD ;parses it
POPJ P, ;error, return
PUSHJ P,CNFRM ;confirm?
POPJ P, ;no, return
MOVE AC1,KW.FLG ;yes, get flag word
TLO AC1,(KW%DEF) ;turn on "DEFAULT-ACCOUNTS"
MOVEM AC1,KW.FLG ;save new flag word
POPJ P, ;return
KW040N:
PUSHJ P,CNFRM ;confirm?
POPJ P, ;no, return
MOVE AC1,KW.FLG ;yes, get flag word
TLZ AC1,(KW%DEF) ;turn off "DEFAULT-ACCOUNTS"
MOVEM AC1,KW.FLG ;save new flag word
POPJ P, ;return
KW050D:
HRROI AC1,KW050G ;pointer to guide word
PUSHJ P,GDWORD ;parse it.
POPJ P, ;error, return
MOVEI AC1,CMDBLK ;address of command state block
MOVEI AC2,DIRBLK ;parse a directory
COMND ;parse it
;**;[75]Change one line at KW050D: + 6L RWW 31-JUL-81
ERCAL EOFTST ;[75]test if EOF on "TAKE"
TLNE AC1,(CM%NOP) ;is it a valid command?
JRST BADDIR ;no, skip
MOVE AC10,AC2 ;yes, save dir num in ac10
PUSHJ P,CNFRM ;confirm?
POPJ P, ;no, return
MOVE AC2,AC10 ;yes, move the dir num back
CAIN AC2,0 ;is it 0 (a spec that doesn't exist)?
JRST INVDIR ;yes, treat it as invalid direc
MOVEM AC2,DIRNUM ;no, save the directory number
MOVEM AC2,DIRSPC ;twice
HRROI AC1,DIRNAM ;pointer where to store name
HRROI AC2,ATMBUF ;pointer to where it is now
SETZ AC3, ;all of it!!
SOUT ;write it (to memory)
ERJMP FATAL ;oops...
POPJ P, ;return
INVDIR:
HRROI AC1,CRLF ;pointer to <CR/LF>
PSOUT ;write it
HRROI AC1,NSDIR ;pointer to error message
PSOUT ;write it
POPJ P, ;return
BADDIR:
HRROI AC1,CRLF ;pointer to <CR/LF>
PSOUT ;write it
HRROI AC1,QUEST ;pointer to "?"
PSOUT ;write it (fatal error msg)
PUSHJ P,ERROR ;write out error message
POPJ P, ;return
KW060D:
HRROI AC1,KW060G ;pointer to guide word
PUSHJ P,GDWORD ;parse it.
POPJ P, ;error, return
PUSHJ P,CNFRM ;confirm?
POPJ P, ;no, return
MOVE AC1,OUTJFN ;get output jfn
RLJFN ;release it.
ERJMP .+1 ;error, don't care...
MOVE AC1,TAKJFN ;[75]get TAKE jfn
CLOSF ;[75]try to close it iff "exit" given
ERJMP .+1 ;[75]error, don't care
RLJFN ;[75]release it
ERJMP .+1 ;[75]error, don't care
HALTF ;exit from program
POPJ P, ;if "@CONT" get next command
KW070D:
HRROI AC1,KW070G ;pointer to guide word
PUSHJ P,GDWORD ;parse it.
POPJ P, ;error, return
PUSHJ P,CNFRM ;confirm?
POPJ P, ;no, return
MOVE AC1,KW.FLG ;yes, get flag word
TLO AC1,(KW%HDR) ;turn on "HEADER"
MOVEM AC1,KW.FLG ;save flag word
POPJ P, ;reuturn
KW070N:
PUSHJ P,CNFRM ;confirm?
POPJ P, ;no, return
MOVE AC1,KW.FLG ;yes, get flag word
TLZ AC1,(KW%HDR) ;turn off "HEADER"
MOVEM AC1,KW.FLG ;save flag word
POPJ P, ;return
KW080D:
PUSHJ P,CNFRM ;confirm?
POPJ P, ;no, return
MOVE AC1,[GJ%SHT+GJ%OLD] ;get a jfn
HRROI AC2,HLPFIL ;on help file
GTJFN ;get jfn
ERJMP NOHELP ;error, no help file
MOVE AC2,[7B5+OF%RD] ;ascii file
OPENF ;open it
ERJMP FATAL ;oops...
MOVE AC11,AC1 ;save the jfn (temporarily)
LOOPB:
MOVE AC1,AC11 ;get the jfn
BIN ;read in a byte
ERJMP ENDHLP ;check for EOF
MOVEI AC1,.PRIOU ;to tty:
BOUT ;write the byte
ERJMP FATAL ;oops...
JRST LOOPB ;go back and do next byte.
ENDHLP:
GTSTS ;get file status
ERJMP FATAL ;oops...
TLNN AC2,(GS%EOF) ;is EOF?
JRST FATAL ;no, oops...
CLOSF ;yes, close it
ERJMP FATAL ;oops...
POPJ P, ;return
NOHELP:
HRROI AC1,NOHLPM ;pointer to NO-HELP-MESSAGE
PSOUT ;write it to TTY:
HRROI AC1,CRLF ;add a <CR/LF>
PSOUT ;write it to TTY:
POPJ P, ;return
KW090D:
MOVEI AC1,CMDBLK ;command state block address
MOVEI AC2,NOBLK ;parse a "NO" command
COMND ;parse it.
;**;[75]Change one line at KW090D: + 3L RWW 31-JUL-81
ERCAL EOFTST ;[75]test if EOF on "TAKE"
TLNE AC1,(CM%NOP) ;was it a valid command?
JRST NONO ;no, goto NONO
HRRZ AC1,@AC2 ;yup, get address of dispatch
PUSHJ P,@AC1 ;jump to it.
POPJ P, ;when return from .-1, return
NONO:
POP P, ;clear off top of stack
JRST NOCMND ;return
KW100D:
HRROI AC1,KW100G ;pointer to guide word
PUSHJ P,GDWORD ;parse it
POPJ P, ;error, return
MOVEI AC1,CMDBLK ;command state block address
MOVEI AC2,OUTBLK ;parse an output spec
COMND ;parse it
;**;[75]Change one line at KW100D: + 6L RWW 31-JUL-81
ERCAL EOFTST ;[75]test if EOF on "TAKE"
TLNN AC1,(CM%NOP) ;is it a valid command
JRST OKJFN ;yes, skip
PUSHJ P,WARN ;no, write a warning message
POPJ P, ;return
OKJFN:
MOVE AC7,AC6 ;save the old jfn in ac 7
MOVE AC6,AC2 ;save the new jfn in ac6
PUSHJ P,CNFRM ;confirm?
JRST NOJFN ;no, skip
MOVEM AC6,OUTJFN ;yes, save new output jfn
MOVE AC1,AC7 ;move the old one to ac1
RLJFN ;release it
ERCAL .+1 ;don't care
POPJ P, ;return
NOJFN:
MOVE AC1,AC6 ;get new jfn back
RLJFN ;release it
ERCAL WARN ;output a warning
POPJ P, ;return
KW110D:
HRROI AC1,KW110G ;pointer to guide word
PUSHJ P,GDWORD ;parse it.
POPJ P, ;error, return
PUSHJ P,CNFRM ;confirm?
POPJ P, ;no, return
MOVE AC1,KW.FLG ;yes, get flag word
TLO AC1,(KW%PAG) ;turn on "PAGES-USED"
MOVEM AC1,KW.FLG ;save flag word
POPJ P, ;return
KW110N:
PUSHJ P,CNFRM ;confirm?
POPJ P, ;no, return
MOVE AC1,KW.FLG ;yes, get flag word
TLZ AC1,(KW%PAG) ;turn off "PAGES-USED"
MOVEM AC1,KW.FLG ;save new flag word
POPJ P, ;return
KW120D:
HRROI AC1,KW120G ;pointer to guide word
PUSHJ P,GDWORD ;parse it
POPJ P, ;error, return
PUSHJ P,CNFRM ;confirm?
POPJ P, ;no, return
MOVE AC1,KW.FLG ;yes, get flag word
TLO AC1,(KW%PCT) ;turn on "PERCENT"
MOVEM AC1,KW.FLG ;save flag word
POPJ P, ;return
KW120N:
PUSHJ P,CNFRM ;confirm?
POPJ P, ;no, return
MOVE AC1,KW.FLG ;yes, get flag word
TLZ AC1,(KW%PCT) ;turn off "PERCENT"
MOVEM AC1,KW.FLG ;save new flag word
POPJ P, ;return
KW130D:
HRROI AC1,KW130G ;pointer to guide word
PUSHJ P,GDWORD ;parse it.
POPJ P, ;error, return
PUSHJ P,CNFRM ;confirm?
POPJ P, ;no, return
MOVE AC1,KW.FLG ;yes, get flag word
TLO AC1,(KW%PER) ;turn on "PERMANENT"
MOVEM AC1,KW.FLG ;save new flag word
POPJ P, ;return
KW130N:
PUSHJ P,CNFRM ;confirm?
POPJ P, ;no, return
MOVE AC1,KW.FLG ;yes, get flag word
TLZ AC1,(KW%PER) ;turn off "PERMANENT"
MOVEM AC1,KW.FLG ;save new flag word
POPJ P, ;return
KW140D:
HRROI AC1,KW140G ;pointer to guide word
PUSHJ P,GDWORD ;parse it.
POPJ P, ;error, return
PUSHJ P,CNFRM ;confirm?
POPJ P, ;no, return
MOVE AC1,KW.FLG ;yes, get flag word
TLO AC1,(KW%SUM) ;turn on "SUMMARY"
MOVEM AC1,KW.FLG ;save new flag word
POPJ P, ;return
KW140N:
PUSHJ P,CNFRM ;confirm?
POPJ P, ;no, return
MOVE AC1,KW.FLG ;yes, get flag word
TLZ AC1,(KW%SUM) ;turn off "SUMMARY"
MOVEM AC1,KW.FLG ;save new flag word
POPJ P, ;return
;**;[75]Add new routine to parse for TAKE command.
KW145D:
HRROI AC1,KW145G ;[75]pointer to guide word
PUSHJ P,GDWORD ;[75]parse it
POPJ P, ;[75]error, return
MOVEI AC1,CMDBLK ;[75]command state block address
MOVEI AC2,TAKBLK ;[75]function descriptor block address
COMND ;[75]parse it
ERCAL EOFTST ;[75]test if EOF on "TAKE"
TLNN AC1,(CM%NOP) ;[75]is it a valid command?
JRST OKTAK ;[75]yes, skip
PUSHJ P,WARN ;[75]no, give error message
POPJ P, ;[75]return
OKTAK:
MOVEM AC2,TAKJFN ;save the jfn of "take file"
PUSHJ P,CNFRM ;confirmed?
POPJ P, ;no, return
HRRZ AC1,TAKJFN ;save jfn
MOVE AC2,[7B5+OF%RD] ;open it for read, 7-bit
OPENF ;open it
ERJMP FATAL ;oops...
HRLZ AC1,AC1 ;put jfn in left half of ac1
TRO AC1,.NULIO ;put NUL JFN in right half
MOVEM AC1,CMDBLK+.CMIOJ ;save input,,output jfns for COMND
POPJ P, ;return (and execute the TAKE file)
KW150D:
HRROI AC1,KW150G ;pointer to guide word
PUSHJ P,GDWORD ;parse it.
POPJ P, ;error, return
PUSHJ P,CNFRM ;confirm?
POPJ P, ;no, return
MOVE AC1,KW.FLG ;yes, get flag word
TLO AC1,(KW%WOR) ;turn on "WORKING"
MOVEM AC1,KW.FLG ;save new flag word
POPJ P, ;return
KW150N:
PUSHJ P,CNFRM ;confirm?
POPJ P, ;no, return
MOVE AC1,KW.FLG ;yes, get flag word
TLZ AC1,(KW%WOR) ;turn off "WORKING"
MOVEM AC1,KW.FLG ;save new flag word
POPJ P, ;return
;**;[75]ADD NEW ROUTINE FOR CHECKING EOF ON TAKE FILE RWW 31-JUL-81
SUBTTL SUBROUTINE TO CHECK FOR EOF ON TAKE FILE
EOFTST:
MOVE AC1,TAKJFN ;[75]get TAKE jfn
GTSTS ;[75]get status on it
ERJMP FATAL ;[75]oops...
TLNN AC2,(GS%EOF) ;[75]is it EOF?
JRST FATAL ;[75]no, some other error, bad news
CLOSF ;[75]EOF, close file
ERJMP FATAL ;[75]oops...
MOVE AC1,[.PRIIN,,.PRIOU] ;[75]go back to original i-o jfn
MOVEM AC1,CMDBLK+.CMIOJ ;[75]save them
POP P, ;[75]clear of top of stack
JRST COMAND ;[75]on EOF always return to COMAND:
SUBTTL CONFIRMATION SUBROUTINE
; This subroutine can be called to ask for confirmation, and should be
; called at the end of all parsing command strings.
;
; calling sequence:
; PUSHJ P,CNFRM
;
; Return:
; +1 if NOT confirmed
; +2 if confirmed
;
CNFRM:
MOVEI AC1,CMDBLK ;command state block address
MOVEI AC2,CFMBLK ;function block address (confirm)
COMND ;get confirmation
;**;[75]Change one line at CNFRM: + 3L RWW 31-JUL-81
ERCAL EOFTST ;[75]test if EOF on "TAKE"
TLNN AC1,(CM%NOP) ;confirmed?
JRST OKCFM ;yes.
HRROI AC1,NCFMSG ;no, output error message
PSOUT ;do it
HRROI AC1,CRLF ;output <CR>
PSOUT ;do it.
POPJ P, ;+1 return (not confirmed)
OKCFM:
POP P,AC1 ;get address normally return to
ADDI AC1,1 ;add one to the normal address
JRST @AC1 ;jump to new address in AC1 (+2 return)
SUBTTL GUIDE WORD SUBROUTINE
; This subroutine is used to parse a guide word for a command.
;
; accepts in AC1, pointer to guide word string.
; calling sequence: (example)
; HRROI AC1,GUIDE ;where: GUIDE: ASCIZ/To MONITOR/
; PUSHJ P,GDWORD
;
; return:
; +1 if bad guide word is parsed
; +2 if guide word is parse correctly
GDWORD:
MOVEM AC1,GDBLK+.CMDAT ;save the pointer to string
MOVEI AC1,CMDBLK ;command state block address
MOVEI AC2,GDBLK ;function block address (guide)
COMND ;check for guide word
;**;[75]Change one line at GDWORD: + 3L RWW 31-JUL-81
ERCAL EOFTST ;[75]test if EOF on "TAKE"
TLNN AC1,(CM%NOP) ;ok (or omitted) guide word?
JRST OKGD ;yes
TLNE AC1,(CM%EOC) ;no, was command ended with <CR>?
JRST .+3 ;yes, don't need one
HRROI AC1,CRLF ;pointer to <CR/LF>
PSOUT ;write it out
HRROI AC1,QUEST ;print to question mark (?)
PSOUT ;write it out.
PUSHJ P,ERROR ;write out error message to TTY:
POPJ P, ;return +1
OKGD:
POP P,AC1 ;get address for +1 return
ADDI AC1,1 ;add one to it.
JRST @AC1 ;go to the address (+2 return)
SUBTTL STORAGE FOR PROGRAM
PDLST: BLOCK .PDLSZ ;PUSH DOWN LIST.
ATMBUF: BLOCK 1000 ;atom buffer
INPUT: BLOCK 1000 ;user's input
CMDBLK: BLOCK 12 ;command state block
JFNBLK: BLOCK 20 ;jfn block
KEYBLK: BLOCK 5 ;keyword block
NOBLK: BLOCK 5 ;keyword block for "NO" commands
GDBLK: BLOCK 5 ;guide work block
OUTBLK: BLOCK 5 ;output file block
DIRBLK: BLOCK 5 ;directory spec block
INIBLK: BLOCK 5 ;initialization block
CFMBLK: BLOCK 5 ;confirmation block
TAKBLK: BLOCK 5 ;[75]block for TAKE command
; Keyword List
KWLST:
^D17,,^D17
KW010U,,0
KW010,,KW010D
KW020,,KW020D
KW030,,KW030D
KW040,,KW040D
KW050,,KW050D
KW060,,KW060D
KW070,,KW070D
KW080,,KW080D
KW090,,KW090D
KW100,,KW100D
KW110,,KW110D
KW120,,KW120D
KW130,,KW130D
KW140,,KW140D
KW145,,KW145D ;[75]
KW150,,KW150D
; Keyword List for "NO" command
NOLST:
^D8,,^D8
KW030,,KW030N
KW040,,KW040N
KW070,,KW070N
KW110,,KW110N
KW120,,KW120N
KW130,,KW130N
KW140,,KW140N
KW150,,KW150N
KW.FLG: BLOCK 1 ;keyword flags
DIRLEN: BLOCK 1 ;number of bytes to output for directory
ACCLEN: BLOCK 1 ;number account byte to write
TAKJFN: BLOCK 1 ;[75]jfn of "TAKE" file
OUTJFN: BLOCK 1 ;output jfn
DIRNUM: BLOCK 1 ;current directory number
DIRSPC: BLOCK 1 ;original directory spec
DIRNAM: BLOCK 12 ;directory spec given to check
DIRINF:
20,,20
BLOCK 30
DEVNUM: BLOCK 1 ;device number for DIRECTORY spec
WRKALL: BLOCK 1 ;working allocation for current directory
PRMALL: BLOCK 1 ;permanent allocation for current directory
PRMFLT: BLOCK 1 ;same as PRMALL, except it is floating format
PAGUSE: BLOCK 1 ;pages in use for current directory
GTOTAL: BLOCK 1 ;grand total pages
DTOTAL: BLOCK 1 ;number of pages for current directory
DIROUT: BLOCK 12 ;asciz string of current directory
DEFACC: BLOCK 12 ;asciz string of default account
USED: BLOCK 1 ;pages in use on structure
FREE: BLOCK 1 ;pages free on structure
SUBTTL ASCIZ AND SIXBIT STRINGS
;these asciz strings are used for general (and standard) output
;formating
CRLF: ASCIZ/
/
QUEST: ASCIZ/?/
PERCNT: ASCIZ/%/
SPC1: ASCIZ/ /
SPC2: ASCIZ/ /
SPC5: ASCIZ/ /
SPC22: ASCIZ/ /
INFMSG: ASCIZ/ +INF/
NCOMND: ASCIZ/?Not a defined command/
NCFMSG: ASCIZ/?Not confirmed/
NOHLPM: ASCIZ/%No help file available/
NSDIR: ASCIZ/?Does not match directory or user name/
PROMPT: ASCIZ/DSTATS>/
;list of commands
KW010U:
0,,CM%NOR ;This is used to require at least the "BE"
ASCIZ/B/ ; the "BEGIN" command
KW010: ASCIZ/BEGIN/
KW020: ASCIZ/CLEAR/
KW030: ASCIZ/CRAM/
KW040: ASCIZ/DEFAULT-ACCOUNTS/
KW050: ASCIZ/DIRECTORIES/
KW060: ASCIZ/EXIT/
KW070: ASCIZ/HEADER/
KW080: ASCIZ/HELP/
KW090: ASCIZ/NO/
KW100: ASCIZ/OUTPUT/
KW110: ASCIZ/PAGES-USED/
KW120: ASCIZ/PERCENT/
KW130: ASCIZ/PERMANENT/
KW140: ASCIZ/SUMMARY/
KW145: ASCIZ/TAKE/
KW150: ASCIZ/WORKING/
; guide words
KW010G: ASCIZ/Execution/
KW020G: ASCIZ/Grand Total/
KW030G: ASCIZ/Output into 80 columns/
KW040G: ASCIZ/To be included/
KW050G: ASCIZ/To check/
KW060G: ASCIZ/To MONITOR/
KW070G: ASCIZ/To be output/
KW100G: ASCIZ/To file/
KW110G: ASCIZ/To be included/
KW120G: ASCIZ/In use/
KW130G: ASCIZ/Allocation to be included/
KW140G: ASCIZ/To be included/
KW145G: ASCIZ/Commands from/
KW150G: ASCIZ/Allocation to be included/
OUTDEF: ASCIZ/TTY:/ ;default output file
DIRDEF: ASCIZ/<*>/ ;default directory spec
TAKDEF: ASCIZ/DSTATS.CMD/
HLPFIL: ASCIZ/HLP:DSTATS.HLP/ ;help file name
H1: ASCIZ/In use/
H2: ASCIZ/ Perm/
H3: ASCIZ/ Work/
H4: ASCIZ/ Used /
H5: ASCIZ/ Directory /
H6: ASCIZ/Default Account/
; summary asciz strings
SUM1A: ASCIZ/ Total of /
SUM2A: ASCIZ/Grand Total of /
SUM3A: ASCIZ/ There are /
SUM1B: ASCIZ/ pages in use for /
SUM2B: ASCIZ/ pages/
SUM3B: ASCIZ/ pages assigned on structure /
SUM4B: ASCIZ/ pages free on structure /
SUBTTL ERROR HANDLING ROUTINE.
FATAL:
HRROI AC1,[ASCIZ/
?/]
PSOUT
PUSHJ P,ERROR
HALTF
WARN:
HRROI AC1,[ASCIZ/
%/]
PSOUT
ERROR:
MOVEI AC1,.PRIOU
HRLOI AC2,.FHSLF
SETZ AC3,
ERSTR
ERJMP .+2
ERJMP .+1
POPJ P,
END DSTATS