Google
 

Trailing-Edge - PDP-10 Archives - BB-M080S-SM - monitor-sources/dob.mac
There are 13 other files named dob.mac in the archive. Click here to see a list.
; UPD ID= 8683, RIP:<7.MONITOR>DOB.MAC.431,   8-Mar-88 13:55:24 by GSCOTT
;TCO 7.1254 - Don't try to print out IORB errors when called back by PHYSIO,
; let SAVMEM check for error and call IORBER to print the error messge and
; abort.  So that space isn't wasted, use RS macro for CCW space rather than
; getting a page from the general resident pool and dividing it by the number
; of IORBs.  Cut down number of IORBs to 1 and up transfer size to save space
; and prevent DOI with little performance penalty, let PHYSIO handle overruns.
; UPD ID= 8671, RIP:<7.MONITOR>DOB.MAC.430,   1-Mar-88 14:43:34 by GSCOTT
;TCO 7.1244 - I hate to say it but TCO 7.1215 seriously broke GETPGS.  Prevent
; page faults and other problems in IORBER.  Check error bit in SAVMEM to abort
; dump in progress.  Avoid possible overruns by cutting down long transfers.
; UPD ID= 8658, RIP:<7.MONITOR>DOB.MAC.429,  22-Feb-88 11:41:32 by GSCOTT
;TCO 7.1237 - Check DB%NND properly, save 3 instructions in DODOB, make
; sure that STKVAR scopes are ended by ENDSV.
; UPD ID= 8506, RIP:<7.MONITOR>DOB.MAC.428,   9-Feb-88 14:57:58 by GSCOTT
;TCO 7.1218 - Update copyright notice.
; UPD ID= 8450, RIP:<7.MONITOR>DOB.MAC.427,   4-Feb-88 16:58:51 by GSCOTT
;TCO 7.1215 - Give up on any errors so that disks aren't trashed by DOB.
; Comment out generation checking code to save space and time, as we always
; want the highest generation of <SYSTEM>DUMP.EXE.  Fix bug where the wrong
; disk address and UDB was used for multi-pack structures.  Use STGADR from
; PROLOG rather than IDXADR for getting disk addresses from index blocks.
; UPD ID= 307, RIP:<7.MONITOR>DOB.MAC.426,  19-Nov-87 15:58:45 by GSCOTT
;TCO 7.1144 - Checked MS%OFL instead of MS%OFS in CKSTR.
; UPD ID= 295, RIP:<7.MONITOR>DOB.MAC.425,  12-Nov-87 16:56:38 by GSCOTT
;TCO 7.1133 - Use LOCK and UNLOCK (in XCDSEC) rather than LOKK and UNLOKK
;	      (in MSEC1), make some resident storage swappable.
; UPD ID= 282, RIP:<7.MONITOR>DOB.MAC.424,  10-Nov-87 17:12:41 by GSCOTT
;TCO 7.1125 - Wrong ACs and symbols at DBTIM always caused a DOBX08.
; UPD ID= 240, RIP:<7.MONITOR>DOB.MAC.423,   3-Nov-87 18:17:55 by GSCOTT
;TCO 7.1108 - Don't get page faults while CSKED in DOB% JSYS, go ECSKED in
;             DBLOCK after locking, and CSKED just before unlocking.
; UPD ID= 236, RIP:<7.MONITOR>DOB.MAC.422,  29-Oct-87 17:26:38 by GSCOTT
;More of TCO 7.1081 - DOB is too big by one word, use a TDZA
;WORK:<GSCOTT.DOB>DOB.MAC.421 23-Oct-87 15:09:53, Edit by GSCOTT
;TCO 7.1081 - Additional minor changes, install into 7.0 library.
;WORK:<GSCOTT.DOB>DOB.MAC.419 22-Oct-87 16:57:52, Edit by GSCOTT
;Minor changes from inspection.
;WORK:<GSCOTT.DOB>DOB.MAC.411 19-Oct-87 12:36:47, Edit by GSCOTT
;Update copyright
;WORK:<GSCOTT.DOB>DOB.MAC.404 19-Oct-87 01:58:07, Edit by GSCOTT
;Minor revisions based on design spec.
;WORK:<GSCOTT.DOB>DOB.MAC.358 15-Oct-87 22:15:16, Edit by GSCOTT
;Need to call DOBSEC before the checksum error message.
;WORK:<GSCOTT.DOB>DOB.MAC.348 15-Oct-87 21:24:08, Edit by GSCOTT
;Implement use of EVDOB in .ENFLG, make .DBENA work
;WORK:<GSCOTT.DOB>DOB.MAC.338 15-Oct-87 19:22:56, Edit by GSCOTT
;Use new bits DB%ERR and DB%SML
;WORK:<GSCOTT.DOB>DOB.MAC.325 14-Oct-87 11:46:59, Edit by GSCOTT
;Announce BUG name when dumping.
;WORK:<GSCOTT.DOB>DOB.MAC.318 13-Oct-87 19:43:26, Edit by GSCOTT
;More work to MAKDIR routine.
;WORK:<GSCOTT.DOB>DOB.MAC.295 13-Oct-87 10:03:03, Edit by GSCOTT
;DOB% JSYS should be entirely in section 6.
;WORK:<GSCOTT.DOB>DOB.MAC.293 13-Oct-87 09:56:33, Edit by GSCOTT
;Allow DOB to write to DUMP.EXEs created by cretinous MAKDMP program.
;WORK:<GSCOTT.DOB>DOB.MAC.240  9-Oct-87 11:12:08, Edit by GSCOTT
;Rename module to be DOB.
;WORK:<GSCOTT.DOB>DOBDRV.MAC.231  8-Oct-87 18:11:01, Edit by GSCOTT
;Remove TORESCD and TOXRESCD macros.
;WORK:<GSCOTT.DOB>DOBDRV.MAC.227  8-Oct-87 18:05:09, Edit by GSCOTT
;Don't use TTEMES.
;WORK:<GSCOTT.DOB>DOBDRV.MAC.213  7-Oct-87 15:20:26, Edit by GSCOTT
;Carefully check argument block sizes
;WORK:<GSCOTT.DOB>DOBDRV.MAC.196  6-Oct-87 17:57:39, Edit by GSCOTT
;Minimize section 0/1 space used.
;WORK:<GSCOTT.DOB>DOBDRV.MAC.150  6-Oct-87 03:10:08, Edit by GSCOTT
;WORK:<GSCOTT.DOB>DOBDRV.MAC.118  5-Oct-87 18:03:13, Edit by GSCOTT
;Update to TOPS-20 coding standard, add subtitles and TOC
;<DONAHUE.BOOT>DOBDRV.MAC.6, 25-Apr-85 15:45:14, Edit by DONAHUE
;Move DOB% to XCDSEC
;<DONAHUE.BOOT>DOBDRV.MAC.3, 24-Apr-85 16:27:57, Edit by DONAHUE
;Write DOBDRV to take continuable dumps

;	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 PROLOG,PHYPAR,SERCOD
	TTITLE (DOB,,< - Dump On Bug JSYS and Code >)
	SUBTTL Peter Donahue/Gregory A. Scott
	Subttl	Table of Contents

;		     Table of Contents for DOB
;
;				  Section		      Page
;
;
;    1. Definitions
;        1.1    Macros . . . . . . . . . . . . . . . . . . . .   4
;        1.2    DOB Storage  . . . . . . . . . . . . . . . . .   5
;        1.3    Symbols
;            1.3.1    General  . . . . . . . . . . . . . . . .   7
;            1.3.2    EXE file . . . . . . . . . . . . . . . .   8
;            1.3.3    DOB% Symbols in MONSYM . . . . . . . . .   9
;    2. DOB% JSYS  . . . . . . . . . . . . . . . . . . . . . .  10
;        2.1    Function .DBENA  . . . . . . . . . . . . . . .  11
;        2.2    Function .DBDIS  . . . . . . . . . . . . . . .  12
;        2.3    Function .DBSBG  . . . . . . . . . . . . . . .  13
;            2.3.1    Convert SIXBIT to RADIX50  . . . . . . .  15
;            2.3.2    Find Virtual Address of a BUG  . . . . .  16
;            2.3.3    Manipulate DOBLST  . . . . . . . . . . .  17
;                2.3.3.1    Setup the list . . . . . . . . . .  18
;                2.3.3.2    Increase size of list  . . . . . .  19
;                2.3.3.3    Store BUG address  . . . . . . . .  20
;                2.3.3.4    Delete BUG entry . . . . . . . . .  21
;                2.3.3.5    Lock/Unlock  . . . . . . . . . . .  22
;        2.4    Function .DBPAR  . . . . . . . . . . . . . . .  23
;        2.5    Function .DBIMD  . . . . . . . . . . . . . . .  24
;        2.6    Function .DBSTA  . . . . . . . . . . . . . . .  26
;        2.7    Function .DBTIM  . . . . . . . . . . . . . . .  28
;    3. Start of checksummed code  . . . . . . . . . . . . . .  29
;    4. DOB Initialization . . . . . . . . . . . . . . . . . .  30
;    5. DOB Un-initialization  . . . . . . . . . . . . . . . .  32
;    6. Dump Memory  . . . . . . . . . . . . . . . . . . . . .  33
;        6.1    Manipulate PI System . . . . . . . . . . . . .  37
;        6.2    Find Usable DUMP.EXE . . . . . . . . . . . . .  38
;            6.2.1    Check A Structure  . . . . . . . . . . .  39
;            6.2.2    Check EXE Directory  . . . . . . . . . .  41
;        6.3    Write DUMP.EXE . . . . . . . . . . . . . . . .  42
;            6.3.1    Find pages to write out  . . . . . . . .  43
;            6.3.2    Check if page should be written  . . . .  46
;            6.3.3    Map index blocks . . . . . . . . . . . .  47
;            6.3.4    Add Entry To EXE Directory . . . . . . .  48
;            6.3.5    Write EXE Directory  . . . . . . . . . .  49
;        6.4    Find Files
;            6.4.1    Find <SYSTEM>DUMP.EXE  . . . . . . . . .  50
;            6.4.2    Map Disk Address . . . . . . . . . . . .  53
;            6.4.3    Find FDB . . . . . . . . . . . . . . . .  54
;            6.4.4    String Comparison  . . . . . . . . . . .  55
	Subttl	Table of Contents (page 2)

;		     Table of Contents for DOB
;
;				  Section		      Page
;
;
;    7. Subroutines
;        7.1    Page Fault Handler . . . . . . . . . . . . . .  56
;        7.2    Checksumming . . . . . . . . . . . . . . . . .  57
;        7.3    Virtual to Physical Address  . . . . . . . . .  58
;        7.4    Read and Write Pages . . . . . . . . . . . . .  59
;            7.4.1    Setup CCW List . . . . . . . . . . . . .  61
;            7.4.2    Get UDB Address  . . . . . . . . . . . .  62
;            7.4.3    Get Free IORB  . . . . . . . . . . . . .  63
;            7.4.4    Wait for IORB Completion . . . . . . . .  64
;            7.4.5    IORB Done  . . . . . . . . . . . . . . .  65
;            7.4.6    IORB Error . . . . . . . . . . . . . . .  66
;    8. DOB Message Printing Routines
;        8.1    Error Messages . . . . . . . . . . . . . . . .  67
;        8.2    XRESCD Routines  . . . . . . . . . . . . . . .  68
;        8.3    RESCD Routines . . . . . . . . . . . . . . . .  69
;    9. End of checksummed code  . . . . . . . . . . . . . . .  70
	SUBTTL Definitions -- Macros

;This DOBER macro should only be used in XRESCD.

DEFINE DOBER(TEXT),<
	CALL [	JSP CX,DOBERR
		ASCIZ\TEXT\]
>				;End DOBER MACRO

DEFINE DOBMS(TEXT),<
	CALL [	JSP CX,DOBMCX
		ASCIZ\TEXT\]
>				;End DOBMS MACRO
	SUBTTL Definitions -- DOB Storage

;Swappable storage (used in DOB% JSYS) goes here

NR(DOBLOK)			;[7.1133] Lock for DOB database
NR(DOBLST)			;[7.1133] Pointer to list of dumpable BUGs

;Here is the resident storage used to dump and in DOB% JSYS

RS(DOBSTS)			;Status flags (DB%xxx)
RS(DOBSTR)			;Number of requested structure (-1 free choice)
RS(DOBTOV)			;Timeout for last DOB

;Resident storage (used in dumping monitors) goes here

RS(DOBJB0)			;Flag to say we should run job 0
RS(DOBTMR)			;Time of last dump + contents of DOBTOV
RS(DOBSTK,<<STKSIZ==^D35>>)	;Allocate a private stack
RS(DEXEPC)			;Size of DUMP.EXE file
RS(XBNUM)			;Number of index block currently mapped
RS(CURPAG)			;Disk address of page mapped into DHPADR
RS(IOCNTR)			;Number of calls to PHYSIO to write file
RS(PGCNTR)			;Number of pages written to file
RS(OLDPFH)			;Address of PF handler when we entered
RS(DOBPI)			;State of PI system when entering DOB
RS(EXEADR)			;Disk address of EXE page of DUMP.EXE file
RS(SDBADR)			;Address of SDB we are using
RS(SAVSTK)			;Save caller's stack
RS(DOBCHK)			;Save checksum of DOB code area
RS(PFFLG)			;Flag to tell CHKADR that reference P.F.'ed
RS(DIORG)			;Address of ROOT-DIR X.B.

;The following words must remain in this order

RS(FNDSTN)			;[7.1215] Pointer to desired file name string
RS(FNDSTE)			;[7.1215] Pointer to desired file type string
;RS(FNDSTV)			;[7.1215] Desired file version

