From 8a5119bb54bdacc7c6b334d8530616c078135cf7 Mon Sep 17 00:00:00 2001
From: Lars Brinkhoff <lars@nocrew.org>
Date: Fri, 8 Mar 2019 13:04:25 +0100
Subject: [PATCH] TOSBLK - convert PALX binaries to SBLK.

---
 build/misc.tcl     |   4 ++
 doc/programs.md    |   1 +
 src/pdp11/tosblk.1 | 163 +++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 168 insertions(+)
 create mode 100644 src/pdp11/tosblk.1

diff --git a/build/misc.tcl b/build/misc.tcl
index ee83c968..cc196415 100644
--- a/build/misc.tcl
+++ b/build/misc.tcl
@@ -512,6 +512,10 @@ expect ":KILL"
 respond "*" ":palx bs;_dazzle\r"
 expect ":KILL"
 
+# TOSBLK, convert from PALX binary to SBLK.
+respond "*" ":midas pdp11;ts tosblk_tosblk\r"
+expect ":KILL"
+
 # TITLER
 respond "*" ":midas dsk0:.;@ titler_mb; titler\r"
 expect ":KILL"
diff --git a/doc/programs.md b/doc/programs.md
index a1e36a6b..3724cac8 100644
--- a/doc/programs.md
+++ b/doc/programs.md
@@ -315,6 +315,7 @@
 - TMPKIL, delete old files from .TEMP.
 - TREES, list toplevel jobs.
 - TREK, Star Trek game.
+- TOSBLK, convert PALX binaries to SBLK.
 - TV-11, Knight TV PDP-11.
 - TVEDIT, paint program.
 - TVREAD, read a bitmap file and display on TV.
diff --git a/src/pdp11/tosblk.1 b/src/pdp11/tosblk.1
new file mode 100644
index 00000000..ed7d8442
--- /dev/null
+++ b/src/pdp11/tosblk.1
@@ -0,0 +1,163 @@
+	title Convert PALX binary to SBLK binary.
+
+;Call with OUTPUT FILE_INPUT FILE.  The input PALX binary is converted
+;to SBLK format, one 16-bit PDP-11 word per 36-bit PDP-10 word.  The
+;symbol table is dropped.
+
+a=1
+b=2
+c=3
+d=4
+e=5
+f=6
+g=6
+p=17
+
+dski==1
+dsko==2
+
+start:	move p,[-pdlen,,pdl]
+	.break 12,[..rjcl,,jcl]		;Get JCL.
+
+	move a,jcl
+	caie a,0
+	 camn a,[asciz /î/]
+	  .value [asciz /:Output file missing./]
+
+	.break 12,[..rpfi,,defaults]	;Output file name defaults from DDT.
+	move a,ddev   ? movem a,odev
+	move a,dsname ? movem a,osname
+	move a,dfn1   ? movem a,ofn1
+	move a,dfn2   ? movem a,ofn2
+
+	movei b,output			;Get output file name.
+	move d,[440700,,jcl]
+	pushj p,rfn"rfn
+
+	caie a,"_
+	 .value [asciz /:Input file missing./]
+
+	move a,odev   ? movem a,idev	;Input file name defaults from output.
+	move a,osname ? movem a,isname
+	move a,ofn1   ? movem a,ifn1
+	move a,ofn2   ? movem a,ifn2
+
+	movei b,input			;Get input file.
+	pushj p,rfn"rfn
+	.call [ setz
+		sixbit/open/
+		[.uii,,dski]
+		idev
+		ifn1
+		ifn2
+		setz isname ]
+	 .lose %lsfil
+
+	.call [ setz
+		sixbit/open/
+		[.uio,,dsko]
+		odev
+		ofn1
+		ofn2
+		setz osname ]
+	 .lose %lsfil
+
+	.iot dsko,[jrst 1]	;Write SBLK end of loader.
+
+	pushj p,convert
+
+	.iot dsko,[0]		;Write SBLK start instruction.
+	.iot dsko,[0]		;Duplicate start instruction.
+	.close dsko,
+
+	.close dski,
+	.logout 1,
+
+convert:
+	.iot dski,a
+	jumpe a,convert		;Skip PALX zeroes between blocks.
+	caie a,1
+	 jrst invalid		;Next, check input for a 1 and a 0.
+	.iot dski,a
+	jumpn invalid
+
+	pushj p,rword		;Get PALX byte count.
+	hrrei c,-6(a)
+	jumple c,[popj p,]
+	pushj p,rword		;Get PALX block address.
+
+	move d,a		;Convert to SBLK address.
+	trne d,1
+	 .value [asciz /:Odd block address in PALX binary./]
+	lsh d,-1
+	
+	trne c,1		;Convert to SBLK word count.
+	 .value [asciz /:Odd block size in PALX binary./]
+	movn e,c
+	lsh e,-1
+	
+	movs f,e
+	hrr f,d
+	.iot dsko,f		;Write SBLK simple block header.
+	move g,f		;Initialize SBLK checksum.
+
+loop:	pushj p,rbyte		;Read PALX byte.
+	move b,a
+	subi c,1
+	pushj p,rbyte		;Read PALX byte.
+	lsh a,8
+	ior b,a
+	.iot dsko,b		;Write SBLK word.
+	rot g,1			;Update SBLK checksum.
+	add g,b
+	sojg c,loop
+
+	.iot dski,a		;Read and ignore PALX checksum.
+	.iot dsko,g		;Write SBLK checksum.
+	jrst convert
+
+invalid:
+	.value [asciz /:Invalid PALX binary file./]
+	.logout 1,
+
+rbyte:	.iot dski,a
+	tdne a,[-400]
+	 jrst invalid
+	popj p,
+
+rword:	pushj p,rbyte
+	move b,a
+	pushj p,rbyte
+	lsh a,8
+	ior a,b
+	popj p,
+
+rsixtp:	cain a,"_
+	 aos (p)
+	popj p,
+
+rfn"$$rfn==:1
+.insrt syseng; rfn >
+
+defaults:
+ddev:	0
+dsname:	0
+dfn1:	0
+dfn2:	0
+
+input:
+idev:	0
+ifn1:	0
+ifn2:	0
+isname:	0
+
+output:
+odev:	0
+ofn1:	0
+ofn2:	0
+osname:	0
+
+.vector pdl(pdlen==20)
+.vector jcl(jclen==20)
+
+end start