-- JaMString.mesa
-- Written by: John Warnock, January, 1979
-- Last changed by Doug Wyatt, December 4, 1980  2:22 PM

DIRECTORY
	JaMStringDefs
		USING [Relation],
	JaMMasterDefs
		USING [Frame, Object],
	JaMControlDefs
		USING [GetCurrentFrame, NotifyCommand, NotifyStringObject],
	JaMExecDefs
		USING [JaMError],
	JaMFnsDefs
		USING [PopInteger, PopString, PushBoolean, PushInteger,
		PushLongInteger],
	JaMLiteralDefs
		USING [StringLit],
	JaMStackDefs
		USING [Pop, Push],
	JaMTypeChkDefs
		USING [DescStringType],
	JaMVMDefs
		USING [AllocateCharsVM, GetCharVM, PutCharsVM, PutCharVM],
	Inline
		USING [LowHalf],
	IODefs
		USING [LineOverflow],
	Real
		USING [AppendReal],
	String
		USING [AppendDecimal, AppendLongDecimal,
		AppendNumber, AppendLongNumber, StringToLongNumber];

JaMString: PROGRAM
IMPORTS JaMFnsDefs,JaMExecDefs,JaMTypeChkDefs,JaMControlDefs,
	JaMLiteralDefs,JaMStackDefs,vm:JaMVMDefs,
	Real,Inline,IODefs,str:String
EXPORTS JaMStringDefs =
BEGIN OPEN JaMStackDefs,JaMMasterDefs;

-- The following routines implement a set of string manipulations.


-- In a StringType Object, the concatenation of Address and Offset gives a
-- 33-bit byte address into VM. AddBytes adds a byte offset to the address.
-- 	[newAddress,newOffset] _ [Address,Offset] + bytes
AddBytes: PROCEDURE[Address: LONG POINTER, Offset: [0..1], bytes: CARDINAL]
	RETURNS[LONG POINTER, [0..1]] = INLINE
	BEGIN
	offs: CARDINAL_Offset+bytes;
	RETURN[Address+offs/2,offs MOD 2];
	END;


String: PUBLIC PROCEDURE  =
	BEGIN
	frame: Frame _ JaMControlDefs.GetCurrentFrame[];
	i: INTEGER _ JaMFnsDefs.PopInteger[];
	s: StringType Object _ [lit,StringType[,,]];
	IF i < 0 THEN RangeErr[];
	s.Length _ i;
	[s.Address,s.Offset]_vm.AllocateCharsVM[i];
	Push[s,frame.opstk];
	END;


StringCompare: PUBLIC PROCEDURE [s1,s2: StringType Object]
	RETURNS[r:JaMStringDefs.Relation] =
	BEGIN
	c1,c2: CHARACTER;
	i: CARDINAL;
	FOR i IN [0..MIN[s1.Length,s2.Length]) DO
		c1 _ vm.GetCharVM[s1.Address,s1.Offset,i];
		c2 _ vm.GetCharVM[s2.Address,s2.Offset,i];
		IF c1 > c2 THEN RETURN[greater];
		IF c1 < c2 THEN RETURN[less];
		ENDLOOP;
	IF s1.Length > s2.Length THEN RETURN[greater];
	IF s1.Length < s2.Length THEN RETURN[less];
	RETURN[equal];
	END;

StringMatch: PROCEDURE[s,t: StringType Object, j: CARDINAL]
	RETURNS[BOOLEAN] = INLINE
	BEGIN
	i: CARDINAL;
	FOR i IN[0..s.Length) DO
		IF vm.GetCharVM[s.Address,s.Offset,i]
		 # vm.GetCharVM[t.Address,t.Offset,j+i] THEN RETURN[FALSE];
		ENDLOOP;
	RETURN[TRUE];
	END;

