/NORTH AMERICAN VERSION OF 
/FAILSAFE.	THIS PROGRAM
/PUNCHES OUT ALL BLOCKS CURRENTLY
/IN USE. THESE MAY BE READ IN
/USING THE SAME PROGRAM.
/ALL INFORMATION IS PUCNCHED AND READ 
/IN BLOCKS OF 201 WORDS EACH TO STAY
/COMPATIBLE WITH THE DEC SYSTEMS MONITOR
/
/
/SUBMITTED TO DECUS JULY, 1969.
/
/NOTE THAT THIS PROGRAM MAKES USE OF
/EAE.	IT IS EASILY MODIFIED FOR NON
/EAE USE
/
/
/
/
/
	*2
MA,	7751	/DISC MEM ADD LOCATION
WC,	7750	/WORD COUNT POINTER
CRLF,	CRLF1	/OUTPUT A CR AND LF
MSG,	MSG1	/POINTER TO MESSAGE ROUTINE
	*20
DISCR,	DISCR1	/READ A BLOCK INTO BUFF1-USE "BLOCK"
DISCW,	DISCW1	/WRITE A BLOCK FROM BUFF1
READB,	READB1	/READ PAPER TAPE INTO BUFF1
PUNCHB,	PUNCB1	/PUNCH THE CONTENTS OF BUFF1
TTIN,	TTIN1	/INPUT FROM TTY INTO "CHAR"
TTOUT,	TTOUT1	/OUTPUT A CHAR TO TTY
CHAR,	0
BLOCK,	0	/CURRENT SAM BLOCK FOR DISC ROUTINES
BLKSIZ,	201	/ONLY FOR COMPATIBILITY!
CNTR1,	0
PUNCH,	PUNCH1	/PUNCH A CHARACTER ON H.S. PUNCH
BUF1AD,	5777	/BEG ADDRS OF BUFF1-1
T1,	0	/TEMP STORAGE
CHECK,	CHECK1	/ADD (AC) TO CKSUM-RESTORE THE AC
LINK,	6200
PCHECK,	PCECK1	/PUNCH THE CHECKSUM AND TRAILER
SAMB,	6377	/BEG ADDRS OF SAM BLOCK-1
DNENT,	0	/CURRENT DN ENTRY
SERCHS,	SEARCH	/SEARCH SAM BLOCK-IF NONE ENTER 7777
TRK,	0
ADDRS,	0
READT,	READT1	/READ ONE FRAM OF TAPE, LEAVE IN CHAR
CKSUM,	0
HALT,	HALT1
/
/
	*200
