DIRECTORY Basics USING [LongMult], JaMBasic USING [Object], JaMInternal USING [Frame, Stack], JaMOps USING [CountStack, Equal, Error, Install, InstallReason, MarkLoop, nullOb, Pop, PopArray, PopCardinal, PopDict, Push, PushBoolean, PushInteger, rangechk, RegisterExplicit, RegisterInternal, Top, TryToGet, Underflow, UnmarkLoop], JaMVM USING [AllocArray, CopyArray, GetElem, PutElem]; JaMArrayImpl: PROGRAM IMPORTS JaMOps, JaMVM, Basics EXPORTS JaMOps = { OPEN VM: JaMVM, JaMOps, JaMInternal, JaMBasic; lengthLimit: CARDINAL = LAST[CARDINAL]; -- maximum length for an array arraycmd: command Object; Head: PROC[a: array Object, n: CARDINAL] RETURNS[array Object] = INLINE { IF na.length THEN n _ a.length; a.length _ a.length - n; a.base _ a.base + Basics.LongMult[n,SIZE[Object]]; RETURN[a] }; Array: PUBLIC PROC[length: CARDINAL] RETURNS[array Object] = { array: array Object _ VM.AllocArray[length]; RETURN[array]; }; ACopy: PUBLIC PROC[array: array Object, expand: CARDINAL _ 0] RETURNS[array Object] = { oldlen: CARDINAL = array.length; newlen: CARDINAL = oldlen + MIN[expand,lengthLimit-oldlen]; new: array Object _ VM.AllocArray[newlen]; VM.CopyArray[src: array, dst: new]; RETURN[new]; }; SubArray: PUBLIC PROC[array: array Object, beg,len: CARDINAL] RETURNS[array Object] = { IF beg>array.length OR len>(array.length-beg) THEN ERROR Error[rangechk]; RETURN[Head[Tail[array,beg],len]]; }; PutArray: PUBLIC PROC[from: array Object, beg: CARDINAL, into: array Object] = { IF beg>into.length OR from.length>(into.length-beg) THEN ERROR Error[rangechk]; VM.CopyArray[from,Tail[into,beg]]; }; APut: PUBLIC PROC[array: array Object, i: CARDINAL, ob: Object] = { IF i0 THEN RETURN[TRUE,VM.GetElem[array,0],Tail[array,1]] ELSE RETURN[FALSE,nullOb,array]; }; -- return first element and remainder of array AStore: PUBLIC PROC[stack: Stack, array: array Object] = { IF CountStack[stack, array.length] ABind[ob,dict]; name => IF ob.tag=X THEN { value: Object; known: BOOLEAN; [known,value] _ TryToGet[dict,ob]; IF known THEN VM.PutElem[array,i,value] }; ENDCASE; ENDLOOP; }; -- bind names in array to values in dict JArray: PUBLIC PROC[frame: Frame] = { n: CARDINAL _ PopCardinal[frame.opstk,lengthLimit]; array: array Object _ Array[n]; Push[frame.opstk,array]; }; JACopy: PUBLIC PROC[frame: Frame] = { array: array Object _ PopArray[frame.opstk]; acopy: array Object _ ACopy[array]; Push[frame.opstk,acopy]; }; JAPut: PUBLIC PROC[frame: Frame] = { ob: Object _ Pop[frame.opstk]; i: CARDINAL _ PopCardinal[frame.opstk]; array: array Object _ PopArray[frame.opstk]; APut[array,i,ob]; }; JAGet: PUBLIC PROC[frame: Frame] = { i: CARDINAL _ PopCardinal[frame.opstk]; array: array Object _ PopArray[frame.opstk]; ob: Object _ AGet[array,i]; Push[frame.opstk,ob]; }; JSubArray: PUBLIC PROC[frame: Frame] = { len: CARDINAL _ PopCardinal[frame.opstk]; beg: CARDINAL _ PopCardinal[frame.opstk]; array: array Object _ PopArray[frame.opstk]; t: array Object _ SubArray[array,beg,len]; Push[frame.opstk,t]; }; JPutArray: PUBLIC PROC[frame: Frame] = { from: array Object _ PopArray[frame.opstk]; beg: CARDINAL _ PopCardinal[frame.opstk]; into: array Object _ PopArray[frame.opstk]; PutArray[from,beg,into]; Push[frame.opstk,into]; }; JAFind: PUBLIC PROC[frame: Frame] = { ob: Object _ Pop[frame.opstk]; array: array Object _ PopArray[frame.opstk]; known: BOOLEAN; i: CARDINAL; [known,i] _ AFind[array,ob]; IF known THEN PushInteger[frame.opstk,i]; PushBoolean[frame.opstk,known]; }; JAAtom: PUBLIC PROC[frame: Frame] = { array: array Object _ PopArray[frame.opstk]; found: BOOLEAN; atom,rest: Object; [found,atom,rest] _ AAtom[array]; IF found THEN { Push[frame.opstk,rest]; Push[frame.opstk,atom] }; PushBoolean[frame.opstk,found]; }; JAStore: PUBLIC PROC[frame: Frame] = { array: array Object _ PopArray[frame.opstk]; AStore[frame.opstk,array]; Push[frame.opstk,array]; }; JALoad: PUBLIC PROC[frame: Frame] = { array: array Object _ PopArray[frame.opstk]; ALoad[frame.opstk,array]; Push[frame.opstk,array]; }; JABind: PUBLIC PROC[frame: Frame] = { dict: dict Object _ PopDict[frame.opstk]; array: array Object _ PopArray[frame.opstk]; ABind[array,dict]; }; CArrayForall: PROC[frame: Frame] = { array: array Object _ PopArray[frame.execstk]; ob: Object _ Top[frame.execstk]; IF array.length>0 THEN { elem: Object _ VM.GetElem[array,0]; rest: array Object _ Tail[array,1]; Push[frame.execstk,rest]; -- rest of array Push[frame.execstk,arraycmd]; -- this procedure Push[frame.opstk,elem]; -- current array element Push[frame.execstk,ob]; -- object to be executed } ELSE { [] _ Pop[frame.execstk]; -- remove object UnmarkLoop[frame]; -- remove mark }; }; JArrayForAll: PUBLIC PROC[frame: Frame] = { ob: Object _ Pop[frame.opstk]; array: array Object _ PopArray[frame.opstk]; MarkLoop[frame]; -- mark scope of loop Push[frame.execstk,ob]; -- object to be executed for each element Push[frame.execstk,array]; -- array to be enumerated Push[frame.execstk,arraycmd]; -- internal command that does the work }; InstallArray: PROC[why: InstallReason, frame: Frame] = { SELECT why FROM register => { arraycmd _ RegisterInternal["@arrayforall"L, CArrayForall]; RegisterExplicit[frame, ".array"L, JArray]; RegisterExplicit[frame, ".aget"L, JAGet]; RegisterExplicit[frame, ".aput"L, JAPut]; RegisterExplicit[frame, ".subarray"L, JSubArray]; RegisterExplicit[frame, ".putarray"L, JPutArray]; RegisterExplicit[frame, ".arrayforall"L, JArrayForAll]; RegisterExplicit[frame, ".astore"L, JAStore]; RegisterExplicit[frame, ".aload"L, JALoad]; RegisterExplicit[frame, ".acopy"L, JACopy]; RegisterExplicit[frame, ".abind"L, JABind]; RegisterExplicit[frame, ".afind"L, JAFind]; }; ENDCASE; }; Install[InstallArray]; }. Paxton January 7, 1981 5:03 PM added ArraySpread, ArryCopy, Arry, ArryGet, ArryPut Paxton January 23, 1981 2:47 PM added ArrayBind, ArryBind, ArrayFind, ArryFind Wyatt 16-Apr-81 12:46:09 Pilot conversion Wyatt 28-Aug-81 14:45:50 rewrite Wyatt 22-Sep-81 14:46:44 add .putarray ªJaMArrayImpl.mesa Doug Wyatt, 7-Oct-81 16:57:40 Russ Atkinson, July 22, 1983 6:04 pm Constants GLOBALS Primitives Array Operations Array Intrinsics Initialization Ê2˜šœ™Jšœ™Jšœ$™$—J˜šÏk ˜ Jšœœ ˜Jšœ œ ˜Jšœ œ˜!šœ˜ JšœÞ˜Þ—Jšœœ+˜6J˜—šœ˜Jšœ˜Jšœ ˜Jšœœ'˜.—J˜Jšœ ™ ˜Jšœ œœœÏc˜FJ˜—Jšœ™˜J˜J˜—Jšœ ™ J˜š Ïnœœœœœ˜IJšœ œœ˜-J˜—š Ÿœœœœœ˜IJšœ œ'˜9Jšœ$œ œ˜?J˜—Jšœ™J˜š Ÿœœœ œœ˜>Jšœœ˜,Jšœ˜J˜J˜—šŸœœœœ˜=Jšœ˜Jšœœ˜ Jšœœ œ˜;Jšœœ˜*Jšœ"œ˜0J˜J˜—šŸœœœœ˜=Jšœ˜Jšœœœœ˜IJšœ˜"J˜J˜—šŸœœœœ˜PJšœœœœ˜OJšœ ˜"J˜J˜—šŸœœœœ˜CJšœœœ˜-Jšœœ˜J˜J˜—š Ÿœœœœœ ˜GJšœœœœ˜2Jšœœ˜J˜J˜—šŸœœœ!˜3Jšœœœ˜(šœœœ˜&Jšœœ˜#Jšœœœœ˜&Jšœ˜—Jšœœ˜Jšœž˜J˜—šŸœœœ˜'Jšœœ&˜šœœœ˜&Jšœ œ˜!šœœ˜J˜šœœœœ˜Jšœœ˜J˜"Jšœœœ˜*—Jšœ˜—Jšœ˜—Jšœž(˜+J˜—Jšœ™J˜šŸœœœ˜%Jšœœ(˜3J˜J˜J˜J˜—šŸœœœ˜%J˜,J˜#J˜J˜J˜—šŸœœœ˜$J˜Jšœœ˜'J˜,J˜J˜J˜—šŸœœœ˜$Jšœœ˜'J˜,J˜J˜J˜J˜—šŸ œœœ˜(Jšœœ˜)Jšœœ˜)J˜,J˜*J˜J˜J˜—šŸ œœœ˜(J˜+Jšœœ˜)J˜+J˜J˜J˜J˜—šŸœœœ˜%J˜J˜,Jšœœœ˜J˜Jšœœ˜)J˜J˜J˜—šŸœœœ˜%J˜,Jšœœ˜"J˜!Jšœœ4˜AJ˜J˜J˜—šŸœœœ˜&J˜,J˜J˜J˜J˜—šŸœœœ˜%J˜,J˜J˜J˜J˜—šŸœœœ˜%J˜)J˜,J˜J˜J˜—šŸ œœ˜$J˜.J˜ šœœ˜Jšœœ˜#J˜#Jšœž˜*Jšœž˜/Jšœž˜0Jšœž˜0J˜—šœ˜Jšœž˜)Jšœž˜!J˜—J˜J˜—šŸ œœœ˜+J˜J˜,Jšœž˜&Jšœž)˜AJšœž˜4Jšœž&˜DJ˜J˜J˜—Jšœ™J˜šŸ œœ'œ˜H˜ J˜;J˜+J˜)J˜)J˜1J˜1J˜7J˜-J˜+J˜+J˜+J˜+J˜—Jšœ˜J˜J˜—J˜J˜J˜J˜šœ˜ J˜3J˜—šœ˜!J˜.J˜—˜J˜J˜—˜J˜J˜—˜J˜ J˜J˜——…—„%`