;End of words that must remain in order
;The following words must remain in this order

	RS(WNDADR)		;Address of window page
	RS(XBADR)		;Address of index block buffer page
	RS(SXBADR)		;Address of super index block buffer page
	RS(DHPADR)		;Address of directory header page
	RS(DDPADR)		;Address of directory data page
	ADRTAB==WNDADR		;First word of table of free page addresses
	ADTBSZ==DDPADR-WNDADR+1	;Number of words in the table

;End of words that must remain in order

;Allocate a mini-device size table

	N.BPP==0		;Offset for blocks per page
	N.CYL==N.BPP+1		;Offset for sectors per cylinder
RS(DEVSIZ,N.CYL+1)		;Disk size table - copied from DSKSZx

;Allocate IORBs

RS(ERIORB)			;[7.1254] IORB that caused the error
RS(FREIRB)			;List header of free IORB list
	NUMIOR==1		;[7.1254] Number of IORBs in pool
	IORSIZ==IRBLEN		;Size of an IORB
RS(IORBPL,IORSIZ*NUMIOR)	;Pool of IORBs

;Determine maximum transfer size in pages

	XFRPAG==^D128		;[7.1254] Max transfer size in each IORB
IFG XFRPAG-^D1020,XFRPAG==^D1020 ;[7.1244] Must be .LE. 1020 pages

;Allocate CCWs

	XFRSIZ==3777		;Max words possible to xfer with one CCW word
	CCWSIZ==<<XFRPAG*PGSIZ>/XFRSIZ>+3 ;[7.1254] Size of each CCW
RS(CCWPL,CCWSIZ*NUMIOR)		;[7.1254] Allocate the CCWs
	SUBTTL Definitions -- Symbols -- General

;FDB structure definitions (most are in PROLOG)

DEFSTR (FBCTL,.FBCTL,35,36)	;Control bits from FDB
DEFSTR (FBBYV,.FBBYV,35,36)	;Pointer to page count word

;Define symbol for which pi-in-progress levels we have to skip dumping on
;This will allow us to take dumps at PI 6 and 7 but not PI 1-5.

	PIPISD==PIPIIP		;Start with all in progress channels
	PINDCH==7		;Start with channel 7
REPEAT 7-PHYCHN,<		;For each channel up to PHYCHN
	PIPISD==PIPISD&^-<1B<^D20+PINDCH>> ;Turn off channel higher than PHYCHN
	PINDCH==PINDCH-1	;Decrease PI level counter by one
>				;End of REPEAT 7-PHYCHN

;Miscellaneous definitions used in dumping

	LCORAD==20		;Lowest address to dump

IFNDEF FTDT,FTDT==0		;[7.1244] Dump disk trace 0=off nonzero=on
				;[7.1244] 1=include trace of single page xfers

;Symbols used to search monitor's symbol table

	GLOBL==4B5		;Symbol is global
	SYMBOT==3		;Bottom of Symbol table
	SYMTOP==4		;Top of Symbol table

;Default values

	DOBITO==^D<15*1000>	;Initial DOB Time out value - 15 seconds

;The following symbols are used by routine CHKADR to touch physical memory

	TSTPAG==777		;Use last page in section 0
	TSTADR==TSTPAG_^D9	;Address of the last page
	TSTMAP==MMAP+TSTPAG	;MMAP slot for test page
	AP.RNX==APFCLR!APNXM	;Clear NXM
	SUBTTL Definitions -- Symbols -- EXE file

;EXE Directory page definitions.  Each entry has a header of the form
;"type,,length" followed by <length-1> words of data.

.EXDIR==1776			;Directory block type
	MSKSTR RPT,,777B8	;Repeat count in EXE file dir entry
;	MSKSTR EXRPT,,777B8	;Repeat count in EXE file dir entry
;	MSKSTR EXADR,,<777,,777777> ;Storage addr mask

.EXENT==1775			;Entry block type
	.ENLEN==1		;Second word is length
		EVLEN==1	;Length of entry vector in DUMP.EXE
	.ENADR==2		;Address of entry vector
		EVADR==140	;Address of entry vector in DUMP.EXE
	.ENFLG==3		;"Dump has been copied" flag (-1 if so)
;		EVBTS==0	;  0 = dump written by BOOT
		EVDOB==1	;  1 = dump written by DOB
;		EVCOP==-1	; -1 = dump copied by SETSPD
	.ENSIZ==4		;Size of entry vector block

.EXEND==1777			;End block type
	.EBSIZ==1		;Size of end block
	SUBTTL Definitions -- Symbols -- DOB% Symbols in MONSYM

;Bits defined in MONSYM and specified in arguments to DOB% JSYS
;
;	DB%ENA==:1B0		;Enable other bits DB%REQ!DB%IGN!DB%INF!DB%CHK

;Bits defined in MONSYM that are kept in the configuration word for each BUG
;
;	DB%REQ==:1B1		;Dump on this BUG is requested
;	DB%IGN==:1B2		;Ignore timeout for this BUG
;	DB%DON==:1B3		;Bug has been dumped already - set by monitor
;	DB%NND==:1B9		;Bug is not normally dumpable - set by monitor


;Bits defined in MONSYM and used in DOBSTS 
;
;	DB%DOB==:1B0		;DOB is enabled (in DOBSTS, must be 1B0)
;	DB%INF==:1B4		;Dump on all BUGINFs
;	DB%CHK==:1B5		;Dump on all BUGCHKs
;	DB%DIP==:1B6		;Dump is in progress
;	DB%ERR==:1B7		;Dump in progress had an error
;	DB%SML==:1B8		;DUMP.EXE for dump in progress is too small
	SUBTTL DOB% JSYS

;DOB - Manipulate the Dump-On-Bugchk(inf) Facility
;
;  AC1/ address of arg block
;
;	DOB%
;
;  Returns +1 always.  
;		Generates illegal instruction trap on failure
;		with error code in AC1
;
;  Arg block format:
;
;	0	.DBCNT		count of words in arg block including this word
;	1	.DBFNC		function code
;       2			function specific arg
;       3			function specific arg
;       ..	..		..

	XSWAPCD

.DOB::	MCENT			;Monitor Context ENTry
	MOVE T1,CAPENB		;Get current caps
	TXNN T1,SC%WHL!SC%OPR!SC%MNT ;Wheel, Oper or Maint???
	ITERR (CAPX2)		;No - bad news
	UMOVE Q1,T1		;Get address of argument block
	UMOVE T2,.DBCNT(Q1)	;Load the size of argument block
	CAIGE T2,.DBFNC+1	;Must be at least two words
	ITERR (ARGX04)		;Return argument block too small
	UMOVE T3,.DBFNC(Q1)	;Get function
	SKIPL T3		;Too low?
	CAIL T3,.DBMAX		;Too high?
	ITERR (ARGX02)		;Yes to one of above
	CALL @DOBFNC(T3)	;(Q1,T2/T1) Perform the function
	 ITERR ()		;Ill inst trap on error (error code in T1)
	MRETNG			;Success

;DOB% Function Dispatch Table

DOBFNC:	XADDR. (DBENA)		;Enable DOB
	XADDR. (DBDIS)		;Disable DOB
	XADDR. (DBSBG)		;Set configuration word
	XADDR. (DBPAR)		;Enable DOB parameters
	XADDR. (DBIMD)		;Force an immediate BUGINF AND DUMP
	XADDR. (DBSTA)		;Return status of DOB
	XADDR. (DBTIM)		;Set timeout
.DBMAX==.-DOBFNC		;Define highest valid function
	SUBTTL DOB% JSYS -- Function .DBENA

;.DBENA Function - Enable DOB.  
;Called with Q1/ Address of user's argument block
;	     T2/ argument block length
;Returns +1 if error T1/ error number
;        +2 if success
;This routine to swaps DOB in - must be swapped out already.

DBENA:	CAIE T2,.DBFNC+1	;Argument block properly set up?
	RETBAD (ARGX17)		;Invalid argument block length
	SKIPGE DOBSTS		;Is it setup?
	RETBAD (DOBX04)		;Already enabled
	CALL <XENT DOBINI>	;(/T1) Have to reinit DOB
	 RETBAD ()		;Pass up error code
	RETSKP			;Skip return to user
	SUBTTL DOB% JSYS -- Function .DBDIS

;.DBDIS Function - Disable DOB
;Called with Q1/ Address of user's argument block
;	     T2/ argument block length
;Returns +1 if error T1/ error number
;        +2 if success
;This routine swaps DOB out - must be locked in now (makes sense, right?)

DBDIS:	CAIE T2,.DBFNC+1	;Argument block properly set up?
	RETBAD (ARGX17)		;Invalid argument block length
	SKIPL DOBSTS		;Is it in?
	RETBAD (DOBX03)		;Not enabled, give error
	CALL DOBUNI		;() Un-initialize it
	RETSKP			;Success
	SUBTTL DOB% JSYS -- Function .DBSBG

;Routine to set the configuration word for a BUG
;Called with Q1/ Address of user's argument block
;	     T2/ argument block length
;Returns +1 if error T1/ error number
;        +2 if success
;Argument block format:
;	.DBNAM		Name of BUG in SIXBIT
;	.DBCFG		New configuration word
;			DB%ENA - if on, turn on the bits
;			DB%REQ - request a dump for this BUG
;			DB%IGN - ignore timeout

DB%BAD==:^-<DB%ENA+DB%REQ+DB%IGN> ;Mask of bits which CANNOT be set by a user

DBSBG:	CAIE T2,.DBCFG+1	;The argument block better be this long
	RETBAD (ARGX17)		;Illegal argument block size 
	XCTU [DMOVE T1,.DBNAM(Q1)] ;Get 2 word entry
	TXNE T2,DB%BAD		;Are only legal bits set??
	RETBAD (ARGX03)		;No - illegal to change specified bits
	CALL DBSBTS		;(T1,T2/T1) Go set bits
	RETBAD ()		;Error in T1
	RETSKP			;Return OK
;Routine to do the work for above
;Accepts T1/ 	BUG name in SIXBIT
;	 T2/	Flags - DB%ENA - turn on bits
;			DB%REQ - dump on this bug
;			DB%IGN - ignore timeout

DBSBTS:	STKVAR <FLAGS,SXNAM,BUGVA>
	MOVEM T1,SXNAM		;Save SIXBIT BUG name
	MOVEM T2,FLAGS		;Save flags from user
	CALL SIXFIV		;(T1/T1) Get RADIX50 value in T2
	 RETBAD (DOBX01)	;Illegal characters in BUGname
	CALL BUGVAX		;(T1/T1) Get V.A. of this symbol in T2
	 RETBAD (DOBX01)	;No such symbol
	MOVEM T1,BUGVA		;Save BUG's Virtual Address
	MOVE T4,@T1		;Get contents of address
	CAME T4,[CALL BGCCHK]	;Is it a BUGCHK from section 0/1?
	CAMN T4,[CALL @XBGCCH]	;Is it a BUGCHK from some other section?
	JRST DBSBT2		;Yes
	CAME T4,[CALL BGCINF]	;Is it a BUGINF from section 0/1?
	CAMN T4,[CALL @XBGCIN]	;Is it a BUGINF from some other section?
	JRST DBSBT2		;Yes
	RETBAD (DOBX01)		;Not a BUG, give an error

DBSBT2:	AOS T1			;Point to address of config word
	MOVE T1,@T1		;Get config word address
	MOVE T4,@T1		;Get configuration word
;	TXNE T4,DB%NVR		;Can we dump this bug?
;	RETBAD (DOBXxx)		;No
	MOVE T3,FLAGS		;Get back flags
	TXZN T3,DB%ENA		;Are we turning on 
	IFSKP.			;Yes
	  TXNE T4,DB%REQ	;Dump already requested?
	  RETBAD (DOBX06)	;Yes - tell user
	  IORM T3,@T1		;No - set appropriate flags
	  MOVE T1,BUGVA		;Get back Virtual Address
	  CALL BGSTOR		;(T1/) Go store the V.A. of this bug
	   RETBAD ()		;Some kind of error
	  JRST DBSBEX		;I stored it, prepare to exit
	ENDIF.			;End of turn on code
	MOVX T3,DB%REQ!DB%IGN	;Want to turn these off
	ANDCAM T3,@T1		;Do it
	MOVE T1,BUGVA		;Get back Virtual Address
	CALL BGDEL		;(T1/) Delete this BUG's name from list
	 RETBAD (DOBX05)	;Dump was not requested for this BUG
DBSBEX:	RETSKP			;Done
	ENDSV.			;End of STKVAR
	SUBTTL DOB% JSYS -- Function .DBSBG -- Convert SIXBIT to RADIX50

;Routine to convert from SIXBIT to RADIX50
;Called with SIXBIT value in T1
;Returns +1 - Illegal character in SIXBIT symbol (NOT 0-9/A-Z)
;	 +2 - Success  T1/ RADIX50 value of symbol
;Smashes Q2
	
SIXFIV:	MOVE T2,[POINT 6,T1]	;B.P. to SIXBIT string
	MOVEI T3,6		;Max of 6 characters
	SETZM Q2		;Zero out accumulator

SXFVLP:	ILDB T4,T2		;Get a character
	JUMPE T4,SXFVRT		;Done if zero (blank)
	CAIG T4,17		;1-17 illegal in a BUGname
	RET			;No
	CAILE T4,31		;20-31(0-9) subtracts 17 for RADIX50
	IFSKP.			;If yes
	  SUBI T4,17		;Convert to RADIX50
	ELSE.			;Not a number
	  CAIG T4,72		;.GE.73 illegal in BUGname
	  CAIGE T4,41		;as is 31-40
	  RET			;NFG
	  SUBI T4,26		;Sub 26 to convert 41-72
	ENDIF.			;Ready with character in T4
	IMULI Q2,50		;This is why they call is "RADIX50"
	ADDM T4,Q2		;Store this digit
	SOJG T3,SXFVLP		;Do the next

SXFVRT:	MOVE T1,Q2		;Return RAD50 value in T1
	RETSKP			;Success
	SUBTTL DOB% JSYS -- Function .DBSBG -- Find Virtual Address of a BUG

;Routine to find the V.A. of a BUGxxx
;Call with  T1/ RADIX50 symbol name
;Returns +1/ No such symbol
;	 +2/ Success,  T1/ V.A. of symbol

BUGVAX:	MOVE T2,PDVSYM		;Get address to Symbol table table
	LDB T3,[POINTR .STLEN(T2),SY%LEN] ;Get length of table		
	IDIVI T3,2		;Get count of symbols
	MOVE T4,.STPTR(T2)	;Get address of symbol table

BUGVLP:	MOVE T2,(T4)		;Get symbol name in RADIX50
	TXNN T2,GLOBL		;Is this symbol global?
	AOJA T4,BUGVNX		;No - check next
	TLZ T2,740000		;Yes clear other flags
	CAME T2,T1		;Do they match?
	AOJA T4,BUGVNX		;No
	MOVE T1,1(T4)		;Get the V.A.
	RETSKP			;And return it

BUGVNX:	AOS T4			;Increment pointer to next sym. tab. entry
	SOJGE T3,BUGVLP		;Decrement count of symbols
	RET			;No matches
	SUBTTL DOB% JSYS -- Function .DBSBG -- Manipulate DOBLST

COMMENT +

FORMAT of DOBLST:
-----------------

DOBLST/ address

		 __________________________________________
      address/  |    Size Of Block      Number		   |
		|   (not including ,,  of names		   |
		|     this word)       in list		   |
		|------------------------------------------|
    	 	|	        virtual			   |
    		|	     address of bug		   |
	        |------------------------------------------|
		|	    virtual address		   |
		|		...			   |
		|------------------------------------------|
		|		...			   |
		|					   |

+
	SUBTTL DOB% JSYS -- Function .DBSBG -- Manipulate DOBLST -- Setup the list

;SETLST - routine called to setup the list
;	Takes no arguments
;Returns +1 - Couldn't get free space T1/ error
;	 +2 - Sucess
;	   T1/ Address of list
;	   DOBLST/ Address of list

	LSTSIZ==^D20	;Size of the list requested 
			;This does NOT include the first word of the list
SETLST:	SAVEAC <T2>
	MOVX T1,<.RESP3,,LSTSIZ+1> ;Priority,,length
	MOVX T2,<RS%SE0!.RESGP>	;General pool
	CALLX (MSEC1,ASGRES)	;(T1,T2/T1) Get some space
	 RETBAD ()		;Probably system resources
	MOVEM T1,DOBLST		;Store address of list
	MOVSI T2,LSTSIZ		;Get size of list in LH
	MOVEM T2,@T1		;Put size in first word
	RETSKP			;And done
	SUBTTL DOB% JSYS -- Function .DBSBG -- Manipulate DOBLST -- Increase size of list

;Routine to increase size of list of BUGs. This routine will increase
;the size of the current block by LSTSIZ and return the previous
;list to the free pool after BLTing it's contents to the new list
;Call with T1/ Address of list
;Returns: +1  Error, T1/ error code
;	  +2  Success, T1/ Address of new list
;		       DOBLST/ Address of new list

INCLST:	SAVEAC <T2,T3>
	STKVAR <OLDSIZ,NEWLST>	;Size of old list, Addr of new list
	HLRZ T2,@T1		;Get size of current list
	MOVEM T2,OLDSIZ		;Store its size too
	MOVEI T1,LSTSIZ+1(T2)	;Get just a little more space
	HRLI T1,.RESP3		;Load priority of this request
	MOVX T2,<RS%SE0!.RESGP>	;General pool
	CALLX (MSEC1,ASGRES)	;(T1,T2/T1) Get some space
	 RETBAD ()		;No free space
	MOVEM T1,NEWLST		;Save address of new list
	MOVEM T1,T3		;Get new list in T3 for XBLTA
	MOVE T1,OLDSIZ		;Get size of old list for XBLTA
	MOVE T2,DOBLST		;Get address of old list for XBLTA
	CALLX (MSEC1,XBLTA)	;(T1,T2,T3) BLT old list to new
	MOVE T1,DOBLST		;Get address of old list
	CALLX (MSEC1,RELRES)	;(T1/) and return it to pool
	MOVE T1,NEWLST		;Get back new list address
	MOVEM T1,DOBLST		;Store address of new list
	MOVE T2,OLDSIZ		;Get old size
	ADDI T2,LSTSIZ		;Calculate new size
	HRLM T2,@T1		;And store it in list
	RETSKP			;Success return
	ENDSV.			;End of STKVAR
	SUBTTL DOB% JSYS -- Function .DBSBG -- Manipulate DOBLST -- Store BUG address

;Routine to store the address of a dumpable bug in DOBLST
;Called with T1/ Virtual Address of BUG
;Returns  +1  Failure, T1/ error code
;	  +2  Success

BGSTOR:	CALL DBLOCK		;[7.1133] () Lock up the database
	MOVEM T1,T2		;Put V.A. here
	SKIPLE T1,DOBLST	;Has the list been setup yet?
	IFSKP.			;Skip if not
	  CALL SETLST		;(/T1) No, go do it
	   CALLRET DBUNLO	;[7.1133] () No free space - unlock, return +1
	ENDIF.			;List now set up
	HLRZ T4,@T1		;Get size of list
	HRRZ Q1,@T1		;Get number of entries
	CAMLE T4,Q1		;Is the list full?
	IFSKP.			;Skip if yes
	  CALL INCLST		;(T1/T1) Yes - need a bigger one
	   CALLRET DBUNLO	;[7.1133] () No free space - unlock, return +1
	ENDIF.			;There is now enough room
	AOS @T1			;Say one more name in list
	ADD T1,Q1		;Point to last name
	AOS T1			;Point to next free entry
	MOVEM T2,@T1		;Store V.A. in list
	CALL DBUNLO		;[7.1133] () Let someone else play with it
	RETSKP			;Success
	SUBTTL DOB% JSYS -- Function .DBSBG -- Manipulate DOBLST -- Delete BUG entry

;Routine to delete an entry from the list of BUG names
;Called with T1/ V.A. of BUG
;Returns: +1 if bug wasn't in list
;	  +2 if bug now deleted

BGDEL:	CALL DBLOCK		;[7.1133] () Lock the list before changing it
	SKIPG T3,DOBLST		;Is the list of names setup?
	CALLRET DBUNLO		;[7.1133] () No, unlock return +1
	HRRZ T2,@T3		;Get number of BUGs in the list in T1
	JUMPE T2,DBUNLO		;[7.1133] () None, unlock return +1
	AOS T3			;Point to first address in list

BGDLP:	CAMN T1,@T3		;Is this the one we want to delete?
	IFSKP.			;Skip if not
	  AOS T3		;Point to next V.A. in list
	  SOJGE T2,BGDLP	;Check next one
	  CALLRET DBUNLO	;[7.1133] () Unlock and return +1
	ENDIF.			;We found the one we want to delete

	MOVE T1,T2		;Get size of BLT in T1
	MOVEM T3,T2		;Setup source of BLT
	AOS T2			;By pointing to next entry in list
	CALLX (MSEC1,XBLTA)	;(T1,T2,T3) BLT list to delete this entry
				; T1/ Size of BLT (twice the remaining entries)
				; T2/ Source of BLT (next entry in list)
				; T3/ Destination of BLT (entry to be deleted)
	SETZM @T3		;Zero out last entry in list
	SOS @DOBLST		;Say one less entry in list

;Bug has been removed from the list.  If we wanted to we could see if we could
;shrink the bug list here by writing a routine that does what INCLST in the
;reverse.  But since it isn't expected to have someone add more than 20 BUGs
;to dump then delete them, writing of this code is low priority.

	CALL DBUNLO		;[7.1133] () Unlock database
	RETSKP			;Success - name deleted from list
	SUBTTL DOB% JSYS -- Function .DBSBG -- Manipulate DOBLST -- Lock/Unlock

;This routine just acquires the DOB lock.  [7.1133] It returns NOINT.
;
;Call:	CALL DBLOCK		;Get database lock
;Returns+1 always, NOINT and with the lock.

DBLOCK:	NOINT			;[7.1108] Go noint for awhile
	LOCK DOBLOK		;[7.1133] Lock it
	RET			;Return to caller

;This routine counteracts the DBLOCK routine.  [7.1133] This routine is called 
;NOINT, and goes OKINT when we are finished.
;
;Call NOINT and with the DOB lock
; 	CALL DBUNLO		;Unlock database
;Returns +1 always, OKINT

DBUNLO:	UNLOCK DOBLOK		;[7.1133] Unlock the database
	OKINT			;[7.1108] OK for interrupts now
	RET			;Return to caller
	SUBTTL DOB% JSYS -- Function .DBPAR

;.DBPAR Function - Enable DOB Parameters
;Called with Q1/ Address of user's argument block
;	     T2/ argument block length
;Returns +1 if error T1/ error number
;        +2 if success

DB%PBD==:^-<DB%ENA+DB%INF+DB%CHK> ;Mask of BITS that CANNOT be set

DBPAR:	CAIE T2,.DBFLG+1	;Verify that it is 2 words long
	RETBAD (ARGX17)		;Illegal size for this function
	UMOVE T2,.DBFLG(Q1)	;Get flags
	TXNE T2,DB%PBD		;Make sure only legal bits set
	RETBAD (ARGX03)		;Illegal to change specified bits
	TXZE T2,DB%ENA		;Are we enabling?
	SKIPA T3,[IORM T4,DOBSTS] ;Yes
	MOVE T3,[ANDCAM T4,DOBSTS] ;No
	MOVE T4,T2		;Get flags in T4
	ANDX T4,DB%INF+DB%CHK	;Keep only relevant ones
	XCT T3			;Set/Turn off bits
	RETSKP			;All done
	SUBTTL DOB% JSYS -- Function .DBIMD

;DBIMD - Force immediate DUMP
;Called with Q1/ Address of user's argument block
;	     T2/ argument block length
;Returns +1 if error T1/ error number
;        +2 if success

DBIMD:	SKIPL DOBSTS		;DOB available? (1B0)
	RETBAD (DOBX02)		;No
	CAIE T2,.DBFNC+1	;Arg block length ok for no str specified?
	IFSKP.			;Yes
	  SETOM DOBSTR		;No structure given
	ELSE.			;Check for other argument block size specified
	  CAIE T2,.DBSTR+1	;Check for valid block size
	  RETBAD (ARGX17)	;Illegal argument block size
	  CALL DBISTR		;(/T1) Verify structure argument
	   RETBAD () 		;No good
	ENDIF.			;If a str specifed, it is locked and we NOINT
	BUG.(INF,FORCED,DOB,SOFT,<DOB - Requested BUGINF with continuable dump>,<<CTRLTT,CTRLTT>,<GBLJNO,GBLJNO>>,<

Cause:	This BUGINF has been requested by a user running the DOBOPR program
	or executing the DOB% JSYS function .DBIMD.  There is no other
	way that this BUGINF can occur.  The name of the user who requested
	the BUGINF has been printed on the CTY as part of the BUGINF output.
	The purpose of this BUGINF is to force a continuable dump of memory.
	A continuable dump should follow this BUGINF.

Data:	CTRLTT - the controlling terminal of the user who requested this.
	GBLJNO - the job number of the user who is requesting this.

Action:	Examine the dump.

>,,<DB%REQ!DB%IGN>)		;Always requested, ignore timeout
	SKIPGE DOBSTR		;Did we request a structure?
	IFSKP.			;Yes
	  MOVE T1,DOBSTR	;Get structure number
	  SETOM DOBSTR		;Clear the structure flag
	  CALLX (MSEC1,ULKSTR)	;(T1/) Unlock str and go OKINT (from FNDSTD)
	ENDIF.
	RETSKP			;Success
;Routine to verify structure name argument
;Returns +1 if some problem, T1/error
;        +2 if ok to use, structure locked and we are NOINT

DBISTR:	UMOVE T1,.DBSTR(Q1)	;Get pointer to 7bit structure name
	CALLX (MSEC1,FNDSTD)	;(T1/T1) Let MSTR check it out
	 RETBAD (STRX01)	;Structure not mounted
	MOVE T2,STRTAB(T1)	;Get address of SDB
	MOVE T3,SDBSTS(T2)	;Get flags
	TXNE T3,MS%OFS		;Is it offline?
	RETBAD (STRX10,<CALLX (MSEC1,ULKSTR)>) ;Structure offline
	TXNE T3,MS%INI!MS%DIS	;Is it being initialized or dismounted?
	RETBAD (STRX01,<CALLX (MSEC1,ULKSTR)>) ;Structure not mounted
	TXNN T3,MS%DMP		;Is it dumpable?
	RETBAD (DOBX07,<CALLX (MSEC1,ULKSTR)>) ;Structure is not dumpable
	MOVEM T1,DOBSTR		;Save requested structure number for DOB
	RETSKP			;Looks good
	SUBTTL DOB% JSYS -- Function .DBSTA

;Function .DBSTA of DOB% - return the status of DOB
;Called with Q1/ Address of user's argument block
;	     T2/ argument block length
;Returns +1 if error T1/ error number
;        +2 if success

DBSTA:	CAILE T2,.DBTOV+1	;Returning bug names?
	TXNE T2,1B35		;Yes, must be odd number words in arg block
	CAIGE T2,.DBSTS+1	;In any case it has to be at least this big
	RETBAD (ARGX17)		;No - illegal size
	CALL DBLOCK		;[7.1133] () Lock database
	MOVE T3,DOBSTS		;Get status word
	XCTU [MOVEM T3,.DBSTS(Q1)] ;Give user status word
	SKIPG T1,DOBLST		;Get address of list of BUGs
	TDZA T4,T4		;Say no requests
	HRLZ T4,@DOBLST		;Get number of BUGs in list (into LH)
	CAILE T2,.DBNUM		;Wants the .DBNUM word?
	XCTU [MOVEM T4,.DBNUM(Q1)] ;Yes, give it to him
	MOVE T3,DOBTOV		;Get the timeout value
	IDIVI T3,^D1000		;Convert to seconds
	CAILE T2,.DBTOV		;Return it?
	XCTU [MOVEM T3,.DBTOV(Q1)] ;Yes
	SUBI T2,.DBTOV+1	;Subtract fixed words from user's block size
	JUMPLE T2,DBSTS2	;Return now if this is all requested
				;T2 will have an (even) number of words left
	IDIVI T2,2		;Get count of entries in user's block
	HRRZ T3,@T1		;Get # of entries in DOBLST
	JUMPLE T3,DBSTS2	;If no Bugs in list, return now
	MOVEM Q1,T4		;Copy address of user's arg block
	ADDI T4,.DBBNM		;Point to first word to store into user's list

DBSTS1:	AOS T1			;Point to next element in DOBLST
	CALL RETSIX		;Get SIXBIT name of BUG in Q2
	MOVE Q3,@T1		;Get virtual address of BUG
	AOS Q3			;Point to address of BUG's config word
	MOVE Q3,@Q3		;Get address of config word
	MOVE Q3,@Q3		;Get config word
	XCTU [DMOVEM Q2,(T4)]	;Store both words into user's list
	XCTU [AOS .DBNUM(Q1)]	;Increment counter word for user
	ADDI T4,2		;Point to next 2-word entry in user's block
	SOSLE T3		;Any BUGs left in T-20's list?
	SOJG T2,DBSTS1		;Any room left in user's list?

DBSTS2:	CALL DBUNLO		;[7.1133] () Unlock the database
	RETSKP			;Return well
;Routine to get the SIXBIT name of a BUG from the address of the Bug block
;Called with T1/ Address of DOBLST entry
;Returns +1 Always
;	 Q2/ SIXBIT name
;	     or 0 if nothing looks like SIXBIT

RETSIX:	SAVEAC <T2,T3>
	MOVE T2,@T1		;Get V.A. of 'CALL BGCxxx'
	MOVX T3,BUGMXR+1	;Don't want to look for more than this

RETSLP:	AOS T2			;Skip config word
	MOVE Q2,@T2		;Get word
	TLNE Q2,770000		;Does it look like SIXBIT?
	RET			;Yes - got it
	SOJGE T3,RETSLP		;Try next word
	SETZM Q2		;Couldn't find it, return 0
	RET
	SUBTTL DOB% JSYS -- Function .DBTIM

;Function .DBTIM of DOB% - set DOB% timeout
;Called with Q1/ Address of user's argument block
;	     T2/ argument block length
;Returns +1 if error T1/ error number
;        +2 if success

DBTIM:	UMOVE T2,.DBCNT(Q1)	;Get the size of the block
	CAIE T2,.DBTVS+1	;[7.1125] Is it OK?
	RETBAD (ARGX17)		;Nope
	UMOVE T2,.DBTVS(Q1)	;[7.1125] Get timeout value
	CAIL T2,1		;[7.1125] Has to be at least 1 second
	CAILE T2,^D24*^D60*^D60	;[7.1125] Is it over 24 hours?
	RETBAD (DOBX08)		;DOB timeout out of range
	IMULI T2,^D1000		;Convert to milliseconds
	MOVEM T2,DOBTOV		;Save it
	RETSKP			; and return
	SUBTTL Start of checksummed code

;Previous code to this is all XSWAPCD for the DOB% JSYS.
;All of the XRESCD following (between STCHK and ENDCHK) is checksummed by DOB.

	XRESCD
	STCHK==.		;Start DOB checksum at this location
	SUBTTL DOB Initialization

;This routine is called during system startup and to initialize the DOB
;database. It grabs any free space needed by the DOB facility. If this routine
;fails to perform any of its functions, it will turn off the DOB facility. Any
;attempt by users to use this facility after this point will return an
;appropriate error.  This routine is also called after DOB has been swapped
;back into memory, to setup the necessary data base.
;
;Returns +1 if error, T1/ error code
;        +2 if DOB initialized

XRENT	(DOBINI,G)		;DOBINI:: and XDOBIN::

;First see if we we have been enabled before and if so just swap in some
;pages.  We don't release any resident free space from anywhere.

	SKIPN ADRTAB		;Have we already allocated some pages?
	IFSKP.			;Skip if yes
	  CALL PGISWP		;() Swap them back in
	  JRST DOB.EX		;And finish up
	ENDIF.			;We haven't allocated any yet

;Setup the reserved IORBs 

	MOVEI T1,CCWPL		;[7.1254] Point to CCW list
	MOVEI T2,IORBPL+<<NUMIOR-1>*IRBLEN> ;Get address of last IORB in pool
	SETZM (T2)		;Zero out last one
IFN NUMIOR-1,<			;[7.1254] Only if more then one IORB
	MOVEI T4,NUMIOR-1	;Setup counter for number of IORBs
DOB.CC:	HRRZM T1,IRBXFL(T2)	;Point IORB to it's CCW list
	MOVEM T2,-IRBLEN(T2)	;Point previous IORB to this one
	ADDI T1,CCWSIZ		;Point to next CCW list
	SUBI T2,IRBLEN		;Point to previous IORB
	SOJG T4,DOB.CC		;Do next IORB
>				;[7.1254] End of IFN NUMIOR-1
	HRRZM T1,IRBXFL(T2)	;Setup CCW pointer for first IORB
	MOVEM T2,FREIRB		;Store first IORB in list
;Get some extended resident free pages

	MOVEI T1,ADTBSZ		;Also need this many pages from non-0 section
	CALLX (MSEC1,PGRSKD)	;(T1/T1,T2) Go get them
	 JRST DOB.ER		;Couldn't, say so
	CAIE T2,ADTBSZ		;Did we get as many as we asked for?
	 JRST DOB.ER		;No, too bad
	MOVSI T2,-ADTBSZ	;Setup loop counter
DOB.AD:	MOVEM T1,ADRTAB(T2)	;Save address of page
	MOVE T1,(T1)		;Get address of next page in list
	SKIPE T1		;If zero, we're done
	AOBJN T2,DOB.AD		;Continue

;Initialize the default timeout.

	MOVEI T1,DOBITO		;Load default timeout value
	MOVEM T1,DOBTOV		;Save timeout value for later

;[7.1133] Initialize the database lock.  

	SETOM DOBLOK		;[7.1133] Insure the lock is free

;We have all of the memory we want to use, checksum our code, clear the
;preferred structure and the last time a dump was taken, enable us, and return
;good.  If you want to set breakpoints in DOB code you should disable it, set
;the breakpoints, then enable it, which causes a new checksum to be computed.

DOB.EX:	CALL CHKCOD		;(/T2) Go checksum the DOB code
	MOVEM T2,DOBCHK		;Store it for later
	SETOM DOBSTR		;And no structure
	SETOM DOBTMR		;Set the timer to indicate no 'recent' dumps
	MOVX T2,DB%DOB		;Say DOB is initialized
	IORM T2,DOBSTS		;And store it in flags word
	RETSKP			;Return

;Here if problem getting the memory that we need

DOB.ER:	MOVEI T1,MONX05		;Insuff sys resources (no resident free space)
DOB.ET:	MOVX T2,DB%DOB		;Say DOB is NOT available
	ANDCAM T2,DOBSTS	;And set it in flags word
	RETBAD ()		;And return error
	SUBTTL DOB Un-initialization

;Routine to UN-initialize the DOB data base (i.e. return any free space)

DOBUNI:	MOVX T1,DB%DOB		;DOB available flag
	ANDCAM T1,DOBSTS	;We are no longer enabled
;	CALLRET PGOSWP		;() Fall thru to unlock the pages from ADRTAB

;Routine to swap the pages pointed to by ADRTAB in or out of memory

PGOSWP:	SKIPA Q1,[MSEC1,,MULKPG] ;Routine to call to unlock
PGISWP:	MOVE Q1,[MSEC1,,MLKPG]	;Routine to call to lock
	MOVE Q2,[-ADTBSZ,,ADRTAB] ;Setup an AOBJN pointer

PGSLP:	HLRZ T1,(Q2)		;Get section
	HRLZ T1,MSECTB(T1)	;Get OFN in LH
	LDB T2,[POINT 9,(Q2),26];Get page number of this page
	HRR T1,T2		;Setup OFN,PN
	SKIPE T1		;If ADRTAB was empty - skip this...
	CALL @Q1		;(T1,T2/) Call the routine
	AOBJN Q2,PGSLP		;Go do next
	RET			;Done
	SUBTTL Dump Memory

;DODOB - Called by BUGFIN to see if this BUG should cause a dump
;
;Dump will NOT be taked if any of the following:
;	DOB is not enabled.
;	We are running at PI level higher (lower number) than PHYCHN.
;	Dump is not requested for this bug (DB%REQ).
;	Bug is normally not dumpable (DB%NND).
;	Dumps for all BUGCHKs enabled, and this is not a BUGCHK.
;	Dumps for all BUGINFs enabled, and this is not a BUGINF.
;	Dumps for all BUGCHKs or INFs enabled, and this bug has previously
;	 been dumped (DB%DON).
;	A dump is then only taken if the DOB timer has expired or this BUG
;	 has the IGNORE-TIMER bit (DB%IGN) set in it's config word.
;	Checksum of DOB code does not match (unless DBUGSW nonzero).
;	No place to write the dump.
;
;Called with T1/ Address of BUG
;	     T2/ BG%INF or BG%CHK as applicable
;Returns +1 Always

XRENT	(DODOB,G)		;DODOB:: and XDODOB::

;Insure that DOB is enabled and that we are not runnig above PHYCHN.

	SKIPGE DOBSTS		;[7.1237] Is DOB initialized yet?
	CONSZ PI,PIPISD		;Are we at interrupt level higher than PHYCHN?
	RET			;Not OK to dump

;Save type of bug and the address of the bug configuration word in STKVARs.

	STKVAR <BUGBLK,BUGFLG>	;Get some scratch places
	MOVEM T2,BUGFLG		;Save type of BUG (INF/CHK)
	MOVE T2,T1		;Get address of BUG
	XHLLI T1,(T2)		;Get section # of BUG block
	HRR T1,(T2)		; and destination address of block
	AOS T1			;Point to address of config word
	MOVE T1,@T1		;Get config word address
	MOVEM T1,BUGBLK		;[7.1237] Store the address of config word
	MOVE T3,@T1		;Get BUG's config word
;Check BUG's configuration word for enable bits, check timeout.

	TXNE T3,DB%REQ		;Is REQUEST bit on?
	JRST DODOB2		;Yes - check timer too

	TXNE T3,DB%DON!DB%NND	;[7.1237] Already dumped or not dumpable?
	RET			;[7.1237] Yes - don't dump this bug
	MOVE T1,BUGFLG		;Get BG%Inf/Chk flag
	MOVX T2,DB%CHK		;Assume we have a BUGCHK
	CAIN T1,BG%INF		;Is it a BUGINF?
	MOVX T2,DB%INF		;Yes - we were wrong then
	TDNN T2,DOBSTS		;Is the proper bit set?
	RET			;No - forget this BUG
	SKIPA T4,[DB%DON]	;Say this BUG was chosen because DB%Inf/Chk
DODOB2:	SETZM T4		;Say the BUG's request bit was on
	TXNE T3,DB%IGN		;IGNORE-TIMER bit set in Config word?
	IFSKP.			;No - check the timer then
	  CALLX (MSEC1,GETMST)	;(/T1) Go get the time 
	  CAMGE T1,DOBTMR	;Has the timer expired?
	  RET			;No - skip this BUG
	ENDIF.

;Check the code checksum.

	CALL CHKCOD		;(/T2) Checksum DOB code
	SKIPN DBUGSW		;Possible breakpoints?
	CAMN T2,DOBCHK		;Is it the same??
	IFSKP.			;Nope
	  CALLX (MSEC1,DOBSEC)	;() Enter secondary protocol for message
	  CALL DOBERP		;[7.1215] Output error prefix
	  DOBMS(<Checksum of DOB code does not match - aborting dump
>)				;Print a not so nice message
	  XJRST [MSEC1,,DOBPRI]	;() Reenter primary protocol and return
	ENDIF.			;If there was a CALLXRET I could have used it

;Ready to dump, set DB%DON if we are here because dumping all BUG CHK/INFs.

	IORM T4,@BUGBLK		;[7.1237] Maybe set DB%DON in bug config word

	ENDSV.			;[7.1237] End of STKVAR at DODOB
				;Fall through to DOBDMP
;Here from DODOB to take a dump of memory.  We will determine which structure
;to write to and call PHYSIO to do the I/O.

DOBDMP:	MOVX T1,DB%DIP		;Come here from DODOB
	IORM T1,DOBSTS		;Indicate that there is a dump-in-progress

	CALL SAVPI		;() Save/Set the state of the PI system
	CALLX (MSEC1,DOBSEC)	;() Enter secondary protocol
	CALLX (MSEC1,MTROFF)	;() Turn off the meters
	CALLX (MSEC1,WATEPT)	;() Wait for DTEs and channels to calm down
	CALL PFHSET		;() Setup page fault handler
	PION			;[7.1254] Turn on PI system again

	MOVEM P,SAVSTK		;Save incoming stack
	MOVE P,[IOWD STKSIZ,DOBSTK] ;New stack pointer
	CALL STRCHK		;() Determine which structure
	 DOBER(Cannot find place to write continuable dump)
	DOBMS(<
[DOB: Writing continuable dump for bug >) ;Output start of message
	MOVE T2,BUGNAM		;Load bug name
	CALL DOBMS6		;(T2/) Output it
	DOBMS (< to structure >) ;Label structure name
	MOVE T2,@SDBADR		;Get name of structure
	CALL DOBMS6		;(T2/) Output that in sixbit
	DOBMS(<]
>)				;Output a CRLF
	CALL SAVMEM		;() Call the routine to write the file
				;Fall through to DOBEXI
;Here when we are finished dumping (or the dumping has been aborted)
;to clean up and then return back to APRSRV.  It is OK to come here with extra
;stuff on the stack since we reset the stack pointer before returning.

DOBEXI:	DOBMS(<[DOB: Continuing system]

>)				;[7.1215] Output another message
	CALL WAITIO		;[7.1254] () Wait for all IO to finish up

	PIOFF			;[7.1254] Turn off PI system
	CALL PFHRST		;() Restore page fault handler
	CALLX (MSEC1,UNWEPT)	;() Counteract the call to WATEPT/MTROFF
	CALLX (MSEC1,DOBPRI)	;() Reenter primary protocol
	CALL RESTPI		;() Restore PI to the way it was

	CALLX (MSEC1,GETMST)	;(/T1) Get the current uptime
	ADD T1,DOBTOV		;Add time out value
	MOVEM T1,DOBTMR		;Store new DOB timer
	EXCH P,SAVSTK		;For debugging purposes
	AOS DOBJB0		;Need to run SETSPD to copy the DUMP file
	MOVEI T1,1		;[7.1254] Load flag for DTESRV
	IORM T1,UPFLAG		;[7.1254] Make the "[DECSYSTEM-20 continued]"
	AOS JB0FLG		;Need to run job 0 to run SETSPD
	MOVX T1,DB%DIP!DB%ERR!DB%SML ;Load dump in progress, error, small bits
	ANDCAM T1,DOBSTS	;Say Dump no longer in progress
	RET			;Return to BUG processing code
	SUBTTL Dump Memory -- Manipulate PI System

;SAVPI - Save the state of the PI system upon entering DOB

SAVPI:	CONI PI,T1		;Get the current state of the PI system
	TXNE T1,PIPION		;Is the system on?
	PIOFF			;Yes - turn it off
	MOVEM T1,DOBPI		;And save the previous state
	CONO PI,<PICHOF+<FLD -1,PICHNM>>;Turn off all of the channels
	CHNON(PHYCHN)		;But leave PHYSIO enabled
	CHNON(APRCHN)		;And Channel 3
	RET			;Back to DOB

;RESTPI - Restore the PI system to what it was when SAVPI was called

RESTPI:	PIOFF			;Start by turning the PI system OFF
	CHNOFF (APRCHN)		;[7.1254] Turn off APR channel
	CHNOFF (PHYCHN)		;Turn off PHYSIO's channel
	MOVE T1,DOBPI		;Get the previous state
	ANDX T1,<FLD -1,PICHNM>	;Only interested in these (levels enabled)
	IORI T1,PICHON		;Say turn them back on
	CONO PI,(T1)		;Put it back where it was
	MOVE T1,DOBPI		;Get back the previous state
	TXNE T1,PIPION		;Was the PI system on before?
	PION			;Yes
	RET			;And continue
	SUBTTL Dump Memory -- Find Usable DUMP.EXE

;Routine to search structure data base and determine which structure
;should be used for the dump
;Return +1 No structures containing valid DUMP.EXE are available
;       +2 A structure was chosen - it's DUMP.EXE's super XB and XB#0 are
;	   mapped in addresses pointed to by SXBADR and XBADR
;	   SDBADR points to the chosen structure's SDB
;	   DEVSIZ table is setup with the proper information

STRCHK:	STKVAR <STRNO>		;Save structure number we are looking at
	SKIPL DOBSTR		;Is a specific structure requested?
	SKIPA T1,DOBSTR		;Yes - only check this one
	SETZ T1,		;No, check all of them starting with first
	MOVEM T1,STRNO		;Save structure number we are looking at

STR.LP:	CALL CKSTR		;(T1/) Check it for dumpable 
	 JRST STR.NX		;Bad - check next one
	CALL IDXFND		;() Go map in super XB and XB #0 of file
	 JRST STR.NX		;Error
	CALL CEXEDR		;() Check for usable DUMP.EXE on this structure
	 JRST STR.NX		;Error
	RETSKP			;Found a good one, return

STR.NX:	SKIPL DOBSTR		;Are we checking them all?
	RET			;No - requested structure didn't pass tests
	AOS T1,STRNO		;Try next structure index
	CAIL T1,STRN		;Have we tried them all?
	RET			;Yes - nothing available
	JRST STR.LP		;Go check out this one

	ENDSV.			;[7.1237] End of STKVAR
	SUBTTL Dump Memory -- Find Usable DUMP.EXE -- Check A Structure

;Check the SDB for a structure to insure 'goodness'
;This is an extremely paranoid routine...
;Call with T1/ Structure number
;Returns - +1/ SDB is bad or Structure not available
;	   +2/ SDB appears to be good AND structure is available for dumping
;	       SDBADR, DIORG, DEVSIZ all set up

;First check the SDB's status.

CKSTR:	SKIPN T1,STRTAB(T1)	;SDB exist?
	RET			;No
	MOVE T2,SDBSTS(T1)	;Get flags
	TXNN T2,MS%INI!MS%DIS!MS%OFS ;[7.1144] Str init, dismount, offline?
	TXNN T2,MS%DMP		;Is this structure 'dumpable'? 
	RET			;Init, dismount, offline, or not dumpable

;We have an SDB that is online and dumpable, next we check the data in the SDB
;for consistency.  These checks don't necessarily insure that the SDB has good
;data, or even that what we are looking at is really an SDB. But if the block
;of data starting at the location we are looking at does pass these tests, it
;is highly likely that it is an SDB and it contains 'good' data.  We also set
;up DIORG and SDBADR here.

	MOVE Q1,SDBNUM(T1)	;Get # of units 
	CAILE Q1,MXSTRU		;Is this reasonable?
	RET			;No
	MOVE T2,SDBRXB(T1)	;Get address of R-D XB
	MOVEM T2,DIORG		;Save the address of root directory index block
	MOVE T2,SDBTYP(T1)	;Get address of size table
	CAIL T2,DSKSZ0		;Does this address 
	CAILE T2,DSKSZ9		; look right?
	RET			;Nope
	MOVE T3,SECCYL(T2)	;Get sectors per cylinder
	MOVEM T3,DEVSIZ+N.CYL	;Store it in DOB's size table
	MOVE T3,SECPAG(T2)	;Blocks per page
	MOVEM T3,DEVSIZ+N.BPP	;Store it too
	MOVE T3,SDBLCA(T1)	;Load the last cyl assigned
	CAMLE T3,SDBCYL(T1)	;Is this reasonable?
	RET			;Nope
	MOVEM T1,SDBADR		;Store address of SDB we are looking at
;Now we check the health of each UDB entry in this SDB.  This first check
;makes sure that there is a UDB address for each unit that the SDB professes to
;have.

	STKVAR <UDBPTR,UNITNO>	;Pointer to UDB, Unit number
	ADDI T1,SDBUDB		;Add to SDB address the offset to UDB pointers
	MOVEM T1,UDBPTR		;Store UDB pointer
	SETZM UNITNO		;Start at unit 0

CKS.UD:	SKIPN T1,@UDBPTR	;Do we have an address for this unit?
	RET			;No - bad SDB
	TLZ T1,-1		;Get rid of flags
	CALLX (MSEC1,GETSTR)	;(T1/T1,T2,T3) Check if unit OK
	 RET			;It isn't
	TXNE T3,MS%WLK		;Is unit write-locked?
	RET			;Yes, NFG
	AOS UDBPTR		;Point to next UDB pointer
	AOS UNITNO		;Say we're doing next unit
	SOJG Q1,CKS.UD		;Any more units to do?

;Used UDB slots are OK, make sure unused UDB slots are zero.

	MOVE T1,UNITNO		;Get unit number in an AC
CKS.U1:	CAIL T1,MXSTRU		;Checked all slots?
	RETSKP			;Yes, skip return
	SKIPE @UDBPTR		;Is this entry zero?
	RET			;No - bad SDB
	AOS UDBPTR		;Point to next UDB
	AOJA T1,CKS.U1		;Count another one and continue

	ENDSV.			;End of STKVAR
	SUBTTL Dump Memory -- Find Usable DUMP.EXE -- Check EXE Directory

;Check the EXE directory of a <SYSTEM>DUMP.EXE to insure that it is in the 
;proper format and that doesn't contain an uncopied dump.
;Returns - +1/ File or EXE file directory bad or contains uncopied dump
;	   +2/ File is suitable for dumping
;
;A EXE directory will be in one of the following formats:
;
;		Dump written by BOOT or DOB		MAKDMP created
;		---------------------------		--------------
;	  0/	.EXDIR,,len				.EXDIR,,1
;	  1/ 	(<len-1> words describing data pages)   .EXEND,,.EBSIZ
;       len/	.EXENT,,.ENSIZ
;len+.ENLEN/		EVLEN
;len+.ENADR/		EVADR
;len+.ENFLG/		flag word (EVBTS, EVDOB, EVCOP)
;len+.ENSIZ/	.EXEND,,.EBSIZ

CEXEDR:	LOAD P5,STGADR,@XBADR	;[7.1215] Get disk address of page 0 of file
	JUMPLE P5,STR.NX	;Bad file
	MOVE P4,WNDADR		;Read page 0 into 'window page'
	CALL REDPAG		;(P4,P5/P4) Try to read page
	 RET			;Error - try next structure
	HLRZ T1,@WNDADR		;Get block type
	CAIE T1,.EXDIR		;Is it a directory block
	RET			;No - skip this structure
	HRRZ T2,@WNDADR		;Get size of the block
	CAIN T2,1		;Is it length one?
	IFSKP.			;It wasn't length one
	  MOVE T3,T2		;Preserve words in exe directory
	  ADD T3,WNDADR		;Get address of the word after directory
	  MOVE T1,@T3		;Get that word
	  ADDI T3,.ENFLG	;Get offset to flag word in entry vector
	  CAMN T1,[.EXENT,,.ENSIZ] ;Must be entry vector and length of four
	  SKIPL @T3		;Has the file been copied yet?
	  RET			;No to either, we can't use this DUMP.EXE
	  ADDI T2,.ENSIZ	;Add in length of entry vector block
	ENDIF.			;End of entry vector check
	ADD T2,WNDADR		;Point to next location
	MOVE T2,@T2		;Get the next word
	CAME T2,[.EXEND,,.EBSIZ] ;Is it the end of the EXE directory?
	RET			;No, don't use this one
	RETSKP			;Yes, use this file
	SUBTTL Dump Memory -- Write DUMP.EXE

;Routine called to write the DUMP.EXE file on the structure pointed to by
;SDBADR.  Returns: +1 if no error, otherwise an error is printed and we
;continue at DOBEXI.

SAVMEM:	STKVAR <STPAG,NMPAG>	;Place to save start and number of pages
	SETZM IOCNTR		;Count of number of calls to WRTPAG
	SETZM PGCNTR		;Count of number of pages written
	SETZM ERIORB		;[7.1254] No error IORB yet
	SETZM @WNDADR		;Zero out directory page 
	MOVE T2,WNDADR		;Get source of BLT
	MOVE T3,T2		;Destination is source
	AOS T3			;  plus one
	MOVEI T1,PGSIZ-1	;Get size of BLT
	CALLX (MSEC1,XBLTA)	;(T1,T2,T3) Zero directory page
	SETOM @WNDADR		;-1 says directory page not started yet
	MOVE T1,@XBADR		;Get disk address of EXE page of file
	MOVEM T1,EXEADR		;And save it for later when we write it out
	SETZ T1,		;Start at page 0

SAV.LP:	MOVEM T1,STPAG		;Save starting physical page number
	MOVX T2,DB%ERR		;[7.1244] Load the error bit
	TDNE T2,DOBSTS		;[7.1244] Any errors?
	JRST IORBER		;[7.1254] Yes, publish one of them and abort
	CALL GETPGS		;(T1/T2,P4,P5) Go get set of contiguous pages
	JUMPN T2,SAV.L2		;Jump if anything to write
	AOS T1,STPAG		;Get the next page number
	JRST SAV.EX		;Try the next page

SAV.L2:	LSH P4,^D9		;Shift page number to an address
	MOVEM T2,NMPAG		;Save number of pages to write
	CALL WRTPAG		;(T2,P4,P5/T1) Go write the pages
	MOVE T2,NMPAG		;Get back count of pages
	MOVE T1,STPAG		;Get back starting page number
	CALL MAKDIR		;(T1,T2/T1,T2) Set up dir page info
	AOS IOCNTR		;Increment counter of IO requests
	ADDM T2,PGCNTR		;Count up how many pages we have written
	ADD T1,T2		;Get address of first page in next group

SAV.EX:	CAMLE T1,NHIPG		;Higher than we have?
	JRST WRTDIR		;Yes - done, go write out directory page
	CAMGE T1,DEXEPC		;Is there room in the file for another page?
	JRST SAV.LP		;Yes - go get next set
	MOVX T1,DB%SML		;DUMP.EXE is too small, light error bit
	IORM T1,DOBSTS		; in the status word
	JRST WRTDIR		;Write directory page and finish up

	ENDSV.			;End of STKVAR scope
	SUBTTL Dump Memory -- Write DUMP.EXE -- Find pages to write out

