From 0cebbf97db7d3985d4ef7dd2fc8037bbd080a61b Mon Sep 17 00:00:00 2001
From: Lars Brinkhoff <lars@nocrew.org>
Date: Thu, 5 Oct 2023 07:26:24 +0200
Subject: [PATCH] Boot ROM for downloading software from Chaosnet over
 Ethernet.

The ROM is built with the default start address, which is 173000.

It appears PROM 50 is the old Maclisp PROM tool, and PROM 555 is a
newer version for Lisp machines.
---
 Makefile             |   3 +-
 build/misc.tcl       |  13 ++
 build/timestamps.txt |   5 +
 doc/minits/ether-.3  |  82 ++++++++
 doc/minits/promp.doc |  54 +++++
 src/mits_b/bootil.26 | 479 +++++++++++++++++++++++++++++++++++++++++++
 src/mits_b/prom.50   | 411 +++++++++++++++++++++++++++++++++++++
 src/mits_b/prom.555  | 108 ++++++++++
 8 files changed, 1154 insertions(+), 1 deletion(-)
 create mode 100755 doc/minits/ether-.3
 create mode 100755 doc/minits/promp.doc
 create mode 100755 src/mits_b/bootil.26
 create mode 100755 src/mits_b/prom.50
 create mode 100755 src/mits_b/prom.555

diff --git a/Makefile b/Makefile
index db00f6ab..55135d6e 100644
--- a/Makefile
+++ b/Makefile
@@ -45,7 +45,8 @@ SRC = syseng sysen1 sysen2 sysen3 sysnet kshack dragon channa	\
       lars drnil radia gjd maint bolio cent shrdlu vis cbf digest prs jsf \
       decus bsg muds54 hello rrs 2500 minsky danny survey librm3 librm4 \
       klotz atlogo clusys cprog r eb cpm mini nova sits nlogo bee gld mprog2 \
-      cfs libmud librm1 librm2 mprog mprog1 mudbug mudsav _batch combat
+      cfs libmud librm1 librm2 mprog mprog1 mudbug mudsav _batch combat \
+      mits_b
 DOC = info _info_ sysdoc sysnet syshst kshack _teco_ emacs emacs1 c kcc \
       chprog sail draw wl pc tj6 share _glpr_ _xgpr_ inquir mudman system \
       xfont maxout ucode moon acount alan channa fonts games graphs humor \
diff --git a/build/misc.tcl b/build/misc.tcl
index b44db600..aaabff3c 100644
--- a/build/misc.tcl
+++ b/build/misc.tcl
@@ -1614,6 +1614,19 @@ respond "*" ":palx test_config\r"
 respond ":::" "777\r"
 expect ":KILL"
 
+# MINITS boot ROM for an Interlan network interface.
+respond "*" ":cwd mits.b\r"
+respond "*" ":palx bootil\r"
+respond "Interlan CSR?" "0\r"
+respond "Chaos address of Interlan board?" "0\r"
+expect "Which set of downloading hosts?"
+respond ")" "0\r"
+respond "Start address?" "0\r"
+respond "Do you want a power up/boot support" "0\r"
+respond "Boot PROM mapping kludge?" "0\r"
+respond "Start of temporary data storage?" "150000\r"
+expect ":KILL"
+
 # ITS universal file.
 respond "*" ":cwd decsys\r"
 respond "*" ":macro\r"
diff --git a/build/timestamps.txt b/build/timestamps.txt
index 87d9402c..db4adfa2 100644
--- a/build/timestamps.txt
+++ b/build/timestamps.txt
@@ -2069,9 +2069,14 @@ mini/gtros.mac 197309171214.52
 mini/ifmac.mac 197309171215.22
 mini/space.inf 197612031148.30
 mini/space.mac 197603291231.31
+minits/ether-.3 198606230618.02
 minits/-how-t.21 198606231622.38
 minits/minits.4 198606230648.36
+minits/promp.doc 198607172318.36
 minsky/tvdis.3 197602261842.17
+mits_b/bootil.26 198905261108.00
+mits_b/prom.50 198405170613.32
+mits_b/prom.555 198606230318.46
 mits_s/3com.3 198302160708.38
 mits_s/boot11.1 198207021703.01
 mits_s/camac.1 198207021703.37
diff --git a/doc/minits/ether-.3 b/doc/minits/ether-.3
new file mode 100755
index 00000000..c06a2f16
--- /dev/null
+++ b/doc/minits/ether-.3
@@ -0,0 +1,82 @@
+Notes on making new ethernet proms for MINITS boxes.
+
+This file is for making boot proms ONLY.
+
+The creation of boot-proms using BOOTIL is independant of the creation
+of new downloads in <DCP.MINITS.E>.  
+
+If you are changing network addresses then you better also change the
+file on the boot hosts that associates pdp-11 addresses with what to
+download into them.  For the AI Lab these files are:
+
+       OZ:PS:<SYSTEM>11LOAD.FILES
+       REAGAN:>PDP-11>11LOAD.FILES
+       ZERMATT:>PDP-11>11LOAD.FILES
+
+If you are changing network addresses you also should edit the namespace
+objects of the hosts involved.  You might also check to see if your actions
+impact safe sites.
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+NEED 2 2716's (Intel) per machine.
+
+(1) Frob MINITS sources as need be, see the file MINITS.TEXT.
+    Typically you edit OZ:<DCP.MINITS.S>CONFIG.PALX
+
+(2) On OZ:
+    Connect to <DCP.MINITS.BOOT-PROM>
+    PALX BOOTIL
+
+    It needs Vector, CSR and Chaos Addresses for the Chaos/Ether card(s).
+    You must already have assigned these when you edited CONFIG.PALX
+    on OZ (Usually use default vec and csr).  Answer all the questions
+    intelligently.
+
+    This writes BOOTIL.BIN in <DCP.MINITS.BOOT-PROM>.  
+    You may wish to rename it if you are doing multiple machines at once.
+    It is only needed for step (3) below.
+
+
+(3) On a Lisp Machine with a prom programmer attached and the prom-programmer
+    facility enabled.
+
+    (load "oz:ps:<dcp.minits.boot-prom>prom")
+    (27burn)
+
+    Answer intelligently and your proms get programmed.
+
+    More info on prom programming is in SYS:FACILITIES;PROMP.DOC
+
+
+;;;;;;;;;;;;;;;;  Following is old way using MX  ;;;;;;;;;;;;;;;;
+;
+;(2) ON MX
+;    :PALX KTV;BOOTIL >
+;
+;    It needs Vector, CSR and Chaos Addresses for the Chaos/Ether card(s).
+;    You must already have assigned these when you edited CONFIG.PALX
+;    on OZ (Usually use default vec and csr).
+;
+;    BIN in HSNAME
+;
+;    Ram starts at 156000 (requires 1000)
+;
+;    N.B., If you are doing more than one host, you cannot do this
+;          step n times because output always goes into BOOTIL BIN.
+;
+;(3) On MX
+;    :LISP
+;    (LOAD "DCP;PROM")
+;    (27BURN-PALX-BIN-FILE <in> <out>)
+;    e.g., <in> "DCP;BOOTIL BIN"
+;    e.g., <out> ".TEMP.;NE437A"
+;
+;    Wants to start at 3000 (the default I think)
+;
+;    This creates two files, e.g. .TEMP.;NE437A B00
+;			    and  .TEMP.;NE437A B08
+;
+;Now read pig:[taft]promp.doc to learn how to use the prom programmer
+;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
\ No newline at end of file
diff --git a/doc/minits/promp.doc b/doc/minits/promp.doc
new file mode 100755
index 00000000..d63163ad
--- /dev/null
+++ b/doc/minits/promp.doc
@@ -0,0 +1,54 @@
+
+
+Instructions for using the prom programmer with a 3600.
+
+    The prom programmer is connected to the 3600 using a serial port.
+It connects to the EIA Port 2 connector at the back of any 3600.  A null
+modem and various sex change connectors are required and should already
+be in place.  The recommended speed is 1200 baud which corresponds to
+position 7 of the rotary pot hidden in a hole in the back of the prom
+programmer.  Faster speeds, such as 9600 baud, may be attempted but
+there is some specialization in the code to handle this and it has not
+been debugged as of this writing.
+
+    To use the programmer physically insert the appropriate pack
+(carefully) and then turn it on.  After the self test has completed, you
+need to place the programmer in remote mode.  Do this by pushing
+<Select> <F> <1> <Start> <Start> .  You must hit "Start" twice.
+
+The function call (PROGRAMMER-RESET) should be used to initialize the
+programmer, but it is perhaps of greater value in that it reassures you
+that the programmer is operating.  If (PROGRAMMER-RESET) returns T you
+have an operational connection. If it hangs in "Serial In" you do not
+have an operative connection.
+
+    If you are using the UniPak the device type will probably default to
+a 2716.  You can set the device type using the function call:
+     (PROGRAMMER-SET-TYPE "Prom Type String") 
+For various current prom types look at the table at the top of the code
+file.
+
+    To program a prom or a pal you need to have the data stored in a
+lisp array in ascending order and to have this array be the value of a
+symbol.  To program a prom call:
+     (PROGRAMMER-PROGRAM-PROM 'Symbol-with-array-value)
+
+    This will load data into the programmer without programming the
+prom, then read it all out again and compare it.  If the data checks ok
+the machine then prints something like:
+     "Insert fresh prom and type Y when ready"
+
+     Put your fresh prom in the programmer if you have not already done
+so and type <y> or <space> to begin the actual burning operation.
+
+    Once the prom has been burnt the programmer will automatically be
+instructed to perform a Verify of the data now in the prom.  If it
+verifies ok you will be notified of success, and if not of failure.
+
+------------------------------------------------------
+
+    There are some other ways to use the stuff that involve the
+construction of "Prom Files" which can be quite useful.  These are
+documented with the code and I will not restate them here as I'm just
+trying to give you a basic feel for how it works.  You can look quickly
+over the code if you wish more information.
diff --git a/src/mits_b/bootil.26 b/src/mits_b/bootil.26
new file mode 100755
index 00000000..7c234784
--- /dev/null
+++ b/src/mits_b/bootil.26
@@ -0,0 +1,479 @@
+;;; -*-midas-*-
+	.title BOOTIL -- Network booting from an Interlan board
+
+.insrt mits.s;conven macros
+.insrt mits.s;style macros
+;; don't insert cpu macros.  If you do, this code may not be vanilla
+
+;; don't assume he has sob
+.macro sob r,addr
+	dec r
+	bne addr
+.endm
+
+;;; configuration 
+
+.if p1
+  .print "
+    Interlan CSR? (0 gets 164000) "
+  .ttymac ans
+    ilcsr==ans
+  .endm ttymac
+  .iif z ilcsr, ilcsr==164000
+  .print "
+    Chaos address of Interlan board? "
+  .ttymac ans
+    myaddr==ans
+  .endm ttymac
+  .print "
+    Which set of downloading hosts? (0:= MIT, 1:= SCRC, 2:= SCH, 3:= SCC,
+				     4:= TMC, 5:= SPA, 7:= Atari, 8:= SWW,
+				     9:= UTexas, 10:=Harris) "
+  .ttymac ans
+    whchst==ans
+  .endm
+  .print "
+    Start address? (0 for IO page bootprom) "
+  .ttymac ans
+    prmadr=ans
+  .endm ttymac
+  .if z prmadr
+    prmadr=173000
+    .print "
+    Do you want a power up/boot support (for 11/34 boot terminators)? (0, 1) "
+    .ttymac ans
+      pwrup==ans
+    .endm ttymac
+    .iif nz pwrup, pwrup==prmadr+24
+  .endc z prmadr
+  .iif ndf pwrup, pwrup==0
+  .print "
+    Do you want LSI-11/23+ (KDF11B) Boot PROM mapping kludge? (0, 1) "
+  .ttymac ans
+    bpmapk==ans
+  .endm ttymac
+  .if nz bpmapk
+   .print "      OK. PROM data should start at PROM address 0, not 3000
+"
+  .endc
+  .print "
+    Start of temporary data storage? (e.g., 150000) "
+  .ttymac ans
+    spaddr==ans
+  .endm ttymac
+
+.endc p1
+
+
+bit.05==1_5
+
+r0=%0
+r1=%1
+
+csrval=%2
+csrreg=%3
+bytcnt=%4
+bytptr=%5
+
+sp=%6
+pc=%7
+
+;;; Ethernet definitions
+
+%etchs==2010			;ethernet type field
+%etarp==3010			;address resolution type field
+
+;;; chaos definitions
+
+$cpkop==01
+$cpkda==04
+$cpkdi==06
+$cpksa==10
+$cpksi==12
+$cpkdt==20
+
+%corfc==1
+%coans==5
+%cpkfc==170000
+
+;;; interlan definitions
+
+ilbar== ilcsr+2
+ilbcr== ilcsr+4
+
+%ilsil==01_8			;set internal loopback
+%ilsel==02_8			;set external loopback
+%ilclb==03_8			;clear loopback
+%ilspm==04_8			;set   promiscous mode
+%ilcpm==05_8			;clear promiscous mode
+%ilsre==06_8			;set   receive-on error mode
+%ilcre==07_8			;clear receive-on error mode
+%ilofl==10_8			;go OFFline
+%ilonl==11_8			;go ONline
+%ildia==12_8			;run on-board diagnostics
+%ilsis==15_8			;set   insert source address mode
+%ilcis==16_8			;clear insert source address mode
+%ilspd==17_8			;set physical address to default
+
+%ilrrs==30_8			;report and reset statistics
+%ilrdt==31_8			;report collision delay times
+
+%illrb==40_8			;load receive buffer address/byte count queue
+
+%illtd==50_8			;load transmit data
+%illts==51_8			;load transmit data and send
+%illga==52_8			;load group address(es)
+%ildga==53_8			;delete group address(es)
+
+
+%ilfrb==60_8			;flush receive buffer address/byte count queue
+
+%ilrst==77_8			;reset board
+
+.=spaddr			;stack grows down, data grows up
+mode:	.blkw 1
+sndtim:	.blkw 1			;counter to spawn a new RFC
+rsttim:	.blkw 1			;reset time (when this hits zero, we do a complete reset)
+hstptr:	.blkw 1			;point to next host table entry
+
+myethr:	.blkw 3			;my ethernet address
+
+pkt:	.blkb 1+1+2		;interlan software header
+ethpkt:	.blkb 6+6+2		;packet pre-emble
+ethdat:				;ethernet data starts here
+chspkt:	.blkb 16.+488.		;chaos packet
+	.blkb 8			;padding bytes
+pktend==.-1			;for an odd number (non-multiple of 8)
+
+.if p2
+.irp len,\.-spaddr
+.print "
+Data region is len (octal) bytes
+"
+.endm
+.endc
+
+.=prmadr
+go:	.word 12767		;mov (pc)+,mode (sets mode nonzero)
+dbug:	clr mode		;sets mode to zero
+	reset
+	mov #10$,sp		;cpu independent spl 7
+	rti
+10$:	.word go2,340
+
+;;; prtdl:	loop <
+;;; 	  tstb @2(sp)
+;;; 	  exitl eq
+;;; 	  loop <
+;;; 	    tstb @#177564
+;;; 	    rptl pl
+;;; 	    >
+;;; 	  movb @2(sp),@#177566
+;;; 	  inc 2(sp)
+;;; 	  rptl
+;;; 	  >
+;;; 	pop (sp)
+;;; 	return
+
+.if nz pwrup
+  .if l pwrup-.
+	.error Too much stuff before pwrup
+  .iff
+    .if p1
+      .irp waste,\pwrup-.
+	.print "waste bytes wasted before 11/34 power vector
+"
+      .endm
+    .endc
+  .endc
+.=pwrup
+	.word go		;start at loader
+	.word 340		;at priority 7
+.endc
+
+go2:	mov #hsttbl,hstptr
+	mov #ilcsr,csrreg
+.if nz bpmapk
+	movb #1,@#177521	;Map in the top half of the boot prom too
+.endc
+restrt:	mov #spaddr,sp		;make sure SP consistent
+	loop <			;complete interface reset loop
+	  call ilnrst
+	  loop <		;send rfc loop
+	    tst mode		;reloading or debugging?
+	    if ne,<call sndrfc>	;reloading, send RFC and arm receiver
+	    else  <call rcvenb>	;else just arm receiver
+	    loop <		;wait for/process packet loop
+	      bisb (csrreg),csrval	;don't miss the bit
+	      bit #bit.05,csrval
+	      if ne,<call rcvpkt>
+	      dec sndtim
+	      rptl ne
+	      >
+	    dec rsttim
+	    rptl gt
+	    >
+	  rptl
+	  >
+
+;;; note: the length of names must be odd.  Double up if necessary.
+.macro .ildma bar,bcr,names
+	jsr bytcnt,ilndma
+	  .word bar
+	  .word bcr
+	  .ilcm2 <names>
+.endm
+
+.macro .ilcmd names
+	jsr bytcnt,ilncmd	;don't need bytcnt in this routine
+	  .ilcm2 <names>
+.endm
+
+.macro .ilcm2 names
+    .irp name,<names>
+	.byte <<%il'name>_-8>
+    .endm
+	.byte 0
+.endm
+
+ilndma:	mov (bytcnt)+,@#ilbar
+	mov (bytcnt)+,@#ilbcr
+
+ilncmd:	movb (bytcnt)+,r0	;no commands are minus (they're six bits)
+	if ne,<
+	  swab r0		;make it an interlan command
+	  mov r0,(csrreg)
+	  clr r0
+	  mov #10.,r1
+	  loop <
+	    movb (csrreg),csrval
+	    bmi ilncmd
+	    sorl r0
+	    sorl r1
+	    br restrt
+	    >
+	  >
+	rts bytcnt
+
+ilnrst:	loop <			;drain CSR of old data
+	  tstb (csrreg)
+	  rptl mi
+	  >
+	.ilcmd <rst,clb,frb,frb,onl,cis,spd>
+	.ildma pkt,66.,rrs
+	mov #ethpkt,r0
+	mov #myethr,r1
+	mov (r0)+,(r1)+
+	mov (r0)+,(r1)+
+	mov (r0)+,(r1)+
+initim:	mov #10.,rsttim		;reset the timers
+	clr sndtim
+	return
+
+
+hsttbl:	
+
+.if z whchst-0			;MIT servers
+	013065			;REAGAN
+	017316			;ZERMATT
+	015163			;ALLSPICE
+	015044			;MINTAKA
+	003130			;AI
+	003131			;MC
+.endc
+.if z whchst-1			;Symbolics servers
+	024610			;SCRC-QUABBIN
+	024620			;SCRC-STONY-BROOK
+.endc
+.if z whchst-2			;SCH servers
+	23047			;SCH-Gila
+	25446			;SCH-TEST-Iguana
+	22446			;SCH-HUEY-DUCK
+.endc
+.if z whchst-3			;SCC servers
+	031532			;SCC-WAIKATO
+.endc
+.if z whchst-4			;TMC servers
+       	37404			;TMC-Eligius
+	37400			;TMC-Aquinas
+	37700			;TMC-Godot
+.endc
+.if z whchst-5			;SPA servers
+	22120			;SPA-Russian
+	22300			;SPA-Los-Trancos
+	22100			;SPA-Sacramento
+	22110			;SPA-Colorado
+.endc
+.if z whchst-7			;Atari
+	036010			;Atari Cambridge
+	036014			;Atari Cambridge
+	036410			;Atari Sunnyvale
+	036414			;Atari Sunnyvale
+.endc
+.if z whchst-8			;Symbolics West Wood
+	034410			;SWW-RED
+	034420			;SWW-BLACK
+	034430			;SWW-WHITE
+	025010			;SWW-INFRARED
+.endc
+.if z whchst-9			;UTexas-3600
+	1001
+	1010
+	1014
+	1020
+.endc
+.if z whchst-10			;Harris 3600s
+	067410
+	067420
+	067430
+.endc
+ 	0
+
+rfcpkt:	.word -1,-1,-1		;hardware broadcast for RFCs
+	.word 52525,52525,52525	;random source
+	.word %etchs		;chaos packet
+	.word %corfc_8,6	;rfc packet, 6 character contact name
+	.word 0,0		;foreign host and index
+	.word myaddr,125252	;my address and index
+	.word 0,0		;no packet number, no ack number
+	.ascii /11LOAD/
+rfcpke==.
+
+sndrfc:	.ilcmd frb		;flush receive queue
+
+	mov #rfcpkt,bytptr
+	mov #ethpkt,r0		;where to put it
+	mov #<rfcpke-rfcpkt>/2,bytcnt	;get word count for transfer
+	loop <
+	  mov (bytptr)+,(r0)+
+	  sorl bytcnt
+	  >
+	mov hstptr,r0		;this hair saves a word
+	mov (r0)+,chspkt+$cpkda	;stuff host in the destination address
+	tst (r0)
+	if eq,<mov #hsttbl,r0>
+	mov r0,hstptr
+
+sndpkt:	.ildma ethpkt,60.,lts
+
+rcvenb:	.ildma pkt,pktend-pkt,lrb
+	return
+
+rcvpkt:	clr csrval		;turn off the received bit for next time
+	bitb #3,pkt		;errors?
+	  bne rcvenb
+	mov #chspkt-2,bytptr
+	cmp (bytptr)+,#%etchs
+	  bne rcvnch
+	cmp (bytptr)+,#%corfc_8
+	  bne rcvenb
+	mov (bytptr)+,bytcnt
+	bic #%cpkfc,bytcnt		;flush forwarding count
+	sub #6,bytcnt
+	  blt rcvenb		;all possible contact+JCL are at least 6
+	cmp (bytptr)+,#myaddr
+	  bne rcvenb
+	mov #chspkt+$cpkdt,bytptr	;go up to the data field
+	mov (bytptr)+,r0	;get contact name
+	cmp (bytptr)+,#<40+<40_8>>	;space,,space
+	  bne rcvenb
+	loop <			;exit to send the ans
+	  cmp r0,#<'L+<'D_8>>	;LD
+	  if eq,<
+	    mov (bytptr)+,r0	;get deposit address
+	    tst bytcnt		;6 already subtracted above
+	    if eq,< jmp (r0) >	;always expect even jump address
+	    loop <
+	      movb (bytptr)+,(r0)+
+	      sorl bytcnt
+	      >
+	    exitl		;go send ans
+	    >
+	  cmp r0,#<'e+<'x_8>>
+	  if eq,<
+	    mov @(bytptr)+,chspkt+$cpkdt
+	    exitl
+	    >
+	  cmp r0,#<'d+<'p_8>>
+	  if eq,<
+	    mov (bytptr)+,@(bytptr)+
+	    exitl
+	    >
+	  cmp r0,#<'g+<'o_8>>
+	  bne rcvenb		;nope on last possibility
+	  jcall @(bytptr)+
+	  >
+	mov #chspkt,bytptr
+	mov #%coans_8,(bytptr)+	;convert to ans packet
+	mov #2,(bytptr)+	;maybe data from ex request
+	mov bytptr,r0		;swap destination and source chaos ports
+	push (bytptr)+
+	push (bytptr)+
+	mov (bytptr)+,(r0)+
+	mov (bytptr)+,(r0)+
+	pop -(bytptr)	
+	pop -(bytptr)	
+	call initim		;got a good packet, reinitialize the timers
+rtnpkt:	mov #ethpkt+6,bytptr	;set ether destination to previous source
+				;leave source same, since it saves words 
+				;and a full host on the other side shouldn't 
+				;be looking at it anyway
+	mov #ethpkt,r0
+	mov (bytptr)+,(r0)+
+	mov (bytptr)+,(r0)+
+	mov (bytptr)+,(r0)+
+	br sndpkt
+
+
+    dsect <
+ar$hrd::	.blkw 1		;hardware address space type
+ar$pro::	.blkw 1		;protocol address space type
+ar$hln::	.blkb 1		;hardware length
+ar$pln::	.blkb 1		;protocol length
+ar$op::		.blkw 1		;opcode
+ar$sha::	.blkb 6		;for ethernet
+ar$spa::	.blkb 2		;for chaosnet
+ar$tha::	.blkb 6		;for ethernet
+ar$tpa::	.blkb 2		;for chaosnet
+    >
+
+rcvnch:	cmp -2(bytptr),#%etarp	;address resolution
+	  bne rcvenb
+	cmp (bytptr)+,#400	;ethernet?
+	  bne rcvenb
+	cmp (bytptr)+,#%etchs	;chaos protocol
+	  bne rcvenb
+	cmp (bytptr)+,#6+<2_8>	;length of hardware,,length of protocol
+	  bne rcvenb
+	cmp (bytptr),#400	;request?
+	  bne rcvenb
+	asl (bytptr)+		;double it (makes it a reply)
+	mov #ethdat+ar$tha,r0	;go up to target fields
+	mov #myethr,r1
+
+	mov (bytptr),(r0)+	;copy source to target 
+	mov (r1)+,(bytptr)+	;and deposet my ether address as new source
+	mov (bytptr),(r0)+
+	mov (r1)+,(bytptr)+
+	mov (bytptr),(r0)+
+	mov (r1)+,(bytptr)+
+
+	cmp (r0),#myaddr	;is it a request for me?
+	  bne rcvenb
+	push (bytptr)
+	mov (r0),(bytptr)
+	pop (r0)
+	br rtnpkt		;send the packet whence it came.
+
+
+;;; Random peices of data
+
+.if p2
+.irp len,\.-go
+.print "
+Code region is len (octal) bytes
+"
+.endm
+.endc
+
+.end go
diff --git a/src/mits_b/prom.50 b/src/mits_b/prom.50
new file mode 100755
index 00000000..ae1d3f4c
--- /dev/null
+++ b/src/mits_b/prom.50
@@ -0,0 +1,411 @@
+;;; -*- Mode: LISP; Package: USER; BASE: 8 -*-
+
+#-LISPM
+(progn 'compile
+       (or (boundp 'lchaos-loaded) (load "mc: dcp2;lchaos"))
+       (defvar conn (chaos:allocate-connection 2))
+       (defvar pkt (chaos:allocate-packet))
+       (defconst connection-dead 't)
+       (defun rmp-reset () (fire-up-rmp-connection))
+       (defun fire-up-rmp-connection ()
+	 (setq connection-dead 't)
+	 (if (= (chaos:initiate-connection conn pkt 500
+					  (exploden "RMP116")
+					  2)
+		%csopn)
+	     (progn (setq connection-dead 'nil)
+		    "RMP connection is open")
+	     (progn (format t "~&RMP connection did NOT open.~&")
+		    "RMP connection failure")))
+
+	 )
+
+#+LISPM
+(defun sleep (n) (cc:sleep n))
+
+(defun rmp-deposit (register-offset datum &optional (re-read 't))
+ #-LISPM (progn
+	   (if connection-dead (fire-up-rmp-connection))
+	   (chaos:set-packet-data-word pkt 0 (1+ register-offset))
+	   (chaos:set-packet-data-word pkt 1 datum)
+	   (chaos:set-packet-length pkt 4)
+	   (chaos:send-data-packet conn pkt %codwd))
+ #+LISPM (progn
+	   (%unibus-write (+ 760400 register-offset) datum))
+ (if re-read (rmp-examine register-offset)))
+
+(defun rmp-examine (register-offset)
+  #-LISPM (progn
+	    (if connection-dead (fire-up-rmp-connection))
+	    (chaos:set-packet-data-word pkt 0 register-offset)
+	    (chaos:set-packet-length pkt 2)
+	    (chaos:send-data-packet conn pkt %codwd)
+	    (if (= (chaos:packet-opcode (chaos:receive-packet conn pkt))
+		   %codwd)
+		(chaos:packet-data-word pkt 0)
+		(progn (format t "~&Didn't get data-is-words packet back.~&")
+		       0)))
+  #+LISPM (%unibus-read (+ 760400 register-offset))
+  )
+
+(defun csr ()          (rmp-examine 6))
+(defun addr ()    (* 2 (rmp-examine 0)))
+(defun data ()         (rmp-examine 2))
+(defun bar ()          (rmp-examine 4))
+(defun wcsr (n)        (rmp-deposit 6 n))
+(defun waddr (n)  (* 2 (rmp-deposit 0 (// n 2))))
+(defun wdata (n)       (rmp-deposit 2 n 'nil))
+(defun wbar (n)        (rmp-deposit 4 n))
+
+Œ
+(defun show-range (low high)
+  (wcsr 0)
+  (waddr low)
+  (do ((n low (1+ n)))
+      ((> n high))
+    (print (list (addr) (data)))))
+
+(defun find-mismatch (n)
+  (wcsr 0)
+  (waddr 0)
+  (do ((i 0 (logand 37777 (1+ i))))
+      ((progn (and (zerop i) (print 'at-zero))
+	      (not (= (data) n)))
+       i)))
+
+(defun feep-on-mismatch (n)
+  (wcsr 0)
+  (waddr 0)
+  (do ()(())
+    (if (not (= (data) n))
+	#-LISPM (tyo 7)
+	#+LISPM (funcall standard-output ':beep))))
+
+(defun ascii-ize-palx-bin-file (file ofile)
+  (ascii-ize-data
+   ofile
+   (combine-bytes
+    (sort-data
+     (get-bin-file-contents (open file
+				  #-LISPM '(in fixnum)
+				  #+LISPM '(:read :fixnum :raw :byte-size 9)))))))
+
+(defun burn-palx-bin-file (file)
+  (burn-data
+   (combine-bytes
+    (sort-data
+     (get-bin-file-contents (open file
+				  #-LISPM '(in fixnum)
+				  #+LISPM '(:read :fixnum :raw :byte-size 9)))))))
+
+(defun 4burn-palx-bin-file (file ofile)
+  (4burn-data
+   ofile
+   (combine-bytes
+    (sort-data
+     (get-bin-file-contents (open file
+				  #-LISPM '(in fixnum)
+				  #+LISPM '(:read :fixnum :raw :byte-size 9)))))))
+
+(defun 27burn-palx-bin-file (file ofile)
+  (27burn-data
+   ofile
+   (combine-bytes
+    (sort-data
+     (get-bin-file-contents (open file
+				  #-LISPM '(in fixnum)
+				  #+LISPM '(:read :fixnum :raw :byte-size 9)))))))
+
+;;; this burns 4 74s471's; the files are called foo bl0, foo bl8, foo bh0 and
+;;; foo bh8.
+(defun 471burn-palx-bin-file (file ofile)
+  (471burn-data
+   ofile
+   (combine-bytes
+    (sort-data
+     (get-bin-file-contents (open file
+				  #-LISPM '(in fixnum)
+				  #+LISPM '(:read :fixnum :raw :byte-size 9)))))))
+
+(defun get-bin-file-contents (file)
+  (do ((data '() (append data new-data))
+       (new-data (get-new-data file) (get-new-data file)))
+      ((null new-data) (close file)
+		       data)))
+
+(defun get-new-data (file)
+  (cond ((not (= (f-getwrd file) 1)) '())
+	('else (let ((len (f-getwrd file))
+		     (addr (f-getwrd file)))
+		 (cond ((<= len 6) '())
+		       ('else (do ((new-data '() (cons (cons addr (f-getbyt file)) new-data))
+				   (addr addr (1+ addr))
+				   (count (- len 6) (1- count)))
+				  ((zerop count) (f-getbyt file)
+						 new-data))))))))
+
+#+LISPM
+(defun in (file) (tyi file) (tyi file) (tyi file) (tyi file))
+(defun f-getwrd (file)
+  (+ (in file) (lsh (in file) 8)))
+(defun f-getbyt (file)
+  (in file))
+
+(defun sort-data (data)
+  (sort data #'(lambda (x y) (< (car x) (car y)))))
+
+(defun combine-bytes (data)
+  (do ((data data (cdr data))
+       (last '())
+       (new-data '()))
+      ((null data) (and last (setq new-data (cons last new-data)))
+		   (nreverse new-data))
+    (cond (last (cond ((evenp (caar data))
+		       (setq new-data (cons last new-data)
+			     last (car data)))
+		      ((= (caar data) (1+ (car last)))
+		       (setq new-data (cons (cons (car last)
+						  (+ (cdr last)
+						     (lsh (cdar data) 8)))
+					    new-data)
+			     last '()))
+		      ('else (setq new-data (cons last new-data)
+				   new-data (cons (car data) new-data)
+				   last '()))))
+	  ('else (cond ((evenp (caar data))
+			(setq last (car data)))
+		       ('else (setq new-data (cons (car data) new-data))))))))
+
+(defun ascii-ize-data (ofile data)
+  (ascii-ize-it ofile data))				;just a transporter
+
+(defun burn-data (data)
+  (format t "~%Data ranges from ~O to ~O. Where do you want it to start? "
+	  (caar data) (caar (last data)))
+  (let ((offset (- (caar data) (read))))
+    (format t "~%Going to burn from ~O to ~O.  Type 'y' when ready. "
+	    (- (caar data) offset) (- (caar (last data)) offset))
+    (do ()((= (tyi) #/y)))
+    (burn-it data offset)))
+
+(defun 4burn-data (ofile data)
+  (format t "~%Data ranges from ~O to ~O. Where do you want it to start? (probably 1000)"
+	  (caar data) (caar (last data)))
+  (let ((offset (- (caar data) (read))))
+    (format t "~%Going to burn from ~O to ~O.  Type 'y' when ready. "
+	    (- (caar data) offset) (- (caar (last data)) offset))
+    (do ()((= (tyi) #/y)))
+    (4burn-it ofile data offset)))
+
+(defun 27burn-data (ofile data)
+  (format t "~%Data ranges from ~O to ~O. Where do you want it to start? (often 3000)"
+	  (caar data) (caar (last data)))
+  (let ((offset (- (caar data) (read))))
+    (format t "~%Going to burn from ~O to ~O.  Type 'y' when ready. "
+	    (- (caar data) offset) (- (caar (last data)) offset))
+    (do ()((= (tyi) #/y)))
+    (27burn-it ofile data offset)))
+
+(defun 471burn-data (ofile data)
+  (format t "~%Data ranges from ~O to ~O. Where do you want it to start? (probably 0)"
+	  (caar data) (caar (last data)))
+  (let ((offset (- (caar data) (read))))
+    (format t "~%Going to burn from ~O to ~O.  Type 'y' when ready. "
+	    (- (caar data) offset) (- (caar (last data)) offset))
+    (do ()((= (tyi) #/y)))
+    (471burn-it ofile data offset)))
+
+(defun burn-it (data offset)
+  (wcsr 1)
+  (sleep 1)
+  (do ((data data (cdr data))
+       (paddr))
+      ((null data))
+    (setq paddr (- (caar data) offset))
+    (waddr paddr)
+    (do () ((plusp (logand (csr) 200))))
+    (waddr paddr)
+    (waddr paddr)
+    (wdata (cdar data))
+    (do () ((plusp (logand (csr) 200))))
+    (cond ((not (= (cdar data) (data)))
+	   (format t "~%~6O// ~6O ~6O did not work. Type 'y' to continue."
+		   paddr
+		   (data)
+		   (cdar data))
+	   (do () ((= (tyi) #/y))))))
+  (wcsr 0))
+
+(defun 4burn-it (ofile data offset)
+  (do ((fn2 '("00" "04" "08" "12") (cdr fn2))
+       (xor-bits '(16 17 01 00) (cdr xor-bits))
+       (lsh-count '(-0 -4 -8. -12.) (cdr lsh-count)))
+      ((null fn2))
+    (let ((of (open (implode (append (exploden ofile)
+				     (exploden " B")
+				     (exploden (car fn2))))
+		    '(out ascii))))
+      (format of
+	      "PROM prom-type /"6306/"~%"
+	      ;"PROM~%"
+	      )
+      (do ((last-addr -1 addr)
+	   (addr)(datum)
+	   (data data (cdr data)))
+	  ((null data) (format of "END~%")
+		       (close of))
+	(setq addr (// (- (caar data) offset) 2)
+	      datum (logand (lsh (cdar data) (car lsh-count)) 17))
+	(do ((n (1+ last-addr) (1+ n)))
+	    ((>= n addr))
+	  (format of "~4o ~3o~%" n 17))
+	(format of "~4o ~3o ; ~3o~%"
+		addr
+		(logxor datum (car xor-bits))
+		datum)))))
+
+(defun 27burn-it (ofile data offset)
+  (do ((fn2 '("00" "08") (cdr fn2))
+       (lsh-count '(-0 -8.) (cdr lsh-count)))
+      ((null fn2))
+    (let ((of (open (implode (append (exploden ofile)
+				     (exploden " B")
+				     (exploden (car fn2))))
+		    '(out ascii))))
+      (format of
+	      "PROM prom-type /"2716/"~%"
+	      ;"PROM~%"
+	      )
+      (do ((last-addr -1 addr)
+	   (addr)(datum)
+	   (data data (cdr data)))
+	  ((null data) (format of "END~%")
+		       (close of))
+	(setq addr (// (- (caar data) offset) 2)
+	      datum (logand (lsh (cdar data) (car lsh-count)) 377))
+	(do ((n (1+ last-addr) (1+ n)))
+	    ((>= n addr))
+	  (format of "~4o ~3o~%" n 377))
+	(format of "~4o ~3o~%"
+		addr
+		datum)))))
+
+(defun 471burn-it (ofile data offset)
+  ;;; burn first pair of proms
+  (471-burn-it-internal ofile data offset 256. '(l0 l8))
+  ;;; burn second pair of proms
+  (471-burn-it-internal ofile (nthcdr 256. data) offset 256. '(h0 h8)))
+
+(defun 471-burn-it-internal (ofile data offset locs fn2)
+  (do ((fn2 fn2 (cdr fn2))
+       (lsh-count '(-0 -8.) (cdr lsh-count)))
+      ((null fn2))
+    (let ((of (open (implode (append (exploden ofile)
+				     (exploden " B")
+				     (exploden (car fn2))))
+		    '(out ascii))))
+      (format of
+	      "PROM prom-type /"74S471/"~%"
+	      ;"PROM~%"
+	      )
+      (do ((last-addr -1 addr)
+	   (addr)(datum)
+	   (data data (cdr data))
+	   (locs-burned 0 (1+ locs-burned)))
+	  ((or (= locs-burned locs) (null data))
+	   (format of "END~%") (close of))
+	(setq addr (// (- (caar data) offset) 2)
+	      datum (logand (lsh (cdar data) (car lsh-count)) 377))
+	(do ((n (1+ last-addr) (1+ n)))
+	    ((>= n addr))
+	  (format of "~4o ~3o~%" n 377))
+	(format of "~4o ~3o~%"
+		addr
+		datum)))))
+
+(defun ascii-ize-it (ofile data)
+  (let ((of (open ofile '(out ascii))))
+    (do ((data data (cdr data)))
+	((null data))
+      (format of "~O//~O~%" (caar data) (cdar data)))
+    (close of)))
+
+
+;;; An LRH file is for burning bytes at various locations.  Only the
+;;; low byte of a word is used, so there should be no eproms on the
+;;; top slot of the rmp-116.  The description file contains lists,
+;;; where the first element is the address to burn, and the second is
+;;; the data.  The address can be anything from 0 to 77777 (the
+;;; address space of the RMP-116).
+
+(defun burn-lrh-file (filename)
+  (let ((filei (open filename
+		     #-LISPM '(in)
+		     #+LISPM '(:read))))
+    (wcsr 1)
+    (sleep 1)
+    (unwind-protect
+     (do ((last-segment -1 this-segment)
+	  (this-segment)
+	  (from-file (read filei 'eof) (read filei 'eof))
+	  (addr)
+	  (datum))
+	 ((eq from-file 'eof))
+       (setq addr  (car  from-file)
+	     datum (cadr from-file))
+       (setq this-segment (// addr 2048.))
+       (if (not (= this-segment last-segment))
+	   (progn (format t "~%Select bank ~D and type G to continue. > "
+			  this-segment)
+		  (do ((char (tyi) (tyi)))
+		      ((or (= char #/g) (= char #/G))))))
+       (burn-lrh-datum addr (logior 177400 datum)))
+     (wcsr 0)
+     (close filei)))
+  'finished)
+
+(defun burn-lrh-datum (addr datum)
+  (do ((OK? '()))
+      (OK?)
+    (do () ((plusp (logand (csr) 200))))
+    (waddr (* addr 2))
+    (waddr (* addr 2))
+    (wdata datum)
+    (do ()((plusp (logand (csr) 200))))
+    (if (= (logand datum 377) (logand (data) 377))
+	(setq OK? 'data-did-get-burned)
+	(progn (format t "~%~6O// ~6O ~6O did not work.  R(etry) C(ontinue) > "
+		       addr (logand (data) 377) (logand datum 377))
+	       (do ((char (tyi) (progn (format t "~%R(etry) C(ontinue) > ")
+				       (tyi))))
+		   ((member char '(#/r #/R #/c #/C))
+		    (setq OK? (member char '(#/c #/C)))))))))
+
+
+
+(defun why-bad (low high)
+  (why-bad-gen low high 0 0))
+
+(defun why-bad-gen (low high when-on when-off)
+  (wcsr 0)
+  (waddr low)
+  (do ((a (addr) (addr))
+       (d (data) (data))
+       (and-all -1)
+       (or-all 0)
+       (and-[d-xor-a] -1)
+       (or-[d-xor-a] 0)
+       )
+      ((> a high)
+       (list 'and-all and-all
+	     'or-all or-all
+	     'and-[d-xor-a] and-[d-xor-a]
+	     'or-[d-xor-a] or-[d-xor-a]
+	     ))
+     (and (= when-on (logand a when-on))
+	  (zerop (logand a when-off))
+	  (progn (setq and-all (logand and-all d)
+		       or-all (logior or-all d)
+		       and-[d-xor-a] (logand and-[d-xor-a] (logxor a d))
+		       or-[d-xor-a] (logior or-[d-xor-a] (logxor a d)))))))
+
diff --git a/src/mits_b/prom.555 b/src/mits_b/prom.555
new file mode 100755
index 00000000..1ea038b4
--- /dev/null
+++ b/src/mits_b/prom.555
@@ -0,0 +1,108 @@
+;;; -*- Mode: LISP; Base: 8. -*-
+
+;; This is for LISPM only.  It is an adaptation and raped mutation of KTV;BOOTIL by DCP
+
+(defun f-getwrd (file)
+  (+ (tyi file) (lsh (tyi file) 8)))
+
+(defun f-getbyt (file)
+  (tyi file))
+
+(defun sort-data (data)
+  (sort data #'(lambda (x y) (< (car x) (car y)))))
+
+(defun combine-bytes (data)
+  (do ((data data (cdr data))
+       (last '())
+       (new-data '()))
+      ((null data) (and last (setq new-data (cons last new-data)))
+		   (nreverse new-data))
+    (cond (last (cond ((evenp (caar data))
+		       (setq new-data (cons last new-data)
+			     last (car data)))
+		      ((= (caar data) (1+ (car last)))
+		       (setq new-data (cons (cons (car last)
+						  (+ (cdr last)
+						     (lsh (cdar data) 8)))
+					    new-data)
+			     last '()))
+		      ('else (setq new-data (cons last new-data)
+				   new-data (cons (car data) new-data)
+				   last '()))))
+	  ('else (cond ((evenp (caar data))
+			(setq last (car data)))
+		       ('else (setq new-data (cons (car data) new-data))))))))
+
+(defun get-bin-file-contents (file)
+  (do ((data '() (append data new-data))
+       (new-data (get-new-data file) (get-new-data file)))
+      ((null new-data) (close file)
+		       data)))
+
+(defun get-new-data (file)
+  (cond ((not (= (f-getwrd file) 1)) '())
+	('else (let ((len (f-getwrd file))
+		     (addr (f-getwrd file)))
+		 (cond ((<= len 6) '())
+		       ('else (do ((new-data '() (cons (cons addr (f-getbyt file)) new-data))
+				   (addr addr (1+ addr))
+				   (count (- len 6) (1- count)))
+				  ((zerop count) (f-getbyt file)
+						 new-data))))))))
+
+;;;;
+
+(when (si:facility-p :prom-programmer)
+  (si:enable-facility :prom-programmer))
+
+(defconst *default-minits-palx-bin-file* "oz:<dcp.minits.boot-prom>bootil.bin")
+
+(defun 27burn (&optional ifile)
+  (if (not ifile)
+      (setq ifile (prompt-and-read
+		    `(:pathname :visible-default ,*default-minits-palx-bin-file*)
+		    "Bin file ? ")))
+  (27burn-palx-bin-file ifile))
+
+(defun 27burn-palx-bin-file (&optional (ifile *default-minits-palx-bin-file*))
+  (with-open-file (istream ifile :characters nil :byte-size 8)
+    (27burn-data (send (fs:parse-pathname ifile) ':name)
+		 (combine-bytes (sort-data (get-bin-file-contents istream))))))
+
+(defun 27burn-data (name data)
+  (let ((ibase 8.)
+	(low-addr (caar data))
+	(hi-addr (caar (last data))))
+    (format t "~2%Data ranges from ~O to ~O." low-addr hi-addr)
+    (let* ((start-addr (or (prompt-and-read '(:number :base 8 :or-nil t)
+			    "Where do you want it to start (default 3000) ? ")
+			   (progn (format t "Using 3000~%") 3000)))
+	   (offset (- low-addr start-addr))
+	   (size (1+ (// (- hi-addr offset) 2))))
+      (format t "~%Going to burn from ~O to ~O~%" start-addr (- hi-addr offset))
+      (27burn-it name data offset size))))
+
+(defun 27burn-it (name data offset size)
+  (loop for suffix in '("-B00" "-B08")
+	 and lsh-count in '(-0 -8.)
+	for array-name = (intern (string-upcase (string-append name suffix)))
+         and output-array = (make-array size :initial-value 377)
+    do
+	(set array-name output-array)
+        (loop for (addr . datum) in data
+	      for  prog-addr = (// (- addr offset) 2)
+	       and prog-datum = (logand (lsh datum lsh-count) 377)
+	  do (aset prog-datum output-array prog-addr))
+    collect 
+	(27burn-it-now-damn-it array-name)
+    into burn-results
+    finally (return burn-results)))
+
+(defun 27burn-it-now-damn-it (array-name)
+  (format t "~%Attempting to contact prom-programmer...")
+  (and (programmer-reset)
+       (format t "~%Prom Programmer communications established.~%"))
+  (putprop array-name "2716" 'prom-type)
+  (programmer-set-type "2716")
+  (format t "~%Now programming ~A~%" array-name)
+  (programmer-program-prom array-name))