Google
 

Trailing-Edge - PDP-10 Archives - bb-l014w-bm_tops20_v7_0_atpch_23 - autopatch/acjlog.mac
There are 9 other files named acjlog.mac in the archive. Click here to see a list.
;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==14			;Edit

VACJLOG==BYTE(3)0(9)VMAJOR(6)0(18)VEDIT ;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:	VG(\VMAJOR,\VEDIT)
	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
;	One entry for each command in the table stolen from ACJUSR.MAC
;	FUN(name,flag,noflag)


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(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(SMON,<SMON>,GOSMN)
	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>