From 3744295d5b971f01be76f718efab11d8c1bed786 Mon Sep 17 00:00:00 2001
From: Eric Swenson <eric@swenson.org>
Date: Fri, 2 Aug 2019 20:29:42 +0000
Subject: [PATCH] Fixed COMSAT on KA10. Conditional assembly prompts for
 limiting to KA10 instructions. Resolves #1671.

---
 build/ka10/include.tcl                |  4 ++++
 build/kl10/include.tcl                |  4 ++++
 build/ks10/include.tcl                |  4 ++++
 build/misc.tcl                        |  1 +
 src/sysnet/{comsat.583 => comsat.584} | 22 ++++++++++++++++++++++
 src/sysnet/{netrts.356 => netrts.357} | 13 +++++++++++--
 src/sysnet/{resolv.34 => resolv.35}   |  8 +++++++-
 7 files changed, 53 insertions(+), 3 deletions(-)
 rename src/sysnet/{comsat.583 => comsat.584} (99%)
 rename src/sysnet/{netrts.356 => netrts.357} (99%)
 rename src/sysnet/{resolv.34 => resolv.35} (98%)

diff --git a/build/ka10/include.tcl b/build/ka10/include.tcl
index 99e141fa..e06a71a9 100644
--- a/build/ka10/include.tcl
+++ b/build/ka10/include.tcl
@@ -217,3 +217,7 @@ proc patch_clib_16 {} {
 
 proc copy_to_klfe {file} {
 }
+
+proc comsat_switches {} {
+    respond "Limit to KA-10 instructions" "y\r"
+}
diff --git a/build/kl10/include.tcl b/build/kl10/include.tcl
index 19d2b62e..47da79f3 100644
--- a/build/kl10/include.tcl
+++ b/build/kl10/include.tcl
@@ -192,3 +192,7 @@ proc copy_to_klfe {file} {
     respond "*" ":klfedr write $file\r"
     expect ":KILL"
 }
+
+proc comsat_switches {} {
+    respond "Limit to KA-10 instructions" "y\r"
+}
diff --git a/build/ks10/include.tcl b/build/ks10/include.tcl
index 2766d41f..4cafb3f5 100644
--- a/build/ks10/include.tcl
+++ b/build/ks10/include.tcl
@@ -206,3 +206,7 @@ proc patch_clib_16 {} {
 
 proc copy_to_klfe {file} {
 }
+
+proc comsat_switches {} {
+    respond "Limit to KA-10 instructions" "n\r"
+}
diff --git a/build/misc.tcl b/build/misc.tcl
index a38224a0..50cbfdc9 100644
--- a/build/misc.tcl
+++ b/build/misc.tcl
@@ -190,6 +190,7 @@ expect ":KILL"
 respond "*" ":link sys2;ts =,sys;ts srccom\r"
 
 respond "*" ":midas .mail.;comsat_sysnet;comsat\r"
+comsat_switches
 expect ":KILL"
 
 respond "*" ":midas device;jobdev dq_sysnet;dqxdev\r"
diff --git a/src/sysnet/comsat.583 b/src/sysnet/comsat.584
similarity index 99%
rename from src/sysnet/comsat.583
rename to src/sysnet/comsat.584
index 676149e0..a8b62d7e 100644
--- a/src/sysnet/comsat.583
+++ b/src/sysnet/comsat.584
@@ -14,6 +14,28 @@ TITLE NEW COMSAT
 	; System Communications Satellite
 	;(analogy pat. pend.-- running job has various actual sat. names)
 
+IF1,[
+
+DEFINE IFCE A,B
+IFE SIXBIT/A/-SIXBIT/B/,TERMIN	;SUBSTITUTE FOR IFSE THAT IGNORES CASE
+
+PRINTX /Limit to KA-10 instructions? /
+.TTYMAC KAONLY
+  IRPS Z,,[YES Y]
+  IFCE Z,KAONLY,{
+	$$KA10==1
+	.ISTOP
+	}
+  TERMIN
+TERMIN
+
+IFNDEF $$KA10, $$KA10==0
+
+IFN $$KA10, PRINTX /Limiting to KA-10 instructions 
+/
+IFE $$KA10, PRINTX /Using KS-10 and KL-10 instructions
+/
+]
 	F=0	; Flags
 	A=1	; A-E consecutive utility regs
 	B=2	;	( routines save all not used for value returning,
diff --git a/src/sysnet/netrts.356 b/src/sysnet/netrts.357
similarity index 99%
rename from src/sysnet/netrts.356
rename to src/sysnet/netrts.357
index 179d7989..f2096ab6 100644
--- a/src/sysnet/netrts.356
+++ b/src/sysnet/netrts.357
@@ -6,6 +6,8 @@ IFNDEF $$FTP,$$FTP==0	; Do not assemble FTP routines anymore.
 IFNDEF $$TCP,$$TCP==1	; Normally assemble TCP routines.
 IFNDEF $$DQ,$$DQ==0	; Normally use host table, not DQ device.
 IFNDEF $$450,$$450==0	; Disable special casing of SMTP reply code 450
+IFNDEF $$KA10, $$KA10==0 ; default to KS/KL-10 instructions
+
 comment|   
          This file contains the network hacking code of COMSAT.
 
@@ -2165,12 +2167,19 @@ NHITS9:	POPAE P,[D,B,A]
 
 ; "NHMLTX" - routine skips if host in A is a Multics.
 NHMLTX:	PUSHAE P,[A,B,C,D]	; Save acs
-	DMOVE C,[ASCII "MULTICS"]	; What we are looking for
+
+IFN $$KA10,[
+	MOVE C,(B)
+	MOVE D,1(B)
+]
+IFE $$KA10, DMOVE C,[ASCII "MULTICS"]	; What we are looking for
+
 	JRST NHOPSY		; Join common code
 
 ; "NHITS" - routine skips if host in A is an ITS.
 NHITS:	PUSHAE P,[A,B,C,D]	; Save acs
-	DMOVE C,[ASCII "ITS" ? 0]	; What we are looking for
+	MOVE C,[ASCII "ITS"]	; What we are looking for
+	MOVEI D,0
 ;	JRST NHOPSY		; Join common code
 
 
diff --git a/src/sysnet/resolv.34 b/src/sysnet/resolv.35
similarity index 98%
rename from src/sysnet/resolv.34
rename to src/sysnet/resolv.35
index ee083319..fe59416c 100644
--- a/src/sysnet/resolv.34
+++ b/src/sysnet/resolv.35
@@ -41,6 +41,8 @@ IFNDEF $$DQRN, $$DQRN==0
 IFNDEF $$DQCH, $$DQCH==1
 IFNDEF $$DQIN, $$DQIN==1
 
+IFNDEF $$KA10, $$KA10==0 ; default to KS/KL-10 instructions
+
 .BEGIN RESOLV
 
 IFN $$DQRN,{
@@ -118,7 +120,11 @@ TERMIN
 ;;; Non-skip means we are not on that network.
 
 OWNHST:	SETZ B,
-IFN $$DQIN, TLNN A,(NE%UNT) ? DMOVE A,[0 ? SQUOZE 0,IMPUS3]
+IFN $$DQIN,[
+ IFN $$KA10, TLNN A,(NE%UNT) ? MOVEI A, 0 ? MOVE B, [SQUOZE 0,IMPUS3]
+ IFE $$KA10, TLNN A,(NE%UNT) ? DMOVE A,[0 ? SQUOZE 0,IMPUS3]
+]
+
 IFN $$DQCH, CAMN A,[NW%CHS] ? MOVE B,[SQUOZE 0,MYCHAD]
 	SKIPE B
 	 .EVAL B,