<> <> <> <> <> <> <> DIRECTORY IO USING [ROS, RopeFromROS, PutChar, PutFR, STREAM], LupineDeclare USING [WriteTypeName], LupineManagerPrivate USING [ ErrorCode, ErrorType, ExplanationProc, GiveExplanation, Indent, IsNull, Nest, Options, ReportError, String, StringNIL, WF1, WFS, WFS1, WFSL, WFL, WFL1, WFLL ], LupineMarshal USING [ AllocDetails, AllocInfo, AllocZone, EnumerateParams, FieldInfo, ParamIndex, ParamInfo, ParamLocation, ParamProcedure, PktSite, VariableNames, Words ], LupineMarshalPrivate USING [ AllocationOperation, Direction, MarshalInfo, MaxDataLength, ParentInfo, SubStrings ], LupineSymbolTable USING [ PutTypeName, Size, SymbolHandle, SymbolHandleNIL, SymbolName, TypeHandle, TypeHandleNIL, TypeInfo, Types ], Rope USING [Cat, Fetch, Length, ROPE]; LupineMarshalUtilityImpl: PROGRAM IMPORTS IO, Declare: LupineDeclare, LupineManagerPrivate, Marshal: LupineMarshal, ST: LupineSymbolTable, Rope EXPORTS LupineMarshal, LupineMarshalPrivate = BEGIN OPEN LupineManagerPrivate, LupineMarshal, Private: LupineMarshalPrivate; <> ParentInfo: TYPE = Private.ParentInfo; MarshalInfo: TYPE = Private.MarshalInfo; SubStrings: TYPE = Private.SubStrings;  <> ZoneString: TYPE = String _ NIL; ZoneStrings: ARRAY {ptrType, vector, counter, maxCount, zone} OF PACKED ARRAY AllocZone OF ZoneString = [ <> ptrType: ["REF", "LONG POINTER", "POINTER"], vector: [heap: "heapAllocVector", mds: "mdsAllocVector"], counter: [heap: "heapAllocs", mds: "mdsAllocs"], maxCount:[heap: "MaxHeapAllocs", mds: "MaxMdsAllocs"], zone: ["paramZones.gc", "paramZones.heap", "paramZones.mds"] ]; BeginAllocation: PUBLIC PROCEDURE [ paramInfo: ParamInfo, nest: Nest, options: Options ] RETURNS [newNest: Nest] = BEGIN OPEN p: paramInfo; newNest _ nest; IF p.allocInfo[heap].number > 0 OR p.allocInfo[mds].number > 0 THEN BEGIN DeclareArray[heap, p.allocInfo[heap], paramInfo.options, nest]; DeclareArray[mds, p.allocInfo[mds], paramInfo.options, nest]; WFL1[nest, "BEGIN ENABLE UNWIND => BEGIN -- Free storage."]; newNest _ nest + 1; Deallocate[heap, p.allocInfo[heap], newNest+1, options]; Deallocate[mds, p.allocInfo[mds], newNest+1, options]; WFL1[newNest+1, "END; -- Free storage."]; END; END; EndAllocation: PUBLIC PROCEDURE [ paramInfo: ParamInfo, justCloseBlocks: BOOLEAN_FALSE, nest: Nest, options: Options ] RETURNS [newNest: Nest] = BEGIN OPEN p: paramInfo; newNest _ nest; IF p.allocInfo[heap].number > 0 OR p.allocInfo[mds].number > 0 THEN BEGIN WFL1[nest, "END; -- ENABLE UNWIND => Free storage."]; newNest _ nest - 1; SELECT TRUE FROM justCloseBlocks => NULL; -- ALWAYS do nothing. ~paramInfo.options.freeServerArguments => NULL; <> ENDCASE => BEGIN Deallocate[heap, p.allocInfo[heap], newNest, options]; Deallocate[mds, p.allocInfo[mds], newNest, options]; END; END; END; WriteNEW: PUBLIC PROCEDURE [ allocOp: Private.AllocationOperation _ new, ptrInfo: ST.TypeInfo, marshalInfo: --VAR-- MarshalInfo, options: Options, dontUseHeap: BOOL _ FALSE] RETURNS [allocSizeName: Rope.ROPE _ NIL] = BEGIN <> <> <> <> <> zone: AllocZone; specialAlloc: BOOL _ FALSE; AllocOpCode: PACKED ARRAY Private.AllocationOperation OF String = [ new: "NEW", cons: "CONS", list: "LIST" ]; WITH ptrInfo: ptrInfo SELECT FROM Ref, Rope, Atom, List => zone _ gc; Pointer, String, Descriptor => BEGIN maxAllocInfo: AllocInfo = marshalInfo.paramInfo.allocInfo; zone _ IF ptrInfo.long THEN heap ELSE mds; IF zone = mds THEN { IF marshalInfo.paramInfo.options.targetLanguage = Cedar THEN { Error[code: MdsAllocation, type: ptrInfo.self, symbol: ST.SymbolHandleNIL, string: StringNIL, causeError: TRUE]; } ELSE IF marshalInfo.paramInfo.options.warnMDSAllocs THEN Warning[code: MdsAllocation, type: ptrInfo.self]; }; IF marshalInfo.paramInfo.transferSite=callee THEN BEGIN WFS[ZoneStrings[vector][zone], "["]; IF maxAllocInfo[zone].isDynamic THEN { WFSL[ "(IF (", ZoneStrings[counter][zone], " _ ", ZoneStrings[counter][zone], "+1) <= ", ZoneStrings[maxCount][zone], " THEN ", ZoneStrings[counter][zone], " ELSE Lupine.UnmarshalingExprError[])" ]; allocSizeName _ Rope.Cat[ ZoneStrings[vector][zone], "Sizes[", ZoneStrings[counter][zone], "]"]; } ELSE BEGIN allocIndexName: Rope.ROPE; allocVectorIndex: LONG INTEGER _ IF marshalInfo.numAllocs[zone] < maxAllocInfo[zone].number THEN (marshalInfo.numAllocs[zone] _ marshalInfo.numAllocs[zone] + 1) ELSE ERROR; allocIndexName _ IO.PutFR["%g", [integer[allocVectorIndex]]]; allocSizeName _ Rope.Cat[ ZoneStrings[vector][zone], "Sizes[", allocIndexName, "]"]; WF1["%g", [integer[allocVectorIndex]]]; END; WFS1["] _ "]; IF dontUseHeap AND zone = heap THEN { specialAlloc _ TRUE; WFS["RpcPrivate.Alloc" ]; }; END; -- IF marshalInfo.paramInfo.transferSite=callee. END; -- Pointer, String, Descriptor. ENDCASE => ERROR; IF ~specialAlloc THEN { IF options.targetLanguage = Cedar AND options.importMultiple AND marshalInfo.paramInfo.transferSite = caller THEN WFS1["interface."]; WFS[ZoneStrings[zone][zone], ".", AllocOpCode[allocOp]]; }; END; DeclareArray: PROCEDURE [ zone: AllocZone, allocDetails: AllocDetails, options: Options, nest: Nest ] = BEGIN totalAllocs: LONG INTEGER _ allocDetails.number + (IF allocDetails.isDynamic THEN SELECT zone FROM heap => options.maxHeapAllocations, mds => options.maxMdsAllocations, ENDCASE => ERROR ELSE 0); IF totalAllocs <= 0 THEN RETURN; WFS[Indent[nest], ZoneStrings[maxCount][zone], ": CARDINAL = "]; WF1["%g;\n", [integer[totalAllocs]]]; IF allocDetails.isDynamic THEN WFL[nest, ZoneStrings[counter][zone], ": CARDINAL _ 0;"]; WFSL[Indent[nest], ZoneStrings[vector][zone], ": ARRAY [1..", ZoneStrings[maxCount][zone], "] OF ", ZoneStrings[ptrType][zone], "_ALL[NIL];\n"]; <> <> <<"Sizes: ARRAY [1..", ZoneStrings[maxCount][zone], "] OF INT _ ALL[0];\n"];>> END; -- DeclareArray. Deallocate: PROCEDURE [ zone: AllocZone, allocDetails: AllocDetails, nest: Nest, options: Options] = BEGIN IF allocDetails.number <= 0 THEN RETURN; WFSL[Indent[nest], "FOR ptr: CARDINAL IN [1..LENGTH[", ZoneStrings[vector][zone], "]] DO\n", Indent[nest+1], "IF ", ZoneStrings[vector][zone], "[ptr] = NIL THEN EXIT;\n"]; <> <> <> <<"RpcPrivate.DeAlloc[", ZoneStrings[vector][zone], "[ptr], ",>> <> <<}>> << ELSE>> WFSL[ Indent[nest+1], ZoneStrings[zone][zone], ".FREE[@", ZoneStrings[vector][zone], "[ptr]];\n", Indent[nest+1], "ENDLOOP;\n"]; END; -- Deallocate.  <> CopyOne: PUBLIC PROCEDURE [ wordsNeeded: Words, value: SubStrings, nullValue, oneStmt: BOOLEAN _ FALSE, marshalInfo: MarshalInfo, nest: Nest ] = BEGIN OPEN varNames: marshalInfo.varNames; IF oneStmt THEN WFL1[nest, "BEGIN"]; InsureContiguousWords[wordsNeeded, marshalInfo, nest]; IF nullValue THEN WFL1[nest, "-- Ignore value and skip ahead in pkt."] ELSE SELECT marshalInfo.direction FROM toPkt => WFSL[ Indent[nest], varNames.pkt, ".data[", varNames.pktLength, "] _ ", value.s1, value.s2, value.s3, "; " ]; fromPkt => WFSL[ Indent[nest], value.s1, value.s2, value.s3, " _ ", varNames.pkt, ".data[", varNames.pktLength, "]; " ]; ENDCASE => ERROR; WFSL[varNames.pktLength, " _ ", varNames.pktLength, "+1;\n"]; IF oneStmt THEN WFL1[nest, "END;"]; END; CopyTwo: PUBLIC PROCEDURE [ wordsNeeded: Words, value: SubStrings, nullValue, oneStmt: BOOLEAN _ FALSE, marshalInfo: MarshalInfo, nest: Nest ] = BEGIN OPEN varNames: marshalInfo.varNames; DoubleWordRoutine: PACKED ARRAY PktSite OF String = [ stubFrame: "StubPktDoubleWord", rpcRuntime: "RpcPktDoubleWord" ]; IF oneStmt THEN WFL1[nest, "BEGIN"]; InsureContiguousWords[wordsNeeded, marshalInfo, nest]; IF nullValue THEN WFL1[nest, "-- Ignore value and skip ahead in pkt."] ELSE SELECT marshalInfo.direction FROM toPkt => WFSL[ Indent[nest], "Lupine.", DoubleWordRoutine[marshalInfo.paramInfo.pktSite], "[", varNames.pkt, ", ", varNames.pktLength, "]^ _ ", value.s1, value.s2, value.s3, ";\n" ]; fromPkt => WFSL[ Indent[nest], value.s1, value.s2, value.s3, " _ Lupine.", DoubleWordRoutine[marshalInfo.paramInfo.pktSite], "[", varNames.pkt, ", ", varNames.pktLength, "]^;\n" ]; ENDCASE => ERROR; WFLL[nest, varNames.pktLength, " _ ", varNames.pktLength, " + 2;"]; IF oneStmt THEN WFL1[nest, "END;"]; END; InsureContiguousWords: PROCEDURE [ wordsNeeded: Words, marshalInfo: MarshalInfo, nest: Nest ] = BEGIN OPEN varNames: marshalInfo.varNames; SELECT TRUE FROM wordsNeeded > Private.MaxDataLength => ERROR; wordsNeeded=0 OR marshalInfo.paramInfo.alwaysOnePkt => NULL; ENDCASE => BEGIN words: String = IO.PutFR["%g", [integer[wordsNeeded]]]; WFLL[nest, "IF ", varNames.pktLength, "+", words, " > RpcPrivate.maxDataLength"]; WFSL[Indent[nest+1], "THEN ", varNames.pktLength, " _ Lupine.", (SELECT marshalInfo.direction FROM toPkt => "StartNextPkt", fromPkt => "FinishThisPkt", ENDCASE => ERROR), "[pkt: ", varNames.pkt, ", pktLength: ", varNames.pktLength, "];\n" ]; END; END; CopyCharacters: PUBLIC PROCEDURE [ textName: SubStrings, numCharsName: String, marshalInfo: MarshalInfo, nest: Nest ] = BEGIN OPEN varNames: marshalInfo.varNames; WFSL[Indent[nest], varNames.pktLength, " _ Lupine.", Routine[marshalInfo.direction], "[pkt: ", varNames.pkt, ", pktLength: ", varNames.pktLength, ", dataAdr: ", textName.s1, textName.s2, textName.s3, ", dataLength: Lupine.WordsForChars[", numCharsName, "], alwaysOnePkt: ", Truth[marshalInfo.paramInfo.alwaysOnePkt], "];\n"]; END; CopyUninterpreted: PUBLIC PROCEDURE [ variableName: String, variableInfo: ST.TypeInfo, parentInfo: ParentInfo, marshalInfo: MarshalInfo, nest: Nest ] = BEGIN <> WITH variableInfo: variableInfo SELECT FROM Null, Basic, Record, Array, RelativePtr, Opaque => CopyType[variableName, variableInfo, parentInfo, marshalInfo, nest]; Transfer, Pointer, Ref, List, String, Rope, Atom, Descriptor, Zone => <> Copy[ nest: nest, name: variableName, typeInfo: variableInfo, interpret: FALSE, parentInfo: parentInfo, marshalInfo: marshalInfo ]; VariantPart, Sequence, Text, StringBody => ERROR; -- These should always be embedded in something else. Definition, Any, Other => ERROR; -- These are impossible. ENDCASE => ERROR; END; CopyType: PUBLIC PROCEDURE [ variableName: String, variableInfo: ST.TypeInfo, parentInfo: ParentInfo, marshalInfo: MarshalInfo, nest: Nest ] = BEGIN <> WITH variableInfo: variableInfo SELECT FROM Null => WFL1[nest, "NULL;"]; Basic, RelativePtr, Opaque, Array => Copy[ nest: nest, name: variableName, typeInfo: variableInfo, interpret: FALSE, parentInfo: parentInfo, marshalInfo: marshalInfo ]; Record => Copy[ nest: nest, name: variableName, typeInfo: variableInfo, interpret: variableInfo.hasSequences, parentInfo: parentInfo, marshalInfo: marshalInfo ]; Descriptor, Sequence => Copy[ nest: nest, name: variableName, typeInfo: variableInfo, interpret: TRUE, parentInfo: parentInfo, marshalInfo: marshalInfo ]; Transfer, Pointer, Ref, List, String, Rope, Atom, Descriptor, Zone, VariantPart, Sequence, Text, StringBody => ERROR; -- Previous special treatment required. Definition, Any, Other => ERROR; -- These are impossible. ENDCASE => ERROR; END; Copy: PRIVATE PROCEDURE [ name: String, typeInfo: ST.TypeInfo, interpret: BOOLEAN, parentInfo: ParentInfo, marshalInfo: MarshalInfo, nest: Nest ] = BEGIN IF interpret THEN WriteCopy[name, typeInfo, TRUE, parentInfo, marshalInfo, nest] ELSE SELECT ST.Size[typeInfo.self] FROM 0 => ERROR; 1 => CopyOne[ nest: nest, wordsNeeded: 1, value: [name], oneStmt: TRUE, marshalInfo: marshalInfo ]; 2 => CopyTwo[ nest: nest, wordsNeeded: 2, value: [name], oneStmt: TRUE, marshalInfo: marshalInfo ]; ENDCASE => WriteCopy[name, typeInfo, FALSE, parentInfo, marshalInfo, nest]; END; Routine: PACKED ARRAY Private.Direction OF String = [ toPkt: "CopyToPkt", fromPkt: "CopyFromPkt"]; Truth: PACKED ARRAY BOOLEAN OF String = [TRUE: "TRUE", FALSE: "FALSE"]; WriteCopy: PROCEDURE [ name: String, typeInfo: ST.TypeInfo, interpret: BOOLEAN, parentInfo: ParentInfo, marshalInfo: MarshalInfo, nest: Nest ] = BEGIN OPEN varNames: marshalInfo.varNames; WFSL[Indent[nest], varNames.pktLength, " _ Lupine.", Routine[marshalInfo.direction], "[pkt: ", varNames.pkt, ", pktLength: ", varNames.pktLength, ", dataAdr: "]; WriteAddress[name, typeInfo.type, interpret, parentInfo]; WFS1[ ", dataLength: "]; WriteSize[name, typeInfo, interpret]; WFS[ ", alwaysOnePkt: ", Truth[marshalInfo.paramInfo.alwaysOnePkt], "];\n"]; END; WriteAddress: PROCEDURE [ name: String, type: ST.Types, interpret: BOOLEAN, parentInfo: ParentInfo] = BEGIN SELECT type FROM Array, Descriptor => IF interpret THEN WFS["BASE[", name, "]"] ELSE WFS["@", name]; Sequence => IF interpret THEN WFS["BASE[DESCRIPTOR[", name, "]]"] ELSE WFS["@", name]; ENDCASE => <> IF name.Fetch[name.Length[]-1] = '^ THEN SELECT parentInfo.typeInfo.type FROM Ref => WFS["LOOPHOLE[", parentInfo.name, "]"]; Pointer => WFS1[parentInfo.name]; ENDCASE => ERROR ELSE WFS["@", name]; END; WriteSize: PROCEDURE [ name: String, typeInfo: ST.TypeInfo, interpret: BOOLEAN ] = BEGIN DynamicArraySize: PROC [ arrayName: SubStrings, elementType: ST.TypeHandle, packed: BOOLEAN] = BEGIN WFS1["SIZE["]; Declare.WriteTypeName[elementType]; IF packed THEN WFSL[", LENGTH[", arrayName.s1, arrayName.s2, arrayName.s3, "]]"] ELSE WFSL["]*LENGTH[", arrayName.s1, arrayName.s2, arrayName.s3, "]"]; END; -- DynamicArraySize. IF interpret THEN WITH typeInfo: typeInfo SELECT FROM Record => BEGIN <> <<(yet) because everything is done in terms of unbound variants.>> WFS1["SIZE["]; Declare.WriteTypeName[typeInfo.self]; IF typeInfo.hasSequences THEN WFS["[LENGTH[DESCRIPTOR[", name, "]]]"]; WFS1["]"]; END; Descriptor => -- Variable length and packing make the size tricky. DynamicArraySize[ [name], typeInfo.elementType, typeInfo.packed]; Sequence => -- Ditto. DynamicArraySize[ SubStrings["DESCRIPTOR", name, "]"], typeInfo.elementType, typeInfo.packed]; ENDCASE => {WFS1["SIZE["]; Declare.WriteTypeName[typeInfo.self]; WFS1["]"]} ELSE {WFS1["SIZE["]; Declare.WriteTypeName[typeInfo.self]; WFS1["]"]}; END;  <> Error: PUBLIC PROCEDURE [ code: ErrorCode, symbol: ST.SymbolHandle, type: ST.TypeHandle, string: String, causeError: BOOLEAN ] = BEGIN ReportMarshalError [ errorType: error, errorCode: code, symbol: symbol, type: type, string: string, causeError: causeError ]; END; Warning: PUBLIC PROCEDURE [ code: ErrorCode, symbol: ST.SymbolHandle _ ST.SymbolHandleNIL, type: ST.TypeHandle _ ST.TypeHandleNIL, string: String _ StringNIL, causeError: BOOLEAN _ FALSE ] = BEGIN ReportMarshalError [ errorType: warning, errorCode: code, symbol: symbol, type: type, string: string, causeError: causeError ]; END; ReportMarshalError: PROCEDURE [ errorType: ErrorType, errorCode: ErrorCode, symbol: ST.SymbolHandle, type: ST.TypeHandle, string: String, causeError: BOOLEAN ] = BEGIN problemText: String _ NIL; SELECT TRUE FROM symbol # ST.SymbolHandleNIL => problemText _ ST.SymbolName[symbol]; type # ST.TypeHandleNIL => BEGIN prStr: IO.STREAM = IO.ROS[]; FillProblem: PROC [c: CHARACTER] = { prStr.PutChar[c] }; ST.PutTypeName[type: type, putProc: FillProblem]; problemText _ IO.RopeFromROS[prStr]; END; ENDCASE => problemText _ string; ReportError[type: errorType, code: errorCode, problemText: problemText]; BEGIN CodeFileMessage: ExplanationProc = BEGIN WFSL[ "-- ##### ", (SELECT errorType FROM error => "Error: ", warning => "Warning: ", abort => "Abort: ", ENDCASE => ERROR), explanation, "\BIdentifier or type = ", (IF IsNull[problemText] THEN "" ELSE problemText), ". --", (IF causeError THEN " Lupine.TranslationError;" ELSE ""), "\n" ]; END; -- CodeFileMsg. GiveExplanation[code: errorCode, explainer: CodeFileMessage]; END; END;  <> EnumerateSomeParams: PUBLIC PROCEDURE [ paramInfo: ParamInfo, proc: ParamProcedure, place1, place2: ParamLocation ] = BEGIN DoParam: ParamProcedure = BEGIN SELECT paramFieldInfo.location FROM place1, place2 => RETURN[stop: proc[paramName, paramType, paramIndex, paramFieldInfo] ]; ENDCASE => NULL; END; Marshal.EnumerateParams[ paramInfo: paramInfo, paramProc: DoParam, includeRESULTs: TRUE ]; END; END. -- LupineMarshalUtilityImpl. TransferParamProcedure: TYPE = PROCEDURE [ transferName: String, -- Is unique within the top-level transfer. transferSymbol: ST.SymbolHandle, transferType: ST.TypeHandle, transferIndex: ParamIndex, transferArgInfo, transferResultInfo: ParamInfo ] RETURNS [stop: BOOLEAN_FALSE]; EnumerateTransferParams: PROCEDURE [ paramRecord: ST.TypeHandle, transferProc: TransferParamProcedure, all, procs, signals, errors: BOOLEAN_FALSE ] = BEGIN index: ST.Index _ 0; TraceTransfers: PROCEDURE [ thisType: ST.TypeHandle, prefixName: String, ptrDepth: INTEGER_0 ] = BEGIN info: ST.TypeInfo = ST.GetTypeInfo[thisType]; WITH info: info SELECT FROM Definition, Basic, Text, String, StringBody, Rope, Atom, Any, RelativePtr, Zone, Opaque, Null, Other => NULL; List, Array, Descriptor, Sequence => Private.Error[code: Other, type: thisType]; Transfer => IF all OR (procs AND info.kind=Procedure) OR (signals AND info.kind=Signal) OR (errors AND info.kind=Error) THEN transferProc [ transfer: LOOPHOLE--DANGER--[info.transferType], kind: info.kind, argumentRecordType: info.argumentType, resultRecordType: info.resultType, transferIndex: (index _ index+1) ]; Record => BEGIN CheckFieldForProc: ST.ComponentProcedure = {TraceTransfers[componentType, ??, ptrDepth]}; [] _ ST.EnumerateRecord[ recordType: info.recordType, proc: CheckFieldForProc]; END; VariantPart => BEGIN CheckVariantForProc: ST.VariantProcedure = {TraceTransfers[variantRecordType, ??, ptrDepth]}; IF info.kind = Computed THEN RETURN; [] _ ST.EnumerateVariants[ variantPartType: info.variantPartType, proc: CheckVariantForProc]; END; Pointer => BEGIN IF ptrDepth > MaxPointerDepth THEN RETURN; TraceTransfers[info.referentType, ???, ptrDepth+1]; END; Ref => BEGIN IF ptrDepth > MaxPointerDepth THEN RETURN; TraceTransfers[info.referentType, ???, ptrDepth+1]; END; ENDCASE => ERROR; END; -- TraceTransfers. TraceTransfers[thisType: paramRecord]; END;