-- 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