-- JaMString.mesa
-- Written by: John Warnock, January, 1979
-- Last changed by Doug Wyatt, February 10, 1981  6:56 PM

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

JaMString: PROGRAM
IMPORTS JaMFnsDefs, JaMExecDefs, JaMTypeChkDefs, JaMControlDefs,
	JaMLiteralDefs, JaMStackDefs, vm:JaMVMDefs,
	Real, Inline, Str:String
	-- Note: String renamed Str to avoid name conflict with String proc below
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 !Str.StringBoundsFault => 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 = { OPEN JaMExecDefs; ERROR JaMError[sizechk,TRUE] };
RangeErr: PROCEDURE = { OPEN JaMExecDefs; ERROR JaMError[rangechk,TRUE] };

true: StringType Object;
false: StringType Object;
novalue: StringType Object;

-- Initialization

STOP;

{ OPEN JaMLiteralDefs;
true _ MakeStringObject[".true"L];
false _ MakeStringObject[".false"L];
novalue _ MakeStringObject["--nostringval--"L];
};
{ OPEN JaMControlDefs;
RegisterCommand[".search"L,StringSearch];
RegisterCommand[".asearch"L,StringAnchorSearch];
RegisterCommand[".string"L,String];
RegisterCommand[".substring"L,SubString];
RegisterCommand[".putstring"L,PutString];
RegisterCommand[".cvs"L,ConvertToString];
RegisterCommand[".cvis"L,ConvertIntoString];
RegisterCommand[".cvrs"L,ConvertToRadixString];
RegisterCommand[".cvos"L,ConvertOctalString];
RegisterCommand[".cvirs"L,ConvertIntoRadixString];
};

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 RegisterCommand, RegisterStringObject
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
DKW  February 10, 1981  6:55 PM
	imports errors from JaMExecDefs; initializes after STOP
(670)