-- File [Ivy]<Nelson>Lupine>LupineMarshalUtilityImpl.mesa.
-- Last edited by BZM on 11-May-82 16:15:50.
-- This module cooperates with LupineMarshal*Impl to export LupineMarshal.
DIRECTORY
CWF USING [WF1, SWF1],
LupineDeclare USING [WriteTypeName],
LupineManagerPrivate USING [
AllocString, ErrorCode, ErrorType, ExplanationProc, GiveExplanation,
Indent, IsNull, MaxIdentifierLength,
Nest, Options, ReportError,
String, StringNIL,
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 ];
LupineMarshalUtilityImpl: PROGRAM
IMPORTS
CWF, Declare: LupineDeclare, LupineManagerPrivate,
Marshal: LupineMarshal, ST: LupineSymbolTable
EXPORTS LupineMarshal, LupineMarshalPrivate
= BEGIN OPEN
LupineManagerPrivate, LupineMarshal, Private: LupineMarshalPrivate;
-- Types from the internal LupineManagerPrivate interface.
ParentInfo: TYPE = Private.ParentInfo;
MarshalInfo: TYPE = Private.MarshalInfo;
SubStrings: TYPE = Private.SubStrings;
-- Routines for handling parameter storage allocation and deallocation.
ZoneString: TYPE = STRING ← NIL;
ZoneStrings: ARRAY {ptrType, vector, counter, maxCount, zone} OF
PACKED ARRAY AllocZone OF ZoneString = [
--prefix: ["gc", "heap", "mds"],
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 ]
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."L];
newNest ← nest + 1;
Deallocate[heap, p.allocInfo[heap], newNest+1];
Deallocate[mds, p.allocInfo[mds], newNest+1];
WFL1[newNest+1, "END; -- Free storage."L];
END;
END;
EndAllocation: PUBLIC PROCEDURE [
paramInfo: ParamInfo,
justCloseBlocks: BOOLEAN←FALSE,
nest: Nest ]
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."L];
newNest ← nest - 1;
SELECT TRUE FROM
justCloseBlocks => NULL; -- ALWAYS do nothing.
~paramInfo.options.freeServerArguments => NULL;
-- Asked to do nothing.
ENDCASE =>
BEGIN
Deallocate[heap, p.allocInfo[heap], newNest];
Deallocate[mds, p.allocInfo[mds], newNest];
END;
END;
END;
WriteNEW: PUBLIC PROCEDURE [
allocOp: Private.AllocationOperation ← new,
ptrInfo: ST.TypeInfo,
marshalInfo: --VAR-- MarshalInfo] =
BEGIN
-- For gc storage, write "zone.NEW".
-- For heap and MDS storage, write "allocVector[index] ← zone.NEW".
-- Index is either a number (eg, 3) or a conditional expression that
-- checks overflow (eg, IF (index←index+1) < Max THEN index ELSE ERROR).
zone: AllocZone;
AllocOpCode: PACKED ARRAY Private.AllocationOperation OF STRING = [
new: "NEW"L, cons: "CONS"L, list: "LIST"L ];
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 marshalInfo.paramInfo.transferSite=callee
THEN BEGIN
WFS[ZoneStrings[vector][zone], "["L];
IF maxAllocInfo[zone].isDynamic
THEN WFSL[
"(IF ("L, ZoneStrings[counter][zone], " ← "L,
ZoneStrings[counter][zone], "+1) <= "L,
ZoneStrings[maxCount][zone],
" THEN "L, ZoneStrings[counter][zone],
" ELSE Lupine.UnmarshalingExprError[])"L ]
ELSE BEGIN
allocVectorIndex: LONG INTEGER ←
IF marshalInfo.numAllocs[zone] < maxAllocInfo[zone].number
THEN (marshalInfo.numAllocs[zone] ←
marshalInfo.numAllocs[zone] + 1)
ELSE ERROR;
CWF.WF1["%LD"L, @allocVectorIndex];
END;
WFS1["] ← "L];
END; -- IF marshalInfo.paramInfo.transferSite=callee.
END; -- Pointer, String, Descriptor.
ENDCASE => ERROR;
WFS[ZoneStrings[zone][zone], "."L, 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 = "L];
CWF.WF1["%LD;*N"L, @totalAllocs];
IF allocDetails.isDynamic
THEN WFL[nest, ZoneStrings[counter][zone], ": CARDINAL ← 0;"L];
WFSL[Indent[nest],
ZoneStrings[vector][zone],
": ARRAY [1.."L, ZoneStrings[maxCount][zone], "] OF "L,
ZoneStrings[ptrType][zone], "←ALL[NIL];*N"L];
END; -- DeclareArray.
Deallocate: PROCEDURE [
zone: AllocZone, allocDetails: AllocDetails, nest: Nest] =
BEGIN
IF allocDetails.number <= 0 THEN RETURN;
WFSL[Indent[nest],
"FOR ptr: CARDINAL IN [1..LENGTH["L, ZoneStrings[vector][zone],
"]] DO*N"L, Indent[nest+1],
"IF "L, ZoneStrings[vector][zone], "[ptr] = NIL*N"L, Indent[nest+2],
"THEN EXIT*N"L, Indent[nest+2],
"ELSE "L, ZoneStrings[zone][zone], ".FREE[@"L,
ZoneStrings[vector][zone], "[ptr]];*N"L,
Indent[nest+1], "ENDLOOP;*N"L];
END; -- Deallocate.
-- Code generation for runtime copying routines.
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"L];
InsureContiguousWords[wordsNeeded, marshalInfo, nest];
IF nullValue
THEN WFL1[nest, "-- Ignore value and skip ahead in pkt."L]
ELSE SELECT marshalInfo.direction FROM
toPkt =>
WFSL[ Indent[nest],
varNames.pkt, ".data["L, varNames.pktLength, "] ← "L,
value.s1, value.s2, value.s3, "; "L ];
fromPkt =>
WFSL[ Indent[nest],
value.s1, value.s2, value.s3,
" ← "L, varNames.pkt, ".data["L, varNames.pktLength, "]; "L ];
ENDCASE => ERROR;
WFSL[varNames.pktLength, " ← "L, varNames.pktLength, "+1;*N"L];
IF oneStmt THEN WFL1[nest, "END;"L];
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"L,
rpcRuntime: "RpcPktDoubleWord"L ];
IF oneStmt THEN WFL1[nest, "BEGIN"L];
InsureContiguousWords[wordsNeeded, marshalInfo, nest];
IF nullValue
THEN WFL1[nest, "-- Ignore value and skip ahead in pkt."L]
ELSE SELECT marshalInfo.direction FROM
toPkt =>
WFSL[ Indent[nest],
"Lupine."L, DoubleWordRoutine[marshalInfo.paramInfo.pktSite],
"["L, varNames.pkt, ", "L, varNames.pktLength,
"]↑ ← "L, value.s1, value.s2, value.s3, ";*N"L ];
fromPkt =>
WFSL[ Indent[nest],
value.s1, value.s2, value.s3,
" ← Lupine."L, DoubleWordRoutine[marshalInfo.paramInfo.pktSite],
"["L, varNames.pkt, ", "L, varNames.pktLength, "]↑;*N"L ];
ENDCASE => ERROR;
WFLL[nest, varNames.pktLength, " ← "L, varNames.pktLength, " + 2;"L];
IF oneStmt THEN WFL1[nest, "END;"L];
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: AllocString = [10];
CWF.SWF1[words, "%LD"L, @wordsNeeded];
WFLL[nest,
"IF "L, varNames.pktLength, "+"L, words,
" > RpcPrivate.maxDataLength"L];
WFSL[Indent[nest+1],
"THEN "L, varNames.pktLength, " ← Lupine."L,
(SELECT marshalInfo.direction FROM
toPkt => "StartNextPkt"L, fromPkt => "FinishThisPkt"L, ENDCASE => ERROR),
"[pkt: "L, varNames.pkt, ", pktLength: "L, varNames.pktLength,
"];*N"L ];
END;
END;
CopyCharacters: PUBLIC PROCEDURE [
textName: SubStrings,
numCharsName: String,
marshalInfo: MarshalInfo,
nest: Nest ] =
BEGIN OPEN varNames: marshalInfo.varNames;
WFSL[Indent[nest],
varNames.pktLength,
" ← Lupine."L, Routine[marshalInfo.direction],
"[pkt: "L, varNames.pkt,
", pktLength: "L, varNames.pktLength,
", dataAdr: "L, textName.s1, textName.s2, textName.s3,
", dataLength: Lupine.WordsForChars["L, numCharsName,
"], alwaysOnePkt: "L, Truth[marshalInfo.paramInfo.alwaysOnePkt],
"];*N"L];
END;
CopyUninterpreted: PUBLIC PROCEDURE [
variableName: String,
variableInfo: ST.TypeInfo,
parentInfo: ParentInfo,
marshalInfo: MarshalInfo,
nest: Nest ] =
BEGIN
-- CopyUninterpreted must generate exactly one statement.
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 =>
-- Treat these as handles by copying just the pointer.
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
-- CopyType must generate exactly one statement.
WITH variableInfo: variableInfo SELECT FROM
Null => WFL1[nest, "NULL;"L];
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."L, Routine[marshalInfo.direction],
"[pkt: "L, varNames.pkt,
", pktLength: "L, varNames.pktLength,
", dataAdr: "L];
WriteAddress[name, typeInfo.type, interpret, parentInfo]; WFS1[
", dataLength: "L];
WriteSize[name, typeInfo, interpret]; WFS[
", alwaysOnePkt: "L, Truth[marshalInfo.paramInfo.alwaysOnePkt],
"];*N"L];
END;
WriteAddress: PROCEDURE [
name: String, type: ST.Types, interpret: BOOLEAN, parentInfo: ParentInfo] =
BEGIN
SELECT type FROM
Array, Descriptor =>
IF interpret THEN WFS["BASE["L, name, "]"L] ELSE WFS["@"L, name];
Sequence => IF interpret
THEN WFS["BASE[DESCRIPTOR["L, name, "]]"L] ELSE WFS["@"L, name];
ENDCASE =>
-- Check for @name↑, which can have type REF and not LONG POINTER.
IF name[name.length-1] = '↑
THEN SELECT parentInfo.typeInfo.type FROM
Ref => WFS["LOOPHOLE["L, parentInfo.name, "]"L];
Pointer => WFS1[parentInfo.name];
ENDCASE => ERROR
ELSE WFS["@"L, name];
END;
WriteSize: PROCEDURE [
name: String, typeInfo: ST.TypeInfo, interpret: BOOLEAN ] =
BEGIN
DynamicArraySize: PROC [
arrayName: SubStrings, elementType: ST.TypeHandle, packed: BOOLEAN] =
BEGIN
WFS1["SIZE["L];
Declare.WriteTypeName[elementType];
IF packed
THEN WFSL[", LENGTH["L, arrayName.s1, arrayName.s2, arrayName.s3, "]]"L]
ELSE WFSL["]**LENGTH["L, arrayName.s1, arrayName.s2, arrayName.s3, "]"L];
END; -- DynamicArraySize.
IF interpret
THEN WITH typeInfo: typeInfo SELECT FROM
Record =>
BEGIN
-- Sequences can complicate record lengths. But variants don't
-- (yet) because everything is done in terms of unbound variants.
WFS1["SIZE["L];
Declare.WriteTypeName[typeInfo.self];
IF typeInfo.hasSequences THEN WFS["[LENGTH[DESCRIPTOR["L, name, "]]]"L];
WFS1["]"L];
END;
Descriptor => -- Variable length and packing make the size tricky.
DynamicArraySize[ [name], typeInfo.elementType, typeInfo.packed];
Sequence => -- Ditto.
DynamicArraySize[ SubStrings["DESCRIPTOR"L, name, "]"L],
typeInfo.elementType, typeInfo.packed];
ENDCASE =>
{WFS1["SIZE["L]; Declare.WriteTypeName[typeInfo.self]; WFS1["]"L]}
ELSE {WFS1["SIZE["L]; Declare.WriteTypeName[typeInfo.self]; WFS1["]"L]};
END;
-- Marshaling Error Routines.
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,
type: ST.TypeHandle,
string: String,
causeError: BOOLEAN ] =
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
problemString: AllocString = [MaxIdentifierLength];
problemText: String ← NIL;
SELECT TRUE FROM
symbol # ST.SymbolHandleNIL =>
problemText ← ST.SymbolName[symbol, problemString];
type # ST.TypeHandleNIL =>
BEGIN
FillProblem: PROC [chr: CHARACTER] =
BEGIN
IF problemString.length >= problemString.maxlength THEN RETURN;
problemString[problemString.length] ← chr;
problemString.length ← problemString.length + 1;
END;
ST.PutTypeName[type: type, putProc: FillProblem];
IF problemString.length > problemString.maxlength-3
THEN BEGIN
problemString[problemString.maxlength-3] ←
problemString[problemString.maxlength-2] ←
problemString[problemString.maxlength-1] ← '.;
problemString.length ← problemString.maxlength;
END;
problemText ← problemString;
END;
ENDCASE => problemText ← string;
ReportError[type: errorType, code: errorCode, problemText: problemText];
BEGIN
CodeFileMessage: ExplanationProc =
BEGIN
WFSL[
"-- ##### "L,
(SELECT errorType FROM
error => "Error: "L, warning => "Warning: "L,
abort => "Abort: "L, ENDCASE => ERROR),
explanation,
"*BIdentifier or type = "L,
(IF IsNull[problemText] THEN "<Not Available>"L ELSE problemText),
". --"L,
(IF causeError THEN " Lupine.TranslationError;"L ELSE ""L),
"*N"L ];
END; -- CodeFileMsg.
GiveExplanation[code: errorCode, explainer: CodeFileMessage];
END;
END;
-- Utility enumerators.
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;