Directory of image this file is from
This file as a plain text file

/CRASH DUMP PROGRAM BEGINS HERE
/RESTART ALWAYS AT LOCATION 200
/THIS IS THE PROGRAM THAT NEEDS TO BE LOADED AFTER A TSS/8
/SYSTEM CRASH TO SAVE THE STATUS OF THE SYSTEM ON DTA0.
/THIS IS TO RESTORE WHAT WAS DELETED FROM 8.21D TO 8.22B
/THIS RUNS IN FIELD 3 TO NOT DISTURB FIELD ONE.
/IT SAVES CORE ON THE DISC AND LOADS THE CRASH
/DUMP PROGRAM (WHICH IS ALSO FIELD 3 RESIDENT HEREIN)
*1000
	CLA CLL
	IOF
	CDF		/OLD VERSION (NOT NEEDED)
	TAD X10
	6615		/LOAD FIELD TO SWAP
	CLA CLL IAC
	RTL
	6643		/LOAD DISK TRACK ADDRESS
	TAD X6605
	JMS XQ
	JMP I (200)
XQ,	0
	DCA XQX
	CLA CMA
	DCA I X7751
	TAD X7000
	DCA I X7750
	CML IAC
	RTR
	CML IAC
	RAR
XQX,	0
	6623
	JMP .-1
	6621
	JMP I XQ
	TAD XQX
	RTR
	JMP XQ+2
X10,	10
X6605,	6605
X6603,	6603
X0200,	200
X7000,	7000
X7750,	7750
X7751,	7751
/CRASH DUMP PROGRAM BEGINS HERE
/RESTART ALWAYS AT LOCATION 200
*0
/THIS IS PAGE ZERO FOR THE DUMPER
*10
QAX0,	0
QAX1,	0

*20
QWS0,	0
QWS1,	0
QWS2,	0
QWS3,	0
QWS4,	0
QWS5,	0
QWS6,	0
QWS7,	0

*30
QWBLK,	0
QWFLD,	0

QRTRK,	0
QRADR,	0

QDTRK,	4
QDADR,	7000

QXFLD,	-40
QXTBK,	7745

QPARA,	50
QF1,	41

WTX,	400
RDX,	515
SPX,	600

WTAPE=JMS I WTX
RDISK=JMS I RDX
SPEAK=JMS I SPX
*200
	IOF		/JUST IN CASE
	CLA CLL
	TAD (600)
	DTCA DTXA	/START UP DECTAPE
	DCA QWBLK	/FIRST BLOCK TO WRITE IS ZERO
	CLA CMA
	DCA QWS2	/WRITE OUT RESTORE PARAMETERS IN PAGE ZERO
	TAD (10)
	DCA QWFLD
	CLA CMA
	DCA QWS3	/WRITE ONLY BLOCK ZERO
	WTAPE
	TAD (-40)
	DCA QWS3	/SET WRITE LENGTH
	DCA QWFLD	/WRITE FIELD ZERO ON TAPE
	CLA CMA
	DCA QWS2	/RESET CA POINTER
	WTAPE
	TAD QDADR
	DCA QRADR	/POINTER TO 1K DISK AREA TO READ
	TAD QDTRK
	DCA QRTRK
	RDISK
	TAD QF1
	DCA QWBLK	/SAVE BLOCK POINTER
	TAD (-4)
	DCA QWS3	/NUMBER OF PAGES TO WRITE
	WTAPE
	TAD (10)
	DCA QWFLD
	TAD (-34)
	DCA QWS3
QMEND,	WTAPE
	TAD QWFLD
	TAD (10)
	DCA QWFLD	/NEW FIELD POINTER
	TAD (-40)
	DCA QWS3
	TAD QWFLD	/TEST FOR END OF MEMORY
	TAD QXFLD
	SPA CLA
	JMP QMEND	/CONTINUE DUMP
QMEMX,	TAD (20)
	DCA QWFLD	/RESET COPY FIELD
	TAD (-37)
	TAD QWBLK
	DCA QWS6
	DCA QRADR
	DCA QRTRK	/CLEAR DISK ADDRESS
	TAD QXTBK	/SET UP COUNTER
	DCA QWS7
QDSKD,	JMS QADVB
	RDISK
	WTAPE
	ISZ QRTRK	/NEXT 4K BLOCK
	ISZ QWS7	/DONE?
	JMP QDSKD
	DTCA		/STOP TAPE
	CLA CLL CML RTL	/LOAD 2
	DCA QRTRK	/READ TRACK 2
	TAD QCORM
	CLL RAR
	DCA QWFLD	/READ INIT INTO FIELD ZERO
	RDISK
	6213		/CIF CDF FIELD ONE
	JMP I (4200)
QCORM,	CORMEM
QADVB,	0
	CLA
	TAD QWS6
	TAD QPARA	/PARAMETER TELLS HOW MANY BLOCKS TO SKIP
	DCA QWBLK
	TAD QWBLK
	DCA QWS6
	TAD (-40)
	DCA QWS3
	JMP I QADVB
*400
/DECTAPE DUMP ROUTINE

