diff --git a/Makefile b/Makefile
index 4be9c23c..31d7d2ba 100644
--- a/Makefile
+++ b/Makefile
@@ -44,7 +44,7 @@ SRC = syseng sysen1 sysen2 sysen3 sysnet kshack dragon channa	\
       mits_s rab stan_k bs cstacy kp dcp2 -pics- victor imlac rjl mb bh \
       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
+      klotz atlogo clusys
 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 \
@@ -55,7 +55,7 @@ DOC = info _info_ sysdoc sysnet syshst kshack _teco_ emacs emacs1 c kcc \
 BIN = sys sys1 sys2 emacs _teco_ lisp liblsp alan inquir sail comlap \
       c decsys graphs draw datdrw fonts fonts1 fonts2 games macsym \
       maint _www_ gt40 llogo bawden sysbin -pics- lmman r shrdlu imlac \
-      pdp10 madman survey rrs
+      pdp10 madman survey rrs clu clucmp
 MINSRC = midas system $(DDT) $(SALV) $(KSFEDR) $(DUMP)
 
 # These are not included on the tape.
diff --git a/README.md b/README.md
index c885032b..e6e1f0aa 100644
--- a/README.md
+++ b/README.md
@@ -152,6 +152,7 @@ Some major applications:
 
 - Adventure, game
 - C10, C compiler
+- CLU, progamming language.
 - DDT, debugger
 - Emacs, editor
 - Logo, interpreter
diff --git a/bin/clu/ts.clusys b/bin/clu/ts.clusys
new file mode 100644
index 00000000..54c8aa6a
Binary files /dev/null and b/bin/clu/ts.clusys differ
diff --git a/bin/clucmp/cludmp.3_77 b/bin/clucmp/cludmp.3_77
new file mode 100644
index 00000000..5ae6db4c
Binary files /dev/null and b/bin/clucmp/cludmp.3_77 differ
diff --git a/build/timestamps.txt b/build/timestamps.txt
index 724853f3..5285f2f6 100644
--- a/build/timestamps.txt
+++ b/build/timestamps.txt
@@ -154,6 +154,15 @@ clib/nc.insert 197904082240.44
 clib/nm.insert 197904090030.29
 clib/-read-.-this- 198002261810.43
 clib/tv.128 197908312338.58
+clu/clu.order 197711161922.32
+clu/ts.clusys 197801112003.24
+clucmp/cludmp.3_77 197801311537.30
+clusys/alpha.10 197808301728.33
+clusys/common.8 197801302220.27
+clusys/load.1 197712051741.21
+clusys/omega.1 197806050121.45
+clusys/pass1.11 198004292220.48
+clusys/types.1 197801302011.48
 c/}lp.bin 198101160107.52
 c/}m.bin 198007170111.50
 c/nc.insert 197904082240.44
diff --git a/doc/clu/clu.order b/doc/clu/clu.order
new file mode 100644
index 00000000..e7e6b38d
--- /dev/null
+++ b/doc/clu/clu.order
@@ -0,0 +1,35 @@
+cmnd	args
+
+PARSE	input { , input } [ > output ]		% check for syntactic errors
+CHECK	input { , input } [ > output ]		% check for semantic errors
+CLUMAC	input { , input } [ > output ]		% produce CLUMAC code
+COMPILE input { , input } [ > output ]		% produce binary
+CLU	input { , input } [ > output ]		% produce binary
+SPECS	input { , input } [ > output ]		% create DU specs
+CE	input { , input } [ > output ]		% create CE
+XFILE	input { , input } [ > output ]		% execute commands in files
+PRINT	input { , input } [ > output ]		% print named files
+EVAL	expression				% evaluate given expression
+SAVE	name					% save "current" CE as given name
+LOAD	[ name ]				% make named (or default) CE "current"
+SNAME	name					% set default directory
+KILL						% kill CLU
+JOB	[ name ]				% go to named (or next) job
+TIME						% print current time
+QUIT						% quit command loop
+HELP						% print this file
+?						% print this file
+
+input:		filename  |  @ filename
+
+output:		filename
+
+Things in {}'s may be repeated zero or more times.  Things in []'s are optional.
+Note: you do not type {}'s and []'s, just what's inside them.
+The default second name for an XFILE input file is "xfile".
+The default second name for PRINT input files is ">".
+The default second name for other input files is "clu".
+The default second name for an @-file is "xload".
+If an output file is specified, TTY output goes to the named file.
+
+JCL is of the form:	[ - cmnd ] args .  The default cmnd is CLU.
diff --git a/doc/programs.md b/doc/programs.md
index 14efa7e5..1fdd34a8 100644
--- a/doc/programs.md
+++ b/doc/programs.md
@@ -62,6 +62,7 @@
 - CKR, Alan Baisley's checkers program.
 - CLOCK, analogue, small, or digital clock.
 - CLOGO, Logo programming language.
+- CLU, compiled programming language.
 - COMBAT, submit jobs to the Muddle compiler.
 - COMIFY, convert HEX to COM format.
 - COMPLR, Lisp compiler.
diff --git a/src/clusys/alpha.10 b/src/clusys/alpha.10
new file mode 100644
index 00000000..c54f5dbc
--- /dev/null
+++ b/src/clusys/alpha.10
@@ -0,0 +1,45 @@
+;	This is CLUSYS;ALPHA >, a file to be inserted
+; in front of CLUMAC files.  It cooperates with the file
+; CLUSYS;OMEGA >, which goes at the end of CLUMAC files.
+
+sblk
+nosyms
+.mllit==1
+if1 [
+	%its==0
+	%pits==1
+	printc	/
+****    Pass 1    ****
+/]
+if2 [
+	printc	/
+****    Pass 2    ****
+/]
+bugflg==0
+
+if2 [	jlink== jsp xr,linker	]
+
+if1 [	.insrt clusys;pass1
+	]
+
+$init
+
+usrflg==1	; shows user-ness
+
+if1 [	.insrt	clusys;types
+	.insrt	clusys;common
+	]
+
+loc	userlo
+; 	ld.cod== 0	; tvec+6
+;	ld.siz== 1	; size of load file
+;	ld.low== 2	; virtual low bound
+;	ld.ent== 3	; ref to entry block vector
+;	ld.ver== 4	; clu version number
+;	ld.ref== 5	; ptr to ref area
+start:	tvec+6		; to make this a proper object
+	finish-start	; the size of the file in words
+	start		; the lowest load address
+	tref+ents$	; the entry blocks vector
+	myvers		; the current version number
+	tref+pur$lo	; ptr to reference area
diff --git a/src/clusys/common.8 b/src/clusys/common.8
new file mode 100644
index 00000000..5379cc8b
--- /dev/null
+++ b/src/clusys/common.8
@@ -0,0 +1,145 @@
+;	This file is included everwhere to broadcast stuff
+; needed by separately-compiled routines, including constants
+; and addresses of support routines.
+
+ifn	usrflg,[
+define	gcon	name,val
+name: .==.+2
+termin
+
+define	gconv	name,[val]
+name:	irp	each,,val
+		.==.+1
+		termin
+termin
+
+define	jumper	name
+name:	.==.+1 
+	termin
+]
+
+ife	usrflg,[
+define	gcon	name,val
+name: val ? jsp	xr,exitc
+termin
+
+define	gconv	name,[val]
+name:	irp	each,,val
+		each
+		termin
+termin
+
+define	jumper	name
+jrst	name
+termin
+]
+
+loc	comadr
+nullp==0,,-100
+gcon	$true,tbool+true	; boolean true
+gcon	$false,tbool+false	; boolean false
+gcon	$none,tnone+(refbit)+none$	; the null return
+gcon	$null,tnull+(refbit)+null$	; the null object
+$nil=$null
+gcon	$nulls,tstr+(refbit)+nulls$	; the null string
+gcon	$nullv,tref+nullv$	; the unusable vector
+gcon	$neg1,tint+777777	; -1
+gcon	$zero,tint+0		; 0
+gcon	$one,tint+1		; 1
+gcon	$two,tint+2		; 2
+gcon	$tyo,tchan+ttyocn	; default tty output
+gcon	$tyi,tchan+ttyicn	; default tty input
+gcon	$work,trel+work$	; a page to work with
+gcon	$ents,tref+ents$	; the system entries
+comadx==.
+; Can't $rtnc following stuff
+gconv	$memhi,tref+gchi	; current high bound on free mem
+gconv	$memlo,tref+gclo	; current low bound on free mem
+gconv	$stkhi,tref+stktop	; upper bound on stack
+gconv	$pure,tref+gchi+1	; current pure stuff
+gconv	$purtop,tref+gchi
+gconv	$types,tref+types$	; the types vector
+gconv	$sigpr,0	; signal printing flag
+gconv	$mtab,0		; the module table
+gconv	$intlock,0	; this locks up the world
+gconv	intchk,skip	; this gets hit when we want to interrupt
+.i.==440000(bsize)
+.c==chsize*10000
+gconv	$bptab,[(.i.-.c),(.i.-2*.c),(.i.-3*.c),(.i.-4*.c),(.i.-5*.c)]
+gconv	$r.get,r.get	; get record component (get_*)
+gconv	$r.put,r.put	; put record component (put_*)
+gconv	$r.acc,r.acc	; general access entry
+gconv	$o.new,o.new	; make a new oneof (make_*)
+gconv	$typbp,[(221600+sp)]
+gconv	$vtab,0		; the vector table (for desc canon)
+gconv	$o.is,o.is	; test for taggedness of oneof
+gconv	$o.get,o.get	; force a get of a oneof component
+gconv	$trace,0	; the trace flag
+gconv	$trxct,0
+gconv	$trsav,0	; trace request
+gconv	$lflag,0	; listen loop recovery flag
+gconv	$bad,txrep+1	; Bad thing
+tbad==tref+$bad
+;	jumps to internal routines
+jumplo==:.
+jumper	setup
+jumper	exiter
+jumper	qsetup
+jumper	yield
+jumper	resume
+jumper	exitc
+jumper	qexit
+jumper	notref
+jumper	notrsb
+jumper	badrep
+jumper	frog
+jumper	linker
+jumper	buggy
+jumper	mexit
+jumper	badrtn
+jumper	memout
+jumper	framer
+jumper	itpop
+jumper	siggy
+jumper	causer
+jumper	notype
+jumper	mxrout	; qproc return
+jumper	vcopy	; copy a vector
+jumper	rcopy	; copy a range
+jumper	yldout
+jumper	agnew
+jumper	nixon
+jumper	i.ofl	; overflow signal
+jumper	myield
+jumper	amake	; make an array
+jumper	badtyp	; bad type code from force
+jumper	safex	; jumper to safe exit
+jumper	chkout	; check interrupts and jrst (xr)
+jumphi==.-1	; highest jumper
+
+loc	nulls$
+gconv	nulls%,[tsrep+0,0]
+gconv	none$,[tvec+1,0]
+gconv	null$,[tvec+1,0]
+gconv	nullv$,[tvec+1,0]
+gconv	$sname,sixbit /clusys/
+gconv	$bvec,tref+basvec	; vector of basic areas
+gconv	$stack,trel+stack	; start of stack
+gconv	$gcsav,tint		; # of words saved by last gc
+gconv	$gcreq,0		; # of GC requests
+gconv	$ahack,0		; # of hacked array arguments
+gconv	$.greq,0	; ^G request
+gconv	$.sreq,0	; ^S request
+gconv	$ihand,0	; inferior interrupt handler (procedure object)
+gconv	$infer,0	; 0,,lh of .ifpir user variable
+gconv	$inreq,0	; inferior interrupt requests
+gconv	$safex,0	; safex hacking flag
+gconv	$indef,0	; any interrupt request increments this
+gconv	$otty,0		; non-zero if tty is open
+gconv	$start,start	; starting address
+gconv	$cflag,0	; arg checking flag (1 -> no check)
+gconv	$snap,0		; # of things snapped
+gconv	$gcopt,0	; GC options word
+gconv	$fhand,0	; 1 -> propagate failure
+gconv	$hheap,0	; hi heap marker
+gconv	$styx,0		; statistics-keeping flag
diff --git a/src/clusys/load.1 b/src/clusys/load.1
new file mode 100644
index 00000000..3fef3178
--- /dev/null
+++ b/src/clusys/load.1
@@ -0,0 +1,655 @@
+;****	A BASIC CLUSYS FILE    ****
+
+cluster	%load,0,0,[],[]
+	
+; %snap  should  be  called  with  the  address  of   a
+; procedure call block  (pcb) and the  address of  the
+; entry  block   of  the   procedure  executing   when
+; snapping. it will give a  nasty error if the  pc.lnk
+; field of  the pcb  does not  refer to  a word  which
+; refers back to the pcb.  it will give another  nasty
+; error if the pcb refers  to a procedure that is  not
+; present in the procedure table. snap returns (if all
+; is well) with the procedure object.
+
+propt%==prc.ni
+proc	%snap,[plnk,ent]
+	$label	retry		; we will try forever if necessary
+	refchk	r0,plnk(er)
+	repchk	r0,tcrep
+; lookup the procedure quickly or slowly
+	$if	skipn	pc.typ(r0)		; if no type to find
+		skipe	pc.par(r0)		; and no parms to fool with
+	$then	mcall	pfind,[pc.str(r0)]	; then look in ptab
+		aos	$snap			; and bump snapped count
+	$else	call	%desc$snap_pcb,1,[r0] ; look and perhaps build one
+	$fi
+; check the returned object for some validity
+	refchk	rr,rr
+	$if	came	rr,$none
+	$then	mcall	%dfail,[plnk(er)]
+	$fi
+; if block is an entry block, check the # of arguments
+	$if	isrep	rr,terep
+	$then	hrrz	r1,en.lpr(rr)	; get the pr for the found procedure
+		hrrz	n1,pr.cut(r1)	; get number of args for that procedure
+		hrrz	r0,plnk(er)
+		$if	skipl	n2,pc.num(r0)	; if #args < 0, then no test
+			cain	n2,-2(n1)	; adjust test for frame size
+		$then	slink	lnk,Snap found a bad # of args for: 
+			move	g0,lnk(lr)
+			$go	bitch
+		$fi
+	$fi
+; attempt to find (and replace) the pcb in cluster data
+	push	sp,rr
+	move	r0,ent(er)		; try to fixup linkage
+	hlro	r0,en.lpr(r0)
+	$ift	mcall	ld.sb,[r0,plnk(er),rr]
+	$then	$rtn	(sp)
+	$fi
+; attempt to find (and replace) the pcb in cluster parm dependent stuff
+	move	rr,(sp)
+	move	r0,ent(er)		; try to fixup cluster parms
+	hrro	r0,en.par(r0)
+	trnn	r0,ones
+	 $go	ppfix
+	$ift	mcall	ld.sb,[r0,plnk(er),rr]
+	$then	$rtn	(sp)
+	$fi
+	move	rr,(sp)
+; attempt to find (and replace) the pcb in proc parm dependent stuff
+	$label	ppfix
+	move	r0,ent(er)		; try to fixup proc parms
+	hlro	r0,en.par(r0)
+	trnn	r0,ones
+	 $rtn	rr
+	$ift	mcall	ld.sb,[r0,plnk(er),rr]
+	$then	$rtn	(sp)
+	$fi
+	move	rr,(sp)
+	$rtn	rr		; and return the procedure object
+
+	$label	bitch		; come here to bitch about something
+	mcall	crlf,[$tyo]	; get new line
+	mcall	ch.ws,[$tyo,g0]	; write the bitch
+	move	r0,plnk(er)
+	mcall	ch.ws,[$tyo,pc.str(r0)]	; write the name of the offender
+	mcall	crlf,[$tyo]
+	croak	$p gets you a listen loop (maybe).
+	call	listen,2,[$tyi,$tyo]	; call to listen again
+	$go	retry		; try again if we return
+corp	%snap,[plnk,ent]
+
+; %Load$replace(vec,item,repl) tries to replace all occurences
+; of item in vec by repl.  If there was a replacement, it returns
+; true, otherwise false.
+propt%==prc.ni
+proc	ld.sb,[vec,item,repl],[flag],[tbool+false]
+
+	move	r0,vec(er)
+	$if	trne	r0,-pgsize
+	$then	$rtnc	$false
+	$fi
+	$for	all,rr,mcall	loopv,[r0]
+		move	r0,item(er)
+		$if	came	r0,(rr)
+		$then	move	r1,repl(er)
+			movem	r1,(rr)
+			move	rr,$true
+			movem	rr,flag(er)
+		$fi
+	$rof	all
+	$rtn	flag(er)
+
+corp	%load$replace,[vec,item,replace],[flag]
+
+; xload takes a string and tries to open the named channel.
+; it then reads lines and treats them as file names to be fload'd
+; into the current environment.
+propt%==prc.ni
+proc	xload,[str],[chan],[0]
+	slink	lnk,read
+	mcall	ch.op,[lnk(lr),str(er)]
+	movem	rr,chan(er)
+	$loop
+		link	lnk,tchar+12
+		mcall	ch.rs,[chan(er),lnk(lr)]
+		assn	str(er),rr
+		mcall	s.siz,[rr]	
+		$if	camg	rr,$two
+		$then	mcall	ld.fl,[str(er)]
+		$else	mcall	ch.cl,[chan(er)]
+			$rtnc	$none
+		$fi
+	$pool
+
+corp	xload,[str],[chan]
+
+; %load$page(chan,addr) attempts to load in a page from
+; a load  file by  mapping it  in. If  successful,  it
+; makes the  page read-only  to prevent  funny  things
+; from happening.
+propt%==prc.ni
+proc	ld.np,[chan,addr]
+	movei	n0,0
+	hrrz	n1,chan(er)
+	hrrz	n2,addr(er)
+	idivi	n2,pgsize
+	$if	.call	ld.np1(pr)	; did we map it in?
+	$then
+	$elf	.call	ld.np2(pr)	; try to get new page for reading
+	$then	movei	n1,pgsize		; could not map it in, so try to read it
+		stypix	n1,(tint)
+		mcall	ch.rv,[chan(er),addr(er),n1]
+	$else	croak	Can't get the page to load!
+	$fi
+	$rtnc	$none
+ld.np1==.-proc$
+	setz
+	sixbit	/corblk/
+	5000,,%cbndr+%cbcpy	; copy, read
+	n0		; arg1 = 0 (no mod to ctrl bits)
+	1000,,%jself	; job = self
+	n2		; page number
+	setz	n1	; channel #
+ld.np2==.-proc$
+	setz
+	sixbit	/corblk/
+	5000,,%cbndr+%cbndw	; read & write the page
+	n0		; arg1 = 0 (no mod to ctrl bits)
+	1000,,%jself	; job = self
+	n2		; page number
+	setzi	%jsnew	; try for new page
+corp	%load$page,[chan,addr]
+
+; Fload takes a string for a file name, then  attempts
+; to open a load file  by that name. If successful  it
+; calls Load on the resulting channel.
+
+propt%==prc.ni
+proc	ld.fl,[name]
+	mcall	f.pa1,[name(er)]
+	movei	n1,'BIN
+	skipn	fb.nm2(rr)
+	 movsm	n1,fb.nm2(rr)
+	movei	n1,6		; read in block mode
+	mcall	f.opn,[n1,rr]	; try to open the file
+	vargen	chan,0
+	movem	rr,chan(er)
+	$if	hlrz	n1,rr	; did we get a channel?
+		cain	n1,(tchan)
+	$then	slink	lnk,Fload could not open 
+		mcall	s.cat,[lnk(lr),name(er)]
+		fail	rr
+	$fi
+	mcall	ld.ld,[chan(er)]	; load the file
+	mcall	ch.cl,[chan(er)]	; close the channel
+	$rtn	name(er)
+corp	fload,[name]
+
+; Load takes an open channel,  then reads in what  had
+; better be a  load file.  To wit, there  should be  a
+; JRST 1 in the  first page of  the file, followed  by
+; blocks with the format:
+; 	0:  -N,,addr
+; 	1-N: data
+; 	N: checksum
+; This loading process runs out when a block is  found
+; with N = 0. The first block to be loaded must be  in
+; the "load block" format given here:
+ 	ld.cod== 0	; tvec+5
+	ld.siz== 1	; size of load file
+	ld.low== 2	; virtual low bound
+	ld.ent== 3	; ref to entry block vector
+	ld.ver== 4	; CLU version number
+	ld.ref== 5	; ptr to ref area
+; Load then calls %load$fix to fix up the loaded stuff,
+; then runs around making  the entry blocks happy  and
+; entering them into the module table.
+
+propt%==prc.ni
+proc	ld.ld,[chan],[lolim,size,reloc,source,srclen],[0,0,0,0,0]
+	mcall	ld.np,[chan(er),$work]
+	movei	n1,1
+	hrli	n1,(jrst)
+	move	r0,$work
+	hrli	r0,-pgsize
+.here	ld.ld1		; Scan for a JRST 1 to start the file.
+		camn	n1,(r0)
+		jrst	ld.ld2(pr)
+		aobjn	r0,ld.ld1(pr)
+		jrst	ld.lde(pr)	; there had better be one!
+.here	ld.ld2		; Get the descriptor block & check it
+	movei	n1,6
+	hrli	n1,(tvec)
+	came	n1,ld.cod+2(r0)	; the first word must be tvec+6
+	jrst	ld.lde(pr)
+	hrrz	n1,1(r0)	; get the low addr from load format
+	hrrz	n2,2+ld.low(r0)	; and from the load block itself
+	came	n1,n2
+	jrst	ld.lde(pr)	; they had better match!
+	movem	n2,lolim(er)	; save the low limit
+	hlrz	n3,2+ld.ver(r0)	; get the version number
+	caie	n3,ones&(myvers); compare against format part
+	jrst	ld.lde(pr)	; otherwise we goof off
+	hrrz	n1,2+ld.siz(r0)
+	movem	n1,size(er)	; and the size of the memory
+	hrli	n1,(twvec)
+	alloc	(n1),n1		; grab enough memory to load into
+	intoff			; no interrupts, please
+	hrroi	r1,0(rr)	; point at the memory
+	movem	r1,reloc(er)	; save that address
+	movei	n3,0		; clear to force new virtual ptr
+.here	ld.ld3
+	jumpl	r0,ld.ld4(pr)	; if work ptr is valid, then use it
+	hrrm	n3,source(er)	; save the virtual ptr
+	hlrm	n3,srclen(er)
+	mcall	ld.np,[chan(er),$work]	; grab the page
+	move	r0,$work
+	hrli	r0,-pgsize	; get ptr to the work area
+	move	n3,source(er)	; get virtual ptr
+	hrl	n3,srclen(er)	; and the length
+.here	ld.ld4
+	jumpl	n3,ld.ld6(pr)	; if we can load another word, do so
+	aobjn	r0,ld.ld5(pr)	; skip checksum & check for new page needed
+	mcall	ld.np,[chan(er),$work]	; grab the page
+	move	r0,$work
+	hrli	r0,-pgsize	; get ptr to the work area
+.here	ld.ld5
+	$if	skipge	n3,(r0)	; get new virtual ptr & check for loading done
+	$then	mcall	ld.fx,[reloc(er),size(er),lolim(er),size(er),reloc(er)]
+		move	r0,reloc(er)	; get the first word address
+		$if	skipn	r1,ld.ref(r0)	; if there are strings to fix up
+		$then	add	r0,ld.siz(r0)
+			stypix	r0,(trel)
+			move	g1,r0
+			$loop			; then start to fix them
+				stypix	r1,(trel)
+				$if	camge	r1,g1		; test for end of area
+				$then	$go	sfixed
+				$fi
+				$if	skipl	n2,(r1)
+					tlnn	n2,repbit
+				$then	hlrz	n2,n2
+					$if	caie	n2,(tsrep) ; fix the string
+					$then	stypix	r1,(trel)
+						push	sp,g1
+						mcall	ld.sf,[r1]
+						pop	sp,g1
+						move	r1,rr
+					$elf	caie	n2,(tarep); skip the array block
+					$then	addi	r1,3
+					$elf	caie	n2,(torep); skip the oneof block
+					$then	addi	r1,2
+					$else	hrrz	n1,(r1)	; skip other blocks
+						addi	r1,(n1)
+					$fi
+				$else	aos	r1		; skip any other word
+				$fi
+			$pool
+			$label	sfixed
+		$fi
+
+		move	r0,reloc(er)	; get the first word address
+		$for	all,rr,call	loopv,1,[ld.ent(r0)] ; for all entry blocks, do
+		  move	g0,(rr)		; get the entry block
+		  $if	isrep	g0,terep
+		  $then	; this is an entry block
+			hrrz	r0,en.lpr(g0)	; get the proc
+			skipn	r0
+			 $resume		; don't enter anything not a procedure
+			push	sp,g0		; save the entry block
+			add	r0,pr.nam(r0)
+			move	rr,(r0)		; get the procedure name
+			hrro	r0,r0
+			push	sp,r0		; save the name address
+			mcall	tb.ca,[$mtab,rr]
+			hrro	r0,(sp)
+			movem	rr,(r0)		; canonicalize the name
+			movem	rr,(sp)		; save the name for later
+			mcall	tb.va,[$mtab,rr]	; get old entry
+			pop	sp,g0			; restore the name
+			pop	sp,g1			; restore the entry
+			push	sp,rr			; save the old guy
+			hrrz	r0,rr
+			mcall	tb.en,[$mtab,g0,g1]
+			pop	sp,rr	; restore the old guy
+			$if	camn	rr,$none
+			$then	movei	n1,relink ; change setup call
+				hrli	n1,(jsp xr,0)
+				movem	n1,en.set(rr) ; to relink
+			$fi
+		  $elf	isrep	g0,tdrep
+		  $then	; this is a descriptor for a cluster
+			push	sp,g0
+			mcall	tb.ca,[$mtab,td.nam(g0)]
+			pop	sp,g0
+			movem	rr,td.nam(g0)		; canon the name
+			mcall	tb.en,[$mtab,rr,g0]	; enter the type desc
+		  $fi
+		$rof	all
+		move	rr,chan(er)
+		jrst	ld.ldx(pr)
+	$fi
+	aobjp	r0,ld.ld3(pr)	; skip over block ptr word & get new page if needed
+.here	ld.ld6			; come here to move a bunch of words
+				; n3 is aobjn to virtual area
+				; r0 is aobjn to work area
+	hlre	n2,n3
+	movn	n2,n2		; get length of virtual ptr
+	hlre	n1,r0
+	movn	n1,n1		; and length of work ptr
+	camle	n1,n2
+	exch	n1,n2		; n1 now has min length to blt
+	hrrz	n0,n3
+	sub	n0,lolim(er)
+	jumpl	n0,ld.lde(pr)	; if low limit too low, error
+	hrrz	br,reloc(er)
+	add	br,n0		; save for destination address
+	add	n0,n1		; add in blt length
+	camle	n0,size(er)
+	jrst	ld.lde(pr)	; if too long to blt, then error
+	hrrz	r1,br		; get dest address
+	addi	r1,-1(n1)	; find last word address
+	hrl	br,r0		; get work area address as source
+	blt	br,(r1)		; move all possible words
+	hrl	n1,n1		; duplicate the size moved
+	add	n3,n1		; update the aobjn ptrs
+	add	r0,n1
+	jrst	ld.ld3(pr)	; and go test for source acceptability
+.here	ld.lde
+	croak	Bad load file!!!!
+	slink	lnk,Load failed.
+	move	rr,lnk(lr)
+.here	ld.ldx
+	inton			; ok to interrupt now
+	$rtn	rr
+corp	%load,[chan],[lolim,size,reloc,source,srclen]
+
+
+; %load$fix(src,srclen,reflow,reflen,reloc)  scans  the
+; area from src for srclen, looking for references  to
+; the area from reflow  to reflen, and relocates  such
+; references to point at the area starting at reloc.
+
+;	macro to perform one case
+define	.case	x
+jrst	lf.nxt(pr)
+$elf	caie	n2,(t!x)
+$then	.case.==0
+termin
+
+;	macro to skip a word of rsb's
+define	.skip	pos
+ifsn	pos,,[
+	kvetch	pos-.case.,n,Bad position in .skip pos !
+	.case.==.case.+1
+	]
+aobjp	r0,lf.ex(pr)
+move	n1,(r0)
+termin
+
+;	macro to relocate the right half of current word
+define	.rel	pos
+ifsn	pos,,[
+	kvetch	pos-.case.,n,Bad position in .rel pos !
+	.case.==.case.+1
+	]
+jsp	r1,lf.rel(pr)
+termin
+
+;	macro to relocate both halves of current word
+define	.pair	pos
+ifsn	pos,,[
+	kvetch	pos-.case.,n,Bad position in .pair pos !
+	.case.==.case.+1
+	]
+jsp	r1,lf.par(pr)
+termin
+
+;	macro to snap setup words
+define	.set	pos
+ifsn	pos,,[
+	kvetch	pos-.case.,n,Bad position in .set pos !
+	.case.==.case.+1
+	]
+jsp	r1,lf.set(pr)
+termin
+
+propt%==prc.ni
+proc	ld.fx,[src,srclen,reflow,reflen,reloc]
+	move	r0,src(er)
+	movn	n1,srclen(er)
+	hrl	r0,n1		; r1 is aobjn to source for fix
+	hrrz	g0,reflow(er)	; g0 points to ref bottom
+	hrrz	n3,reflen(er)	; n3 is size of ref area
+	move	g1,reloc(er)	; g1 points to start of reloc area
+.here	lf.get
+	$crtnc	r0,ge,$none
+	move	n1,(r0)
+.here	lf.nxt
+.case.==0
+	hlrz	n2,n1		; grab the type code
+	$if	skipl	n1
+	$then	.rel
+	$elf	trne	n2,repbit
+	$then	.skip
+	$elf	cail	n2,typrep+repbit
+	$then	croak	Bad rep code in %load$fix (ptr in r0)
+	$elf	caige	n2,typrsb+repbit
+	$then	croak	Bad rep code in %load$fix (ptr in r0)
+;	otherwise each .case is an $elf-$then pair
+; to handle the rep cases
+	.case	arep		; arrays
+		.skip	ar.cod
+		.rel	ar.rel
+		.rel	ar.vec
+	.case	crep		; call blocks
+		.skip	pc.cod
+		.set	pc.set
+		.skip	pc.num
+	.case	drep		; descriptors
+		.skip	td.cod
+		.rel	td.fix
+		.skip	td.opt
+	.case	erep		; entry blocks
+		.skip	en.cod
+		.set	en.set
+		.pair	en.lpr
+		$if	trnn	n1,ones	; if there is initialization
+		$then	movs	n1,n1	; en.vi is (ref+1,,rsb)
+			sos	n1
+			movem	n1,(r0)
+			.rel	en.vi
+			move	n1,-1(r0)
+			aos	n1
+			movsm	n1,-1(r0)
+			move	n1,(r0)	; remember, n1 has word in r0
+		$else	setzm	(r0)
+			.skip
+		$fi
+		.pair	en.par
+		.rel	en.tr
+	.case	orep		; oneofs
+		.skip	on.cod
+	.case	prep		; pure parts
+		; Remove indirection in the code that goes through jumpers.
+		hrrz	n2,pr.err(r0)
+		subi	n2,pr.go	; n2 has # of words to scan
+		movei	r1,pr.go(r0)	; r1 points to start of code
+		.here	ld.fx1
+			$if	skipl	n1,(r1)		; get the instruction
+			$then	tlz	n1,400000	; test for setz
+				skipe	n1
+				 movni	n2,1		; force end of loop
+			$elf
+				tlz	n1,777400	; clear off opcode & ac
+				cail	n1,jumplo	; don't try if too low
+				caile	n1,jumphi	; or if too high
+			$then	; could be indirect jrst or jumpxx
+				move	n3,(n1)		; get jrst from where n1 points
+				hlrz	n1,(r1)		; get instruction LH
+				trz	n1,777		; clear all but opcode
+				cain	n1,(jrst)	; if a jrst, then
+				 hrrm	n3,(r1)		; snap indirection
+				trz	n1,7777		; clear low 3 bits of opcode
+				cain	n1,(jump)	; if a jump*, then
+				 hrrm	n3,(r1)		; snap indirection
+			$fi
+			addi	r1,1
+			sojg	n2,ld.fx1(pr)
+
+		hrrz	n1,pr.err(r0)	; get disp to errors
+		hrl	n1,n1
+		add	r0,n1			; move over to errors
+		jrst	lf.get(pr)
+	.case	srep		; strings
+		movei	n1,bpword+bpword-1(n1)
+		idivi	n1,bpword	; get # of words to skip
+		hrl	n1,n1		; duplicate the number
+		add	r0,n1		; point at next stuff to fix
+		jrst	lf.get(pr)
+	.case	vec		; vectors
+		.skip
+	.case	wvec		; word vectors
+		hrl	n1,n1
+		add	r0,n1
+		jrst	lf.get(pr)
+	.case	xrep		; ref vector
+		hrrz	n1,n1
+		push	sp,n1
+		.skip
+		$loop
+			$if	sosg	(sp)
+			$then	.rel
+			$else	jrst	lf.nxt(pr)
+			$fi
+		$pool
+	$fi
+	jrst	lf.nxt(pr)
+
+.here	lf.par			; reloc a pair of refs (ref,,ref)
+	hlrz	n2,n1
+	sub	n2,g0
+	jumpl	n2,lf.rel(pr)
+	caml	n2,n3
+	jrst	lf.rel(pr)
+	add	n2,g1		; add in relocation
+	hrlm	n2,(r0)		; insert the left half back into mem
+.here	lf.rel
+	hrrz	n1,n1
+	sub	n1,g0		; check for validity of ref at bottom
+	jumpl	n1,lf.skp(pr)
+	caml	n1,n3		; must be under (or at) the top, too
+	jrst	lf.skp(pr)
+	add	n1,g1		; add in relocation
+	hrrm	n1,(r0)		; relocate the right half
+.here	lf.skp
+	.skip
+	jrst	(r1)		; and return to caller
+.here	lf.set
+	trne	n1,-typlo	; check for n1 being in the common area
+	jrst	lf.rel(pr)
+	trnn	n1,-comadr
+	jrst	lf.rel(pr)	; skip if it is not
+	hlrz	n2,(n1)
+	caie	n2,(jrst)	; is it a link to a jrst ?
+	jrst	lf.skp(pr)
+	hrr	n1,(n1)		; yes, so change it
+	movem	n1,(r0)
+	jrst	lf.skp(pr)	; and go skip the word
+
+.here	lf.ex			; to exit, come here
+	$rtnc	$none
+corp	%load$fix,[src,srclen,reflow,reflen,reloc]
+
+propt%==prc.ni
+proc	ld.sf,[rel]
+	refchk	r0,rel(er)
+	move	rr,r0		; save the start in rr
+	hrli	r0,(bsize)
+	move	r1,r0
+	hrro	g1,r1		; save the start
+	hrre	n3,(r0)		; grab the size in bytes
+	$loop
+		$if	sosl	n3
+		$then	$go	done
+		$fi
+		ildb	n1,r1	; grab byte from source
+		$label	again
+		$if	caie	n1,"\
+		$then	movei	n2,3
+			movei	n1,0
+			$loop
+				$if	sosl	n2
+				$then	$go	next
+				$fi
+				$if	sosl	n3
+				$then	idpb	n1,r0
+					$go	done
+				$fi
+				ildb	n0,r1
+				$if	cail	n0,"0
+					caile	n0,"7
+				$then	rot	n1,3
+					andi	n0,7
+					add	n1,n0
+					sos	(rr)	; keep track of chars missed
+				$elf	caie	n2,2
+				$then	; no # chars follow \
+					sos	(rr)	; keep track of chars missed
+					cain	n0,"n	; Newline
+					 movei	n0,12
+					cain	n0,"N
+					 movei	n0,12
+					cain	n0,"t	; Tab
+					 movei	n0,11
+					cain	n0,"T
+					 movei	n0,11
+					cain	n0,"p	; Page (form feed)
+					 movei	n0,14
+					cain	n0,"P
+					 movei	n0,14
+					cain	n0,"b	; Backspace
+					 movei	n0,10
+					cain	n0,"B
+					 movei	n0,10
+					cain	n0,"r	; carriage Return
+					 movei	n0,15
+					cain	n0,"R
+					 movei	n0,15
+					cain	n0,"v	; Vertical tab
+					 movei	n0,13
+					cain	n0,"V
+					 movei	n0,13
+					move	n1,n0	; default to literal char
+					$go	next
+				$else	idpb	n1,r0
+					move	n1,n0
+					$go	again
+				$fi
+			$pool
+		$fi
+		$label	next
+		idpb	n1,r0		; deposit byte to dest
+	$pool
+
+	$label	done
+	movei	n1,0
+	$loop
+		$if	came	r0,r1
+		$then	hrrz	n1,(rr)			; and the number of bytes
+			addi	n1,bpword+bpword-1	; adjust to get # of words
+			idivi	n1,bpword
+			add	rr,n1			; skip them
+			$rtn	rr			; and return the ptr
+		$fi
+		idpb	n1,r0		; clear out remainder of string
+	$pool
+
+corp	%load$string_fix,[rel]
+
+
+retsulc	%load
+
diff --git a/src/clusys/omega.1 b/src/clusys/omega.1
new file mode 100644
index 00000000..f354851a
--- /dev/null
+++ b/src/clusys/omega.1
@@ -0,0 +1,16 @@
+;	OMEGA:	Insert after every CLUMAC file.
+
+purgen
+
+refs$:	consta
+
+ents$:	$gents
+
+finish:
+
+if2 [	printc	/
+----------------------------------------------------------------
+/]
+
+end	start
+
diff --git a/src/clusys/pass1.11 b/src/clusys/pass1.11
new file mode 100644
index 00000000..4490235b
--- /dev/null
+++ b/src/clusys/pass1.11
@@ -0,0 +1,1468 @@
+; This file gives the standard definitions of registers,
+; some data blocks, and code generation macros throughout the
+; CLU system. It need only be included on the first pass of the
+; assembly.
+
+; non-gc'd scratch regs (contents unchanged by reloc or gc)
+n0=: 0		; scratch 1 (may not contain an address!)
+n1=: 1		; scratch 2
+n2=: 2		; scratch 3 
+n3=: 3		; scratch 4
+
+; relocatable registers (rh relocatable but not gc'd)
+r0=: 4		; reloc register 1
+r1=: 5		; reloc register 2
+
+; gc'd scratch regs (lh should have type code, rh should have reference)
+g0=: 6		; gc scratch 1
+g1=: 7		; gc scratch 2
+
+; return object reg (a single gc'd ref)
+rr=: 10		; must be a ref
+
+; activation registers	(all non-gc'd)
+br=: 11	; blt register (both halves reloc)
+xr=: 12	; x-fer register (rh reloc)
+er=: 13	; environment register (rh reloc)
+lr=: 14	; linkage register (rh reloc)
+pr=: 15	; procedure register (rh reloc)
+mr=: 16  ; module register (rh reloc)
+
+; stack pointer (stack frames are a basis of gc)
+sp=: 17	; (rh reloc)
+
+; Opcodes not supported by MIDAS
+jov=jfcl+(400)	; jump on fixed overflow
+jfov=jfcl+(040)	; jump on floating overflow
+
+; interesting  constants
+myvers==:1,,1	; current version number (format,,features)
+
+typgen==:0	; gt means generate type codes
+tcflag==:typgen	; type checking flag for macros
+
+ttyicn==:1	; tty input channel #
+ttyocn==:2	; tty output channel #
+
+ifn	%its,[
+	pgsize==:1024.	; size of memory page in words
+	pglog2==:10.	; log2 of page size
+	hipage==:254.	; start of funny pages (last 2)
+	chmax==:17	; max # of channels available
+	]
+ifn	%pits,[
+	tyijfn==:100	; tty input jfn
+	tyojfn==:101	; tty output jfn
+	pgsize==:512.	; size of memory page in words
+	pglog2==:9.	; log2 of page size
+	hipage==:510.	; start of funny pages (last 2)
+	chmax==:27	; max # of channels available
+	]
+
+; true xor false must equal true+false !!!
+true==: 777777
+false==: 0
+
+; Interesting constant addresses in memory
+comadr==:100		; common vectors address
+nulls$==:600		; null string location
+syslo==:6*1024.		; lowest system address (leave space for GC)
+userlo==:32.*1024.	; lowest user address
+memlen==:2*pgsize	; initial space for the gc-able memory
+gchi==:hipage*pgsize-1	; highest possible gc-address (ever)
+gclo==:gchi-memlen+1	; lowest possible gc-address (intially)
+work$==:hipage*pgsize	; loader working area address (for 1 page)
+mover==:work$+pgsize	; moving area
+ones==:777777		; halfword of ones (highest address)
+
+; string stuff
+bpword==: 5		; number of bytes per word
+chsize==: 7		; bits per character
+bsize==: chsize*100,,0	; mask for byte ptr for strings
+wsize==: 004400,,000000	; mask for full-word byte ptr
+hichar==: 177		; the highest char (must be 177, 377, or 777 !)
+%lbchr==: .1stwd ascii ""
+%eschr==: .1stwd ascii "\"
+
+; macros start here
+define	.here	label
+label==.-proc$
+termin
+
+; $catch starts a catch level for error handlers
+define	$catch	var
+dd%==dd%+1
+pushsym	ca%,dd%
+pushsym	co%,co%$
+co%$==.
+hrrom	sp,var
+termin
+
+; $cause is  used  to signal  an  exception within  in  a  clu
+; routine. The name of the  error is a standard argument  that
+; should refer  to an  exception descriptor.  the num  is  the
+; literal number  of  arguments  given to  be  signalled  (not
+; including name), and a bunch of arguments may be given along
+; with the call  (or arguments  may be  pushed first).  Unlike
+; signal, $cause does not transfer control out of the frame.
+define	$cause	name,num,[bunch]
+args	bunch
+movei	rr,num
+push	sp,rr
+tdlink	.caul,.caur,name
+push	sp,.caul(.caur)
+jsp	xr,causer
+termin	
+
+; $cont restarts a loop started by $loop
+define	$cont
+symn jrst lp%,\lp%,(pr)
+termin
+
+; $crtnb test returns true if the test skips, false otherwise
+define	$crtnb	test/
+test
+$rtnc	$false
+$rtnc	$true
+termin
+
+; $crtnc reg,cond,caddr; tests the register for the condition
+; (l,le,e,n,g,ge) and returns the constant at caddr if the cond is true.
+define	$crtnc	reg,cond,caddr
+jump!cond	reg,caddr+1
+rtn$==rtn$+1
+termin
+
+; $crtnrr reg,cond; tests the register for the condition
+; (l,le,e,n,g,ge) and returns rr if the condition is true.
+define	$crtnrr	reg,cond
+jump!cond	reg,exiter
+rtn$==rtn$+1
+termin
+
+; $elf is an else-if construct useful in case statements, etc.
+; it is used much like $if, except that it does not start a new level
+; of conditional, and needs no matching $fi.
+define	$elf line/
+$else	line
+termin
+
+; $else starts the else-clause of the conditional, and is
+; optional. the else-clause is terminated by $fi.
+define	$else line/
+symn	jrst	f%,\if%$,-proc$(pr)
+symn	e%,\el%$,==.
+e%==e%+1
+el%$==e%
+line
+termin
+
+; $etagcase finishes up a tagcase.
+define	$etagcase
+$fi
+popsym	tag%
+termin
+
+; $except starts an exception handler for the current catch level.
+define	$except	var,[names,vars,labels]
+symn	jrst dd%,\ca%$,(pr)
+ifge	co%$,[co%$==co%$-.,,co%$]
+.exc==0
+irp	each,,names
+	.exc==.exc+1
+	termin
+.exx==.exc,,.-proc$
+pushsym	z%,co%$
+pushsym	z%,.exx
+pushsym z%,var&ones
+irp	name,,names
+	pushsym	z%,name
+	termin
+irp	each,,labels
+	$label	each
+	termin
+.flg==0
+irp	each,,vars
+	ifse	each,*,{.flg==1
+			.istop}
+	pop	sp,each
+	termin
+ife	.flg,{
+	hrr	sp,var
+	}
+termin
+
+; this is necessary prior to the arguments for a $myield
+define	$fakef
+push	sp,$none
+push	sp,$none
+termin
+
+; $fi terminates a conditional statement or expression.
+define	$fi
+symn	e%,\el%$,==.
+symn	f%,\if%$,==.
+popsym	if%
+popsym	el%
+termin
+
+; $for starts a for-loop  using an iterator  given by iter,  a
+; variable given by var (special case for rr), and a label  to
+; name the loop.
+define	$for	label,[var],iter/
+iter
+$go	label
+.for.==0
+.for1==0
+irp	each,,var
+	.for.==.for.+1
+	termin
+ifg	.for.-1,[
+	massn	var
+	]
+ife	.for.-1,[
+	irp	each,,var
+		assn	each,rr
+		termin
+	]
+termin
+
+; $frame makes a frame in a qproc
+define	$frame
+jsp	r0,framer
+termin
+
+; $gents generates all entry blocks
+define	$gents
+tvec+m%+1
+litgen	m%
+0
+termin
+
+; $go is used to perform a forward jump inside a procedure.
+; l is a label that is local to the procedure.
+define	$go l
+if2	[.la==0
+	.6bit=='l
+	.lag==0
+	repeat	g%,[
+		.la==.la+1
+		symn	.lax==l6%,\.la
+		symn	.lap==lm%,\.la
+		ife	.lap-proc$,[
+			ife	.lax-.6bit,[.lag==.la]
+			]
+		]
+	kvetch	.lag,e,Can't $go to non-existent label l !
+	symn	jrst	g%,\.lag,(pr)
+	]
+if1	[0]
+termin
+
+; $if starts a conditional statement or expression. the result
+; is dependent on  the last instruction  before the $then.  if
+; that  instruction  skips,  the  $then  block  is   executed,
+; otherwise the $else block is exected. this may be nested  to
+; 64. levels.
+define	$if line/
+f%==f%+1
+pushsym	if%,if%$
+if%$==f%
+e%==e%+1
+pushsym	el%,el%$
+el%$==e%
+line
+termin
+
+; $iff is like $ift, except that false causes $then, true causes
+; $else to be executed.
+define	$iff line/
+$if	$testf	line
+termin
+
+; $ift is like $if,  except that it only  accepts one line  of
+; code for the test,  and the boolean  value in rr  determines
+; the branch executed (true causes $then, false cause $else).
+define	$ift line/
+$if	$test	line
+termin
+
+; $init initializes all sorts of stuff for the header files
+define	$init
+zap	[m%,p%,x%,r%,s%,n%,c%,e%,f%,q%,d%,dd%,cl%,ov%,rlink%,rpage%,rline%,vname%]
+termin
+
+; $itpop pops one level of iterator off the stack without  the
+; hair  of  actually  resuming,   and  returns  to  the   next
+; instruction
+define	$itpop
+jsp	xr,itpop
+termin
+
+; $label is used to define a label for $go's
+define	$label l
+if1	[
+	pushsym	g%,.-proc$
+	pushsym	l6%,'l
+	pushsym	lm%,proc$
+	]
+termin
+
+; $loop is used to start a loop inside a procedure. loops  may
+; be nested. getting out of a loop may be done with a $go or a
+; $rtn.
+define	$loop
+pushsym	lp%,.-proc$
+termin
+
+; $mrtn n,[bunch]  returns an  n-tuple of  objects (which  are
+; pushed onto the stack) from  a function. it creates code  to
+; be executed by  the mexit routine,  which also performs  the
+; appropriate exit stuff. the br register is set up to do  the
+; blt from top of stack to top of stack, and (sp) is set up to
+; have the difference between the number of return objects and
+; the number of arguments.
+define	$mrtn	n,[bunch]
+rtn$==rtn$+1
+args	bunch
+.n.==n
+.m.==.n.&ones
+.r.==.n.&777777000000
+.f.==0
+ifn	.r.,{
+	movei	rr,.m.(.r.)
+	hrli	rr,(tmrtn)
+	hrrz	r0,sp
+	subi	r0,-1(rr)
+	movei	br,-1-narg$(er)
+	hrl	br,r0
+	jrst	mexit
+	.stop}
+ife	.r.,{
+	link	.m.,tmrtn+.n.
+	move	rr,.m.(lr)
+	movei	br,-1-narg$(er)
+	hrli	br,1-.n.(sp)
+	jrst	mexit
+	.stop}
+termin
+
+; $myield n,[bunch] does the same  thing as $mrtn except  that
+; it yields multiple objects instead of returning them.
+define	$myield	n,[bunch]
+args	bunch
+link	.m.,tmrtn+n
+assn	rr,.m.(lr)
+jsp	xr,myield
+termin
+
+; $pool terminates a loop.
+define	$pool
+kvetch	lp%$,e,A $pool has occurred without a corresponding $loop !
+popsym	lp%
+symn jrst ,\lp%$,(pr)
+termin
+
+; $qrtn item,cut; is used to put  the item into rr and to  cut
+; back the stack and quickly exit.
+define	$qrtn	item,cut
+ifsn rr,item,{move	rr,item}
+subi	sp,cut
+jrst	exitex
+rtn$==rtn$+1
+termin
+
+; $resume resumes the iterator closest on the stack.
+define	$resume
+jrst	resume
+termin
+
+; $rof terminates the loop labelled by label.
+define	$rof	label
+jrst	resume
+$label	label
+termin
+
+; $rtn returns the object given by obj, which is special cased
+; for rr.
+define	$rtn	obj
+ifsn rr,obj,{move	rr,obj}
+jrst	exiter
+rtn$==rtn$+1
+termin
+
+; $rtnc returns a constant, which must have a jsp xr,exitc  at
+; one after the object!!!!
+define	$rtnc	obj
+jrst	obj+1
+rtn$==rtn$+1
+termin
+
+; $tag generates the  code to conditionally  perform the  next
+; code based on whether the tag matches the integers given  in
+; the list.
+define	$tag	[taglst]
+ifn	tag%$,{
+	$elf
+	}
+tag%$==tag%$+1	
+.tag.==.
+irp	each,,taglst
+	cain	n1,each
+	skipa
+	termin
+ife	.-.tag.,{
+	skipa
+	}
+	$then
+termin
+
+; $tagcase starts the  code for a  tagcase statement. the  var
+; given is the current variable for tagcasing. the save  given
+; is an auxilliary variable given to save the old contents  of
+; the variable.
+define	$tagcase	var,save
+refchk	rr,var
+repchk	rr,torep
+hrrz	n1,(rr)
+ifsn	save,,{movem	rr,save}
+move	rr,1(rr)
+ifsn	rr,var,{movem	rr,var}
+pushsym	tag%,tag%$
+tag%$==0
+$if
+termin
+
+; $test skips if rr holds true
+define	$test	line/
+line
+came	rr,$true
+termin
+
+; $testf is like $test, except that it skips on false.
+define	$testf	line/
+line
+came	rr,$false
+termin
+
+; $then starts the then-clause of the conditional statement.
+; the then-clause is terminated by $else, $fi, or $elf.
+define	$then line/
+symn	jrst	e%,\el%$,-proc$(pr)
+line
+termin
+
+; $uncatch ends a catch block, the stack is restored.
+define	$uncat var
+symn	dd%,\ca%$,==.-proc$
+popsym	ca%
+ifn	ca%,{symn	ca%$==ca%,\ca%,
+	}
+popsym	co%
+hrr	sp,var
+termin
+
+; $yield yields an object in the iterator fashion. rr contains
+; the yielded object.
+define	$yield	obj
+assn	rr,obj
+jsp	xr,yield
+termin
+
+; alloc amount,reg assumes that the  amount is expressed in  a
+; form fit for a movni rr,amount;  which puts the negative  of
+; the amount  into  rr. Then  the  allocation takes  place  by
+; adding that number to  $memhi. If the  amount is dynamic  or
+; more than a page then a check is done for stack collision (a
+; collision causes a GC). The reg argument is assumed to be  a
+; register that holds  a code word  to be out  into the  first
+; word of the allocated memory. Note that a procedure that has
+; an explicit alloc must not allow asynchronous interrupts  to
+; occur since  rr and  $memhi can  be in  funny states  midway
+; through an alloc.
+define	alloc	size,codreg
+propt%==propt%\prc.ni
+movni	rr,size
+addb	rr,$memhi
+camg	rr,$stkhi
+ pushj	sp,memout
+movem	codreg,(rr)
+termin
+
+; anyize  thing,type; gives the thing the given type code
+define	anyize	thing,type
+push	sp,thing
+typreg	rr,type
+hrrz	n0,rr
+caie	n0,t%any
+dpb	rr,$typbp
+pop	sp,thing
+termin
+
+; args is used to push a list of arguments
+define	args [bunch]
+irp each,,bunch
+	push	sp,each
+	termin
+termin
+
+; arrgen nargs; makes an array from nargs on top of the stack,
+; where the low bound is the bottom-most argument.
+define	arrgen	nargs
+movei	r1,-nargs+2(sp)
+hrli	r1,-nargs+1
+jsp	xr,amake
+move	n1,-nargs+1(sp)
+hrrm	n1,ar.cod(rr)
+subi	sp,nargs
+termin
+
+; assn  is   used  to   assign   one  variable   to   another.
+; registers may be  used as  variables, as may  slots  in  the
+; linkage section. rr  is creamed by  the  execution of  assn,
+; and is recognized as a special case.
+define	assn x,y
+ifsn rr,y,{
+	move	rr,y}
+ifsn rr,x,{
+	movem	rr,x}
+termin
+
+; call calls  the procedure  with  the clu  name given  by  p,
+; number of  arguments  given by  n,  and arguments  given  by
+; bunch. arguments  may  be pushed  prior  to using  call,  of
+; course. a procedure call block (pcb) is put into the linkage
+; section (or cluster parm sect or proc parm sect) for use  by
+; the runtime system.
+define	call	[p],nargs,[bunch]
+.nargs==nargs+0
+kvetch	-pgsize&.nargs,n,Bad number of arguments: nargs !
+args	bunch
+pnchk	.ccv,.ccf,.cct,.ccs,p
+rlinkx	.ccr,6,[tcrep+pc.dat ? jlink ? .nargs ? .ccs ? .cct ? .ccv ]
+ife	.ccf,{
+	link	.ccl,tpcb+.ccr
+	move	mr,.ccl(lr)
+	xct	en.set(mr)
+	.stop}
+ifn	.ccf&tdc.pp,{
+	pplink	.ccl,tpcb+.ccr
+	hlro	r0,en.par(mr)
+	move	mr,.ccl(r0)
+	xct	en.set(mr)
+	.stop}
+ifn	.ccf&tdc.cp,{
+	cplink	.ccl,tpcb+.ccr
+	hrro	r0,en.par(mr)
+	move	mr,.ccl(r0)
+	xct	en.set(mr)
+	.stop}
+termin
+
+; cluster starts the  definition of a  cluster, where name  is
+; the clu name for the cluster, rep is the type object for the
+; cluster's representation, parms is a list of internal  names
+; for the  cluster parameters,  and  opers is  a list  of  the
+; internal names of the externally available operations of the
+; cluster. the cluster name is  the first item in the  linkage
+; section.
+define	cluster	name,atype,rep,[parms],[opers]
+printc	/
+cluster name
+/
+.atype==atype+0
+pushsym	m%,.atype
+rep$==rep+0
+zap	[l%,cp%,qproc%,propt%,od%opt,od%,.tflg]
+slink	lnk,name
+ifn	.atype,[.tflg==.atype&typmsk-<tcpd&typmsk>]
+ife	.tflg,{
+	ctype%==tcpd
+	pushsym	cp%,.atype
+	pushsym	cp%,rep$
+	}
+ifn	.tflg,{
+	ctype%==ttd
+	pushsym	l%,.atype
+	pushsym	l%,rep$
+	}
+irp parm,,parms
+	pushsym	cp%,parm
+	termin
+pushsym	c%,.
+if2	{symn	link$==cl%,\c%
+	 ifn link$,[link$==link$+refs$]
+	 symn	cparm$==d%,\c%
+	 ifn cparm$,[cparm$==cparm$+refs$]
+	 symn	odata$==ov%,\c%
+	 ifn odata$,[odata$==odata$+refs$]
+	 }
+termin
+
+; corp terminates the definition of a procedure or  operation.
+; name is the  external name for  the procedure (must  include
+; cluster name). anames are the clu names for the arguments to
+; the procedure, and vnames  are the clu  names for the  local
+; variables.
+define	corp name,[anames,vnames]
+kvetch	rtn$,e,Warning: no $rtn's found in procedure.
+jrst	frog
+kvetch	if%$,n,Outstanding $if's, I think !
+kvetch	el%$,n,Not all $if's properly ended !
+kvetch	lp%,n,Not all $loops are kosher !
+kvetch	ca%,n,Not all $catch blocks ended !
+.perr.==.-proc$
+kvetch	.perr.,l,Oh SHIT: end of procedure is before its beginning !
+litgen	z%
+.pname.==.-proc$
+strlit	name
+narg$x==0
+irp aname,,anames
+	strlit aname
+	narg$x==narg$x+1
+	termin
+kvetch	narg$x-narg$,n,Warning: number of arguments in corp and proc disagree.
+ifn	vname%,[
+	irp vname,,vnames
+		strlit	vname
+		termin
+	vname%==0
+	]
+.psize.==.-proc$
+..vi==0
+ifn	v%,{..vi==v%(1)}
+vecgen	...vi,v%
+if1	[symn	vi%,\p%,==..vi+(...vi)
+	]
+ifn	errflg,[
+	printc	/
+name may have errors in it.
+/
+errflg==0]
+vecgen	..q%,pp%
+pushsym	q%,..q%
+if1	[pushsym	s%,.psize.
+	 pushsym	n%,.pname.
+	 pushsym	x%,.perr.+(propt%)
+	]
+zap	[qproc%,propt%,od%opt]
+termin
+
+; cpdesc creates a type descriptor for a cluster parm
+define	cpdesc	name,str,pos
+string	.cdps,str
+.cpdp==pos+0
+rlinkx	name,5,[tdrep+5 ? 0 ? tdc.pa+tdc.cp ? .cdps ? .cpdp ]
+name==tcpd+name
+termin
+
+; cplink name,val; creates  a link  with named  offset to  the
+; given value in the cluster parameter section
+define	cplink	name,val/
+pushsym	cp%,val
+name==cp%
+propt%==propt%\prc.cp
+termin
+
+; croak is used to generate a simple error message that gets
+; sent to ddt, and is used to indicate some basic failure, or some
+; unimplemented feature.
+define	croak string/
+.croks==.length `
+: string 
+
+`
+.crok.==<.croks+bpword+bpword>/bpword
+purwrd	..crok,tsrep+.croks
+repeat	.crok.-1,[
+	.strw.==.nthwd .rpcnt+1,asciz `
+: string 
+
+`
+	purwrd	..str,.strw.
+	]
+u.crok	1+..crok
+termin
+
+define	cvtdown	thing
+ifg	tcflag,{
+	push	sp,thing
+	ife	ctype%-ttd,[hrroi r0,2(lr)]
+	ife	ctype%-tcpd,[hrro r0,en.par(mr) ? hrroi r0,2(r0) ]
+	skipg	rr,(r0)
+	 jsp	xr,notype
+	dpb	rr,$typbp 
+	pop	sp,thing
+	}
+termin
+
+define	cvtup	thing
+ifg	tcflag,{
+	push	sp,thing
+	ife	ctype%-ttd,[hrroi r0,1(lr)]
+	ife	ctype%-tcpd,[hrro r0,en.par(mr) ? hrroi r0,1(r0) ]
+	skipg	rr,(r0)
+	 jsp	xr,notype
+	dpb	rr,$typbp 
+	pop	sp,thing
+	}
+termin
+
+; edesc creates a descriptor for an exception. this is treated
+; like a type, even though it isn't really a type. it is a lot
+; easier to check if it canonicalized like a type, however.
+define	edesc	name,ename,[bunch]
+tdchk	.edv,.edf,.edt,bunch
+string	.eds,ename
+rlinkx	name,5,[ tdrep+5 ? 0 ? tdc.ed+.edf ? .eds ? .edv ]
+name==.edt+name
+termin
+
+; this macro implements what erjmp SHOULD do
+define	ergo	loc
+ercal	ergot
+jump	loc
+termin
+
+define	fail	str
+ifn	qproc%,[jsp r0,framer]
+move	rr,str
+jsp	xr,nixon
+termin
+
+; fakef creates a  fake frame  on top  of the  stack with  two
+; words reserved  for  the frame.  this  must be  used  before
+; pushing values for a $myield!
+define	fakef
+$fakef
+termin
+
+; fixup places the values given  (v) starting at the  location
+; given (l), then restores the location counter.
+define	fixup	l,[v]
+.fix.==.
+.==l
+irp	each,,v
+	each
+	termin
+.==.fix.
+termin
+
+; force thing,type; insists  that the  given thing  is of  the
+; given type and leaves the thing in rr
+define	force	thing,type
+push	sp,thing
+typreg	rr,type
+ldb	n1,$typbp
+caie	n1,(rr)
+ jsp xr,badtyp
+pop	sp,rr
+termin
+
+; gettyp reg,src gets the type code from the src into the reg
+define	gettyp	reg,src
+.r==src
+hlrz	reg,src
+andi	reg,(typmsk)
+termin
+
+; icall calls an iterator instead of a procedure.
+define	icall	[p],n,[bunch]
+call	p,n,bunch
+termin
+
+; intoff disallows interrupts when we are doing something sneaky
+define	intoff
+aos	$intlock
+termin
+
+; inton allows interrupts when we are squeaky clean
+define	inton
+sosg	$intlock
+jsp	xr,yldout	; **** TEMP until chkout is present ****
+termin
+
+; isref	reg,src skips  if  src  is a  reference,  and  as  a
+; side-effect puts src into reg
+define	isref	reg,src
+skipl	reg,src
+termin
+
+; isrep	reg,type skips  if reg  points  to object  with  the
+; given rep type code (ref check assumed done)
+define	isrep	reg,type
+.t==type
+ife	.t&ones,[.t==(.t)]
+hlrz	n0,(reg)
+caie	n0,.t
+termin
+
+; isrsb	reg,src skips if src is  data, and as a  side-effect
+; puts src into reg
+define	isrsb	reg,src
+skipge	reg,src
+termin
+
+define	itdesc	iname,[args,ylds,sigs]
+pidesc	iname,tdc.it,args,ylds,sigs
+termin
+
+define	iter p,[args,vars,vinit],ptype,[parms]
+propt%==propt%\prc.it
+proc	p,args,vars,vinit,ptype,parms
+termin
+
+define	kvetch	expr,cond,line/
+if!cond	expr,[
+	.err	line
+	errflg==1	]
+termin
+
+; link creates a link to a literal word that gets placed in the
+; linkage section such that name is the offset.
+define	link name,liter/
+pushsym	l%,liter
+name==l%
+termin
+
+; litgen generates all current literals of the form x$n, where 
+; n is  an  octal number  from  0 to  x$-1.  this is  used  to
+; generate accumulated constants at convenient times.
+define	litgen x
+if1 {.=.+x
+    x==0
+    .stop}
+repeat	x,[
+	.x==.rpcnt+1
+	symn	x,\.x,
+	]
+x==0
+termin
+
+; massn is used to do a multiple assignment of objects to  the
+; given variables. rr  is presumed to  have a multiple  return
+; type value which  gives the number  of objects coming  back.
+; the assignments are made in  reverse order, though! so,  for
+; "x,y  :=   p(...)"  the   macro  must   be  written   "massn
+; [y(er),x(er)]".
+define	massn	[dst]
+.n.==0
+irp	each,,dst
+	.n.==.n.+1
+	termin
+mcheck	.n.
+irp	each,,dst
+	pop	sp,each
+	termin
+termin
+
+; mcall is used for internal  clu support system calls,  since
+; it presupposes  that  one  knows where  one  is  calling  at
+; assembly time.
+define	mcall p,[bunch]
+args	bunch
+..p==0
+if2	[..p=movei mr,p
+	 ife	..p&(17),{
+		 ifl	<..p&ones>-refs$,{
+			..p==..p+refs$
+			}
+		}
+	]
+..p
+xct	en.set(mr)
+termin
+
+; mcheck is used to check that  rr has a multiple return  type
+; value with n objects.
+define	mcheck n
+link	mrtn$,tmrtn+<n>
+came	rr,mrtn$(lr)
+jsp	xr,badrtn
+termin
+
+; mflush flushes the  arguments on the  stack after a  routine
+; that returns multiple arguments returns. No action is  taken
+; if rr does not contain a multiple return value.
+define	mflush
+hlrz	n1,rr
+cain	n1,(tmrtn)
+ subi	sp,(rr)
+termin
+
+; nprint is used to print a number
+define	nprint	prefix,num,rest
+printc	`prefix num rest
+`
+termin
+
+define	odget	reg,disp
+move	r0,en.odv(mr)
+move	reg,disp(r0)
+termin
+
+define	odlink	disp,init
+pushsym	od%,init+0
+disp==od%
+termin
+
+define	odset	reg,disp
+move	r0,en.odv(mr)
+movem	reg,disp(r0)
+termin
+
+define	oduse
+od%opt==1
+termin
+
+; pcall calls a ref generated by pcdesc
+define	pcall	ref,[bunch]
+args	bunch
+..pcal==ref
+if2	[ifl <..pcal&ones>-refs$,{..pcal==..pcal+refs$}]
+tdlink	.tal,.tar,..pcal
+move	mr,.tal(.tar)
+xct	en.set(mr)
+termin
+
+; pcdesc sets iname to a ref to a pcb
+define	pcdesc	iname,[pspec],nargs
+.ccn==nargs+0
+pnchk	.ccv,.ccf,.cct,.ccs,pspec
+rlinkx	.ccr,6,[tcrep+pc.dat ? jlink ? nargs ? .ccs ? .cct ? .ccv ]
+iname==ttd+.ccr
+ifn	.ccf&tdc.cp,[iname==tcpd+.ccr]
+ifn	.ccf&tdc.pp,[iname==tppd+.ccr]
+termin
+
+; pdesc creates a descriptor for a procedure object
+define	pdesc	iname,[spec]
+pnchk	.pdv,.pdf,.pdt,.pdn,spec
+rlinkx	.pd,6,[ tdrep+6 ? 0 ? tdc.xr+.pdf ? .pdn ? .pdt ? .pdv ]
+iname==ttd+.pd
+ifn	.pdf&tdc.cp,[iname==tcpd+.pd]
+ifn	.pdf&tdc.pp,[iname==tppd+.pd]
+termin
+
+; pidesc creates  a type  descriptor for  the return  type  of
+; either a procedure or iterator
+define	pidesc	iname,kind,[args,rtns,sigs]
+tdchk	.piv1,.pif1,.pit1,args
+tdchk	.piv2,.pif2,.pit2,rtns
+tdchk	.piv3,.pif3,.pit3,sigs
+rlinkx	.pid,7,[tdrep+7 ? 0 ? kind\.pif1\.pif2\.pif3 ? 0 ? .piv1 ? .piv2 ? .piv3 ]
+iname==.pit1+.pid
+ifg	.pit2-iname,[iname==.pit2+.pid]
+ifg	.pit3-iname,[iname==.pit3+.pid]
+termin
+
+; pnchk sets  the  typ  and nam  arguments  depending  on  the
+; procedure spec given. If  there is just  one element to  the
+; spec then it is a simple unadorned procedure name. If  there
+; is more than one element, then the first is a type (or  type
+; desc), the  second is  the operation  name (without  cluster
+; name or $),  and the  remaining elements  are the  procedure
+; parameters. The vec  arg gets set  to a vector  ref for  the
+; procedure parms, The flg arg gets  set as is does for  tdchk
+; (to show  parm dependence).  The  typ arg  gets set  to  the
+; cluster type  (0 if  none). The  name arg  gets set  to  the
+; procedure (or operation) name.
+define	pnchk	vec,flg,typ,name,[spec]
+zap	[.pnc,.pnf,.pnff,.pnt,name,vec,typ,flg]
+irp	each,,spec
+	.pnc==.pnc+1
+	termin
+ife	.pnc-1,{
+	string	name,spec
+	.stop}
+ifg	.pnc-1,[
+	.pnc==0
+	irp	each,rest,spec
+		.pnc==.pnc+1
+		ife	.pnc-1,[.pnt==each]
+		ife	.pnc-2,[
+			string	name,each
+			tdchk	vec,.pnff,.pnct,[rest]
+			.pnf==.pnf\.pnff
+			]
+		termin
+	ife	tppd&typmsk-<.pnt&typmsk>,[.pnf==.pnf\tdc.pp]
+	ife	tcpd&typmsk-<.pnt&typmsk>,[.pnf==.pnf\tdc.cp]
+	]
+typ==.pnt
+flg==.pnf
+termin
+
+; pops is used to pop things  from the stack to a given  bunch
+; of destinations.
+define	pops [bunch]
+irp each,,bunch
+	pop	sp,each
+	termin
+termin
+
+define	popsym	sym
+expung	sym!$
+ifg	sym,{
+	symn	sym!$==sym,\sym,
+	sym==sym-1}
+termin
+
+; ppdesc creates a type descriptor for a proc parm
+define	ppdesc	name,str,pos
+string	.ppds,str
+.ppdp==pos+0
+rlinkx	name,5,[tdrep+5 ? 0 ? tdc.pa+tdc.pp ? .ppds ? .ppdp ]
+name==tppd+name
+termin
+
+; pplink name,val; creates  a link  with named  offset to  the
+; given value in the procedure parameter section
+define	pplink	name,val/
+pushsym	pp%,val
+name==pp%
+propt%==propt%\prc.pp
+termin
+
+; proc starts  the  definition  of a  procedure  or  operation
+; within a cluster.  p is a  dummy except that  $p is a  label
+; that shows up in ddt for the basic system. args is a list of
+; internal names for the offsets  to the arguments, vars  does
+; the same  for the  variables,  while vinit  initializes  the
+; variables to something decent.
+define	proc p,[args,vars,vinit],ptype,[parms]
+zap	[pp%,errflg,if%,if%$,el%,el%$,lp%,lp%$,z%,rtn$,nvar$,narg$,ca%,ca%$,tag%,tag%$]
+zap	[errflg,.vin,.prf,co%,co%$,v%,..p,pparm$,..v]
+tdflg	.prf,ptype
+ifn	.prf&tdc.cp,[propt%==propt%\prc.cp]
+ifn	.prf&tdc.pp,[propt%==propt%\prc.pp]
+proc$==.
+irp	vin,,vinit
+	.vin==.vin+1
+	pushsym	v%,vin+0
+	termin
+irp var,,vars
+    nvar$==nvar$+1
+    var== nvar$
+    termin
+kvetch  .vin-nvar$,n,Warning: variable initialization of incorrect length.
+irp arg,,args
+    narg$== narg$+1
+    termin
+argdsp== -1-narg$
+irp arg,,args
+    arg==argdsp
+    argdsp==argdsp+1
+    termin
+irp parm,,parms
+	pushsym	pp%,parm
+	propt%==propt%\prc.pp
+	termin
+if2	[p%==p%+1
+	symn	..vi==vi%,\p%
+	ifn	..vi,{..vi==..vi+(refs$)}
+	..p==pushj sp,setup
+	ife	qproc%,[ife	..vi&ones,[..p==pushj sp,qsetup]]
+	ifn	qproc%,[..p==jsp xr,proc$+pr.go]
+	symn	pparm$==q%,\p%
+	ifn pparm$,[pparm$==pparm$+refs$]
+	]
+ptype$==ptype+0
+rlinkx	p,en.dat+od%opt,[terep+en.dat+od%opt ? ..p ? proc$(link$) ? ..vi ?
+		cparm$(pparm$) ? 0 ? ptype$ ? 0 ?
+		ifn	od%opt,{ tref+odata$}
+		]
+..newp==tref+p
+if2	[..m%==m%+1
+	 symn ..prep==m%,\..m%,+refs$
+	 ]
+pushsym	m%,..newp
+if2	[ifn	..prep-..newp,[.err Phase error on proc definition for p
+		nprint	old = ,\..prep
+		nprint	new = ,\..newp
+		]]
+$!p=.
+if1	[pushsym	p%,tref+.
+	.=.+pr.go]
+if2	[symn	tprep+s%,\p%
+	symn	x%,\p%
+	narg$+2
+	symn	n%,\p%
+	]
+termin
+
+define	ptdesc	iname,[args,rtns,sigs]
+pidesc	iname,tdc.pt,args,rtns,sigs
+termin
+
+; purgen generates the pure area
+define	purgen
+pur$lo:	litgen	r%
+pur$hi:	0
+termin
+
+; purwrd puts a purifiable word  into the pure area and   sets
+; the  name  to  be  OK  on  second  pass  (it  just  has  the
+; displacement on the first pass).
+define	purwrd	name,item
+name==r%
+r%==r%+1
+if1	{
+	.stop}
+name==name+pur$lo
+symn	r%,\r%,==item
+termin
+
+define	pushsym	sym,val
+sym==sym+1
+symn	sym,\sym,==val
+sym!$==val
+termin
+
+define	qproc	name,[args,vars,init],ptype,[pparms]
+qproc%==1
+proc	name,args,vars,init,ptype,pparms
+termin
+
+define	qsignal	name,num,[bunch]
+signal	name,num,bunch
+termin
+
+; Recgen [list] assumes that the components of the record have
+; been pushed onto the stack, but not in the right order  (but
+; it works if they are in order, also). The list given is  the
+; list of displacements in the record for the components (1 is
+; lowest disp, .c is highest disp).
+define	recgen	[list]
+.c==1
+irp	each,,list
+	.c==.c+1
+	termin
+movei	n1,.c
+jsp xr,vmake
+irp	each,,list
+	pop	sp,each(rr)
+	termin
+termin
+
+define	refchk	reg,src
+skipl	reg,src
+jsp	xr,notref
+termin
+
+define	repchk	reg,type
+.t==type
+ife	.t&ones,[.t==(.t)]
+hlrz	n0,(reg)
+caie	n0,.t
+jsp	xr,badrep
+termin
+
+define	reti name,[anames,vnames]
+corp name,anames,vnames
+termin
+
+; retsulc terminates the definition of a cluster with the name
+define	retsulc name,[parms]
+vecgen	..cl%,l%
+pushsym	cl%,..cl%
+vecgen	..d%,cp%
+pushsym	d%,..d%
+vecgen	..ov%,od%
+pushsym	ov%,..ov%
+termin	
+
+define	rlink	name,[items]
+.err	You can no longer use rlink! Use rlinkx instead!
+name==0
+termin
+
+define	rlinkx	name,size,[items]
+if1	[name==rlink%
+	items
+	rlink%==rlink%+size
+	.==.-1
+	]
+if2	[name== items
+	 ifn	rlink%,{
+		ifn	name-rlink%,{
+			radix	10.
+			rlinke	\rpage%,\rline%,\rsize%
+			radix	8
+			}
+		}
+	 rlink%==name+size
+	 rline%==.curln
+	 rpage%==.curpg
+	 rname%==sixbit |name|
+	 rsize%==size
+	 ]
+termin
+
+define	rlinke	pg,ln,siz
+.err	Warning: Bad rlinkx on page pg, line ln 
+printc	|				Name: |
+.tyo6	rname%
+printc	|, Size: siz
+|
+termin
+
+; rsbchk reg,src puts the src into the reg and checks to  make
+; sure that the thing  put there is  indeed raw seething  bits
+; (sign bit off)
+define	rsbchk	reg,src
+skipge	reg,src
+jsp	xr,notrsb
+termin
+
+; rtdesc creates a type  descriptor that specifies the  return
+; type of the given procedure.
+define	rtdesc	iname,[pspec]
+pnchk	.rtv,.rtf,.rtt,.rtn,pspec
+rlinkx	.rtd,6,[tdrep+6 ? 0 ? tdc.rt+.rtf ? .rtn ? .rtt ? .rtv ]
+iname==ttd+.rtd
+ifn	.rtf&tdc.cp,[iname==tcpd+.rtd]
+ifn	.rtf&tdc.pp,[iname==tppd+.rtd]
+termin
+
+define	scall	str,num,[bunch]
+.ccn==num+0
+kvetch	-100&.ccn,n,Bad number of arguments: nargs !
+args	bunch
+rlinkx	.ccr,6,[tcrep+pc.dat ? jlink ? .ccn ? str ? 0 ? 0 ]
+link	.ccl,tpcb+.ccr
+move	mr,.ccl(lr)
+xct	en.set(mr)
+termin
+
+; sdesc creates  the type  descriptor for  general types  with
+; string  selectors  (or  any  canonicalized  selectors)   for
+; arguments.
+define	sdesc	iname,xname,[bunch]
+tdchk	.tdv,.tdf,.tdt,bunch
+string	.tds,xname
+ife	.tdv,[.tdf==tdc.cp ? .tdt==tcpd]
+rlinkx	iname,5,[tdrep+5 ? 0 ? tdc.sd\.tdf ? .tds ? .tdv ]
+iname==.tdt+iname
+termin
+
+; signal is used to signal an exception in a clu routine.  the
+; name of the error is  a standard argument that should  refer
+; to an exception descriptor. the num is the literal number of
+; arguments given to be signalled (not including name), and  a
+; bunch of  arguments may  be given  along with  the call  (or
+; arguments may be pushed first).
+define	signal	name,num,[bunch]
+ifn	qproc%,[jsp r0,framer]
+args	bunch
+movei	rr,num
+push	sp,rr
+tdlink	.sigl,.sigr,name
+push	sp,.sigl(.sigr)
+jsp	xr,siggy
+termin	
+
+; slink creates  a link  to a  string such  that name  is  the
+; offset in the  linkage section for  the string reference  to
+; string.
+define	slink name,str/
+string	.slink,str
+link	name,.slink
+termin
+
+; string generates a string literal and assigns the code to name
+define	string	name,lit/
+.c==.1stwd ascii "lit"
+.c==.c&(774000)
+.q==%lbchr
+ife %lbchr-.c,{ irpc one,rest,lit
+		name==rest
+		.istop
+		termin
+	    .stop
+		}
+.str.==.lengt "lit"
+ife	.str.-4,{
+	ife	%eschr-.c,{
+		irpc one,rest,lit
+			name==tstr+rest
+			.istop
+			termin
+		.stop
+		}}
+ifle .str.,{
+	name==(%str)+nulls$
+	.stop}
+ife .str.-1,{
+	name==tstr+"lit
+	.stop}
+..str.==<.str.+bpword+bpword-1>/bpword
+purwrd	..str,tsrep+.str.
+name== (%str)+..str
+repeat	..str.-1,[
+	.strw.==.nthwd .rpcnt+1,ascii "lit"
+	purwrd	..str,.strw.
+	]
+termin
+
+; strlit generates  a string  literal  with the  in-line  word
+; being the reference to the string.
+define	strlit str/
+string	.strl.,str
+.strl.	
+termin
+
+; stypi reg,code sets the type code into the reg provided that
+; we are maintaining such codes. The ref bit is unchanged.
+define	stypi	reg,code
+ifg	typgen,[
+	.c==code
+	ife	.c&ones,[.c==(.c)]
+	tlz	reg,(typmsk)
+	tlo	reg,.c&(typmsk)
+	]
+termin
+
+; stypix reg,code sets  the type  code into  the reg  provided
+; that we are maintaining  such codes. The ref  bit is set  by
+; the type code.
+define	stypix	reg,code
+.c==code
+ife	.c&ones,[.c==(.c)]
+hrli	reg,.c
+termin
+
+; symn is a kludge designed to get around the miserable  midas
+; way of converting symbol values  to strings. n is usually  a
+; number generated between s and rest.
+define	symn s,n,rest/
+s!n!rest
+termin
+
+; tdchk sets the  rp and flg  args depending on  the bunch  of
+; type descriptors given.  The  rp gets a ref  to a vector  of
+; the parameters,  while  the flg  is  zero for  no  parameter
+; dependencies, and  has the  tdc.pp or  tdc.cp bits  set  for
+; appropriate other dependencies. An empty bunch returns rp  =
+; 0, flg = 0.
+define	tdchk	rp,flg,typ,[bunch]
+zap	[rp,.tdcm,.tdcf,.rpc]
+.tdct==ttd
+irp	each,,bunch
+	.tdcm==.tdcm+1
+	tdflg	.tdcf,each
+	termin
+ifg	.tdcm,[	rlinkx	rp,.tdcm+1,[tvec+.tdcm+1 ? irp each,,bunch ? each ? termin ]
+	        rp==tref+rp]
+ifn	.tdcf&tdc.cp,[.tdct==tcpd]
+ifn	.tdcf&tdc.pp,[.tdct==tppd]
+flg==.tdcf
+typ==.tdct
+termin
+
+; tdesc creates the type descriptor for general types.
+define	tdesc	iname,xname,[bunch]
+tdchk	.tdv,.tdf,.tdt,bunch
+string	.tds,xname
+rlinkx	iname,5,[tdrep+5 ? 0 ? tdc.td+.tdf ? .tds ? .tdv ]
+iname==.tdt+iname
+termin
+
+; tdflg sets the flags with tdc codes depending on the thing
+define	tdflg	flg,thing
+ife	tppd&typmsk-<thing&typmsk>,[flg==flg\tdc.pp]
+ife	tcpd&typmsk-<thing&typmsk>,[flg==flg\tdc.cp]
+termin
+
+; tdlink creates a link to a type descriptor, possibly setting
+; r1 with the right vector address  lnk gets set to the  disp,
+; and reg gets set to the right reg
+define	tdlink	lnk,reg,thing
+ife	thing&typmsk-<tppd&typmsk>,{
+	pplink	lnk,thing
+	hlrz	r1,en.par(mr)
+	reg==r1
+	.stop}
+ife	thing&typmsk-<tcpd&typmsk>,{
+	cplink	lnk,thing
+	hrrz	r1,en.par(mr)
+	reg==r1
+	.stop}
+link	lnk,thing
+reg==lr
+termin
+
+; typarg causes a  bunch of  type descriptors  to be   pushed,
+; regardless of whether they  are parameter-dependent or  not.
+; this code can  clobber any reg  <= xr. Type-descriptors  get
+; snapped.
+define	typarg	[bunch]
+irp	each,,bunch
+typreg	rr,each
+push	sp,rr
+termin
+termin
+
+; typreg  generates  code  to  put   a  type  code  (or   type
+; descriptor) into  a register  given by  reg. this  code  can
+; clobber any reg <= xr. Type-descriptors get snapped.
+define	typreg	dst,td
+tdlink	.tal,.tar,td
+hrroi	r0,.tal(.tar)
+skipg	rr,(r0)
+jsp	xr,notype
+assn	dst,rr
+termin
+
+; vargen var,vinit;  generates a  new  variable that  will  be
+; initialized to  vinit,  and  makes var  the  offset  of  the
+; variable so  that  var(er)  will be  the  address  when  the
+; procedure is run.
+define	vargen	var,vinit
+nvar$==nvar$+1
+var==nvar$
+.vin==.vin+1
+pushsym v%,vinit+0
+termin
+
+define	vecgen	name,vec
+..vnam==0
+..vgen==vec&ones
+ifn	..vgen,{
+	rlinkx	..vnam,..vgen+1,[tvec+1+..vgen
+		.x==0
+		repeat	..vgen,[
+			.x==.x+1
+			symn	vec,\.x,
+			]
+		]
+	}
+name==..vnam
+vec==0
+termin
+
+; xcall calls a procedure that is pointed to by rr.
+define	xcall	thing,n,[bunch]
+args	bunch
+ifsn	thing,,[assn rr,thing]
+hrrz	mr,rr
+xct	en.set(mr)
+termin
+
+define	zap	[stuff]
+irp	each,,stuff
+	each==0
+	termin
+termin
+
+; zdesc creates a descriptor for a procedure object vector for
+; selector-type clusters only!
+define	zdesc	iname,xname
+string	.zds,xname
+rlinkx	.pd,5,[ tdrep+5 ? 0 ? tdc.zd+tdc.cp ? .zds ? 0]
+iname==tcpd+.pd
+termin
+
+; Setup some first-pass quantities for $label & $go
+zap	[g%,g%$,l6%,l6%$,lm%,lm%$,rlink%]
+
\ No newline at end of file
diff --git a/src/clusys/types.1 b/src/clusys/types.1
new file mode 100644
index 00000000..30602f6e
--- /dev/null
+++ b/src/clusys/types.1
@@ -0,0 +1,171 @@
+;;;;	TYPES	;;;;
+
+if1,[
+typlo=:400
+refbit=:400000
+relbit=:200000
+repbit=:200000
+gcbit=: 100000
+typmsk=:(07777)
+
+;	offsets for blocks used in the CLU support system.
+
+;	arep,array_rep
+ar.cod==: 0	; tarep+low_bound
+ar.rel==: 1	; [rsb,,rel] -size,,rel to usable stuff in vector
+ar.vec==: 2	; [rsb,,ref] predict,,ref to real vector
+
+;	crep,call_block_rep
+pc.cod==: 0	; tcrep+size (in words)
+pc.set==: 1	; [rsb] the setup for the procedure (pc.set=en.set !!)
+pc.num==: 2	; [rsb] the number of arguments given in the call
+pc.str==: 3	; [ref] the external name (or operation name)
+pc.typ==: 4	; [ref] the cluster type (if an operation)
+pc.par==: 5	; [ref] parms given for the procedure
+pc.dat==: 6	; any more words are refs
+
+;	drep,descriptor_rep
+td.cod==: 0	; [rsb] code for type desc & length
+td.fix==: 1	; [ref] the fixed up value for the descriptor (init 0)
+td.opt==: 2	; [rsb] the variety of type desc
+td.nam==: 3	; [ref] string ref for external name (or 0)
+td.arg==: 4	; [ref] to parms or arguments (td,sd,pt,it,ed,zd)
+		; [ref] to cluster desc (rt,xr)
+		; [0,,rsb] position of parm (pa)
+td.rtn==: 5	; [ref] to return types (for pt,it)
+		; [ref] to proc parms (rt,xr)
+td.sig==: 6	; [ref] to signal types (for pt,it)
+
+;	option codes in td.opt (must be single bits)
+tdc.td==:1	; simple type desc
+tdc.sd==:2	; selected type desc
+tdc.pa==:4	; cluster/proc parm
+tdc.rt==:10	; return type desc
+tdc.pt==:20	; proc type desc
+tdc.it==:40	; iterator type desc
+tdc.ed==:100	; exception desc
+tdc.xr==:200	; external proc desc
+tdc.pp==:400	; proc parm dependent
+tdc.cp==:1000	; cluster parm dependent
+tdc.zd==:2000	; zdesc (for records/oneofs)
+
+;	erep,entry_rep
+en.cod==: 0	; terep+size (in words)
+en.set==: 1	; [rsb,,rel] the setup instruction to XCT (en.set=pc.set !!)
+en.lpr==: 2	; [ref,,ref] the (lr,,pr) pair
+en.vi==: 3	; [ref+1,,rsb] the variable init pair (ref+1,,len)
+en.par==: 4	; [ref,,ref] the (proc parm,,cluster parm) pair
+en.tr==: 5	; [rsb,,ref] the trace info (if any)
+en.typ==: 6	; [ref] the type (or type desc) for this entry
+en.nxt==: 7	; [ref] the chain of entry blocks (for parameters)
+en.dat==: 8.	; any more words are refs
+en.odv==: 8.	; [ref] optional vector to own data
+
+;	prep,pure_part_rep
+pr.cod==: 0	; tprep+size (in words)
+pr.err==: 1	; [rsb,,rsb] LH has prc codes, RH has disp to error info
+pr.cut==: 2	; [rsb] stack cutback on exit
+pr.nam==: 3	; [rsb] disp to names in pr block
+pr.go==:  4	; [rsb] first word of code here
+		; further words are [rsb], except that
+		; [ref]'s start where pr.err is an offset to
+
+; prc codes
+prc.ni==: 1	; no interrupts while this proc is current
+prc.cp==: 2	; this proc is dependent on cluster parms
+prc.na==: 4	; no array chopping while in this procedure
+prc.pp==: 10	; this proc is dependent on proc parms
+prc.it==: 20	; this proc is really an iterator
+prc.ma==: 40	; this proc is multi-argument (top one gives #)
+
+;	orep,oneof_rep
+on.cod==: 0	; torep+tag
+on.ref==: 1	; [ref] info part
+
+;	srep,string_rep
+st.cod==: 0	; tsrep+number_of_chars
+st.dat==: 1	; [rsb] characters immediately follow
+
+;	vec,vector
+ve.cod==: 0	; tvec+size (in words)
+ve.dat==: 1	; [ref] references follow
+
+;	wvec,word_vector
+wv.cod==: 0	; twvec+size (in words)
+wv.dat==: 1	; [rsb] words of raw seething bits follow
+
+;	xvec,ref_vector
+xv.cod==: 0	; txvec+size (in words)
+xv.dat==: 1	; [rsb,,ref] words in remainder
+
+fb.cod==0
+fb.dev==1
+fb.nm1==2
+fb.nm2==3
+fb.usr==4
+fb..==5
+
+;	deft is used to define types
+define	deft	name,xname
+if1	[t!name=:(.+typbit)
+	 t%!name=:.+typbit
+	 typnum==typnum+1]
+ife	usrflg,[
+	if1	[ [0 ? ascii	"xname"]
+		]
+	if2	[strlit xname
+		]
+	]
+ifn	usrflg,[.=.+1]
+termin
+typnum==0
+
+]	; end of first pass cond
+
+;	Fake a vector for the type codes.
+typlen==:100
+loc	typlo-2
+types$:	ife	usrflg,[tvec+typlen ? ttype+typusr-1 ]
+loc	typlo
+;	The most basic type codes to occur as LH of references
+typbit==refbit
+deft	ref,ref
+deft	xref,?ref
+typbit==refbit+relbit
+deft	rel,rel
+deft	xrel,?rel
+typrep==:.
+typbit==repbit
+;	The most basic type codes to appear as LH of 1st words
+deft	arep,arep
+deft	crep,crep
+deft	drep,drep
+deft	erep,erep
+deft	prep,prep
+deft	orep,orep
+deft	srep,srep
+deft	vec,vec
+deft	wvec,wvec
+deft	xrep,xvec
+typbit==0
+typrsb==:.
+deft	int,int
+deft	bool,bool
+deft	char,char
+deft	type,type
+deft	mrtn,mrtn
+deft	chan,chan
+typref==:.
+deft	str,str
+deft	real,real
+typbit==refbit
+deft	pcb,pcb		; procedure call block
+deft	td,tdesc	; normal-type descriptor
+deft	ppd,ppdesc	; proc parm desc
+deft	cpd,cpdesc	; cluster parm desc
+typbit==0
+deft	null,null
+deft	none,none	; type of return obj from procs that don't have any
+deft	any,any		; type any
+typusr==:.	; User-defined types from here on
+%str=:refbit(tstr)
diff --git a/src/sys3/ts.clu b/src/sys3/ts.clu
new file mode 120000
index 00000000..82a21628
--- /dev/null
+++ b/src/sys3/ts.clu
@@ -0,0 +1 @@
+clucmp/cludmp.>
\ No newline at end of file