; -*- midas -*-
title HSNAME -- Print a user's HSNAME

x=0
a=1
b=2
c=3
d=4
t=5
tt=6
p=17

tyoc=16

pdllen==40

define syscal op,args
	.call [setz ? sixbit /op/ ? args ((setz))]
termin

argi=:1000,,0
val=:2000,,0
cnti=:5000,,0

define type &string
       move t,[440700,,[asciz string]]
       movei tt,<.length string>
       syscal SIOT,[argi tyoc ? t ? tt]
         .lose %lsfil
termin


go:	move p,[-pdllen,,pdl]	   ;init the stack pointer
	.break 12,[..rjcl,,jclbuf] ;read in the JCL
	syscal open,[cnti .uao\%tjdis ? argi tyoc ? [sixbit /TTY/]]
	  .lose %lsfil
	move d,[440700,,jclbuf]
	setzm jclp		   ;have we seen any real JCL?
jclred:	movei c,6
	setz a,			   ;start with empty word
jclrd0:	ildb b,d		   ;read a char
	caie b,",		   ;Comma?
	  cain b,40		   ;  space?
	    jrst jclrd0		   ;    yes, read another
jclrd1:	caie b,0		   ;null?
	  cain b,^C		   ;  ^C?
	    jrst jclrd9		   ;    end of JCL
	caie b,^M		   ;CR?
	  cain b,^_		   ;  ^_?
	    jrst jclrd9		   ;	these can end JCL too.
	caie b,",		   ;Comma?
	  cain b,40		   ;  space?
	    jrst [ imuli c,6
		   skiple c	   ;    unless already full
		     lshc a,(c)	   ;      align the word properly
		   pushj p,namhak  ;    Hack this person
		   jrst jclred]	   ;	and gobble some more names, maybe
	cail b,140
	  subi b,40		   ;convert to sixbit
	subi b,40
	lsh b,36		   ;move the char into our word
	skiple c		   ;unless we've already got 6 chars
	  lshc a,6		   ;  we shift it into the rightmost part
	ildb b,d		   ;get another character
	soja c,jclrd1		   ;and add this into the menagerie.

jclrd9:	jumpe a,done		   ;If no name there, just log out now
	imuli c,6		   ;convert characters to bits
	skiple c		   ;  unless already full
	  lshc a,(c)
	pushj p,namhak		   ;otherwise hack a name first
done:	skipn jclp		   ;have we found anything at all so far?
	  jrst penult		   ;  no, try for our own HSNAME
	.logout 1,		   ;and then we're done

penult:	.suset [.rxuname,,a]	   ;use our own XUNAME
	pushj p,namhak		   ;hack it
	.logout 1,		   ;and bye-bye

namhak:	setom jclp		   ;say we found some real JCL
	type /A/
	movem a,usrnam		   ;save the name
	pushj p,6type		   ;type it though
	type / ==> /
	.break 12,[..rhsname,,itsnam]  ;get his HSNAME from DDT
	move a,usrnam		   ;type the directory
	jrst 6type

6type:	move b,a		   ;get word in B
6type1:	setz a,			   ;clear out A to receive a char
	lshc a,6		   ;get the leftmost char in A
	cain a,0		   ;space?
	  jrst [ type /^Q/	   ;  quote it first
		 jrst .+1]
	addi a,40		   ;Convert to ascii
	.iot tyoc,a		   ;type it
	jumpn b,6type1		   ;if there's any more, type it too
	popj p,			   ;otherwise return

itsnam:	0
usrnam:	0
jclp:	0

jclbuf:	block 40
pdl:	[.lose]
	block pdllen


end go