Trailing-Edge
-
PDP-10 Archives
-
tops20_version7_0_tools_tape_clock_tape
-
tools/dobopr/dobopr.mac
There is 1 other file named dobopr.mac in the archive. Click here to see a list.
; UPD ID= 14, RIP:<7.TOOLS-TAPE>DOBOPR.MAC.152, 26-Feb-88 09:49:11 by GSCOTT
;TCO 7.1236 - (12) Update copyright notice.
;GALAXY:<GSCOTT.DOB>DOBOPR.MAC.148 9-Nov-87 15:11:36, Edit by GSCOTT
;(11) Add SET TIMEOUT command
;WORK:<GSCOTT.DOB>DOBOPR.MAC.144 9-Nov-87 14:53:29, Edit by GSCOTT
;(10) Fix SET DUMP ALL BUGCHK command, add SLEEP command
;WORK:<GSCOTT.DOB>DOBOPR.MAC.142 24-Oct-87 17:42:47, Edit by GSCOTT
;(7) Add code to display [OK] message when setting all BUGs.
;WORK:<GSCOTT.DOB>DOBOPR.MAC.136 19-Oct-87 12:33:07, Edit by GSCOTT
;(6) Add TAKE command
;WORK:<GSCOTT.DOB>DOBOPR.MAC.94 15-Oct-87 16:49:22, Edit by GSCOTT
;(5) Say something if no structures dumpable.
;WORK:<GSCOTT.DOB>DOBOPR.MAC.69 8-Oct-87 17:40:03, Edit by GSCOTT
;(4) Boring bugs in STATUS command.
;WORK:<GSCOTT.DOB>DOBOPR.MAC.59 7-Oct-87 10:19:14, Edit by GSCOTT
;(3) Correct argument block counts
;WORK:<GSCOTT.DOB>DOBOPR.MAC.48 7-Oct-87 09:45:23, Edit by GSCOTT
;(2) Fix status command
;WORK:<GSCOTT.DOB>DOBOPR.MAC.13 6-Oct-87 12:37:15, Edit by GSCOTT
;(1) Begin to update to TOPS-20 coding standard.
TITLE DOBOPR - Sample User Interface for DOB% JSYS
SUBTTL Gregory A. Scott
; COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1988.
; ALL RIGHTS RESERVED.
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
; ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
; INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
; COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
; OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
; TRANSFERRED.
;
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
; AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
; CORPORATION.
;
; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
; SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.
SEARCH MONSYM,MACSYM,CMD
.CPYRT <1988>
.REQUIRE SYS:MACREL,SYS:CMD
.DIRECTIVE FLBLST
SALL
STDAC.
Subttl Table of Contents
; Table of Contents for DOBOPR
;
; Section Page
;
;
; 1. Definitions . . . . . . . . . . . . . . . . . . . . . 3
; 2. Storage . . . . . . . . . . . . . . . . . . . . . . . 4
; 3. Command Tables . . . . . . . . . . . . . . . . . . . . 5
; 4. Initialization and Dispatch . . . . . . . . . . . . . 7
; 5. Commands
; 5.1 EXIT and SLEEP . . . . . . . . . . . . . . . . 8
; 5.2 DAYTIME . . . . . . . . . . . . . . . . . . . 9
; 5.3 HELP . . . . . . . . . . . . . . . . . . . . . 10
; 5.4 TAKE . . . . . . . . . . . . . . . . . . . . . 12
; 5.5 ENABLE and DISABLE . . . . . . . . . . . . . . 13
; 5.6 FORCE . . . . . . . . . . . . . . . . . . . . 14
; 5.7 SET . . . . . . . . . . . . . . . . . . . . . 15
; 5.7.1 DUMPS . . . . . . . . . . . . . . . . . 16
; 5.7.2 DUMPS (on) ALL . . . . . . . . . . . . . 18
; 5.7.3 STRUCTURE . . . . . . . . . . . . . . . 19
; 5.7.4 TIMEOUT . . . . . . . . . . . . . . . . 20
; 5.7.5 Set BUGs Dumpable . . . . . . . . . . . 21
; 5.8 STATUS . . . . . . . . . . . . . . . . . . . . 23
; 6. Subroutines
; 6.1 Parsing . . . . . . . . . . . . . . . . . . . 28
; 6.2 Clear a table . . . . . . . . . . . . . . . . 30
; 6.3 SIXBIT to ASCII . . . . . . . . . . . . . . . 31
; 6.4 Print BUG name . . . . . . . . . . . . . . . . 32
; 6.5 Copy Atom Buffer . . . . . . . . . . . . . . . 33
; 6.6 Error Handler . . . . . . . . . . . . . . . . 34
SUBTTL Definitions
; Version number definitions
VMAJOR==1 ;Major version of DOBOPR
VMINOR==0 ;Minor version number
VEDIT==12 ;Edit number
VWHO==0 ;Group who last edited program (0=development)
VDBOPR==<VWHO>B2+<VMAJOR>B11+<VMINOR>B17+VEDIT
;Entry vector
ENTVEC: JRST BEGIN ;Start address
JRST BEGIN ;Reenter address
VDBOPR ;Version number
ENVLEN==.-ENTVEC ;Entry vector length
;Flags in F
GL%IGN==1B0 ;Global 'ignore' switch
GL%NO==1B1 ;Global 'no'
GL%LIM==1B2 ;Too many BUGs enabled to report them all
GL%STR==1B3 ;Structure header printed
;ASCII Character definitions
TAB==11 ;A <TAB>
SPACE==40 ;Ascii SPACE
CR==15 ;A <CR>
SLASH=="/" ;Slash
ESC==33 ;Escape
;Macros
;ERROR$ Macro to report JSYS errors
DEFINE ERROR$ <
ERJMP DOBERP
>
DEFINE CRLF <
TMSG <
>
>
DEFINE EMSG(TEXT) <
HRROI T1,[ASCIZ\TEXT\]
ESOUT%
>
SUBTTL Storage
;This block is to be used to store the BUG names as the command line is
; being parsed
LSTNUM==10 ;Number of BUGs and structures listed per line
NUMBGS==10 ;Number of BUGs that can be specified
; with one command string
ENTSIZ==3 ;Size of each BUG's entry in BUGNAM
;Word 0 - BUG's name in ASCII
;Word 1 - " " " "
;Word 2 - Flags (DB%IGN)
BUGSIZ==<NUMBGS*ENTSIZ> ;Size of the table
BUGNAM: BLOCK BUGSIZ ;Table to hold pointers to BUG names
BUGPTR: BLOCK 1 ;Pointer into current entry in BUGNAM
;Argument block for use with DOB%
MXBUGS==50 ;Max number of BUGs that can be returned
; in DOBARG
DOBLEN==<MXBUGS*2>+.DBBNM+1 ;Max length of the DOB% argument block
; 2 words per BUG - Bugs are returned
; starting in word .DBBNM of the block
DOBARG: BLOCK DOBLEN
;Random storage
DOBPDL: BLOCK <PDLSIZ==100> ;The stack
ASCNAM: BLOCK 2 ;Block to store 7-Bit strings
MSTBLK: BLOCK .MSGLN ;Block for use with MSTR%
BGCNTR: BLOCK 1 ;Count of BUGs set by user
TAKJFN: BLOCK 1 ;JFN of take file
;CMD storage
CMDSTG ;Allocate storage
SUBTTL Command Tables
;Command table for first keyword
CMDTAB: XC,,XC
T DAYTIME
T DISABLE ;DOB
T ENABLE ;DOB
T EXIT
T FORCE ;Immediate dump
T HELP
T SET ;Dumps/Structure
T SLEEP ;Zzz...
T STATUS ;Of DOB
T TAKE ;From 'filename'
XC=.-CMDTAB-1
;Command table for SET command
SETTAB: XS,,XS
T DUMPS
T NO
T STRUCTURE
T TIMEOUT
XS=.-SETTAB-1
;Command table for SET NO command
SETNTB: 1,,1
T DUMPS
;Command table for SET DUMPS (ON) xxx
DMPTAB: 1,,1
T (ALL,0)
;Command table for SET DUMPS (ON) ALL xxx
ALLTAB: 2,,2
T (BUGCHKS,[DB%CHK])
T (BUGINFS,[DB%INF])
;Switch table for SET DUMPS (ON) bugname/IGNORE
IGNTAB: 1,,1
T (IGNORE,0)
;Command table for SET STRUCTURE name
ST%DMP==1B18
ST%NDM==1B19
STRTAB: 2,,2
T (DUMPABLE,[MS%DMP])
T (NONDUMPABLE,[0])
SUBTTL Initialization and Dispatch
;Here to start the program.
BEGIN: RESET% ;The world
MOVE P,[XWD PDLSIZ,DOBPDL] ;To set up stack
CALL CMDINI ;To set us up
;Here on a reparse or to parse a new command.
PARSE: MOVE P,[XWD PDLSIZ,DOBPDL] ;To set up stack
MOVEI T1,DOBARG ;Address of arg block
MOVEI T2,DOBLEN ;Length of arg block
CALL CLEAR ;Go clear the block
SETZM F ;Clear flags word
PROMPT (DOBOPR>) ;Our prompt
MOVEI T1,[FLDDB. .CMKEY,,CMDTAB] ;Get a keyword
CALL RFLDE ;(T1/T1,T2) Read the command
JRST PARERR ;See if end of take file
MOVE T1,(T2) ;Get command routine
CALL (T1) ;Go to it
JRST PARSE ;And get the next keyword
SUBTTL Commands -- EXIT and SLEEP
;Exit command
.EXIT: NOISE (to monitor) ;Quit and exit are the same
CALL CONF ;() Confirm that
HALTF
JRST BEGIN ;In case of continue
;Sleep command, useful for command files
.SLEEP: NOISE (for) ;Output guide
MOVEI T1,[FLDDB. .CMNUX,CM%SDH,^D10,<seconds to sleep>]
CALL RFLDE ;Read the number of seconds
JRST PARERR ;Owie
NOISE (seconds) ;Output guide
CALL CONF ;Confirm that
MOVE T1,T2 ;Copy seconds to T1
IMULI T1,^D1000 ;Make it into milliseconds
DISMS% ;ZZZ...
RET ;Return for next command
SUBTTL Commands -- DAYTIME
;Daytime command
.DAYTI: CALL CONF ;() Confirm that
MOVEI T1,.PRIOU ;Destination
SETO T2, ;Time now
SETZ T3, ;No formatting
ODTIM% ;Output it
RET
SUBTTL Commands -- HELP
;Help command
.HELP: NOISE (with DOBOPR)
CALL CONF ;() Confirm that
HRROI T1,INFO ;Point to help string
PSOUT% ;Output it
RET ;Return
;Help string
INFO: ASCIZ\
DOBOPR is the interface between an enabled user and the Dump-On-Bugchk
(DOB) facility. The user must have WHEEL, OPERATOR or MAINTENANCE
privileges enabled to run this program. The following commands are
available:
DAYTIME - Prints out time of day.
DISABLE (DOB) - Disables the DOB facility.
ENABLE (DOB) - Enables DOB.
EXIT - Leaves DOBOPR.
FORCE (IMMEDIATE DUMP) - Makes TOPS-20 take a continuable dump. An
optional argument of structure name allows the user to specify to which
structure he/she wants the dump written. Otherwise, TOPS-20 chooses the
first available structure that is dumpable.
HELP - Prints out this text.
SET DUMPS - Can specify ALL BUGCHKS/BUGINFS or a list of BUG names. An
optional qualifier (/IGNORE) at the beginning of the list overrides
the default timeout period between continuable dumps. It can also be
given after an individual BUG name to override it just for that BUG.
SET NO - Can be used with above command to reverse the setting of ALL
BUGCHKS/BUGINFS or a list of individual BUG names. The IGNORE
switch is not valid if NO has been specified.
SET STRUCTURE - Specify whether or not a particular structure is
dumpable (i.e. continuable dumps can be written to it).
STATUS - Prints out the current status of the DOB facility. The output
to this command includes:
DOB - whether or not the facility is enabled.
DUMP ON - ALL BUGCHKs or BUGINFs (if set).
DUMPS REQUESTED FOR - lists all BUGs for which dumping has
been requested.
DUMPABLE STRUCTURES - lists which structures are dumpable
TAKE - Directs DOBOPR to take commands from a file.
\
SUBTTL Commands -- TAKE
.TAKE: NOISE (commands from) ;Mumble
MOVEI T1,[FLDDB. .CMIFI,CM%SDH,,<take filename>]
CALL RFLDE ;(T1/T1,T2) Get filename
JRST PARERR ;Owie
CALL CONF ;() Confirm that
MOVEM T2,TAKJFN ;Save JFN
MOVE T1,T2 ;Load JFN
MOVX T2,<FLD(7,OF%BSZ)!OF%RD> ;Read 7-bit bytes
OPENF% ;Pry it open
ERJMP PARERR ;Error, return
HRLM T1,SBK+.CMIOJ ;That is the input JFN now
RET ;Return for all commands
SUBTTL Commands -- ENABLE and DISABLE
;Enable/Disable (DOB)
.ENABL: SKIPA Q1,[.DBENA] ;Setup function for DOB%
.DISAB: MOVEI Q1,.DBDIS ; ...
NOISE (DOB)
CALL CONF ;Finish up, check for echo
MOVEM Q1,DOBARG+.DBFNC ;Store proper function
MOVEI T1,.DBFNC+1 ;Get size of block
MOVEM T1,DOBARG+.DBCNT ;Store that too
MOVEI T1,DOBARG ;Setup T1
DOB% ;Do it
ERROR$ ;Report it
RET ;And done
SUBTTL Commands -- FORCE
;FORCE (IMMEDIATE DUMP) [structure]
.FORCE: NOISE (immediate dump to structure)
MOVEI T1,[FLDDB. .CMDEV,,,,,[ ;Structure name
FLDDB. .CMCFM]] ;Confirm
CALL RFLDE ;(T1/T1,T2) Parse that
JRST PARERR ;Couldn't
LOAD T1,CM%FNC,.CMFNP(T3);Get function parsed
CAIE T1,.CMCFM ;Confirm?
IFSKP. ;If yes
CALL ECHO ;() Echo command
JRST FRCINF ;Now go do it
ENDIF.
CALL CONF ;() Confirm command
HRROI T1,ASCNAM ;Point to where we want the structure name
DEVST% ;T2 already has the device designator
ERROR$ ;UH OH
MOVX T1,<POINT 7,ASCNAM>;Point to the 7-bit string
MOVEM T1,DOBARG+.DBSTR ;Store the pointer
SKIPA T1,[.DBSTR+1] ;Say this many words in the arg block
FRCINF: MOVEI T1,.DBFNC+1 ;Say this many words
MOVEM T1,DOBARG+.DBCNT ;Store the count
MOVEI T1,.DBIMD ;Setup function
MOVEM T1,DOBARG+.DBFNC ;Store it too
MOVEI T1,DOBARG ;Point to the arg block
DOB% ;Do it
ERROR$ ;Uh oh...
RET ;And done
SUBTTL Commands -- SET
;Set Command
.SET: MOVEI T1,[FLDDB. .CMKEY,,SETTAB] ;'SET' table
CALL RFLDE ;(T1/T1,T2) Read the field
JRST PARERR ;Check out error
MOVE T1,(T2) ;Get command routine
CALL (T1) ;Go to it
RET ;Done
SUBTTL Commands -- SET -- DUMPS
;SET [NO] DUMPS (ON) xxx command
.NO: MOVEI T1,[FLDDB. .CMKEY,,SETNTB]
CALL RFLDE ;(T1/T1,T2) Read the field
JRST PARERR ;Check out error
TXO F,GL%NO ;Set global 'no' flag
.DUMPS: NOISE (on)
MOVEI T1,BUGNAM ;Address of table to hold pointers to BUG names
MOVEI T2,BUGSIZ ;Length of the table
CALL CLEAR ;Clear it out
MOVEI T1,BUGNAM ;Address of block of names
MOVEM T1,BUGPTR ;Setup pointer to first entry
SETZM BGCNTR ;And zero the counter
TXZ F,GL%IGN ;Turn off global ignore flag
MOVEI T1,[FLDDB. .CMKEY,,DMPTAB,,,[ ;Could be KEYWORD (ALL)
FLDDB. .CMSWI,,IGNTAB,,,[ ; or SWITCH (/IGNORE)
FLDDB. .CMFLD,,,<Name of BUG, 6 characters or less>]]]
; or a BUG name
TXNE F,GL%NO ;Global 'no' on?
MOVEI T1,[FLDDB. .CMKEY,,DMPTAB,,,[
FLDDB. .CMFLD,,,<Name of BUG, 6 characters or less>]]
;Yes - can't have /IGNORE switch
CALL RFLDE ;(T1/T1,T2) Read the field
JRST PARERR ;Check out error
HRRZS T3 ;Isolate used block in RH
LOAD T1,CM%FNC,.CMFNP(T3);Get function parsed
CAIN T1,.CMKEY ;Was it a keyword?
JRST DUALL ;Yes, go to it
CAIE T1,.CMSWI ;Was it a switch?
JRST STRNAM ;No - arbitrary field - go store it
TXO F,GL%IGN ;Yes, say global ignore was typed
;Here to parse an arbitrary field
GETNAM: MOVEI T1,[FLDDB. .CMSWI,,IGNTAB,,,[ ;IGNORE switch
FLDDB. .CMCFM,,,,,[
FLDDB. .CMFLD,,,<Name of BUG, 6 characters or less>]]] ;BUGname
TXNN F,GL%IGN ;Is global 'ignore' on?
TXNE F,GL%NO ;How about global 'no'?
;Yes to one - can't have a switch then...
MOVEI T1,[FLDDB. .CMCFM,,,,,[ ;Confirm
FLDDB. .CMFLD,,,<Name of BUG, 6 characters or less>]]
CALL RFLDE ;(T1/T1,T2)
JRST PARERR ;Some kind of error
LOAD T1,CM%FNC,.CMFNP(T3);Get function parsed
CAIN T1,.CMCFM ;Done yet?
JRST SETBGS ;Go do them
CAIE T1,.CMSWI ;A switch?
JRST STRNAM ;No, must be a BUG name - go store it
MOVE T1,BUGPTR ;Get address of current entry
MOVX T2,DB%IGN ;Get the ignore bit
IORM T2,-1(T1) ;Set it in previous entry
JRST GETNAM ;And go get next field
STRNAM: MOVE T1,BGCNTR ;Get count of BUGs
CAIGE T1,NUMBGS ;Room for more?
IFSKP. ;No
TXO F,GL%LIM ;No - note that
JRST GETNAM ;And ignore this name
ENDIF.
MOVE T1,BUGPTR ;Get address to store this BUG
CALL CPYATM ;Copy Atom buffer there
MOVEI T1,2 ;Increment pointer to point
ADDM T1,BUGPTR ; to flags word of this entry
MOVX T1,DB%IGN ;'Ignore' bit
TXNE F,GL%IGN ;Should we set it?
MOVEM T1,@BUGPTR ;Yes
MOVX T1,DB%ENA+DB%REQ ;Set up bits to turn on
TXNN F,GL%NO ;Did user type 'NO' in this command line?
IORM T1,@BUGPTR ;No - then turn these bits on
AOS BUGPTR ;Point to first word of next entry
AOS BGCNTR ;Increment BUG counter
JRST GETNAM ;And go get next field
SUBTTL Commands -- SET -- DUMPS (on) ALL
;SET [NO] DUMPS (ON) ALL xxx
DUALL: MOVEI T1,[FLDDB. .CMKEY,,ALLTAB]
CALL RFLDE ;(T1/T1,T2) Read the field
JRST PARERR ;Check out error
CALL CONF ;() Confirm that command
MOVE T2,(T2) ;Get address of bits
MOVE T3,(T2) ;Get bits
TXNN F,GL%NO ;Global 'no' on?
TXOA T3,DB%ENA ;No, set ENABLE bit
TXZ T2,DB%ENA ;Yes, turn these bits off
MOVEM T3,DOBARG+.DBFLG ;Store bits
HRROI T1,[ASCIZ/ ALL BUGCHKs /] ;Assume CHKs
TXNE T3,DB%INF ;INFs?
HRROI T1,[ASCIZ/ ALL BUGINFs /] ;Yes
PSOUT% ;Output that
MOVEI T1,.DBPAR ;Say do this function
MOVEM T1,DOBARG+.DBFNC ;Store it
MOVEI T1,.DBFLG+1 ;Size of arg block
MOVEM T1,DOBARG+.DBCNT ;Store it
MOVEI T1,DOBARG ;Setup the Jsys
DOB% ;Do it
ERROR$ ;Maybe DOB is disabled
TMSG <[OK]
> ;Output Okay message
RET ;Done
SUBTTL Commands -- SET -- STRUCTURE
;SET STRUCTURE (name) name DUMPABLE/NONDUMPABLE
.STRUC: MOVEI T1,MSTBLK ;Address of the MSTR% block
MOVX T2,.MSGLN ;Size of the block
CALL CLEAR ;Go clear it
NOISE (named) ;Do the noise words
MOVEI T1,[FLDDB. .CMDEV];Parse a Device name
CALL RFLDE ;(T1/T1,T2) Read the field
JRST PARERR ;Check out error
MOVEM T2,MSTBLK+.MSGSN ;Store device designator in MSTR block
MOVEI T1,[FLDDB. .CMKEY,,STRTAB]
CALL RFLDE ;(T1/T1,T2) Read the field
JRST PARERR ;Check out error
MOVE T1,(T2) ;Get address of proper bits
MOVE T1,(T1) ;Get the bits
PUSH P,T1 ;Save it over the call
CALL CONF ;() Can I confirm that for your today sir?
POP P,T1 ;Get back the bit to set
MOVX T2,MS%DMP ;Get the mask of the bit to set
DMOVEM T1,MSTBLK+.MSSST ;Specify new value to be set and mask of bit
; to change
MOVX T1,<3,,.MSSSS> ;Size of block,,function
MOVEI T2,MSTBLK ;Address of block
MSTR% ;Do it
ERROR$ ;Error
RET
SUBTTL Commands -- SET -- TIMEOUT
;SET TIMEOUT (to) n (seconds)
.TIMEO: NOISE (to) ;Do the noise words
MOVEI T1,[FLDDB. .CMNUX,CM%SDH,^D10,<seconds to sleep>]
CALL RFLDE ;Read the number of seconds
JRST PARERR ;Owie
NOISE (seconds) ;Mumble
CALL CONF ;Confirm that
MOVEM T2,DOBARG+.DBTVS ;Copy seconds to block
MOVEI T1,.DBTIM ;Say do this function
MOVEM T1,DOBARG+.DBFNC ;Store it
MOVEI T1,.DBTVS+1 ;Size of arg block
MOVEM T1,DOBARG+.DBCNT ;Store it
MOVEI T1,DOBARG ;Setup the Jsys
DOB% ;Do it
ERROR$ ;Maybe DOB is disabled
RET ;Return OK
SUBTTL Commands -- Set -- Set BUGs Dumpable
;The BUGNAM table contains a 2-word entry for each bug that should be set
;this routine loops thru the table and executes DOB% once per bug and
;prints out the success or failure of each attempt.
SETBGS: CALL ECHO ;() Echo this command
SKIPE P1,BGCNTR ;Did user specify any BUG names?
IFSKP. ;If no BUGs
EMSG <DOBOPR: No BUGs specified>
RET ;Give him/her the bad news
ENDIF.
MOVEI T1,.DBCFG+1 ;Get size of block
MOVEM T1,DOBARG+.DBCNT ;And store it in the argument block
MOVEI T1,.DBSBG ;Function = Set a BUG
MOVEM T1,DOBARG+.DBFNC ;Store it in the block
MOVEI T1,BUGNAM ;Get address of block containing ASCII names
MOVEM T1,BUGPTR ;Store it in the pointer word
SETLUP: MOVEI T1,@BUGPTR ;Get the pointer to the string again
CALL ASCSIX ;Convert it to SIXBIT
MOVEM T2,DOBARG+.DBNAM ;And store it in the argument block
MOVE T1,BUGPTR ;Get address of current entry
MOVE T1,2(T1) ;Get config word for the entry
MOVEM T1,DOBARG+.DBCFG ;And set it in the DOB block
MOVEI T1,DOBARG ;Point to the arg block
DOB% ;Do it
ERJMP SETERR ;Handle error
MOVEI T1,TAB ;Output a TAB
PBOUT% ; to the terminal
MOVEI T2,@BUGPTR ;Get pointer to string
CALL NAMOUT ;Output BUG name to TTY:
TMSG < [OK]
> ;Tell him/her it's okey dokey
SETLUX: MOVEI T1,ENTSIZ ;Size of an entry in BUGNAM
ADDM T1,BUGPTR ;Increment pointer to point to next entry
SOJG P1,SETLUP ;More to do?
TXNN F,GL%LIM ;Did we run out of room along the way?
RET ;Nope, just returm
EMSG <DOBOPR: Not all requested bugs were set - Insufficient table space
> ;Bad news
RET ;Return now
SETERR: EMSG <DOBOPR: Error setting > ;Start the error string
MOVEI T2,@BUGPTR ;Get pointer to string
CALL NAMOUT ;Output BUG name to TTY:
TMSG < - > ;Output seperator
CALL LSTERR ;Output last error string
JRST SETLUX ; and then continue to do the rest
SUBTTL Commands -- STATUS
;Status command
.STATU: NOISE (of dumpable BUGs) ;Print out the noise words
CALL CONF ;() Confirm the command
MOVEI T1,.DBTOV+1 ;Size of arg block including timeout value
MOVEM T1,DOBARG+.DBCNT ;Store size of block
MOVEI T1,.DBSTA ;Say function is return status
MOVEM T1,DOBARG+.DBFNC ;Store function
MOVEI T1,DOBARG ;Point to the argument block
DOB% ;And do the JSYS
ERROR$ ;DOB not in this monitor
HLRZ T2,DOBARG+.DBNUM ;Get number of BUGs enabled
JUMPE T2,STATU1 ;None - just list other info
CAIG T2,MXBUGS ;Do we have enough room for all of them?
IFSKP. ;If not
TXO F,GL%LIM ;Note that we cannot get them all
MOVEI T2,MXBUGS ;This is as many as we can handle
ENDIF.
IMULI T2,2 ;Allocate 2 words per BUG
ADDI T2,.DBTOV+1 ;And leave room for first several words
MOVEM T2,DOBARG+.DBCNT ;Setup the arg block count
DOB% ;And do it again to get the list of BUGs
ERROR$ ;Uh oh
STATU1: CALL STSDOB ;Output status of DOB
CALL STSBUG ;Ouput list of any BUGs that are enabled
CALL STSSTR ;Ouput list of any dumpable structures
RET
;STSDOB - Routine to output the status of DOB
STSDOB: TMSG <
DOB is > ;What is DOB?
MOVE T2,DOBARG+.DBSTS ;Get status bits
HRROI T1,[ASCIZ/disabled/];Assume disabled
TXNE T2,DB%DOB ;Is DOB Enabled?
HRROI T1,[ASCIZ/enabled/];Yes
PSOUT% ;Say which
TMSG <, timeout is set to > ;Label the next bit
MOVEI T1,.PRIOU ;Point output to primary
MOVE T2,DOBARG+.DBTOV ;Load timeout value
MOVEI T3,^D10 ;Radix decimal
NOUT% ;Output that
ERROR$ ;Is hell freezing over?
TMSG < seconds
> ;Finish that up
MOVE T2,DOBARG+.DBSTS ;Get status bits
TXCN T2,DB%INF+DB%CHK ;Either of these Enabled?
RET ;No - skip the rest
TMSG <Dumping on > ;One or both are - output it
TXCE T2,DB%INF!DB%CHK ;Both enabled?
IFSKP. ;Yes
HRROI T1,[ASCIZ\all BUGCHKs and BUGINFs
\] ;Load string for both
PSOUT% ;Output that string
RET ;And continue
ENDIF.
TXNE T2,DB%CHK ;Just CHKs enabled?
SKIPA T1,[XWD -1,[ASCIZ\all BUGCHKs
\]] ;Yes, just all CHKs
HRROI T1,[ASCIZ\all BUGINFs
\] ;No, just all INFs
PSOUT% ;Output appropriate string
RET
;STSBUG - Routine to list any BUGs for which a dump is currently requested
STSBUG: HRRZ Q3,DOBARG+.DBNUM ;Get number of BUGs returned
JUMPE Q3,R ;If no BUGs return
TMSG <
Dumps have been requested for the following BUGs:
>
MOVEI Q1,DOBARG+.DBBNM ;Point to first BUG in list
MOVEI Q2,LSTNUM ;Setup a counter
LSTBUG: MOVEI T1,TAB ;Put a <TAB> in T1
PBOUT%
MOVEI T2,(Q1) ;Point to bug name
CALL SIXASC ;Convert Bugname to ASCII
HRROI T1,ASCNAM ;Point to converted string
PSOUT% ;Output it
MOVEI T1,"*" ;Put a '*' in T1
MOVX T4,DB%IGN ;Setup the 'ignore' bit
TDNN T4,1(Q1) ;Is it set for this Bug?
IFSKP. ;Yes
PBOUT ;Output asterisk
TXO F,GL%IGN ;And note that we did so
ENDIF.
ADDI Q1,2 ;Point to next BUG in list
SOJLE Q3,LSTBUX ;Any more Bugs to dump?
SOJG Q2,LSTBUG ;Have we output 3?
MOVEI Q2,LSTNUM ;Yes, reset the counter
CRLF ;And output a CRLF
JRST LSTBUG
LSTBUX: CRLF ;Output crlf
HRROI T1,[ASCIZ/ not all BUGs have been reported
/]
TXNE F,GL%LIM ;Were we able to report all the BUGs?
PSOUT% ;Nope
HRROI T1,[ASCIZ/ * means ignore timeout
/]
TXNE F,GL%IGN ;Any Bugs with 'ignore' set?
PSOUT% ;Yes
RET ;Return
;STSSTR - Routine to list all structures that are currently dumpable
STSSTR: MOVX T1,<-1,,.DEVNA> ;Get size of the DEVNAM table
GETAB% ;From the monitor
ERROR$ ;Hell is freezing over or something
HRLZ P1,T1 ;Xwd aobjn count, table index
MOVEI P3,LSTNUM ;Number of names to output between CRLFs
;Loop through each device in the device table until we get one that is not
;a disk device. We also ignore DSK: for obvious reasons.
STRLUP: HRL T1,P1 ;Get current index
HRRI T1,.DEVNA ;And table name
GETAB% ;Get next device name
ERJMP STRLUX ;Skip it
CAMN T1,[SIXBIT/DSK/] ;Is it DSK:???
JRST STRLUX ;Yes - skip it
MOVEM T1,P2 ;Store SIXBIT name
MOVEI T2,P2 ;And point to it with T2
CALL SIXASC ;Convert SIXBIT to ASCII
HRROI T1,ASCNAM ;Point to the ASCII name of the device
STDEV% ;Get a device designator for this device
ERJMP STRLUX ;Skip this one
MOVE T1,T2 ;Put designator In T1
DVCHR% ;Get Characteristics
ERJMP STRLUX ;Just skip it
LOAD T1,DV%TYP,T2 ;Get type of device
CAIE T1,.DVDSK ;Is it a disk?
JRST STRLUZ ;No - then we've checked them all
HRROI T1,ASCNAM ;Point to device name
MOVEM T1,MSTBLK+.MSGSN ;Store it in MSTR% block
MOVX T1,<2,,.MSGSS> ;Size of arg block,,function
MOVX T2,MSTBLK ;Address of block
MSTR% ;Get the structure status
ERJMP [ CALL DOBERR ;Print out error
JRST STRLUX ] ;And continue
MOVE T1,MSTBLK+.MSGST ;Get status
TXNN T1,MS%DMP ;Is is DUMPABLE
JRST STRLUX ;No
;Here when we have a dumpable structure to print out.
TXOE F,GL%STR ;Output the header yet?
IFSKP. ;If not
TMSG <
Dumpable structures:
> ;Output the header
ENDIF.
MOVX T1,TAB ;Output
PBOUT% ; a tab
HRROI T1,ASCNAM ;Point to structure name
PSOUT% ;Output it
SOJG P3,STRLUX ;Have we printed LSTNUM structures?
CRLF ;Time for a CRLF
MOVEI P3,LSTNUM ;Setup the counter again
;Here to loop to the next structure.
STRLUX: AOBJN P1,STRLUP ;More to do?
;If we didn't print any structures out say that. Give a extra CRLF and return.
STRLUZ: TXNE F,GL%STR ;Output a structure name?
SKIPA T1,[Point 7,[ASCIZ/
/]] ;Yes, finish up output
HRROI T1,[ASCIZ/No structures are set dumpable
/]
PSOUT% ;End the display
RET ; and return
SUBTTL Subroutines -- Parsing
;Here to confirm command and echo take file if needed
;Call when ready to parse confirm.
CONF: SAVEAC (<T1,T2>) ;Save ACs
MOVEI T1,[FLDDB. .CMCFM] ;Make sure users types <CRLF>
CALL RFLDE ;(T1/T1,T2) Read the field
JRST PARERR ;Check out error
;Here to perhap output whatever was in the take file command.
;Call after confirming command, returns +1 always.
ECHO: HRROI T1,CMDBUF ;Point to ASCIZ characters
SKIPE TAKJFN ;Coming from a file?
PSOUT% ;Yes, output what we had
RET ;Return
;Come here when error parsing, see if it is end-of-file and if so it
;must be the end of the take file. Otherwise output error message
;and get another command.
PARERR: HRROI T1,CMDBUF ;Point to ASCIZ characters
SKIPE TAKJFN ;Coming from a file?
PSOUT% ;Yes, output what we have
CALL GETERR ;(/T2) Get last error code
CAIE T2,IOX4 ;End of file reached?
CALL DOBERR ;() No, output an error message
SKIPN TAKJFN ;Any take file JFN?
JRST PARSE ;Try again
TMSG <
End of > ;Output end of file message
MOVEI T1,.PRIOU ;Load output to primary
MOVE T2,TAKJFN ;Reload the JFN
SETZ T3, ;Default the format
JFNS% ;Output filename
ERJMP .+1 ;Ignore error
TMSG <
> ;Pretty listing
MOVEI T1,.PRIIN ;Load the primary input JFN
HRLM T1,SBK+.CMIOJ ;That is the input JFN now
MOVE T1,TAKJFN ;Reload the file's JFN
CLOSF% ;Close it
ERCAL TAKER3 ;() Maybe it wasn't open
SETZM TAKJFN ;No more JFN
JRST PARSE ;Restart command
TAKER3: MOVE T1,TAKJFN ;Reload the JFN
RLJFN% ;Release it
ERJMP .+1 ;HFO?
RET ;Return to above
SUBTTL Subroutines -- Clear a table
;CLEAR - Routine to clear a table
;Called with T1/ Address of table to clear
; T2/ Size of table
;Returns +1 always
CLEAR: SETZM (T1) ;Zero out the first word
ADDI T2,-1(T1) ;Setup address of the last word in the block
HRLS T1 ;Put starting address in both halfs
AOS T1 ;Address of second word in RH
BLT T1,(T2) ;Clear it
RET
SUBTTL Subroutines -- SIXBIT to ASCII
;ASCSIX - Routine to convert from ASCII to SIXBIT
;CALL with T1/ Address of ASCII string
;Returns T2/ SIXBIT string
ASCSIX: HRLI T1,440700 ;Make it a B.P.
MOVE T3,[POINT 6,T2] ;Destination byte pointer
SETZM T2 ;Zero out destination
MOVX T4,6 ;Max of 6 bytes in string
ASCLUP: ILDB Q1,T1 ;Get the next byte
JUMPE Q1,R ;Done if zero
CAIE Q1,SPACE ;A space?
CAIN Q1,TAB ;Or a TAB
RET ;Yes
CAIE Q1,CR ;A CRLF?
CAIN Q1,SLASH ;A Slash?
RET ;Yes to one of the above
SUBI Q1,"A"-'A' ;Subtract the difference
IDPB Q1,T3 ;Deposit the 6-bit byte
SOJG T4,ASCLUP ;Get the next one
RET
;SIXASC - Routine to convert from SIXBIT to ASCII
;Call with T2/ Address of SIXBIT string
;Returns ASCNAM/ 7-Bit string
SIXASC: HRLI T2,(POINT 6) ;Make address a byte pointer
MOVE T1,[POINT 7,ASCNAM];Point to destination
SETZM ASCNAM ;Zero out name buffer
SETZM ASCNAM+1 ; ....
MOVEI T4,6 ;Max of 6 bytes
SIXLUP: ILDB T3,T2 ;Get a byte
JUMPE T3,SIXDON ;Done if we get a 0 byte
ADDI T3,"A"-'A' ;Convert the byte
IDPB T3,T1 ;Deposit byte into string
SOSLE T4 ;More to do?
JRST SIXLUP ;Yes - go do next one
SIXDON: RET
SUBTTL Subroutines -- Print BUG name
;NAMOUT - Routine to output a BUG name to the terminal
;This routine will output characters until one of the following
;characters is seen:
; SPACE SLASH ESCAPE CRLF TAB
;Called with T2/ Address of beginning of string
;Returns +1 Always
NAMOUT: HRLI T2,440700 ;Make it a B.P.
NAMLUP: ILDB T1,T2 ;Get a byte
JUMPE T1,R ;Done if zero byte
CAIE T1,SPACE ;A space?
CAIN T1,SLASH ;A slash?
RET ;Yes - done
CAIE T1,ESC ;Escape?
CAIN T1,CR ;CR?
RET ;Yes
CAIN T1,TAB ;A tab?
RET ;Yes
CAIL T1,"a" ;Is it lower case?
CAILE T1,"z" ;...
SKIPA ;No
ADDI T1,"A"-"a" ;Yes - upper it
PBOUT ;And print it on the TTY
JRST NAMLUP ;Go do next
SUBTTL Subroutines -- Copy Atom Buffer
;CPYATM - Routine to copy the contents of the Atom buffer
;Called with T1/ Destination address
;Returns +1 Always
CPYATM: HRLI T1,440700 ;Make it a B.P.
MOVX T2,<POINT 7,ATMBUF>;Make B.P. to Atom buffer
MOVEI T3,6 ;We only want 6 characters
CPYLUP: ILDB T4,T2 ;Get a byte from the Atom
JUMPE T4,R ;Atom buffer is guaranteed to end with null
CAIL T4,"a" ;Is it lower case??
CAILE T4,"z" ;...
SKIPA ;No
ADDI T4,"A"-"a" ;Upper it
IDPB T4,T1 ;Put it into BUGNAM
SOJG T3,CPYLUP ;More to do?
RET ;No
SUBTTL Subroutines -- Error Handler
;DOBERP - ERJMPed to from ERROR$ macro
;Prints error then goes to get new command
DOBERP: CALL DOBERR ;Output the error
JRST PARSE ;Parse a new command please
;This routine is called on any JSYS error to print it.
DOBERR: EMSG <DOBOPR: > ;Start with a ?
CALL LSTERR ;Print the error
CRLF ;Output crlf
RET ; and return
;Small routine to print last errpr
LSTERR: MOVEI T1,.PRIOU ;Output to primary
HRLOI T2,.FHSLF ;This fork's last error
SETZ T3, ;No limit
ERSTR% ;Error to string
JRST LSTER1 ;Undefined error number
JFCL ; errors
RET ; and return
LSTER1: TMSG <Undefined error number > ;Output a starting string
CALL GETERR ;(/T2) Get last error
MOVEI T1,.PRIOU ;Point output to primary
MOVEI T3,10 ;Octal
NOUT% ;Output undefined number
ERJMP .+1 ;Disaster
RET ;Return to caller
;Small routine to return last error
;Returns +1 always, T1/ .FHSLF
; T2/ last error code
GETERR: MOVEI T1,.FHSLF ;Load this fork
GETER% ;Get the last error
TLZ T2,-1 ;Zap the fork handle
RET ;Return T2
END <ENVLEN,,ENTVEC>