StringSearch: PUBLIC PROCEDURE  =
	BEGIN
	compare: BOOLEAN_FALSE;
	j: CARDINAL;
	frame: Frame _ JaMControlDefs.GetCurrentFrame[];
	s: StringType Object _ JaMTypeChkDefs.DescStringType[Pop[frame.opstk]];
	t: StringType Object _ JaMTypeChkDefs.DescStringType[Pop[frame.opstk]];
	FOR j IN [0..t.Length)
		DO
		IF t.Length - j < s.Length THEN EXIT; -- compare = FALSE
		IF StringMatch[s,t,j] THEN
			BEGIN compare_TRUE; EXIT END; -- j is match position in t
		ENDLOOP;
	IF compare THEN
		BEGIN
		sob: StringType Object_[lit,StringType[,,]];
		[sob.Address,sob.Offset]_AddBytes[t.Address,t.Offset,j+s.Length];
		sob.Length _ t.Length-(j+s.Length);
		Push[sob,frame.opstk]; -- part of t following match
		[sob.Address,sob.Offset]_AddBytes[t.Address,t.Offset,j];
		sob.Length _ s.Length;
		Push[sob,frame.opstk]; -- part of t matching s
		sob.Address _ t.Address; sob.Offset _ t.Offset;
		sob.Length _ j;
		Push[sob,frame.opstk]; -- part of t preceding match
		END
	ELSE Push[t,frame.opstk]; -- no match, just push t
	JaMFnsDefs.PushBoolean[compare];
	END;

StringAnchorSearch: PUBLIC PROCEDURE  =
	BEGIN
	compare: BOOLEAN_FALSE;
	frame: Frame _ JaMControlDefs.GetCurrentFrame[];
	s: StringType Object _ JaMTypeChkDefs.DescStringType[Pop[frame.opstk]];
	t: StringType Object _ JaMTypeChkDefs.DescStringType[Pop[frame.opstk]];
	compare _ (t.Length >= s.Length) AND StringMatch[s,t,0];
	IF compare THEN
		BEGIN
		sob: StringType Object_[lit,StringType[,,]];
		[sob.Address,sob.Offset]_AddBytes[t.Address,t.Offset,s.Length];
		sob.Length _ t.Length-s.Length;
		Push[sob,frame.opstk]; -- remainder of t following match
		sob.Address _ t.Address; sob.Offset _ t.Offset;
		sob.Length _ s.Length;
		Push[sob,frame.opstk]; -- part of t matching s
		END
	ELSE Push[t,frame.opstk]; -- no match, just push t
	JaMFnsDefs.PushBoolean[compare];
	END;


SubString: PUBLIC PROCEDURE  =
	BEGIN
	frame:Frame _ JaMControlDefs.GetCurrentFrame[];
	cnt:INTEGER _ JaMFnsDefs.PopInteger[];
	strt:INTEGER _ JaMFnsDefs.PopInteger[];
	s:StringType Object_ JaMTypeChkDefs.DescStringType[Pop[frame.opstk]];
	IF cnt < 0 OR strt < 0 OR strt+cnt > s.Length THEN RangeErr[];
	[s.Address,s.Offset]_AddBytes[s.Address,s.Offset,strt];
	s.Length _ cnt;
	Push[s,frame.opstk];
	END;

PutString: PUBLIC PROCEDURE  =
	BEGIN
	i: CARDINAL;
	frame: Frame _ JaMControlDefs.GetCurrentFrame[];
	s: StringType Object _ JaMTypeChkDefs.DescStringType[Pop[frame.opstk]];
	strt: INTEGER _ JaMFnsDefs.PopInteger[];
	t: StringType Object _ JaMTypeChkDefs.DescStringType[Pop[frame.opstk]];
	IF strt < 0 OR strt +s.Length > t.Length THEN RangeErr[];
	FOR i IN [0..s.Length) DO
		vm.PutCharVM[vm.GetCharVM[s.Address,s.Offset,i],
			t.Address,t.Offset,i+strt];
		ENDLOOP;
	Push[t,frame.opstk];
	END;

AppendInteger: PROCEDURE[s: STRING, i: INTEGER, rdx: CARDINAL] =
	BEGIN
	str.AppendNumber[s,LOOPHOLE[i,CARDINAL],rdx];
	END;

AppendLongInteger: PROCEDURE[s: STRING, ii: LONG INTEGER, rdx: CARDINAL] =
	BEGIN
	str.AppendLongNumber[s,LOOPHOLE[ii,LONG CARDINAL],rdx];
	END;

