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