From: Lars Brinkhoff <lars@nocrew.org>
Date: Mon, 9 Apr 2018 08:01:24 +0000 (+0200)
Subject: Add MUD.MIC, MBOOTS.MAC, and POWER.BCL from the tape.
X-Git-Url: https://jxself.org/git/?a=commitdiff_plain;h=44836ad4d173a8e4cd94ffe432572b45e9adc456;p=mud1.git

Add MUD.MIC, MBOOTS.MAC, and POWER.BCL from the tape.
---

diff --git a/MBOOTS.MAC b/MBOOTS.MAC
index 3ae86dd..550bbcd 100644
--- a/MBOOTS.MAC
+++ b/MBOOTS.MAC
@@ -1,1107 +1,160 @@
-;Copyright (C) 1980 by
-;Roy Trubshaw, Richard Bartle & Brian Mallett,
-;Essex University, Colchester. CO4 3SQ.
+;COPYRIGHT (C) 1980 BY
+;ROY TRUBSHAW, RICHARD BARTLE & BRIAN MALLETT,
+;ESSEX UNIVERSITY, COLCHESTER. CO4 3SQ.
 ;
-;	This software is furnished on the understanding that
-;it may be used and or copied only with the inclusion of this
-;notice.  No title or ownership of this software is hereby
-;transferred. The information in this software is subject to
-;change without notice. No responsibility is assumed for the
-;use or reliability of this software.
+;       THIS SOFTWARE IS FURNISHED ON THE UNDERSTANDING THAT
+;IT MAY BE USED AND OR COPIED ONLY WITH THE INCLUSION OF THIS
+;NOTICE.  NO TITLE OR OWNERSHIP OF THIS SOFTWARE IS HEREBY
+;TRANSFERRED. THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO
+;CHANGE WITHOUT NOTICE. NO RESPONSIBILITY IS ASSUMED FOR THE
+;USE OR RELIABILITY OF THIS SOFTWARE.
  
-	TITLE	BCPL
-	TWOSEG	400K
+        TITLE   BCPL
+        TWOSEG  400K
  
-	SEARCH UUOSYM
-
-	CODE1==617022
-	CODE2==13731
-	CODE3==26262
+        SEARCH UUOSYM
  
