DIRECTORY
Atom USING [ MakeAtom ],
IO,
LupineDeclare USING [WriteSymbolName, WriteTypeName],
LupineManagerPrivate
USING [
Indent, Options, ModuleName,
Nest, ParamPassingMethod, String, StringNIL,
formattedStream,
WFS, WFS1, WFSL, WFL, WFL1, WFLL ],
LupineMarshal USING [FieldInfo, ParamInfo, ParamRecordKind],
LupineMarshalPrivate
USING [
ContainsRefs, ContainsSequences, ContainsStatics,
CopyOne, CopyTwo, CopyType, Direction, Error, HasEmptyIndex,
MarshalInfo, MarshalType, MaxPointerDepth,
NeedsMarshaling, NeedsOperationProc, OperationProc,
ParentInfo, Passing,
SubStrings, UniqueName, VerifyPassingMethods, WriteNEW ],
LupineSymbolTable
USING [
ComponentProcedure, EnumerateRecord,
EnumerateVariants, GetTypeInfo, IsAnonymous, MakeTypeID,
PutTypeName, QualifyOpenNames, SymbolHandle, SymbolName,
TypeID, TypeHandle, TypeInfo, Types, VariantProcedure ],
RefTab USING [ Create, EachPairAction, Fetch, Pairs, Ref, Store ],
LupineMarshalTypeConstructorImpl:
PROGRAM
IMPORTS
Atom, IO, Declare: LupineDeclare, LupineManagerPrivate,
Private: LupineMarshalPrivate, ST: LupineSymbolTable, RefTab, Rope
EXPORTS LupineMarshalPrivate
SHARES LupineManagerPrivate
= BEGIN OPEN LupineManagerPrivate, LupineMarshal;
Types from the internal LupineManagerPrivate interface.
ParentInfo: TYPE = Private.ParentInfo;
MarshalInfo: TYPE = Private.MarshalInfo;
NeedsOperationProc: TYPE = Private.NeedsOperationProc;
OperationProc: TYPE = Private.OperationProc;
SubStrings: TYPE = Private.SubStrings;
List of deferred marshal types. What's wrong with global Variables?
MarshalTypes: TYPE = RefTab.Ref;
marshalTypes: MarshalTypes←NIL;
MarshalTransfer:
PUBLIC
PROCEDURE [
name: String,
transferInfo: Transfer ST.TypeInfo,
parentInfo: ParentInfo,
marshalInfo: MarshalInfo,
nest: Nest,
options: Options ] =
BEGIN
Private.VerifyPassingMethods[value: TRUE, handle: TRUE, marshalInfo: marshalInfo];
Private.Error[code: TransferParameter, type: transferInfo.self];
END;
MarshalRecord:
PUBLIC
PROCEDURE [
name: String,
recInfo: Record ST.TypeInfo,
parentInfo: ParentInfo,
marshalInfo: MarshalInfo,
nest: Nest,
options: Options ] =
BEGIN
Private.VerifyPassingMethods[value: TRUE, marshalInfo: marshalInfo];
IF recInfo.hasSequences
THEN MarshalSequenceRecord[ nest: nest,
recName: name, recInfo: recInfo,
parentInfo: parentInfo, marshalInfo: marshalInfo,
options: options ]
ELSE MarshalFixedRecord[ nest: nest,
recName: name, recInfo: recInfo,
parentInfo: parentInfo, marshalInfo: marshalInfo,
options: options ];
END;
MarshalFixedRecord:
PROCEDURE [
recName: String,
recInfo: Record ST.TypeInfo,
parentInfo: ParentInfo,
marshalInfo: MarshalInfo,
nest: Nest,
options: Options ] =
BEGIN
MarshalFixedRecord needs storage for the record to already be allocated.
Thus, sequence containing records are separately handled by
MarshalSequenceRecord, which calls us to do some work.
IF (
SELECT parentInfo.typeInfo.type
FROM
Record, VariantPart => FALSE, ENDCASE => TRUE)
AND Private.ContainsStatics[recInfo.self]
THEN
BEGIN
Private.CopyType[ nest: nest,
variableName: recName, variableInfo: recInfo,
parentInfo: parentInfo, marshalInfo: marshalInfo ];
After a blind copy, always reset any Refs to NIL immediately.
This consistency-making must be done atomically, ie, there
must be no possibility of a fault (UNWIND) between the copying
and the NIL-making.
MakeRefsNil[ nest: nest,
name: recName,
type: recInfo.self,
parentInfo: parentInfo,
marshalInfo: marshalInfo,
options: options ];
END;
DoRecordOperation[ nest: nest,
opProc: Private.MarshalType, needsOpProc: Private.NeedsMarshaling,
recName: recName, recInfo: recInfo,
marshalInfo: marshalInfo,
options: options ];
END;
MarshalSequenceRecord:
PROCEDURE [
recName: String,
recInfo: Record ST.TypeInfo,
parentInfo: ParentInfo,
marshalInfo: MarshalInfo,
nest: Nest,
options: Options ] =
BEGIN
IF ~recInfo.hasSequences
OR
(
SELECT parentInfo.typeInfo.type
FROM
Pointer, Ref => FALSE, ENDCASE => TRUE)
THEN ERROR;
SELECT marshalInfo.direction
FROM
toPkt =>
BEGIN
Private.CopyOne[ nest: nest,
wordsNeeded: 3,
value: [parentInfo.name, "=NIL"--L--],
marshalInfo: marshalInfo ];
WFL[nest, "IF "--L--, parentInfo.name, " # NIL THEN BEGIN"--L--];
WFL1[nest+1, "-- Record has a sequence, put its length up front."--L--];
Private.CopyTwo[ nest: nest+1,
wordsNeeded: 0,
value: SubStrings["LENGTH[DESCRIPTOR["--L--, recName, "]]"--L--],
marshalInfo: marshalInfo ];
IF Private.Passing[Result, argument, marshalInfo]
THEN WFL1[nest+1, "NULL; -- Call by result, don't send record."--L--]
ELSE MarshalFixedRecord[ nest: nest+1,
recName: recName, recInfo: recInfo,
parentInfo: parentInfo, marshalInfo: marshalInfo,
options: options ];
WFL[nest+1, "END; -- IF "--L--, parentInfo.name, " # NIL."--L--];
END;
fromPkt =>
BEGIN
WFL1[nest, "recordIsNIL: Lupine.NilHeader;"--L--];
Private.CopyOne[ nest: nest,
wordsNeeded: 3,
value: ["recordIsNIL"--L--],
marshalInfo: marshalInfo ];
IF Private.Passing[Result, result, marshalInfo]
OR Private.Passing[Var, result, marshalInfo]
THEN
WFL[nest,
"IF recordIsNIL # ("--L--, parentInfo.name,
"=NIL) THEN Lupine.UnmarshalingError;"--L--];
WFL1[nest, "IF recordIsNIL"--L--];
WFL[nest+1, "THEN "--L--, parentInfo.name, " ← NIL"--L--];
WFL1[nest+1, "ELSE BEGIN"--L--];
WFL1[nest+2, "seqLength: Lupine.SequenceHeader;"--L--];
Private.CopyTwo[ nest: nest+2,
wordsNeeded: 0,
value: ["seqLength"--L--],
marshalInfo: marshalInfo ];
IF Private.Passing[Result, result, marshalInfo]
OR Private.Passing[Var, result, marshalInfo]
THEN
BEGIN
WFL[nest+2,
"IF seqLength # LENGTH[DESCRIPTOR["--L--, recName,
"]] THEN Lupine.UnmarshalingError;"--L-- ];
WFL1[nest+2,
"NULL; -- Call by var or result, use existing record."--L--];
END
ELSE
BEGIN
WFS[Indent[nest+2], parentInfo.name, " ← ("--L--];
[] ← Private.WriteNEW[
ptrInfo: parentInfo.typeInfo, marshalInfo: marshalInfo, options: options ];
WFS1["["--L--];
Declare.WriteTypeName[recInfo.self];
WFS1["[Lupine.SHORT[seqLength]]]);\n"--L--];
END;
IF Private.Passing[Result, argument, marshalInfo]
THEN WFL1[nest+2,
"NULL; -- Call by result, use uninitialized record."--L--]
ELSE MarshalFixedRecord[ nest: nest+2,
recName: recName, recInfo: recInfo,
parentInfo: parentInfo, marshalInfo: marshalInfo,
options: options ];
WFL[nest+2, "END; -- IF recordIsNIL."--L--];
END;
ENDCASE => ERROR;
END;
DoRecordOperation:
PROCEDURE [
opProc: OperationProc,
needsOpProc: NeedsOperationProc,
recName: String,
recInfo: Record ST.TypeInfo,
marshalInfo: MarshalInfo,
nest: Nest,
options: Options ] =
BEGIN
MarshalField:
ST.ComponentProcedure =
BEGIN
IF ~needsOpProc[componentType] THEN RETURN;
Monitored records will be caught because of the LOCK field.
opProc[ nest: nest,
name: FieldName[
fieldSymbol: component,
recordType: recInfo.self,
anonOk:
-- Single component variant records don't need names.
componentIndex = 1 AND
recInfo.hasVariants AND
ST.GetTypeInfo[componentType].type = VariantPart ],
type: componentType,
parentInfo: [recName, recInfo],
marshalInfo: marshalInfo,
options: options ];
END;
IF needsOpProc[recInfo.self]
THEN
BEGIN
WFL[nest, "BEGIN OPEN record: "--L--, recName, ";"--L--];
[] ← ST.EnumerateRecord[recordType: recInfo.self, proc: MarshalField];
WFL[nest, "END; -- OPEN record: "--L--, recName, "."--L--];
END;
END;
MarshalVariantPart:
PUBLIC
PROCEDURE [
name: String,
varInfo: VariantPart ST.TypeInfo,
parentInfo: ParentInfo,
marshalInfo: MarshalInfo,
nest: Nest,
options: Options ] =
BEGIN
Private.VerifyPassingMethods[value: TRUE, marshalInfo: marshalInfo];
IF Private.ContainsSequences[varInfo.self]
THEN Private.Error[code: SequenceInsideVariant, type: varInfo.self]
ELSE DoVariantOperation[ nest: nest,
opProc: Private.MarshalType, needsOpProc: Private.NeedsMarshaling,
varName: name, varInfo: varInfo,
marshalInfo: marshalInfo,
options: options ];
END;
DoVariantOperation:
PROCEDURE [
opProc: OperationProc,
needsOpProc: NeedsOperationProc,
varName: String,
varInfo: VariantPart ST.TypeInfo,
marshalInfo: MarshalInfo,
nest: Nest,
options: Options ] =
BEGIN
MarshalVariant:
ST.VariantProcedure =
BEGIN
IF ~needsOpProc[variantRecordType] THEN RETURN;
WFS1[Indent[nest+1]];
Declare.WriteSymbolName[variantTag];
WFS1[" =>\n"--L--];
opProc[ nest: nest+2,
name: "variant"--L--,
type: variantRecordType,
parentInfo: [varName, varInfo],
marshalInfo: marshalInfo,
options: options ];
END; -- MarshalVariant.
SELECT
TRUE
FROM
~needsOpProc[varInfo.self] => NULL;
varInfo.kind = Computed =>
Private.Error[code: ComputedVariant, type: varInfo.self];
ENDCASE =>
BEGIN
WFL1[nest, "WITH variant: record SELECT FROM"
--L--];
[] ←
ST.EnumerateVariants[
variantPartType: varInfo.self, proc: MarshalVariant];
WFL1[nest+1, "ENDCASE => NULL; -- WITH variant: record."--L--];
END;
END;
MarshalPointer:
PUBLIC
PROCEDURE [
name: String,
pointerInfo: Pointer ST.TypeInfo,
parentInfo: ParentInfo,
marshalInfo: MarshalInfo,
nest: Nest,
options: Options ] =
BEGIN
MarshalPointerTypes[ nest: nest,
ptrName: name, ptrInfo: pointerInfo,
referentType: pointerInfo.referentType,
parentInfo: parentInfo, marshalInfo: marshalInfo,
options: options ];
END;
MarshalRef:
PUBLIC
PROCEDURE [
name: String,
refInfo: Ref ST.TypeInfo,
parentInfo: ParentInfo,
marshalInfo: MarshalInfo,
nest: Nest,
options: Options ] =
BEGIN
MarshalPointerTypes[ nest: nest,
ptrName: name, ptrInfo: refInfo,
referentType: refInfo.referentType,
parentInfo: parentInfo, marshalInfo: marshalInfo,
options: options ];
END;
MarshalPointerTypes:
PROCEDURE [
ptrName: String,
ptrInfo: ST.TypeInfo,
referentType: ST.TypeHandle,
parentInfo: ParentInfo,
marshalInfo: MarshalInfo,
nest: Nest,
options: Options ] = {
toPkt: BOOL ← SELECT marshalInfo.direction FROM toPkt=>TRUE, ENDCASE=>FALSE;
IF ~marshalInfo.paramInfo.options.inlineMarshal
THEN {
marshalStream: IO.STREAM;
marshalProcName: String;
procNest: LupineManagerPrivate.Nest ← 0;
mainStream: IO.STREAM = LupineManagerPrivate.formattedStream;
wasQualified: BOOL;
[marshalStream, marshalProcName] ← MarshalProcStream[ptrInfo, marshalInfo];
IF marshalProcName=NIL THEN GOTO Vanilla; -- Not a named type, don' mess with it.
wasQualified ← ST.QualifyOpenNames[TRUE]; -- Push;
IF toPkt THEN WFS[Indent[nest], "pktLength ← "]
ELSE WFSL[Indent[nest], "[", ptrName, ", pktLength] ← "];
WFS[marshalProcName];
IF toPkt THEN WFSL["[", ptrName, ", pkt, pktLength];\n"]
ELSE {
IF marshalInfo.paramInfo.options.importMultiple
AND marshalInfo.paramInfo.transferSite = caller
THEN {
WFS["[interface, pkt, pktLength];\n"]
}
ELSE {
WFS["[pkt, pktLength];\n"];
};
};
IF marshalStream=NIL THEN { []←ST.QualifyOpenNames[wasQualified]; RETURN; };
LupineManagerPrivate.formattedStream ← marshalStream;
WFS[ Indent[procNest], marshalProcName];
WFS1[ ": PROC["];
IF toPkt THEN WriteValueDeclaration[ptrInfo]
ELSE {
-- unmarshalling: if not single import, then prepend an interface
IF marshalInfo.paramInfo.options.importMultiple
AND marshalInfo.paramInfo.transferSite = caller
THEN {
WFS1[ "interface: RpcControl.InterfaceRecord, "];
};
};
WFS[
SELECT marshalInfo.paramInfo.pktSite
FROM
stubFrame=>"pkt: RpcPrivate.StubPkt",
rpcRuntime=>"pkt: RpcPrivate.RPCPkt", ENDCASE=>ERROR];
WFS[", pktLength0: RpcPrivate.DataLength]\n"];
WFS[Indent[procNest+1], "RETURNS["];
IF ~toPkt THEN WriteValueDeclaration[ptrInfo];
WFS["pktLength: RpcPrivate.DataLength] = BEGIN\n"];
WFL[procNest+1, "pktLength ← pktLength0; {"];
DoMarshalPointerTypes["value", ptrInfo, referentType, parentInfo, marshalInfo, procNest+1, options];
WFL[procNest+1, "};END;\n"];
[]←ST.QualifyOpenNames[wasQualified]; -- Pop
LupineManagerPrivate.formattedStream ← mainStream;
SaveMarshalProc[ptrInfo, marshalInfo, marshalStream];
}
ELSE GOTO Vanilla;
EXITS
Vanilla =>
DoMarshalPointerTypes[ptrName, ptrInfo, referentType, parentInfo, marshalInfo, nest, options];
};
WriteValueDeclaration:
PROC[ptrInfo:
ST.TypeInfo] = {
WFS1[ "value: "];
Declare.WriteTypeName[ptrInfo.self];
WFS[", "];
};
DoMarshalPointerTypes:
PROCEDURE [
ptrName: String,
ptrInfo: ST.TypeInfo,
referentType: ST.TypeHandle,
parentInfo: ParentInfo,
marshalInfo: MarshalInfo,
nest: Nest,
options: Options ] =
BEGIN
referentInfo: ST.TypeInfo = ST.GetTypeInfo[referentType];
referentName: String = ptrName.Cat["^"];
Private.VerifyPassingMethods[all: TRUE, marshalInfo: marshalInfo];
marshalInfo.ptrDepth ← marshalInfo.ptrDepth + 1;
SELECT
TRUE
FROM
marshalInfo.ptrDepth > Private.MaxPointerDepth =>
Private.Error[code: ProbablePointerRecursion, type: ptrInfo.self];
(
WITH refInfo: referentInfo
SELECT
FROM
Basic =>
SELECT refInfo.kind
FROM
Unspecified, Other => TRUE, ENDCASE => FALSE,
Any => TRUE,
Opaque => ~refInfo.lengthKnown,
ENDCASE => FALSE) =>
Private.Error[code: InvalidHandle, type: ptrInfo.self];
(
WITH refInfo: referentInfo
SELECT
FROM
Text, StringBody => TRUE,
Record => refInfo.hasSequences,
ENDCASE => FALSE) =>
Private.MarshalType[ nest: nest,
name: referentName,
type: referentType,
parentInfo: [ptrName, ptrInfo],
marshalInfo: marshalInfo,
options: options ];
ENDCASE =>
MarshalFixedReferent[ nest: nest,
ptrName: ptrName, ptrInfo: ptrInfo,
referentName: referentName, referentInfo: referentInfo,
parentInfo: parentInfo, marshalInfo: marshalInfo,
options: options ];
marshalInfo.ptrDepth ← marshalInfo.ptrDepth - 1;
END;
MarshalFixedReferent:
PROCEDURE [
ptrName: String, ptrInfo: ST.TypeInfo,
referentName: String, referentInfo: ST.TypeInfo,
parentInfo: ParentInfo,
marshalInfo: MarshalInfo,
nest: Nest,
options: Options ] =
BEGIN
This routine expects that the referentType has a fixed,
nondynamic length. MarshalPointerTypes should have screened this.
SELECT marshalInfo.direction
FROM
toPkt =>
BEGIN
Private.CopyOne[ nest: nest,
wordsNeeded: 1,
value: [ptrName, "=NIL"--L--],
marshalInfo: marshalInfo ];
WFL[nest, "IF "--L--, ptrName, " # NIL THEN"--L--];
IF Private.Passing[Result, argument, marshalInfo]
THEN WFL1[nest+1, "NULL; -- Call by result, send nothing."--L--]
ELSE Private.MarshalType[ nest: nest+1,
name: referentName, type: referentInfo.self,
parentInfo: [ptrName, ptrInfo], marshalInfo: marshalInfo,
options: options ];
END;
fromPkt =>
BEGIN
WFL1[nest, "isNIL: Lupine.NilHeader;"--L--];
Private.CopyOne[ nest: nest,
wordsNeeded: 1,
value: ["isNIL"--L--],
marshalInfo: marshalInfo ];
IF Private.Passing[Result, result, marshalInfo]
OR
Private.Passing[Var,result,marshalInfo]
THEN
BEGIN
WFL[nest,
"IF isNIL # ("--L--, ptrName,
"=NIL) THEN Lupine.UnmarshalingError;"--L--];
WFL1[nest, "IF ~isNIL THEN"--L--];
WFL1[nest+1, "-- Call by var or result, use existing referent."--L--];
Private.MarshalType[ nest: nest+1,
name: referentName, type: referentInfo.self,
parentInfo: [ptrName, ptrInfo], marshalInfo: marshalInfo,
options: options ];
END
ELSE
BEGIN
WFL1[nest, "IF isNIL"--L--];
WFL[nest+1, "THEN "--L--, ptrName, " ← NIL"--L--];
WFL1[nest+1, "ELSE BEGIN"--L--];
WFS[Indent[nest+2], ptrName, " ← ("--L--];
[] ← Private.WriteNEW[ptrInfo: ptrInfo, marshalInfo: marshalInfo, options: options];
WFS1["["--L--];
Declare.WriteTypeName[referentInfo.self];
WFS1["]);\n"--L--];
IF Private.Passing[Result, argument, marshalInfo]
THEN WFL1[nest+2,
"NULL; -- Call by result, use uninitialized referent."--L--]
ELSE Private.MarshalType[ nest: nest+2,
name: referentName, type: referentInfo.self,
parentInfo: [ptrName, ptrInfo], marshalInfo: marshalInfo,
options: options ];
WFL1[nest+2, "END; -- IF isNIL."--L--];
END;
END;
ENDCASE => ERROR;
END;
MarshalList:
PUBLIC
PROCEDURE [
name: String,
listInfo: List ST.TypeInfo,
parentInfo: ParentInfo,
marshalInfo: MarshalInfo,
nest: Nest,
options: Options ] =
BEGIN
Private.VerifyPassingMethods[value: TRUE, handle: TRUE, marshalInfo: marshalInfo];
DoListOperation[ nest: nest,
opProc: Private.MarshalType, needsOpProc: Private.NeedsMarshaling,
listName: name, listInfo: listInfo,
marshalInfo: marshalInfo,
options: options ];
END;
DoListOperation:
PROCEDURE [
opProc: OperationProc,
needsOpProc: NeedsOperationProc,
listName: String,
listInfo: List ST.TypeInfo,
marshalInfo: MarshalInfo,
nest: Nest,
options: Options ] =
BEGIN
thisNode: String = Private.UniqueName[
root: "thisNode"--L--,
marshalInfo: marshalInfo ];
thisNodeFirst: String = Private.UniqueName[
root: "thisNode"--L--, suffix: ".first"--L--,
marshalInfo: marshalInfo ];
IF opProc # Private.MarshalType
THEN
ERROR;
DoListOperation does only marshaling correctly for now.
SELECT marshalInfo.direction
FROM
toPkt =>
BEGIN
WFS[Indent[nest], thisNode, ": "--L--];
Declare.WriteTypeName[type: listInfo.self, includeReadonly: FALSE];
WFS1[";\n"--L--];
WFL1[nest, "listLength: Lupine.ListHeader ← 0;"--L--];
WFSL[ Indent[nest], "FOR "
--L--, thisNode, " ← "
--L--,
listName, ", "--L--, thisNode, ".rest UNTIL "--L--,
thisNode, " = NIL DO\n"--L--];
WFL1[nest+1, "listLength ← listLength + 1; ENDLOOP;"--L--];
Private.CopyTwo[ nest: nest,
wordsNeeded: 2,
value: SubStrings["listLength"--L--],
marshalInfo: marshalInfo ];
WFSL[ Indent[nest], "FOR "
--L--, thisNode, " ← "
--L--,
listName, ", "--L--, thisNode, ".rest UNTIL "--L--,
thisNode, " = NIL DO\n"--L--];
opProc[ nest: nest+1,
name: thisNodeFirst,
type: listInfo.firstType,
parentInfo: [listName, listInfo],
marshalInfo: marshalInfo,
options: options ];
WFL[nest+1, "ENDLOOP; -- FOR "--L--, thisNode, "."--L--];
END;
fromPkt =>
BEGIN
lastNode: String = UniqueName[
root: "lastNode",
marshalInfo: marshalInfo ];
WFS[Indent[nest], "lastNode: "--L--];
Declare.WriteTypeName[type: listInfo.self, includeReadonly: FALSE];
WFS[" ← ("--L--, listName, " ← NIL);\n"--L--];
WFL1[nest, "listLength: Lupine.ListHeader;"--L--];
Private.CopyTwo[ nest: nest,
wordsNeeded: 2,
value: SubStrings["listLength"--L--],
marshalInfo: marshalInfo ];
WFL1[nest, "WHILE listLength > 0 DO"--L--];
WFS[Indent[nest+1], thisNode, ": "--L--];
Declare.WriteTypeName[type: listInfo.self, includeReadonly: FALSE];
WFS1[" = "--L--];
[] ← Private.WriteNEW[
allocOp: cons, ptrInfo: listInfo, marshalInfo: marshalInfo, options: options];
WFS1["[--DefaultValue--,NIL];\n"--L--];
opProc[ nest: nest+1,
name: thisNodeFirst,
type: listInfo.firstType,
parentInfo: [listName, listInfo],
marshalInfo: marshalInfo,
options: options ];
WFL1[nest+1, "IF lastNode # NIL"--L--];
WFSL[
Indent[nest+2], "THEN lastNode ← (lastNode.rest ← "
--L--,
thisNode, ")\n"--L--,
Indent[nest+2], "ELSE lastNode ← ("
--L--, listName, " ← "
--L--,
thisNode, ");\n"--L-- ];
WFL1[nest+1, "listLength ← listLength - 1;"--L--];
WFL1[nest+1, "ENDLOOP; -- WHILE listLength > 0."--L--];
END;
ENDCASE => ERROR;
END;
MarshalArray:
PUBLIC
PROCEDURE [
name: String,
arrayInfo: Array ST.TypeInfo,
parentInfo: ParentInfo,
marshalInfo: MarshalInfo,
nest: Nest,
options: Options ] =
BEGIN
Private.VerifyPassingMethods[value: TRUE, marshalInfo: marshalInfo];
IF Private.HasEmptyIndex[index: arrayInfo.indexType]
THEN Private.Error[code: EmptyArray, type: arrayInfo.self]
ELSE MarshalVector[ nest: nest,
vectorName: name, vectorInfo: arrayInfo,
indexType: arrayInfo.indexType, elementType: arrayInfo.elementType,
parentInfo: parentInfo, marshalInfo: marshalInfo,
options: options ];
END;
MarshalDescriptor:
PUBLIC
PROCEDURE [
name: String,
descInfo: Descriptor ST.TypeInfo,
parentInfo: ParentInfo,
marshalInfo: MarshalInfo,
nest: Nest,
options: Options ] =
BEGIN
lengthString: String =
IO.PutFR["(IF BASE[%g]=NIL THEN 0 ELSE LENGTH[%g])",
[rope[name]], [rope[name]] ];
Private.VerifyPassingMethods[all: TRUE, marshalInfo: marshalInfo];
SELECT marshalInfo.direction
FROM
toPkt =>
BEGIN
Private.CopyTwo[ nest: nest,
wordsNeeded: 2,
value: [lengthString],
marshalInfo: marshalInfo ];
WFL[nest, "IF BASE["--L--, name, "] # NIL THEN"--L--];
IF Private.Passing[Result, argument, marshalInfo]
THEN WFL1[nest+1, "NULL; -- Call by result, send length only."--L--]
ELSE
BEGIN
MarshalVector[ nest: nest+1,
vectorName: name, vectorInfo: descInfo,
indexType: descInfo.indexType, elementType: descInfo.elementType,
parentInfo: parentInfo, marshalInfo: marshalInfo,
options: options ];
END;
END;
fromPkt =>
BEGIN
The commented code below, and later in this BEGIN block is all that remains from an attempt to use a different allocator for the server stub.
IF options.targetLanguage = Mesa OR ~descInfo.long THEN {
WFSL[Indent[nest],
"DescriptorType: TYPE = RECORD ["--L--,
(IF descInfo.packed THEN "PACKED "--L-- ELSE ""--L--),
"SEQUENCE COMPUTED CARDINAL OF "--L--];
Declare.WriteTypeName[descInfo.elementType];
WFS1["];\n"--L--];
};
WFL1[nest, "descLength: Lupine.SequenceHeader;"--L--];
Private.CopyTwo[ nest: nest,
wordsNeeded: 2,
value: ["descLength"--L--],
marshalInfo: marshalInfo];
IF Private.Passing[Result, result, marshalInfo]
OR
Private.Passing[Var,result,marshalInfo]
THEN
BEGIN
WFL[nest, "IF descLength # "--L--, lengthString];
WFL[nest+1, "THEN Lupine.UnmarshalingError;"--L--];
WFL1[nest,
"NULL; -- Call by var or result, use existing descriptor."--L--];
END
ELSE
BEGIN
WFSL[Indent[nest], name, " ← DESCRIPTOR[\n"
--L--,
Indent[nest+1], "("--L--];
IF options.targetLanguage = Cedar AND descInfo.long THEN {
allocSizeName: Rope.ROPE;
allocSizeName ← Private.WriteNEW[ptrInfo: descInfo, marshalInfo: marshalInfo, options: options, dontUseHeap: TRUE];
WFSL["[Lupine.SHORT[descLength]]),\n",
Indent[nest+1], "( ", allocSizeName, " ← Lupine.SHORT[descLength])];\n"];
}
ELSE {
[] ← Private.WriteNEW[ptrInfo: descInfo, marshalInfo: marshalInfo, options: options, dontUseHeap: FALSE];
WFS["[DescriptorType[Lupine.SHORT[descLength]]]),\n"
--L--,
Indent[nest+1], "Lupine.SHORT[descLength]];\n"--L--];
};
END;
IF Private.Passing[Result, argument, marshalInfo]
THEN WFL1[nest,
"NULL; -- Call by result, use uninitialized descriptor."--L--]
ELSE
BEGIN
MarshalVector[ nest: nest,
vectorName: name, vectorInfo: descInfo,
indexType: descInfo.indexType, elementType: descInfo.elementType,
parentInfo: parentInfo, marshalInfo: marshalInfo,
options: options ]
END;
END;
ENDCASE => ERROR;
END;
MarshalSequence:
PUBLIC
PROCEDURE [
name: String,
seqInfo: Sequence ST.TypeInfo,
parentInfo: ParentInfo,
marshalInfo: MarshalInfo,
nest: Nest,
options: Options ] =
BEGIN
Private.VerifyPassingMethods[value: TRUE, marshalInfo: marshalInfo];
WITH tagName: seqInfo
SELECT
FROM
Computed => Private.Error[code: ComputedSequence, type: seqInfo.self];
Named =>
BEGIN
WFL1[nest, "-- The sequence's length was carried by its record."--L--];
IF ~Private.NeedsMarshaling[seqInfo.elementType] THEN ERROR;
MarshalVector[ nest: nest,
vectorName: name, vectorInfo: seqInfo,
indexType: seqInfo.indexType, elementType: seqInfo.elementType,
parentInfo: parentInfo, marshalInfo: marshalInfo,
options: options ];
END;
ENDCASE => ERROR;
END;
MarshalVector:
PROCEDURE [
vectorName: String,
vectorInfo: ST.TypeInfo,
indexType, elementType: ST.TypeHandle,
parentInfo: ParentInfo,
marshalInfo: MarshalInfo,
nest: Nest,
options: Options ] =
BEGIN
MarshalVector must generate exactly one statement.
Caller guarantees that the vector has >= 0 elements in it, and that
any header information for sequences and descriptors has been sent.
IF ~Private.NeedsMarshaling[elementType]
THEN Private.CopyType[ nest: nest,
variableName: vectorName, variableInfo: vectorInfo,
parentInfo: parentInfo, marshalInfo: marshalInfo ]
ELSE DoVectorOperation[ nest: nest,
opProc: Private.MarshalType, needsOpProc: Private.NeedsMarshaling,
vectorName: vectorName, vectorInfo: vectorInfo,
indexType: indexType, elementType: elementType,
marshalInfo: marshalInfo,
options: options ];
END;
DoVectorOperation:
PROCEDURE [
opProc: OperationProc,
needsOpProc: NeedsOperationProc,
vectorName: String,
vectorInfo: ST.TypeInfo,
indexType, elementType: ST.TypeHandle,
marshalInfo: MarshalInfo,
nest: Nest,
options: Options ] =
BEGIN
Must generate one statement.
IF needsOpProc[elementType]
THEN
BEGIN
indexName: String = Private.UniqueName[
root: "element", marshalInfo: marshalInfo];
elementName: String = IO.PutFR["%g[%g]", [rope[vectorName]], [rope[indexName]]];
WFSL[Indent[nest], "FOR "--L--, indexName, ": "--L--];
Declare.WriteTypeName[indexType];
WFS1[" IN "--L--];
SELECT vectorInfo.type
FROM
Array => Declare.WriteTypeName[indexType];
Descriptor, Sequence =>
BEGIN
WFS1["[FIRST["--L--]; Declare.WriteTypeName[indexType];
WFS1["]..FIRST["--L--]; Declare.WriteTypeName[indexType];
WFSL["]+LENGTH["
--L--,
(IF vectorInfo.type=Sequence THEN "DESCRIPTOR["--L-- ELSE ""--L--),
vectorName,
(IF vectorInfo.type=Sequence THEN "]"--L-- ELSE ""--L--),
"])"--L--];
END;
ENDCASE => ERROR;
WFS1[" DO\n"--L--];
opProc[ nest: nest+1,
name: elementName, type: elementType,
parentInfo: [vectorName, vectorInfo],
marshalInfo: marshalInfo,
options: options ];
WFL[nest+1, "ENDLOOP; -- FOR "--L--, indexName, "."--L--];
END;
END;
Managing deferred Marshal Types.
SavedMarshalProc: TYPE = REF SavedMarshalProcRec;
SavedMarshalProcRec:
TYPE =
RECORD [
marshalProcName: String←NIL,
marshalProcBody: String←NIL
];
dummyMarshalProcRec: SavedMarshalProc←
NEW[SavedMarshalProcRec←[]];
InitMarshalTypes:
PUBLIC
PROC = {
marshalTypes ← RefTab.Create[];
};
MarshalProcStream:
PROC[typeInfo:
ST.TypeInfo, marshalInfo: Private.MarshalInfo]
RETURNS [marshalProcStream: IO.STREAM←NIL, marshalProcName: String←NIL ] = {
smp: SavedMarshalProc;
new: BOOL;
[smp, new] ← GetSavedMarshalProc[typeInfo, marshalInfo];
IF smp=NIL THEN RETURN;
marshalProcName ← smp.marshalProcName;
IF new AND smp.marshalProcName#NIL THEN marshalProcStream ← IO.ROS[];
};
SaveMarshalProc:
PROC[
typeInfo: ST.TypeInfo, marshalInfo: Private.MarshalInfo, marshalProcStream: IO.STREAM] = {
smp: SavedMarshalProc;
smp ← GetSavedMarshalProc[typeInfo, marshalInfo].smp;
IF smp.marshalProcBody#NIL THEN ERROR;
smp.marshalProcBody ← marshalProcStream.RopeFromROS[];
};
GetSavedMarshalProc:
PROC[typeInfo:
ST.TypeInfo, marshalInfo: Private.MarshalInfo]
RETURNS[smp: SavedMarshalProc←NIL, new: BOOL←FALSE]= {
OPEN IO;
typeStr: String;
marshalProcName: String;
marshalProcID: ATOM;
typeID: ST.TypeID = ST.MakeTypeID[typeInfo.self];
IF typeID.stamp.time = 0 THEN RETURN; -- Not a named type
typeStr ←
IO.PutFR["[%g, %g]%g.%g",
card[typeID.stamp.net],
card[typeID.stamp.host],
card[typeID.stamp.time],
card[LONG[LOOPHOLE[typeID.sei, CARDINAL]]]
];
IF marshalInfo.direction=fromPkt THEN typeStr ← typeStr.Cat[".Un"];
marshalProcID ← Atom.MakeAtom[typeStr];
smp ← NARROW[marshalTypes.Fetch[marshalProcID].val];
IF smp#NIL THEN RETURN;
new←TRUE;
marshalProcName ← GetUniqueTypeName[typeInfo.self,
IF marshalInfo.direction=toPkt THEN "Marshal" ELSE "Unmarshal"];
smp ← NEW[SavedMarshalProcRec ← [marshalProcName, NIL]];
[] ← marshalTypes.Store[marshalProcID, smp];
};
WriteMarshalProcs:
PUBLIC
PROC = {
WriteMarshalProc: RefTab.EachPairAction =
TRUSTED {
WFS[NARROW[val, SavedMarshalProc].marshalProcBody];
RETURN[FALSE];
};
[]←RefTab.Pairs[marshalTypes, WriteMarshalProc];
InitMarshalTypes[];
};
MakeRefsNil: OperationProc =
BEGIN
Make only refs in safe storage NIL, not those in pkts.
IF marshalInfo.direction=fromPkt
AND Private.ContainsRefs[type: type]
THEN
BEGIN
WFL1[nest, "-- Restore garbled REFs to NIL following copy."--L--];
AssignNilToRefs[ nest: nest,
name: name, type: type,
parentInfo: parentInfo, marshalInfo: marshalInfo,
options: options ];
END;
END;
AssignNilToRefs: OperationProc =
BEGIN
typeInfo: ST.TypeInfo = ST.GetTypeInfo[type: type];
SELECT marshalInfo.paramFieldInfo.passingMethod
FROM
Handle => NULL;
InterMds => ERROR;
Var, Value, Result =>
WITH typeInfo: typeInfo
SELECT
FROM
Null, Definition, Basic,
Pointer, RelativePtr, String, StringBody, Text,
Any, Opaque, Zone, Other => NULL;
Ref, List, Rope, Atom, Transfer =>
WFLL[nest,
"LOOPHOLE["--L--, name, ", "--L--,
(IF typeInfo.type#Transfer THEN "LONG "--L-- ELSE ""--L--),
"POINTER] ← NIL;"--L-- ];
Record =>
DoRecordOperation[ nest: nest,
opProc: AssignNilToRefs, needsOpProc: Private.ContainsRefs,
recName: name,
recInfo: typeInfo,
marshalInfo: marshalInfo,
options: options ];
VariantPart =>
DoVariantOperation[ nest: nest,
opProc: AssignNilToRefs, needsOpProc: Private.ContainsRefs,
varName: name,
varInfo: typeInfo,
marshalInfo: marshalInfo,
options: options ];
Array =>
DoVectorOperation[ nest: nest,
opProc: AssignNilToRefs, needsOpProc: Private.ContainsRefs,
vectorName: name,
vectorInfo: typeInfo,
indexType: typeInfo.indexType, elementType: typeInfo.elementType,
marshalInfo: marshalInfo,
options: options ];
Descriptor =>
DoVectorOperation[ nest: nest,
opProc: AssignNilToRefs, needsOpProc: Private.ContainsRefs,
vectorName: name,
vectorInfo: typeInfo,
indexType: typeInfo.indexType, elementType: typeInfo.elementType,
marshalInfo: marshalInfo,
options: options ];
Sequence =>
DoVectorOperation[ nest: nest,
opProc: AssignNilToRefs, needsOpProc: Private.ContainsRefs,
vectorName: name,
vectorInfo: typeInfo,
indexType: typeInfo.indexType, elementType: typeInfo.elementType,
marshalInfo: marshalInfo,
options: options ];
ENDCASE => ERROR;
ENDCASE => ERROR;
END;
FieldName:
PROCEDURE [
recordName: String ← "record",
recordType: ST.TypeHandle,
fieldSymbol: ST.SymbolHandle,
anonOk: BOOLEAN ← FALSE ]
RETURNS [recordDotField: String ← NIL] =
BEGIN
IF anonOk
OR ~
ST.IsAnonymous[symbol: fieldSymbol]
THEN recordDotField ← recordName.Cat[".", ST.SymbolName[fieldSymbol]]
ELSE
BEGIN
Private.Error[code: AnonymousIdentifier, type: recordType];
recordDotField ← "record.unnamedField";
END;
END;
sS: IO.STREAM ← IO.ROS[];
GetUniqueTypeName:
PROC[type: LupineSymbolTable.TypeHandle, prefix: String←
NIL]
RETURNS[name: String] = {
Put:
PROC[c:
CHAR] =
{ IF c='. THEN sS.PutRope["Dot"] ELSE sS.PutChar[c] };
sS ← IO.ROS[sS];
IF prefix#NIL THEN sS.PutRope[prefix];
ST.PutTypeName[
putProc: Put,
type: type,
rootInterfaceOpenName: ModuleName[openedInterface] ];
RETURN[sS.RopeFromROS[close: FALSE]];
};
WriteUniqueTypeName:
PROC[type: LupineSymbolTable.TypeHandle] = {
WFS[GetUniqueTypeName[type, NIL]];
};