Build DEVICE; JOBDEV CHA from source code.

Makefile

@@ -9,8 +9,7 @@ SRC = system syseng sysen1 sysen2 sysen3 sysnet kshack dragon channa	\
       inquir acount gz sys decsys ecc alan sail kcc kcc_sy c games archy dcp \
       spcwar
 DOC = info _info_ sysdoc sysnet syshst kshack _teco_ emacs emacs1 c kcc chprog
-BIN = sys2 device emacs _teco_ lisp liblsp alan inquir sail comlap c decsys \
-      moon
+BIN = sys2 emacs _teco_ lisp liblsp alan inquir sail comlap c decsys moon
 
 # These directories are put on the minsys tape.
 MINSYS = _ sys

bin/device/jobdev.chaos

@@ -1 +0,0 @@
-device/jobdev.cha

build/build.tcl

@@ -238,6 +238,8 @@ respond "*" ":print cstacy;..new. (udir)\r"
 type ":vk\r"
 respond "*" ":print teach;..new. (udir)\r"
 type ":vk\r"
+respond "*" ":print device;..new. (udir)\r"
+type ":vk\r"
 
 respond "*" ":midas sysbin;_.teco.;teco\r"
 expect ":KILL"
@@ -556,6 +558,11 @@ respond "*" ":midas sysbin;_syseng;@chaos\r"
 expect ":KILL"
 respond "*" ":link sys;atsign chaos,sysbin;@chaos bin\r"
 
+# CHA: and CHAOS: device
+respond "*" ":midas device;jobdev cha_dcp;chadev\r"
+expect ":KILL"
+respond "*" ":link device;jobdev chaos,device;jobdev cha\r"
+
 respond "*" ":link syseng;netwrk 999999,sysnet;netwrk >\r"
 
 respond "*" ":midas .;ts redrct_sysnet;redrct\r"

src/dcp/chadev.1

