Google
 

Trailing-Edge - PDP-10 Archives - BB-L288A-RM - swskit-utilities/rdlog.mac
There is 1 other file named rdlog.mac in the archive. Click here to see a list.
;<JENNESS.FELOG>RDLOG.MAC.94, 28-Jan-80 15:20:25, Edit by JENNESS
; [105] If line counter is zero, suppress it in device status.
;<JENNESS.FELOG>RDLOG.MAC.94, 28-Jan-80 15:19:00, Edit by JENNESS
; [104] Remove line flags from device status except hardware abort.
;<JENNESS.FELOG>RDLOG.MAC.93, 28-Jan-80 15:17:52, Edit by JENNESS
; [103] Fix GET32 to return the value in S1 instead of S2.
;<JENNESS.FELOG>RDLOG.MAC.92, 28-Jan-80 13:56:46, Edit by JENNESS
; [102] Swap meaning of input and output on console activity flags.
; RDLOG - FELOG data file interpreter

;
;			  COPYRIGHT (c) 1980
;                    DIGITAL EQUIPMENT CORPORATION
;
;     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  which  is  not supplied by
;     DIGITAL.
;
	SUBTTL	Universal searches and version information

	SALL				; Make nice clean listings

	.DIRECTIVE FLBLST		; List only 1st binary word in multi
					;  word text strings

	SEARCH	GLXMAC			; General GLXLIB definitions
	SEARCH	ORNMAC			; Command block definitions
	SEARCH	D60UNV			; Search for D60JSY linkages

	PROLOGUE (RDLOG)		; Initialize GLXLIB assembly options

; Version, increment major version number only when incompatibility with
;	   previous edits occurs.

	XP	RDLVER,	1		; Major version number
	XP	RDLMIN,	1		; Minor version number
	XP	RDLWHO,	0		; Who did editing last (0=DEC)
	XP	RDLEDT,	105		; Edit number

	%%.RDL=:<VRSN. (RDL)>		; Set value of edit level/version

TOPS10 <LOC	137			; .JBVER
	%%.RDL
	RELOC
    > ;End it TOPS10

; Print title and version information during assembly

Define VOUTX (S1,S2,S3,S4,S5)

<.XCREF					;; Turn off crefing
 IFB <S5>,<S6==0>			;; If no "WHO" set it to none
 IFNB <S5>,<S6==S5>			;; If "WHO" set who it is.

 IFN <S6>,<TITLE S1 S2'S3'('S4')-'S6
	   Printx S1 S2'S3'('S4')-'S6>	;; If "WHO" is defined .. append it

 IFE <S6>,<TITLE  S1 S2'S3'('S4')
	   Printx S1 S2'S3'('S4')> 	;; If no "WHO" leave it off.
 PURGE S6
 .CREF					;; Turn crefing back on
    > ;End VOUTX definition

