// S T P R O C S // GSTPROCS subset **
// catalogue number
// ** get "LUSERSYMS.SR";
get "CHAR.DF"
external
	[ pm;
	move;
// **	outsb;
// **	outnum;
	divmod;
	] 
// external (incoming statics)

// Outgoing Procedures

external
	[ stsize;
	stcopy;
// **	stsubstring;
// **	stsubstringi;
// **	stcompare;
	stequal	// **
	stappend;
	stget;
	stput;
// **	stenc;
// **	stdec;
	stnum;
// **	pxst;
// **	ckst;
	stlkup;
	sbwsize
	] 
// external (outgoing statics)
// static  (locally declared statics)
// local structures 

structure [
	lh	byte;
	rh	byte;
	]
	= [
	blank	bit 15;
	odd	bit 1;
	];

structure ST:
	[
	blank	word;
	siz	word;
	pos	word;
	sb	word;
	];

// manifest

//  S T S I Z E
//  number of characters in st
let stsize(st) =  st >> lh

//  S T C O P Y
and stcopy(st1,st2) be move(st2,st1,((st2 >> lh rshift 1)+1))

and stequal(st1,st2) = valof // **
[
let cbyte1 = st1 >> lh;
let cbyte2 = st2 >> lh;
if cbyte1 ne cbyte2 then resultis false
let nw = (cbyte1+1) rshift 1
for i = 0 to nw-1 do if st1 ! i ne st2 ! i then resultis false
if cbyte1 << odd then resultis true
resultis (st1 ! nw) << lh eq (st2 ! nw) << lh
] 


// S T A P P E N D
and stappend(sb,st) = valof // Tesler knows how to make this 4 lines
[ let pwst = nil; let pwsb = nil;
let cbytest = nil;
let bytest = nil
let lbst = false; let lbsb = false;
cbytest = st >> lh;
pwst = st;
// determine where the end of sb is
test (sb >> lh) << odd ifso
	[
	lbsb = true;
	pwsb = sb+(sb >> lh rshift 1)+1;
	] 
ifnot	pwsb = sb+(sb >> lh  rshift  1);
for i = 1 to cbytest do
	[ test lbst ifso
		[ bytest = pwst >> lh;
		lbst = false;
		] 
	ifnot	[ bytest = pwst >> rh;
		lbst = true;
		pwst = pwst+1;
		] 
	test lbsb ifso
		[ (rv pwsb) = bytest lshift 8;
		lbsb = false;
		] 
	ifnot	[ pwsb >> rh = bytest;
		lbsb = true;
		pwsb = pwsb+1;
		(rv pwsb) = 0;
		] 
	] 
if not lbsb then pwsb >> rh = 0;
sb >> lh = (sb >> lh)+cbytest;
resultis sb
] 


// S T G E T
and stget(st,i) = valof
[
if i ge (st >> lh) then resultis -1;
let j = (i+1) rshift 1;
test (i << odd) eq 1 ifso resultis (st + j) >> lh
ifnot	resultis (st + j) >> rh;
] 


// S T P U T
and stput(sb,i,char) be
[ let j = (i+1) rshift 1;
test (i << odd) eq 1 ifso (sb + j) >> lh = char
ifnot	(sb + j) >> rh = char;
]

// S T N U M

and stnum(st,number,radix,width,zf,lj,signed; numargs N) = valof
[
let pxnum,negative,j = vec 8,false,0;

if N ls 7 then signed = false;
if N ls 6 then lj = true;
if N ls 5 then zf = false;
if N ls 4 then width = 0;
if N ls 3 then radix = 10;

if signed & (number ls 0) then
	[ number = -number; negative = true ];

pxnum ! 0 = 0;
	[
	pxnum ! 0 = (pxnum ! 0)+1;
	number = divmod(number,radix,lv (pxnum ! (pxnum ! 0)));
	] repeatuntil (number eq 0);

if negative then
	[
	pxnum ! 0 = (pxnum ! 0)+1;
	pxnum ! (pxnum ! 0) = $--$0;
	];

test (pxnum ! 0) gr width ifso
	[
	test (width eq 0) ifso
		[
		for i = pxnum ! 0 to 1 by -1 do
			[
			stput(st,j,(pxnum ! i)+$0);
			j = j+1;
			];
		st >> lh = pxnum ! 0;
		resultis true;
		]
	ifnot	[
		for i = 1 to width by 1 do
			[
			stput(st,j,$**);
			j = j+1;
			];
		resultis false;
		];
	]
ifnot	[
	test lj ifso
		[
		for i = pxnum ! 0 to 1 by -1 do
			[
			stput(st,j,pxnum ! i);
			j = j+1;
			];
		for i = 1 to width-pxnum ! 0 do
			[
			stput(st,j,zf ? $0-$0,chsp-$0);
			j = j+1;
			];
		]
	ifnot	[
		for i = 1 to width-pxnum ! 0 do
			[
			stput(st,j,zf ? $0-$0,chsp-$0);
			j = j+1;
			];
		for i = pxnum ! 0 to 1 by -1 do
			[
			stput(st,j,pxnum ! i);
			j = j+1;
			];
		];
	st >> lh = pxnum ! 0;
	resultis true;
	]
] // end stnum

// S T L K U P
// SPE catalogue #

and stlkup(rgst,siz,st) = valof
[
for i = 0 to siz-1 do
	if stequal(rgst ! i,st) then resultis i;
resultis -1;
];


and sbwsize(st) = (stsize(st) + 2) rshift 1 // ** guessed code