/THIS SUBROUTINE DUMPS ONE MEMORY FIELD ON 40
/DECTAPE BLOCKS, ONE PAGE PER BLOCK.


WTENT,	0
	CDF
WTX1,	CLA CLL CMA RTL
	DCA QWS0
	CLA CLL CMA RTL
	DCA WX
	DTRA
	AND (7174)
	DTXA		/CLEAR STATUS REGISTER A
	DTLB		/CLEAR FIELD BITS
	TAD WTWC
	DCA I WTCA
WTX2,	DTRA
	TAD (210)	/EXTABLISH SEARCH GO MODE
	AND (210)
	JMP WTX4

WTX3,	SNL		/TEST FOR DIRECTION CHANGE
	JMP WTX5
WTX4,	JMS WTOPR
	DTRA
	RTL
	RTL
	SZL CLA		/PUT DIRECTION BIT IN LINK
	TAD (2)
	TAD I WTWC	/LAST BLOCK SEEN	
	CMA
	TAD QWBLK	/BLOCK TO FIND
	CMA
	SZA CLA
	JMP WTX3	/CONTINUE SEARCH
	SZL		/CHECK DIRECTION
	JMP WTX3+1	/CHANGE DIRECTION TO FORWARD
	TAD QWFLD	/SET FIELD BITS
	DTLB
	TAD (7600)
	DCA I WTWC	/TRANSFER 200 WORDS
	TAD QWS2
	DCA I WTCA
	TAD (50)
	JMS WTOPR
	TAD (40)
	DTXA
	TAD I WTCA
	DCA QWS2	/RESAVE CA
	ISZ QWBLK
	ISZ QWS3
	JMP WTX1
	JMP I WTENT	/NORMAL EXIT
WTX5,	TAD (400)
	ISZ WX
	JMP WTX4
	JMP WT01
/THIS SUBROUTINE PERFORMS A DTXA
/AND WAITS FOR COMPLETION OF OPERATION.
WTOPR,	0
	DTXA
	DTSF DTRB
	JMP .-1
	SMA CLA
	JMP I WTOPR	/NORMAL EXIT
	DTRB
	RTL
	RAL
	SPA CLA		/SELECT ERROR?
	JMP WTSELC	/YES
	SZL		/END ZONE ERROR?
	TAD (400)	/YES... CHANGE TAPE DIRECTION
	DTXA
	ISZ QWS0	/INCREMENT ERROR COUNT
	JMP WTX1+2
WT01,	SPEAK		/PANIC BUTTON
	WTHELP-1
	JMP I (200)
WTSELC,	SPEAK
	WTSMS-1
	JMP WTX1
/ADDRESS POINTERS
WTWC,	7754
WTCA,	7755
WX,	-1
/THIS ROUTINE READS ALL OR PART
/OF A 4K DISK TRACK.

/RF08 DISK IOTS
	DMAR=6603	/LOAD DISK MEMORY ADDRESS AND WRITE
	DIML=6615	/LOAD ETENDED MEMORY SELECT
	DISC=6623	/SKIP IF ERROR OR COMPLETION FLAG SET
	DFSE=6621	/SKIP IF ERROR FLAG SET
	DXAL=6643	/LOAD SIK EXTENDED ADDRESS REGISTER
	CORMEM=30



RDENT,	0
	CLA CLL CMA RTL
	DCA QWS0	/RESET ERROR COUTER
	CDF
RDX1,	CLA CMA
	DCA I RDCA
	TAD QRADR	/DISK TRACK ADDRESS
	DCA I RDWC
	TAD QRTRK
	DXAL
	TAD QWFLD
	DIML
	TAD QRADR
	DMAR
	DISC
	JMP .-1
	DFSE
	JMP I RDENT	/ALL DONE OK
	ISZ QWS0
	JMP RDX1	/TRY AGAIN ON ERROR
	SPEAK		/CAN'T READ DISK
	RDHELP-1
	JMP I (200)
/ADDRESS POINTERS
RDWC,	7750
RDCA,	7751
PAGE
/THIS SUBROUTINE TYPES OUT A MESSAGE
/AND WAITS FOR A CHARACTER TO BE RETURNED.

SPENT,	0
	CLA CLL
	CDF+30
	TAD (215)
	JMS QTOUT
	TAD (212)
	JMS QTOUT
	TAD I SPENT
	DCA QAX0
SPLOP,	TAD I QAX0
	SNA
	JMP QTX
	JMS QTOUT
	JMP SPLOP

QTX,	KCC
	KSF
	JMP .-1
	KRB
	DCA QWS1
	TAD QWS1
	JMS QTOUT
	TAD QWS1
	TAD (-215)
	SZA CLA
	JMP QTX
	ISZ SPENT
	TAD (212)
	JMS QTOUT
	CDF
	JMP I SPENT

QTOUT,	0
	TLS
	CLA
	TSF
	JMP .-1
	JMP I QTOUT
/MESSAGES
RDHELP, "D;"F;215;212;0
WTHELP,	"B;"D;215;212;0
WTSMS,	"S;"E;"L;"E;"C;"T;215;212;0
*7770
ZBLOCK 7
$$$$$