IF1,<
 IFN <RDLMIN>,<VOUTX (RDLOG - FELOG data file interpreter,\RDLVER,\"<"@"+RDLMIN>,\RDLEDT,\RDLWHO)>
 IFE <RDLMIN>,<VOUTX (RDLOG - FELOG data file interpreter,\RDLVER,,\RDLEDT,\RDLWHO)>

 > ;End IF1

IF2,<
 Printx Starting PASS2.
    > ;End IF2
	SUBTTL	Macros

; Macro - $ERET
;
; Function - To print an error message and return.
;
; Parameters -
;
;	TEXT	Error message text to be printed before system error text
;	FORK	Process handle that system error is to be printed for
;	VECTOR	Where to return after printing error, if none .. return

Define $ERET (TEXT,FORK,VECTOR)
<	HRROI	S1,[ASCIZ \TEXT\]	;; Point to text string
 IFNB <FORK>,<MOVE S2,FORK>		;; Get fork handle if given
 IFB  <FORK>,<MOVX S2,.FHSLF>		;;  else point to this fork
 IFNB <VECTOR>,<$CALL ERRPRT		;; If vector given, print error
		JRST VECTOR>		;; and jump where specified
 IFB  <VECTOR>,<JRST ERRPRT>		;; If no vector, return after printing
    >;End $ERET definition


; Macros - INVST, INCV
;
; Function - To assign incremental values to a series of symbols.  This
;	is useful when defining data block offsets.

Define INVST <..INV==0>
Define INCV (VAL) <VAL==..INV
		   ..INV==..INV+1>
; Macro - $BIT
;
; Function - To create appropriate interpretation of a bit set in S1.
;
; Parameters -
;
;	$%BIT	Bit value to test against S1
;	ONTXT	Text to be output if bit is on
;	OFFTXT	Text to be output if bit is off

Define $BIT ($%BIT,ONTXT,OFFTXT) <
XLIST
IFNB <ONTXT>,<
	TXNE	S1,<1_$%BIT>		;; Check for BIT set on
	 $TEXT	LOGCHR,<ONTXT^A>	;;  Yes .. output text
    > ;End if ONTXT exists
XLIST
IFNB <OFFTXT>,<
	TXNN	S1,<1_$%BIT>		;; Check for BIT set off
	 $TEXT	LOGCHR,<OFFTXT^A>	;;  Yes .. output "OFF" text
    > ;End if OFFTXT exists
LIST
   > ;End $BIT definition
	SUBTTL	Miscellaneous

; Global externals

	PARSET				; Define parser semantic externals
	EXTERNAL P$HELP			; Help routine
	EXTERNAL PARSER			; Syntactic parser
	EXTERNAL WAIFDB			; WAIT command
	EXTERNAL TAKFDB			; TAKE command
	EXTERNAL P$NPRO			; Flag "No processing" in $ACTION
	.REQUIRE OPRPAR			; Where all the parser routines live

; Constants

	XP	PDLSIZ,	500		; Size of the stack


; Keywords

Define KYWRDS

<XLIST
	KY	DISABLE,.DIS,DISABL,DISPDB
	KY	ENABLE,.ENA,ENABLE,ENAPDB
	KY	EXIT,.EXT,,EXIPDB
	KY	HELP,.HLP,HELP,HELPDB
	KY	LIST,.LST,LIST,LSTPDB
	KY	OUTPUT,.OUT,OPUT,OUTPDB
TOPS20 <KY	PUSH,.PUS,PUSHR,PUSPDB>
	KY	TAKE,.KYTAK,,TAKFDB
	KY	VERSION,.VER,,VERPDB
LIST
    > ;End KYWRDS definition

; Other keyword values

	XP	.DEV,	100		; DEVICE
	XP	.LINE,	101		; LINE
	XP	.PRT,	102		; PORT
	XP	.ENT,	103		; ENTRY
	XP	.TIM,	104		; TIME
	XP	.UTL,	105		; UNTIL
	XP	.AFT,	106		; AFTER
	XP	.HDR,	1000		; HEADER
	XP	.BDY,	2000		; BODY
	SUBTTL	GLXLIB initialization blocks

; Initialization block

IB:	$BUILD	IB.SZ			; Size of initialization block
	 $SET	 (IB.PRG,,'RDLOG')	;  Program name
	 $SET	 (IB.FLG,IT.OCT,1)	;  Open command terminal
	$EOB
	SUBTTL	Startup and initialization

ENTVEC:	JRST	START
	JRST	START
	EXP	%%.RDL

START:	RESET				; Clear up everything
	MOVE	P,[IOWD PDLSIZ,PDL]	; Start up the stack
	MOVX	S1,IB.SZ		; Size of initialization block
	MOVEI	S2,IB			; Address of initialization block
	$CALL	I%INIT			; Initialize GLXLIB
	$TEXT	,< RDLOG V.^V/[%%.RDL]/>
	$CALL	M%GPAG			; Get a page for "BEFORE" data buffer
	MOVEM	S1,BUFBEF		; Save address for later
	$CALL	M%GPAG			; Get page for "AFTER" data buffer
	MOVEM	S1,BUFAFT		; Save for later
	$CALL	M%GPAG			; Get another page
	MOVEM	S1,LSTBUF		; Save for text output routines
	SETZM	LSTIFN			; Clear output IFN .. imply TTY

TOPS20 <SKIPE	S1,PUSFRK		; Check for a fork previously made
	 JRST	[KFORK			;  Kill it
		  ERJMP .+1		;  Ignore errors
		 JRST .+1]
	SETZM	PUSFRK			; Clear PUSH fork handle
    >;End if TOPS20

	JRST	MAIN			; Start processing top level commands
	SUBTTL	Top-level command scan

; Routine - MAIN
;
; Function - To continuously process commands.  After each command is
;	processed, the command scanner is invoked again.
;
; Parameters and returns - none

MAIN:	MOVEI	S1,TOPSCN		; Location of top parser PDB chain
	MOVEI	S2,TOPPRM		; Prompt for top level
	MOVEI	T1,TOPVEC		; Vector table for keywords
	$CALL	COMMAND			; Process command
	JRST	MAIN			; Get next command
	SUBTTL	Command processing routine (COMMAND)

; Routine - COMMAND
;
; Function - This is the command processing routine.  It does the call
;	to the syntactic PARSER and then vectors to the appropriate 
;	service routine depending on the value of the first keyword in 
;	the command string.
;
; Parameters -
;
;	S1/	Start of PDB chain
;	S2/	Address of prompt string
;	T1/	Address of vector table (T$EFND style)
;
; Returns -
;
;	True	Command was processed
;	False	Error occured while processing command

COMMAND:
	STKVAR	<PPAGE,VEC>
	MOVEM	T1,VEC			; Save address of vector table
	MOVEM	S1,PRSBLK+PAR.TB	; Set location of PDB chain
	MOVEM	S2,PRSBLK+PAR.PM	; Set location of prompt string

CMMD.1:	MOVX	S1,PAR.SZ		; Size of parser argument block
	MOVEI	S2,PRSBLK		; Address of parser block
	$CALL	PARSER			; Parse a command
	JUMPT	CMMD.5			; Success in parsing a command

	MOVE	T1,PRT.FL(S2)		; Get PARSER flags
	TXNE	T1,P.ENDT		; End of TAKE file?
	 JRST	[SETZM TAKFLG		;  Clear TAKE file processing flag
		 JRST CMMD.1]		;  Go get next command
	$CALL	DSPCMD			; Optionally display the command
	MOVE	T1,PRT.CF(S2)		; Get COMND flags
	TXNE	T1,CM%ESC		; Escape last character?
	 $TEXT	,<>			;  Yes .. move to new line
	$TEXT	,<? ^T/@PRT.EM(S2)/>	; Output error message
	$RETF				; Return indicating error

CMMD.5:	MOVE	S1,PRT.CM(S2)		; Get address of command page
	MOVEM	S1,PPAGE		; Save page address for releasing
	MOVE	T1,PRT.FL(S2)		; Get flags from PARSER
	$CALL	DSPCMD			; Display TAKE command if needed
	TXNN	T1,P.TAKE		; TAKE command?
	TXNE	T1,P.NPRO		; No processing for command?
	 $RETT				;  Already done in ACTION routine
	MOVE	S2,COM.PB(S1)		; Get offset to parser blocks
	ADD	S1,S2			; Make address to start of blocks
	$CALL	P$SETUP			; Start semantic parsing
CMMD.6:	$CALL	P$KEYW			; Get keyword value
	MOVE	S2,VEC			; Get address of vector table
	$CALL	T$EFND			; Look for vector for this keyword
	 JUMPF	CMMD.F			;  No such command .. give error
	JUMPE	S1,CMMD.N		; If no processing routine .. error
	$CALL	(S1)			; Call processing routine
	MOVE	S1,PPAGE		; Get page address of command
	PJRST	M%RPAG			; Return it to memory manager
					; and return to caller
CMMD.F:	$TEXT	,<?Unkown keyword found in semantic scanning.>
	CAIA
CMMD.N:	$TEXT	,<?Semantic routine for keyword not defined.>
	$RETF
; Routine - DSPCMD
;
; Function - This routine checks whether a take command is to be displayed.
;	If it is, then the prompt and the command are output onto the terminal.
;
; Parameters -
;
;	S1/	Address of command page
;	T1/	Flag word from PARSER

DSPCMD:	$CALL	CHKDSP			; Check if need to display
	 JUMPF	.RETT			;  Return o.k.
	MOVE	T2,COM.CM(S1)		; Get text offset
	ADDI	T2,1(S1)		; Point to start of string
	$TEXT	,<^T/@PRSBLK+1/^T/(T2)/^A> ; Output the command
	$RET

; Routine - CHKDSP
;
; Function - This routine is the called by DSPCMD to see if command is
;	to be displayed.

CHKDSP:	TXNE	T1,P.TAKE		; Take command itself
	 JRST	CHKD.1			;  Yes..set flag and return false
	TXC	T1,P.CTAK!P.ERRO	; From take and an error
	TXCN	T1,P.CTAK!P.ERRO	; Both were set
	 $RETT				;  Yes..display the text
	TXNN	T1,P.DSPT		; Display take command
	 $RETF				;  Return false
	$RETT				; O.k. return true

CHKD.1:	SETOM	TAKFLG			; In take command
	$RETF				; Return false
; Routine - T$EFND
;
; Function - To search a table for a particular 18 bit value and return
;	the associated 18 bit data value if found.
;
; Parameters -
;
;	S1/	Value to search for
;	S2/	Address of table
;
;	Table format:
;
;		Max-entries,,actual-entry-count
;		Key-value-1,,data-value-1
;		Key-value-n,,data-value-n
;		etc.
;
; Returns -
;
;	False if not found in table (or no entries)
;	True  if found and S1 contains the associated data value.

T$EFND:	HRRZ	TF,(S2)			; Get count of entries in table
	JUMPE	TF,.RETF		; If none .. search fails
	MOVNS	TF			; Make negative count
	HRL	S2,TF			; Make AOBJP pointer for search loop
	AOS	S2			; Move onto first entry in table

EFND.1:	HLRZ	TF,(S2)			; Get next table key value
	CAMN	TF,S1			; Check for a match
	 JRST	[HRRZ S1,(S2)		;  If so .. get data value
		 $RETT]			;  and give search success flag
	AOBJN	S2,EFND.1		; No match .. move onto next entry
	$RETF				; Ran out of entries .. search fails
	SUBTTL	Semantic service routines

; Keyword routine - HELP
;
; Function - To supply help for any of the other commands.

HELP:	$CALL	P$KEYW			; Get next keyword value
	 JUMPF	HLPR.1			;  No .. go try * token
	HRRO	S2,S1			; Point to keyword string
	JRST	HLPR.2			; Go try for help

HLPR.1:	$CALL	P$TOK			; Get address of token string
	JUMPT	[HRROI	S2,1(S1)	;  Point to it
		 JRST	HLPR.2]		;  Process all help entries
	HRROI	S2,[ASCIZ \INTRO\]
	MOVEI	S1,INTFD		; Introduction file FD
	CAIA

HLPR.2:	MOVEI	S1,HLPFD		; Help file FD address
	$CALL	P$HELP			; Get help
	$RETT

TOPS20 <
HLPFD:	XWD	5,0
	ASCIZ	/HLP:RDLOG.HLP/

INTFD:	XWD	5,0			; Introduction FD
	ASCIZ	/HLP:RDLINT.HLP/
    >;End if TOPS20

TOPS10 <
HLPFD:	XWD	FDMSIZ,0		; Size of the file descriptor
	SIXBIT	/HLP/
	SIXBIT	/RDLOG/
	SIXBIT	/HLP/
	XWD	0,0

INTFD:	XWD	FDMSIZ,0		; Size of the file descriptor
	SIXBIT	/HLP/			; Device HLP:
	SIXBIT	/RDLINT/		; Introduction file
	SIXBIT	/HLP/
	XWD	0,0
    >;End if TOPS10
TOPS20 <
; Keyword Routine - PUSHR
;
; Function - To push to a new EXEC.  The EXEC that is mapped into the inferior
;	process is the same one that is running as the TOP-PROCESS.

PUSHR:	SKIPE	PUSFRK			; Check for a fork already created
	 JRST	PUSCNT			;  Go continue the fork
	MOVX	S1,CR%CAP		; Give it same capabilites
	SETZ	S2,			; No ACs
	CFORK				; Create a fork
	 JRST	[$ERET <Can't create an inferior fork>]
	MOVEM	S1,PUSFRK		; Save fork handle
	HRROI	S1,PUSNAM		; Scratch area to write EXEC filename
	MOVEI	S2,1			; JFN of TOPPROCESS EXEC
	SETZB	T1,T2			; Clear format control
	JFNS				; Get file name
	 ERJMP	[$ERET <Can't read TOPprocess EXEC filename>,,PUSKIL]
	HRROI	S2,PUSNAM		; Point to the file name
	MOVX	S1,GJ%OLD+GJ%SHT
	GTJFN
	 JRST	[$ERET <Can't get JFN of EXEC>,,PUSKIL]
	HRL	S1,PUSFRK		; Put process handle in left half
	GET				; MAP in the EXEC
	 ERJMP	[$ERET <Can't map in EXEC>,,PUSKIL]
	TDZA	S2,S2			; Start at primary entry address
PUSCNT:	 MOVEI	S2,1			;  Start at re-enter address
	MOVE	S1,PUSFRK		; Get fork of push process again
	SFRKV				; Start the fork
	 ERJMP	[$ERET <Can't start sub-fork>]
	WFORK				; Wait for the fork to pop
	RFSTS				; Get the fork status
	LOAD	S1,S1,RF%STS		; Get termination code
	CAIN	S1,.RFFPT		;  Was it an error?
	 JRST	[$ERET <Fork terminated abnormally>,PUSFRK,PUSKIL]
	$RETT				; Successful return

PUSKIL:	MOVE	S1,PUSFRK		; Get inferior fork handle
	SETZM	PUSFRK			; Clear fork handle
	KFORK				; Kill it
	 ERJMP	[$ERET <Failure while killing fork>]
	$RETF
    >;End if TOPS20
; Routine - LOGCHR
;
; Function - To output the LOG information to the appropriate device.
;	If the flag TABFLG is non-zero, each line is preceded by a TAB.

LOGCHR:	CAIN	S1,12			; Check for a line-feed
	SKIPN	TABFLG			; Check for TAB at start of lines
	 PJRST	LOGX			;  No .. just output character
	$CALL	LOGX			; Output line-feed
	MOVX	S1,11			; Get TAB character and output

LOGX:	SKIPN	LSTIFN			; Check for "OUTPUT"ing
	 PJRST	T%TTY			;  No .. output to TTY
	AOSLE	LSTCNT			; Check for room in buffer
	 JRST	[$CALL	LOGOUT		;  Output text buffer
		 JUMPF  .POPJ		;  If failed .. give failure return
		 JRST	.+1]		;  Continue processing current char
	IDPB	S1,LPNT			; Put character into buffer
	$RETT

; Routine - LOGOUT, LOGRST
;
; Function - To dump the text output buffer and reset the count and pointer

LOGOUT:	$SAVE	<S1,S2>
	MOVE	S1,LSTCNT		; Get down count value
	ADDI	S1,5*1000		; Find number of bytes in buffer
	JUMPE	S1,.POPJ		; If no bytes .. just return
	HRL	S2,S1			; Put into LH
	HRR	S2,LSTBUF		; Get address of buffer
	MOVE	S1,LSTIFN		; Get file handle
	$CALL	F%OBUF			; Output the buffer
	JUMPT	LOGRST			; Reset the pointers and count
	$TEXT	,<?Write failure ^E/-1/ on: ^F/LFOB+FOB.FD/>
	$RETF

LOGRST:	MOVE	S1,LSTBUF		; Get address of output buffer
	HRLI	S1,440700		; Make into ASCII pointer
	MOVEM	S1,LPNT			; Save for LOGCHR routine
	MOVNI	S1,5*1000-1		; Get number of characters in buffer
	MOVEM	S1,LSTCNT		; Reset character count
	$RET
; Keyword routine - OUTPUT
;
; Function - To open and setup the output log file.

OPUT:	$CALL	P$OFIL			; Get file FD of log file
	MOVEM	S1,LFOB+FOB.FD		; Store in FOB for open
	MOVX	S1,FOB.MZ		; Get size of FOB
	MOVEI	S2,LFOB			; Get address of FOB
	$CALL	F%OOPN			; Open for output
	MOVEM	S1,LSTIFN		; Save IFN for later
	JUMPT	OPUT.1			; If success .. go reset pointers
	SETZM	LSTIFN			; Failed .. clear IFN
	$TEXT	,<?Open failure ^E/-1/ on: ^F/LFOB+FOB.FD/>
	$RET

OPUT.1:	$CALL	LOGRST			; Reset pointers
	$TEXT	LOGCHR,<[Interpreted by RDLOG version: ^V/[%%.RDL]/]^A>
	$CALL	LIST.A			; Output log file data
	$TEXT	LOGCHR,<^M^J[End of log]>
	$CALL	LOGOUT			; Output any last bit of buffer
	MOVE	S1,LSTIFN		; Get file handle
	$CALL	F%REL			; Close and release log file
	$RET
; Keyword routine - LIST
;
; Function - To list all the entries in a log data file.  Each entry
;	in the file is read, interpreted and listed.

LIST:	SETZM	LSTIFN			; Clear output file handle
LIST.A:	$CALL	P$IFIL			; Get file FD of data file
	MOVEM	S1,DFOB+FOB.FD		; Store in FOB for open
	SETZB	S1,S2			; Clear a couple of registers
	DMOVEM	S1,MRKUTL		; Clear mark boundaries
	DMOVEM	S1,TIMUTL		; Clear time boundaries
	SETOM	LSTGO			; Initially enable listing
	SETZM	ENTCNT			; Clear count of entries processed
	$CALL	LSTSWT			; Parse any boundary switches
	MOVX	S1,FOB.MZ		; Get size of FOB
	MOVEI	S2,DFOB			; Get address of FOB
	$CALL	F%IOPN			; Open log file for 36bit read mode
	JUMPT	LIST.1			; If succeeded .. continue
	$TEXT	,<?Open failure ^E/-1/ on: ^F/DFOB+FOB.FD/>
	$RET

LIST.1:	MOVEM	S1,DIFN			; Save file handle
	$CALL	F%IBYT			; Get version number of FELOG
	 JUMPF	LIST.F			;  If failure .. output error message
	$TEXT	LOGCHR,<^M^J[Recorded with FELOG version: ^V/S2/]>
	SKIPE	LSTIFN			; Check if just output to TTY
	 $TEXT	,<^M^J[Recorded with FELOG version: ^V/S2/]>

LIST.2:	MOVE	S1,DIFN			; Get file handle
	$CALL	F%IBYT			; Get next entry length and flags
	 JUMPF	LIST.F			;  If error happens .. drop dead
	JUMPE	S2,LIST.E		; If zero .. end of data stream
	$CALL	LIST.C			; Go call appropriate list routine
	 JUMPF	LIST.F			;  If I/O error .. tell so
	JRST	LIST.2			; Do next entry

LIST.F:	$TEXT	,<?Unexpected I/O error^M^J?^E/[-2]/>
LIST.E:	$TEXT	,<[^D/ENTCNT/ entries processed]>
	SKIPE	LSTIFN			; Output to listing file if any.
	 $TEXT	LOGCHR,<[^D/ENTCNT/ entries processed]>
	MOVE	S1,DIFN			; Get file handle again
	$CALL	F%REL			; Release it
	$RET


LIST.C:	AOS	ENTCNT			; Increment entry count
	TXNE	S2,PHSBEF		; Check for "BEFORE" phase
	 PJRST	RDBEF			;  Read before entry
	TXNE	S2,PHSAFT		; Check for "AFTER" phase
	 PJRST	RDAFT			;  Read and list current entries
	TXNE	S2,PHSMRK		; Check for "MARK" entry
	 PJRST	RDMRK			;  Read and dump mark
	TXNE	S2,PHSSKD		; Check for "SCHEDULER" entry
	 PJRST	RDSKD			;  Read and dump SCHED info
	$TEXT	,<?Illegal entry format.>
	$RETF
; Routine - LSTSWT
;
; Function - Read and process switches that bound the entries to be
;	interpreted.
;
;	/AFTER:TIME: time
;	/UNTIL:TIME: time
;	/AFTER:MARK:xx n
;	/UNTIL:MARK:xx n
;
;	where xx is LOCATION, NUMBER or NAME.

LSTSWT:	$CALL	P$SWIT			; Get switch value
	 JUMPF	@.POPJ			;  If not switch .. return (CRLF)
	CAIN	S1,.UTL			; Check for "UNTIL" switch
	 TDZA	P1,			;  Yes .. zero offset
	JRST	[MOVEI	P1,1		; No .. 1 offset "AFTER"
		 SETZM	LSTGO		; Start listing after condition met
		 JRST	.+1]
	$CALL	P$KEYW			; Get "TIME"/"MARK" keyword
	CAIN	S1,.TIM			; Check for "TIME"
	 JRST	LSTTIM			;  Yes .. go set time
	$CALL	P$NUM			; No .. read "MARK" number
	MOVEM	S1,MRKUTL(P1)		; Set mark number
	JRST	LSTSWT			; Process next switch

LSTTIM:	$CALL	P$TIME			; Get time value
	MOVEM	S1,TIMUTL(P1)		; Set time boundary
	JRST	LSTSWT			; Process next switch
; Routine - RDBEF
;
; Function - To read the "BEFORE" data file entry.
;
; Returns - FALSE	I/O error occured
;	    TRUE	Buffer contains entry

RDBEF:	MOVE	P1,BUFBEF		; Point to "BEFORE" buffer
	PJRST	RDBUF			; Get entry and propogate any errors
; Routine - RDAFT
;
; Function - To read the "AFTER" data file entry.  When the buffer has been
;	read in, the current "BEFORE" entry and the current "AFTER" entry
;	together are interpreted
;
; Returns - FALSE	I/O error occured
;	    TRUE	Buffer contains entry

RDAFT:	MOVE	P1,BUFAFT		; Point to "AFTER" data buffer
	$CALL	RDBUF			; Get "AFTER" entry
	 JUMPF	.POPJ			;  Propogate any I/O errors
	MOVE	S1,1(P1)		; Get TIME of entry
	MOVEM	S1,TIME			; Save it

	SKIPE	T1,TIMUTL		; Check for UNTIL:TIME set
	 JRST	[CAIGE	S1,T1		;  Yes .. check if done
		  JRST	.+1		;   No .. check other end of bounds
		 SETZM	LSTGO		;  Yes .. clear listing flag
		 $RETT]			;  Return
	SKIPE	T1,TIMAFT		; Check for AFTER:TIME set
	 JRST	[CAIL	S1,T1		;  Yes .. check if to start
		  SETOM	LSTGO		;   Yes .. set listing flag
		 JRST .+1]
	SKIPN	LSTGO			; Check for LISTing enabled
	 $RETT				;  No .. wait for /AFTER condition met

TOPS10 <MOVEI	P2,3(P1)		; Offset to CAL11. block
	LOAD	T1,(P2),C$PRT		; Get port number
	MOVEM	T1,PORT			; Save it
	LOAD	T1,(P2),C$LIN		; Get line number
	MOVEM	T1,LINE			; Save it
	LOAD	T1,(P2),C$DEV		; Get device code
	MOVEM	T1,DEVICE		; Save it
	LOAD	T1,(P2),C$FC		; Get function code
	LOAD	T2,(P2),C$RC		; Get result code
    > ;End if TOPS10

TOPS20 <MOVEI	P2,4(P1)		; Offset to transaction header
	MOVE	T1,3(P1)		; Get port number
	MOVEM	T1,PORT			; Save it
	LOAD	T1,(P2),HDRLN		; Get line number
	MOVEM	T1,LINE			; Save it
	LOAD	T1,(P2),HDRDV		; Get device number
	MOVEM	T1,DEVICE		; Save it
	LOAD	T1,(P2),HDRFC		; Get function code
	LOAD	T2,(P2),HDRRC		; Get result code
	LOAD	P4,(P2),HDRBC		; Get byte count
    > ;End if TOPS20

	SKIPN	S1,FNCFLG(T1)		; Check for display disabled
	 $RETT				;  No .. just return
	$TEXT	LOGCHR,<>		; Start new line
	TXNE	S1,.HDR			; Check for header enabled
	 $CALL	HEADER			; Output header to entry
	TXNN	S1,.BDY			; Check for body enabled
	 $RETT				;  Yes .. return after header listing
	HRRZ	T2,FNCTBL(T1)		; Get address of interpretation routine
	JUMPN	T2,(T2)			; Execute data interpretation routine
	$RETT				; If no routine .. just return
; Routine - RDBUF
;
; Function - To read a log data file entry into the specified buffer.
;
; Parameters -
;
;	S2/	Word count in RH
;	P1/	Buffer address (must be a full page)
;
; Returns - FALSE	I/O error occured
;	    TRUE	Buffer contains entry

RDBUF:	$SAVE	<P1>			; Save buffer address

	MOVE	S1,P1			; Get address of page
	$CALL	.ZPAGA			; Zero the buffer
	MOVEM	S2,(P1)			; Put count and flags in first word
	HRRZS	S2			; Get count only
	MOVNS	S2			; Get negative count
	HRL	P1,S2			; Make AOBJP pointer
	MOVE	S1,DIFN			; Get file handle

RDBF.1:	AOBJP	P1,.RETT		; When count exhausted .. return
	$CALL	F%IBYT			; Get next byte from data file
	 JUMPF	.POPJ			;  If I/O error .. just return
	MOVEM	S2,(P1)			; Put byte into buffer
	JRST	RDBF.1			; Go get next byte
; Routine - RDMRK
;
; Function - To interpret the information contained in a "MARK"
;	entry in the log data stream.
;
; Returns - FALSE	I/O error occured
;	    TRUE	MARK entry read successfully

RDMRK:	MOVE	P1,BUFAFT		; Get scratch buffer
	$CALL	RDBUF			; Read the MARK entry
	 JUMPF	.POPJ			;  If I/O error .. just return

	MOVE	S1,2(P1)		; Get mark location/name
	MOVE	S2,3(P1)		; Get mark incremental number
	$TEXT	LOGCHR,<^M^J***************************************************************>
	$TEXT	LOGCHR,<- MARK at time ^H/1(P1)/ number ^D/S2/ ^A>
	TLNN	S1,770000		; Check for a SIXBIT character
	 JRST	RDM.1			;  No .. assumes a number then
	$TEXT	LOGCHR,<name ^W/S1/>		; Output SIXBIT "MARK" name
	JRST	RDM.2

RDM.1:	$TEXT	LOGCHR,<location ^O/S1/>	; Output octal "MARK" location
RDM.2:	$TEXT	LOGCHR,<***************************************************************>

	SKIPE	T1,MRKUTL		; Check for MARK:UNTIL set
	 JRST	[CAIGE	S2,T1		;  Yes .. check if done
		  JRST	.+1		;   No .. check other end of bounds
		 SETZM	LSTGO		;  Yes .. clear listing flag
		 $RETT]			;  Return
	SKIPE	T1,MRKAFT		; Check for MARK:AFTER set
	 JRST	[CAIL	S2,T1		;  Yes .. check if to start
		  SETOM	LSTGO		;   Yes .. set listing flag
		 $RETT]			;  Return
	$RETT				; Return
; Routine - RDSKD
;
; Function - To read and interpret a SCHEDULER type entry.  This entry
;	is provided to aid in evaluating the efficiency of task schedulers
;
; Returns - FALSE	I/O error occured
;	    TRUE	MARK entry read successfully

RDSKD:	MOVE	P1,BUFAFT		; Get scratch buffer
	$CALL	RDBUF			; Read the MARK entry
	 JUMPF	.POPJ			;  If I/O error .. just return
	$TEXT	LOGCHR,<^M^J+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++>
	$TEXT	LOGCHR,<Task: ^O/2(P1)/  Flags: ^O/3(P1)/  Wakeup time: ^H/4(P1)/  Time scheduled: ^H/1(P1)/>
	$TEXT	LOGCHR,<+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++>
	$RET
; Routine - HEADER
;
; Function - To create the entry text header.  This header describes the
;	phase, time, port/line/device and function that was recorded.
;
; Parameters -
;
;	T1/	Function code
;	T2/	Result code
;	TIME/	Time entry was logged
;	PORT/	Port number of front end
;	LINE/	Line number for line and device functions
;	DEVICE/	Device number for device functions
;
; Note - Destroys T3 and T4

HEADER:	MOVEI	T3,-1(T1)		; Get function code - 1
	IDIVI	T3,2			; Find offset to "WHAT" vector
	$TEXT	LOGCHR,<^T/@FNCSTR(T1)/	^I/@WHAT(T3)/	"^T/@RESULT(T2)/" 	   ^H/TIME/>
	$RET

WHAT:	[ITEXT <P:^O/PORT/ L:^O/LINE/ D:^O/DEVICE/>]
	[ITEXT <P:^O/PORT/ L:^O/LINE/ D:^O/DEVICE/>]
	[ITEXT <P:^O/PORT/ L:^O/LINE/>]
	[ITEXT <P:^O/PORT/	>]

FNCSTR:	[ASCIZ \Unknown Function\]
	[ASCIZ \Read Data Request\]
	[ASCIZ \Write Data Request\]
	[ASCIZ \Read Device Status\]
	[ASCIZ \Write Device Command\]
	[ASCIZ \Read Line Status\]
	[ASCIZ \Write Line Command\]
	[ASCIZ \Read Port Status\]

RESULT:	[ASCIZ \Unknown result\]
	[ASCIZ \Succeeded\]
	[ASCIZ \Delayed\]
	[ASCIZ \Rejected\]
; Routine - PNTBEF, PNTAFT
;
; Function - To create the needed pointers to the data part of the current
;	entries.
;
; Returns -
;
; PNTBEF	P1/	Buffer address containing data
;		P2/	Address of transaction header
;		P3/	Byte pointer to data portion
;		P4/	Byte count of data

PNTBEF:	MOVE	P1,BUFBEF		; Get address of "BEFORE" entry buffer

TOPS20 <MOVEI	P2,4(P1)		; Point to transaction header
	LOAD	P4,(P2),HDRBC>		; Get byte count
TOPS10 <MOVEI	P2,3(P1)		; Point to transaction header
	LOAD	P4,(P2),C$NBT>		; Get byte count
	JRST	PNTCOM			; Go fixup byte pointer

PNTAFT:	MOVE	P1,BUFAFT		; Get address of "AFTER" entry buffer

TOPS20 <MOVEI	P2,4(P1)		; Point to transaction header
	LOAD	P4,(P2),HDRBC>		; Get byte count
TOPS10 <MOVEI	P2,3(P1)		; Point to transaction header
	LOAD	P4,(P2),C$BXF>		; Get byte count


PNTCOM:	$SAVE	<S1>

	MOVE	P3,2(P1)		; Get byte pointer to data portion
	HRR	P3,P1			; Create address part of pointer
	ADDX	P3,FIXLEN		; Offset to data part
	LOAD	S1,P3,BP.POS		; Get position of next byte
	CAIG	S1,7			; Check for overflow to next word
	 MOVEI	S1,44			;  Yes .. reset to start of word
	STORE	S1,P3,BP.POS		; Put position of next byte back
	$RET
; Routine - RDDAT, WDDAT
;
; Function - To interpret the data string in read and write data
;	entries.

RDDAT:	$CALL	PNTAFT			; Point to "AFTER" data buffer
	PJRST	DATPRT			; Interpret data

WDDAT:	$CALL	PNTBEF			; Point to "BEFORE" data buffer
	PJRST	DATPRT			; Interpret data
; Routine - DATPRT
;
; Function - To print and interpret data messages
;
; Parameters -
;
;	P4/	Number of bytes in string
;	P3/	Byte pointer to string

DATPRT:	JUMPE	P4,.RETT		; If no bytes .. just return
	SETOM	TABFLG			; Indicate TAB over for each line
	$TEXT	LOGCHR,<[^D/P4/ bytes]^M^J^A>
	SETZM	LOGCOL			; Clear column counter
DTP.1:	SOJL	P4,DTP.3		; Check for end of string
	ILDB	T1,P3			; Get next byte in string
	CAIGE	T1," "			; Check for control character
	 JRST	DTP.2			;  Yes .. go print octal value
	CAIE	T1,176			; Check for two other funny
	CAIN	T1,177			; characters
	 JRST	DTP.2			;  Yes .. go print octal
	MOVE	S1,LOGCOL		; Get current column count
	CAIGE	S1,^d72			; Check for column overflow
	 JRST	DTP.O			;  No .. go output character
	$TEXT	LOGCHR,<>		; Start new line
	SETZM	LOGCOL			; Clear column counter
DTP.O:	$TEXT	LOGCHR,<^7/T1/^A>	; Print character
	AOS	LOGCOL			; Increment column counter
	JRST	DTP.1			; Go get next character

DTP.2:	MOVEI	S1,3			; Default to one character octal
	CAIL	T1,10			; Check for 2 digit octal
	 MOVEI	S1,4
	CAILE	T1,37			; Check for 3 digit octal
	 MOVEI	S1,5
	MOVE	S2,LOGCOL		; Get column counter
	ADDI	S2,2(S1)		; Bias it for number of digits
	CAIGE	S2,^d72			; Check for overflow on octal output
	 JRST	DTP.OO			;  No .. go output octal value
	$TEXT	LOGCHR,<>		; Start new line
	SETZM	LOGCOL			; Clear column counter
DTP.OO:	$TEXT	LOGCHR,<^7/[74]/^O/T1/^7/[76]/^A>
	ADDM	S1,LOGCOL		; Increment column counter
	JRST	DTP.1			; Go do next character

DTP.3:	SETZM	TABFLG			; Indicate no more TABs
	$TEXT	LOGCHR,<>		; Output last CRLF
	$RETT
; Routine - R6SAFT
;
; Function - To interpret a port status data block

R6SAFT:	STKVAR	<ACTFLG,DEVFLG>

	$CALL	PNTAFT			; Setup pointers to status string
	SETOB	P4,TABFLG		; Indicate each line preceded by TAB
	SETZM	ACTFLG			; Clear activity seen
	MOVSI	P1,-^d12		; 12 lines of status on port
	HRRI	P1,S6ACT(P3)		; Point to start of activity bits
ACTS.7:	AOS	P4			; Increment line number
	SKIPN	P2,(P1)			; Get status of next line
	 JRST	ACTS.E			;  If no bits set go to next line
	SKIPN	ACTFLG			; Did we already output message
	 $TEXT	LOGCHR,<	Activity on:^A>
	SETOM	ACTFLG			; Say that we output activity already
	SETZM	DEVFLG			; Say that no device name output yet.
	$TEXT	LOGCHR,< Line ^O/P4/^A>	; Output line number

	CAXE	P2,<777777,,777760>	; Check for line hardware abort
	 JRST	ACTS.A			;  No .. check for each device
	$TEXT	LOGCHR,< Line hardware abort;^A>
	JRST	ACTS.E			; Go onto next line

ACTS.A:	TXNN	P2,1b0			; Check for console input
	 JRST	ACTS.I			;  No .. check output console
	SETOM	DEVFLG			; Say device has been output
	$TEXT	LOGCHR,< Output console^A>
ACTS.I:	TXNN	P2,1b1			; Check for console output
	 JRST	ACTS.O			;  No .. check other devices
	SKIPE	DEVFLG			; Check if input console output
	 $TEXT	LOGCHR,<,^A>		; Yes .. separate by comma
	$TEXT	LOGCHR,< Input console^A>
	SETOM	DEVFLG

ACTS.O:	MOVSI	P3,-3			; Three types of generic devices
ACTS.8:	LDB	S2,ACTBYT(P3)		; Get activity of generic device
	JUMPE	S2,ACTS.9		; Go to next if no activity
	SKIPE	DEVFLG			; Check if first device type
	 $TEXT	LOGCHR,<,^A>		;  No .. separate by comma
	SETOM	DEVFLG			; Say that device has been output
	$TEXT	LOGCHR,< ^T/@ACTDEV(P3)/ ^A> ; Output device type
	$CALL	LSTBIT			; List the device units that are active

ACTS.9:	AOBJN	P3,ACTS.8		; Loop over generic devices
	$TEXT	LOGCHR,<;^A>		; Finish for current line
ACTS.E:	AOBJN	P1,ACTS.7		; Loop over all lines
	SETZM	TABFLG			; No more TABs
	SKIPE	ACTFLG			; Check if any activity output
	 $TEXT	LOGCHR,<>		; Finish last line of status
	$RETT


ACTBYT:	POINT	8,P2,15			; 2nd byte
	POINT	8,P2,23			; 3rd byte
	POINT	8,P2,31			; 4th byte

ACTDEV:	[ASCIZ \Card reader\]
	[ASCIZ \Line printer\]
	[ASCIZ \Card punch\]
; Routine - LSTBIT
;
; Function - To output a string that tells what bits are turned on in a status
;	word.
;
; Parameters -
;
;	S2/	Status word with the "bits"
;
; Notes -
;
;	LB.HLD	Last value found in a sequence of "ON" bits
;	LB.LST	Last value actually output

LSTBIT:	ACVAR	<LB.HLD,LB.LST>
	SETOB	LB.HLD,LB.LST		; No hold value and no value output
	SETZ	S1,			; Start at bit zero
	JUMPE	S2,@.RETT		; If no bits turned on .. just return

LB$L:	ROT	S2,-1			; Move next bit to sign bit
	JUMPL	S2,LB$ON		; Check for bit set
	JUMPL	LB.HLD,LB$NXT		; No .. check for sequence started
	CAMN	LB.HLD,LB.LST		; Check for hold value as last output
	 JRST	LB$NHD			;   Yes .. so don't output again
	CAIE	LB.HLD,1(LB.LST)	; Check for more than two value
	 JRST	LB$DSH			;  sequence and output dash if so.
	$TEXT	LOGCHR,<,^O/LB.HLD/^A>	; Output this value
	CAIA
LB$DSH:	$TEXT	LOGCHR,<-^O/LB.HLD/^A>	; Output end of sequence
	MOVEM	LB.HLD,LB.LST		; Set the last value output
LB$NHD:	SETOM	LB.HLD			; Clear sequence running value
LB$NXT:	AOJA	S1,LB$L			; Go do the next bit

LB$ON:	TXZ	S2,1b0			; Turn of the bit
	JUMPL	LB.LST,LB$1ST		; Check for any value output already
	JUMPGE	LB.HLD,LB$NSQ		; Yes .. check for sequence running
	$TEXT	LOGCHR,<,^A>		; No .. just output the value
LB$1ST:	$TEXT	LOGCHR,<^O/S1/^A>	; Output value
	MOVEM	S1,LB.LST		; Save last value output
LB$NSQ:	MOVEM	S1,LB.HLD		; Save last value in sequence
	JUMPN	S2,LB$NXT		; If any bits left .. goto next one

	CAMN	S1,LB.LST		; Was current value last one output?
	 JRST	LB$END			;  Yes .. no more to output
	CAIE	S1,1(LB.LST)		; Check for more than two value
	 JRST	LB$DS1			;  sequence and output dash if so.
	$TEXT	LOGCHR,<,^O/S1/^A>	; Output this value
	CAIA
LB$DS1:	$TEXT	LOGCHR,<-^O/S1/^A>	; Output end of sequence
LB$END:	$RETT
; Routine - RLSAFT
;
; Function - To interpret a line status data block

RLSAFT:	$CALL	PNTAFT			; Point to "AFTER" data buffer
	SKIPN	P4			; Check for disabled line
	 JRST	[$TEXT LOGCHR,<	Line is disabled>
		 $RETT]
	ILDB	S1,P3			; Get line type
	$TEXT	LOGCHR,<	^T/@LINTYP(S1)/^A>
	$CALL	LFLGS			; Output line flags

	ILDB	S1,P3			; Get line info
	$BIT	0,<, Line enabled>
	$BIT	1,<, DTR set>
	$BIT	2,<, DSR set>

	MOVE	P1,[-^d32,,LSTBL]	; Point to line status table
RLSA.1:	$CALL	GET16			; Get next 16 bit value
	JUMPE	S1,[SKIPL (P1)		;  Check for unconditionally printed
		     JRST RLSA.2	;   No .. suppress on zero value
		    JRST  .+1]		;  Continue printing
	HRR	S2,(P1)			; Get address of text
	$TEXT	LOGCHR,<, ^T/(S2)/ ^D/S1/^A> ; Print item
RLSA.2:	AOBJN	P1,RLSA.1		; Continue until all done

	$CALL	GET16			; Get line driver type
	$TEXT	LOGCHR,<, ^T/@DRTBL(S1)/>
	$RETT
; Routine - RDSAFT
;
; Function - To interpret the device status string values.

RDSAFT:	$CALL	PNTAFT			; Point to "AFTER" data buffer
	ILDB	S1,P3			; Get device type
	$TEXT	LOGCHR,<	Device type: ^T/@DEVTYP(S1)/, Component code: ^A>
	$CALL	DCCMP			; Output component code
	$CALL	GET16			; Get line counter
	SKIPE	S1			; If zero .. ignore it
	 $TEXT	LOGCHR,<, Line count ^D/S1/^A>

	$CALL	GET32			; Get 32 bits worth of flags
	$BIT	4,<, Interpret input carriage control>
	$BIT	5,<, Interpret output carriage control>
	$BIT	7,<, Do component selection>,<, No component selection>
	$BIT	^d8,<, Do space compression>
	$BIT	^d9,<, Page counter overflowed>
	$BIT	^d10,<, Page counter interrupts enabled>
	$BIT	^d11,<, Old BSC protocol>,<, New BSC protocol>
	$BIT	^d12,<, Output buffers dumping>
	$BIT	^d13,<, Input permission sent to HASP>
	$BIT	^d14,<, Input mode>,<, Output mode>
	$BIT	^d16,<, Output permission requested>
	$BIT	^d17,<, Output permission granted>
	$BIT	^d18,<, Output running>
	$BIT	^d19,<, Output EOF signaled>
	$BIT	^d20,<, Output EOF complete>
	$BIT	^d21,<, Output abort started>
	$BIT	^d22,<, Output abort complete>
	$BIT	^d23,<, Input permission requested>
	$BIT	^d24,<, Input permssion granted>
	$BIT	^d25,<, Input running>
	$BIT	^d26,<, Input abort started>
	$BIT	^d27,<, Input abort complete>
	$BIT	^d28,<, Input EOF complete>
	$BIT	^d29,<, Input permissmion was requested>
	$BIT	^d30,<, Output permission was requested>
	$BIT	^d31,<, Communications established>

	$CALL	GET16			; Get record size
	$TEXT	LOGCHR,<, Record size ^D/S1/^A>
	$CALL	GET16			; Get line flags
	$BIT	^d10,<, Hardware line abort>
	$CALL	GET16			; Get line signature
	$TEXT	LOGCHR,<, Line signature ^D/S1/>
	$RETT
; Routine - LFLGS
;
; Function - To interpret the line flags given in the line status and
;	device status strings.
;
; Parameters -
;
;	P3/	Byte pointer to data part of entry

LFLGS:	$CALL	GET16			; Get line flags
	$BIT	0,<, Emulation>,<, Termination>
	$BIT	1,<, Primary>,<, Secondary>
	$BIT	2,<, Signed on>
	$BIT	3,<, Transparency enabled>
	$BIT	4,<, Disable in progress>
	$BIT	5,<, Line enable complete>
	$BIT	6,<, Line abort complete>
	$BIT	7,<, Off line>
	$BIT	^d8,<, Line disable complete>
	$BIT	^d9,<, Disable done bye DTE failure>
	$BIT	^d10,<, Hardware line abort>
	$BIT	^d11,<, Communications established>
	$RETT
; Routine - WDCBEF, WLCBEF
;
; Function - To interpret the data portion (command) part of a device
;	or line command.  The vector tables DCTBL and LCTBL contain
;	pointers to the command text names and routines to do additional
;	processing on the command data.

WDCBEF:	MOVEI	S1,DCTBL		; Base address of device command table
	CAIA
WLCBEF:	MOVEI	S1,LCTBL		; Base address of line command table
	$CALL	PNTBEF			; Point to "BEFORE" data entry
	ILDB	S2,P3			; Get command number
	ADD	S1,S2			; Offset into table
	HRRZ	S2,(S1)			; Get command name text
	$TEXT	LOGCHR,<	^T/@S2/^A> ; Output command name text
	HLRZ	S2,(S1)			; Get address of command routine
	SKIPE	S2			; Check if there is one
	 $CALL	(S2)			;  Yes .. do it
	$TEXT	LOGCHR,<>		; Put CRLF at end of text string.
	$RETT
; Routine - LCEL
;
; Function - To interpret the parameters specified on the line command
;	ENABLE LINE (LC.EL).
;
; Parameters -
;
;	P3/	Byte pointer to data buffer

LCEL:	ILDB	S1,P3			; Get type of station
	$TEXT	LOGCHR,<^T/@LINTYP(S1)/, ^A>
	ILDB	S1,P3			; Get flags
	$BIT	0,<Emulation, >,<Termination, >
	$BIT	1,<Primary>,<Secondary>
	$RETT
; Routine - DCCMP
;
; Function - To output the component code interpretation.
;
; Parameters -
;
;	P3/	Byte pointer to data block in entry

DCCMP:	ILDB	S1,P3			; Get component code specified
	MOVE	T1,S1			; Save copy of value
	MOVEI	S2,CMPTBL		; Point to interpretation table
	$CALL	T$EFND			; Find the entry
	JUMPF	[MOVEI S1,[ASCIZ \Unknown\]
		 JRST .+1]
	$TEXT	LOGCHR,<(^O/T1/) ^T/(S1)/^A>
	$RETT


; Routine - DCSC
;
; Function - To output the device type
;
; Parameters -
;
;	P3/	Byte pointer to data block in entry

DCSC:	ILDB	S1,P3			; Get device code
	$TEXT	LOGCHR,<^T/@DEVTYP(S1)/^A>
	$RETT
; Routine - COMDEC, COMOCT
;
;	(LC.CSD, LC.WAR, LC.BPM, LC.RPM)
;	(DC.REC, DC.SLC, DC.SBS, DC.BPR)
;
; Function - To print the 16 bit value associated with each of the commands.
;
; Parameters -
;
;	P3/	Byte pointer to data block in entry

COMDEC:	$CALL	GET16
	$TEXT	LOGCHR,<^D/S1/^A>
	$RETT

COMOCT:	$CALL	GET16
	$TEXT	LOGCHR,<^O/S1/^A>
	$RETT
; Routine - GET16, GET32
;
; Function - To load either 16 or 32 bit values from the data buffer
;	into S1.  This routine assumes that the 16 or 32 bit value is not
;	split over a 36 bit word boundary.
;
; Parameters -
;
;	P3/	Byte pointer to data buffer
;
; Returns -
;
;	S1/	Data value
;	P3/	Updated byte pointer

GET32:	ILDB	S2,P3			; Get low order 8 bits
	ROTC	S1,-^d8			; Put into S2
	ILDB	S2,P3			; Repeat for other 3 bytes
	ROTC	S1,-^d8
	ILDB	S2,P3
	ROTC	S1,-^d8
	ILDB	S2,P3
	ROTC	S1,-^d12		; Shift extra for lower null 4 bits
	$RET

GET16:	ILDB	S1,P3			; Get low order 8 bits
	ILDB	T1,P3			; Get high order 8 bits
	LSH	T1,^d8			; Shift it up
	IOR	S1,T1			; Put it all together
	$RET
; Keyword routine - ENABLE, DISABLE
;
; Function - To enable or disable a particular port/line/device combination
;	from interpretation and output, or a particular function code.
;
;	Each function has a word (offset by function number) that contains
;	the flags .HDR and .BDY.  Each flag determines whether it's
;	corresponding part of an entry is listed.

ENABLE:	TDZA	T1,T1			; Flag ENABLE being done
DISABL:	 MOVX	T1,1			; Flag DISABLE being done
	$CALL	P$KEYW			; Get PORT/ENTRY keyword
	CAIN	S1,.ENT			; Check for "ENTRY"
	 JRST	ED.ENT			;  Yes .. go process entry
	$TEXT	,<?Port selection currently unsupported.>
	$RETF

ED.ENT:	$CALL	P$KEYW			; Get function code
	MOVE	T2,S1			; Save it for a minute
	$CALL	P$SWIT			; Get switch /HEADER or /BODY
	SKIPT				
	 SETO	S1,			;  If no switch, do for both /H and /B
	XCT	[IORM S1,FNCFLG(T2)	; ENABLE
		 ANDCAM S1,FNCFLG(T2)](T1) ; DISABLE
	$RETT
	SUBTTL	Error output routine

; Routine - ERRPRT
;
; Function - To print out a text error message and the last error
;	that occured at monitor level for this job.
;
; Parameters -
;
;	S1/	Byte pointer to error message string
;	S2/	Process handle

ERRPRT:	$TEXT	,<?^T/(S1)/^M^J?^E/[-2]/>
	$RETF
	SUBTTL	Command syntax tables

PRSBLK:	BLOCK	PAR.SZ			; Parser argument block

TOPPRM:	ASCIZ \RDLOG>\			; Default prompt message

TOPSCN:	$INIT	(TOPPDB)
TOPPDB:	$KEYDSP	(TOPKEY)

Define KY (KEYW,KEYM,KEYV,KEYP) 
<IFNDEF KEYM,<KEYM==..KC		;; Assign keyword mnemonic value
	      ..KC==..KC+1>		;; Increment to next keyword value
	DSPTAB (KEYP,KEYM,KEYW)		;; Table entry for keyword
  >;End KY definition

	..KC==1				; Initialize keyword counter

TOPKEY:	$STAB				; Top of command string
	 KYWRDS				;  Entry for each keyword
	$ETAB


; EXIT (to EXEC)

EXIPDB:	$NOISE	(EXT.1,to EXEC)
EXT.1:	$CRLF	(<$ACTION EXIT>)
EXIT:	$CALL	P$NPRO			; No processing needed on command
	$HALT				; Stop the run (continuable)
	$RETT				; Return if continued

; HELP "keyword" or "*" or CRLF

HELPDB:	$NOISE	(HLP.1,on command)
HLP.1:	$KEY	(CFMPDB,HLP.2,<$Alternate HLP.3>)
HLP.2:	$STAB
	 Define KY (KEYW,B,C,D) <KEYTAB ([ASCIZ \KEYW\],<KEYW>)>
	 KYWRDS				; Help for all top level keywords
	$ETAB
HLP.3:	$TOKEN	(CFMPDB,*,<$Help <* for help on all commands>,$Alternate CFMPDB>)


TOPS20 <
; PUSH (to EXEC)

PUSPDB:	$NOISE	(CFMPDB,to EXEC)
    >;End if TOPS20


; TAKE (command file) file-name

TAKPDB:	$NOISE	(TAK.1,command file)
TAK.1:	$IFILE	(CFMPDB,Command file name)


; VERSION
 
VERPDB:	$NOISE	(VER.1,of RDLOG)
VER.1:	$CRLF	(<$ACTION VERSN>)
VERSN:	$CALL	P$NPRO			; Set no processing flag
	$TEXT	,< RDLOG V.^V/[%%.RDL]/> ; Output program version number
	$RETT				; Return to parser


CFMPDB:	$CRLF


; LIST (data file) file-name

LSTPDB:	$NOISE	(LST.1,data file)
LST.1:	$IFILE	(CFMPDB,,<$DEFAULT FELOG.DAT>)


; OUTPUT (to file) file-name (from log file) file-name

OUTPDB:	$NOISE	(OUT.1,to file)
OUT.1:	$OFILE	(OUT.2,,<$DEFAULT RDLOG.LOG>)
OUT.2:	$NOISE	(OUT.3,from data file)
OUT.3:	$IFILE	(CFMPDB,,<$DEFAULT FELOG.DAT>)


; ENABLE ENTRY/PORT

DISPDB:
ENAPDB:	$KEYDSP	(ED.1)
ED.1:	$STAB
	 DSPTAB (ED.2,.ENT,ENTRY)
	 DSPTAB (ED.10,.PRT,PORT)
	$ETAB
ED.2:	$KEY	(ED.4,ED.3)
ED.3:	$STAB
	 KEYTAB (FC.WDC,DEVICE-COMMAND)
	 KEYTAB (FC.RDS,DEVICE-STATUS)
	 KEYTAB (FC.WLC,LINE-COMMAND)
	 KEYTAB (FC.RLS,LINE-STATUS)
	 KEYTAB (FC.R6S,PORT-STATUS)
	 KEYTAB (FC.RD,READ-DATA)
	 KEYTAB (FC.WD,WRITE-DATA)
	$ETAB
ED.4:	$SWITCH	(CFMPDB,ED.5,<$ALTERNATE CFMPDB>)
ED.5:	$STAB
	 KEYTAB	(.BDY,BODY)
	 KEYTAB	(.HDR,HEADER)
	$ETAB

ED.10:	$NUMBER	(ED.11,^d8)
ED.11:	$KEY	(ED.13,ED.12,<$ALTERNATE CFMPDB>)
ED.12:	$STAB
	 KEYTAB	(.LINE,LINE)
	$ETAB
ED.13:	$NUMBER	(ED.14,^d8)
ED.14:	$KEY	(ED.16,ED.15,<$ALTERNATE CFMPDB>)
ED.15:	$STAB
	 KEYTAB	(.DEV,DEVICE)
	$ETAB
ED.16:	$NUMBER (CFMPDB,^d8)


; Top level keyword vector table

Define KY (KEYW,KEYM,KEYV,KEYP) <IFNB <KEYV>,<KEYM,,KEYV>>

TOPVEC:	$STAB
	 KYWRDS				; Make entry for all keywords
	$ETAB
	SUBTTL	Local read-only

; Function vector table .. each routine interprets data portion for
;	a particular function.

FNCTBL:	0				; Unknown function
	RDDAT				; Read data
	WDDAT				; Write data
	RDSAFT				; Read device status
	WDCBEF				; Write device command
	RLSAFT				; Read line status
	WLCBEF				; Write line command
	R6SAFT				; Read port status

; Component code name table

CMPTBL:	$STAB
	 SDCOU,,[ASCIZ \Output console\]
	 SDCIN,,[ASCIZ \Input console\]
	 SDCR1,,[ASCIZ \Card reader\]
	 SDLP1,,[ASCIZ \Line printer\]
	 SDCP1,,[ASCIZ \Card punch\]
	 SDSON,,[ASCIZ \Signon device\]
	$ETAB

; Device type table

DEVTYP:	[ASCIZ \(0) Unknown\]
	[ASCIZ \Printer\]
	[ASCIZ \Card-punch\]
	[ASCIZ \Card-reader\]
	[ASCIZ \Input console\]
	[ASCIZ \Output console\]

; Line type table

LINTYP:	[ASCIZ \(0) Unknown\]
	[ASCIZ \3780\]
	[ASCIZ \2780\]
	[ASCIZ \HASP\]

; Line driver type table

DRTBL:	[ASCIZ \(0) Unknown\]
	[ASCIZ \DQ11\]
	[ASCIZ \KMC/DUP11\]
	[ASCIZ \DUP11\]

; Line status table.  -1 in LH implies output even if value
;	is zero.

LSTBL:	0,,[ASCIZ \Error interrupts\]
	0,,[ASCIZ \Status register 1\]
	0,,[ASCIZ \Status register 2\]
	0,,[ASCIZ \Receiver timeouts\]
	0,,[ASCIZ \Transmitter timeouts\]
	0,,[ASCIZ \Clear to send failures\]
	0,,[ASCIZ \Messages sent and ACK'd\]
	0,,[ASCIZ \NAK's received\]
	0,,[ASCIZ \Invalid responses to TTD\]
	0,,[ASCIZ \Invalid responses to messages\]
	0,,[ASCIZ \TTD's sent\]
	0,,[ASCIZ \WACK's received\]
	0,,[ASCIZ \EOT's instead of messages (abort)\]
	0,,[ASCIZ \Invalid responses to bids\]
	0,,[ASCIZ \RVI's while transmitting\]
	0,,[ASCIZ \Messages received ok\]
	0,,[ASCIZ \Bad BCC's\]
	0,,[ASCIZ \NAK's sent in response to data messages\]
	0,,[ASCIZ \WACK's sent\]
	0,,[ASCIZ \TTD's received\]
	0,,[ASCIZ \EOT's sent or received aborting stream\]
	0,,[ASCIZ \Messages ignored\]
	0,,[ASCIZ \Transparent messages with invalid character after DLE\]
	0,,[ASCIZ \Attempts to change between transparent and normal in a blocked message\]
	0,,[ASCIZ \Transmitter timeouts\]
	-1,,[ASCIZ \Clear to send delay\]
	0,,[ASCIZ \Silo overflows\]
	-1,,[ASCIZ \Silo warning area size\]
	0,,[ASCIZ \Max bytes used in silo warning area\]
	-1,,[ASCIZ \Bytes per message\]
	-1,,[ASCIZ \Record per message\]
	0,,[ASCIZ \Line signature\]

; Device command vector table

DCTBL:	0,,[ASCIZ \Unknown command (0)\]
	DCSC,,[ASCIZ \Device type: \]
	COMDEC,,[ASCIZ \Max records/transmission: \]
	0,,[ASCIZ \Dump output buffers\]
	0,,[ASCIZ \Clear input permission "was" requested\]
	0,,[ASCIZ \Reserved (5)\]
	0,,[ASCIZ \Interpret carriage control on input\]
	0,,[ASCIZ \Don't interpret carriage control on input\]
	0,,[ASCIZ \Interpret carriage control on output\]
	0,,[ASCIZ \Don't interpret carriage control on output\]
	0,,[ASCIZ \Reserved (10)\]
	0,,[ASCIZ \Reserved (11)\]
	DCCMP,,[ASCIZ \Component code: \]
	0,,[ASCIZ \No component code selection\]
	COMDEC,,[ASCIZ \Printer line counter overflow value: \]
	0,,[ASCIZ \Disable printer line counter overflow\]
	COMDEC,,[ASCIZ \Maximum transmission block size: \]
	0,,[ASCIZ \Do space compression on output\]
	0,,[ASCIZ \No space compression on output\]
	0,,[ASCIZ \Use old BSC protocol\]
	0,,[ASCIZ \Use new BSC protocol\]
	0,,[ASCIZ \Request output permission\]
	0,,[ASCIZ \Grant input permission\]
	0,,[ASCIZ \Signal output EOF\]
	0,,[ASCIZ \Clear output EOF complete (ACK)\]
	0,,[ASCIZ \Signal output abort\]
	0,,[ASCIZ \Clear output abort complete (ACK)\]
	0,,[ASCIZ \Clear input EOF complete (ACK)\]
	0,,[ASCIZ \Signal input abort\]
	0,,[ASCIZ \Clear input abort complete (ACK)\]
	0,,[ASCIZ \Suspend device\]
	0,,[ASCIZ \Unsuspend device\]
	COMDEC,,[ASCIZ \Bytes/record: \]

LCTBL:	0,,[ASCIZ \Unknown command (0)\]
	LCEL,,[ASCIZ \Enable line, \]
	0,,[ASCIZ \Set Data Terminal Ready (DTR)\]
	0,,[ASCIZ \Abort all transfers and clear DTR\]
	0,,[ASCIZ \Disable line\]
	COMDEC,,[ASCIZ \Clear to send delay: \]
	COMDEC,,[ASCIZ \Bytes in silo warning area: \]
	0,,[ASCIZ \Enable transparency\]
	0,,[ASCIZ \Disable transparency\]
	COMDEC,,[ASCIZ \Maximum bytes/message: \]
	COMDEC,,[ASCIZ \Records/message: \]
	COMDEC,,[ASCIZ \Line signature: \]
	SUBTTL	Local writeables

PDL:	BLOCK	PDLSIZ			; Stack

TAKFLG:	BLOCK	1			; Flag non-zero if processing take file
ERRBUF:	BLOCK	^D17			; Buffer for error messages

TOPS20 <
PUSFRK:	BLOCK	1			; Fork handle of fork for PUSH.
PUSNAM:	BLOCK	^D17			; Buffer for PUSH EXEC file name
    >;End if TOPS20


; Object description used by BEFORE and AFTER routines

TIME:	BLOCK	1
PORT:	BLOCK	1
LINE:	BLOCK	1
DEVICE:	BLOCK	1

; Log output file

LFOB:	BLOCK	1			; Disk file open block
	EXP	^d7			; Output in ASCIZ
LSTIFN:	BLOCK	1			; File handle
LSTBUF:	BLOCK	1			; Buffer for text
LPNT:	BLOCK	1			; Byte pointer to text buffer
LSTCNT:	BLOCK	1			; Count of bytes in buffer

LOGCOL:	BLOCK	1			; Column counter for field checking
TABFLG:	BLOCK	1			; Flag for field checking
ENTCNT:	BLOCK	1			; Entries processed count

; Log data file

DFOB:	BLOCK	1			; Disk file open block
	EXP	^d36			; Full word reads
DIFN:	BLOCK	1			; File handle

; Data log file buffers

BUFAFT:	BLOCK	1			; Data buffer for AFTER, MARK entries
BUFBEF:	BLOCK	1			; Data buffer for BEFORE entries

; AFTER/UNTIL flags

MRKUTL:	BLOCK	1			; MARK until mark number
MRKAFT:	BLOCK	1			; MARK after mark number
TIMUTL:	BLOCK	1			; TIME until
TIMAFT:	BLOCK	1			; TIME after

LSTGO:	BLOCK	1			; If non zero .. output entries

; This vector contains function specific flags.  These control
; output display modes.  0 suppresses function, +n only list header, -n
; list total entry (including body)

FNCFLG:	-1				; Unknown function
	-1				; Read data function
	-1				; Write data
	-1				; Read device status
	-1				; Write device command
	-1				; Read line status
	-1				; Write line command
	-1				; Read port status


	END	<3,,ENTVEC>
; Local Modes:
; Mode:Fundamental
; Comment Column:40
; Comment Start:;
; End: