<> <> <> <> <> <> DIRECTORY Basics USING [LowByte, LowHalf], Convert, 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]; -- String USING [AppendChar, AppendLongDecimal, AppendLongNumber, StringToLongNumber]; JaMStringImpl: PROGRAM IMPORTS Basics, Convert, JaMOps, JaMVM EXPORTS JaMOps = { OPEN VM:JaMVM, JaMOps, JaMInternal, JaMBasic; <> lengthLimit: CARDINAL = LAST[StringLength]; <> true,false,novalue: string Object; <> Head: PROC[s: string Object, n: CARDINAL] RETURNS[string 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: 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> 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 _ Basics.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[Basics.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: 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] = BEGIN [] _ Convert.AppendReal[LOOPHOLE[s], 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: LONG STRING _ [20]; c: LONG CARDINAL; IF string.length>s.maxlength THEN ERROR Error[rangechk]; VM.GetText[string,s]; c _ Convert.CardFromRope[LOOPHOLE[s], 8 ! Convert.Error => GO TO err]; EXITS err => ERROR Error[rangechk] }; <> 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]; }.