DIRECTORY
Basics USING [LowByte, LowHalf],
Convert USING [AppendCard, AppendInt, AppendReal, CardFromRope, Error],
TJaMBasic USING [Object, StringLength, Tag],
TJaMInternal USING [Frame],
TJaMOps USING [Error, Install, InstallReason, NameToString, Pop, PopCardinal, PopInteger, PopString, Push, PushBoolean, PushInteger, rangechk, RegisterExplicit, Text],
TJaMVM USING [AllocString, CopyString, GetChar, GetText, PutChar, PutText];
TJaMStringImpl:
PROGRAM
IMPORTS Basics, Convert, TJaMOps, TJaMVM
EXPORTS TJaMOps = {
Constants
lengthLimit: CARDINAL = LAST[TJaMBasic.StringLength];
Globals
true,false,novalue: string TJaMBasic.Object;
The following routines implement a set of string manipulations.
Head:
PROC[s: string TJaMBasic.Object, n:
CARDINAL]
RETURNS[string TJaMBasic.Object] =
INLINE {
IF n<s.length THEN s.length ← n; RETURN[s]
};
Tail:
PROC[s: string TJaMBasic.Object, n:
CARDINAL]
RETURNS[string TJaMBasic.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: TJaMBasic.StringLength]
RETURNS[string TJaMBasic.Object] = {
s: string TJaMBasic.Object ← TJaMVM.AllocString[length];
s.tag ← L; RETURN[s];
};
SCopy:
PUBLIC
PROC[string: string TJaMBasic.Object, expand:
CARDINAL ← 0]
RETURNS[string TJaMBasic.Object] = {
oldlen: CARDINAL = string.length;
newlen: CARDINAL = oldlen + MIN[expand,lengthLimit-oldlen];
new: string TJaMBasic.Object ← TJaMVM.AllocString[newlen];
TJaMVM.CopyString[src: string, dst: new]; RETURN[new];
};
SubString: PUBLIC PROC[s: string TJaMBasic.Object, beg,len: CARDINAL]
RETURNS[string TJaMBasic.Object] = {
IF beg>s.length OR len>(s.length-beg) THEN ERROR TJaMOps.Error[TJaMOps.rangechk];
RETURN[Head[Tail[s,beg],len]];
};
PutString:
PUBLIC
PROC[from: string TJaMBasic.Object, beg:
CARDINAL, into: string TJaMBasic.Object] = {
IF beg>into.length OR from.length>(into.length-beg) THEN ERROR TJaMOps.Error[TJaMOps.rangechk];
TJaMVM.CopyString[from,Tail[into,beg]];
};
StringCompare:
PUBLIC
PROC[a,b: string TJaMBasic.Object]
RETURNS[
INTEGER] = {
FOR i:
CARDINAL
IN[0..
MIN[a.length,b.length])
DO
ca: CHARACTER ← TJaMVM.GetChar[a,i];
cb: CHARACTER ← TJaMVM.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 TJaMBasic.Object, j:
CARDINAL]
RETURNS[
BOOLEAN] =
INLINE {
FOR i:
CARDINAL
IN[0..s.length)
DO
IF TJaMVM.GetChar[s,i] # TJaMVM.GetChar[t,j+i] THEN RETURN[FALSE];
ENDLOOP;
RETURN[TRUE];
};
MakeString:
PUBLIC
PROC[text: TJaMOps.Text, tag: TJaMBasic.Tag ←
L]
RETURNS[string TJaMBasic.Object] = {
string: string TJaMBasic.Object ← String[text.length];
TJaMVM.PutText[string,text]; string.tag ← tag;
RETURN[string];
};
StringText:
PUBLIC
PROC[string: string TJaMBasic.Object, text: TJaMOps.Text] = {
TJaMVM.GetText[string,text];
};
StringForAll:
PUBLIC
PROC[string: string TJaMBasic.Object,
proc: PROC[CHARACTER] RETURNS[BOOLEAN]] = {
FOR i:
CARDINAL
IN[0..string.length)
DO
c: CHARACTER ← TJaMVM.GetChar[string,i];
IF proc[c] THEN EXIT;
ENDLOOP;
};
Intrinsics
JString:
PUBLIC
PROC[frame: TJaMInternal.Frame] = {
n: CARDINAL ← TJaMOps.PopCardinal[frame.opstk,lengthLimit];
TJaMOps.Push[frame.opstk,String[n]];
};
JCopyString:
PUBLIC
PROC[frame: TJaMInternal.Frame] = {
s: string TJaMBasic.Object ← TJaMOps.PopString[frame.opstk];
TJaMOps.Push[frame.opstk,SCopy[s]];
};
JSubString:
PUBLIC
PROC[frame: TJaMInternal.Frame] = {
len: CARDINAL ← TJaMOps.PopCardinal[frame.opstk];
beg: CARDINAL ← TJaMOps.PopCardinal[frame.opstk];
s: string TJaMBasic.Object ← TJaMOps.PopString[frame.opstk];
t: string TJaMBasic.Object ← SubString[s,beg,len];
TJaMOps.Push[frame.opstk,t];
};
JPutString:
PUBLIC
PROC[frame: TJaMInternal.Frame] = {
s: string TJaMBasic.Object ← TJaMOps.PopString[frame.opstk];
beg: CARDINAL ← TJaMOps.PopCardinal[frame.opstk];
t: string TJaMBasic.Object ← TJaMOps.PopString[frame.opstk];
PutString[s,beg,t];
TJaMOps.Push[frame.opstk,t];
};
JSGet:
PUBLIC
PROC[frame: TJaMInternal.Frame] = {
i: CARDINAL ← TJaMOps.PopCardinal[frame.opstk];
s: string TJaMBasic.Object ← TJaMOps.PopString[frame.opstk];
item: INTEGER;
IF i NOT IN[0..s.length) THEN ERROR TJaMOps.Error[TJaMOps.rangechk];
item ← LOOPHOLE[TJaMVM.GetChar[s,i]];
TJaMOps.PushInteger[frame.opstk,item];
};
JSPut:
PUBLIC
PROC[frame: TJaMInternal.Frame] = {
item: INTEGER ← Basics.LowHalf[TJaMOps.PopInteger[frame.opstk]];
i: CARDINAL ← TJaMOps.PopCardinal[frame.opstk];
s: string TJaMBasic.Object ← TJaMOps.PopString[frame.opstk];
c: CHARACTER;
IF i NOT IN[0..s.length) THEN ERROR TJaMOps.Error[TJaMOps.rangechk];
c ← LOOPHOLE[Basics.LowByte[item]];
TJaMVM.PutChar[s,i,c];
};
StringSearch:
PUBLIC
PROC[frame: TJaMInternal.Frame] = {
s: string TJaMBasic.Object ← TJaMOps.PopString[frame.opstk];
t: string TJaMBasic.Object ← TJaMOps.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 TJaMBasic.Object ← Tail[t,j];
TJaMOps.Push[frame.opstk,Tail[r,s.length]]; -- part of t following match
TJaMOps.Push[frame.opstk,Head[r,s.length]]; -- part of t matching s
TJaMOps.Push[frame.opstk,Head[t,j]]; -- part of t preceding match
TJaMOps.PushBoolean[frame.opstk,TRUE];
RETURN
};
ENDLOOP;
TJaMOps.Push[frame.opstk,t]; -- no match, just push t
TJaMOps.PushBoolean[frame.opstk,FALSE];
};
StringAnchorSearch:
PUBLIC
PROC[frame: TJaMInternal.Frame] = {
s: string TJaMBasic.Object ← TJaMOps.PopString[frame.opstk];
t: string TJaMBasic.Object ← TJaMOps.PopString[frame.opstk];
IF (t.length >= s.length)
AND StringMatch[s,t,0]
THEN {
TJaMOps.Push[frame.opstk,Tail[t,s.length]]; -- remainder of t following match
TJaMOps.Push[frame.opstk,Head[t,s.length]]; -- part of t matching s
TJaMOps.PushBoolean[frame.opstk,TRUE]
}
ELSE {
TJaMOps.Push[frame.opstk,t]; -- no match, just push t
TJaMOps.PushBoolean[frame.opstk,FALSE]
};
};
AppendInteger:
PROC[s:
LONG
STRING, i:
INT, rdx:
CARDINAL ← 10] = {
IF rdx=10
THEN [] ← Convert.AppendInt[
LOOPHOLE[s], i, 10]
ELSE [] ← Convert.AppendCard[LOOPHOLE[s], LOOPHOLE[i], 8];
};
AppendChar:
PROC[s:
LONG
STRING, c:
CHAR] = {
s[s.length] ← c;
s.length ← s.length + 1;
};
AppendReal:
PROC[s:
LONG
STRING, r:
REAL] = {
[] ← Convert.AppendReal[LOOPHOLE[s], r];
};
ConvertToString:
PUBLIC
PROC[frame: TJaMInternal.Frame] = {
ob: TJaMBasic.Object ← TJaMOps.Pop[frame.opstk];
string: string TJaMBasic.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[TJaMOps.NameToString[ob]]; -- make a copy!
ENDCASE;
TJaMOps.Push[frame.opstk,string];
};
ConvertToRadixString:
PUBLIC
PROC[frame: TJaMInternal.Frame] = {
rdx: CARDINAL ← TJaMOps.PopCardinal[frame.opstk];
ob: TJaMBasic.Object ← TJaMOps.Pop[frame.opstk];
string: string TJaMBasic.Object ← novalue;
s: STRING ← [50];
IF rdx NOT IN[2..36] THEN ERROR TJaMOps.Error[TJaMOps.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;
TJaMOps.Push[frame.opstk,string];
};
TextIntoString:
PROC[from: TJaMOps.Text, into: string TJaMBasic.Object]
RETURNS[string TJaMBasic.Object] = {
IF from.length>into.length THEN ERROR TJaMOps.Error[TJaMOps.rangechk];
into.length ← from.length; TJaMVM.PutText[into,from]; RETURN[into]
};
StringIntoString:
PROC[from,into: string TJaMBasic.Object]
RETURNS[string TJaMBasic.Object] = {
PutString[from,0,into]; into.length ← from.length; RETURN[into]
};
ConvertIntoString:
PUBLIC
PROC[frame: TJaMInternal.Frame] = {
string: string TJaMBasic.Object ← TJaMOps.PopString[frame.opstk];
ob: TJaMBasic.Object ← TJaMOps.Pop[frame.opstk];
result: string TJaMBasic.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[TJaMOps.NameToString[ob],string];
ENDCASE;
TJaMOps.Push[frame.opstk,result];
};
ConvertIntoRadixString:
PUBLIC
PROC[frame: TJaMInternal.Frame] = {
string: string TJaMBasic.Object ← TJaMOps.PopString[frame.opstk];
rdx: CARDINAL ← TJaMOps.PopCardinal[frame.opstk];
ob: TJaMBasic.Object ← TJaMOps.Pop[frame.opstk];
result: string TJaMBasic.Object ← novalue;
s: STRING ← [50];
IF rdx NOT IN[2..36] THEN ERROR TJaMOps.Error[TJaMOps.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;
TJaMOps.Push[frame.opstk,result];
};
ConvertOctalString:
PUBLIC
PROC[frame: TJaMInternal.Frame] = {
string: string TJaMBasic.Object ← TJaMOps.PopString[frame.opstk];
s: LONG STRING ← [20];
c: LONG CARDINAL;
IF string.length>s.maxlength THEN ERROR TJaMOps.Error[TJaMOps.rangechk];
TJaMVM.GetText[string,s];
c ← Convert.CardFromRope[LOOPHOLE[s], 8 ! Convert.Error => GO TO err];
EXITS
err => ERROR TJaMOps.Error[TJaMOps.rangechk]
};
Initialization
InstallString:
PROC[why: TJaMOps.InstallReason, frame: TJaMInternal.Frame] = {
SELECT why
FROM
register => {
true ← MakeString[".true"L];
false ← MakeString[".false"L];
novalue ← MakeString["--nostringval--"L];
TJaMOps.RegisterExplicit[frame,".string"L,JString];
TJaMOps.RegisterExplicit[frame,".copystring"L,JCopyString];
TJaMOps.RegisterExplicit[frame,".substring"L,JSubString];
TJaMOps.RegisterExplicit[frame,".putstring"L,JPutString];
TJaMOps.RegisterExplicit[frame,".sget"L,JSGet];
TJaMOps.RegisterExplicit[frame,".sput"L,JSPut];
TJaMOps.RegisterExplicit[frame,".search"L,StringSearch];
TJaMOps.RegisterExplicit[frame,".asearch"L,StringAnchorSearch];
TJaMOps.RegisterExplicit[frame,".cvs"L,ConvertToString];
TJaMOps.RegisterExplicit[frame,".cvis"L,ConvertIntoString];
TJaMOps.RegisterExplicit[frame,".cvrs"L,ConvertToRadixString];
TJaMOps.RegisterExplicit[frame,".cvos"L,ConvertOctalString];
TJaMOps.RegisterExplicit[frame,".cvirs"L,ConvertIntoRadixString];
};
ENDCASE;
};
TJaMOps.Install[InstallString];
}.