Trailing-Edge
-
PDP-10 Archives
-
BB-H311B-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: