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))