<> <> <> <> <> <> <> <> 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 = { <> lengthLimit: CARDINAL = LAST[TJaMBasic.StringLength]; <> true,false,novalue: string TJaMBasic.Object; <> Head: PROC[s: string TJaMBasic.Object, n: CARDINAL] RETURNS[string TJaMBasic.Object] = INLINE { IF ns.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> 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] }; <> 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]; }.