;[7.1215] GETPGS - Get a set of contiguous pages to write out.  Since the
;monitor tends to allocate files in continuous sectors for an entire cylinder,
;we try to make up transfers of larger number of pages to make an entire group
;of continuous sectors (up to an entire cylinder's worth in one IORB).

;Call with T1/ Desired physical page to start writing
;Returns +1   P4/ Physical memory page to start writing
;	      T2/ Number of pages to write
;	      P5/ Disk address to write to
;Use of ACs herein:
;		T1 - Physical page we are checking out
;		T4 - Address of index block entry for current page
;[7.1215] STKVARs:
;	DSKADR/ starting disk address for this unit
;	CURCYL/ starting (current) cylinder
;	CURSEC/ starting (current) physical sector
;	CURUNT/ starting (current) unit number
;	PAGCNT/ count of pages in the contiguous pages so far 

GETPGS:	STKVAR <DSKADR,CURCYL,CURSEC,CURUNT,PAGCNT> ;[7.1244][7.1215] 
	SETZM PAGCNT		;[7.1215] Zero out page counter
	MOVEI T4,1(T1)		;[7.1244] Map memory page to file page in T4
	MOVE T2,T4		;[7.1215] Copy the file page number to T2
	LSH T2,-^D9		;[7.1215] Determine which XB is needed
	CALL MAPXB		;[7.1215] (T2/P4,P5) and go get it into XBADR
	ANDI T4,777		;Keep just low order bits
	ADD T4,XBADR		;Get address of XB

	LOAD T2,STGADR,@T4	;[7.1215] Get disk address for this page
	JUMPE T2,R		;[7.1215] Return now if not a real disk address
	TLZ T2,DSKMSK		;[7.1244] Clear non-address bits
	MOVEM T2,DSKADR		;[7.1215] Save disk address to write
	IDIV T2,DEVSIZ+N.CYL	;[7.1244] Isolate cyl/sect in T2/T3
	MOVEM T2,CURCYL		;[7.1244] Save cylinder
	MOVEM T3,CURSEC		;[7.1244] Sector too

	MOVE T2,DSKADR		;[7.1244] Get disk address back please
	MOVE T3,SDBADR		;[7.1244] Load selected SDB address
	IDIV T2,SDBSIZ(T3)	;[7.1244] Compute the unit number in T2
	MOVEM T2,CURUNT		;[7.1244] Save current unit number

	CALL CHKADR		;(T1/) See if this page is accessible
	 JRST GTPGDN		;Can't write this page
;Come here when current page is OK to write, count it then try next one
;	T1/ physical page number we are looking at now
;	T4/ address of current XB entry for that physical page
;	CURCYL/ current cyl
;	CURSEC/ current sector
;	CURUNT/ current unit

GTPGNX:	AOS PAGCNT		;[7.1244] Increment page counter
	AOS T1			;Check out next page
	CAMLE T1,NHIPG		;Higher than we have?
	JRST GTPGDN		;Yes - done with this group

	AOS T4			;Increment XB index
	TXNE T4,777		;[7.1215] Do we need the next XB?
	IFSKP.			;[7.1215] Yes, we need another XB
	  MOVE T2,XBNUM		;[7.1215] Get current XB
	  AOS T2		;[7.1215] Increment it for next one
	  CALL MAPXB		;[7.1215] (T2/P4,P5) Map in next XB please
	  MOVE T4,XBADR		;[7.1215] Get first word of address of XB
	ENDIF.			;[7.1215] XB entry pointed to by T4 now

	LOAD Q1,STGADR,@T4	;[7.1215] Get disk address for next page
	JUMPE Q1,GTPGDN		;[7.1215] Done if not a real disk address
	TLZ Q1,DSKMSK		;[7.1215] Keep just the address bits
	IDIV Q1,DEVSIZ+N.CYL	;Get Sec/Cyl in Q1/Q2
	CAME Q1,CURCYL		;Same cylinder?
	JRST GTPGDN		;No - can't add this page to group
	MOVE T2,DEVSIZ+N.BPP	;Add number of blocks per page
	ADDM T2,CURSEC		;Point to next page
	CAMN Q2,CURSEC		;Same sector?
	CALL CHKADR		;(T1/) See if page is OK to write
	 JRST GTPGDN		;Don't write out this page

	LOAD T2,STGADR,@T4	;[7.1215] Get disk address for that page
	TLZ T2,DSKMSK		;[7.1215] Keep just the address bits
	MOVE T3,SDBADR		;[7.1215] Load selected SDB address
	IDIV T2,SDBSIZ(T3)	;[7.1215] Compute the unit number in T2
	CAME T2,CURUNT		;[7.1215] Odd case of jump in unit number?
	JRST GTPGDN		;[7.1215] Yes can't write this page now

	MOVE T2,PAGCNT		;[7.1244] Increment page count
	CAIGE T2,XFRPAG		;[7.1244] Is this chunky enough?
	JRST GTPGNX		;[7.1244] This one is ready to ship out
;	JRST GTPGDN		;[7.1244] Fall thru if we are chunky enough
;Done with this group - return proper arguments
;	T2/ Number of pages to write
;	P4/ Physical memory page to start writing
;	P5/ Disk address to write to

GTPGDN:	MOVE P4,T1		;[7.1244] Get starting page number to write out
	SUB P4,PAGCNT		;[7.1244]  by subtracting count from last page
	MOVE T2,PAGCNT		;Get number of pages to write
	MOVE P5,DSKADR		;[7.1215] Get starting disk address
	RET			; and return

	ENDSV.			;End STKVAR
	SUBTTL Dump Memory -- Write DUMP.EXE -- Check if page should be written

;CHKADR - Routine to determine if page should be written out
;Called with T1/ Phys. Page address
;Returns +1/ Don't write this page
;	 +2/ Write this page
;		T1/ Phys. page address to write

CHKADR:	CAMLE T1,NHIPG		;Check that the page 'looks' good
	RET			;It doesn't - better skip it
	MOVX T2,PSASM!CSWRB	;Setup CST write bit and a legal age
	EXCH T2,@CST0X+T1	;Save/setup CST0 for page we want to check
	PUSH P,TSTMAP		;Save existing page table entry 
	HLL T1,IMMPTR		;Form immediate pointer (+writeable+cacheable)
	MOVEM T1,TSTMAP		;Map page to be Tested
	CLRPT @[TSTADR]		;Clear pager entry for tstadd page
	CONO APR,AP.RNX		;Turn off NXM flag
	SETZM PFFLG		;Turn off page fault flag too
CHKAD:	SKIP @[TSTADR]		;Reference virtual page
CHKCNT:	HRRZ T1,TSTMAP		;Get physical page number
	POP P,TSTMAP		;Restore original map entry
	MOVEM T2,@CST0X+T1	;Restore CST0 entry for page
	CLRPT TSTADR		;Don't forget to clear the pager, Gene...
	CONSO APR,APNXM		;NXM on reference?
	SKIPE PFFLG		;Did it page fail?
	SKIPA			;Yes or Yes
	RETSKP			;No P.F., no NXM - return successfully
	CONO APR,AP.RNX		;Yes, reset NXM flag
	RET			;Return bad
	SUBTTL Dump Memory -- Write DUMP.EXE -- Map index blocks

;Routine to map an index block (from address in super index block)
;Call with T2/ Number of XB we want
;Returns +1 always, trashes P4 and P5

MAPXB:	CAMN T2,XBNUM		;[7.1215] Is the one we want here?
	RET			;Yes - return
	SAVEAC <T1,T2,T3>	;[7.1215] Save T1-T3
	MOVEM T2,XBNUM		;[7.1215] Store number of new XB
	ADD T2,SXBADR		;[7.1215] Get super XB's offset for new XB
	LOAD P5,STGADR,@T2	;[7.1215] Get disk address of the new XB
	SKIPN P5		;[7.1215] Must be nonzero
	DOBER (Illegal format of index block) ;[7.1215] It was zero, owie
	MOVE P4,XBADR		;Read into XB page
	CALL REDPAG		;(P4,P5/) Go do it
	 DOBER(Error reading index block)
;Should compute and check checksum here
	RET 			;Return
	SUBTTL Dump Memory -- Write DUMP.EXE -- Add Entry To EXE Directory

;Routine to add an entry to the directory page of the EXE file.
;Called with T1/ Physical page number we just wrote
;	     T2/ number of pages we just wrote
;Returns +1 always, with T1 and T2 preserved.

MAKDIR:	SKIPGE T3,@WNDADR	;Get offset to current block in directory page
	JRST MAK1ST		;No entries yet, go do first
	ADD T3,WNDADR		;Get address of directory page
	AOS T3			;And point to second word in the block
	HRRZ Q1,@T3		;Get last process page written
	LOAD Q2,RPT,@T3		;Get repeat count of this entry
	ADD Q1,Q2		;Increment it to see
	CAIE Q1,-1(T1)		; if we have a contiguous set
	JRST MAKNEW		;No - go write new entry
	ADD Q2,T2		;Does this group make
	CAIL Q2,1000		; it too big?
	JRST MAKNEW		;Yes - new entry

MAKDON:	STOR Q2,RPT,@T3		;No - increment count
	RET			; And done...

MAKNEW:	MOVE T3,@WNDADR		;Get current word count
MAK1ST:	ADDI T3,2		;Increment for new 2 word block
	TXNN T3,777		;Have we exceeded max size of directory page?
	 DOBER(Directory page too small) ;Yes - report it
	MOVEM T3,@WNDADR	;Update count of words in directory section
	ADD T3,WNDADR		;Add address of page to offset of current block
	HRRM T1,@T3		;Save file page number to write
	AOS @T3			;Increment it...
	AOS T3			;Point to second word of block
	MOVEM T1,@T3		;Store process page number 
				; (physical page address)
	MOVEM T2,Q2		;Get number of pages
	SOS Q2			;Decrement for repeat count
	JRST MAKDON		;And finish
	SUBTTL Dump Memory -- Write DUMP.EXE -- Write EXE Directory

;Routine to finish directory page and write it out so that it looks like this:
;
;	  0/	.EXDIR,,len
;	  1/ 	(<len-1> words describing data pages)
;       len/	.EXENT,,.ENSIZ
;len+.ENLEN/		EVLEN
;len+.ENADR/		EVADR
;len+.ENFLG/		EVDOB (dump written by DOB)
;len+.ENSIZ/	.EXEND,,.EBSIZ

WRTDIR:	MOVEI T1,2		;Increment size of directory block
	ADDM T1,@WNDADR		; ...
	MOVEI T1,.EXDIR		;Get directory block type
	HRLM T1,@WNDADR		;Store that in directory
	HRRZ Q3,@WNDADR		;Get offset of current block
	ADD Q3,WNDADR		;Add in address of page
	MOVE T1,[.EXENT,,.ENSIZ] ;Load entry vector block type and length
	MOVEM T1,@Q3		;Store it as first word in entry vector
	AOS Q3			;Point to next word (.ENLEN)
	MOVEI T1,EVLEN		;Get length of entry vector
	MOVEM T1,@Q3		;Store it in .ENLEN
	AOS Q3			;Point to next word (.ENADR)
	MOVEI T1,EVADR		;Get address of entry vector
	MOVEM T1,@Q3		;Store address of entry vector in .ENADR
	AOS Q3			;Point to next work (.ENFLG)
	MOVEI T1,EVDOB		;Load DOB code (1)
	MOVEM T1,@Q3		;Store it in .ENFLG
	AOS Q3			;Point to next free word for end block
	MOVE T1,[.EXEND,,.EBSIZ] ;Load end block type and size
	MOVEM T1,@Q3		;Store that
	LOAD P5,STGADR,EXEADR	;[7.1215] Write out Page 0 of file
	SKIPN P5		;Complain if no Page zero
	 DOBER(No page 0 of file) ;No page 0
	MOVE P4,WNDADR		;Get virtual address of EXE directory
	CALL GETPHY		;(P4/P4) Translate it to a physical address
	 DOBER(Illegal address for EXE page of file) ;Illegal address
	MOVEI T2,1		;Say just write one page, please
	CALL WRTWAT		;(T2,P4,P5/) Write directory page and wait 
	 DOBER(Error writing Directory page of DUMP.EXE) ;Err writing dir page
	MOVE T2,DOBSTS		;Load status word
	TXNE T2,DB%SML		;Was the dump file too small?
	DOBER(Dump file too small) ;Yes - DUMP.EXE too short
	RET			;Success
	SUBTTL Dump Memory -- Find Files -- Find <SYSTEM>DUMP.EXE

;Map the XB of DUMP.EXE (the EXE directory)
;Returns +1 if file not found
;        +2 if file found page read in at WNDADR

IDXFND:	SETOM CURPAG		;Initialize to no page read in yet
	MOVE P5,DIORG		;Get address
	MOVE P4,XBADR		;Index block buffer
	CALL REDPAG		;(P4,P5/) Read root-dir XB
	 RET			;Error reading page
	CALL DIRMAP		;() Map in root dir header page
	 RET			;Couldn't
	MOVE T1,[POINT 7,[ASCIZ/SYSTEM/]] ;Finding SYSTEM.DIRECTORY
	MOVE T2,[POINT 7,[ASCIZ/DIRECTORY/]] ; in the <ROOT-DIRECTORY>
;	SETZ T3,		;Get highest version number (should be 1)
	CALL IDXGET		;(T1,T2,T3) Get index block of dir file
	 RET			;Couldn't
	CALL DIRMAP		;(/P4,P5) Map in the directory
	 RET			;Couldn't
	MOVE T1,[POINT 7,[ASCIZ/DUMP/]] ;Get pointer to name string
	MOVE T2,[POINT 7,[ASCIZ/EXE/]] ; and pointer to extension string
;	SETZ T3,		;Get highest version (1)
				;Fall into IDXGET
;Small routine called from above to get the index block for the file
;Call with T1/ pointer to filename
;	   T2/ pointer to filetype
;          T3/ generation number (not currently used)
;Returns +1 if cannot find it
;        +2 if can find it
	
IDXGET:	DMOVEM T1,FNDSTN	;[7.1215] Save name in FNDSTN, ext in FNDSTE
;	MOVEM T3,FNDSTV		;[7.1215] Save file version number
	CALL FIND		;(/P1) Return FDB offset in P1
	 RET			;No such file
GX.NE:	MOVE Q2,FNDSTE		;Compare with next extension
	CALL GETPAG		;(P1/T1) Map in page containing FDB
	 RET			;Error in GETPAG
	LOAD Q3,FBEXT,(T1)	;Get address of extension string block
	HRLI Q3,(POINT 7,0)	;Set it up as a string pointer
	ADDI Q3,1		;Point to string
	CALL STRCMP		;(Q2,Q3/) Compare strings
	 CAIA			;Failed
	JRST GX.NV		;Found extension match - look at version
	CALL GETPAG		;(P1/T1) Map in page containing FDB
	 RET			;Error
	LOAD P1,FBEXL,(T1)	;Step to next FDB in this chain
	JUMPN P1,GX.NE		;Back if still more
	 RET			;File not found
GX.NV:	CALL GETPAG		;(P1/T1) Map in page containing FDB
	 RET			;Return if not there
;	LOAD T1,FBGEN,(T1)	;Get generation number
;	SKIPE FNDSTV		;Is most recent version wanted?
;	CAMN T1,FNDSTV		;Is it what we want?
	JRST GX.DON		;Yes - exit
GX.NV1:	CALL GETPAG		;(P1/T1) Map in page containing the FDB
	 RET			;Can't do it
	LOAD P1,FBGNL,(T1)	;Step to FDB of next generation
	JUMPN P1,GX.NV		;Jump if more to try
	RET			;Not found
;Here when we have found the file that we wanted, P1/ FDB offset

GX.DON:	CALL GETPAG		;(P1/T1) Map in page containing FDB
	 RET			;Error
	LOAD T2,FBCTL,(T1)	;Get control bits
	TXNE T2,FB%DEL!FB%NXF	;Does it exist?
	JRST GX.NV1		;No, go get another then
	LOAD T4,FBBYV,(T1)	;Yes, get page count
	HRRZM T4,DEXEPC		;Remember it
	SETOM XBNUM		;Initialize XB number to short file
	LOAD P5,FBADR,(T1)	;Get adr of index block
	TXNN T2,FB%LNG		;Long file?
	JRST GX.DN1		;No, just read in index block 0
	MOVE P4,SXBADR		;Long file, read in the super index block
	CALL REDPAG		;(P4,P5/) into SXBADR
	 RET			;Error reading page
	LOAD P5,STGADR,@SXBADR	;[7.1215] Get adr of first index block
	JUMPE P5,R		;If no page 0, format error
	SETZM XBNUM		;Mark that index block 0 is mapped
GX.DN1:	MOVE P4,XBADR		;Read into XB area
	JRST REDPAG		;(P4,P5/) Read the page and return +1 or +2

;Small routine called from above to read first page of directory
;Returns +1 if no error
;Returns +2 if error

DIRMAP:	MOVE P4,DDPADR		;Get address for directory header
	MOVE P5,@XBADR		;Get disk address for first page of dir
	JRST REDPAG		;(P4,P5/) Read the page return +1 or +2
	SUBTTL Dump Memory -- Find Files -- Map Disk Address

;Routine to map a page of the directory
;Accepts in P1/ address to map
;	CALL GETPAG
;Returns +1 with T1/ mapped address
;                P5/ current page in file

GETPAG:	MOVE P4,DHPADR		;Get address of directory data page
	HRRZ T1,P1		;Get address desired from file
	LSH T1,-^D9		;Convert address to page number
	ADD T1,XBADR		;Get address of XB
	LOAD P5,STGADR,@T1	;[7.1244] Get disk address of file page
	SKIPN P5		;[7.1244] Skip if a real address
	DOBER(<Bad disk address while searching directory>) ;[7.1244] Owie dir
	TLZ P5,DSKMSK		;Unwanted bits
	CAMN P5,CURPAG		;Desired page already in core?
	JRST GETPG1		;Yes, do not need to read again
	CALL REDPAG		;(P4,P5/P4) No, read the page
	 RET			;Can't read directory page
GETPG1:	LDB T1,[POINT 9,P1,35]	;Get low order bits of original address
	IOR T1,DHPADR		;Add address of directory data page
	MOVEM P5,CURPAG		;Update currently in-core page
	RETSKP			;Return
	SUBTTL Dump Memory -- Find Files -- Find FDB

;Subroutine to do a primary name search in a directory
;Call with byte pointer to filename in FNDSTN
;Returns +1 if error
;        +2 with P1/ offset to FDB for that file

FIND:	MOVE T1,DDPADR		;Get address of Directory data page
	ADDI T1,SYMBOT		;Add in offset to bottom of symbol table
	MOVE T1,@T1		;Get address of bottom of S.T.
	MOVE Q2,DDPADR		;Dir data page address again
	ADDI Q2,SYMTOP		;Pointer to top of S.T.
	MOVE Q2,@Q2		;Get address of top
	MOVEM T1,P1		;Store address of bottom of S.T.
	SUB T1,Q2		;Get -length of S.T.
	ADDI P1,2		;Build a relocate
	HRLI P1,2(T1)		;AOBJN pointer

FND.NF:	MOVE Q2,FNDSTN		;File name
	CALL GETPAG		;(P1/T1) Map in page containing s.t. entry
	 RET			;Error in GETPAG
	LOAD Q3,SYMET,(T1)	;Get symbol type
	JUMPN Q3,R		;Return if not zero
	LOAD Q3,SYMVL,(T1)	;Get first five chars of name
	CAME Q3,@FNDSTN		;Is this a match against string?
	JRST FND.NM		;No, no need to compare name string
	LOAD Q3,SYMAD,(T1)	;Get FDB address
	PUSH P,P1		;Save pointer into symbol table
	MOVE P1,Q3		;Get address of FDB
	CALL GETPAG		;(P1/T1) Map in page containing FDB
	 JRST FND.EG		;If error, restore P1 and return
	POP P,P1		;Restore symbol table pointer
	LOAD Q3,FBNAM,(T1)	;Get address of name string block
	HRLI Q3,(POINT 7,0)	;Set up string pointer
	ADDI Q3,1		;Point to string
	CALL STRCMP		;(Q2,Q3/) Compare strings
	 RET			;Return if failure
	CALL GETPAG		;Map in page containing s.t. entry
	 RET			;Couldn't
	HRRZ P1,@T1		;Get first file FDB
	RETSKP			;Success

FND.EG:	POP P,P1		;Restore P1
	RET			;Return +1

FND.NM:	ADD P1,[1,,1]		;No match, step over symbol value
	AOBJN P1,FND.NF		;Loop for more
	RET			;No more names, error
	SUBTTL Dump Memory -- Find Files -- String Comparison

;String compare subroutine
;Call with Q2/ address of ASCIZ string
;          Q3/ address of another ASCIZ string
;Returns +1 if no match
;        +2 if match

STRCMP:	PUSH P,P1		;Save P1
	MOVE P1,Q3		;Copy address of string in file
	CALL GETPAG		;(P1/T1) Map page containing string block
	 JRST FND.EG		;Error in GETPAG, restore P1 and return
	POP P,P1		;Restore P1
	HRRI Q3,0		;Zero out RH of byte pointer
	TLO Q3,T1		;Make it use an (T1), in case
				; string is in another section

STRCM1:	ILDB T3,Q2		;Get 1st byte
	ILDB T2,Q3		;Get 2nd byte
	CAME T3,T2		;Equal?
	RET			;no - lose
	JUMPN T3,STRCM1		;Yes, loop if not at end of string
	RETSKP			;Skip return, they match
	SUBTTL Subroutines -- Page Fault Handler

;Routine to store the address of the page fault handler at entry
;and to setup a new one to handle PFs while DOB is running

PFHSET:	MOVE T1,UPTPFN		;Get old PF handler
	MOVEM T1,OLDPFH		;Store it
	XMOVEI T1,PFH		;Get address of new one
	MOVEM T1,UPTPFN		;Store it for while we are running
	RET			;And done

PFHRST:	SKIPE T1,OLDPFH		;Get address we stored 
	MOVEM T1,UPTPFN		;Put it back - if it isn't zero
	RET

;Routine to handle Page faults while DOB is running

PFH:	PUSH P,T1		;Save it
	HRRZ T1,UPTPFO		;Get P.C. of fault
	CAIE T1,CHKAD		;Is it an expected one?
	JRST PFH1		;No - report it
	SETOM PFFLG		;Notify CHKADR routine that it page faulted
	POP P,T1		;Restore it
	JRST CHKCNT		;And continue CHKADR

;Here to report an unexpected page fault and return to caller

PFH1:	CALL DOBERP		;[7.1215] () Output standard error prefix
	DOBMS(<Page Fault while taking continuable dump at >)
	MOVE T1,UPTPFO		;Get page fail PC
	CALLX (MSEC1,DOBNO)	;(T1/) Print it
	MOVEI T2,[ASCIZ/, PFW /] ;Load label for page fault word
	CALL DOBMES		;(T2/) Print it
	MOVE T1,UPTPFW		;Get the page fail word
	CALLX (MSEC1,DOBNO)	;(T1/) And print that too
	JRST DOBABT		;[7.1215] Abort before screwing up disk more
	SUBTTL Subroutines -- Checksumming

;Routine to generate a checksum of the DOB code area.  This routine returns the
;checksum of all of the code from locations STCHK through ENDCHK.
;Returns +1 Always
;	 T2/ Checksum

CHKCOD:	MOVSI T1,<-<ENDCHK-STCHK>> ;Get -ive words,,0
	SETZ T2,		;Use T2 to accumulate checksum

CHKLUP:	ROT T2,1		;Rotate the bits around
	ADD T2,STCHK(T1)	;Add in next word
	AOBJN T1,CHKLUP		;And loop
	RET			;Return with checksum in T2
	SUBTTL Subroutines -- Virtual to Physical Address

;GETPHY - Routine to translate from a virtual address to physical
;Accepts P4/ Virtual address
;Returns +1  Virtual address is illegal
;	 +2 P4/ Physical address

GETPHY:	MAP P4,(P4)		;Get physical address of page
	TXNN P4,TWHPFF		;Hard failure?
	TXNN P4,TWVALD		;Valid?
	RET			;Yes/No - can't read the page
	ANDX P4,TWVADR		;Keep only bits we need
	RETSKP			;Success
	SUBTTL Subroutines -- Read and Write Pages

;Routine to read a page from the disk. This routine will wait until
;the page has been successfully read into memory before returning
;control to the caller
;Call with P5/ Disk address to read
;          P4/ Virtual address to read into
;Returns +1 if error
;	 +2 if success, P4/ address of IORB

REDPAG:	CALL GETPHY		;(P4/P4) Get a physical address
	 RET			;Illegal address
	MOVEI T1,IRFRED		;Function is READ
	MOVEI T2,1		;Say we want to read 1 page
	CALL DOIO		;(T1,T2,P4,P5/T1) Do it	
	CALL IRBWAT		;(T1/) Go wait for successful completion
	 RET			;Error on this IORB (timeout)
	RETSKP			;Success

;Routine to write a set of contiguous pages to the disk.  This routine
;will queue the I/O and then return control to the caller.  Any errors
;on the xfer will be noted when the I/O completes.
;
;Call with T2/ Count of contiguous pages to write
;          P5/ Disk address to write
;          P4/ Address in memory of data
;Returns +1 always, I/O has been queued
;	   T1/ Address of IORB

WRTPAG:	MOVEI T1,IRFWRT		;Function is WRITE
	CALL DOIO		;(T1,T2,P4,P5/T1) Do it
	RET			;Done

;Routine to queue up a write and wait for successful completion
;before returning control
;Call with T2, P4, P5 set up for WRTPAG
;Returns +1 if error
;        +2 if success

WRTWAT:	CALL WRTPAG		;(T2,P4,P5/T1) Queue the I/O
	CALL IRBWAT		;(T1/) Wait for completion
	 RET			;Owie
	RETSKP			;Success
;Routine to Queue the I/O
;Arguments: T1/ Function (read/write) 
;	    T2/ Count of pages
;	    P4/ Physical page number
;	    P5/ Disk address
;Returns +1 T1 and P4/ Address of IORB

DOIO:				;[7.1254] Here to perform IO for DOB
IFN FTDT,JFCL			;[7.1254] Patch to "CALL DTRACE" for trace 
	CALL CCWSET		;(T1,T2,P4/P4) Go setup IORB, CCW list
	CALL UDBSET		;[7.1215] (P4,P5/T2) Get UDB address in T2
	MOVE T1,P4		;Get IORB address
	CALLX (MSEC1,PHYSIO)	;(T1,T2/) Queue the I/O
	MOVE T1,P4		;[7.1215] Get back IORB address
	RET			;Done

IFN FTDT,<			;[7.1244] Set FTDT nonzero to enable trace
;[7.1244] Trace routine for DOIO
;Arguments: T1/ Function (read/write) 
;	    T2/ Count of pages
;	    P4/ Physical page number
;	    P5/ Disk address
;Returns: +1 always

DTRACE:	SAVET			;Save some ACs
	STKVAR <PCOUNT>		;Place to store count
	MOVEM T2,PCOUNT		;Since we made a place, put the count there
	CAIN T2,1		;One page transfer size?
IFN FTDT-1,RET			;[7.1254] Set FTDT to 1 to enable single page
IFE FTDT-1,JFCL			;[7.1254] typeout and allow patching if not 1
	CAIN T1,IRFRED		;Reading today?
	SKIPA T2,[EXP [ASCIZ/Read count /]] ;Yep
	MOVEI T2,[ASCIZ/Write count /] ;Nope
	CALL DOBMES		;(T2/) Output that
	MOVE T1,PCOUNT		;Reload count
	CALLX (MSEC1,DOBNO)	;(T1/) Output that number
	DOBMS(< memory page >)	;Label the number next
	MOVE T1,P4		;Load pages
	CALLX (MSEC1,DOBNO)	;(T1/) Output that number
	DOBMS(< disk address >)	;Output label
	MOVE T1,P5		;Load disk address
	CALLX (MSEC1,DOBNO)	;(T1/) Output that number
	DOBMS(<
>)				;Output CRLF
	RET			; and return
>				;End of IFN FTDT
	SUBTTL Subroutines -- Read and Write Pages -- Setup CCW List

;Routine to setup the CCW list
;Arguments: T1/ Function (read/write) 
;	    T2/ Count of pages
;	    P4/ Physical page number
;Returns +1 P4/ Address of IORB

CCWSET:	STKVAR <CIORB>		;[7.1215] Place to stash IORB
	CALL GTIORB		;(/T3) Get an IORB (returns address in T3)
	MOVEM T3,CIORB		;[7.1215] Store the IORB address
	STOR T1,ISFCN,(T3)	;Store function
	MOVEI T1,IRMWRD		;Say word mode
	STOR T1,IRBDM,(T3)	;Store it in IORB
	MOVEI T1,IORBDN		;Address of termination routine
	HRRZM T1,IRBIVA(T3)	;Store it and zero out STRTIO call
	IMULI T2,PGSIZ		;Make it word count
	MOVEM T2,IRBCNT(T3)	;Store it in IORB
	HRRZ T3,IRBXFL(T3)	;Get address of CCW list for this IORB
	MOVE T1,P4		;Get memory address
	JUMPE T1,CCW.P0		;Handle separately if for page 0
	TXO T1,1B0		;Setup Channel jump (xfer - don't halt)
CCW.LP:	MOVEM T1,@T3		;Store address and opcode
	CAIGE T2,XFRSIZ		;Do we have more than 1 xfer's worth?
	SKIPA T4,T2		;No - use only what we have left
	MOVEI T4,XFRSIZ		;Yes - use max size
	SUB T2,T4		;Number of words remaining	
	DPB T4,[POINT 11,@T3,13] ;Put it into the IOWD
	ADD T1,T4		;Increment memory address
	AOS T3			;Point to next word in CCW list
	JUMPN T2,CCW.LP		;Any more to do?
CCW.EX:	SETZM @T3		;Add halt word at end to be sure
	MOVE P4,CIORB		;[7.1215] Get IORB address to P4
	HRLM T3,IRBXFL(P4)	;Store end of CCW list
	RET			;Return with IORB address in T1

CCW.P0:	MOVX T1,1B0+<<LCORAD>B13> ;Setup skip word
	MOVEM T1,@T3		;Store it
	AOS T3			;Point to next CCW word
	SUBI T2,LCORAD		;Subtract first 20 words from word count
	ADDI T1,LCORAD		;Change starting address to skip these words
	JRST CCW.LP		;And continue inline

	ENDSV.			;[7.1215] End of STKVAR
	SUBTTL Subroutines -- Read and Write Pages -- Get UDB Address

;Routine find the UDB for this transfer.  This routine checks the disk address,
;stores the disk address for a unit in the IORB, and returns the unit number in
;T2.  The dump is aborted if the disk address or UDB is illegal.
;
;Call with: P4/ IORB address
;	    P5/ Disk address
;Returns +1 T2/ UDB address, P4 and P5 unchanged
;	    Disk address is set in the IORB

UDBSET:	MOVE T1,SDBADR		;Get SDB address
	MOVE T2,P5		;Disk address
	TLZ T2,DSKMSK		;Keep just the address bits
	IDIV T2,SDBSIZ(T1)	;Compute which unit that address is on
	MOVEM T3,IRBADR(P4)	;[7.1215] Store unit's disk address in IORB
	CAML T2,SDBNUM(T1)	;[7.1215] Is this a legal unit number?
	DOBER(Illegal address in index block) ;Owie index block
	ADDI T2,SDBUDB(T1)	;[7.1215] Compute UDB address in SDB
	SKIPN T2,(T2)		;[7.1215] Get the UDB address from the SDB
	DOBER(Illegal UDB address in SDB) ;No UDB address
	TLZ T2,-1		;Mask out flags
	RET			;Done
	SUBTTL Subroutines -- Read and Write Pages -- Get Free IORB

;Routine to return a free IORB
;Call with no arguments
;Returns +1 always, T3/ IORB address

GTIORB:	PUSH P,T1		;Save T1
	MOVEI T1,2000		;[7.1254] Need a long counter for RA81s
GTI.LP:	CHNOFF (PHYCHN)		;No interrupts
	SKIPE T3,FREIRB		;Is there a free IORB?
	JRST GTI.ZR		;Yes, clean it up before returning
	CHNON (PHYCHN)		;Back on
	MOVEI T3,5000		;Setup a timer
	SOJG T3,.		;Twiddle our thumbs
	SOJG T1,GTI.LP		;Have to free one up eventually
	DOBER(No IORB available) ;This should not happen

GTI.ZR:	MOVE T1,(T3)		;Get address of next IORB in list
	MOVEM T1,FREIRB		;And put it on front of list
	CHNON (PHYCHN)		;We're back
	PUSH P,T3		;Save address of IORB
	SETZM (T3)		;Zero out some words before returning
	SETZM IRBMOD(T3)
	SETZM IRBCNT(T3)
	SETZM IRBIVA(T3)
	SETZM IRBADR(T3)
REPEAT 0,<
;This code zeroes out the CCW list - not necessary OR desirable 
	SETZM T1
	HRLM T1,@IRBXFL(T3)	;Zero LH of pointer
	MOVE T1,IRBXFL(T3)	;Get address of CCW list
	HRLS T1			;Get address
	AOS T1			;  plus one in RH
	SETZM @IRBXFL(T3)	;Zero out first word
	MOVE T3,IRBXFL(T3)	;Get address of CCW again
	ADDI T3,CCWSIZ-1	;Setup end of BLT
	BLT T1,@T3		;Do it
>
	POP P,T3		;Get back address of IORB
	POP P,T1		;Restore T1 at call
	RET
	SUBTTL Subroutines -- Read and Write Pages -- Wait for IORB Completion

;Routine to wait for completion of a specific IORB
;Call with T1/ Address of IORB
;Returns +1 if IORB timed out or had an error
;Returns +2 if IORB completed 

IRBWAT:	MOVX T2,50000000	;A very long timer
IRB.LP:	SKIPG IRBIVA(T1)	;Has it completed?
	JRST IRB.CK		;Yes - check for errors
	SOJG T2,IRB.LP		;Try again	
	RET			;Say IORB timed out

IRB.CK:	SKIPL IRBIVA(T1)	;Was there an error on the xfer?
	RET			;Yes - say so
	RETSKP			;No - success

;[7.1254] Routine to wait for IO to finish at the end of the dump.
;Returns+1: always

WAITIO:	MOVEI T2,10000		;Number of times to check all IORBs
WAITI1:	MOVSI T1,-NUMIOR	;Get AOB pointer for pool
WAITI2:	SKIPLE IORBPL+IRBIVA(T1) ;Has this one completed?
	JRST WAITI3		;Nope, wait a bit
	ADDI T1,IRBLEN-1	;Point to next one
	AOBJN T1,WAITI2		;And loop for all of them
	RET			;Return
WAITI3:	SOJG T2,WAITI1		;Try looking again
IFN FTDT,<			;Only if trace on
	DOBMS(<[IORBs still active]
>)				;Shouldn't happen
>				;End of IFN FTDT
	RET			;Return anyway
	SUBTTL Subroutines -- Read and Write Pages -- IORB Done

;Routine to handle a done interrupt for the IORBs.  This routine must be in
;RESCD as PHYSIO calls it with the 18 bit address in IRBIVA.  Expects address
;of interrupting IORB in T1, returns +1 always.  Only called at interrupt level
;so does nothing to interlock list.  If there is a dump in progress, and the
;IORB had an error, and the function was a write, and this is the first write
;with an error, save the address of the offending IORB for later and light the
;error bit in DOBSTS.

	RESCD			;Get to section 0/1

IORBDN:	MOVE T2,IRBSTS(T1)	;Load the IORB status
	SETOM IRBIVA(T1)	;Assume that there was success
	LOAD T3,ISFCN,(T1)	;[7.1254] Load the offending function
	MOVE T4,DOBSTS		;[7.1254] Load DOB status word
	TXNE T4,DB%DIP		;[7.1254] Is there a dump in progress and
	TXNN T2,IS.ERR		;[7.1254]  was there an error on this xfer?
	IFSKP.			;[7.1254] Dump in progress and error seen
	  SETZM IRBIVA(T1)	;[7.1254] Indicate that there was an error
	  CAIE T3,IRFRED	;[7.1254] Is the function a write
	  TXOE T4,DB%ERR	;[7.1254]  and this is the first error seen?
	  ANSKP.		;[7.1254] First write error seen in this dump
	    MOVEM T4,DOBSTS	;[7.1254] Store new DOBSTS with error bit lit
	    HRRZM T1,ERIORB	;[7.1254] Save the IORB with the error
	    TXNN T2,IS.RTL!IS.DVE!IS.DTE!IS.WGU ;[7.1254] Any error bit set?
	    HRROS ERIORB	;[7.1254] Nope, flag this for later
	ENDIF.			;Now release the IORB
	MOVE T2,FREIRB		;Get head of list
	MOVEM T2,(T1)		;Make this one point to previous head
	MOVEM T1,FREIRB		;Add new head
	RET			;And done

	XRESCD			;Back to XCDSEC for a little while
	SUBTTL Subroutines -- Read and Write Pages -- IORB Error

;[7.1254] Here with an I/O error to be reported, pointed to by ERIORB.
; If ERIORB is 0, there was an unknown error.
; If ERIORB is positive it is the address of the IORB that caused the error.
; If ERIORB is negative then the IORB with IS.ERR on had no error bits set.

IORBER:	CALL DOBERP		;() Start standard DOB error string
	DOBMS(<Error while writing dump>) ;Deliver the unhappy news 
	SKIPN T4,ERIORB		;Do we have an IORB that erred?
	IFSKP.			;Yes, more info to type out
	  TLZE T4,-1		;No error bits set in this IORB?
	  DOBMS(< no error bits set in IORB,>) ;Nope
	  DOBMS(< from physical address >) ;Label the next 
	  HRRZ T1,IRBXFL(T4)	;Get start of CCW
	  LDB T1,[POINT 22,@T1,35] ;Get address part of first one
	  CALLX (MSEC1,DOBNO)	;(T1/) Output that number
	  DOBMS (< page count >) ;Output label for next string
	  LDB T1,[POINT 9,IRBCNT(T4),26] ;Get page count from IORB
	  CALLX (MSEC1,DOBNO)	;(T1/) Output number there too
	ENDIF.			;End of IORB error typeout code
	JRST DOBABT		; and abort the dump
	SUBTTL DOB Message Printing Routines -- Error Messages

;Routine to output error string from DOB
;Call with CX/ address of ASCIZ string
;Never returns, cancels continuable dump instead.

DOBERR:	MOVEI T4,(CX)		;Copy error address here
	CALL DOBERP		;[7.1215] () Output error prefix
	MOVE T2,T4		;Get address of the error string
	CALL DOBMES		;(T2/) Output it
				;[7.1215] Fall thru to DOBABT

;[7.1215] Here to give a message then abort the dump in progress

DOBABT:	DOBMS(<

[DOB: Aborting dump]
>)				;[7.1215] Indicate we are aborting the dump
	JRST DOBEXI		;Clean up and return to APRSRV

;Here to print the error prefix for DOB errors
;Returns +1 always

DOBERP:	JSP CX,DOBMCX		;[7.1215] Output the following message
	BYTE(7).CHCRT,.CHLFD,.CHBEL,.CHBEL,.CHBEL ;[7.1215]
	ASCIZ /? DOB Error: /	;[7.1215] 
	SUBTTL DOB Message Printing Routines -- XRESCD Routines

;Small routine to output ASCIZ string on the CTY
;Call at DOBMES with T2/ address of message
;Call at DOBMCX with CX/ address of message
;Returns: +1 always

DOBMCX:	MOVEI T2,(CX)		;Copy the string argument to T1
DOBMES:	HRLI T2,(POINT 7)	;Make a 7-bit local byte pointer
DOBMLP:	ILDB T1,T2		;Get a byte in T1
	JUMPE T1,R		;Return if a null seen
	CALLX (MSEC1,DOBTYO)	;(T1/) Output a character 
	JRST DOBMLP		;Loop for more characters

;Small routine to output a sixbit word on the CTY
;Call with T2/SIXBIT word
;Returns +1 always

DOBMS6:	MOVE T4,[POINT 6,T2]	;Point to the SIXBIT string
	SETZ T3,		;Insure the word after T2 is zero
DOBMSL:	ILDB T1,T4		;Get a character
	JUMPE T1,R		;Jump if a SIXBIT space seen
	ADDI T1,"A"-'A'		;Convert to ASCII
	CALLX (MSEC1,DOBTYO)	;(T1/) Output the character
	JRST DOBMSL		;Loop for all of them
	SUBTTL DOB Message Printing Routines -- RESCD Routines

	RESCD			;Back to section 0/1

;Small routine to output a character to the CTY
;Call from XCDSEC "CALLX (MSEC1,DOBTYO)", with T1/character
;Returns +1 always

DOBTYO:	JSR BUGTYO		;(T1/) Output character to CTY
	RET			;Return back

;Small routine to output a number using the BUGNO routine.
;Call from XCDSEC "CALLX (MSEC1,DOBNO)", with T1/number
;Returns +1 always

DOBNO:	JSR BUGNO		;(T1/) Output the number
	RET			;Return

;Small routine to enter secondary protocol
;Call from XCDSEC "CALLX (MSEC1,DOBSEC)"
;Returns +1 always

DOBSEC:	JSR BUGMON		;() Enter secondary protocol
	RET			;Return

;Small routine to enter primary protocol
;Call from XCDSEC "CALLX (MSEC1,DOBPRI)"
;Returns +1 always

DOBPRI:	JSR BUGPRI		;() Enter primary protocol
	RET			;Return

	XRESCD			;Back to extended resident code
	SUBTTL End of checksummed code

;This must be at the END of the DOB code so CHKCOD can checksum the code
;in XRESCD including the literal pool for XRESCD.

DOBLIT:	XLIST			;LIT follows
	LIT
	LIST			;Resume listing after LIT

	ENDCHK==.		;Last location to be checksummed

	TNXEND
	END