
<<LupineMarshalTypeConstructorImpl.mesa.>>
    <<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
<<Last edited by>>
<<BZM on March 18, 1982  11:18 AM.>>
    <<Birrell, September 8, 1983 4:38 pm>>
    <<Swinehart, July 13, 1984 6:16:22 pm PDT>>
    <<Bob Hagmann May 16, 1985 3:08:22 pm PDT>>

<<This module cooperates with LupineMarshal*Impl to export LupineMarshal.>>

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 ],
Rope USING [Cat, ROPE];


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;


<<Marshaling routines for type constructors (i.e., nonbuiltin types).>>

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[];
};


<<Marshaling utility routines.>>

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]];
};


END.  -- LupineMarshalTypeConstructorImpl.