BEG,	JMS I MSG
	TEXT <READ OR DUMP?<
	JMS I CRLF
	JMS I TTIN	/INPUT D OR R
	TAD CHAR
	CIA
	DCA CHAR
	TAD CHAR
	TAD ("D
	SNA CLA
	JMP I OPT1	/DUMP
	TAD CHAR
	TAD ("R
	SNA CLA
	JMP I OPT2
	JMS I MSG
	TEXT <THAT IS A NO-NO!<
	JMS I CRLF
	JMP BEG
OPT1,	DUMP
OPT2,	READ
CHECK1,	0	/FORM THE CHECKSUM ROUTINE
	DCA CK	/SAVE THE (AC)
	TAD CKSUM	/GET THE OLD CHECKSUM
	TAD CK	/FORM THE NEW
	DCA CKSUM
	TAD CK	/RESTORE THE AC
	JMP I CHECK1
CK,	0
PUNCB1,	0	/PUNCH THE (BUFF1)
	CLA CLL
	TAD BUF1AD
	DCA 11
	TAD (-201
	DCA CNTR1
PB1,	TAD I 11	/WE USE THE EAE!!!
	MQL
	SHL
	5
	JMS I CHECK
	JMS I PUNCH
	SHL
	5
	JMS I CHECK
	JMS I PUNCH
	ISZ CNTR1
	JMP PB1
	JMP I PUNCB1
	/
	*400
/
/
DUMP,	JMS I MSG
	TEXT <PRESS SPACE BAR TO START PUNCHING<
	JMS I CRLF
	JMS I HALT
DMPP,	CLA CLL
	PLS
	TAD (-50	/PUCNH SOME LEADER
	DCA CNTR1
LP40,	TAD (200
	JMS I PUNCH
	ISZ CNTR1
	JMP LP40
	DCA CKSUM	/CLEAR CHECKSUM
	TAD (177	/GET THE DN BLOCK
	DCA BLOCK	/OF THE DISC
	JMS I DISCR
	JMS I PUNCHB	/AND PUNCH IT
	TAD I LINK	/MORE DN ENTRIES?
	SNA CLA
	JMP EDN	/NO, GET SAM BLOCK
	TAD I LINK
	DCA BLOCK
	JMS I DISCR	/GET NEXT DN BLOCK
	JMS I PUNCHB	/PUNCH IT
	TAD I LINK
	SNA CLA		/ANY MORE?
	JMP EDN		/NO
	ISZ BLOCK	/YES
	JMS I DISCR
	JMS I PUNCHB	/THIS MUST BE THE LAST ONE
EDN,	JMS I PCHECK	/PUNCH CHECKSUM AND TRAILER
	JMP I .+1
	600
PCECK1,	0		/ROUTINE TO PUNCH
	CLA CLL		/CHECKSUM AND TRAILER
	TAD CKSUM	/THEN CLEAR CHECKSUM
	MQL
	SHL
	5
	JMS I PUNCH
	SHL
	5
	JMS I PUNCH
	TAD (-50
	DCA T401
LP401,	TAD (200
	JMS I PUNCH
	ISZ T401
	JMP LP401
	CLA CLL
	DCA CKSUM
	JMP I PCECK1
T401,	0
/
/
/
/
	*600
	TAD (200	/WE NOW PUNCH OUT
	DCA BLOCK	//STORE THE BLOCK NUMBER
	JMS I DISCR	/THE SAM BLOCK
	JMS I PUNCHB
	JMS I PCHECK	/WITH TRAILER
	TAD SAMB	/AND SAVE THE SAM BLOCK
	DCA 12
	TAD BUF1AD
	DCA 11
	TAD (-201
	DCA CNTR1
LP600,	TAD I 11
	DCA I 12
	ISZ CNTR1
	JMP LP600
	CLA IAC		/NOW FOR ALL THE REST
	DCA DNENT	/WE START WITH DN ENTRY 1
LP601,	JMS I SERCHS	/GET FIRST BLOCK
	TAD BLOCK	/FOR THIS ENTRY
	SPA CLA		/END OF DUMP IF NEG
	JMP I P604
LP603,	JMS I DISCR	/GET THE BLOCK
	JMS I PUNCHB
	TAD I LINK	/LAST FOR THIS ENTRY
	SNA
	JMP P602	/YES
	DCA BLOCK	/NO SET UP FOR NEXT BLOCK
	JMP LP603	/AND PUNCH IT
P602,	JMS I PCHECK	/PUNCH CHECKSUM
	JMS I HALT
	TAD (200	/THIS IS SO ONE
	PLS		/CAN ADVANCE TAPE MANUALLY
	CLA CLL
	TAD (-50
	DCA CNTR1
LP605,	TAD (200
	JMS I PUNCH
	ISZ CNTR1
	JMP LP605
	ISZ DNENT	/INCREMENT DN ENTRY
	TAD (-77	/LAST POSSIBLE ENTRY?
	TAD DNENT
	SZA CLA
	JMP LP601	/NO, LOOK FOR MORE
	JMP I P604
P604,	BEG
PUNCH1,	0		/PUNCH ONE SINGLE FRAME
	PSF
	JMP .-1
	PLS
	CLA CLL
	JMP I PUNCH1
DISCR1,	0		/READ A BLOCK OFF OF DISC
	CAM
	TAD BUF1AD
	DCA I MA
	TAD (-201
	DCA I WC
	TAD BLOCK
	MQL MUY
	201
	DCA TRK
	CLA CLL
	MQA
	IAC
	DCA ADDRS
	GLK
	TAD TRK
	DCA TRK
	CAM
	TAD TRK
	SHL
	5
	DEAL
	CLA CLL
	TAD ADDRS
	DMAR
	DFSC
	JMP .-1
	JMP I DISCR1
/
/
/
	*1000
SEARCH,	0		/ROUTINE TO FIND
	CLA CLL		/FISRT BLOCK OF 
SR1,	TAD (-200	/CURRENT DN ENTRY
	DCA CNTR1
	TAD SAMB
	DCA 11
	DCA BLOCK
LPSR1,	TAD I 11
	AND (77		/RIGHT SIDE FIRST
	CIA
	TAD DNENT
	SNA CLA
	JMP I SEARCH	/FOUND IT!!
	ISZ BLOCK	/NOT THIS ONE
	ISZ CNTR1
	JMP LPSR1	/TRY FOR	MORE
	TAD (-200
	DCA CNTR1
	TAD SAMB
	DCA 11
LPSR2,	TAD I 11	/LOOK ON LEFT 
	AND (7700	/HAND SIDE
	LSR
	5
	CIA
	TAD DNENT
	SNA CLA
	JMP I SEARCH	/FOUND IT!!
	ISZ BLOCK
	ISZ CNTR1
	JMP LPSR2	/TRY AGAIN
	ISZ DNENT	/NONE, SO TRY NEXT ONE
	TAD DNENT
	TAD (-77	/LAST POSSIBLE ONE?
	SPA CLA
	JMP SEARCH+1	/NO!
	CLA CMA		/YES, MAKE "BLOCK" NEGATIVE
	DCA BLOCK
	JMP I SEARCH	/AND RETURN
DISCW1,	0
	CLA CLL		/ROUTINE TO WRITE ON DISC
	TAD BUF1AD	/NOTE THE USE OF EAE
	DCA I MA
	TAD (-201
	DCA I WC
	TAD BLOCK
	MQL MUY
	201
	DCA TRK
	CLA CLL
	MQA
	IAC
	DCA ADDRS
	GLK
	TAD TRK
	DCA TRK
	CAM
	TAD TRK
	SHL
	5
	DEAL
	CLA CLL
	TAD ADDRS
	DMAW
	DFSC
	JMP .-1
	JMP I DISCW1
/
/
/
	*1200
READ,	CLA CLL		/RREAD THE TAPE
	TAD (177	/FIRST GET THE DN BLOCK
	DCA BLOCK
P1201,	JMS I READB
	JMS I DISCW
	TAD I LINK	/MORE THAN ONE?
	SNA CLA
	JMP P1200	/NO
	TAD I LINK	/YES
	DCA BLOCK	/FIX UP BOCK
	JMP P1201	/AND GET THAT ONE
	DCA CKSUM
P1200,	JMS I READB	/GET THE SAM BLOCK
	TAD (-201
	DCA CNTR1	/BUT FIRST SAVE IT IN CORE
	TAD SAMB
	DCA 11
	TAD BUF1AD
	DCA 12
LP1201,	TAD I 12
	DCA I 11
	ISZ CNTR1
	JMP LP1201
	TAD (200
	DCA BLOCK
	JMS I DISCW	/NOW SAVE IT ON DISC
	CLA IAC
	DCA DNENT	/SET UP FOR FIRST DN ENTRY
LP1202,	DCA CKSUM
	JMS I SERCHS
	TAD BLOCK
	SPA CLA
	JMP LP1203	//YES
LP1205,	JMS I READB
	JMS I DISCW
	TAD I LINK
	SNA		/LAST OF THIS TAPE
	JMP LP1204	/YES
	DCA BLOCK	/GET THIS BLOCK THEN
	JMP LP1205
LP1204,	CLA CLL
	TAD CKSUM	/IS CHECKSUM OKAY?
	SZA
	JMP RDERR	/NO!!!!!
	JMS I HALT
	ISZ DNENT	/INCREMENT DN NUMBER
	JMP LP1202	/AND GET THE NEXT
LP1203,	CLA CLL		/FINISHED THE LOAD
	TAD (7576	/SET UP TO 
	DCA I WC
	TAD (7576	/GO TO THE MONITOR
	DCA I MA
	CLA CLL
	DEAL
	DMAR
	DFSC
	JMP .-1
	JMP I .+1
	7600
RDERR,	CLA CLL		/CHECKSUM ERROR WAS
	JMS I MSG	/DETECTED
	TEXT <CHECKSUM ERROR! BACK TAPE UP AND PRESS SPACE BAR<
	JMS I CRLF
	JMS I HALT
	JMP LP1202
/
/
/
	*1400
READB1,	0
	TAD BUF1AD
	DCA 11
	TAD (-201
	DCA CNTR1
LP1400,	JMS I READT
	TAD CHAR
	TAD (-200
	SNA CLA
	JMP LP1400
	CAM
	TAD CHAR
	JMS I CHECK
	LSR
	5
	JMS I READT
	TAD CHAR
	JMS I CHECK
	MQA
	DCA I 11
	ISZ CNTR1
	JMP LP1400
	TAD I LINK	/END OF THIS DN ENTRY
	SZA CLA
	JMP I READB1	/NO, GET CHECK SUM
	JMS I READT	/YES,GET CHECK SUM
	CAM
	TAD CHAR
	LSR
	5
	JMS I READT
	TAD CHAR
	MQA
	CIA
	TAD CKSUM
	DCA CKSUM
	JMP I READB1
READT1,	0
	RFC
	RSF
	JMP .-1
	RRB
	DCA CHAR
	JMP I READT1
/
	PAGE
/
/
TTIN1,	0
	KSF
	JMP .-1
	KRB
	DCA CHAR
	TAD CHAR
	JMS TTOUT1
	JMP I TTIN1
TTOUT1,	0
	TLS
	TSF
	JMP .-1
	CLA CLL
	JMP I TTOUT1
CRLF1,	0
	TAD (215
	JMS TTOUT1
	TAD (212
	JMS TTOUT1
	JMP I CRLF1
HALT1,	0
	KCC
	KSF
	JMP .-1
	KCC
	JMP I HALT1
	PAGE
DECOU1,]0
]DCA D1
]TAD D1
]MQL DVI
]1750
]DCA D1
]MQA
]TAD (260
]JMS I TTOUT
]TAD D1
]MQL DVI
]144
]DCA D1
]MQA
]TAD (260
]JMS I TTOUT
]TAD D1
]MQL DVI
]12
]DCA D1
]MQA
]TAD (260
]JMS I TTOUT
]TAD D1
]TAD (260
]JMS I TTOUT
]JMP I DECOU1
D1,]0
SPACE2,]0
]TAD (240
]JMS I TTOUT
]TAD (240
]JMS I TTOUT
]JMP I SPACE2
/^
/
/
/
MSG1,]0
	CLA CMA	/SET C(AC)=-1
]TAD MSG1]/ADD LOCATION
	DCA 10	/AUTO-INDEX REGISTER
	TAD I 10	/FETCH FIRST WORD
	DCA MSRGHT	/SAVE IT
	TAD MSRGHT
	RTR
	RTR	/ROTATE 6 BITS RIGHT
	RTR
	JMS TYPECH	/TYPE IT
	TAD MSRGHT	/GET DATA AGAIN
	JMS TYPECH	/TYPE RIGHT HALF
]JMP MSG1+4]/CONTINUE
MSRGHT,	0	/TEMPORARY STORAGE
TYPECH,	0	/TYPE CHARACTER IN C(AC)6-11
	AND MASK77
	SNA	/IS IT END OF MESSAGE?
	JMP I 10	/YES: EXIT
	TAD M40	/SUBTRACT 40
	SMA	/<40?
	JMP .+3	/NO
	TAD C340	/YES: ADD 300
	JMP MTP	/TO CODES <40
	TAD M3	/SUBTRACT 3
	SZA	/IS IT ZERO?
	JMP .+3	/NO
	TAD C212	/YES: CODE 43 IS
	JMP MTP	/LINE-FEED (212)
	TAD M2	/SUBTRACT 2
	SZA	/IS IT ZERO?
	JMP .+3	/NO
	TAD C215	/YES: CODE 45 IS
	JMP MTP	/CARRIAGE-RETURN (215)
	TAD C245	/ADD 200 TO OTHERS >40
MTP,	JMS I TTOUT	/TRANSMIT A CHAR
	JMP I TYPECH	/RETURN
MASK77,	77
M40,	-40
C340,	340
M3,	-3
C212,	212
M2,	-2
C215,	215
C245,	245
]$