@@ -0,0 +1,418 @@
+
+title	CHA device -- cha:.file. (dir)  lists connections
+
+idebug==0			;0<-->not debugging
+
+irps ac,,nil a b c d e f g t tt w x y z zz p
+ac=.irpcnt
+termin
+
+bojo==1
+
+lpdl==30
+
+call=pushj p,
+return=popj p,
+
+define syscal name,args
+	.call [setz ? sixbit/name/ ? args ((setz))]
+termin
+
+tsint:	loc 42
+	-ltsint,,tsint
+	loc tsint
+
+	p
+	0? 1_bojo ? -1 ? -1 ? bojint
+ltsint==.-tsint
+
+.vector pdl(lpdl)
+.vector buffer(80.*64.)		;80 chars accross by 60 lines
+.vector data(12.)
+.scalar done
+
+go:	move p,[-lpdl,,pdl-1]
+	.suset [.roption,,t]
+	tlo t,optint		;new style interrupts
+	.suset [.soption,,t]
+	.suset [.smsk2,,[1_bojo]]	;interrupts on the job device
+	setzm done		;not done yet
+	syscal open,[[.uao,,bojo] ? ['boj,,]]
+	 call die
+	syscal jobcal,[movei bojo ? movem a ? [-12,,data]]
+	 call die
+	move x,data+1
+	came x,[sixbit/.file./]
+	 call illfnm
+	move x,data+2
+	came x,[sixbit/(dir)/]
+	 call illfnm
+	syscal jobret,[movei bojo ? movei 1]	;winning open
+	 call die
+	call evsyms
+	call filbuf		;go fill the buffer with CHAOS listing
+	call shove
+	syscal jobret,[movei bojo ? movei 1]	;tell IOTs that
+						;they've won
+	 jfcl
+	jfcl
+	 .hang			;wait until we get a close or
+				;something 
+
+illfnm:	syscal jobret,[movei bojo ? [%ebdfn,,]]	;illegal file name
+	 jfcl
+	call die		;and die
+
+;;; ;;; CLOSE	commit suicide
+;;; ;;; IOT	if still generating, ignore
+;;; ;;; 	if finished, send OK completion and let him worry about it
+;;; ;;; 'else	send OK return and hope
+
+bojint:	push p,a
+	push p,b
+bojin1:	syscal jobcal,[movei bojo ? movem a ? [-1,,b]]
+bojin2:	 jrst [	pop p,b
+		pop p,a
+		jrst dismis]
+	tlne a,60000		;bit 4.5 or 4.6 means close
+	 call die
+	hrrz a,a
+	camn b,['fillen]
+	 jrst [	syscal jobret,[movei bojo ? [%ebddv,,]]
+		 jrst lose
+		jrst bojin1]
+	cain a,1		;iot?
+	 skipe done		;finished my IOTing
+	  skipa
+	   jrst bojin2		;dismis ioting
+	syscal jobret,[ movei bojo ? movei 1]	;else win (sigh)
+	 jrst bojin2
+	jrst bojin1
+
+dismis:	syscal dismis,[p]
+lose:	syscal jobret,[movei bojo ? [%ensmd,,]]	;mode not available
+	 call die
+	jrst dismis
+
+die:	skipe debug
+	 .value
+	.logout 1,
+	.break 16,160000
+	.value
+
+
+define symtab syms
+irp sym,,[syms]
+	sym',,[squoze 0,/sym/]
+termin
+	0
+termin
+
+symtbl:	symtab [nindx,chsusr,uname,jname,chssta,chsibp,chsobp,chsnbf,chsnos,chspkn,chsack,chswin,chsfrn,%cfoff,%cfsts,%cfcls,%cfsty,chttbf,chfrbf,chqrfc,chqlsn]
+
+define eval val,tab,idx
+	move val,tab
+	addi val,idx
+	move val,400000(val)
+termin
+
+evsyms:	movei a,symtbl
+evslp:	hrrz b,(a)
+	skipn b
+	 jrst evsy02
+	move b,(b)
+	.eval b,
+	 .lose 1000
+	hlrz c,(a)
+	movem b,(c)
+	aoja a,evslp
+
+evsy02:	move t,[-200,,200]
+	setzi tt,
+	syscal corblk,[movei %cbred+%cbndr
+		movei %jself ? t
+		movei %jsabs ? tt]
+	 .lose 1000
+	return
+
+
+.scalar count
+
+define princ &str&,
+	movei .length str
+	addm  count
+	move t,[440700,,[asciz str]]
+	skipa
+	idpb tt,a
+	ildb tt,t
+	jumpn tt,.-2
+termin
+
+define ctype item
+	movei item
+	idpb  a
+	aos count
+termin
+
+define terpri
+	movei ^M
+	idpb  a
+	movei ^J
+	idpb  a
+	movei 2
+	addm count
+termin
+
+define space n,\m
+m==n+ifb n,1
+	movei  40
+	repeat m, idpb a
+	movei  m
+	addm count
+termin
+
+define octprn n,arg
+	movsi -n
+	move t,arg
+	call $octprn
+termin
+
+define decprn n,arg
+ifnb n,	movsi -n
+ifb  n, movsi 400000
+	move t,arg
+	call $decprn
+termin
+
+define sixprn arg
+	move t,[440600,,arg]
+	movei 6
+	addm count
+	ildb tt,t
+	addi tt,40
+	idpb tt,a
+	sojg ,.-3
+termin
+
+
+filbuf:	setzm count
+	move a,[440700,,buffer]
+
+	princ /
+Idx Usr Uname  Jname  State  Ibf Pbf Nos Ack R Win T Foreign Addr  Flag
+/
+	setzi b,
+filb02:	caml b,nindx
+	 jrst filb20
+	eval t,chsusr,(b)
+	skipl t
+	 call prtidx
+	aoja b,filb02
+
+filb20:	eval c,chttbf
+	decprn ,c
+	princ / buffers, /
+	eval c,chfrbf
+	decprn ,c
+	princ / of which are free./
+	terpri
+
+	eval c,chqrfc
+	skipn c
+	 jrst filb30
+	princ /Pending RFCs:/
+	terpri
+	hlrz c,c
+	call prtpkt
+	jumpn c,.-1
+
+filb30:	eval c,chqlsn
+	skipn c
+	 jrst filb40
+	princ /Pending LSNs:/
+	terpri
+	hlrz c,c
+	call prtpkt
+	jumpn c,.-1
+
+filb40:
+	princ //
+	return
+
+prtidx:	octprn 3,b
+	space
+	eval c,chsusr,(b)
+	ldb d,[111100,,c]
+	octprn 3,d
+	space
+	eval d,uname,(c)
+	sixprn d
+	space
+	eval d,jname,(c)
+	sixprn d
+	space
+	eval c,chssta,(b)
+	move d,(c)[sixbit /closedlistenrfcrcvrfcsntopen  losingincxmtlowlvl/]
+	sixprn d
+	space
+	eval c,chsnbf,(b)
+	hlrz d,c
+	decprn 3,d
+	space
+	hrrz c,c
+	decprn 3,c
+	space
+	eval c,chsnos,(b)
+	decprn 3,c
+	space
+	eval c,chspkn,(b)
+	eval d,chsack,(b)
+	hlrz c,c
+	hlrz d,d
+	sub c,d
+	skipge c
+	 addi c,200000
+	decprn 3,c
+	space
+	eval c,chswin,(b)
+	hlrz d,c
+	caige d,10.
+	 call [	decprn 1,d
+		space 3
+		return]
+	caige d,100.
+	 caige d,10.
+	  skipa
+	   call [ decprn 2,d
+		  space 2
+		  return]
+	cail d,100.
+	 call [ decprn 3,d
+		space 1
+		return]
+	hrrz d,c
+	decprn 3,d
+	space
+	eval c,chsfrn,(b)
+	ldb d,[242000,,c]
+	octprn 6,d
+	space
+	ldb d,[042000,,c]
+	octprn 6,d
+	space
+
+	eval c,chssta,(b)
+	TSNE c,%CFOFF
+	 call [	ctype "F	;F - OFF AT PI LEVEL
+		return]
+	TSNE c,%CFSTS
+	 call [	ctype "S	;S - SEND STS
+		return]
+	TSNE c,%CFCLS
+	 call [	ctype "C	;C - HALF-CLOSED
+		return]
+	TSNE c,%CFSTY
+	 call [	ctype "T	;T - CONNECTED TO STY
+		return]
+	eval c,chsibp,(b)
+	skipe c
+	 call [	ctype "I	;I - HAS INPUT BUFFER
+		return]
+	eval c,chsobp,(b)
+	skipe c
+	 call [	ctype "O	;O - HAS OUTPUT BUFFER
+		return]
+
+	terpri
+	return
+
+prtpkt:	octprn 6,c
+	princ /: /
+	hrlzi d,2(c)
+	hrri d,d
+	.getloc d,
+	ldb d,[041200,,d]
+	octprn 3,d
+	space
+	hrlzi d,(c)
+	hrri d,d
+	.getloc d,
+	ldb b,[041400,,d]
+	hrlzi e,4(c)
+	hrri e,d
+prtpk2:	.getloc e,
+	move f,[441000,,d]
+repeat 4,[
+	ildb g,f
+	ctype (g)
+	sojle b,prtpk4
+]
+	add e,[1,,]
+	jrst prtpk2
+prtpk4:	terpri
+	hrlzi d,-2(c)
+	hrri d,d
+	.getloc d,
+	hrrz c,d
+	return
+
+
+$octprn:
+	idivi t,8
+	addi tt,"0
+	push p,tt
+	aobjp $octp3
+	jumpn t,$octprn
+	movei tt,<" >
+	push p,tt
+	aobjn .-1
+$octp3:	addm count
+	pop p,tt
+	idpb tt,a
+	sojg .-2
+	return
+
+$decprn:
+	idivi t,10.
+	addi tt,"0
+	push p,tt
+	aobjp $decp3
+	jumpn t,$decprn
+	tlnn 200000
+	 jrst [ hrrz ? jrst $decp3]
+	movei tt,<" >
+	push p,tt
+	aobjn .-1
+$decp3:	addm count
+	pop p,tt
+	idpb tt,a
+	sojg .-2
+	return
+
+
+shove:	move tt,[440700,,buffer]
+	move t,count
+	syscal siot,[movei bojo ? tt ? t]
+	 jfcl
+	move t,count
+	idivi t,5
+	subi tt,5		;neg number needed to send
+	.iot bojo,[-1,,^C]
+	aojl tt,.-1
+	setom done		;declare done
+	return
+
+...lit:	constants
+debug:	idebug
+...var::variables
+	0			;make sure page exists
+
+end go
+
+
+;;; local modes:
+;;; mode:midas
+;;; auto fill mode:
+;;; fill column:70
+;;; compile command: :midas device;jobdev cha_1 î
+;;; end: