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

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 [AppendReal],
  String USING [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] = INLINE { Real.AppendReal[s,r] };

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

}.