From 3421b87214afbba2a212136f40633508c7824651 Mon Sep 17 00:00:00 2001
From: Lars Brinkhoff <lars@nocrew.org>
Date: Thu, 5 Oct 2023 11:47:00 +0200
Subject: [PATCH] Chaosnet service to report host load.

---
 build/misc.tcl       |   3 +
 build/timestamps.txt |   1 +
 src/alan/load.12     | 133 +++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 137 insertions(+)
 create mode 100644 src/alan/load.12

diff --git a/build/misc.tcl b/build/misc.tcl
index 0833e32d..b44db600 100644
--- a/build/misc.tcl
+++ b/build/misc.tcl
@@ -162,6 +162,9 @@ respond "*" ":midas alan;ts gensym_alan;gensym\r"
 expect ":KILL"
 respond "*" ":link device; chaos gensym, alan; ts gensym\r"
 
+respond "*" ":midas device;chaos load_alan;load\r"
+expect ":KILL"
+
 # Mini Chaosnet file server.  Version 5 is MINIC.
 respond "*" ":midas sysbin; minic bin_syseng; minisr 5\r"
 expect ":KILL"
diff --git a/build/timestamps.txt b/build/timestamps.txt
index 8599ade0..03fb6bf8 100644
--- a/build/timestamps.txt
+++ b/build/timestamps.txt
@@ -17,6 +17,7 @@ alan/gensym.21 198210071659.49
 alan/gensym.data 198210060137.50
 alan/ljob.74 198608310056.32
 alan/ljob.fasl 198608310056.41
+alan/load.12 198503212329.03
 alan/lspcom.20 198402060114.20
 alan/lspcom.fasl 198402060114.36
 alan/lspenv.259 198611082116.10
diff --git a/src/alan/load.12 b/src/alan/load.12
new file mode 100644
index 00000000..c56cc5dc
--- /dev/null
+++ b/src/alan/load.12
@@ -0,0 +1,133 @@
+;;;-*-Midas-*-
+
+a=:1
+b=:2
+c=:3
+d=:4
+e=:5
+t=:6
+tt=:7
+x=:10
+y=:11
+z=:12
+
+nb=:13
+
+p=:17
+
+neti==:1
+neto==:2
+
+call=:pushj p,
+return=:popj p,
+save==:push p,
+rest==:pop p,
+pause=:.break 16,100000
+quit=:.logout 1,
+
+loc 42
+	tsint
+loc 100
+
+define syscall name,args
+	.call [setz ? sixbit /name/ ? args(400000)]
+termin
+
+.insrt dsk:system;chsdef >
+$cpkbp==:440800,,%cpkdt
+.vector pkt(%cpmxw)
+.scalar pktbp
+.scalar pktrm
+
+lpdl==:50.
+.vector pdl(lpdl)
+
+format"$$errs==:0
+.insrt dsk:syseng;format
+
+define format &string&,args
+	pushj p,[
+	pushj p,fmtin
+zzz==-1
+irp arg,,[args]
+	push p,arg
+zzz==.irpcnt
+termin
+	hrroi a,[ascii string]
+	movei b,.length string
+	movni c,zzz+1
+	jrst format"format]
+termin
+
+fmtin:	push p,a
+	push p,b
+	push p,c
+	push p,[fmtout]
+	jrst @-4(p)
+
+fmtout:	pop p,c
+	pop p,b
+	pop p,a
+	pop p,(p)
+	popj p,
+
+go:	.close 1,		; Started as server
+	move p,[-lpdl,,pdl-1]
+	.suset [.smask,,[%piioc]]
+	syscall chaoso,[movei neti ? movei neto ? movei 3]
+	 .lose %lssys
+	movei a,%colsn
+	call init
+	format "LOAD"
+	call pktout
+	movei a,%cslsn
+	movei b,30.*10.		; 10 seconds
+	syscall netblk,[movei neto ? a ? b ? movem c]
+	 .lose %lssys
+	caie c,%csrfc
+	 quit
+	movei a,%coans
+	call init
+	move a,[squoze 0,sloadu]
+	.eval a,
+	 .lose
+	hrl a,a
+	hrri a,a
+	.getloc a,
+	movei t,10000.
+	idivm t,a
+	syscall sstatu,[movem b ? movem b ? movem b]
+	 .lose %lssys
+	format "Fair Share: ~D%~%Users: ~D.",[a,b]
+	call pktout
+	syscall finish,[movei neto]
+	 jfcl
+	quit
+
+init:	dpb a,[$cpkop pkt]
+	move tt,[$cpkbp pkt]
+	movem tt,pktbp
+	movei tt,%cpmxc
+	movem tt,pktrm
+	return
+
+outst1:	sosge pktrm
+	 .lose
+	ildb tt,a
+	idpb tt,pktbp
+outstr:	sojge b,outst1
+	return
+
+pktout:	movei tt,%cpmxc
+	sub tt,pktrm
+	dpb tt,[$cpknb pkt]
+	syscall pktiot,[movei neto ? movei pkt]
+	 .lose %lssys
+	return
+
+tsint:	0
+	0
+	quit
+
+end go
+
\ No newline at end of file