zork-1978-01/zork/ar1.random/setsn.1

<TITLE SNAME-SETTER>
	<DECLARE ("VALUE" <PRIMTYPE WORD> "OPTIONAL" <OR STRING <PRIMTYPE WORD>>)>
	<JUMPL	AB* DOPUSH>
	<PUSHJ	P* GETSNM>
	<JRST	FINIS>
DOPUSH	<DPUSH	TP* (AB)>
	<PUSHJ	P* SETSNM>
	<JRST	FINIS>

; "GET .SNAME IF NO ARGUMENT GIVEN"
<INTERNAL-ENTRY GETSNM 0>
	<SUBM	M* (P)>
	<*SUSET	[<(*16*) B>]>
	<MOVE	A* <TYPE-WORD WORD>>
	<JRST	MPOPJ>

; "SET .SNAME, DOING STRTOX IF GIVEN STRING"
<INTERNAL-ENTRY SETSNM 1>
	<SUBM	M* (P)>
	<POP	TP* B>
	<POP	TP* A>
	<GETYP	O* A>
	<CAIN	O* <TYPE-CODE STRING>>
	 <PUSHJ	P* STRTOX>
	<*SUSET	[<(*400016*) B>]>
	<JRST	MPOPJ>

; "DO STRTOX"
STRTOX	<SUBM	M* (P)>
	<HRRZ	O* A>
	<CAILE	O* 6>		; "Length of string L=? 6?"
	 <MOVEI	O* 6>
	<MOVE	C* [<(*440600*) E>]>
	<MOVEI	E* 0>
SXLOOP	<ILDB	D* B>		; "Get character in D"
	<CAIL	D* *140*>	; "Lower case?"
	 <SUBI	D* *40*>
	<SUBI	D* *40*>
	<IDPB	D* C>		; "Cons into E"
	<SOJN	O* SXLOOP>	; "Done?"
	<MOVE	B* E>
	<MOVE	A* <TYPE-WORD WORD>>
	<JRST	MPOPJ>