-	JRST	.BCPL.##	; CATCH FALL THROUGH
-..BCPL::TDZA	1,	1
-	SETO	1,	0	; SET UP CCL VALUE
-	MOVEM	1,	%CCL##	;Store it.
-	MOVEM	0,	%CALLNM##	;Save name of this game...
-	CAIN	.SGPPN,	75	;Frig for 7.001 monitor - get 75 instead of ppn
-	MOVE	.SGPPN,	77	;Real ppn is in 77 (part of lookup block)
-	MOVEM	.SGPPN,	MAINTA##	;Save as maintainer's ppn
-	MOVEM	.SGPPN,	PATHPP	;Save for assigning MUD:
-	CAIN	.SGDEV,	75	;Same palaver for device now
-	MOVE	.SGDEV,	75	;Device is 1st entry in lookup block
-	SKIPN		.SGDEV	;Did he give a disc?
-	MOVEI	.SGDEV,	'DSK'	;No so assume dsk...
-	MOVEM	.SGDEV,	DISC	;stow away...
-	MOVEM	.SGDEV,	PATHDV	;...again.
-	came	.sgdev,	[	sixbit	/dsk/	]
-	camn	.sgdev,	[	sixbit	/all/	]
-	jrst		past
-	camn	.sgdev,	[	sixbit	/lib/	]
-	jrst		past
-	movei	2,	4
-lop:	move	1,	[	xwd	3,	loc]
-	jobstr	1,
-	jrst		past
-	move	1,	loc
-	jumpe	1,	over
-	camn	1,	addr+1
-	jrst		past
-	movem	1,	addr(2)
-	addi	2,	3
-	jrst		lop
-over:	sos		2
-	hrli	1,	@2
-	hrri	1,	addr
-	struuo	1,
-	trn
-past:	hrri	1,	pathbk
-	hrli	1,	12
-	path.	1,
-	trn
-	RESET
-	setz	1,
-	setuwp	1,
-	halt
-	SKIPE		74
-	JRST	[	OUTSTR	[	ASCIZ	/
-If you think I'll let you DDT me you've another think coming, squire...
-/				]
-			JRST	@.
-			EXIT
-		]
-	movei	1,	imrtrp
-	movem	1,	.jbapr
-	movei	1,	ap.pov+ap.ilm+ap.nxm+ap.par
-	aprenb	1,	0
-	moveI 1,vec
-	piini.	1,0
-	trn
-	movei 1,swint
-	movem 1,vec+4
-	movei 1,imrtrp
-	movem 1,vec+10
-	move 1,[ ps.fon+ps.fac+args]
-	pisys.	1,0
-	trn
-	move 1,[ ps.fon+ps.fac+args1]
-	pisys.  1,0
-	trn
-	skipn		esxwd##
-	jrst		ripple
-	movei	1,	2
-	hrli	1,	3
-	movei	2,	2036
-	seto	3,
-	trmno.	3,
-	trn
-	setz	4,
-	trmop.	1,
-	trn
-	movei	2,	2003
-	trmop.	1,
-	trn
-ripple:	JRST		400010	;Start ripple through
-swint:	movem	1,	sumadd
-	hrrz	1,	status
-	cain	1,	code1
-	jrst		cone
-	caie	1,	code2
-	cain	1,	code3
-	jrst		ctwo
-wally:	setzm		half
-okok:	move	1,	sumadd
-	debrk.
-	halt
-cone:	setom		half
-	jrst		okok
-ctwo:	skipn		half
-	jrst		wally
-	caie	1,	code2
-	jrst		nice
-	skipe		maint##
-	jrst		[	outstr	[asciz	/
-Someone has just tried to do something magical to you nastily.
-/					]
-				jrst wally
-			]
-	outstr [asciz /
-Someone has done something magical to you, nastily...
+        JRST    .BCPL.##        ; CATCH FALL THROUGH
+..BCPL::TDZA    1,      1
+        SETO    1,      0       ; SET UP CCL VALUE
+        MOVEM   1,      %CCL##  ;STORE IT.
+        MOVEM   0,      %CALLNM##       ;SAVE NAME OF THIS GAME...
+        CAIN    .SGPPN, 75      ;FRIG FOR 7.001 MONITOR - GET 75 INSTEAD OF PPN
+        MOVE    .SGPPN, 77      ;REAL PPN IS IN 77 (PART OF LOOKUP BLOCK)
+        MOVEM   .SGPPN, MAINTA##        ;SAVE AS MAINTAINER'S PPN
+        MOVEM   .SGPPN, PATHPP  ;SAVE FOR ASSIGNING MUD:
+        CAIN    .SGDEV, 75      ;SAME PALAVER FOR DEVICE NOW
+        MOVE    .SGDEV, 75      ;DEVICE IS 1ST ENTRY IN LOOKUP BLOCK
+        SKIPN           .SGDEV  ;DID HE GIVE A DISC?
+        MOVEI   .SGDEV, 'DSK'   ;NO SO ASSUME DSK...
+        MOVEM   .SGDEV, DISC    ;STOW AWAY...
+        MOVEM   .SGDEV, PATHDV  ;...AGAIN.
+        CAME    .SGDEV, [       SIXBIT  /DSK/   ]
+        CAMN    .SGDEV, [       SIXBIT  /ALL/   ]
+        JRST            PAST
+        CAMN    .SGDEV, [       SIXBIT  /LIB/   ]
+        JRST            PAST
+        MOVEI   2,      4
+LOP:    MOVE    1,      [       XWD     3,      LOC]
+        JOBSTR  1,
+        JRST            PAST
+        MOVE    1,      LOC
+        JUMPE   1,      OVER
+        CAMN    1,      ADDR+1
+        JRST            PAST
+        MOVEM   1,      ADDR(2)
+        ADDI    2,      3
+        JRST            LOP
+OVER:   SOS             2
+        HRLI    1,      @2
+        HRRI    1,      ADDR
+        STRUUO  1,
+        TRN
+PAST:   HRRI    1,      PATHBK
+        HRLI    1,      12
+        PATH.   1,
+        TRN
+        RESET
+        SETZ    1,
+        SETUWP  1,
+        HALT
+
+
+
+
+
+
+        SKIPE           74
+        JRST    [       OUTSTR  [       ASCIZ   /
+IF YOU THINK I'LL LET YOU DDT ME YOU'VE ANOTHER THINK COMING, SQUIRE...
+/                               ]
+                        JRST    @.
+                        EXIT
+                ]
+        MOVEI 1,VEC
+        PIINI.  1,0
+        TRN
+        MOVEI 1,SWINT
+        MOVEM 1,VEC+4
+        MOVE 1,[ PS.FON+PS.FAC+ARGS]
+        PISYS.  1,0
+        TRN
+        MOVEI   1,      2
+        HRLI    1,      3
+        MOVEI   2,      2036
+        SETO    3,
+        TRMNO.  3,
+        TRN
+        SETZ    4,
+        TRMOP.  1,
+        TRN
+        MOVEI   2,      2003
+        TRMOP.  1,
+        TRN
+        MOVEI   2,      2005
+        SETO    4,
+        TRMOP.  1,
+        TRN
+        JRST            400010  ;START RIPPLE THROUGH
+SWINT:  DMOVEM  1,      SUMADD
+        MOVEM   3,      SUMADD+2                ;WHAT'S WRONG WITH PUSHING ON STACK?
+        HRRZ 1,STATUS   ;PASSED VALUE
+        HLRZ 2,STATUS   ;JOB NUMBER
+        HLL  3,STATUS
+        HRRI 3,2        ;TABLE 2 GETS PPN FOR JOB
+        GETTAB  3,
+        JRST WALLY
+        CAME 3,MAINTA## ;MAKE SURE MAINTAINER DID IT
+        JRST WALLY
+        SUB  1,2
+        CAIN 1,"N"
+        JRST NICE
+        CAIN 1,"H"
+        JRST HORRIB
+WALLY:  DMOVE   1,      SUMADD
+        MOVE    3,      SUMADD+2
+        DEBRK.
+        HALT
+HORRIB: OUTSTR [ASCIZ /
+SOMETHING MAGICAL HAS HAPPENED NASTILY...
 / ]
-	exit
-	halt
-nice:	outstr [asciz /
-Someone has done something magical to you, nicely...
-/]
-	setom	ctcflg##
-	jrst	wally
-
-imrtrp:	movei	1,	imrext
-	movem	1,	.jbapr
-	outstr	[asciz	/
-Something amazingly magical has happened!
+        EXIT
+        HALT
+NICE:   OUTSTR [ASCIZ /
+SOMETHING MAGICAL HAS HAPPENED NICELY...
 /]
-	skipe		magic##
-	jrst		imrext
-	setom		magic##
-	jsp	14,	@resetgame##
-	subi	16,	2
-imrext:	exit	1,
- 
-reloc
- 
-sumadd:	block 1
-half:	0
-vec:	block 4
-new:	0
-old:	0
-flags:	0
-status:	0
-new1:	0
-old1:	0
-flags1:	0
-stats1:	0
- 
-args: 	.pcjbi
-	xwd 4,0
-	xwd 2,0
-args1:	.pciuu
-	xwd 10,0
-	xwd 2,0
- 
-pathbk:	-5
-	0
-	sixbit /MUD/
-	0
-pathdv:	exp 0, 0, 0
-pathpp:	exp 0, 0, 0, 0
-addr:	.fssrc
-disc::	block 1
-	0
-	0
-	block	^d21			;should be enough for most searchlists...
-loc:	exp -1,0,0
-	END	..BCPL
-
-
-
-
-\\\\\
-SUBFILE: POWER.BCL @11:29 13-NOV-1986 <477> (3816)   
-/*
-Copyright (C) 1980 by
-Roy Trubshaw & Richard Bartle,
-Essex University, Colchester. CO4 3SQ.
-
-	This software is furnished on the understanding that
-it may be used and or copied only with the inclusion of this
-notice.  No title or ownership of this software is hereby
-transferred. The information in this software is subject to
-change without notice. No responsibility is assumed for the
-use or reliability of this software.
-*/
-
-get "bcl:acs"
-get "bcl:scb"
-get "bcl:iolib"
-get "dungen"
-get "bcl:rfslib"
-
-$LDTEXT "/RUNAME:power"
-
-external "."
-$(	fn
-$)
-
-manifest
-$(	TREESIZE	=	RECLENGTH+2
-	RIGHT		=	RH | TREESIZE-1
-	LEFT		=	LH | TREESIZE-1
-	CHAIN		=	RH | TREESIZE
-	PPPN		=	#2011002011//MPPN
-$)
-
-static
-$(	lastblock	=	0
-	cbl		=	vec 1
-	dmpbuf		=	vec BUFFERS
-	cbll		=	vec 1
-	perputt		=	?
-	dmpbuff		=	vec BUFFERS
-	bcntt		=	1
-	nextrec		=	?
-	game		=	$6"mud"
-	rock		=	$6"rock"
-	blud		=	$6"blud"
-	perput		=	?
-	rec		=	?
-	gender		=       0
-	me		=	0
-	ch		=	?
-	name		=       vec 1
-	room		=	0
-	tree		=	0
-$)
-
-let start() be
-$(	let bcnt=1
-	output:=tty
-	outs("The power program!*C*L")
-	$[	$rescan
-zonk:		$inchrs		1
-		$jrst		plonk
-		$caie	1,	'-'
-		$jrst		zonk
-cronk:		$inchrs		1
-		$jrst		plonk
-		$trz	1,	#40
-		$caie	1,	'M'
-		$cain	1,	'V'
-		$jrst		wonk
-		$caie	1,	'B'	//spot the hacks...
-		$cain	1,	'R'
-		$trna
-		$jrst		cronk
-		$move	2,	rock
-		$cain	1,	'B'
-		$move	2,	blud
-		$movem	2,	game
-wonk:		$inchrs		1
-		$trna
-		$jrst		wonk
-plonk:	$]
-	input:=tty
-	Readname(name, "Password: ")
-	test !name=!"bushbaby" then outs("*C*LThat'll do...*C*L") or
-	$(	Outs("*C*LEek! Go away!*C*L")
-		finish
-	$)
-	$(	Outs("Frig, Start, League, Transfer, Enumerate, Password, Dot, Reveal, Mud, Kill*C*Lor One-off? ")
-		switchon valof
-		$[	$clrbfi
-			$inchrw		1
-			$trz	1,	#40
-		$] into
-		$(
-		case 'R':	outs("eveal*C*L")
-				reveal()
-				finish
-		case 'M':	outs("ud*C*L")
-				run($6"dsk", $6"mud", $6"exe", PPPN)
-		case 'S':	outs("tart*C*L")
-				strat()
-				finish
-		case 'D':	outs("ot*C*L")
-				dot()
-				finish
-		case 'F':	outs("rig*C*L")
-				break
-		case 'L':	outs("eague*C*L")
-				league()
-				finish
-		case 'T':	outs("ransfer*C*L")
-				Transfer()
-				finish
-		case 'E':	outs("numerate*C*L")
-				Enumerate()
-				finish
-		case 'P':	outs("assword*C*L")
-				password()
-				finish
-		case 'K':	outs("ill*C*L")
-				kill()
-				finish
-		case 'O':	outs("ne-off*C*L")
-				oneoff()
-				finish
-		default 0 ... #137:
-			Outs("*C*LEh?*C*L")
-		$)
-	$) repeat
-	setup()
-	readname(name, "Name: ")
-	if !name =!"richard" Outs("*C*LYou're so naive...*C*L")<>finish
-	searchrec(name)
-	if rec then rec_rec rem 128+dmpbuf
-	test rec then
-	$(	let sc, sx=SCRE of rec, WRD1 of rec bitand 1
-		outs("Current character profile is:*C*L")
-		out("Name*T*T:s:s*C*Lscore*T*T:n*T:s*C*Lstrength*T:n*C*L",rec+2,WIZD of rec bitand WIZMASK -> "*TWIZ","",sc,lev(sc,sx),STRN of rec)
-		out("dexterity*T:n*C*Lstamina*T*T:n*T(max*T:n)*C*Lgames played*T:n*C*Lsex*T*T:smale*C*Lp/w*T:8*C*L",
-		dxty of rec,stna of rec,stmx of rec,games of rec, sx -> "fe", "",PSWD of rec)
-		dumpersona(true)
-		save.block()
-	$) or
-	$(	out("No current persona! I'll make one for you, :s.*C*L",name)
-		addrec(name)
-		rec_rec rem 128+dmpbuf
-		games of rec_1
-		WRD1 of rec_!name
-		WRD2 of rec_LENGTH of name>4 -> 1!name,0
-		WIZD of rec_false
-		dumpersona()
-		save.block()
-	$)
-	Close(perput)
-	deq(sc.channel^perput)
-$)
-and dumpersona(pw) be
-$(	unless numbargs() pw_false
-	if pw pw_ESSEX
-	if pw pw_appendfile($6"dsk",$6"prolog",$6"prl", MPPN,label(oops))
-	if pw
-	$(	write(pw,"POWERing :S*C*LStr.*TDex.*TSta.*TScore*TSex*TP/w*C*L",name)
-		write(pw,":N*T:N*T:N*T:N*T:S*T:8*C*L",STRN of rec,DXTY of rec,
-			STMX of rec,SCRE of rec,((WRD1 of rec) bitand 1)->"f","m",PSWD of rec)
-	$)
-	outs("Prepare to fulfill your wildest dreams!*C*L")
-	outs("Strength	?");	STRN of rec_getno(STRN)
-	outs("Stamina (max)	?");	STNA of rec_getno(STMX);	STMX of rec_STNA of rec
-	outs("Dexterity	?");	DXTY of rec_getno(DXTY)
-	outs("Score		?");	SCRE of rec_getno(SCRE)
-	outs("Sex		?")
-	$[      $CLRBFI
-		$INCHRW	 ch
-	$]
-	Gender_(WRD1 of rec) bitand 1
-	TEST ch='M'\/ch='m' THEN OUTS("ale*C*L")<>gender_0
-	OR if ch= 'F'\/ch='f' THEN OUTS("emale*C*L")<>
-		gender_1
-	outs("Pn		?");	PN of rec_Getno(PN,true)
-	unless PN of rec PN of rec_valof $[	$getppn	1,	0	$]
-	WRD1 of rec_((WRD1 of rec) bitand ~1) bitor gender
-	LSTM of rec_valof
-	$[	$hrri	ac,	#11
-		$hrli	ac,	#53
-		$gettab ac,     0
-		$trn
-	$]
-	if pw /\ (PSWD of rec ne 0)
-	$(	outs("Zero p/w	?")
-		if valof
-		$[	$clrbfi
-			$inchrw		1
-			$trz	1,	#40
-			$caie	1,	'Y'
-			$jrst		render
-			$outstr		$az"es*C*L"
-			$trna
-render:			$setz	1,	0
-			$clrbfi
-		$] then PSWD of rec_0
-	$)
-	if pw
-	$(	write(pw,":N*T:N*T:N*T:N*T:S*T:8*C*L",STRN of rec,DXTY of rec,
-			STMX of rec,SCRE of rec,((WRD1 of rec) bitand 1)->"f","m",PSWD of rec)
-		close(pw)
-	$)
-	return
-oops:	Outs("*C*LI can't log this frig, so I won't do it, sorry.*C*L")
-$)
-and load.block(stream,block) be
-$(	if block=lastblock return
-	useti(perput,block)
-	inuuo(stream,cbl)
-	lastblock_block
-$)
-and save.block(block) be
-$(	let blk=numbargs()->block,lastblock
-	useto(perput,blk)
-	outuuo(perput,cbl)
-$)
-and searchrec(nam) = valof
-$(	let pnt,lrec,str=?,0,vec 1
-	!str_!nam
-	1!str_LENGTH of nam>4 -> 1!nam, 0
-	load.block(perput,1)
-	lrec_hashval(str)
-	rec_dmpbuf!lrec
-	while rec
-	$(	load.block(perput,rec/WDSPERBUF+1)
-		pnt_(rec rem WDSPERBUF)+dmpbuf
-		if namesame(str,2+pnt) break
-		lrec_rec
-		rec_POINTR of pnt
-	$)
-	resultis lrec
-$)
-and saverec(nam) = valof
-$(	searchrec(nam)
-	unless rec addrec(nam)
-	if rec		//In case addrec hasn't added them.
-	$(	load.block(perput,rec/WDSPERBUF+1)
-		dumpersona(rec rem WDSPERBUF+dmpbuf)
-		save.block()
-	$)
-	resultis rec	//return a value to indicate whether you've been saved.
-$)
-and deleterec(nam) be
-$(	let olrec,odel,lrec=?,?,searchrec(nam)
-	and pnt=rec rem WDSPERBUF+dmpbuf
-	unless rec return	//Can't find record
-						//Ok, this may look a little long-winded
-	load.block(perput,rec/WDSPERBUF+1)	//but it's worth it not to corrupt the persona file in case of a crash
-	WRD1 of pnt_0
-	WRD2 of pnt_0		//Zero names for purges etc.
-	GAMES of pnt_0		//Yawn thinks we need this, too! (WE DO! - Yawn xx)
-	olrec_!pnt
-	save.block()
-
-	load.block(perput,lrec/WDSPERBUF+1)
-	dmpbuf!(lrec rem WDSPERBUF)_olrec	//Old pointer to rec now points to old pointer of rec.
-	save.block()
-	
-	load.block(perput,1)	//Get the deleted record pointer
-	odel_DEL of dmpbuf
-	save.block()
-
-	load.block(perput,rec/WDSPERBUF+1)	//And plonk it in the record to be deleted
-	!pnt_odel		//Does anyone read all these comments?
-	save.block()
-
-	load.block(perput,1)	//Finally update the deleted record pointer to point to the newly deleted record!
-	DEL of dmpbuf_rec
-	save.block()
-$)
-and addrec(nam) be
-$(	let hashcont,olrec,str=?,?,vec 1
-	!str_!nam
-	1!str_LENGTH of nam>4 -> 1!nam,0
-	load.block(perput,1)
-	rec_DEL of dmpbuf
-	test rec then
-	$(	load.block(perput,rec/WDSPERBUF+1)
-		olrec_POINTR of (rec rem WDSPERBUF+dmpbuf)
-		save.block()
-	$) or
-	$(	rec_FLEN of dmpbuf
-		unless rec			//No persona file exists.
-		$(	rec_2*WDSPERBUF
-			FLEN of dmpbuf_rec	//Create hash table
-		$)
-		olrec_0				//No deleted records
-		FLEN of dmpbuf+_RECLENGTH
-		save.block()
-	$)
-	load.block(perput,1)
-	DEL of dmpbuf_olrec
-	hashcont_dmpbuf!hashval(str)
-	dmpbuf!hashval(str)_rec
-	save.block()
-
-	load.block(perput,rec/WDSPERBUF+1)
-	POINTR of (dmpbuf+rec rem WDSPERBUF)_hashcont
-	save.block()
-$)
-and hashval(nam) =  ((!nam+1!nam)>>1) rem 253
-and kill() be
-$(	setup()
-	readname(name, "Name: ")
-	if !name =!"richard" Outs("*C*LNot Richard...*C*L")<>finish
-	deleterec(name)
-	test rec then out(":s terminated.",name)
-	or out(":s already dead - you can only kill people once!",name)
-	
-	Close(perput)
-	deq(sc.channel^perput)
-$)
-and getno(sel,octal)=valof
-$(	let ch=valof
-	$[	$clrbfi
-		$inchrw 1
-	$]
-	unless numbargs()=2 octal_false
-	unless '0' le ch le '9'
-	$(	$[	$clrbfi	$]
-		resultis sel of rec
-	$)
-	putback(input,  ch)
-	ch_(octal->inoct,inno)()
-	$(	let stk=SC.PUTSTACK^input
-		SC.PUTSTACK^input, SC.READER^input _ !stk, stk!2
-		freevec(stk)
-	$)
-	resultis ch
-$)
-and inoct(nopb)=valof
-$(	let res=0 and ch=?
-	ch_inch() repeatuntil '0' le ch le '7'
-	while '0' le ch le '7' do
-	$(	res_(res<<3)-'0'+ch
-		ch_inch()
-	$)
-	unless numbargs() putback(input,ch)
-	resultis res
-$)
-and readname(nm, pr) be
-$(      let n,ch,linev=0,?,vec NAMELENGTH
-	write(tty, pr)
-	readch(input,@ch)
-	while 'a'<=(ch bitor #40)<='z' do
-	$(      n+:1
-		unless n>NAMELENGTH linev!n:='A'<=ch<='Z'->ch+#40,ch
-		readch(input,@ch)
-	$)
-	!linev:=n>NAMELENGTH->NAMELENGTH,n
-	packstring(linev,nm)
-	until ch='*L' do readch(input,@ch)
-$)      repeatuntil LENGTH of nm
-and dot() be
-$(   	let stfl,no,ch=0,?,?
-	writes(tty,"Please enter the job number of the about to be dotted job*C*L(0 for all of them)*C*L")
-	writes(tty,"**")
-	no_rdno(tty)
-	$(	let res=?
-		writes(tty,"dotted nicely or horribly N/H? ")
-		$[    	$clrbfi
-			$inchrw  ch
-		$]
-		stfl_0
-		test ch='H' \/ ch='h' then stfl_#13731<>writes(tty,"orribly*C*L") or
-		if ch='N' \/ ch='n' then stfl_#26262<>writes(tty,"icely*C*L")
-		unless stfl writes(tty,"*Binvalid character*C*L")<>loop
-		for i=1 to 200 dispose(#617022,i)
-		test no then res_dispose(stfl, no)
-		or for i=1 to 200 if dispose(stfl, i) res_true
-		unless res Writes(tty, "*C*L?POWIDW - it didn't work so stop pissing around.*C*L")
-		finish	
-	$) repeat
-$)
-and dispose(stfl, no) be
-$[	$hrrz 2,stfl
-	$hrl  2,no
-	$calli 2,#175
-	$setz 1,0			//uh?
-$]
-and namesame(nam1,nam2)=
-(!nam1>>1)=(!nam2>>1)/\((LENGTH of nam1<=4)\/(1!nam1>>1)=(1!nam2>>1))
-and strat() be
-$(	let resp=?
-	$(	writes(tty, "*C*LMud, Valley or Rock? ")
-		$[	$inchrw		1
-			$trz	1,	' '
-			$movem	1,	resp
-		$]
-	$) repeatuntil resp='V' | resp='M' | resp='R'
-	write(tty, ":s*C*L", resp='R'->"ock", resp='V'->"alley", "ud")
-	resp_resp='R' -> $6"rock",resp='V'->$6"valley", $6 "mud"
-	output_createtmp(resp)
-	readname(name, "Name: ")
-	writes(tty, "*C*LRoom: ")
-	$[ $clrbfi      $]
-	for i=0 to 5 do
-	$(	let letter = byte 6:30-6*i
-		and next = valof $[ $inchrw    1 $]
-		if 'a' le next le 'z' next-_'a'-'A'
-		if next = '*C' break
-		letter from room _ next-' '
-	$)
-	$[ $clrbfi      $]
-	out(":s*^C:n*$:n*$:n",	name,
-				valof $[ $mstime 1, 0 $],
-				valof $[ $mstime 1, 0 $],
-				room)
-	close(output)
-	run($6 "dsk", resp, $6 "exe", 0)
-$)
-
-and setup() be
-$(	!cbl_(-BUFFERS<<18)bitor(dmpbuf-1)
-	1!cbl_0
-	if false
-	$(
-dogoneit:	perput_createfile($6"dsk",game,$6".pm",PPPN,0,#17,1)
-		enq(SC.CHANNEL^perput)
-		useto(perput,2)
-		outuuo(perput,cbl)
-		close(perput)
-		deq(sc.channel^perput)
-	$)
-	perput_updatefile($6"dsk",game,".pm",PPPN,label(dogoneit),#17,1)
-	enq(sc.channel^perput)
-	useti(perput,1)
-$)
-and reveal() be
-$(	let ch, f, fil, ext=?, ?, vec 1, vec 1
-	readname(fil, "File part: ")
-	readname(ext, "Extension part: ")
-	f_findfile($6"dsk", fil, ext, 0, label(absent))
-	if false
-absent:	f_findfile($6"dsk", fil, ext, PPPN, label(nowhere))
-	input_f
-	ch_Inch()
-	while ch ne '*E'
-	$(	outch(ch)
-		ch_inch()
-	$)
-	close(f)
-	input_tty
-	return
-nowhere:	out("Sorry, I can't find :S.:S*C*L", fil, ext)
-$)
-
-and password() be
-$(	let num,numrecs,bcnt=?,?,3
-	setup()
-	out("*C*LOctal password: ")
-	num_inoct(true)
-	
-	useti(perput,1)
-	inuuo(perput,cbl)
-	numrecs_(FLEN of dmpbuf-256)/12	//First find the number of records
-
-	useti(perput,bcnt) 	//Load in the first block of records
-	inuuo(perput,cbl)
-
-	rec_dmpbuf
-	for i=1 to numrecs
-	$(	if WRD1 of rec /\ num=PSWD of rec
-			out(":S on :N points*C*L", rec+2, SCRE of rec)
-		if (rec-dmpbuf)>128
-		$(	rec -_ 128
-			bcnt +_ 1
-			useti(perput,bcnt)
-			inuuo(perput,cbl)
-		$)			
-		rec+_RECLENGTH
-	$)
-
-	close(perput)
-	deq(sc.channel^perput)
-$)
+        SETOM   CTCFLG##
 
-and Lev(pts, fem)=valof
-$(	let sc=exp.step
-	for i=0 to 9
-	$(	if sc ge pts resultis i
-		sc+_sc
-	$)
-	resultis 9
-$)!(fem!(table
-		(table	"novice",
-			"warrior",
-			"hero",
-			"champion",
-			"superhero",
-			"enchanter",
-			"sorcerer",
-			"necromancer",
-			"legend",
-			"wizard"
-		),
-		(table	"novice",
-			"warrior",
-			"heroine",
-			"champion",
-			"superheroine",
-			"enchantress",
-			"sorceress",
-			"necromancess",
-			"legend",
-			"witch"
-		)
-	)
-)
 
-and Enq(chan) be
-$(	let addr=vec 4
-	!addr_#1000005
-	1!addr_142857
-	2!addr_chan
-	3!addr_$az"mud"+(-1<<18)
-	4!addr_0
-	Out("*C*LENQ. error code :8*C*L", valof
-	$[	$move	1,	addr
-		$enq.	1,	0
-		$trna
-		$(	return	$)
-	$])
-$)
 
-and Deq(chan) be
-$(	let addr=vec 1
-	!addr_#1000005
-	1!addr_142857
-	Out("*C*LDEQ.error code :8*C*L", valof
-	$[	$move	1,	addr
-		$hrli	1,	1
-		$deq.	1,	0
-		$trna
-		$(	return	$)
-	$])
-$)
-and transfer() be
-$(	let peep, bcnt, numrecs=?, 3, ?
-	outs("where from? (0 for everywhere) ")
-	peep_inoct(true)
-	setup()
-	
-	useti(perput,1)
-	inuuo(perput,cbl)
-	numrecs_(FLEN of dmpbuf-256)/12	//First find the number of records
 
-	useti(perput,bcnt) 	//Load in the first block of records
-	inuuo(perput,cbl)
 
-	rec_dmpbuf
-	for i=1 to numrecs
-	$(	if WRD1 of rec /\ (PN of rec=peep | peep=0)
-		$(	out(":s: [**,:8] -> ", rec+2, PN of rec)
-			PN of rec_Getno(PN, true)
-		$)
-	
-		if (rec-dmpbuf)>128
-		$(	rec -_ 128
-			useto(perput, bcnt)
-			outuuo(perput, cbl)
-			bcnt +_ 1
-			useti(perput,bcnt)
-			inuuo(perput,cbl)
-		$)
-		rec+_RECLENGTH
-	$)
 
-	close(perput)
-	deq(sc.channel^perput)
-$)
-
-and League() be
-$(	let numrecs,bcnt=?,3
-	setup()
-	useti(perput,1)
-	inuuo(perput,cbl)
-	numrecs_(FLEN of dmpbuf-256)/12	//First find the number of records
-
-	useti(perput,bcnt) 	//Load in the first block of records
-	inuuo(perput,cbl)
-
-	rec_dmpbuf
-	for i=1 to numrecs
-	$(	if WRD1 of rec tree_insert(SCRE of rec, tree)
-		if (rec-dmpbuf)>128
-		$(	rec -_ 128
-			bcnt +_ 1
-			useti(perput,bcnt)
-			inuuo(perput,cbl)
-		$)			
-		rec+_RECLENGTH
-	$)
-
-
-	close(perput)
-	deq(sc.channel^perput)
-	outs("Writing to LEAGUE.ENM")
-	output_createfile("dsk","league","enm",0)
-	outree(tree)
-	while me
-	$(	let p=LH of me
-		Out("richard*T*T[**,:8]:c*T34359738369*T9999*Tyes*TWIZARD*C*L",p, p ls #1000->'*T','*0')
-		me of_RH
-	$)
-	close(output)
-$)
-and today()=valof
-$[	$hrli	1,	#53
-	$hrri	1,	#11
-	$gettab	1,	0
-	$trn
-	$hlrz	1,	1
-$]
-and Enumerate() be
-$(	let now,bcnt,numrecs=today(),3,?
-	setup()
-	outs("Writing to POWER.ENM*C*L")
-	output_Createfile($6"dsk",$6"power",$6"enm", 0, Label(rats))
-	outs("Enumeration of personas as of ")
-	outtime()
-	outs(" on ")
-	outdate()
-	outs(":*C*L*L")
-	
-	useti(perput,1)
-	inuuo(perput,cbl)
-	numrecs_(FLEN of dmpbuf-256)/12	//First find the number of records
-
-	useti(perput,bcnt) 	//Load in the first block of records
-	inuuo(perput,cbl)
-
-	rec_dmpbuf
-	for i=1 to numrecs
-	$(	if WRD1 of rec
-		$(	let t, sx, wz=now-(LH from LSTM of rec), (WRD1 of rec) bitand 1, WIZD of rec
-			Out("Name:*T*T:S*C*LPpn:*T*T[**,:8]*C*LScore:*T*T:N*C*LStrength:*T:N*C*LDexterity:*T:N*C*LStamina:*T:N*Tmax :N*C*L",
-				rec+2,PN of rec,SCRE of rec,STRN of rec,DXTY of rec,STNA of rec,STMX of rec)
-				Out("Last game:*T:N day:S ago*C*Lgames:*T*T:N*C*Lsex:*T*T:Smale*C*L",
-					t,t=1->"","s",GAMES of rec,sx->"fe","")
-				if wz bitand WIZMASK Out("Mode:*T*TWI:S*C*L", sx->"TCH","ZARD")
-				if wz bitand 4 Outs("Mode:*T*TBERSERK*C*L")
-				Outs("*C*L*L")
-		$)
-		if (rec-dmpbuf)>128
-		$(	rec -_ 128
-			bcnt +_ 1
-			useti(perput,bcnt)
-			inuuo(perput,cbl)
-		$)			
-		rec+_RECLENGTH
-	$)
-
-	close(perput)
-	deq(sc.channel^perput)
-	close(output)
-	Writes(tty,"*C*LEnumerated in DSK:POWER.ENM*C*L")
-	if false
-rats:		Writes(tty,"*C*LCan't create DSK:POWER.ENM*C*L")
-$)
-
-and insert(sc, tree)=valof
-$(	if tree test sc ls SCRE of tree then
-	$(	LEFT of tree_insert(sc, LEFT of tree)
-		resultis tree
-	$) or if sc gr SCRE of tree then
-	$(	RIGHT of tree_insert(sc, RIGHT of tree)
-		resultis tree
-	$)
-	sc_Newvec(TREESIZE)
-	for i=0 to RECLENGTH sc!i_rec!i
-	sc!(RH from RIGHT)_0
-	if tree
-	$(	CHAIN of sc_CHAIN of tree
-		CHAIN of tree_sc
-		resultis tree
-	$)
-	CHAIN of sc_0
-	resultis sc
-$)
-
-and outree(tree) be if tree
-$(	let l, r, n, p=LEFT of tree, RIGHT of tree, tree+2, PN of tree
-	outree(l)
-	test !n=!"richard" then
-	$(	let m=newvec(0)
-		LH of m_p
-		RH of m_me
-		me_m
-	$) or
-	Out(":s:c*T[**,:8]:c*T:N*T:c:N*T:8:S:S*C*L",
-		n, LENGTH of n ge 8 -> '*0', '*T', p, p ls #1000->'*T','*0', SCRE of tree,SCRE of tree > 9999999 -> '*0','*t', GAMES of tree,
-		PSWD of tree, (WIZD of tree bitand 4)-> "*TBERSERK", "",(WIZD of tree bitand WIZMASK)->WRD1 of tree bitand 1->"*TWITCH","*TWIZARD", "")
-	Outree(CHAIN of tree)
-	outree(r)
-$)
-and Oneoff() be
-$(	let now,newrec,lastrec,recptr,rec2,old.lastrec,hashbuf=
-			today(),0,?,?,0,?,vec 256
-	!cbll_(-BUFFERS<<18)bitor(dmpbuff-1)
-	1!cbll_0
-	clearvec(dmpbuff, BUFFERS)
-	perputt_createfile($6"dsk",game,$6"off",0,0,#17,1)
-	useto(perputt,1)
-	nextrec_dmpbuff
-	setup()
-	$(	inuuo(perput,cbl)
-		rec_dmpbuf
-		while LH of rec
-		$(
-//Do the processing between here...
-
-			let temp,pswrd=newrec,? 	//record list pointer
-			newrec_newvec(RECLENGTH)	//new reclength
-			!newrec_temp
-			for i=0 to 7 do (2+i)!newrec_i!rec	//copy over oldrec
-			for i=8 to RECLENGTH-2 do (2+i)!newrec_0	//and zero the rest
-			pswrd_9!newrec
-			9!newrec_(pswrd rem ((1<<20)-1))*(pswrd rem ((1<<25)-1))
-			if LENGTH of (rec+1)<5 4!newrec_0
-			
-
-//...and here!
-			rec+_8
-		$)
-		unless rec=dmpbuf+2*WDSPERBUF-8 & rec!1 then break
-	$) repeat
-			
-	
-	bcntt_3
-	for hashno=0 to 252
-	$(	let nextrec=newrec
-		out("****************HASH=:N*****************C*L",hashno)
-		lastrec_0
-		while nextrec
-		$(	let recptr=rec2+dmpbuff
-			if hashno=hashval(nextrec+3)
-			$(	out(":s	:n*C*L",nextrec+3,bcntt)
-				1!nextrec_lastrec
-				lastrec_rec2+(bcntt-1)*WDSPERBUF
-				old.lastrec_lastrec
-				for i=0 to 11 i!recptr_(i+1)!nextrec
-				rec2+_12
-				if rec2>128
-				$(	useto(perputt,bcntt)
-					outuuo(perputt,cbll)
-					bcntt+_1
-					rec2 rem_ 128
-					for i=0 to rec2-1 do i!dmpbuff_(i+12-(rec2-1))!nextrec
-				$)
-			$)
-			nextrec_!nextrec
-		$)
-		hashno!hashbuf_lastrec
-	$)
-	useto(perputt,bcntt)		//tidy up.
-	outuuo(perputt,cbll)
-	255!hashbuf_old.lastrec+12
-	254!hashbuf_0
-
-	for hashno=0 to 255 hashno!dmpbuff_hashno!hashbuf
-
-	useto(perputt,1)
-	outuuo(perputt,cbll)		//Output hash table
-		
-	close(perput)
-	deq(sc.channel^perput)
-	close(perputt)
-	Writes(tty,"*C*LOne-offed in the .OFF file*C*L")
-$)
-and clearvec(vect,size) be
-$[	$MOVE	AC,	vect
-	$HRLI	B,	0(AC)
-	$HRRI	B,	1(AC)
-	$SETZM		0(AC)
-	$ADD	AC,	size
-	$BLT	B,	0(AC)
-$]
-and yes(rec, str) =valof
-write(tty, ":s :s", rec+1, str)<>
-$[	$clrbfi
-	$inchrw		1
-	$caie	1,	'y'
-	$cain	1,	'Y'
-	$jrst		ep
-	$cain	1,	'*C'
-	$jrst		yep
-	$clrbfi
-	$outstr		$az"o*C*L"
-	$setz	1,	0
-	$(	return		$)
-yep:	$outchr		'y'
-ep:	$outstr		$az"es*C*L"
-$]
-
-$[	fn:	$exit	1,	0
-		$jrst		fn
-$]
-
-
-
-
-\\\\\
-SUBFILE: DBADAT.MAC @15:11 16-AUG-1986 <477> (786)   
-;Copyright (C) 1980 by
-;Roy Trubshaw, Richard Bartle & Ronan Flood,
-;Essex University, Colchester. CO4 3SQ.
-;
-;	This software is furnished on the understanding that
-;it may be used and or copied only with the inclusion of this
-;notice.  No title or ownership of this software is hereby
-;transferred. The information in this software is subject to
-;change without notice. No responsibility is assumed for the
-;use or reliability of this software.
+        JRST    WALLY
  
-	TITLE	Database for MUD version 3
-	TWOSEG	400K
-	SALL
-	.DIRECTIVE	SFCOND
-	NOSYM
+RELOC
  
-	MAXPLY==^D36
+SUMADD: BLOCK 3
+VEC:    BLOCK 4
+NEW:    0
+OLD:    0
+FLAGS:  0
+STATUS: 0
  
-	IF2	<PRINTX Assembling Database for MUD version 3>
+ARGS:   .PCJBI
+        XWD 4,0
+        XWD 2,0
  
-	DEFINE	FLIST(SIZE,NUM)<
-	EXP	.+1
-	REPEAT	NUM-1,<
-	EXP	.+SIZE
-	BLOCK	SIZE-1>
-	BLOCK	SIZE>
- 
-	DEFINE	VEC(SIZE,VALUE<0>)<
-	EXP	.+1
-	IFE	VALUE,	<BLOCK	SIZE>
-	IFN	VALUE,	<REPEAT SIZE,	    <EXP       VALUE>>>
- 
-STARTL::EXP	.				;Address of start of database.
-INDEX:: EXP	0				;Room index.
-DICTIO::BLOCK	1				;Dictionary hash table.
-STLIST::BLOCK	1				;Pointer to start location list.
-MAX.RO::BLOCK	1				;Max number of rooms.
-MAX.DE::BLOCK	1				;Max number of demons.
-DEMONS::BLOCK	1				;Table of demons
-GDEMON::EXP	0				;List of global demons
-DATE::	BLOCK	1				;DECsystem 10 date of creation.
-RDATE::	EXP	0				;DECsystem 10 date of last reset
-RHOURS::EXP	0				;Accumulated time since last Reset
-RNDMS::	EXP	0				;List of room lists for randomisation
-FTIME::	EXP	0				;First time played this version?
-TIME::	BLOCK	1				;DECsystem 10 time of creation.
-BACKWD::BLOCK	1				;Says if a direction has an opposite
-TVERB::	BLOCK	1				;movement check word
-NAPCT::	0					;number of naps before assume crash
-SUPERS::0					;whether this is superseded by us or not
-DEMO::	0					;is there a demo on?
-RANDIR::0					;random directions in travel table
-CODES::	BLOCK	1				;vdu manipulation codes.
-LOW1::	EXP	0				;overload measure
-LOW2::	EXP	0				;near-overload measure
-TIMES::	EXP .+1					;vector of lists of playing times
-	BLOCK 7
-MOTVEC::	BLOCK	1			;Inverse movement no. to names
-MOVERS::	BLOCK	1			;Objects which are mobile
-MVLOCK::	EXP	-1			;So don't try to move above twice at once
-DELOCK::	EXP	-1			;Global demon lock
-MELTED::	EXP	-1			;Whether objects can move
-PEACE::	EXP	0				;whether can fight or not
-SPECT::	EXP	0				;whether there's a spectacular on
-MALE::	VEC	^D10				;names for males
-						;I bet I forget to alter with MAX.LEVEL...
-FEMALE::	VEC	^D10			;names for females
-MUDNAM::	BLOCK	^D27			;Name of dungeon as BCPL string
-MUD6::	EXP	0				;first 6 letters of above in 6bit
-ESXWD::	BLOCK	1				;memory location for manifest ESSEX constant
-PS6::	BLOCK	1				;first 6 letters of persona file
-MAX.ME::BLOCK	1				;Max number of text messages.
-TEXT::	BLOCK	1				;Table of text messages.
-TXTVEC::	BLOCK	1			;Word count for disc file
-INIDR:: EXP	-1				;Initialisation door.
-DELDR::	EXP	-1				;Delay door for timing out.
-ACTIVE::VEC	MAXPLY,	-1			;To ensure you're still playing
-PLAYER::EXP	-1				;Stack pointer.
-	COUNT==MAXPLY+2 			;2 is the frig factor!
-PLYNUM::VEC	MAXPLY,   <<COUNT=COUNT-1>>
-	PURGE	COUNT
-MQUEUE::VEC	MAXPLY				;Message queue.
-PNAMES::VEC	MAXPLY				;Player names.
-JOBNOS::VEC	MAXPLY				;Player job numbers. Forget locking it...
-KIPS::	VEC	MAXPLY				;Times at which people went to sleep.
-QDOORS::VEC	MAXPLY, -1			;Doors to message queues.
-PDOOR::	EXP	-1				;persona file door
-MDOOR:: EXP	-1				;Door to message freelist.
-NDOOR::	EXP	-1				;Door to name selection
-TABS::	VEC	^D24				;Combat tables
-SHELF::	EXP	0				;Shelf for arch-wiz items
-SHORTM::FLIST	3,	200			;Short message freelist.
-LONGME::FLIST	20,	100			;Long message freelist.
-%RANSE::XWD	1,	-1			;Random number seed.
-MAGIC:: EXP	0				;If non zero u get thrown out.
-NOWIZ::	EXP	0				;true if no wiz's allowed
-LOCKED::EXP	0				;Whether the game is wizard-locked or not
-ENDLOC::EXP	HERE/^D512			;Current page
-FREE.S::EXP	.+1				;Freestore pointer
-	BLOCK	1
-HERE==.
-END
-
-
-
-
-\\\\\
-
\ No newline at end of file
+PATHBK: -5
+        0
+        SIXBIT /MUD/
+        0
+PATHDV: EXP 0, 0, 0
+PATHPP: EXP 0, 0, 0, 0
+ADDR:   .FSSRC
+DISC::  BLOCK 1
+        0
+        0
+        BLOCK   ^D21                    ;SHOULD BE ENOUGH FOR MOST SEARCHLISTS...
+LOC:    EXP -1,0,0
+        END     ..BCPL
diff --git a/MUD.MIC b/MUD.MIC
new file mode 100644
index 0000000..facf059
--- /dev/null
+++ b/MUD.MIC
@@ -0,0 +1,147 @@
+.NOERROR
+.IF ($A#"") .GOTO 'A
+!TO COMPILE LOAD AND SAVE MUD IN ITS ENTIRETY SAY .DO MUD M.
+!IF THE DATABASE FILE DBADAT AND ALSO MBOOTS ARE IN .REL FORM
+!THEN SAY .DO MUD B. TO JUST COMPILE MUD.BCL SAY .DO  MUD R. TO MERELY LOAD
+!MUD SAY .DO MUD R2. TO COMPILE BITS OF MUD DO MUD <N> FOR MUD<N>.BCL
+!TO COMPILE LOAD AND SAVE DBASE SAY .DO MUD DM IF THE DATABASE FILE DBADAT
+!IS NOT ALREADY COMPILED, .DO MUD DB IF IT IS.
+!TO COMPILE AND LOAD POWER, .DO MUD P
+!TO PRODUCE DOCUMENTATION SAY .DO MUD DOC.
+!TO DELETE MUD.MAS AND MAKE A NEW ONE SAY .DO MUD NEW.
+!TO TIDY UP THE AREA THEN LOGOUT .DO MUD TIDY.
+!TO REASSEMBLE AND LOAD A MUD WITH SMALLER FREEVEC .DO MUD S
+!TO DO M AND DB OPTIONS TOGETHER, .DO MUD ALL
+.MIC EXIT
+P::
+.R BCPL
+*POWER/O
+*LINK!
+*POWER/G
+NSS POWER
+.MIC EXIT
+ALL::
+M::
+.R MACRO
+*DBADAT=DBADAT
+*MBOOTS=MBOOTS
+*^Z
+B::
+.R BCPL
+*MUD0/O
+*MUD1/O
+*MUD2/O
+*MUD3/O
+*MUD4/O
+*MUD5/O
+*MUD6/O
+*MUD7/O
+*MUD8/O
+*MUDLIB/O
+*^Z
+R2::
+.R LINK
+*MUD0,MUD1,MUD2,MUD3,MUD4,MUD5,MUD6,MUD7,MUD8,MUDLIB,MBOOTS/COUNTER/SET:.HIGH.:472500
+*DBADAT/G
+.SSAVE
+.IF ($A="ALL") .GOTO DB
+.MIC EXIT
+DM::
+.R MACRO
+*DBADAT=DBADAT
+^C
+DB::
+.R BCPL
+*DBASE/O
+DL::
+.R LINK
+*/SET:.HIGH.:430000
+*DBASE,SYS:BCPLIB/SEARCH/SET:.HIGH.:472500,DBADAT/G
+.SAVE
+
+
+
+
+
+
+.MIC EXIT
+R::
+.R BCPL
+*MUD0/O
+*MUD1/O
+*MUD2/O
+*MUD3/O
+*MUD4/O
+*MUD5/O
+*MUD6/O
+*MUD7/O
+*MUD8/O
+*^Z
+.BACKTO R2
+0::
+1::
+2::
+3::
+4::
+5::
+6::
+7::
+8::
+.R BCPL
+*MUD'A/O
+*^Z
+.BACKTO R2
+DOC::
+.R CSC:FORM
+*MUDDLE/P1
+*MUDDLE/CAMERA
+.MIC EXIT
+DEL::
+NEW::
+MAS::
+.R SETSRC
+*C DSKB,*
+*^Z
+.R ED
+*DEL MUD.MAS
+*Q
+.R SUBFIL-MUD.SUB
+.PRO MUD.MAS<477>
+.MIC EXIT
+ML::
+.R BCPL
+*MUDLIB/O
+^Z
+.BACKTO R2
+S::
+.R MACRO
+*DBADAT=DBADAT
+*^Z
+.R LINK
+*MUD0,MUD1,MUD2,MUD3,MUD4,MUD5,MUD6,MUD7,MUD8,MUDLIB,MBOOTS/COUNTER/SET:.HIGH.:472500
+*DBADAT/G
+.SSAVE
+.R LINK
+*/SET:.HIGH.:430000
+*DBASE,SYS:BCPLIB/SEARCH/SET:.HIGH.:472500,DBADAT/G
+
+
+
+
+
+
+.SAVE
+.MIC EXIT
+TIDY::
+.R SUBFIL-MUD.SUB/D
+.DEL *.REL
+.DEL MUD.DMP
+.IF ($B="") .GOTO LOGOUT
+.COP 'B_MUD.MAS
+.COP 'B_MUD.TXT
+.COP 'B_DBASE.EXE
+.COP DSKC:'B_MUD.?PM
+LOGOUT::
+.DEL DBASE.EXE
+.IF ($C="") .R LOGOUT
+.MIC EXIT
diff --git a/MUD.MIC.jpg b/MUD.MIC.jpg
deleted file mode 100644
index e210402..0000000
Binary files a/MUD.MIC.jpg and /dev/null differ
diff --git a/POWER.BCL b/POWER.BCL
new file mode 100644
index 0000000..5059e65
--- /dev/null
+++ b/POWER.BCL
@@ -0,0 +1,507 @@
+/*
+COPYRIGHT (C) 1980 BY
+ROY TRUBSHAW & RICHARD BARTLE,
+ESSEX UNIVERSITY, COLCHESTER. CO4 3SQ.
+
+        THIS SOFTWARE IS FURNISHED ON THE UNDERSTANDING THAT
+IT MAY BE USED AND OR COPIED ONLY WITH THE INCLUSION OF THIS
+NOTICE.  NO TITLE OR OWNERSHIP OF THIS SOFTWARE IS HEREBY
+TRANSFERRED. THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO
+CHANGE WITHOUT NOTICE. NO RESPONSIBILITY IS ASSUMED FOR THE
+USE OR RELIABILITY OF THIS SOFTWARE.
+*/
+
+GET "BCL:ACS"
+GET "BCL:SCB"
+GET "BCL:IOLIB"
+GET "DUNGEN"
+GET "BCL:RFSLIB"
+
+$LDTEXT "/RUNAME:POWER"
+
+EXTERNAL "."
+$(      FN
+$)
+
+MANIFEST
+$(      TREESIZE        =       RECLENGTH+2
+        RIGHT           =       RH \ TREESIZE-1
+        LEFT            =       LH \ TREESIZE-1
+        CHAIN           =       RH \ TREESIZE
+$)
+
+STATIC
+$(      CBL             =       VEC 1
+        DMPBUF          =       VEC BUFFERS
+        PERPUT          =       ?
+        REC             =       ?
+        GENDER          =       0
+        ME              =       0
+        CH              =       ?
+        NAME            =       VEC 1
+        ROOM            =       0
+        TREE            =       0
+$)
+
+LET START() BE
+$(      LET BCNT=1
+        OUTPUT:=TTY
+        OUTS("THE POWER PROGRAM!*C*L")
+        INPUT:=TTY
+        $(      OUTS("FRIG, START, LEAGUE, TRANSFER, ENUMERATE OR DOT? ")
+                SWITCHON VALOF
+                $[      $CLRBFI
+                        $INCHRW         1
+                        $TRZ    1,      #40
+                $] INTO
+                $(
+                CASE 'S':       OUTS("TART*C*L")
+                                STRAT()
+                                FINISH
+
+
+
+
+
+
+                CASE 'D':       OUTS("OT*C*L")
+                                DOT()
+                                FINISH
+                CASE 'F':       OUTS("RIG*C*L")
+                                BREAK
+                CASE 'L':       OUTS("EAGUE*C*L")
+                                LEAGUE()
+                                FINISH
+                CASE 'T':       OUTS("RANSFER*C*L")
+                                TRANSFER()
+                                FINISH
+                CASE 'E':       OUTS("NUMERATE*C*L")
+                                ENUMERATE()
+                                FINISH
+                DEFAULT 0 ... #137:
+                        OUTS("*C*LEH?*C*L")
+                $)
+        $) REPEAT
+        SETUP()
+        READNAME(NAME)
+        IF !NAME =!"RICHARD" OUTS("*C*LYOU'RE SO NAIVE...*C*L")<>FINISH
+        $(      INUUO(PERPUT,CBL)
+                REC_DMPBUF
+                UNTIL PN OF REC=0\/
+                        (NAMESAME(NAME,REC+1)/\VALOF
+                $(      OUT("*C*LDO YOU MEAN :S OF [**,:8]? ",NAME, PN OF REC)
+                        $[      
+BACK:                           $CLRBFI
+                                $INCHRW         1
+                                $IORI   1,      '*S'
+                                $CAIN   1,      'Y'
+                                $JRST           YES
+                                $CAIN   1,      'N'
+                                $JRST           NO
+                                $OUTSTR         $AZ "*C*LEH? YES OR NO? "
+                                $JRST           BACK
+YES:                            $OUTSTR         $AZ "ES*C*L"
+                                $JRST           FRONT
+NO:                             $OUTSTR         $AZ "O*C*L"
+                                $SETZ   1,      0
+FRONT:                          $CLRBFI
+                        $]
+                $) ) REC+_RECLENGTH
+                IF PN OF REC
+                $(      LET SC, SX=SCRE OF REC, WRD1 OF REC BITAND 1
+                        OUTS("CURRENT CHARACTER PROFILE IS:*C*L")
+                        OUT("NAME*T*T:S*C*LSCORE*T*T:N*T:S*C*LSTRENGTH*T:N*C*L",REC+1,SC,LEV(SC,SX),STRN OF REC)
+                        OUT("DEXTERITY*T:N*C*LSTAMINA*T*T:N*T(MAX*T:N)*C*LGAMES PLAYED*T:N*C*LSEX*T*T:SMALE*C*L",
+                        DXTY OF REC,STNA OF REC,STMX OF REC,GAMES OF REC, SX -> "FE", "")
+                        DUMPERSONA()
+                        BREAK
+                $)
+                IF REC=DMPBUF+LASTREC TEST REC!1 THEN
+                $(      BCNT+_2
+                        LOOP
+                $) OR
+                $(      REC!1_TRUE
+                        USETO(PERPUT,BCNT)
+                        OUTUUO(PERPUT,CBL)
+                        $[      $MOVE   AC,     DMPBUF
+
+
+
+
+
+
+                                $HRLI   B,      0(AC)
+                                $HRRI   B,      1(AC)
+                                $SETZM          0(AC)
+                                $ADDI   AC,     BUFFERS
+                                $BLT    B,      0(AC)
+                        $]
+                        BCNT+_2
+                        REC_DMPBUF
+                $)
+                OUT("NO CURRENT PERSONA! I'LL MAKE ONE FOR YOU, :S*C*L",NAME)
+                GAMES OF REC_1
+                WRD1 OF REC_!NAME
+                WRD2 OF REC_1!NAME
+                WIZD OF REC_FALSE
+                DUMPERSONA()
+                BREAK
+        $) REPEAT
+        USETO(PERPUT,BCNT)
+        OUTUUO(PERPUT,CBL)
+        CLOSE(PERPUT)
+        DEQ(SC.CHANNEL^PERPUT)
+$)
+AND DUMPERSONA() BE
+$(      OUTS("PREPARE TO FULFILL YOUR WILDEST DREAMS!*C*L")
+        OUTS("STRENGTH  ?");    STRN OF REC_GETNO(STRN)
+        OUTS("STAMINA (MAX)     ?");    STNA OF REC_GETNO(STNA);        STMX OF REC_STNA OF REC
+        OUTS("DEXTERITY ?");    DXTY OF REC_GETNO(DXTY)
+        OUTS("SCORE             ?");    SCRE OF REC_GETNO(SCRE)
+        OUTS("SEX               ?")
+        $[      $CLRBFI
+                $INCHRW  CH
+        $]
+        GENDER_(WRD1 OF REC) BITAND 1
+        TEST CH='M'\/CH='M' THEN OUTS("ALE*C*L")<>GENDER_0
+        OR IF CH= 'F'\/CH='F' THEN OUTS("EMALE*C*L")<>
+                GENDER_1
+        OUTS("PN                ?");    PN OF REC_GETNO(PN,TRUE)
+        UNLESS PN OF REC PN OF REC_VALOF $[     $GETPPN 1,      0       $]
+        WRD1 OF REC_((WRD1 OF REC) BITAND ^1) BITOR GENDER
+        LSTM OF REC_VALOF
+        $[      $HRRI   AC,     #11
+                $HRLI   AC,     #53
+                $GETTAB AC,     0
+                $TRN
+        $]
+$)
+AND GETNO(SEL,OCTAL)=VALOF
+$(      LET CH=VALOF
+        $[      $CLRBFI
+                $INCHRW 1
+        $]
+        UNLESS NUMBARGS()=2 OCTAL_FALSE
+        UNLESS '0' LE CH LE '9'
+        $(      $[      $CLRBFI $]
+                RESULTIS SEL OF REC
+        $)
+        PUTBACK(INPUT,  CH)
+        CH_(OCTAL->INOCT,INNO)()
+        $(      LET STK=SC.PUTSTACK^INPUT
+                SC.PUTSTACK^INPUT, SC.READER^INPUT _ !STK, STK!2
+
+
+
+
+
+
+                FREEVEC(STK)
+        $)
+        RESULTIS CH
+$)
+AND INOCT(NOPB)=VALOF
+$(      LET RES=0 AND CH=?
+        CH_INCH() REPEATUNTIL '0' LE CH LE '7'
+        WHILE '0' LE CH LE '7' DO
+        $(      RES_(RES<<3)-'0'+CH
+                CH_INCH()
+        $)
+        UNLESS NUMBARGS() PUTBACK(INPUT,CH)
+        RESULTIS RES
+$)
+AND READNAME(NM) BE
+$(      LET N,CH,LINEV=0,?,VEC NAMELENGTH
+        WRITE(TTY,"NAME: ")
+        READCH(INPUT,@CH)
+        WHILE 'A'<=(CH BITOR #40)<='Z' DO
+        $(      N+:1
+                UNLESS N>NAMELENGTH LINEV!N:='A'<=CH<='Z'->CH+#40,CH
+                READCH(INPUT,@CH)
+        $)
+        !LINEV:=N>NAMELENGTH->NAMELENGTH,N
+        PACKSTRING(LINEV,NM)
+        UNTIL CH='*L' DO READCH(INPUT,@CH)
+$)      REPEATUNTIL LENGTH OF NM
+AND DOT() BE
+$(      LET STFL,NO,CH=0,?,?
+        WRITES(TTY,"PLEASE ENTER THE JOB NUMBER OF THE ABOUT TO BE DOTTED JOB*C*L(0 FOR ALL OF THEM)*C*L")
+        WRITES(TTY,"**")
+        NO_RDNO(TTY)
+        $(      LET RES=?
+                WRITES(TTY,"DOTTED NICELY OR HORRIBLY N/H? ")
+                $[      $CLRBFI
+                        $INCHRW  CH
+                $]
+                STFL_0
+                IF CH='H' \/ CH='H' THEN STFL_'H'<>WRITES(TTY,"ORRIBLY*C*L")
+                IF CH='N' \/ CH='N' THEN STFL_'N'<>WRITES(TTY,"ICELY*C*L")
+                UNLESS STFL WRITES(TTY,"*BINVALID CHARACTER*C*L")<>LOOP
+                TEST NO THEN RES_DISPOSE(STFL, NO)
+                OR FOR I=1 TO 200 IF DISPOSE(STFL, I) RES_TRUE
+                UNLESS RES WRITES(TTY, "*C*L?POWIDW - IT DIDN'T WORK SO STOP PISSING AROUND.*C*L")
+                FINISH  
+        $) REPEAT
+$)
+AND DISPOSE(STFL, NO) BE
+$[      $SETO 1,0
+        $PJOB 3,0
+        $HRRZ 2,STFL
+        $ADD  2,3
+        $HRL  2,NO
+        $CALLI 2,#175
+        $SETZ 1,0
+$]
+AND NAMESAME(NAM1,NAM2)=
+(!NAM1>>1)=(!NAM2>>1)/\((LENGTH OF NAM1<=4)\/(1!NAM1>>1)=(1!NAM2>>1))
+AND STRAT() BE
+$(      LET RESP=?
+
+
+
+
+
+
+        $(      WRITES(TTY, "*C*LMUD OR VALLEY? ")
+                $[      $INCHRW         1
+                        $TRZ    1,      ' '
+                        $MOVEM  1,      RESP
+                $]
+        $) REPEATUNTIL RESP='V' \ RESP='M'
+        WRITES(TTY, RESP='V'->"ALLEY*C*L", "UD*C*L")
+        RESP_RESP='V'->$6"VALLEY", $6 "MUD"
+        OUTPUT_CREATETMP(RESP)
+        READNAME(NAME)
+        WRITES(TTY, "*C*LROOM: ")
+        $[ $CLRBFI      $]
+        FOR I=0 TO 5 DO
+        $(      LET LETTER = BYTE 6:30-6*I
+                AND NEXT = VALOF $[ $INCHRW    1 $]
+                IF 'A' LE NEXT LE 'Z' NEXT-_'A'-'A'
+                IF NEXT = '*C' BREAK
+                LETTER FROM ROOM _ NEXT-' '
+        $)
+        $[ $CLRBFI      $]
+        OUT(":S*^C:N*$:N*$:N",  NAME,
+                                VALOF $[ $MSTIME 1, 0 $],
+                                VALOF $[ $MSTIME 1, 0 $],
+                                ROOM)
+        CLOSE(OUTPUT)
+        RUN($6 "DSK", RESP, $6 "EXE", 0)
+$)
+
+AND SETUP() BE
+$(      !CBL_(-BUFFERS<<18)BITOR(DMPBUF-1)
+        1!CBL_0
+        IF FALSE
+        $(
+DOGONEIT:       PERPUT_CREATEFILE($6"DSK",$6"MUD",$6".PM",0,0,#17,1)
+                ENQ(SC.CHANNEL^PERPUT)
+                USETO(PERPUT,2)
+                OUTUUO(PERPUT,CBL)
+                CLOSE(PERPUT)
+                DEQ(SC.CHANNEL^PERPUT)
+        $)
+        PERPUT_UPDATEFILE($6"DSK",$6"MUD",".PM",0,LABEL(DOGONEIT),#17,1)
+        ENQ(SC.CHANNEL^PERPUT)
+        USETI(PERPUT,1)
+$)
+
+AND LEV(PTS, FEM)=VALOF
+$(      LET SC=EXP.STEP
+        FOR I=0 TO 9
+        $(      IF SC GE PTS RESULTIS I
+                SC+_SC
+        $)
+        RESULTIS 9
+$)!(FEM!(TABLE
+                (TABLE  "NOVICE",
+                        "WARRIOR",
+                        "HERO",
+                        "CHAMPION",
+                        "SUPERHERO",
+                        "ENCHANTER",
+                        "SORCERER",
+
+
+
+
+
+
+                        "NECROMANCER",
+                        "LEGEND",
+                        "WIZARD"
+                ),
+                (TABLE  "NOVICE",
+                        "WARRIOR",
+                        "HEROINE",
+                        "CHAMPION",
+                        "SUPERHEROINE",
+                        "ENCHANTRESS",
+                        "SORCERESS",
+                        "NECROMANCESS",
+                        "LEGEND",
+                        "WITCH"
+                )
+        )
+)
+
+AND ENQ(CHAN) BE
+$(      LET ADDR=VEC 4
+        !ADDR_#1000005
+        1!ADDR_142857
+        2!ADDR_CHAN
+        3!ADDR_$AZ"MUD"+(-1<<18)
+        4!ADDR_0
+        OUT("*C*LENQ. ERROR CODE :8*C*L", VALOF
+        $[      $MOVE   1,      ADDR
+                $ENQ.   1,      0
+                $TRNA
+                $(      RETURN  $)
+        $])
+$)
+
+AND DEQ(CHAN) BE
+$(      LET ADDR=VEC 1
+        !ADDR_#1000005
+        1!ADDR_142857
+        OUT("*C*LDEQ.ERROR CODE :8*C*L", VALOF
+        $[      $MOVE   1,      ADDR
+                $HRLI   1,      1
+                $DEQ.   1,      0
+                $TRNA
+                $(      RETURN  $)
+        $])
+$)
+AND TRANSFER() BE
+$(      LET PEEP, BCNT=?, 1
+        OUTS("WHERE FROM? (0 FOR EVERYWHERE) ")
+        PEEP_INOCT(TRUE)
+        SETUP()
+        $(      INUUO(PERPUT, CBL)
+                REC_DMPBUF
+                WHILE PN OF REC
+                $(      IF PN OF REC=PEEP \ PEEP=0
+                        $(      OUT(":S: [**,:8] -> ", REC+1, PN OF REC)
+                                PN OF REC_GETNO(PN, TRUE)
+                        $)
+                        REC+_RECLENGTH
+                $)
+                USETO(PERPUT, BCNT)
+
+
+
+
+
+
+                OUTUUO(PERPUT, CBL)
+                UNLESS REC=DMPBUF+LASTREC & REC!1 BREAK
+                BCNT+_2
+        $) REPEAT
+        CLOSE(PERPUT)
+        DEQ(SC.CHANNEL^PERPUT)
+$)
+
+AND LEAGUE() BE
+$(      SETUP()
+        $(      INUUO(PERPUT,CBL)
+                REC_DMPBUF
+                WHILE PN OF REC
+                $(      TREE_INSERT(SCRE OF REC, TREE)
+                        REC+_RECLENGTH
+                $)
+                UNLESS REC=DMPBUF+LASTREC & REC!1 THEN BREAK
+        $) REPEAT
+        CLOSE(PERPUT)
+        DEQ(SC.CHANNEL^PERPUT)
+        OUTREE(TREE)
+        WHILE ME
+        $(      LET P=LH OF ME
+                OUT("RICHARD*T*T[**,:8]:C*T34359738369*T999*TWIZARD*C*L",P, P LS #1000->'*T','*0')
+                ME OF_RH
+        $)
+$)
+AND ENUMERATE() BE
+$(      LET NOW=VALOF
+        $[      $HRLI   1,      #53
+                $HRRI   1,      #11
+                $GETTAB 1,      0
+                $TRN
+                $HLRZ   1,      1
+        $]
+        SETUP()
+        OUTPUT_CREATEFILE($6"DSK",$6"POWER",$6"ENM", 0, LABEL(RATS))
+        OUTS("ENUMERATION OF PERSONAS AS OF ")
+        OUTTIME()
+        OUTS(" ON ")
+        OUTDATE()
+        OUTS("::*C*L*L")
+        $(      INUUO(PERPUT,CBL)
+                REC_DMPBUF
+                WHILE PN OF REC
+                $(      LET T, SX, WZ=NOW-(LH FROM LSTM OF REC), (WRD1 OF REC) BITAND 1, WIZD OF REC
+                        OUT("NAME:*T*T:S*C*LPPN:*T*T[**,:8]*C*LSCORE:*T*T:N*C*LSTRENGTH:*T:N*C*LDEXTERITY:*T:N*C*LSTAMINA:*T:N*TMAX 
+:N*C*L",
+                                REC+1,PN OF REC,SCRE OF REC,STRN OF REC,DXTY OF REC,STNA OF REC,STMX OF REC)
+                                OUT("LAST GAME:*T:N DAY:S AGO*C*LGAMES:*T*T:N*C*LSEX:*T*T:SMALE*C*L",
+                                        T,T=1->"","S",GAMES OF REC,SX->"FE","")
+                                IF WZ BITAND 1 OUT("MODE:*T*TWI:S*C*L", SX->"TCH","ZARD")
+                                IF WZ BITAND 4 OUTS("MODE:*T*TBERSERK*C*L")
+                                OUTS("*C*L*L")
+                        REC+_RECLENGTH
+                $)
+                UNLESS REC=DMPBUF+LASTREC & REC!1 THEN BREAK
+        $) REPEAT
+        CLOSE(PERPUT)
+        DEQ(SC.CHANNEL^PERPUT)
+
+
+
+
+
+
+        CLOSE(OUTPUT)
+        WRITES(TTY,"*C*LENUMERATED IN DSK:POWER.ENM*C*L")
+        IF FALSE
+RATS:           WRITES(TTY,"*C*LCAN'T CREATE DSK:POWER.ENM*C*L")
+$)
+
+AND INSERT(SC, TREE)=VALOF
+$(      IF TREE TEST SC LS SCRE OF TREE THEN
+        $(      LEFT OF TREE_INSERT(SC, LEFT OF TREE)
+                RESULTIS TREE
+        $) OR IF SC GR SCRE OF TREE THEN
+        $(      RIGHT OF TREE_INSERT(SC, RIGHT OF TREE)
+                RESULTIS TREE
+        $)
+        SC_NEWVEC(TREESIZE)
+        FOR I=0 TO RECLENGTH SC!I_REC!I
+        SC!(RH FROM RIGHT)_0
+        IF TREE
+        $(      CHAIN OF SC_CHAIN OF TREE
+                CHAIN OF TREE_SC
+                RESULTIS TREE
+        $)
+        CHAIN OF SC_0
+        RESULTIS SC
+$)
+
+AND OUTREE(TREE) BE IF TREE
+$(      LET L, R, N, P=LEFT OF TREE, RIGHT OF TREE, TREE+1, PN OF TREE
+        OUTREE(L)
+        TEST !N=!"RICHARD" THEN
+        $(      LET M=NEWVEC(0)
+                LH OF M_P
+                RH OF M_ME
+                ME_M
+        $) OR
+        OUT(":S:C*T[**,:8]:C*T:N*T:N:S:S*C*L",N, LENGTH OF N GE 8 -> '*0', '*T', P, P LS #1000->'*T','*0', SCRE OF TREE, GAMES OF TR
+EE,
+                (WIZD OF TREE BITAND 4)-> "*TBERSERK", "",(WIZD OF TREE BITAND 1)->WRD1 OF TREE BITAND 1->"*TWITCH","*TWIZARD", "")
+        OUTREE(CHAIN OF TREE)
+        OUTREE(R)
+$)
+
+$[      FN:     $EXIT   1,      0
+                $JRST           FN
+$]