GENSYM - generate unique values.

src/alan/gensym.21

@@ -0,0 +1,303 @@
+;;;-*-Midas-*-
+
+a=1
+b=2
+c=3
+d=4
+e=5
+t=6
+tt=7
+x=10
+y=11
+
+p=17
+
+ttyo==1
+dski==2
+chaosi==15
+
+tyo=.iot ttyo,
+call=pushj p,
+return=popj p,
+
+define princ &string&
+	move x,[440700,,[ascii string]]
+	movei y,.length string
+	.call cprinc
+	 .lose %lssys
+termin
+
+define syscall name,args
+	.call [setz ? sixbit /name/ ? args(400000)]
+termin
+
+pdllen==100.
+.vector pdl(pdllen)
+
+buflen==20.			;100 characters
+.vector buf(buflen+1)		;extra word for -1 to stop .break 12,[..rjcl,,]
+
+.scalar length			;length of key in words
+.scalar iaobjn			;initial aobjn pointer into buffer
+
+	loc 100
+
+go:	.close 1,		;in case we are a chaos server
+	move p,[-pdllen,,pdl-1]
+	call gjinfo		;get job info (inferior/server)
+	call opnout		;get an output channel
+	syscall open,[[.uii,,dski] ? [sixbit /dsk/]
+			dbfn1 ? dbfn2 ? dbdir]
+	 .lose %lsfil
+	syscall fillen,[movei dski ? movem a]
+	 .lose %lssys
+	imul a,[-<1_<18.-10.>>]
+	hrri a,dbpage	
+	syscall corblk,[movei %cbndr\%cbndw ? movei %jself ? a ? movei dski]
+	 .lose %lssys
+	.close dski,
+	call getkey
+	move a,[440700,,buf]
+cntlen:	ildb c,a
+	caig c,40
+	 jrst gotlen
+	cail c,"a
+	 caile c,"z
+	  jrst cntlen
+	subi c,<"a-"A>
+	dpb c,a
+	jrst cntlen
+
+gotlen:	setzi c,
+	dpb c,a
+repeat 4,idpb c,a
+	movei b,-buf(a)
+	movem b,length
+	imul b,[-1,,0]
+	hrri b,buf
+	movem b,iaobjn
+	movei e,db
+fndkey:	hlrz d,(e)
+	jumpe d,nofind
+	came d,length
+	 jrst [addi e,1(d) ? jrst fndkey]
+	move a,iaobjn
+	movei b,1(e)
+eqloop:	move t,(a)
+	came t,(b)
+	 aoja e,[add e,length ? jrst fndkey]
+	aoj b,
+	aobjn a,eqloop
+	push p,e
+	call didfind
+	pop p,e
+	aos a,(e)
+	hrrz a,a
+	call prtnum
+	call finish
+	jrst die
+
+prtnum:	idivi a,10.
+	jumpe a,prtnm1
+	hrlm b,(p)
+	call prtnum
+	hlrz b,(p)
+prtnm1:	addi b,"0
+	tyo b
+	return
+
+die:	skipe debug
+	 .value
+	.logout 1,
+
+.scalar hastty,haschs
+gjinfo:	setzm hastty
+	setzm haschs
+	.suset [.roption,,t]
+	tlne t,optddt
+	 jrst [	setom hastty
+		return]
+	.suset [.rjname,,t]
+	.suset [.rsname,,tt]
+	camn t,[sixbit/chaos/]
+	 came tt,[sixbit/gensym/]
+	  skipa
+	   jrst [	setom haschs
+			return]
+	.value			;don't know what we have
+
+;;; generic operations
+
+opnout:	skipe hastty
+	 jrst ttyopn
+	skipe haschs
+	 jrst chsopn
+	.value
+
+getkey:	move a,[buf,,buf+1]
+	setzm buf
+	blt a,buf+buflen-1
+	setom buf+buflen
+
+	skipe hastty
+	 jrst ttykey
+	skipe haschs
+	 jrst chskey
+	.value
+
+didfind:skipe hastty
+	 jrst ttydid
+	skipe haschs
+	 jrst chsdid
+	.value
+
+nofind:	skipe hastty
+	 jrst ttynof
+	skipe haschs
+	 jrst chsnof
+	.value
+
+finish:	skipe hastty
+	 jrst ttyfin
+	skipe haschs
+	 jrst chsfin
+	.value
+
+;;; tty operations
+
+ttyopn:	syscall open,[[%tjdis+.uao,,ttyo] ? [sixbit /tty/]]
+	 .lose %lssys
+	return
+
+ttykey:	.suset [.roption,,a]
+	tlnn a,%opcmd
+	 jrst nojcl
+	.break 12,[..rjcl,,buf]
+	return
+
+nojcl:	princ "AUse JCL."
+	call die
+
+ttynof:	call prtkey
+	princ "ANot found."
+	call die
+
+prtkey:	princ |AKey: "|
+	skipa a,[440700,,buf]
+	 tyo c
+	ildb c,a
+	jumpn c,.-2
+	tyo [""]
+	return
+
+ttydid:	call prtkey
+	princ "ANext value: "
+	return
+
+ttyfin:	.close ttyo,
+	return
+
+;;; chaosnet operations
+
+.insrt system;chsdef >
+.vector chspkt(%cpmxw)
+
+chsopn:	syscall chaoso,[movei chaosi ? movei ttyo ? movei 1]
+	 call die
+	movei a,%colsn
+	dpb a,[$cpkop chspkt]
+	move a,[440700,,[asciz /GENSYM/]]
+	move b,[440800,,<chspkt+%cpkdt>]
+	setzi c,
+chop10:	ildb d,a
+	jumpe d,chop20
+	idpb d,b
+	aoja c,chop10
+chop20:	dpb c,[$cpknb chspkt]
+	syscall pktiot,[movei ttyo ? movei chspkt]
+	 call die
+	movei t,30.*10.		;ten seconds
+	skipe debug
+	 movei t,30.*60.*2.	;two minutes if debugging
+	syscal netblk,[movei chaosi ? movei %cslsn ? t ? movem tt]
+	 call die
+	caie tt,%csrfc
+	 call die
+	return
+
+chskey:	syscal pktiot,[movei chaosi ? movei chspkt]
+	 call die		;RFC better be there
+	move a,[440700,,buf]
+	move b,[440800,,<chspkt+%cpkdt>]
+	ldb c,[$cpknb chspkt]
+chky10:	ildb d,b
+	soje c,[return]
+	caie d,40
+	 jrst chky10
+chky20:	ildb d,a		;make sure allowed to put
+	jumpn d,[return]
+	ildb d,b		;get packet character
+	dpb  d,a		;plop it down
+	sojg c,chky20
+	return
+
+chsnof:	movei t,%cocls		;reject the connection
+	dpb t,[$cpkop chspkt]
+	move a,[440800,,<chspkt+%cpkdt>]
+	setzi b,
+	move c,[440700,,[asciz /Key "/]]	;[["]]
+	call chsprt
+	move c,[440700,,buf]
+	call chsprt
+	move c,[440700,,[asciz /" not found./]]	;[["]]
+	call chsprt
+	dpb b,[$cpknb chspkt]
+	syscall pktiot,[movei ttyo ? movei chspkt]
+	 call die
+	call die
+
+chsprt:	ildb t,c
+	jumpe t,[return]
+	idpb t,a
+	aoja b,chsprt
+
+chsdid:	movei t,%coopn
+	dpb t,[$cpkop chspkt]
+	syscall pktiot,[movei ttyo ? movei chspkt]
+	 call die
+	return
+
+chsfin:	syscall force,[movei ttyo]
+	 call die
+	movei t,%coeof
+	dpb t,[$cpkop chspkt]
+	setzi t,
+	dpb t,[$cpknb chspkt]
+	syscall pktiot,[movei ttyo ? movei chspkt]
+	 call die
+	syscall finish,[movei ttyo]
+	 call die
+	.close ttyo,
+	.close chaosi,
+	return
+
+dbdir:	sixbit /ALAN/
+dbfn1:	sixbit /GENSYM/
+dbfn2:	sixbit /DATA/
+
+cprinc:	setz
+	sixbit /siot/
+	movei ttyo
+	move x
+	setz y
+
+debug:	0			;debuggingp?
+
+variables
+constants
+
+dbpage==:<.+1777>/2000
+db=:dbpage*2000
+
+	end go
+