ConvertToString: PUBLIC PROCEDURE  =
	BEGIN
	frame: Frame _ JaMControlDefs.GetCurrentFrame[];
	ob: Object _ Pop[frame.opstk];
	s: STRING _ [20];
	WITH dob:ob SELECT FROM
		IntegerType => BEGIN
			str.AppendDecimal[s,dob.IntegerVal];
			JaMLiteralDefs.StringLit[s,frame.opstk];
			END;
		LongIntegerType => BEGIN
			str.AppendLongDecimal[s,dob.LongIntegerVal];
			JaMLiteralDefs.StringLit[s,frame.opstk];
			END;
		RealType => BEGIN
			Real.AppendReal[s,dob.RealVal];
			JaMLiteralDefs.StringLit[s,frame.opstk];
			END;
		BooleanType => BEGIN
			IF dob.BooleanVal THEN Push[true,frame.opstk]
			ELSE Push[false,frame.opstk];
			END;
		StringType => Push[dob,frame.opstk];
		ENDCASE => Push[novalue,frame.opstk];
	END;

ConvertToRadixString: PUBLIC PROCEDURE  =
	BEGIN
	frame:Frame _ JaMControlDefs.GetCurrentFrame[];
	rdx: INTEGER_JaMFnsDefs.PopInteger[];
	ob:Object_Pop[frame.opstk];
	s:STRING_[32];
	IF rdx NOT IN[2..36] THEN RangeErr[];
	WITH dob:ob SELECT FROM
		IntegerType => BEGIN
			AppendInteger[s,dob.IntegerVal,rdx];
			JaMLiteralDefs.StringLit[s,frame.opstk];
			END;
		LongIntegerType => BEGIN
			AppendLongInteger[s,dob.LongIntegerVal,rdx];
			JaMLiteralDefs.StringLit[s,frame.opstk];
			END;
		RealType => BEGIN
			str.AppendLongNumber[s,LOOPHOLE[dob.RealVal],ABS[rdx]];
			JaMLiteralDefs.StringLit[s,frame.opstk];
			END;
		ENDCASE => Push[novalue,frame.opstk];
	END;


ConvertIntoString: PUBLIC PROCEDURE  =
	BEGIN
	frame: Frame _ JaMControlDefs.GetCurrentFrame[];
	sob: StringType Object _ JaMTypeChkDefs.DescStringType[Pop[frame.opstk]];
	ob: Object_Pop[frame.opstk];
	s: STRING_[20];
	WITH dob:ob SELECT FROM
		IntegerType => BEGIN
			str.AppendDecimal[s,dob.IntegerVal];
			IF sob.Length >= s.length THEN
				BEGIN
				vm.PutCharsVM[sob.Address,sob.Offset,@s.text,0,s.length];
				sob.Length _ s.length;
				Push[sob,frame.opstk];
				END
			ELSE SizeErr[];
			END;
		LongIntegerType => BEGIN
			str.AppendLongDecimal[s,dob.LongIntegerVal];
			IF sob.Length >= s.length THEN
				BEGIN
				vm.PutCharsVM[sob.Address,sob.Offset,@s.text,0,s.length];
				sob.Length _ s.length;
				Push[sob,frame.opstk];
				END
			ELSE SizeErr[];
			END;
		RealType => BEGIN
			Real.AppendReal[s,dob.RealVal];
			IF sob.Length >= s.length THEN
				BEGIN
				vm.PutCharsVM[sob.Address,sob.Offset,@s.text,0,s.length];
				sob.Length _ s.length;
				Push[sob,frame.opstk];
				END
			ELSE SizeErr[];
			END;
		BooleanType => BEGIN
			IF dob.BooleanVal THEN Push[true,frame.opstk]
			ELSE Push[false,frame.opstk];
			END;
		StringType => Push[dob,frame.opstk];
		ENDCASE => Push[novalue,frame.opstk];
	END;

