-- JaMStringImpl.mesa
-- Original version John Warnock, January, 1979
-- Last changed by Bill Paxton, February 6, 1981 9:31 AM
-- Last changed by Doug Wyatt, 7-Oct-81 17:17:49
-- Last changed by McGregor, September 10, 1982 11:22 am

DIRECTORY
JaMBasic USING [Object, StringLength, Tag],
JaMInternal USING [Frame],
JaMOps USING [Error, Install, InstallReason, NameToString, Pop,
PopCardinal, PopInteger, PopString, Push, PushBoolean, PushInteger,
rangechk, RegisterExplicit, Text],
JaMVM USING [AllocString, CopyString, GetChar, GetText, PutChar, PutText],
Inline USING [LowByte, LowHalf],
Real USING [WriteReal],
String USING [AppendChar, AppendLongDecimal, AppendLongNumber, StringToLongNumber];

JaMStringImpl: PROGRAM
IMPORTS JaMOps, JaMVM, Inline, Real, String
EXPORTS JaMOps = {
OPEN S:String, VM:JaMVM, JaMOps, JaMInternal, JaMBasic;

-- Constants

lengthLimit: CARDINAL = LAST[StringLength];

-- Globals

true,false,novalue: string Object;

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

Head: PROC[s: string Object, n: CARDINAL] RETURNS[string Object] = INLINE {
IF n<s.length THEN s.length ← n; RETURN[s] };
Tail: PROC[s: string Object, n: CARDINAL] RETURNS[string Object] = INLINE {
IF n>s.length THEN n ← s.length; s.length ← s.length - n; n ← s.offset + n;
s.text ← s.text + n/2; s.offset ← n MOD 2; RETURN[s] };

String: PUBLIC PROC[length: StringLength] RETURNS[string Object] = {
s: string Object ← VM.AllocString[length];
s.tag ← L; RETURN[s];
};

SCopy: PUBLIC PROC[string: string Object, expand: CARDINAL ← 0]
RETURNS[string Object] = {
oldlen: CARDINAL = string.length;
newlen: CARDINAL = oldlen + MIN[expand,lengthLimit-oldlen];
new: string Object ← VM.AllocString[newlen];
VM.CopyString[src: string, dst: new]; RETURN[new];
};

SubString: PUBLIC PROC[s: string Object, beg,len: CARDINAL]
RETURNS[string Object] = {
IF beg>s.length OR len>(s.length-beg) THEN ERROR Error[rangechk];
RETURN[Head[Tail[s,beg],len]];
};

PutString: PUBLIC PROC[from: string Object, beg: CARDINAL, into: string Object] = {
IF beg>into.length OR from.length>(into.length-beg) THEN ERROR Error[rangechk];
VM.CopyString[from,Tail[into,beg]];
};

StringCompare: PUBLIC PROC[a,b: string Object] RETURNS[INTEGER] = {
FOR i: CARDINAL IN[0..MIN[a.length,b.length]) DO
ca: CHARACTER ← VM.GetChar[a,i];
cb: CHARACTER ← VM.GetChar[b,i];
IF ca#cb THEN RETURN[IF ca<cb THEN -1 ELSE 1];
ENDLOOP;
IF a.length=b.length THEN RETURN[0]
ELSE RETURN[IF a.length<b.length THEN -1 ELSE 1];
};

StringMatch: PROC[s,t: string Object, j: CARDINAL] RETURNS[BOOLEAN] = INLINE {
FOR i: CARDINAL IN[0..s.length) DO
IF VM.GetChar[s,i] # VM.GetChar[t,j+i] THEN RETURN[FALSE];
ENDLOOP;
RETURN[TRUE];
};

MakeString: PUBLIC PROC[text: Text, tag: Tag ← L] RETURNS[string Object] = {
string: string Object ← String[text.length];
VM.PutText[string,text]; string.tag ← tag;
RETURN[string];
};

StringText: PUBLIC PROC[string: string Object, text: Text] = {
VM.GetText[string,text];
};

StringForAll: PUBLIC PROC[string: string Object,
proc: PROC[CHARACTER] RETURNS[BOOLEAN]] = {
FOR i: CARDINAL IN[0..string.length) DO
c: CHARACTER ← VM.GetChar[string,i];
IF proc[c] THEN EXIT;
ENDLOOP;
};

-- Intrinsics

JString: PUBLIC PROC[frame: Frame] = {
n: CARDINAL ← PopCardinal[frame.opstk,lengthLimit];
Push[frame.opstk,String[n]];
};

JCopyString: PUBLIC PROC[frame: Frame] = {
s: string Object ← PopString[frame.opstk];
Push[frame.opstk,SCopy[s]];
};

JSubString: PUBLIC PROC[frame: Frame] = {
len: CARDINAL ← PopCardinal[frame.opstk];
beg: CARDINAL ← PopCardinal[frame.opstk];
s: string Object ← PopString[frame.opstk];
t: string Object ← SubString[s,beg,len];
Push[frame.opstk,t];
};

JPutString: PUBLIC PROC[frame: Frame] = {
s: string Object ← PopString[frame.opstk];
beg: CARDINAL ← PopCardinal[frame.opstk];
t: string Object ← PopString[frame.opstk];
PutString[s,beg,t];
Push[frame.opstk,t];
};

JSGet: PUBLIC PROC[frame: Frame] = {
i: CARDINAL ← PopCardinal[frame.opstk];
s: string Object ← PopString[frame.opstk];
item: INTEGER;
IF i NOT IN[0..s.length) THEN ERROR Error[rangechk];
item ← LOOPHOLE[VM.GetChar[s,i]];
PushInteger[frame.opstk,item];
};

JSPut: PUBLIC PROC[frame: Frame] = {
item: INTEGER ← Inline.LowHalf[PopInteger[frame.opstk]];
i: CARDINAL ← PopCardinal[frame.opstk];
s: string Object ← PopString[frame.opstk];
c: CHARACTER;
IF i NOT IN[0..s.length) THEN ERROR Error[rangechk];
c ← LOOPHOLE[Inline.LowByte[item]];
VM.PutChar[s,i,c];
};

StringSearch: PUBLIC PROC[frame: Frame] = {
s: string Object ← PopString[frame.opstk];
t: string Object ← PopString[frame.opstk];
FOR j: CARDINAL IN[0..t.length) WHILE (t.length - j) < s.length DO
IF StringMatch[s,t,j] THEN { -- j is match position in t
r: string Object ← Tail[t,j];
Push[frame.opstk,Tail[r,s.length]]; -- part of t following match
Push[frame.opstk,Head[r,s.length]]; -- part of t matching s
Push[frame.opstk,Head[t,j]]; -- part of t preceding match
PushBoolean[frame.opstk,TRUE];
RETURN };
ENDLOOP;
Push[frame.opstk,t]; -- no match, just push t
PushBoolean[frame.opstk,FALSE];
};

StringAnchorSearch: PUBLIC PROC[frame: Frame] = {
s: string Object ← PopString[frame.opstk];
t: string Object ← PopString[frame.opstk];
IF (t.length >= s.length) AND StringMatch[s,t,0] THEN {
Push[frame.opstk,Tail[t,s.length]]; -- remainder of t following match
Push[frame.opstk,Head[t,s.length]]; -- part of t matching s
PushBoolean[frame.opstk,TRUE] }
ELSE {
Push[frame.opstk,t]; -- no match, just push t
PushBoolean[frame.opstk,FALSE] };
};

AppendInteger: PROC[s: STRING, i: LONG INTEGER, rdx: CARDINAL ← 10] = INLINE {
IF rdx=10 THEN S.AppendLongDecimal[s,i] ELSE S.AppendLongNumber[s,i,rdx] };

AppendReal: PROC[s: STRING, r: REAL] = BEGIN
 MyAppend: SAFE PROC [c: CHAR] = TRUSTED {S.AppendChar[s, c]};
 Real.WriteReal[MyAppend, r];
 END;

ConvertToString: PUBLIC PROC[frame: Frame] = {
ob: Object ← Pop[frame.opstk];
string: string Object ← novalue;
s: STRING ← [50];
WITH ob:ob SELECT FROM
integer => { AppendInteger[s,ob.ivalue]; string ← MakeString[s] };
real => { AppendReal[s,ob.rvalue]; string ← MakeString[s] };
boolean => string ← (IF ob.bvalue THEN true ELSE false);
string => string ← ob;
name => string ← SCopy[NameToString[ob]]; -- make a copy!
ENDCASE;
Push[frame.opstk,string];
};

ConvertToRadixString: PUBLIC PROC[frame: Frame] = {
rdx: CARDINAL ← PopCardinal[frame.opstk];
ob: Object ← Pop[frame.opstk];
string: string Object ← novalue;
s: STRING ← [50];
IF rdx NOT IN[2..36] THEN ERROR Error[rangechk];
WITH ob:ob SELECT FROM
integer => { AppendInteger[s,ob.ivalue,rdx]; string ← MakeString[s] };
real => { AppendInteger[s,LOOPHOLE[ob.rvalue],rdx]; string ← MakeString[s] };
ENDCASE;
Push[frame.opstk,string];
};

TextIntoString: PROC[from: Text, into: string Object] RETURNS[string Object] = {
IF from.length>into.length THEN ERROR Error[rangechk];
into.length ← from.length; VM.PutText[into,from]; RETURN[into] };

StringIntoString: PROC[from,into: string Object] RETURNS[string Object] = {
PutString[from,0,into]; into.length ← from.length; RETURN[into] };

ConvertIntoString: PUBLIC PROC[frame: Frame] = {
string: string Object ← PopString[frame.opstk];
ob: Object ← Pop[frame.opstk];
result: string Object ← novalue;
s: STRING ← [50];
WITH ob:ob SELECT FROM
integer => { AppendInteger[s,ob.ivalue]; result ← TextIntoString[s,string] };
real => { AppendReal[s,ob.rvalue]; result ← TextIntoString[s,string] };
boolean => result ← (IF ob.bvalue THEN true ELSE false);
string => result ← ob;
name => result ← StringIntoString[NameToString[ob],string];
ENDCASE;
Push[frame.opstk,result];
};

ConvertIntoRadixString: PUBLIC PROC[frame: Frame] = {
string: string Object ← PopString[frame.opstk];
rdx: CARDINAL ← PopCardinal[frame.opstk];
ob: Object ← Pop[frame.opstk];
result: string Object ← novalue;
s: STRING ← [50];
IF rdx NOT IN[2..36] THEN ERROR Error[rangechk];
WITH ob:ob SELECT FROM
integer => { AppendInteger[s,ob.ivalue,rdx]; result ← TextIntoString[s,string] };
real => { AppendInteger[s,LOOPHOLE[ob.rvalue],rdx]; result ← TextIntoString[s,string] };
ENDCASE;
Push[frame.opstk,result];
};

ConvertOctalString: PUBLIC PROC[frame: Frame] = {
string: string Object ← PopString[frame.opstk];
s: STRING ← [50];
i: LONG INTEGER;
IF string.length>s.maxlength THEN ERROR Error[rangechk];
VM.GetText[string,s]; i ← S.StringToLongNumber[s,8];
PushInteger[frame.opstk,i];
};

-- Initialization

InstallString: PROC[why: InstallReason, frame: Frame] = { SELECT why FROM
register => {
true ← MakeString[".true"L];
false ← MakeString[".false"L];
novalue ← MakeString["--nostringval--"L];
RegisterExplicit[frame,".string"L,JString];
RegisterExplicit[frame,".copystring"L,JCopyString];
RegisterExplicit[frame,".substring"L,JSubString];
RegisterExplicit[frame,".putstring"L,JPutString];
RegisterExplicit[frame,".sget"L,JSGet];
RegisterExplicit[frame,".sput"L,JSPut];
RegisterExplicit[frame,".search"L,StringSearch];
RegisterExplicit[frame,".asearch"L,StringAnchorSearch];
RegisterExplicit[frame,".cvs"L,ConvertToString];
RegisterExplicit[frame,".cvis"L,ConvertIntoString];
RegisterExplicit[frame,".cvrs"L,ConvertToRadixString];
RegisterExplicit[frame,".cvos"L,ConvertOctalString];
RegisterExplicit[frame,".cvirs"L,ConvertIntoRadixString];
};
ENDCASE;
};

Install[InstallString];

}.