Trailing-Edge
-
PDP-10 Archives
-
BB-KL11L-BM_1990
-
t20src/acjlog.mac
There are 9 other files named acjlog.mac in the archive. Click here to see a list.
; Edit= 16 to ACJLOG.MAC on 25-Sep-89 by GSCOTT
;Add recently implemented function from ACJUSR.MAC (up to edit 133 of ACJ).
; Edit= 15 to ACJLOG.MAC on 14-Sep-89 by GSCOTT
;Set edit number to decimal for GIMME program.
;RIP:<7.UTILITIES>ACJLOG.MAC.352 8-Apr-89 16:20:38, Edit by GSCOTT
;(14) Get latest function from ACJUSR.MAC
;RIP:<7.UTILITIES>ACJLOG.MAC.349 29-Mar-89 13:08:19, Edit by GSCOTT
;(13) Output number of files read too.
;RIP:<7.UTILITIES>ACJLOG.MAC.348 20-Mar-89 10:24:45, Edit by GSCOTT
;(12) Fix problem with FUNWDS definition.
;RIP:<7.UTILITIES>ACJLOG.MAC.341 16-Mar-89 22:27:07, Edit by GSCOTT
;(11) Add select function command.
;RIP:<7.UTILITIES>ACJLOG.MAC.295 13-Mar-89 15:45:43, Edit by GSCOTT
;(10) Output date time of first and last record read for summary.
;RIP:<7.UTILITIES>ACJLOG.MAC.289 2-Mar-89 21:48:33, Edit by GSCOTT
;(7) Be smart about output to the TTY.
;RIP:<7.UTILITIES>ACJLOG.MAC.277 26-Feb-89 14:16:38, Edit by GSCOTT
;(6) Clean up comments here and there, fix EMSG macro.
;RIP:<7.UTILITIES>ACJLOG.MAC.269 22-Feb-89 00:58:52, Edit by GSCOTT
;(5) Stats on total events.
;RIP:<7.UTILITIES>ACJLOG.MAC.253 22-Feb-89 00:07:23, Edit by GSCOTT
;(4) SELECT STATUS command.
;RIP:<7.UTILITIES>ACJLOG.MAC.217 21-Feb-89 15:45:47, Edit by GSCOTT
;(3) Add SELECT command and record parsing.
;RIP:<7.UTILITIES>ACJLOG.MAC.109 20-Feb-89 10:31:51, Edit by GSCOTT
;(2) Output header even if no entries for that day.
;RIP:<7.UTILITIES>ACJLOG.MAC.107 17-Feb-89 15:55:59, Edit by GSCOTT
;(1) Creation.
; COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1989.
; ALL RIGHTS RESERVED.
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
; ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
; INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
; COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
; OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
; TRANSFERRED.
;
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
; AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
; CORPORATION.
;
; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
; SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.
TITLE ACJLOG - ACJ log file reader
SUBTTL Gregory A. Scott
COMMENT ~
Written Febuary 1989 by Gregory A. Scott, Digital Equipment Corportation,
Marlboro, Massachusetts.
This program reads the ACJ log files and produces a summary. Selection
criteria for events may be (1) event status (2) time of event (3) username.
The output is written to another file which can be displayed (or mailed).
Future enhancements to consider: selection based on event type (GETOK function
code), selection based on optional data (after the comma in each record).
~
Subttl Table of Contents
; Table of Contents for ACJLOG
;
; Section Page
;
;
; 1. Definitions
; 1.1 Version and Entry Vector . . . . . . . . . . . 4
; 1.2 Macros . . . . . . . . . . . . . . . . . . . . 5
; 1.3 Flags and Constants . . . . . . . . . . . . . 7
; 1.4 Storage
; 1.4.1 Big Buffers . . . . . . . . . . . . . . 8
; 1.4.2 Command Parsing . . . . . . . . . . . . 9
; 1.4.3 Extraction . . . . . . . . . . . . . . . 10
; 1.5 Tables
; 1.5.1 GTJFN Block Templates . . . . . . . . . 11
; 1.5.2 Main Command Tables . . . . . . . . . . 12
; 1.5.3 Select Command Tables . . . . . . . . . 13
; 1.5.4 Set Command Tables . . . . . . . . . . . 17
; 2. Initialization . . . . . . . . . . . . . . . . . . . . 18
; 3. Commands
; 3.1 Top Level . . . . . . . . . . . . . . . . . . 19
; 3.2 Begin Command . . . . . . . . . . . . . . . . 20
; 3.3 Exit Command . . . . . . . . . . . . . . . . . 21
; 3.4 Help Command . . . . . . . . . . . . . . . . . 22
; 3.5 Read Command . . . . . . . . . . . . . . . . . 23
; 3.6 Select Command . . . . . . . . . . . . . . . . 24
; 3.7 Set Command . . . . . . . . . . . . . . . . . 28
; 3.8 Show Command . . . . . . . . . . . . . . . . . 29
; 3.9 Take Command . . . . . . . . . . . . . . . . . 33
; 3.10 Write Command . . . . . . . . . . . . . . . . 36
; 3.11 Subroutines . . . . . . . . . . . . . . . . . 37
; 4. Extract . . . . . . . . . . . . . . . . . . . . . . . 41
; 4.1 Initialization . . . . . . . . . . . . . . . . 42
; 4.2 Extract One File . . . . . . . . . . . . . . . 43
; 4.3 Extract Header . . . . . . . . . . . . . . . . 44
; 4.4 Check Line . . . . . . . . . . . . . . . . . . 46
; 4.4.1 Time of Entry . . . . . . . . . . . . . 47
; 4.4.2 Username . . . . . . . . . . . . . . . . 48
; 4.4.3 Function . . . . . . . . . . . . . . . . 49
; 4.4.4 Messages . . . . . . . . . . . . . . . . 50
; 4.5 Statistics
; 4.5.1 Start . . . . . . . . . . . . . . . . . 52
; 4.5.2 Finished . . . . . . . . . . . . . . . . 53
; 4.5.3 Summary Message . . . . . . . . . . . . 54
; 5. Read Disk File
; 5.1 Get Next File . . . . . . . . . . . . . . . . 57
; 5.2 Open Input File . . . . . . . . . . . . . . . 58
; 5.3 Get Input File Byte . . . . . . . . . . . . . 59
; 5.4 Map Chunk of Pages . . . . . . . . . . . . . . 60
; 5.5 Unmap File . . . . . . . . . . . . . . . . . . 61
; 5.6 Close File . . . . . . . . . . . . . . . . . . 62
; 5.7 Error Recovery . . . . . . . . . . . . . . . . 63
Subttl Table of Contents (page 2)
; Table of Contents for ACJLOG
;
; Section Page
;
;
; 6. Write Disk File
; 6.1 Open and Close . . . . . . . . . . . . . . . . 64
; 6.2 Write Header . . . . . . . . . . . . . . . . . 65
; 6.3 Write Summary . . . . . . . . . . . . . . . . 66
; 6.4 Write String . . . . . . . . . . . . . . . . . 67
; 7. Subroutines
; 7.1 Input Time . . . . . . . . . . . . . . . . . . 68
; 7.2 Simulate SIN . . . . . . . . . . . . . . . . . 69
; 7.3 Simulate SOUT . . . . . . . . . . . . . . . . 70
; 7.4 Small Output Routines . . . . . . . . . . . . 71
; 7.5 Output Time in Milliseconds . . . . . . . . . 72
; 7.6 Output Time in Internal Format . . . . . . . . 73
; 7.7 Output Filenames and Usernames . . . . . . . . 74
; 7.8 Error Messages . . . . . . . . . . . . . . . . 75
; 8. End of ACJLOG . . . . . . . . . . . . . . . . . . . . 76
SUBTTL Definitions -- Version and Entry Vector
;Search the usual things
SEARCH MONSYM,MACSYM
.DIREC FLBLST ;First line binary only
SALL ;Clean listing
STDAC. ;Get usual ACs
.CPYRT <<1989>> ;Set copyright
;Define the version of today's program.
VMAJOR==1 ;Version
VEDIT==DEC 16 ;Edit in decimal for stupid GIMME program
VACJLOG==BYTE(3)0(9)VMAJOR(6)0(18)VEDIT+VI%DEC ;Build version number
;Define the entry vector
EV: JRST START ;Normal start
JRST START ;Reenter start
EVER: EXP VACJLOG ;Version
EVLEN==.-EV ;Length of entry vector
;Make a string with the version in it
DEFINE VG(MAJOR,EDIT),<
ASCIZ/ACJLOG MAJOR(EDIT)/>
VERS: RADIX 5+5 ;[15] Set decimal radix
VG(\VMAJOR,\VEDIT) ;[15] Make version string
RADIX 4+4 ;[15] Set octal again
SUBTTL Definitions -- Macros
;Macro to parse noise words
DEFINE NOISE (GWRD) <
MOVEI T2,[FLDDB. .CMNOI,,<-1,,[ASCIZ /GWRD/]>]
CALL COMANE>
;Macro to output just error message text.
DEFINE EMSG (TEXT),<
CALL [JSP CX,EMSG1
ASCIZ |TEXT|]
>
;Macro to catch a JSYS error. First argument is the error string to print, it
;will be followed by the last JSYS error. The second argument is optional code
;to execute and the third argument is a place to JRST to.
DEFINE JSERR(TEXT,CODE,WHERE),<
IFB <WHERE>,<
IFB <CODE>,<
ERCAL [ JSP CX,JSERR1
ASCIZ/TEXT: /]
>; End of IFB <CODE>
IFNB <CODE>,<
ERCAL [ MOVEI CX,[ASCIZ/TEXT: /]
CALL JSERR1
CODE
RET]
>; End of IFNB <CODE>
>;End of IFB <WHERE>
IFNB <WHERE>,<
ERJMP [ MOVEI CX,[ASCIZ/TEXT: /]
CALL JSERR1
CODE
JRST WHERE]
>;End of IFB <WHERE>
>;End of DEFINE JSERR
;Macro to just output a string and the last JSYS error.
DEFINE OJSERR(TEXT,CODE,WHERE),<
IFB <WHERE>,<
IFB <CODE>,<
CALL [ JSP CX,JSERR1
ASCIZ/TEXT: /]
>; End of IFB <CODE>
IFNB <CODE>,<
CALL [ MOVEI CX,[ASCIZ/TEXT: /]
CALL JSERR1
CODE
RET]
>; End of IFNB <CODE>
>;End of IFB <WHERE>
IFNB <WHERE>,<
JRST [ MOVEI CX,[ASCIZ/TEXT: /]
CALL JSERR1
CODE
JRST WHERE]
>;End of IFB <WHERE>
>;End of DEFINE JSERR
SUBTTL Definitions -- Flags and Constants
;Flags in F
ABORTF==1B1 ;Aborting current run
NOF==1B2 ;NO typed
ALLF==1B3 ;ALL typed
FILESF==1B10 ;Output filespecs as read
OTTYF==1B11 ;Output is to tty so no filespecs now
DENYF==1B14 ;Selecting denied entries
FAILF==1B15 ;Selecting failed entries
UNUSF==1B16 ;Selecting unusual entries
NORMF==1B17 ;Selecting normal status entries
;Constants.
PLEN==200 ;Generous stack
MAXLPP==^D60 ;Maximum lines per page of output file
CBUFSZ==100 ;Command buffer size in words
ABUFSZ==40 ;Atom buffer size in words
SUBTTL Definitions -- Storage -- Big Buffers
;Define a macro to allocate buffers in memory, allocated from the top of memory
;down. Pages 0-27 are reserved to the program.
APAGE==777 ;Start at the top of section zero
DEFINE ALLOCP (ASIZE,SYMBPG,SYMBBU,SYMBLP),<
APAGE==APAGE-ASIZE ;Find where to start this buffer
IFE APAGE-30,<
PRINTX ? Too much buffer space allocated
PASS2 ;Punt
END ; and get out of here
> ;End of IFE APAGE-30
SYMBPG==APAGE+1 ;Define first page number
SYMBBU=SYMBPG_9 ;Address of page map buffer
SYMBLP==SYMBPG+<ASIZE-1> ;Last page of mapping buffer
> ;End of DEFINE ALLOCP
;Allocate the pages that we will be using today.
ALLOCP (200,PGBUPG,PGBUFF,PGBULP) ;File reading page buffer
ALLOCP (20,TEXTPG,TEXTBU,TEXTLP) ;Text string (general) buffer
ALLOCP (1,LINEPG,LINEBU,LINELP) ;Line from file
ALLOCP (1,HEADPG,HEADBU,HEADLP) ;Header string from file
SUBTTL Definitions -- Storage -- Command Parsing
;Storage for command parsing
CSBLOK: BLOCK .CMGJB+1 ;Command state block
CMDBUF: BLOCK <CBUFSZ==100> ;Command buffer
ATMBUF: BLOCK <ABUFSZ==40> ;Atom buffer
GTJBLK: BLOCK .GJATR+1 ;Long form GTJFN buffer
TIMBLK: BLOCK 3 ;Place to store parsed time
PRSJFN: BLOCK 1 ;Parsing JFN
TAKJFN: BLOCK 1 ;Take file JFN
;Command state block
CSBTPL: EXP COM2 ;(.CMFLG) Reparse at COM2
XWD .PRIIN,.PRIOU ;(.CMIOJ) Input and output JFNs
POINT 7,PROMPT ;(.CMRTY) Pointer to prompt string
POINT 7,CMDBUF ;(.CMBFP) Pointer to start of buffer
POINT 7,CMDBUF ;(.CMPTR) Pointer to next input
EXP 5*CBUFSZ-1 ;(.CMCNT) Count of space remaining after .CMPTR
EXP 0 ;(.CMINC) Number of unparsed chars after .CMPTR
POINT 7,ATMBUF ;(.CMABP) Atom buffer pointer
EXP 5*ABUFSZ-1 ;(.CMABC) Atom buffer size in characters
EXP GTJBLK ;(.CMGJB) Address of long form GTJFN block
PROMPT: EXP ASCII "ACJLO",BYTE(7)"G",76,0 ;Our prompt string
SUBTTL Definitions -- Storage -- Extraction
;Misc storage.
STACK: BLOCK PLEN ;Program stack
ERRBUF: BLOCK ^D400/5 ;Place to make error strings
;Statistics storage.
RUNTIM: BLOCK 1 ;Our runtime at program start
PEOPLE: BLOCK 1 ;Elapsed time at program start
STATPA: BLOCK 1 ;Count of pages read
STATFL: BLOCK 1 ;Count of files read
STATNR: BLOCK 1 ;Count of files not read
STATEX: BLOCK 1 ;Count of events extracted
STATTE: BLOCK 1 ;Count of total events
;Storage used to read files.
INPJFN: BLOCK 1 ;The input file JFN
INPFIL: BLOCK ^D40*5 ;The input file spec
BYTPTR: BLOCK 1 ;Pointer to current data area
BYTCNT: BLOCK 1 ;Number of bytes not read in current chunk
PGSIZF: BLOCK 1 ;Pages left to read in current file
PGCHNK: BLOCK 1 ;Number of pages mapped in this chunk
PGSTAR: BLOCK 1 ;First page of used pages in file
PGMAXI: BLOCK 1 ;Maximum pages to map at a time
;Storage used in writing files.
OUTJFN: BLOCK 1 ;The output file JFN
OUTFIL: BLOCK <^D40*5>/5 ;The output file spec
;Storage used in selecting records to extract.
FSTTIM: BLOCK 1 ;Date time of first record read
LSTTIM: BLOCK 1 ;Date time of last record read
BEGTIM: BLOCK 1 ;Date time of first desired record
ENDTIM: BLOCK 1 ;Date time of last desired record
HDRTIM: BLOCK 3 ;Date time from last header record seen
SELUSR: BLOCK ^D40/5 ;Username selected
RECUSR: BLOCK ^D40/5 ;Username of current record
RECFUN: BLOCK ^D40/5 ;Function name of current record
RECMES: BLOCK ^D40/5 ;Message string
SUBTTL Definitions -- Tables -- GTJFN Block Templates
;Read command parse GTJFN block
REAGTJ: GJ%OLD!GJ%IFG!GJ%FLG!.GJALL ;(.GJGEN) Flags and generation
XWD .NULIO,.NULIO ;(.GJSRC) No JFNs
POINT 7,[ASCIZ/DSK/] ;(.GJDEV) Default device
0 ;(.GJDIR) Default directory
POINT 7,[ASCIZ /LOGFILE/] ;(.GJNAM) Default file
POINT 7,[ASCIZ /LOG/] ;(.GJEXT) Default type
0 ;(.GJPRO) No default protection
0 ;(.GJACT) No default account
0 ;(.GJJFN) No specified JFN
0 ;(.GJF2) No additional flags
;Take file GTJFN block
TAKGTJ: GJ%OLD ;(.GJGEN) Flags and generation
XWD .NULIO,.NULIO ;(.GJSRC) No JFNs
0 ;(.GJDEV) No default device
0 ;(.GJDIR) No default directory
Point 7,[ASCIZ/ACJLOG/] ;(.GJNAM) Default file
Point 7,[ASCIZ/CMD/] ;(.GJEXT) Default type
0 ;(.GJPRO) No default protection
0 ;(.GJACT) No default account
0 ;(.GJJFN) No specified JFN
0 ;(.GJF2) No additional flags
;Write command GTJFN block
WRIGTJ: GJ%FLG!GJ%DEL!GJ%FOU!GJ%FLG!GJ%MSG ;(.GJGEN) Flags and generation
XWD .NULIO,.NULIO ;(.GJSRC) No IO JFNs
POINT 7,[ASCIZ/DSK/] ;(.GJDEV) Destination logical name
0 ;(.GJDIR) Directory
POINT 7,[ASCIZ/LOGFILE/] ;(.GJNAM) File
POINT 7,[ASCIZ/SUM/] ;(.GJEXT) Type
0 ;(.GJPRO) No default protection
0 ;(.GJACT) or account
0 ;(.GJJFN) No specified JFN
0 ;(.GJF2) No extra flags
SUBTTL Definitions -- Tables -- Main Command Tables
;Command table - must be in alphabetical order
; One entry for each command in the table
; CMND(name,help,routine,noflag)
DEFINE COMGEN<
XLIST
CMND(BEGIN,<(processing)>,DOBEGI)
CMND(EXIT,<(program)>,DOEXIT)
CMND(HELP,<(message)>,DOHELP)
CMND(READ,<(log files) logfile.log.*>,DOREAD)
CMND(SELECT,<(criteria) keyword value>,DOSELE)
CMND(SET,<(mode) mode>,DOSET)
CMND(SHOW,<(status)>,DOSHOW)
CMND(TAKE,<(commands from) acjlog.cmd>,DOTAKE)
CMND(WRITE,<(summary to) logfile.sum.-1>,DOWRIT)
LIST
>
;Command table suitable for use from COMND.
DEFINE CMND(A,B,C)<
XWD [ASCIZ/A/],C
>
CMDTBL: XWD COMNUM,COMNUM ;Table header
COMGEN ;Generate top level keywords
COMNUM==.-CMDTBL-1 ;Compute number of keywords
;Table of keywords for HELP command.
DEFINE CMND(A,B,C)<
[ASCIZ\ A 'B'
\]
>
COMHLP: COMGEN ;Generate help text
HLPNUM==.-COMHLP ;Set number of entries
SUBTTL Definitions -- Tables -- Select Command Tables
;Select Command table - must be in alphabetical order
; One entry for each command in the table
; SELCOM(name,routine)
DEFINE SELGEN<
XLIST
SELCOM(BEGIN-TIME,SELBEG)
SELCOM(END-TIME,SELEND)
SELCOM(FUNCTION,SELFUN)
SELCOM(STATUS,SELSTA)
SELCOM(USER,SELUSE)
LIST
>
;Command table for SELECT command.
DEFINE SELCOM(A,B)<
XWD [ASCIZ/A/],B
>
SELTBL: XWD SELNUM,SELNUM ;Table header
SELGEN ;Generate top level keywords
SELNUM==.-SELTBL-1 ;Compute number of keywords
;Select Status Command table - must be in alphabetical order
; One entry for each command in the table
; STACOM(name,flag,noflag)
DEFINE STAGEN<
XLIST
STACOM(ALL,DENYF!FAILF!NORMF!UNUSF)
STACOM(DENIED,DENYF)
STACOM(FAILED,FAILF)
STACOM(NO,NOF)
STACOM(NORMAL,NORMF)
STACOM(UNUSUAL,UNUSF)
LIST
>
;Command table for Select Status command
DEFINE STACOM(A,B)<
XWD [ASCIZ/A/],[B]
>
STATBL: XWD STANUM,STANUM ;Table header
STAGEN ;Generate top level keywords
STANUM==.-STATBL-1 ;Compute number of keywords
;Command table for SELECT STATUS NO commands
DEFINE STACOM(A,B)<
IFN B-NOF,<XWD [ASCIZ/A/],[B]>
>
STNTBL: XWD STNNUM,STNNUM ;Table header
STAGEN ;Generate top level keywords
STNNUM==.-STNTBL-1 ;Compute number of keywords
;Select Function Command table - must be in alphabetical order
;The easiest way to maintain this tabls is to steal it from ACJUSR.MAC
DEFINE GFUNCT,<
XLIST
FUN(ACCESS,<Access>,GOACC)
FUN(ARPANET-ACCESS,<Arpanet>,GOANA)
FUN(ASSIGN-DEVICE,<Assign>,GOASD)
FUN(ASSIGN-DUE-TO-OPENF,<Open-assign>,GOOAD)
FUN(ATTACH-JOB,<Attach>,GOATJ)
FUN(CAPABILITIES,<Caps>,GOCAP)
FUN(CLASS-ASSIGNMENT,<Class>,GOCLS)
FUN(CLASS-SET-AT-LOGIN,<Class-set-at-login>,GOCL0)
FUN(CREATE-DIRECTORY,<Create-directory>,GOCRD)
FUN(CREATE-FORK,<Create-fork>,GOCFK)
FUN(CREATE-JOB,<CRJOB>,GOCJB)
FUN(CREATE-LOGICAL-NAME,<Create-logical-name>,GOCRL)
FUN(CTERM,<Cterm>,GOCTM)
FUN(DECNET-ACCESS,<DECnet>,GODNA)
FUN(DETACH,<Detach>,GODTC)
FUN(DSKOP,<DSKOP>,GODSK)
FUN(ENQ-QUOTA,<ENQ-quota>,GOENQ)
FUN(GET-DIRECTORY,<Get-directory>,GOGTD)
FUN(GETAB,<GETAB>,GOGTB)
FUN(HSYS,<HSYS>,GOHSY)
FUN(INFO,<INFO>,GOINF)
FUN(LATOP,<LATOP>,GOLAT)
FUN(LOGIN,<Login>,GOLOG)
FUN(LOGOUT,<Logout>,GOLGO)
FUN(MDDT,<MDDT>,GOMDD)
FUN(MTA-ACCESS,<MTA-access>,GOMTA)
FUN(SECURE-CHFDB,<Secure-CHFDB>,GOCFD)
FUN(SECURE-DELF,<Secure-DELF>,GODLF)
FUN(SECURE-OPENF,<Secure-OPENF>,GOOPN)
FUN(SECURE-RNAMF,<Secure-RNAMF>,GORNF)
FUN(SET-TIME,<Set-time>,GOSTD)
FUN(SJPRI,<SJPRI>,GOSJP)
FUN(SMON,<SMON>,GOSMN)
FUN(SPRIW,SPRIW,GOSPR)
FUN(STRUCTURE-MOUNT,<Str-mount>,GOSMT)
FUN(SYSGT,<SYSGT>,GOSGT)
FUN(TERMINAL-SPEED,<Terminal-speed>,GOTBR)
FUN(TLINK,<TLINK>,GOTLK)
FUN(TTMSG,<TTMSG>,GOTTM)
FUN(USER-TEST,<User-test-function>,GOUSR)
LIST
> ;End of DEFINE GFUNCT
;Command table for Select function command.
.GOUSR=400000 ;User function codes from here to 777777
DEFINE FUN(A,B,C),<
IFL .'C-.GOUSR,<XWD [ASCIZ/A/],[.'C]>
IFGE .'C-.GOUSR,<XWD [ASCIZ/A/],[0]>>
FUNTBL: XWD FUNNUM,FUNNUM ;Table header
FUNKEY: GFUNCT ;Generate top level keywords
FUNNUM==.-FUNTBL-1 ;Compute number of keywords
;TBLUK table for function keywords in log files
DEFINE FUN(A,B,C),<
IFL .'C-.GOUSR,<XWD [ASCIZ/B/],[.'C]>
IFGE .'C-.GOUSR,<XWD [ASCIZ/B/],[0]>>
FUXTBL: XWD FUXNUM,FUXNUM ;Table header
FUXKEY: GFUNCT ;Generate top level keywords
FUXNUM==.-FUXTBL-1 ;Compute number of keywords
;Define table for enable bits, defaulting to all on.
FUNMAX==0 ;Start out with max code of zero
DEFINE FUN(A,B,C),<IFL .'C-.GOUSR,<IFG .'C-FUNMAX,<FUNMAX==.'C>>>
GFUNCT ;Make MAXFUN value up
FUNWDS==1+<FUNMAX/^D36> ;Get number of words in enable table
FUNENA: REPEAT FUNWDS,<EXP -1> ;Table for enabled function bits
FUNENT: REPEAT FUNWDS,<EXP -1> ;Table for use in command
;Two little tables used whenever needed to allow ALL or NO.
ALLTBL: XWD 1,1 ;Only one keyword
XWD [ASCIZ/ALL/],[ALLF] ;All
NOTBL: XWD 1,1 ;Only one keyword
XWD [ASCIZ/NO/],[NOF] ;No
SUBTTL Definitions -- Tables -- Set Command Tables
;Set Command table - must be in alphabetical order
; One entry for each command in the table
; SETCOM(name,flag,noflag)
DEFINE SETGEN<
XLIST
SETCOM(DISPLAY-FILESPECS,FILESF,1)
SETCOM(NO,NOF,0)
LIST
>
;Command table for SET command
DEFINE SETCOM(A,B,C)<
XWD [ASCIZ/A/],[B]
>
SETTBL: XWD SETNUM,SETNUM ;Table header
SETGEN ;Generate top level keywords
SETNUM==.-SETTBL-1 ;Compute number of keywords
;Command table for SET NO commands
DEFINE SETCOM(A,B,C)<
IFN C,<XWD [ASCIZ/A/],[B]>
>
SNOTBL: XWD SNONUM,SNONUM ;Table header
SETGEN ;Generate top level keywords
SNONUM==.-SNOTBL-1 ;Compute number of keywords
SUBTTL Initialization
;Here to start up the program
START: RESET% ;The world
MOVE P,[IOWD PLEN,STACK] ;Load stack pointer
SETZM PRSJFN ;No JFNs parsing
SETZM INPJFN ; or input
SETZM OUTJFN ; or output
SETZM TAKJFN ; or command
MOVE T1,[XWD CSBTPL,CSBLOK] ;Get BLT pointer for command state block
BLT T1,CSBLOK+.CMGJB ;Move it to the command state block
;Set defaults.
TXNN F,NORMF!DENYF!FAILF!UNUSF ;Need to default flags today?
MOVX F,FILESF!DENYF!FAILF!UNUSF ;Load default flags today
SKIPN T1,ENDTIM ;Ending date set?
MOVX T1,.INFIN ;Nope, load this
MOVEM T1,ENDTIM ;Save ending date
MOVE T1,[ASCIZ/*/] ;Load default user
SKIPN SELUSR ;Any user selected yet?
MOVEM T1,SELUSR ;Nope, select user *
SKIPN T1,PGMAXI ;Maximum set?
MOVEI T1,<PGBULP-PGBUPG>+1 ;Nope load default (use it all)
MOVEM T1,PGMAXI ;Set maximum chunk size
HRROI T1,INPFIL ;Point to input file spec
HRROI T2,[ASCIZ/LOGFILE.LOG.*/] ;Point to default file spec
SKIPN INPFIL ;Any set?
CALL ISOUT ;(T1,T2/T1) Nope, set the default
HRROI T1,OUTFIL ;Point to output file spec
HRROI T2,[ASCIZ/LOGFILE.SUM/] ;Point to default file spec
SKIPN OUTFIL ;Any set?
CALL ISOUT ;(T1,T2/T1) Nope, set the default
;Give an initialization message
HRROI T1,TEXTBU ;Point to text buffer to build string
HRROI T2,VERS ;Point to version string
CALL ISOUT ;(T1,T2/T1) Start off with that string
CALL OCRLF ;(T1/T1) Append in a crlf
CALL PTEXT ;(/) Output all of that to the terminal
SUBTTL Commands -- Top Level
;Here when ready to read a command from the terminal.
COM1: TXZ F,NOF!ABORTF ;Indicate that NO not typed, not aborting
MOVEI T2,[FLDDB. .CMINI] ;Get init function
CALL COMAND ;(T2/T1,T2) Do it
JRST COMERR ;Lose big
;See if we are doing a TAKE file and if so process another line out of it.
CALL TAKCHK ;(/) Read a line from the TAKE file
;Here on a reparse.
COM2: MOVE P,[IOWD PLEN,STACK] ;Load stack pointer
SKIPE T1,PRSJFN ;Load the closed input JFN
RLJFN% ;Release it forever
ERJMP .+1 ;Ignore errors
SETZM PRSJFN ;Clear that JFN please
MOVEI T2,[FLDDB. .CMKEY,CM%HPP,CMDTBL,<a command,>] ;Point to commands
CALL COMAND ;(T2/T1,T2) Get a command
JRST COMERR ;Lose
HRRZ T2,(T2) ;Get dispatch address
CALL (T2) ;(/) Do it
JRST COM1 ;Loop for more commands
SUBTTL Commands -- Begin Command
;BEGIN (processing)
DOBEGI: NOISE (processing) ;Output the noise
CALL CONFIR ;(/T1,T2) Confirm the command
CALLRET XTRACT ;(/) Extract and dump the stuff out
SUBTTL Commands -- Exit Command
;EXIT (program)
DOEXIT: NOISE (program) ;Output the noise
CALL CONFIR ;(/) Confirm command
;Exit the program!
CALL TAKCLS ;(/) Shut off the TAKE file if any
HALTF% ;Take a dirt nap
RET ;The toe tag has been removed!
SUBTTL Commands -- Help Command
;HELP (message)
DOHELP: NOISE (message) ;Parse noise word
CALL CONFIR ;(T2/T1,T2) Confirm, maybe log or echo it
HRROI T1,TEXTBU ;Point to usual spot for such things
CALL OCRLF ;(T1/T1) Append a crlf
HRROI T2,VERS ;Point to version string
CALL ISOUT ;(T1,T2/T1) Append that string
HRROI T2,[ASCIZ/ commands:
/] ;Tell him what we are doing
CALL ISOUT ;(T1,T2/T1) Append that string
MOVSI T3,-HLPNUM ;Get number of elements in table
HELPLP: HRRO T2,COMHLP(T3) ;Get pointer to help text
CALL ISOUT ;(T1,T2/T1) Append that string
AOBJN T3,HELPLP ;Loop for all commands
CALL OCRLF ;(T1/T1) Output that final crlf
CALLRET PTEXT ;(/) Output help text and return
SUBTTL Commands -- Read Command
;READ (ACJ log file) logfile.log.*
DOREAD: NOISE (ACJ log file) ;Give noise
;Get the filespec, confirm the command, remember filename for later.
MOVE T1,[XWD REAGTJ,GTJBLK] ;Make BLT pointer for source GTJFN
BLT T1,GTJBLK+.GJF2 ;Copy GTJFN block over there
MOVEI T2,[FLDDB. .CMFIL,CM%SDH!CM%HPP,,<Source MACRO files>]
CALL COMAND ;(T2/T1,T2) Parse input filespec
IFSKP. ;If that worked
MOVEM T2,PRSJFN ;Save that as JFN for now
CALL CONFIR ;(/) Confirm the command
HRROI T1,INPFIL ;Point to filespec
MOVE T2,PRSJFN ;Load the JFN that we just got
CALLRET OJFNS ;(T1,T2/T1) Save the filespec and return
ENDIF. ;Something wrong otherwise
OJSERR (<Illegal input filespec>) ;Input owie
RET ;Return
SUBTTL Commands -- Select Command
;SELECT keyword value
DOSELE: NOISE (criteria) ;Output some noise first of course
MOVEI T2,[FLDDB. .CMKEY,,SELTBL] ;We want to parse table of SETs
CALL COMAND ;(T2/T1,T2) Parse keyword
JRST COMERR ;Owie command
HRRZ T2,(T2) ;Load address of action routine
CALLRET (T2) ;Find our way to the next command
;Here for SELECT USER command.
SELUSE: MOVEI T2,[FLDDB. .CMUSR,CM%SDH,,<Username>,,[
FLDBK. .CMFLD,CM%SDH,,<Wild user specification>,,[
EXP USRB0.,USRB1.,USRB2.,USRB3.]]]
CALL COMANE ;(T2/T1-T3) Parse username field
LDB T3,[POINTR .CMFNP(T3),CM%FNC] ;Load the function parsed
DMOVE Q2,T2 ;Copy T2 and T3 away for a second
CALL CONFIR ;(/) Confirm the command
SETZM SELUSR ;Clear first word for later checks
HRROI T1,SELUSR ;Place to keep user string
CAIE Q3,.CMFLD ;Was it the field parse?
IFSKP. ;Yes
HRROI T2,ATMBUF ;Point to atom buffer source
CALLRET ISOUT ;(T1,T2/T1) Copy the user name down there
ENDIF. ;End of field parse
MOVE T2,Q2 ;Copy the user number back
CALLRET ODIRST ;(T1,T2/T1) Send username in there and return
;Here for SELECT END-TIME and SELECT BEGIN-TIME.
SELBEG: CALL TIMFLD ;(/T2) Get time from user
MOVE Q2,T2 ;Save it
CALL CONFIR ;(/) Confirm that
MOVEM Q2,BEGTIM ;Save ending time
RET ;Return now
;Here for SELECT END-TIME.
SELEND: CALL TIMFLD ;(/T2) Get time from user
MOVE Q2,T2 ;Save it
CALL CONFIR ;(/) Confirm that
MOVEM Q2,ENDTIM ;Save ending time
RET ;Return now
;Here for SELECT FUNCTION command.
SELFUN: SETZM FUNENT ;Start out with NO ALL
IFG FUNWDS-1,< ;Only if more than one word
MOVE T1,[XWD FUNENT,FUNENT+1] ;Load BLT pointer
BLT T1,FUNENT+FUNWDS-1 ;Copy all of those words
> ;End of IFG FUNWDS-1
CALL SELFUP ;(/) Parse keywords to make FUNENT bits
MOVSI T1,-FUNWDS ;Load -wordcount,,0
DO. ;Loop throught the bits looking for one one
SKIPE FUNENT(T1) ;Skip if all bits zero
EXIT. ;At least one bit on
AOBJN T1,TOP. ;Loop for all of them
EMSG <At least one function must be selected>
RET ;Get out
OD. ;End of check for at least one bit
MOVE T1,[XWD FUNENT,FUNENA] ;Load BLT pointer
BLT T1,FUNENA+FUNWDS-1 ;Copy all of those words
RET ; and then return
;Local routine to parse function keywords list for SELECT FUNCTION comamnd.
;Returns +1 always.
SELFUP: DO. ;Loop to read function bits
MOVEI T2,[FLDDB. .CMKEY,,FUNTBL,,,[
FLDDB. .CMKEY,,NOTBL,,,[
FLDDB. .CMKEY,,ALLTBL,,,[
FLDDB. .CMCFM]]]] ;Parse this
CALL COMANE ;(T2/T1,T2,T3) Parse keyword
LDB T3,[POINTR .CMFNP(T3),CM%FNC] ;Load the function parsed
CAIN T3,.CMCFM ;Was it the confirm parse?
RET ;Yes, get out now
HRRZ P1,(T2) ;Load entry from that table
MOVE P1,(P1) ;It must contain an address
TXNN P1,NOF ;Is it NO something?
IFSKP. ;Yes
MOVEI T2,[FLDDB. .CMKEY,,FUNTBL,,,[
FLDDB. .CMKEY,,ALLTBL]] ;Parse keyword or all
CALL COMANE ;(T2/T1,T2,T3) Parse keyword
HRRZ P1,(T2) ;Load entry from that table
MOVE P1,(P1) ;Yes, get the flags
TXO F,NOF ;Set the NO flag
ENDIF. ;End of NO code
TXNN P1,ALLF ;Was it ALL?
IFSKP. ;Yes, it was ALL
SETOM FUNENT ;Assume just ALL
TXZE F,NOF ;NO set?
SETZM FUNENT ;Yes, it was NO ALL
IFG FUNWDS-1,< ;Only if more than one word
MOVE T1,[XWD FUNENT,FUNENT+1] ;Load BLT pointer
BLT T1,FUNENT+FUNWDS-1 ;Copy all of those words
> ;End of IFG FUNWDS-1
LOOP. ;Get another keyword
ENDIF. ;End of ALL code
HRRZ T2,P1 ;Load the function code from the table
IDIVI T2,^D36 ;Find word in enable table
MOVX T4,1B0 ;Load bit zero
MOVN T3,T3 ;Make -ive for LSH
LSH T4,(T3) ;Find bit position in word
IORM T4,FUNENT(T2) ;Assume that enabling this function
TXZE F,NOF ;Did I really mean to not do this?
ANDCAM T4,FUNENT(T2) ;Turn off the bit if NO said
LOOP. ;Get another keyword
OD. ;End of SELFUP
;Here for SELECT STATUS command.
SELSTA: SETZ Q1, ;Load zero for nothing selected right now
DO. ;Loop parsing keywords
MOVEI T2,[FLDDB. .CMKEY,,STATBL,,,[
FLDDB. .CMCFM]] ;We want to parse keyword or confirm
CALL COMANE ;(T2/T1,T2,T3) Parse keyword
LDB T3,[POINTR .CMFNP(T3),CM%FNC] ;Load the function parsed
CAIN T3,.CMCFM ;Was it the confirm parse?
EXIT. ;Yes, get out of loop
MOVE T2,(T2) ;Load the entry causing this
MOVE T2,(T2) ;Load the flags bits today
TXNE T2,NOF ;Is it NO?
IFSKP. ;No
TDO Q1,T2 ;Set the requested bits
LOOP. ;And get another keyword or confirm
ENDIF. ;End of its not no code
MOVEI T2,[FLDDB. .CMKEY,,STNTBL] ;We want to parse table of NO
CALL COMANE ;(T2/T1,T2) Parse keyword after "NO"
MOVE T2,(T2) ;Load the address of the flags
TDZ Q1,(T2) ;Clear the specified flag
LOOP. ;Keep getting keywords
OD. ;End of keyword reading loop
TXNE Q1,DENYF!FAILF!NORMF!UNUSF ;Any set now?
IFSKP. ;If not
EMSG <At least one message status must be selected> ;Give error
RET ; and return
ENDIF. ;Otherwise there are some set in new word
MOVE F,Q1 ;Load new flags word
RET ; and return
SUBTTL Commands -- Set Command
;SET [NO] keyword
DOSET: MOVEI T2,[FLDDB. .CMKEY,,SETTBL] ;We want to parse table of SETs
CALL COMAND ;(T2/T1,T2) Parse keyword
JRST COMERR ;Owie command
MOVE T2,(T2) ;Load the entry causing this
MOVE Q1,(T2) ;Load the flags bits today
TXNN Q1,NOF ;Is it NO?
JRST DOSET3 ;Nope, set the bt
DOSET2: MOVEI T2,[FLDDB. .CMKEY,,SNOTBL] ;We want to parse table of NO keywords
CALL COMAND ;(T2/T1,T2) Parse keyword after "NO"
JRST COMERR ;Owie command
MOVE Q1,(T2) ;Load the address of the flags
CALL CONFIR ;(/) Confirm that command
TDZ F,(Q1) ;Clear the flag specified
RET
DOSET3: CALL CONFIR ;(/) Confirm that command
TDO F,Q1 ;Set the indicated bits
RET ;Return
SUBTTL Commands -- Show Command
;SHOW (status)
DOSHOW: NOISE (status) ;Output noise
CALL CONFIR ;(/) Confirm command
HRROI T1,TEXTBU ;Point to text buffer page
;Output each item by using a table to call a response routine.
MOVSI Q1,-SHONUX ;Load -strings,,0
DO. ;For each string to output
HRRZ T3,SHOTXT(Q1) ;Load address of action routine
HLRO T2,SHOTXT(Q1) ;Load the fixed part of the string
CALL (T3) ;(Q1,T1,T2/T1) Append in desired text
AOBJN Q1,TOP. ;Loop for all of them
OD. ;End of per string loop
;Now send all of that text to terminal and return.
CALLRET PTEXT ;Output buffer and return
;For the show tables, one of the following action routines is specified.
;Called with
; Q1/ offset into tables
; T1/ Output pointer
; T2/ Pointer to fixed text, -1,,<lh of SHOTXT(Q1)>
;Returns +1 always, T1/ updated
SHOSTR: CALL ISOUT ;(T1,T2/T1) Send fixed part
HRRO T2,SHOTAB(Q1) ;Here for string, load its address
CALL ISOUT ;(T1,T2/T1) Send just the string
CALLRET OCRLF ;(T1/T1) Send a crlf last
SHODAT: CALL ISOUT ;(T1,T2/T1) Send fixed part
MOVE T2,@SHOTAB(Q1) ;Here for date time, load its address
CALL OODTIM ;(T1,T2/T1) Output date and time
CALLRET OCRLF ;(T1/T1) Send a crlf last
SHOBIT: HRROI T2,[ASCIZ/ Set /] ;Load initial text
CALL ISOUT ;(T1,T2/T1) Send first part of command
HRROI T2,[ASCIZ/no /] ;Bit is off if we say this
TDNN F,SHOTAB(Q1) ;Skip if the bit is on
CALL ISOUT ;(T1,T2/T1) Send no part
HLRO T2,SHOTXT(Q1) ;Load the fixed part of the string
CALL ISOUT ;(T1,T2/T1) Output the bit name
CALLRET OCRLF ;(T1/T1) Send a crlf last
SHOSTA: TDNE F,SHOTAB(Q1) ;Skip if the bit is off
CALL ISOUT ;(T1,T2/T1) Output fixed part if bit is on
RET ;Return
SHOFUN: CALL ISOUTC ;(T1,T2/T1,T3) Send fixed part, get length
MOVSI Q2,-FUNWDS ;Load number of function words
DO. ;Loop to check them
MOVE T2,FUNENA(Q2) ;Is this one
CAME T2,[-1] ; all ones?
EXIT. ;Nope, have to output them
AOBJN Q2,TOP. ;Loop for all of them
HRROI T2,[ASCIZ/ all/] ;Point to keyword
CALL ISOUT ;(T1,T2/T1) Send it
CALLRET OCRLF ;(T1/T1) Append crlf and return
OD. ;So its not ALL
MOVE Q3,T3 ;Copy count of characters so far
MOVSI Q2,-FUNNUM ;Load number of function words
DO. ;Loop to output them
HRRZ T2,FUNKEY(Q2) ;Load address of function code
HRRZ T2,(T2) ;Load the function code itself
IDIVI T2,^D36 ;Find word in enable table
MOVX T4,1B0 ;Load bit zero
MOVN T3,T3 ;Make -ive for LSH
LSH T4,(T3) ;Find bit position in word
TDNN T4,FUNENA(T2) ;Is the bit on?
IFSKP. ;Yes, in fact it is
MOVE T4,T1 ;Copy pointer to T4
CALL OSPACE ;(T1/T1) First a space
HLRO T2,FUNKEY(Q2) ;Load string to print
CALL ISOUTC ;(T1,T2/T1,T3) Send keyword counting
ADDI Q3,1(T3) ;Count the word and its space
CAIG Q3,^D79-2 ;Long line?
IFSKP. ;Yes
MOVE T1,T4 ;Get old pointer back
HRROI T2,[BYTE(7)" ","-",.CHCRT,.CHLFD," "," ",0] ;Cont string
CALL ISOUT ;(T1,T2/T1) Send that
MOVEI Q3,2 ;Load where we are now
LOOP. ;And start this keyword over
ENDIF. ;End of line overflow code
ENDIF. ;End of output code
AOBJN Q2,TOP. ;Loop for all of them
OD. ;End of per keyword loop
CALLRET OCRLF ;(T1/T1) Append crlf and return
;Make tables for string output above.
DEFINE SHOGEN,<
XLIST
SHO(<Status of >,VERS,SHOSTR)
SHO(< Read >,INPFIL,SHOSTR)
SHO(< Write >,OUTFIL,SHOSTR)
SHO(< Select user >,SELUSR,SHOSTR)
SHO(< Select begin >,BEGTIM,SHODAT)
SHO(< Select end >,ENDTIM,SHODAT)
SHO(< Select function>,,SHOFUN)
SHO(< Select status>,,ISOUT)
SHO(< denied>,DENYF,SHOSTA)
SHO(< failed>,FAILF,SHOSTA)
SHO(< normal>,NORMF,SHOSTA)
SHO(< unusual>,UNUSF,SHOSTA)
SHO(,,OCRLF)
SHO(<display-filespecs>,FILESF,SHOBIT)
LIST
>
;Now invoke the macro to build paralell tables.
DEFINE SHO(A,B,C),<XWD [ASCIZ\A\],C>
SHOTXT: SHOGEN
SHONUX==.-SHOTXT
DEFINE SHO(A,B,C),<EXP B>
SHOTAB: SHOGEN
SUBTTL Commands -- Take Command
;TAKE (commands from) file.typ
DOTAKE: SKIPN TAKJFN ;Are we in a TAKE now?
IFSKP. ;Yes
EMSG <Nested TAKE commands are illegal> ;Nope
JRST TAKEOF ;Abort this take command
ENDIF. ;That's all
NOISE (commands from file) ;Mumble
MOVE T1,[XWD TAKGTJ,GTJBLK] ;Make BLT pointer for source GTJFN
BLT T1,GTJBLK+.GJF2 ;Copy GTJFN block over there
MOVEI T2,[FLDDB. .CMFIL,CM%SDH,,<take filename>]
CALL COMAND ;(T1/T1,T2,T3) Get filename
JRST COMERR ;Owie
MOVEM T2,PRSJFN ;Save JFN
CALL CONFIR ;(/) Confirm that command
;Open up the file, set the I/o JFNs and so forth, and then return.
MOVE T1,PRSJFN ;Load JFN again
MOVX T2,<FLD(7,OF%BSZ)!OF%RD> ;Read 7-bit bytes
OPENF% ;Pry it open
ERJMP COMERR ;Error, return
SETZM PRSJFN ;Don't release the JFN now
MOVEM T1,TAKJFN ;Reload that JFN please
MOVE T1,TAKGTJ+.GJSRC ;Load .NULIO,,.NULIO JFNs
MOVEM T1,CSBLOK+.CMIOJ ;That is the input JFN now
RET ;Return for all commands
;Routine to call after call to .CMINI function to process take file.
;Returns +1 always
TAKCHK: SKIPN T1,TAKJFN ;Do we have a take JFN?
RET ;Nope, return now
HRROI T2,CMDBUF ;Point to command buffer
MOVEI T3,<CBUFSZ*5>-1 ;Load characters we can supply to buffer
MOVEI T4,.CHLFD ;Load terminating character
;Loop reading one command from the file. Check for hyphen at end of line.
TAKCH1: SIN% ;String INput
ERJMP TAKEOF ;Check for EOF if error
CAILE T3,<CBUFSZ*5>-4 ;Have at least 3 characters been read?
JRST TAKCH5 ;Nope, no continuation possible
MOVNI Q1,3 ;Backup by this many bytes
ADJBP Q1,T2 ;Point back three
ILDB Q2,Q1 ;Get character two back
CAIE Q2,"-" ;Hyphen?
JRST TAKCH5 ;No, cannot be continuation then
ILDB Q2,Q1 ;Get the next character
CAIN Q2,.CHCRT ;Was it a return?
JRST TAKCH1 ;Yes, get the next line also please
;Entire command line has been read now, set up CSB, echo command, and return.
TAKCH5: MOVEI T4,<CBUFSZ*5>-1 ;Load mas possible characters transferred
SUB T4,T3 ;Compute number stored in buffer
MOVEM T4,CSBLOK+.CMINC ;Save that as number of unparsed characters
MOVEI T3,0 ;Load a null character
IDPB T3,T2 ;Insure a null at end of text string
MOVE T1,CSBLOK+.CMRTY ;Load the pointer to prompt string
PSOUT% ;Send that to the terminal please
HRROI T1,CMDBUF ;Point to command buffer again
PSOUT% ;Send it to the terminal
RET ;Back in the saddle again
;Come here when error reading from take file. If IOX4 it must be the end of
;the take file, otherwise give error message. Then close the TAKE file and go
;to COM1 to start getting commands from the terminal.
TAKEOF: CALL GETERR ;(/T2) Get last error code into T2
CAIE T2,IOX4 ;Is it end of file on take command?
OJSERR (<Error reading command file>) ;Nope, mumble about error instead
HRROI T1,TEXTBU ;Point to text buffer
HRROI T2,[ASCIZ/[End of /] ;Point bracket and start of message
CALL ISOUT ;(T1,T2/T1) Send that along
MOVE T2,TAKJFN ;Reload the JFN
SETZ T3, ;Default format
JFNS% ;Make into a string
HRROI T2,[ASCIZ/]
/] ;Point to bracket cr lf string
CALL ISOUT ;(T1,T2/T1) Send that along
CALL PTEXT ;(/) Send all of that to terminal
CALL TAKCLS ;(/) Close out the take file JFN
JRST COM1 ;Restart command
;Here to close TAKE file.
;Returns +1 always.
TAKCLS: SKIPN T1,TAKJFN ;Reload the file's JFN
RET ;None there
CLOSF% ;Close it
ERCAL TAKCL3 ;Maybe it wasn't open
SETZM TAKJFN ;No more JFN
MOVE T1,CSBTPL+.CMIOJ ;Load the primary input JFN
MOVEM T1,CSBLOK+.CMIOJ ;That is the input JFN now
RET
TAKCL3: MOVE T1,TAKJFN ;Reload the JFN
RLJFN% ;Release it
ERJMP .+1 ;Ignore any error
RET ;Return to above
SUBTTL Commands -- Write Command
;WRITE (summary to) logfile.sum.-1
DOWRIT: NOISE (summary to) ;Give noise
;Get the filespec, confirm, save filespec, and return.
MOVE T1,[XWD WRIGTJ,GTJBLK] ;Make BLT pointer for source GTJFN
BLT T1,GTJBLK+.GJF2 ;Copy GTJFN block over there
MOVEI T2,[FLDDB. .CMFIL,CM%SDH!CM%HPP,,<File to write summary to>]
CALL COMAND ;(T2/T1,T2) Parse input filespec
IFSKP. ;If that worked
HRRZM T2,PRSJFN ;Save that as the JFN for now
CALL CONFIR ;(/) Confirm the command
HRROI T1,OUTFIL ;Point to output filespec
MOVE T2,PRSJFN ;Load the JFN that we just got
CALLRET OJFNS ;(T1,T2/T1) Get the full output filespec
ENDIF. ;Otherwise there was a problem
OJSERR (<Illegal output filespec>) ;Owie
RET ;Return
SUBTTL Commands -- Subroutines
;Here to parse something using COMND JSYS.
;Call with T2/ address of command function block chain
;Returns +1 if no parse
;Returns +2 if parsed OK
COMAND: MOVEI T1,CSBLOK ;Point to command state block
COMND% ;Parse that function please
ERJMP COMAN3 ;Owie if error!
TXNN T1,CM%NOP ;Error during confirm parse?
RSKP: AOS (P) ;Nope, give skip return
R: RET ;Nope, return OK
COMAN3: CALL GETERR ;(/T2) Get last error code
CAIN T2,IOX4 ;Is it "End of file reached"?
JRST COM1 ;Yes, handle it by going to COM1
RET ;No, return
;Call CONFIR to parse a confirm.
;Returns +1 always, goes to COMERR if there is a problem.
CONFIR: MOVEI T2,[FLDDB. .CMCFM] ;Point to confirm function
; CALLRET COMANE ;Get the function done possibly
;Here to perform a COMND JSYS function and go to COMERR if error.
;Call with T2/ function block
;Returns +1 always (goes to COMERR if there is a problem).
COMANE: CALL COMAND ;Do the function
JRST COMERR ;Give error message
RET ;Return to caller
;Here when some kind of command error.
COMERR: OJSERR (<ACJLOG command error>) ;Nope, an owie instead of EOF
JRST COM1 ;Reset stack and continue parsing commands
;Here to input a date time, either:
; dd-mmm-yy hh:mm[:ss]
; TODAY|NOW [+|-[hh:]mm]
; EARLIEST|LATEST
;Returns +1 always, T2/ time
TIMFLD: SAVEAC <Q1,Q2,Q3> ;Save some ACs for later
MOVEI T2,[FLDDB. .CMTAD,CM%SDH,CM%IDA!CM%ITM,<date and time>,,[
FLDDB. .CMKEY,,TIMKEY]] ;Point to functions to parse
CALL COMANE ;(T2/T1-T3) Parse date time or whatever
LDB T3,[POINTR .CMFNP(T3),CM%FNC] ;Load the function parsed
CAIN T3,.CMTAD ;Was it the date time that parsed?
RET ;Yes, return T2/ time
;Keyword parsed, dispatch to routime to do the work.
HRRZ T2,(T2) ;Load address to dispatch to
CALLRET (T2) ;(/T2) Get time base for this keyword
;Here if EARLIEST typed.
TIMEAR: SETZ T2, ;No time is less than this
RET ;Return
;Here if LATEST typed.
TIMLAT: MOVX T2,.INFIN ;Load +infinity for a time
RET ;Return that
;Here if TODAY typed.
TIMTOD: SETO T2, ;Use current time
SETZ T3, ;No special formatting flags
ODCNV% ;Get the time as seperate numbers
ERJMP .+1 ;Ignore errors
TRZ T4,-1 ;Clear seconds since midnight
IDCNV% ;Convert back to internal date time in T2
ERJMP .+1 ;Ignore errors
MOVE Q1,T2 ;Return time in proper place
CALLRET TIMOFF ;(Q1/T2) Return time in T2
;Here if NOW typed.
TIMNOW: GTAD% ;Get current time
MOVE Q1,T1 ;Return time in proper place
; CALLRET TIMOFF ;(Q1/T2) Fall through to gather offset if any
;Parse time offset (+|- hh:mm).
TIMOFF: MOVEI T2,TIMFDB ;Point to token function desc block
CALL COMAND ;(T2/T1,T2,T3) Parse one of them
CAIA ;Didn't parse, assume plus time
CAMN T3,[XWD TIMFDB,TIMFDB] ;Plus used?
SKIPA Q2,[1] ;Yes, plus or nothing, load a +1
MOVNI Q2,1 ;No, minus was used, load a -1
;Now Q1/ time base, Q2/ offset multiplier, get Q3/ minutes.
SETZ Q3, ;Load a zero offset for the time
MOVEI T2,[FLDDB. .CMNUM,CM%SDH,^D10,<minutes or hours:minutes (optional)>]
CALL COMAND ;(T2/T1,T2,T3) Parse a number for the time
IFSKP. ;If that parse minutes worked
MOVEM T2,Q3 ;Save that number of minutes
MOVEI T2,[FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ/:/]>,<colon followed by minutes (optional)>]
CALL COMAND ;Try to parse a colon
IFSKP. ;If that parsed, minutes follow
MOVEI T2,[FLDDB. .CMNUM,CM%SDH,^D10,<minutes>] ;Parse the minutes
CALL COMANE ;(T2/T1-T3) Must furnish minutes now
IMULI Q3,^D60 ;That first number was hours, make it minutes
ADD Q3,T2 ;Get the total time offset now in minutes
ENDIF. ;End of minutes parse
ENDIF. ;End of additional time parse
;Now combine offset, flag, and time base and return that in T2.
HRLZ T2,Q3 ;Load minutes,,0 (or 0 if no minutes typed)
IDIVI T2,^D60*^D24 ;Divide by mins/day to get 0,,fraction_of_day
IMUL T2,Q2 ;Make +ive or -ive time offset
ADD T2,Q1 ;Add in time base that was specified
RET ;Return with T2/ time
;Table of keywords to parse as an alternate to date-time.
TIMKEY: XWD TIMNUM,TIMNUM ;Mini keyword table of keywords for time input
XWD [ASCIZ/EARLIEST/],TIMEAR
XWD [ASCIZ/LATEST/],TIMLAT
XWD [ASCIZ/NOW/],TIMNOW
XWD [ASCIZ/TODAY/],TIMTOD
TIMNUM==.-TIMKEY
;Function desc block for parsing plus and minus token.
TIMFDB: FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ/+/]>,<+hours:minutes or hours:minutes (optional)>,,[
FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ/-/]>,<-hours:minutes (optional)>]
SUBTTL Extract
;Here to read a set of files for BUGs and load them into memory.
;Returns +1 always.
XTRACT: CALL STATST ;(/) Start stats
CALL XTRINI ;(/) Init variables, open files
;Loop through each file and write selected lines from it to the output.
XLOOP: CALL FILOPN ;(/) Open input file
JRST NXTFIL ;Error, get next file
CALL XTRFIL ;(/) Extract lines from the file
CALL FILUNM ;(/) Unmap pages
CALL FILCLS ;(/) Close input file
;Here is where we cycle through to the next input file.
NXTFIL: CALL FILNXT ;(/) Get next file
JRST XLOOP ;Another file to do, loop around
;All done looping through files, close output file and return.
CALL WRISUM ;(/) Write summary info
CALL WRICLS ;(/) Close output file
CALL STATFI ;(/) Finish run
CALLRET STATUS ;(/) Output used and so forth to terminal
SUBTTL Extract -- Initialization
;Here to init varaibles before proceeding with extraction loop.
;Returns +1 always.
XTRINI: SETZM HEADBU ;No current header
MOVX T1,.INFIN ;Load +infinity for a time
MOVEM T1,FSTTIM ; set date time of first record read
SETZM LSTTIM ;Clear date time of last record read
CALL FILFND ;(/) Get a JFN on the input spec
TXOA F,ABORTF ;Can't do it
CALL WRIFND ;(/) Get a JFN for output file
TXOA F,ABORTF ;Can't do it
CALL WRIOPN ;(/) Open file for output
TXOA F,ABORTF ;Can't do it
CALLRET WRIHDR ;(/) Write our header
RET ;Return
SUBTTL Extract -- Extract One File
;Here to read through all lines in a file and write lines to the output file.
;Returns +1 always.
XTRFIL: TXNN F,OTTYF ;Not output to TTY
TXNN F,FILESF ; and display files?
IFSKP. ;Yes
HRROI T1,TEXTBU ;Point to somewhere
CALL OSPACE ;(T1/T1) Send a space
HRRZ T2,INPJFN ;Load input JFN
CALL OJFNS ;(T1,T2/T1) Send that along
CALL PTEXT ;(/) Print that
ENDIF. ;End of file print code
;For each line in the file: see if this line is a header line and handle
;specially, otheriwse see if it meets our selection criteria and if so write
;the event to the output file.
SETZ P1, ;Clear count of selected events
DO. ;For each line in the file
MOVE Q1,[Point 7,LINEBU] ;Point to place to store line
CALL FILLIN ;(Q1/) Get a line from the file
EXIT. ;EOF probably
CALL XTRHDR ;(/) See if this is a header line
LOOP. ;Yes, it was
AOS STATTE ;Count line as an event
CALL XTRSEL ;(/) Line meet selection criteria?
LOOP. ;Nope, get next line
HRROI T2,LINEBU ;Point to line buffer
CALL WRISTR ;(T2/) Yes, write out the line
AOS STATEX ;Count this bug as written
AOJA P1,TOP. ;Count event and get another line
OD. ;End of for each line loop
;Output a message indicating the number of events found today.
TXNN F,OTTYF ;Output to terminal?
TXNN F,FILESF ;Doing files?
RET ;Say nothing
HRROI T1,TEXTBU ;Point to text buffer
HRROI T2,[ASCIZ/ [/] ;Start text
CALL ISOUT ;(T1,T2/T1) Start with this string
SKIPN T2,P1 ;Load number of bugs
CALLRET PCRLF ;(/) None there, just output crlf and rtn
HRROI T3,[ASCIZ/ event/] ;Load this text to pluralize
CALL OPLURA ;(T1-T3/T1) Output events
HRROI T2,[ASCIZ/]
/] ;Close that off
CALL ISOUT ;(T1,T2/T1) Append that string in there
CALLRET PTEXT ;(/) Output that text and return
SUBTTL Extract -- Extract Header
;Here to check if first character not numeric, it may be header data.
;Writes "new" (changed) headers to output file.
;Returns +1 if header data, data stored
;Returns +2 if not header data
XTRHDR: MOVE T1,[Point 7,LINEBU] ;Point to text buffer
ILDB T2,T1 ;Load first character of the line
JUMPE T2,R ;Jump for next line if null here
CAIL T2,"0" ;Is the first character
CAILE T2,"9" ; numeric?
CAIA ;Yes
RETSKP ;Nope, give +2 return
CAIE T2,.CHFFD ;Is this a form feed?
RET ;Nope, junk header information, get next line
MOVE Q1,[Point 7,LINEBU] ;Point to utility player position
CALL FILLIN ;(Q1/) Get a line from the file
RET ;EOF probably
;Skip until second comma, then read date time on the line.
MOVEI Q1,2 ;Load number of commas to look for
MOVE Q2,[Point 7,LINEBU] ;Point to text buffer
DO. ;Loop for eating until comma
ILDB T2,Q2 ;Load a character from line
JUMPE T2,R ;If null get out of here
CAIE T2,"," ;Is it a comma?
LOOP. ;Nope, loop unconditionally
SOJG Q1,TOP. ;Yes, loop if not second one
OD. ;End of looking for mister goodcomma
MOVE T1,Q2 ;Point to the date-time
MOVX T2,0 ;No particular format options
IDTNC% ;Input Date and Time No Conversion
IFNJE. ;If that worked
DMOVEM T2,HDRTIM ;Save year,,month and day,,day_of_week
MOVEM T4,HDRTIM+2 ;Save flags,,seconds_since_midnight
ENDIF. ;End of IDTIM worked code
;Sniff line just read in and bind off with CRLF at last space before time.
MOVE T1,Q2 ;Keep pointer to where last seen space is
DO. ;Loop through this line
ILDB T2,Q2 ;Load character from line just read
CAIN T2,.CHCRT ;Is it end of header line?
EXIT. ;Yes, get out of here now
CAIN T2," " ;Was the character a space?
MOVE T1,Q2 ;Yes, remember this for later
CAIN T2,":" ;Colon?
EXIT. ;Yes, end of string to search
JUMPN T2,TOP. ;Loop unless null
OD. ;End of copy header loop
CALL OCRLF ;(T1/T1) Bind off header with CRLF string
;Now see if header line just read in is different from one stored.
MOVE Q2,[Point 7,LINEBU] ;Point to text buffer
MOVE Q3,[Point 7,HEADBU] ;Point to header buffer
DO. ;Loop through the header buffer
ILDB T2,Q2 ;Load a character from new header line
ILDB T3,Q3 ;Load character from old header line
CAIE T2,(T3) ;Characters still match?
EXIT. ;Nope, get out
JUMPN T2,TOP. ;Loop until null seen
RET ;Return now if both strings ended
OD. ;End of header check looop
;Header is different than last header, copy non matching part over.
DPB T2,Q3 ;Store first non-null non-matching character
DO. ;Copy non-matching part of header string
ILDB T2,Q2 ;Get next character in header
IDPB T2,Q3 ;Store in output place
JUMPN T2,TOP. ;Loop until null seen
OD. ;End of header copy loop
HRROI T2,HEADBU ;Pointer to header line
CALLRET WRISTR ;(T2/) Write header to file and return
SUBTTL Extract -- Check Line
;Routine to see if string in LINEBU meets selection criteria.
;Returns +1 if fails selection criteria
;Returns +2 if meets selection criteria
;Format of record is: hh:mm:ss username access-type job-info, data [message]
XTRSEL: MOVE T1,[Point 7,LINEBU] ;Point to text buffer
CALL XTRSTI ;(T1/T1) See if time criteria OK
RET ;Nope
CALL XTRSUS ;(T1/T1) See if username criteria OK
RET ;Nope
CALL XTRSFC ;(T1/T1) See if function code OK
RET ;Nope
;Parse any addition fields here before searching for "[message]".
CALL XTRSME ;(T1/) See if message criteria OK
RET ;Nope
RETSKP ;Skip return everything is OK
SUBTTL Extract -- Check Line -- Time of Entry
;Routine to read time and see if it matches time criteria.
;Call with T1/ pointer to beginning of record
;Returns +1 if no match
;Returns +2 if ok, T1/ updated
XTRSTI: CALL ITIME ;(T1/T1,T2,T3,T4) Input the time
RET ;EOF or format error, reject record
DMOVE T2,HDRTIM ;Get header year,,month and day,,0
HLL T4,HDRTIM+2 ;Get flags,,time_since_midnight
IDCNV% ;Convert that time to a universal date time
ERJMP R ;Return +1 if errors
CAMG T2,FSTTIM ;Is that time less than first time seen?
MOVEM T2,FSTTIM ;Yes, store the new first time seen
CAML T2,LSTTIM ;Is that time greater than last time seen?
MOVEM T2,LSTTIM ;Yes, store the new last time seen
CAMG T2,ENDTIM ;Is record's date-time greater than end d-t?
CAMGE T2,BEGTIM ; or record's d-t less than begin date-time?
RET ;Out of range, return +1
RETSKP ;In range, return +2
SUBTTL Extract -- Check Line -- Username
;Routine to read username and see if this record matches the username criteria.
;Call with T1/ pointing to username
;Returns +1 if no match
;Returns +2 if ok, T1/ updated
XTRSUS: HRROI T2,RECUSR ;Point to username storage for record
MOVEI T3,^D39 ;Load max string length
MOVEI T4," " ;Load terminator character
CALL ISIN ;(T1,T2,T3,T4/T1,T2,T3) Input the username
SKIPE T3 ;Unless space ran out(!)
ILDB T2,T1 ;Eat terminator character
MOVE T4,T1 ;Copy pointer to the text line over to T4
MOVE T2,SELUSR ;Load selected username
CAMN T2,[ASCIZ/*/] ;Is it all users?
RETSKP ;Yes, just return now with T1
MOVX T1,.WLSTR ;Matching strings today please
HRROI T2,SELUSR ;Load pointer to string that is wild
HRROI T3,RECUSR ;Load pointer to string to compare against
WILD% ;See if they match
ERJMP .+1 ;How could this fail?
EXCH T1,T4 ;Return the string pointer in T1 please
JUMPN T4,R ;Reject if no match
RETSKP ;Skip return to accept record
SUBTTL Extract -- Check Line -- Function
;Routine to read function and see if this record matches the function criteria.
;Call with T1/ pointing to place where function should be
;Returns +1 if no match
;Returns +2 if ok, T1/ updated
XTRSFC: HRROI T2,RECFUN ;Point to username storage for record
MOVEI T3,^D39 ;Load max string length
MOVEI T4," " ;Load terminator character
CALL ISIN ;(T1,T2,T3,T4/T1,T2,T3) Input the function
SKIPE T3 ;Unless space ran out(!)
ILDB T2,T1 ;Eat terminator space character
MOVE T4,T1 ;Copy pointer to the text line over to T4
MOVEI T1,FUXTBL ;Load address of table to look in
HRROI T2,RECFUN ;Point to string we just read in
TBLUK% ;Look it up
EXCH T4,T1 ;Swap the pointer back with the matching entry
TXNE T2,TL%NOM!TL%AMB ;No match or ambiguous?
RET ;Return +1 it can't match
HRRZ T2,(T4) ;Load the address of function code from table
MOVE T2,(T2) ;Load the function code from the table
IDIVI T2,^D36 ;Find word in enable table
MOVX T4,1B0 ;Load bit zero
MOVN T3,T3 ;Make -ive for LSH
LSH T4,(T3) ;Find bit position in word
TDNN T4,FUNENA(T2) ;Is the bit on?
RET ;Nope, function not enabled
RETSKP ;Function was enabled, keep checking
SUBTTL Extract -- Check Line -- Messages
;See if record has [text] in it and if so see if we want that type of record.
;Call with T1/ pointer to input characters
;Returns +1 if no match
;Returns +2 if match
XTRSME: SETZ Q3, ;Clear count of [status] messages
DO. ;Loop through this line
ILDB T2,T1 ;Load character from line
JUMPE T2,TOP. ;Loop if null seen
CAIE T2,.CHCRT ;End of record?
IFSKP. ;Yes
JUMPN Q3,R ;Return if record had status messages
TXNN F,NORMF ;Record is normal, including these?
RET ;Nope, do not select this record
RETSKP ;Yes, select normal status record
ENDIF. ;End of end of record code
CAIE T2,"[" ;Is this the start of a secret word?
LOOP. ;Loop for all of the characters
CALL XTRSMT ;(T1,Q3/T1,Q3) Try for a match
LOOP. ;Nope, go for next character please
RETSKP ;OK, select this record
OD. ;End of loop
;Local routine called from XTRSME when a open square bracket seen.
;Reads in the word around the brackets and sees if it is selected.
;Returns +1 to keep looking
;Returns +2 if found
XTRSMT: MOVE Q1,T1 ;Save pointer
SETZM RECMES+1 ;Clear second word of string
HRROI T2,RECMES ;Point to place to store the text
MOVEI T3,^D39 ;Load maximum characters in word
MOVEI T4,"]" ;Terminate on this one character
CALL ISIN ;(T1,T2,T3,T4/T1,T3) Copy that word
MOVE T1,Q1 ;Restore pointer in case failure
;Look for [Denied] [Failed] [Unusual] words.
DMOVE T2,RECMES ;Load the text read in today
CAMN T2,[ASCIZ/Denie/] ;Is it a
CAME T3,[ASCIZ/d/] ; denied request?
IFSKP. ;Yes
TXNE F,DENYF ;Selecting these records?
AOJA Q3,RSKP ;Yes, skip return
AOJA Q3,R ;Nope, but count this as not normal record
ENDIF. ;Not a denied request
CAMN T2,[ASCIZ/Faile/] ;Is it a
CAME T3,[ASCIZ/d/] ; failed request?
IFSKP. ;Yes
TXNE F,FAILF ;Selecting these records?
AOJA Q3,RSKP ;Yes, skip return
AOJA Q3,R ;Nope, but count this as not normal record
ENDIF. ;Not a failed request
CAMN T2,[ASCIZ/Unusu/] ;Is it a
CAME T3,[ASCIZ/al/] ; unusual request?
IFSKP. ;Yes
TXNE F,UNUSF ;Selecting these records?
AOJA Q3,RSKP ;Yes, skip return
AOJA Q3,R ;Nope, but count this as not normal record
ENDIF. ;Not a unusual request
RET ;Return +1 if word in brackets not known
SUBTTL Extract -- Statistics -- Start
;Here to initialize statistics.
;Returns +1 always
STATST: SETZM STATFL ;Zero the files looked atcount
SETZM STATNR ;Zero the files not looked at count
SETZM STATPA ;Zero the page count
SETZM STATEX ;Zero the extracted count
SETZM STATTE ;Zero the total events count
;Save runtime and elapsed time for later.
MOVEI T1,.HPRNT ;Get program runtime
HPTIM% ;From the monitor
JSERR (<HPTIM function .HPRNT failed to get initial runtime>)
MOVEM T1,RUNTIM ;Save it
MOVEI T1,.HPELP ;Get elapsed system time
HPTIM% ;From the monitor
JSERR (<HPTIM function .HPELP failed to get initial elapsed time>)
MOVEM T1,PEOPLE ;Save that
;Output the time we are starting and return.
HRROI T1,TEXTBU ;Point to the text buffer
HRROI T2,[ASCIZ/ Starting at /] ;The string to start the message with
CALL ISOUT ;(T1,T2/T1) Output starting message
SETO T2, ;The time is now
CALL OODTIM ;(T1,T2/T1) Output date and time
CALL OCRLF ;(T1/T1) and a crlf and return
CALLRET PTEXT ;(/) Output all of that text and return
SUBTTL Extract -- Statistics -- Finished
;Here when finished with taking stats.
;Call after STATST called and after work has been done.
;Returns +1 always
STATFI: MOVEI T1,.HPRNT ;Get our runtime
HPTIM% ;In high precsion units
JSERR (<HPTIM failure to get ending runtime>)
SUBM T1,RUNTIM ;Get our elapsed runtime
MOVEI T1,.HPELP ;Get the system elapsed time
HPTIM% ;In high precision units
JSERR (<HPTIM failure to get ending elapsed time>)
SUBM T1,PEOPLE ;Get our elapsed people time
;Output the finish message, starting with CPU time used.
HRROI T1,TEXTBU ;Point to the usual construction area
HRROI T2,[ASCIZ/ Finished at /] ;Normal end
CALL ISOUT ;(T1,T2/T1) Append that next
MOVE T2,T1 ;Save output pointer
GTAD% ;Load system's time and date
EXCH T2,T1 ;Swap the pointer with the time
CALL OODTIM ;(T1,T2/T1) Output time
CALL OCRLF ;(T1/T1) Finish with CRLF
CALLRET PTEXT ;(/) Output that stuff
SUBTTL Extract -- Statistics -- Summary Message
;Here to output summary message.
;Returns +1 always, just call STATFI first.
STATUS: HRROI T1,TEXTBU ;Use usual text buffer
;Summary line first.
CALL STATSU ;(T1/T1) Append in the summary line
;Next is "used blah in blah".
HRROI T2,[ASCIZ/ Used /] ;Label for next numbers
CALL ISOUT ;(T1,T2/T1) Append that label
MOVE T2,RUNTIM ;Load run time
CALL OTIME ;(T1,T2/T1) Output time
HRROI T2,[ASCIZ/ in /] ;In
CALL ISOUT ;(T1,T2/T1) Append that tiny string
MOVE T2,PEOPLE ;Load peopletime
CALL OTIME ;(T1,T2/T1) Output elapsed people time
CALL OCRLF ;(T1/T1) Finish with a crlf
;Output ratios.
CALL STATRA ;(T1/T1) Append in the ratios
;Now we are really done making all of that, output it and return.
CALLRET PTEXT ;(/) Output the ending message, return
;Output pages per CPU second and pages per people second.
;Call with T1/ output pointer
;Returns +1 always, T1/ updated
STATRA: SKIPN STATPA ;Get pages?
IFSKP. ;Yes
CALL OSPACE ;(T1/T1) A space first
FLTR T2,STATPA ;Get pages read
FLTR T3,RUNTIM ;Make it floating point
FDVR T3,[100000.0] ;Get seconds
FDVR T2,T3 ;Get pages/CPU second
CALL OFLOUT ;(T1,T2/T1) Output that
HRROI T2,[ASCIZ\ pages/CPU second, \] ;Output the label for the ratio
CALL ISOUT ;(T1,T2/T1) Ho hum that to the string
FLTR T2,STATPA ;Get pages read
FLTR T3,PEOPLE ;Float people time
FDVR T3,[100000.0] ;Get seconds
FDVR T2,T3 ;Get pages/People second
CALL OFLOUT ;(T1,T2/T1) Output that please
HRROI T2,[ASCIZ\ pages/people second
\] ;Label that last one
CALL ISOUT ;(T1,T2/T1) Output that mess next
ENDIF. ;End of pages output code
;Output events per CPU second and events per people second.
SKIPN STATEX ;Any extracted?
IFSKP. ;Yes
FLTR T2,STATEX ;Get events extracted
FLTR T3,RUNTIM ;Get floating point runtime
FDVR T3,[100000.0] ;Get seconds
FDVR T2,T3 ;Get events/CPU second
CALL OFLOUT ;(T1,T2/T1) Output that
HRROI T2,[ASCIZ\ extracted/CPU second, \] ;Ratio label
CALL ISOUT ;(T1,T2/T1) Ho hum that to the string
FLTR T2,STATEX ;Float events read
FLTR T3,PEOPLE ;Float people time
FDVR T3,[100000.0] ;Get seconds
FDVR T2,T3 ;Get events/People second
CALL OFLOUT ;(T1,T2/T1) Output that please
HRROI T2,[ASCIZ\ extracted/people second
\] ;Label that last one
CALL ISOUT ;(T1,T2/T1) Append the final text
ENDIF. ;End of event output
RET ;Now return
;Construct summary line.
;Call with T1/ output pointer
;Returns +1 always, T1/ updated
STATSU: SKIPN FSTTIM ;Any times seen?
IFSKP. ;Yes output them
HRROI T2,[ASCIZ/ Earliest at /]
CALL ISOUT ;(T1,T2/T1) Output that label
MOVE T2,FSTTIM ;Load first time seen
CALL OODTIM ;(T1,T2/T1) Output that time
HRROI T2,[ASCIZ/, latest at /]
CALL ISOUT ;(T1,T2/T1) Output that label
MOVE T2,LSTTIM ;Load last time seen
CALL OODTIM ;(T1,T2/T1) Output that time
CALL OCRLF ;(T1/T1) Send a crlf along
ENDIF. ;End of time summary
HRROI T2,[ASCIZ/ Extracted /] ;Label for following
CALL ISOUT ;(T1,T2/T1) Output that label
MOVE T2,STATEX ;Load events extracted
CALL ODEC ;(T1,T2/T1) Output that number
HRROI T2,[ASCIZ/ out of /] ;Seperator text
CALL ISOUT ;(T1,T2/T1) is appended next
MOVE T2,STATTE ;Load total events
HRROI T3,[ASCIZ/ event/] ;Load singular label
CALL OPLURA ;(T1,T2,T3/T1) Send that along
HRROI T2,[ASCIZ/ in /] ;Label for following
CALL ISOUT ;(T1,T2/T1) Output that label
MOVE T2,STATPA ;Load pages read
HRROI T3,[ASCIZ/ page/] ;Load singular label
CALL OPLURA ;(T1,T2,T3/T1) Send that along
MOVE T2,STATFL ;Load number of pages
CAIG T2,1 ;More than one?
IFSKP. ;Yes
HRROI T2,[ASCIZ/ from /] ;Label for following
CALL ISOUT ;(T1,T2/T1) Output that label
MOVE T2,STATFL ;Load pages read
HRROI T3,[ASCIZ/ file/] ;Load singular label
CALL OPLURA ;(T1,T2,T3/T1) Send that along
ENDIF. ;End of more than one file read code
CALLRET OCRLF ;(T1/T1) Append crlf and return
SUBTTL Read Disk File -- Get Next File
;Here to get next file to copy.
;Returns +1 if another file to do
;Returns +2 if done (or if aborting copy)
FILNXT: TXNE F,ABORTF ;Aborting?
RETSKP ;Yes, return now
MOVE T1,INPJFN ;Get the indexable file handle
GNJFN% ;Get the next file for that wild JFN please
ERJMP FILN2 ;Error, probably last file
RET ;Return
;Here if GNJFN error, probably last file.
FILN2: CALL GETERR ;(/T2) Get error in T2
CAIN T2,GNJFX1 ;No more files?
JRST FILN3 ;Yes, skip return
OJSERR (<GNJFN failure>) ;Nope, owie
JRST FILABT ;Abort this run
FILN3: SETZM INPJFN ;Clear JFN
RETSKP ;Skip return
SUBTTL Read Disk File -- Open Input File
;Here to get a JFN on the input filespec.
;Returns +1 if error, +2 if OK.
FILFND: MOVX T1,GJ%SHT!GJ%OLD!GJ%IFG!GJ%FLG ;Short old wild with flags
HRROI T2,INPFIL ;Point to input file spec
GTJFN% ;Get a JFN on that
JSERR (<Can't find input file>,,R)
MOVEM T1,INPJFN ;Save flags,,JFN
RETSKP ;Skip return
;Here with filename defaulted, get a JFN for the input file.
;Returns +1 if error, +2 if success and ready to copy
FILOPN: TXNE F,ABORTF ;Aborting?
RET ;Yes, return +1 now
HRRZ T1,INPJFN ;Get the JFN
MOVX T2,OF%RD+OF%PDT ;Don't change dates and read
OPENF% ;Pry it open
JSERR (<Can't open input file>,,FILERR)
;Do housekeeping associated with reading this file.
SIZEF% ;Get the file's size
JSERR (<Can't get file size>,,FILERR)
MOVEM T3,PGSIZF ;Save as pages left to read today
SETZM PGCHNK ;No last chunk transferred
SETZM PGSTAR ;Start at page 0 of the file
SETZM BYTCNT ;Clear byte count
RETSKP ; and return
SUBTTL Read Disk File -- Get Input File Byte
;We get bytes one from the file here
;Return +1 if EOF
;Return +2 if not, T1/ character
FILBYT: SOSGE BYTCNT ;Count down the bytes in the file
JRST FILBY1 ;Oops none left
ILDB T1,BYTPTR ;Get one
JUMPE T1,FILBYT ;Loop if null seen
AOS (P) ;Skip inline for speed
RET ; (JRST RSKP is one more instruction)
;Here if we need to fill the file again
FILBY1: CALL FILMAP ;(/) Map a chunk from the file
RET ;Return +1 if EOF
JRST FILBYT ;Loop for more bytes
;Routine to copy one line out of the input file.
;Call with Q1/ output byte pointer
;Returns +1 if error, +2 with line copied
FILLIN: CALL FILBYT ;(/T1) Get a byte from the file
RET ;End of file
IDPB T1,Q1 ;Store a byte there
CAIE T1,.CHCRT ;Is it a return?
JRST FILLIN ;Get more stuff
CALL FILBYT ;(/T1) Get another byte please
RET ;End of file
CAIN T1,.CHLFD ;Better be line feed
IDPB T1,Q1 ;Yes, it was, store a byte there
SETZ T1, ;Load a null
IDPB T1,Q1 ;Store it there
RETSKP ;Successful return
SUBTTL Read Disk File -- Map Chunk of Pages
;Find the (next) used and the (next) free page so that we know how much to map
;in this gulp. Returns +1 if EOF, +2 with pages mapped.
;Following are maintained in this routine:
; PGCHNK/ chunk size mapped in last try (0 at BOF)
; PGSIZF/ pages to read today (size of file in pages at BOF)
; PGSTAR/ place to start this map (0 at BOF)
; PGMAXI/ maximum size of each map
;Returns +1 if error or EOF, +2 if no error
FILMAP: SKIPE PGCHNK ;Skip if a chunk not mapped right now
CALL FILUNM ;(/) Unmap previously mapped pages
;We have a number of contiguous chunks of file, map them in
MOVE T4,PGCHNK ;Load chunk size last used
ADD T4,PGSTAR ;Compute next place to start
CAML T4,PGSIZF ;Done with all of this file yet?
RET ;Yes, reached end of file
MOVEM T4,PGSTAR ;Store new starting page
MOVE T4,PGSIZF ;Get final page number+1
SUB T4,PGSTAR ;Compute number of pages to map
CAMLE T4,PGMAXI ;Bigger than chunk size?
MOVE T4,PGMAXI ;Do a buffer worth and no more
MOVEM T4,PGCHNK ;Count these pages
HRL T1,INPJFN ;Get the input JFN
HRR T1,PGSTAR ;Map in from here
MOVX T2,<.FHSLF,,PGBUPG> ;Map to there
MOVX T3,PM%CNT!PM%RD ;With these bits not PM%PLD
HRR T3,PGCHNK ; and this page count
PMAP% ;Map them please
JSERR (<Can't map input file pages>,,FILERR) ;Abort this file
ADDM T4,STATPA ;Count as pages looked through
;We have a chunk of pages, set up the byte pointer and count then return
MOVE T3,PGCHNK ;Load count again
IMULI T3,5*1000 ;Compute ASCII bytes in the chunk
MOVEM T3,BYTCNT ;Save as byte count
MOVE T3,[Point 7,PGBUFF] ;Load byte pointer to that thing
MOVEM T3,BYTPTR ;Save as byte pointer
RETSKP ;Skip return if all OK
SUBTTL Read Disk File -- Unmap File
;Here to unmap some pages from the file window.
;Returns +1 always
FILUNM: SETO T1, ;Indicate no mapping desired
MOVX T2,<.FHSLF,,PGBUPG> ;Unmap from there
MOVE T3,PGCHNK ;Load chunk size
TXO T3,PM%CNT ;Count is in T3
PMAP% ;Map them please
JSERR (<Can't unmap input file pages>,,FILERR) ;Owie
RET
SUBTTL Read Disk File -- Close File
;This is were we close the file.
;Returns +1 always.
FILCLS: AOS STATFL ;Increment count of files read
HRRZ T1,INPJFN ;Just load the JFN
TXO T1,CO%NRJ!CZ%NUD ;Don't update disk
CLOSF% ;Slam
JSERR (<Error closing input file>)
RET ;Return
;Here to abort the input file.
;Returns +1 always.
FILCLA: AOS STATNR ;Here to abort, count one aborted
HRRZ T1,INPJFN ;Just load the JFN
TXO T1,CO%NRJ!CZ%ABT ;Don't release the JFN, abort this one
CLOSF% ;Slam
ERJMP .+1 ;Ignore errors
RET ;Return
;Here to release JFN
;Returns +1 always.
FILRLS: HRRZ T1,INPJFN ;Load the JFN
CLOSF% ;Close it
ERCAL FILRJF ;Uh oh
SETZM INPJFN ;No more JFN please
RET ;Return
FILRJF: HRRZ T1,INPJFN ;Reload JFN
RLJFN% ;Release it
ERJMP .+1 ;Ignore error
RET ; and return
SUBTTL Read Disk File -- Error Recovery
repeat 0,<
;Here to print file name for errors that we continue on.
;Returns +1 always.
FILWRN: HRROI T1,TEXTBU ;Point to text buffer
HRROI T2,[ASCIZ/ file /] ;Output label
CALL ISOUT ;(T1,T2/T1) Send that next
HRRZ T2,OUTJFN ;Load output JFN
CALL OJFNS ;(T1,T2/T1) Output the filename
HRROI T2,[ASCIZ/, will continue
/] ;Rest of the string
CALL ISOUT ;(T1,T2/T1) Send that to the file
CALLRET PTEXT ;(/) Send that to the terminal and return
> ;End of repeat 0
;Here when an error processing a input file to output the filename and next
;input file for processing today.
FILABT: HRROI T2,[ASCIZ/
Aborting command on file /] ;Load abort text
TXOA F,ABORTF ;Abort entire copy
FILERR: HRROI T2,[ASCIZ/
Skipping file /] ;Label this
HRROI T1,TEXTBU ;Point at text buffer
CALL ISOUT ;(T1,T2/T1) Start the error string
HRRZ T2,OUTJFN ;Load output JFN
CALL OJFNS ;(T1,T2/T1) Output the filename
CALL OCRLF ;(T1/T1) Append a CRLF
CALL PTEXT ;(/) Send the entire error message
;Clean up after this abort of the file.
CALL FILUNM ;(/) Unmap file pages
CALL FILCLA ;(/) Abort this input file
TXNN F,ABORTF ;Aborting?
RET ;Return to caller
CALL FILRLS ;(/) Release the JFN
JRST COM1 ;Restart command scanner
SUBTTL Write Disk File -- Open and Close
;Get a JFN for output file.
;Returns +1 if error, +2 if OK and OUTJFN set up.
WRIFND: MOVX T1,GJ%SHT!GJ%FOU ;Load short form and output bits
HRROI T2,OUTFIL ;Point to output spec
GTJFN% ;Get a JFN on that file
JSERR (<Can't use output file>,,R) ;Owie
MOVEM T1,OUTJFN ;Store JFN
DVCHR% ;Get device characteristics
ERJMP RSKP ;Ignore this if error
LOAD T3,DV%TYP,T2 ;Load device type
CAIE T3,.DVTTY ;Terminal?
TXZA F,OTTYF ;Nope
TXO F,OTTYF ;Yep
RETSKP ;Skip return
;Open output file for write.
;Returns +1 if error, +2 with file open for write
WRIOPN: HRRZ T1,OUTJFN ;Load the ouput JFN
MOVX T2,FLD(7,OF%BSZ)!OF%WR ;7 bit byte write
OPENF% ;Pry it open
JSERR (<Can't open output file>,,R) ;Owie!
RETSKP ;Nope
;Close output file.
;Returns +1 always.
WRICLS: SKIPE T1,OUTJFN ;Load output JFN
CLOSF% ;Close it
JSERR(<Can't close output file>)
SETZM OUTJFN ;Clear this since JFN closed and released
RET ;Return to caller
SUBTTL Write Disk File -- Write Header
;Routine to write header to output file.
;Returns +1 always.
WRIHDR: HRROI T1,TEXTBU ;Point to usual spot
HRROI T2,[ASCIZ/ Summary by /] ;Label next part
CALL ISOUT ;(T1,T2/T1) Send label
HRROI T2,VERS ;Point to version
CALL ISOUT ;(T1,T2/T1) Send version string
HRROI T2,[ASCIZ/ at /] ;Load little string
CALL ISOUT ;(T1,T2/T1) Append that little string in there
SETO T2, ;The time is now
CALL OODTIM ;(T1,T2/T1) Send time along
CALL OCRLF ;(T1/T1) and a crlf
HRROI T2,TEXTBU ;Point back to buffer
CALLRET WRISTR ;Send that string and return
SUBTTL Write Disk File -- Write Summary
;Routine to write summary to log file.
;Returns +1 always.
WRISUM: TXNE F,OTTYF ;Output to TTY?
RET ;Yes, return now!
HRROI T1,TEXTBU ;Point to text buffer
CALL STATSU ;(T1/T1) Make summary line
HRROI T2,[ASCIZ/ Events written to /] ;Start another line
CALL ISOUT ;(T1,T2/T1) with this string
HRRZ T2,OUTJFN ;Load output JFN
CALL OJFNS ;(T1,T2/T1) Send filename
CALL OCRLF ;(T1/T1) And a crlf
HRROI T2,TEXTBU ;Point to buffer
CALLRET WRISTR ;(T2/) Send that along to the file and return
SUBTTL Write Disk File -- Write String
;Local routine to do a SOUT.
;Call with T2/ pointer to string
;Uses WRILIN to determine what line of the file we are writing
;Returns+1 always
WRISTR: SETZB T3,T4 ;End on a null, write to file
SKIPE T1,OUTJFN ;Load JFN
SOUT% ;Send that to the file
JSERR(<Can't write output file>,,WRICLS)
RET ;Return
SUBTTL Subroutines -- Input Time
;Here to input time from a string, call with T1/ string pointer
;Returns +1 if error (illegal digits or eol)
;Returns +2 if time, T1/ updated, T2/ 0,,frac days, T3/ terminator, T4/ seconds
ITIME: CALL ITIME2 ;(T1/T1,T2,T3) Get two digits (hours)
RET ;EOF, return error
CAIE T3,":" ;Must be colon
RET ;Owie, return error
MOVE T4,T2 ;Copy the first number to T4
CALL ITIME2 ;(T1/T1,T2,T3) Get 2 digits (minutes)
RET ;Owie, something wrong
CAIE T3,":" ;Must be colon
RET ;Owie, return error
IMULI T4,^D60 ;Multiply hours by number of minutes/hour
ADD T4,T2 ;Fold in the minutes to get total
CALL ITIME2 ;(T1/T1,T2,T3) Get the next 2 digits (seconds)
RET ;Owie
CAIE T3," " ;Must be a space after the seconds
RET ;Owie
IMULI T4,^D60 ;Multiply minutes by number of seconds/minute
ADD T4,T2 ;Fold in the minutes to get total seconds
HRLZ T2,T4 ;Load minutes,,0 (or 0 if no minutes typed)
IDIVI T2,^D60*^D60*^D24 ;Divide by secs/day to get 0,,fraction_of_day
RETSKP ;Skip return T2/ frac days, T4/ seconds
;Local routine used only by ITIME routine to read two digits.
;Returns +1 if error (illegal digits or eol)
;Returns +2 if OK, T2/ number, T3/ terminator character
ITIME2: ILDB T2,T1 ;Load a digit into T2
CAIL T2,"0" ;Is it a
CAILE T2,"9" ; digit?
RET ;Nope, return error
ILDB T3,T1 ;Load a digit into T3
CAIL T3,"0" ;Is it a
CAILE T3,"9" ; digit?
RET ;Nope, return error
SUBI T2,"0" ;Convert ASCII to binary
IMULI T2,^D10 ;Shift over in the decimal radix
ADDI T2,-"0"(T3) ;Add this digit in please
ILDB T3,T1 ;Get the next character and
RETSKP ; skip return
SUBTTL Subroutines -- Simulate SIN
;Here to copy ASCIZ string, insures null at end of string.
;Call with
; T1/ source byte pointer
; T2/ destination byte pointer
; T3/ +ive count of maximum characters
; T4/ terminator character
;Returns +1 always, string copied, T1 and T2/ updated, T3/ remaining count
ISIN: TLC T1,-1 ;Complement left half
TLCN T1,-1 ;Was the left half -1?
HRLI T1,(Point 7) ;Yes, make it a byte pointer
TLC T2,-1 ;Complement left half
TLCN T2,-1 ;Was the neft half -1?
HRLI T2,(Point 7) ;Yes, make it a byte pointer
DO. ;Loop for those characters
ILDB CX,T1 ;Load a byte
SKIPE CX ;Is a null?
CAMN CX,T4 ;Is it time to quit?
EXIT. ;Yes, get out
IDPB CX,T2 ;Store that character
SOJGE T3,TOP. ;Loop for entire count please
OD. ;End of loop
SETZ CX, ;Load a null character
IDPB CX,T2 ;Store it back there please
MOVNI CX,1 ;Back up the destination byte pointer
ADJBP CX,T2 ; by one and
MOVEM CX,T2 ; store back the byte pointer
MOVNI CX,1 ;Back up the source byte pointer
ADJBP CX,T1 ; by one and
MOVEM CX,T1 ; store back the byte pointer
RET ;Return to caller with all ACs updated
SUBTTL Subroutines -- Simulate SOUT
;Here to quickly/cheaply copy ASCIZ string, insures null at end of string.
;Call with T1/ destination byte pointer, T2/ source byte pointer
;Returns +1 always, string copied, T1 and T2 updated
ISOUT: TLC T1,-1 ;Complement left half
TLCN T1,-1 ;Was the neft half -1?
HRLI T1,(Point 7) ;Yes, make it a byte pointer
TLC T2,-1 ;Complement left half
TLCN T2,-1 ;Was the neft half -1?
HRLI T2,(Point 7) ;Yes, make it a byte pointer
ISOUT1: ILDB CX,T2 ;Load a byte
IDPB CX,T1 ;Store it
JUMPN CX,ISOUT1 ;Jump if not done
MOVNI CX,1 ;Back up the byte pointer
ADJBP CX,T1 ; by one and
MOVEM CX,T1 ; store back the byte pointer
RET ;Return
;Here to copy ASCIZ string, insures null at end of string, returns length.
;Call with T1/ destination byte pointer, T2/ source byte pointer
;Returns +1 always, string copied, T1 and T2 updated, T3/ count
ISOUTC: TLC T1,-1 ;Complement left half
TLCN T1,-1 ;Was the neft half -1?
HRLI T1,(Point 7) ;Yes, make it a byte pointer
TLC T2,-1 ;Complement left half
TLCN T2,-1 ;Was the neft half -1?
HRLI T2,(Point 7) ;Yes, make it a byte pointer
SETZ T3, ;Clear the counter for this string
ISOUT4: ILDB CX,T2 ;Load a byte
IDPB CX,T1 ;Store it
JUMPE CX,ISOUT5 ;Jump if not done
AOJA T3,ISOUT4 ;Continus until null seen
ISOUT5: MOVNI CX,1 ;Back up the byte pointer
ADJBP CX,T1 ; by one and
MOVEM CX,T1 ; store back the byte pointer
RET ;Return
SUBTTL Subroutines -- Small Output Routines
;Here to output CRLF (PCRLF) or text buffer (PTEXT).
;Returns +1 always
ACRLF: ASCIZ /
/
PTEXT: SKIPA T1,[XWD -1,TEXTBU] ;Point to text area and skip always
PCRLF: HRROI T1,ACRLF ;Point to crlf
PSOUT% ;Send to terminal
RET ; and return
;Here to append a CRLF to the string pointed to by T1.
;Returns +1 always
OSPACE: SKIPA T2,[-1,,[ASCIZ/ /]] ;Point to a space string
OCRLF: HRROI T2,ACRLF ;Point to crlf string
CALLRET ISOUT ;(T1,T2/T1) Append that to string and return
;Here to output number from T2, T1/ destination pointer
;Returns +1 always
OOCT: SKIPA T3,[4+4] ;Radix 8
ODEC: MOVEI T3,5+5 ;Radix 10
NOUT% ;Kachunk
JSERR (<NOUT failed>) ;Someone out of control here
RET ;Return
;Here to output number and name of it with "S" as appropriate.
;Call with T1/destination T2/ number and T3/ pointer to ASCIZ
OPLURA: PUSH P,T3 ;Save pointer to text
CALL ODEC ;(T1,T2/T1) Output number
EXCH T2,(P) ;Save number back, get text pointer
CALL ISOUT ;(T1,T2/T1) Output that string next
POP P,T2 ;Restore number
CAIN T2,1 ;Only one?
RET ;Yep, done
HRROI T2,[ASCIZ/s/] ;Load your S up
CALLRET ISOUT ;(T1,T2/T1) Output and insure a null on end
;Here to output floating point number in T2, T1/ destination pointer
;Returns +1 always
OFLOUT: MOVX T3,FL%ONE!FL%PNT!FLD(4,FL%RND)!FLD(3,FL%SND) ;Format bits
FLOUT% ;Output that
JSERR (<FLOUT failure>) ;Snowballs exist in hell today
RET ;Return to sender
SUBTTL Subroutines -- Output Time in Milliseconds
;Output time in HPTIM units in the form "h:mm:ss.tt"
;Call with T1/ destination designator, T2/ time
;Returns +1 always
OTIME: MOVE CX,T1 ;Save output designator in dangerous spot
MOVE T1,T2 ;Copy time over
ADDI T1,^D500 ;Round up the hundredths of seconds
IDIVI T1,^D1000 ;Get units into hundredths of seconds
IDIV T1,[^D<100*60*60>] ;Get hours from hundreths of seconds
IDIVI T2,^D<100*60> ;Get minutes from fractional hours
IDIVI T3,^D100 ;Get seconds from fractional minutes
PUSH P,T4 ;Save hundredths of secs from fractional secs
PUSH P,T3 ;Save seconds
PUSH P,T2 ;Save minutes
MOVE T2,T1 ;Copy hours to T2
MOVE T1,CX ;Get output designator back from dangerous spot
MOVX T3,^D10 ;Radix 10
MOVEI T4,":" ;Load a colon for a seperator
SKIPE T2 ;Skip hours if zero
CALL OTIME1 ;(T1,T2,T3,T4/T1,T3) Output hours and a colon
POP P,T2 ;Get the minutes
SKIPE T2 ;Skip minutes if zero
CALL OTIME1 ;(T1,T2,T3,T4/T1,T3) Output minutes and colon
POP P,T2 ;Get the seconds
MOVEI T4,"." ;Seperator should be a dot
CALL OTIME1 ;(T1,T2,T3,T4/T1,T3) Output seconds and a dot
SETZ T4, ;No seperator now
POP P,T2 ;Load hundredths of seconds and fall through
OTIME1: NOUT% ;Output number
JSERR (<NOUT failed>) ;Owie
SKIPE T4 ;Any seperator character?
IDPB T4,T1 ;Yes, store it now
MOVX T3,NO%LFL!NO%ZRO!FLD(2,NO%COL)!FLD(^D10,NO%RDX) ;2 for the rest
RET ;Return to above
SUBTTL Subroutines -- Output Time in Internal Format
;Output time of day, "earliest", or "latest".
;Call with T1/ output pointer, T2/ time
;Returns +1 always, T1/ updated pointer.
OODTIM: IFE. T2 ;Is time zero?
HRROI T2,[ASCIZ/earliest/] ;Yes, load special string
CALLRET ISOUT ;(T1,T2/T1) Say this instead of 15-Nov-1858
ENDIF. ;OK, so the time wasn't zero
CAME T2,[.INFIN] ;Is it infinity?
IFSKP. ;Yes
HRROI T2,[ASCIZ/latest/] ;Say this
CALLRET ISOUT ;(T1,T2/T1) instead of 21-Sep-2217
ENDIF. ;So, it must be a normal date time
MOVX T3,OT%SCL ;Suppress columnation 9 days of the month
ODTIM% ;Zap it to terminal
JSERR (<ODTIM failed>) ;Hell is freezing over
RET ;Return
SUBTTL Subroutines -- Output Filenames and Usernames
;Small subroutine to get a filename appended to a string.
;Call with T1/ output pointer.
;Returns +1 always.
OJFNS: JUMPE T2,R ;File closed? Just return
MOVX T3,FLD(.JSSSD,JS%DEV)!FLD(.JSSSD,JS%DIR)!FLD(.JSAOF,JS%NAM)!FLD(.JSAOF,JS%TYP)!FLD(.JSAOF,JS%GEN)!JS%PAF
JFNS% ;JFN to String
JSERR(<JFNS error>) ;Owie
RET ;Return
;Routine to do a DIRST.
;Call with T1/ output designator, T2/ user or directory number (5B2+n)
;Returns +1 always, T1/ updated pointer
; T2/ user or directory number if legal,
; 0,,error if unknown or 0,,0 if not logged in
ODIRST: TRNE T2,-1 ;Not logged in?
IFSKP. ;If not logged in
HRROI T2,[ASCIZ/not-logged-in/] ;Indicate not logged in today
CALL ISOUT ;(T1,T2/T1) Send all of that to string and ret
SETZ T2, ;Indicate not logged in
RET ;Return with T1/ updated pointer and T2/ 0
ENDIF. ;End of not logged in case
MOVE T3,T1 ;Copy pointer in case error
DIRST% ;DIRectory number to STring
ERJMP .+2 ;Skip if error
RET ;Return to caller
EXCH T1,T3 ;Swap pointer with error code
HRROI T2,[ASCIZ/unknown/] ;Say something if failure
CALL ISOUT ;(T1,T2/T1) Return a string
MOVE T2,T3 ;Return error code in T2
RET ;Return pointer in T1
SUBTTL Subroutines -- Error Messages
;Subroutine to output error message
;Called from invocation of EMSG macro with CX/ address of text
;Returns +1 always.
EMSG1: HRROI T1,(CX) ;Point to the string itself
ESOUT% ;Send to terminal with question mark
RET ; and return
;Subroutine to handle JSYS errors
;Call with CX/address of ASCIZ string
;Returns +1 always, message, error, and trailing CRLF printed
JSERR1: HRROI T1,ERRBUF ;Point to text buffer
HRROI T2,(CX) ;Point to the string
CALL ISOUT ;(T1,T2/T1) Start off with that text
MOVX T2,<.FHSLF,,-1> ;This fork's last error
SETZ T3, ;No limit
ERSTR% ;Get string to error
CALL JSERR2 ;(T1/T1) Undefined error number
JFCL ;String size out of bounds or bad designator?
CALL OCRLF ;(T1/T1) Append a CRLF
CALLRET PERROR ;(/) Output error string and return
JSERR2: HRROI T2,[ASCIZ/Undefined error /] ;Output label for string
CALL GETERR ;(/T2) Get fork's last error
MOVEI T3,4+4 ;Radix 8
NOUT% ;Output that octal number
ERJMP .+1 ;Ignore error within error within error
RETSKP ;Return to finish the string
;Small routine to return this fork's last error in T2
;Returns +1 always, T2/ error number
GETERR: PUSH P,T1 ;Save T1
MOVEI T1,.FHSLF ;Load this fork
GETER% ;Get last error in T2
TLZ T2,-1 ;Zap junk in LH
POP P,T1 ;Restore T1
RET ;Return
;Small routine to display contents of error buffer.
;Returns +1 always
PERROR: HRROI T1,ERRBUF ;Point to error buffer
ESOUT% ;Output to terminal
RET ;Return to caller
SUBTTL End of ACJLOG
;Literals
LIT..: XLIST
LIT
LIST
END <EVLEN,,EV>