ConvertIntoRadixString: PUBLIC PROCEDURE  =
	BEGIN
	frame: Frame _ JaMControlDefs.GetCurrentFrame[];
	sob: StringType Object _ JaMTypeChkDefs.DescStringType[Pop[frame.opstk]];
	rdx: INTEGER_JaMFnsDefs.PopInteger[];
	ob: Object_Pop[frame.opstk];
	s: STRING_[32];
	IF rdx NOT IN[2..36] THEN RangeErr[];
	WITH dob:ob SELECT FROM
		IntegerType => BEGIN
			AppendInteger[s,dob.IntegerVal,rdx];
			IF sob.Length >= s.length THEN
				BEGIN
				vm.PutCharsVM[sob.Address,sob.Offset,@s.text,0,s.length];
				sob.Length _ s.length;
				Push[sob,frame.opstk];
				END
			ELSE SizeErr[];
			END;
		LongIntegerType => BEGIN
			AppendLongInteger[s,dob.LongIntegerVal,rdx];
			IF sob.Length >= s.length THEN
				BEGIN
				vm.PutCharsVM[sob.Address,sob.Offset,@s.text,0,s.length];
				sob.Length _ s.length;
				Push[sob,frame.opstk];
				END
			ELSE SizeErr[];
			END;
		RealType => BEGIN
			str.AppendLongNumber[s,LOOPHOLE[dob.RealVal],rdx];
			IF sob.Length >= s.length THEN
				BEGIN
				vm.PutCharsVM[sob.Address,sob.Offset,@s.text,0,s.length];
				sob.Length _ s.length;
				Push[sob,frame.opstk];
				END
			ELSE SizeErr[];
			END;
		ENDCASE => Push[novalue,frame.opstk];
	END;

ConvertOctalString: PUBLIC PROCEDURE  =
	BEGIN
	l: LONG INTEGER;
	s: STRING_[20];
	frame: Frame _ JaMControlDefs.GetCurrentFrame[];
	JaMFnsDefs.PopString[s!IODefs.LineOverflow => RangeErr[]];
	l_str.StringToLongNumber[s,8];
	IF l < -LONG[32768] OR l > 32767 THEN JaMFnsDefs.PushLongInteger[l]
	ELSE JaMFnsDefs.PushInteger[LOOPHOLE[Inline.LowHalf[l],INTEGER]];
	END;


SizeErr: PROCEDURE = BEGIN JaMExecDefs.JaMError[sizechk,TRUE] END;
RangeErr: PROCEDURE = BEGIN JaMExecDefs.JaMError[rangechk,TRUE] END;

true: StringType Object;
false: StringType Object;
novalue: StringType Object;
sizechk: StringType Object;
rangechk: StringType Object;

StartString: PROCEDURE =
	BEGIN OPEN JaMControlDefs;
	NotifyStringObject[@true, ".true"L];
	NotifyStringObject[@false, ".false"L];
	NotifyStringObject[@novalue, "--nostringval--"L];
	NotifyStringObject[@sizechk, ".sizechk"L];
	NotifyStringObject[@rangechk, ".rangechk"L];
	--Strings
	NotifyCommand[".search"L,StringSearch];
	NotifyCommand[".asearch"L,StringAnchorSearch];
	NotifyCommand[".string"L,String];
	NotifyCommand[".substring"L,SubString];
	NotifyCommand[".putstring"L,PutString];
	NotifyCommand[".cvs"L,ConvertToString];
	NotifyCommand[".cvis"L,ConvertIntoString];
	NotifyCommand[".cvrs"L,ConvertToRadixString];
	NotifyCommand[".cvos"L,ConvertOctalString];
	NotifyCommand[".cvirs"L,ConvertIntoRadixString];
	END;

-- Initialization
StartString;

END.

DKW  March 28, 1980  4:43 PM
	added StartString
DKW  March 30, 1980  5:28 PM
	added AddBytes, StringMatch
DKW  April 1, 1980  4:00 PM
	now uses NotifyCommand, NotifyStringObject
DKW  May 31, 1980  1:09 AM
	updated for Mesa6
DKW  July 14, 1980  11:23 PM
	AppendFloat => AppendReal
DKW  October 24, 1980  6:42 PM
	changed handling of negative numbers in .cvrs, .cvris
DKW  December 4, 1980  2:21 PM
	InlineDefs => Inline, StringDefs => str:String
(600)\1475b7B277b16B450b11B258b12B1038b19B761b12B394b11B761b15B702b21B647b17B1202b23B1148b18B348b1B1b7B60b8B62b4B21b5B21b7B21b7B21b8B22b11B