Google
 

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>