From 5ccac7f47d51876a4b3a7d90d50ea6370f217f79 Mon Sep 17 00:00:00 2001
From: Lars Brinkhoff <lars@nocrew.org>
Date: Sat, 15 Jun 2019 10:13:04 +0200
Subject: [PATCH] FAILSA - read TOPS-10 FAILSAFE tapes.

---
 build/misc.tcl    |   4 ++
 doc/programs.md   |   1 +
 src/moon/failsa.9 | 119 ++++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 124 insertions(+)
 create mode 100644 src/moon/failsa.9

diff --git a/build/misc.tcl b/build/misc.tcl
index 9b94d94f..2ba64083 100644
--- a/build/misc.tcl
+++ b/build/misc.tcl
@@ -353,6 +353,10 @@ expect ":KILL"
 respond "*" ":midas moon; ts jedgar_moon; jedgar\r"
 expect ":KILL"
 
+# failsa
+respond "*" ":midas moon;_failsa\r"
+expect ":KILL"
+
 # ports
 respond "*" ":midas sys2;ts ports_sysen2;ports\r"
 expect ":KILL"
diff --git a/doc/programs.md b/doc/programs.md
index ebc5aa7e..ac57c1d1 100644
--- a/doc/programs.md
+++ b/doc/programs.md
@@ -103,6 +103,7 @@
 - EXPN/VRFY, query remote SMTP server.
 - FACTOR, factor integers.
 - FAIL, assembler from SAIL.
+- FAILSA, read FAILSAFE tapes.
 - FCDEV, talk to LispM file server.
 - FDIR, fast directory listing.
 - FED, font editor.
diff --git a/src/moon/failsa.9 b/src/moon/failsa.9
new file mode 100644
index 00000000..a7f69a22
--- /dev/null
+++ b/src/moon/failsa.9
@@ -0,0 +1,119 @@
+	TITLE FAILSAFE READER
+
+.MLLIT==1
+
+A=1
+B=2
+C=3
+D=4
+E=5
+T=6
+TT=7
+I=10
+J=11
+Q=12
+P=17
+
+MTIC=13
+DKOC=14
+TYOC=15
+
+PDL:	-40,,.
+	BLOCK 40
+
+SNM:	SIXBIT/REV.7/	;SNAME TO READ INTO
+
+MTO:	.BII,,'MT0
+
+DKO:	.BIO,,'DSK
+FN1:	0
+FN2:	0
+
+GO:	MOVE P,PDL
+	.OPEN TYOC,[.UAO,,'TTY]
+	 .VALUE
+	MOVE TT,[.FNAM1]
+	PUSHJ P,SIXTYO
+	.IOT TYOC,[".]
+	MOVE TT,[.FNAM2]
+	PUSHJ P,SIXTYO
+	PUSHJ P,CRLF
+	.SUSET [.SSNAME,,SNM]
+	.OPEN MTIC,MTO		;SKIP FIRST TWO FILES
+	 .VALUE
+	HRROI TT,BUF
+	.IOT MTIC,TT
+	.OPEN MTIC,MTO
+	 .VALUE
+	HRROI TT,BUF
+	.IOT MTIC,TT
+	.OPEN MTIC,MTO		;THIRD FILE IS WHOLE TAPE
+	 .VALUE
+NXF:	MOVE TT,[-43,,BUF]	;READ HEADER
+	.IOT MTIC,TT
+	JUMPL TT,EOT
+	SKIPL Q,BUF
+	 .VALUE
+	MOVEI Q,-42(Q)		;NUMBER OF DATA WORDS IN THIS RECORD
+	MOVE TT,BUF+4
+	MOVEM TT,FN1
+	PUSHJ P,SIXTYO
+	.IOT TYOC,[" ]
+	HLLZ TT,BUF+5
+	MOVEM TT,FN2
+	PUSHJ P,SIXTYO
+	MOVE E,BUF+7		;LENGTH
+	CAMGE E,Q
+	 .VALUE			;SCREWED UP
+	.OPEN DKOC,DKO
+	 .VALUE
+	.CALL [	SETZ		;DON'T BOTHER IDUMPING
+		'SDMPBT
+		MOVEI DKOC
+		SETZI 1 ]
+	 JFCL
+RFL:	JUMPN Q,EOR
+	HRROI TT,Q		;GOBBLE HEADER OF NEXT RECORD
+	.IOT MTIC,TT
+	JUMPGE Q,EOR
+	 .VALUE			;UNEXPECTED HEADER
+EOR:	MOVEI D,LBUF
+	CAIGE E,LBUF
+	 MOVE D,E		;D HAS NUMBER OF WORDS TO READ FROM FILE
+	CAMGE Q,D		;DON'T TAKE MORE THAN IN RECORD
+	 MOVE D,Q
+	SUB E,D
+	SUB Q,D
+	MOVNS D,D
+	MOVSS D,D
+	HRRI D,BUF
+	MOVE C,D
+	.IOT MTIC,D
+	SKIPGE D
+	 .VALUE
+	.IOT DKOC,C
+	JUMPN E,RFL
+	.CLOSE DKOC,
+	PUSHJ P,CRLF
+	JRST NXF
+
+EOT:	MOVE TT,[SIXBIT/E-O-T/]
+	PUSHJ P,SIXTYO
+	.BREAK 16,160000
+
+CRLF:	.IOT TYOC,[15]
+CPOPJ:	POPJ P,
+
+SIXTYO:	MOVEI T,0
+	LSHC T,6
+	ADDI T,40
+	.IOT TYOC,T
+	JUMPN TT,SIXTYO
+	POPJ P,
+
+LBUF==200
+BUF:	BLOCK LBUF
+BUFP:	-LBUF,,BUF
+
+END GO
+