LupineDeclareStubsImpl.mesa.
Copyright © 1985 by Xerox Corporation. All rights reserved.
Last edited by
BZM on 14-May-82 13:06:34.
Birrell, September 9, 1983 3:41 pm
Bob Hagmann February 12, 1985 12:57:01 pm PST
This module cooperates with LupineDeclare*Impl to export LupineDeclare.
DIRECTORY
IO USING [PutFR],
LupineDeclare USING [
DispatcherType, PktSite,
TransferDeclaration, TransferName, TransferSite,
WriteParameterName, WriteTypeName ],
LupineDeclarePrivate USING [DispatcherName, GetString],
LupineManagerPrivate USING [
Indent, IsNull,
Nest, Options, String, StringNIL,
WF1, WFL, WFL1, WFLL, WFS, WFS1, WFSL ],
LupineMarshal USING [
BeginAllocation, EndAllocation,
EnumerateParams, FieldInfo, FreeParamInfo, FromPacket,
MakeParamInfo, ParamProcedure, ParamInfo, ParamIndex, ParamLocation,
ToPacket, VariableNames, Words ],
LupineSymbolTable USING [
GetTypeInfo, IsAnonymous, SymbolHandle,
TransferTypes, TypeHandle, TypeInfo ],
Rope USING[ Equal ];
LupineDeclareStubsImpl: PROGRAM
IMPORTS
IO, Declare: LupineDeclare, LupineManagerPrivate,
Marshal: LupineMarshal, Private: LupineDeclarePrivate,
ST: LupineSymbolTable, Rope
EXPORTS LupineDeclare
= BEGIN OPEN LupineManagerPrivate, LupineDeclare;
ParamInfo: TYPE = Marshal.ParamInfo;
ParamLocation: TYPE = Marshal.ParamLocation;
TransferInfo: TYPE = Transfer ST.TypeInfo;
Public code generation routines.
ProcedureStub: PUBLIC PROCEDURE [
transfer: ST.SymbolHandle,
transferType: ST.TypeHandle,
transferDeclaration: TransferDeclaration,
signalDispatcherType: DispatcherType,
options: Options,
nest: Nest ] =
BEGIN
procName: String = Declare.TransferName[transfer];
transferPrefix: String ← StringNIL;
extraFirstArg: String ← StringNIL;
transferInfo: TransferInfo = GetTransferInfo[transferType];
argInfo, resultInfo: ParamInfo;
[argInfo, resultInfo] ← GetArgResultInfo[
transferInfo: transferInfo,
transferDeclaration: transferDeclaration,
transferSite: caller, pktSite: rpcRuntime,
options: options ];
BEGIN ENABLE UNWIND => FreeArgResultInfo[argInfo, resultInfo];
WFS1["\n"];
IF options.targetLanguage = Cedar AND options.importMultiple THEN {
transferPrefix ← "clientStub";
extraFirstArg ← "interface: RpcControl.InterfaceRecord";
};
TransferHeader[ nest: nest,
transferPrefix: transferPrefix,
transferName: procName,
transferInfo: transferInfo,
argInfo: argInfo, resultInfo: resultInfo,
extraFirstArg: extraFirstArg,
public: transferDeclaration=inInterface,
options: options ];
WFS1[" =\n"];
CallingStubBody[ nest: nest+1,
transferName: procName, blockName: procName,
transferInfo: transferInfo,
signalDispatcher: Private.DispatcherName[signalDispatcherType],
argInfo: argInfo, resultInfo: resultInfo, options: options];
END; -- ENABLE UNWIND.
FreeArgResultInfo[argInfo, resultInfo];
END;
DispatcherStubArm: PUBLIC PROCEDURE [
transfer: ST.SymbolHandle,
transferType: ST.TypeHandle,
transferDeclaration: TransferDeclaration,
options: Options,
nest: Nest ] =
BEGIN
transferName: String = Declare.TransferName[transfer];
WFSL[ Indent[nest], transferName, " => RETURN[\n",
Indent[nest+1], transferName, "Stub[",
Private.GetString[dispatcherArgs], "]];\n" ];
END;
DispatcherStubBody: PUBLIC PROCEDURE [
transfer: ST.SymbolHandle,
transferType: ST.TypeHandle,
transferDeclaration: TransferDeclaration,
inlineBody: BOOLEAN,
options: Options,
nest: Nest ] =
BEGIN
transferName: String = Declare.TransferName[transfer];
transferInfo: TransferInfo = GetTransferInfo[transferType];
argInfo, resultInfo: ParamInfo;
stubName: String = IO.PutFR["%gStub", [rope[transferName]]];
The stubName here must agree with that used in DispatcherStubArm.
[argInfo, resultInfo] ← GetArgResultInfo[
transferInfo: transferInfo,
transferDeclaration: transferDeclaration,
transferSite: callee, pktSite: rpcRuntime,
options: options ];
BEGIN ENABLE UNWIND => FreeArgResultInfo[argInfo, resultInfo];
WFSL["\n", Indent[nest], stubName, ": "];
TransferType[ nest: nest,
transferInfo: transferInfo,
argInfo: argInfo, resultInfo: resultInfo,
extraFirstArg: StringNIL,
printAsComment: TRUE,
options: options ];
WFS1[" RpcPrivate.Dispatcher =\n"];
CalledStubBody[ nest: nest+1,
transferName: transferName, blockName: stubName,
transferInfo: transferInfo,
inlineBody: inlineBody,
argInfo: argInfo, resultInfo: resultInfo,
options: options ];
END; -- ENABLE UNWIND.
FreeArgResultInfo[argInfo, resultInfo];
END;
SignalCode: PUBLIC PROCEDURE [
transfer: ST.SymbolHandle,
transferType: ST.TypeHandle,
transferDeclaration: TransferDeclaration,
options: Options,
nest: Nest ] =
BEGIN
transferInfo: TransferInfo = GetTransferInfo[transferType];
argInfo, resultInfo: ParamInfo;
[argInfo, resultInfo] ← GetArgResultInfo[
transferInfo: transferInfo,
transferDeclaration: transferDeclaration,
transferSite: caller, pktSite: stubFrame,
options: options ];
BEGIN ENABLE UNWIND => FreeArgResultInfo[argInfo, resultInfo];
WFS1["\n"];
TransferHeader[ nest: nest,
transferPrefix: StringNIL,
transferName: Declare.TransferName[transfer],
transferInfo: transferInfo,
argInfo: argInfo, resultInfo: resultInfo,
extraFirstArg: StringNIL,
public: transferDeclaration=inInterface,
options: options ];
WFS1[" = CODE;\n"];
END; -- ENABLE UNWIND.
FreeArgResultInfo[argInfo, resultInfo];
END; -- SignalCode.
SignalCatchStub: PUBLIC PROCEDURE [
transfer: ST.SymbolHandle,
transferType: ST.TypeHandle,
transferDeclaration: TransferDeclaration,
signalDispatcherType: DispatcherType ← none,
options: Options,
nest: Nest ] =
BEGIN
signalName: String = Declare.TransferName[transfer];
transferInfo: TransferInfo = GetTransferInfo[transferType];
argInfo, resultInfo: ParamInfo;
[argInfo, resultInfo] ← GetArgResultInfo[
transferInfo: transferInfo,
transferDeclaration: transferDeclaration,
transferSite: caller, pktSite: rpcRuntime,
options: options ];
BEGIN ENABLE UNWIND => FreeArgResultInfo[argInfo, resultInfo];
WFSL["\n", Indent[nest], signalName, " "];
TransferType[ nest: nest,
printAsComment: TRUE,
transferInfo: transferInfo,
argInfo: argInfo, resultInfo: resultInfo,
extraFirstArg: StringNIL,
options: options ];
WFS1[" =>\n"];
CallingStubBody[ nest: nest+1,
transferName: signalName, blockName: signalName,
transferInfo: transferInfo,
signalDispatcher: Private.DispatcherName[signalDispatcherType],
argInfo: argInfo, resultInfo: resultInfo,
options: options ];
END; -- ENABLE UNWIND.
FreeArgResultInfo[argInfo, resultInfo];
END;
Detailed code generation utilities.
TransferHeader: PROCEDURE [
transferPrefix: String,
transferName: String,
transferInfo: TransferInfo,
argInfo, resultInfo: ParamInfo,
extraFirstArg: String,
public: BOOLEAN,
nest: Nest,
options: Options ] =
BEGIN
WFSL[Indent[nest], transferPrefix, transferName,
(IF public THEN ": PUBLIC " ELSE ": "),
(IF transferInfo.safe THEN "SAFE " ELSE "") ];
TransferType[nest: nest,
transferInfo: transferInfo, argInfo: argInfo, resultInfo: resultInfo, extraFirstArg: extraFirstArg, options: options];
END;
TransferType: PROCEDURE [
transferInfo: TransferInfo,
argInfo, resultInfo: ParamInfo,
extraFirstArg: String,
printAsComment: BOOLEAN←FALSE,
nest: Nest,
options: Options ] =
BEGIN
TransferTypeName: ARRAY ST.TransferTypes OF String = [
Procedure: "PROCEDURE", Error: "ERROR", Signal: "SIGNAL",
Port: "PORT", Program: "PROGRAM", Process: "PROCESS",
Other: "<<<ERROR>>>" ];
WFS[ (IF printAsComment THEN "--" ELSE ""),
TransferTypeName[transferInfo.kind],
(IF argInfo.paramCount>0 OR resultInfo.paramCount>0 THEN " " ELSE "")];
FullParameterList[ nest: nest,
argInfo: argInfo, resultInfo: resultInfo,
extraFirstArg: extraFirstArg,
printingComment: printAsComment,
options: options ];
IF printAsComment THEN WFS1["--"];
END;
Generate Client procedure stubs and Server catch-phrase stubs.
CallingStubBody: PROCEDURE [
transferName, blockName: String,
transferInfo: TransferInfo,
signalDispatcher: String,
argInfo, resultInfo: ParamInfo,
nest: Nest,
options: Options ] =
BEGIN
CallPkt: String = "pkt"; -- For signal stubs, this must be = Dispatcher's pkt.
ReturnPkt: String = "pkt"; -- For signal stubs, ...
CallLength: String = "pktLength";
pktSize: INT;
pktOnStack: BOOL ← TRUE;
ReturnLength: String --must equal-- = CallLength;
ReturnLimit: String = "returnLimit"; -- Not used at this time.
LastPkt: String = "lastPkt";
ArgPtr: String = "argPkt";
ResultPtr: String = "resPkt";
CallVars: Marshal.VariableNames = [
pkt: CallPkt, overlayPtr: ArgPtr,
pktLength: CallLength, pktLimit: "",
lastPkt: LastPkt ];
ReturnVars: Marshal.VariableNames = [
pkt: ReturnPkt, overlayPtr: ResultPtr,
pktLength: ReturnLength, pktLimit: ReturnLimit,
lastPkt: LastPkt ];
WFL[nest, (IF transferInfo.safe THEN "TRUSTED " ELSE ""), "BEGIN"];
SELECT transferInfo.kind FROM
Signal, Error =>
BEGIN
ParamsAsLocalVars[paramInfo: argInfo, ...];
Anonymous signal arguments are impossible to handle,
the compiler will complain.
ParamsAsLocalVars [ nest: nest,
paramInfo: resultInfo, doOnlyAnonymousParams: TRUE, options: options ];
Declare locals corresponding to anon. AC result parameters.
END;
Procedure =>
BEGIN
ParamsAsLocalVars[paramInfo: argInfo, ...];
All argument declarations already performed in the PROC header.
ParamsAsLocalVars [ nest: nest,
paramInfo: resultInfo, doOnlyAddressParams: TRUE, options: options ];
AC results are not declared in the PROC header when there are
any static results (this saves space). Declare them now.
END;
ENDCASE => ERROR;
OverlayRecord[
paramInfo: argInfo, transferIndexName: transferName, nest: nest ];
OverlayRecord[paramInfo: resultInfo, nest: nest];
SELECT transferInfo.kind FROM
Signal, Error =>
These reuse the Dispatcher's call pkt.
IF ~Rope.Equal[CallPkt, Private.GetString[dispatcherPkt]]
THEN ERROR;
ENDCASE => {
Procedures (and the rest) use a freshly declared pkt.
pktSize ← MAX[argInfo.sizeOf.pktToAllocate, resultInfo.sizeOf.pktToAllocate];
pktOnStack ← LocalPacket[ nest: nest,
pktName: CallPkt,
size: pktSize,
options: options ];
};
IF ~Rope.Equal[CallPkt, ReturnPkt]
THEN WFLL[nest, ReturnPkt, ": RpcPrivate.StubPkt = ", CallPkt, ";"];
OverlayPointer[ nest: nest,
paramInfo: argInfo,
pktName: CallPkt, overlayPtrName: ArgPtr,
do: both ];
OverlayPointer[ nest: nest,
paramInfo: resultInfo,
pktName: ReturnPkt, overlayPtrName: ResultPtr,
do: both ];
PacketLength[ nest: nest,
paramInfo: argInfo,
pktLengthName: CallLength,
declare: yes, assign: yes ];
WFL[nest, LastPkt, ": BOOLEAN;"];
SELECT transferInfo.kind FROM
Procedure =>
BEGIN
IF options.targetLanguage = Cedar AND ~pktOnStack THEN {
-- Wrap an extra BEGIN block around the body, and put an UNWIND to deallocate the buffer
WFS[Indent[nest], "BEGIN ENABLE UNWIND => RpcPrivate.DeAlloc[LOOPHOLE[pkt], RpcPrivate.pktOverhead"];
WF1["+%g];\n", [integer[pktSize]]];
nest ← nest + 1;
};
WFSL[Indent[nest], "RpcPrivate.StartCall[callPkt: ", CallPkt];
IF options.targetLanguage = Cedar AND options.importMultiple
THEN WFS1[", interface: interface.myInterface"]
ELSE WFS1[", interface: myInterface"];
IF argInfo.hasConversation THEN DoConversationArg[argInfo];
WFS1["];\n"];
END;
Signal, Error =>
WFL[nest, "RpcPrivate.StartSignal[signalPkt: ", CallPkt, "];"];
ENDCASE => ERROR;
IF ~argInfo.hasOverlayParams
THEN WFLL[nest, ArgPtr, ".transferIndex ← ", transferName, ";"];
Marshal.ToPacket[ nest: nest,
paramInfo: argInfo,
overlayHandling: [static: copyToPkt],
varNames: CallVars,
options: options ];
WFSL[Indent[nest],
"[returnLength: , lastPkt: ", LastPkt,
"] ←\n", Indent[nest+1],
"RpcPrivate.Call[ pkt: ", CallPkt, ", callLength: ", CallLength,
",\BmaxReturnLength: "];
WF1["%g", [integer[resultInfo.sizeOf.pktToAllocate]]];
IF ~IsNull[signalDispatcher]
THEN WFS[", signalHandler: ", signalDispatcher];
WFS1["];\n"];
PacketLength[ nest: nest,
paramInfo: resultInfo,
pktLengthName: ReturnLength,
declare: no, assign: ifNeeded ];
SELECT TRUE FROM
resultInfo.transferType=Error =>
WFL1[nest, "Lupine.RuntimeError; -- Impossible to RESUME an ERROR."];
resultInfo.alwaysOnePkt =>
BEGIN
Marshal.FromPacket[ nest: nest,
paramInfo: resultInfo,
overlayHandling: [static: copyToFrame],
varNames: ReturnVars,
options: options ];
DeAllocPkt[nest: nest, options: options, transferInfo: transferInfo, pktSize: pktSize, pktOnStack: pktOnStack];
ReturnStmt[ nest: nest,
type: transferInfo.kind,
resultInfo: resultInfo,
resultOverlayPtr: ResultPtr,
staticResults: inFrame ];
END; -- alwaysOnePkt.
resultInfo.alwaysMultiplePkts =>
BEGIN
Marshal.FromPacket[ nest: nest,
paramInfo: resultInfo,
overlayHandling: [static: copyToFrame],
varNames: ReturnVars,
options: options ];
DeAllocPkt[nest: nest, options: options, transferInfo: transferInfo, pktSize: pktSize, pktOnStack: pktOnStack];
ReturnStmt[ nest: nest,
type: transferInfo.kind,
resultInfo: resultInfo,
resultOverlayPtr: ResultPtr,
staticResults: inFrame ];
END; -- alwaysMultiplePkt.
~resultInfo.hasOverlayParamType[static] =>
BEGIN
Could be multiple packets, no statics.
Marshal.FromPacket[ nest: nest,
paramInfo: resultInfo,
overlayHandling: [static: leaveInPkt],
varNames: ReturnVars,
options: options ];
DeAllocPkt[nest: nest, options: options, transferInfo: transferInfo, pktSize: pktSize, pktOnStack: pktOnStack];
ReturnStmt[ nest: nest,
type: transferInfo.kind,
resultInfo: resultInfo,
resultOverlayPtr: ResultPtr,
staticResults: inFrame ];
END; -- One or more packets, no statics.
ENDCASE => -- Could be one or more packets, some statics.
BEGIN
WFL1[nest, "BEGIN -- OnePkt."];
WFL1[nest, " -- Move statics from pkt now."];
Marshal.FromPacket[ nest: nest+1,
paramInfo: resultInfo,
overlayHandling: [static: justCopyToFrame],
varNames: ReturnVars,
options: options ];
Marshal.FromPacket[ nest: nest,
paramInfo: resultInfo,
overlayHandling: [static: leaveInPkt],
varNames: ReturnVars,
options: options ];
DeAllocPkt[nest: nest, options: options, transferInfo: transferInfo, pktSize: pktSize, pktOnStack: pktOnStack];
Return[
type: transferInfo.kind,
resultInfo: resultInfo,
resultOverlayPtr: ResultPtr,
staticResults: inFrame ];
WFS1[";\n"];
WFL1[nest, "END; -- OnePkt."];
END; -- One or more packets.
SELECT transferInfo.kind FROM
Procedure => {
IF options.targetLanguage = Cedar AND ~pktOnStack THEN {
-- End of extra BEGIN block around the body
WFL[nest, "END; -- UNWIND."];
nest ← nest - 1;
};
};
ENDCASE;
WFL[nest, "END; -- ", blockName, "."];
END; -- CallingStubBody.
DoConversationArg: PROCEDURE [argInfo: ParamInfo] =
BEGIN
conversationFound: BOOLEAN ← FALSE;
PrintConversationName: Marshal.ParamProcedure =
BEGIN
IF paramFieldInfo.location = inConversation
THEN BEGIN
Declare.WriteParameterName[paramName, paramIndex];
RETURN[stop: (conversationFound ← TRUE)];
END;
END;
WFS1[", localConversation: "];
Marshal.EnumerateParams[paramInfo: argInfo, paramProc: PrintConversationName];
IF ~conversationFound THEN ERROR;
END;
Generate Server procedure stubs and Client signal-raising stubs.
CalledStubBody: PROCEDURE [
transferName, blockName: String,
transferInfo: TransferInfo,
inlineBody: BOOLEAN,
argInfo, resultInfo: ParamInfo,
nest: Nest,
options: Options ] =
BEGIN
CallPkt: String = "pkt"; -- Must be identical to Dispatcher's pkt.
ReturnPkt: String = CallPkt; -- ... pkt.
CallLength: String = "pktLength";
ReturnLength: String --must equal-- = CallLength;
CallLimit: String = "callLimit"; -- Not used at this time.
LastPkt: String = "lastPkt"; -- Must be identical to Dispatcher's lastPkt.
ArgPtr: String = "argPkt";
ResultPtr: String = "resPkt";
CallVars: Marshal.VariableNames = [
pkt: CallPkt, overlayPtr: ArgPtr,
pktLength: CallLength, pktLimit: CallLimit,
lastPkt: LastPkt ];
ReturnVars: Marshal.VariableNames = [
pkt: ReturnPkt, overlayPtr: ResultPtr,
pktLength: ReturnLength, pktLimit: "",
lastPkt: LastPkt ];
WFL[nest, (IF inlineBody THEN "INLINE " ELSE ""), "BEGIN"];
ParamsAsLocalVars[nest: nest, paramInfo: argInfo, options: options];
ParamsAsLocalVars[nest: nest, paramInfo: resultInfo, options: options];
OverlayRecord[paramInfo: argInfo, nest: nest];
OverlayRecord[paramInfo: resultInfo, nest: nest];
IF ~Rope.Equal[CallPkt, Private.GetString[dispatcherPkt]] THEN ERROR;
IF ~Rope.Equal[CallPkt, ReturnPkt] THEN ERROR;
OverlayPointer[ nest: nest,
paramInfo: argInfo,
pktName: CallPkt, overlayPtrName: ArgPtr,
do: both ];
OverlayPointer[ nest: nest,
paramInfo: resultInfo,
pktName: ReturnPkt, overlayPtrName: ResultPtr,
do: IF argInfo.alwaysOnePkt THEN both ELSE declare ];
PacketLength[ nest: nest,
paramInfo: argInfo,
pktLengthName: CallLength,
declare: IF argInfo.transferType=Error THEN ifNeeded ELSE yes,
assign: ifNeeded ];
nest ← Marshal.BeginAllocation[paramInfo: argInfo, nest: nest, options: options];
SELECT TRUE FROM
argInfo.alwaysOnePkt =>
BEGIN
Marshal.FromPacket[ nest: nest,
paramInfo: argInfo,
overlayHandling: [static: leaveInPkt],
varNames: CallVars,
options: options ];
OverlayPointer[ nest: nest,
paramInfo: resultInfo,
pktName: ReturnPkt, overlayPtrName: ResultPtr,
do: argInfo.alwaysOnePkt => assigned above ];
CallStmt[ nest: nest,
transferName: transferName,
type: transferInfo.kind,
argInfo: argInfo, resultInfo: resultInfo,
staticArgs: inPktOverlay, staticResults: inPktOverlay,
argOverlayPtr: ArgPtr, resultOverlayPtr: ResultPtr ];
END; -- alwaysOnePkt.
argInfo.alwaysMultiplePkts =>
BEGIN
Marshal.FromPacket[ nest: nest,
paramInfo: argInfo,
overlayHandling: [static: copyToFrame],
varNames: CallVars,
options: options ];
OverlayPointer[ nest: nest,
paramInfo: resultInfo,
pktName: ReturnPkt, overlayPtrName: ResultPtr,
do: assign ];
CallStmt[ nest: nest,
transferName: transferName,
type: transferInfo.kind,
argInfo: argInfo, resultInfo: resultInfo,
staticArgs: inFrame, staticResults: inPktOverlay,
argOverlayPtr: ArgPtr, resultOverlayPtr: ResultPtr ];
END; -- alwaysMultiplePkt.
~argInfo.hasOverlayParamType[static] =>
BEGIN
Could be multiple packets, no statics.
Marshal.FromPacket[ nest: nest,
paramInfo: argInfo,
overlayHandling: [static: leaveInPkt],
varNames: CallVars,
options: options ];
OverlayPointer[ nest: nest,
paramInfo: resultInfo,
pktName: ReturnPkt, overlayPtrName: ResultPtr,
do: assign ];
CallStmt[ nest: nest,
transferName: transferName,
type: transferInfo.kind,
argInfo: argInfo, resultInfo: resultInfo,
staticArgs: inFrame, staticResults: inPktOverlay,
argOverlayPtr: ArgPtr, resultOverlayPtr: ResultPtr ];
END; -- One or more packets, no statics.
ENDCASE => -- Could be one or more packets, some statics.
BEGIN
WFL1[nest, "BEGIN -- OnePkt."];
WFL[nest, "onePkt: BOOLEAN = ", LastPkt, ";"];
WFL1[nest, "IF ~onePkt THEN BEGIN -- Must move statics from pkt now."];
Marshal.FromPacket[ nest: nest+1,
paramInfo: argInfo,
overlayHandling: [static: justCopyToFrame],
varNames: CallVars,
options: options ];
WFL1[nest+1, "END;"];
Marshal.FromPacket[ nest: nest,
paramInfo: argInfo,
overlayHandling: [static: leaveInPkt],
varNames: CallVars,
options: options ];
OverlayPointer[ nest: nest,
paramInfo: resultInfo,
pktName: ReturnPkt, overlayPtrName: ResultPtr,
do: assign ];
WFL1[nest, "IF onePkt"];
WFS[Indent[nest+1], "THEN "];
Call[ nest: nest+2,
transferName: transferName,
type: transferInfo.kind,
argInfo: argInfo, resultInfo: resultInfo,
staticArgs: inPktOverlay, staticResults: inPktOverlay,
argOverlayPtr: ArgPtr, resultOverlayPtr: ResultPtr ];
WFS["\n", Indent[nest+1], "ELSE "];
Call[ nest: nest+2,
transferName: transferName,
type: transferInfo.kind,
argInfo: argInfo, resultInfo: resultInfo,
staticArgs: inFrame, staticResults: inPktOverlay,
argOverlayPtr: ArgPtr, resultOverlayPtr: ResultPtr ];
WFS1[";\n"];
WFL1[nest, "END; -- OnePkt."];
END; -- One or more packets.
PacketLength[ nest: nest,
paramInfo: resultInfo,
pktLengthName: ReturnLength,
declare: no,
assign: IF argInfo.transferType=Error THEN no ELSE yes ];
Marshal.ToPacket[ nest: nest,
paramInfo: resultInfo,
overlayHandling: [static: alreadyInPkt],
varNames: ReturnVars,
options: options ];
nest ← Marshal.EndAllocation[ nest: nest,
paramInfo: argInfo,
justCloseBlocks: argInfo.transferType=Error,
options: options ];
IF argInfo.transferType # Error -- Nothing can follow an ERROR.
THEN BEGIN
WFSL[Indent[nest],
"RETURN[", Private.GetString[dispatcherReturnLength],
": ", ReturnLength, "];\n" ];
END;
WFL[nest, "END; -- ", blockName, "."];
END; -- CalledStubBody.
Call, return, and parameter record routines.
CallStmt: PROCEDURE [
transferName: String,
type: ST.TransferTypes,
argInfo, resultInfo: ParamInfo,
staticArgs, staticResults: ParamLocation,
argOverlayPtr, resultOverlayPtr: String,
nest: Nest ] =
BEGIN
WFS1[Indent[nest]];
Call[transferName, type, argInfo, resultInfo,
staticArgs, staticResults, argOverlayPtr, resultOverlayPtr, nest];
WFS1[";\n"];
END;
Call: PROCEDURE [
transferName: String,
type: ST.TransferTypes,
argInfo, resultInfo: ParamInfo,
staticArgs, staticResults: ParamLocation,
argOverlayPtr, resultOverlayPtr: String,
nest: Nest ] =
BEGIN
CallName: ARRAY ST.TransferTypes OF String = [
Procedure: "", Error: "ERROR ", Signal: "SIGNAL ",
Port: "", Program: "START ", Process: "FORK ", Other: "" ];
IF resultInfo.paramCount > 0
THEN BEGIN
ParameterConstructor[
paramInfo: resultInfo,
overlayPtrName: resultOverlayPtr,
statics: staticResults ];
IF resultInfo.paramCount < 2
THEN WFS1[" ← "] ELSE WFS[" ←\n", Indent[nest+1]];
END;
WFS[CallName[type], --ModuleName[interface], ".",-- transferName];
ParameterConstructor[
paramInfo: argInfo, overlayPtrName: argOverlayPtr, statics: staticArgs];
END;
ReturnStmt: PROCEDURE [
type: ST.TransferTypes,
resultInfo: ParamInfo,
resultOverlayPtr: String,
staticResults: ParamLocation,
nest: Nest ] =
BEGIN
WFS1[Indent[nest]];
Return[type, resultInfo, resultOverlayPtr, staticResults];
WFS1[";\n"];
END;
Return: PROCEDURE [
type: ST.TransferTypes,
resultInfo: ParamInfo,
resultOverlayPtr: String,
staticResults: ParamLocation ] =
BEGIN
ReturnName: ARRAY ST.TransferTypes OF String = [
Procedure: "RETURN", Error: "RESUME", Signal: "RESUME",
Port: "", Program: "STOP", Process: "", Other: "" ];
WFS1[ReturnName[type]];
ParameterConstructor[
paramInfo: resultInfo,
overlayPtrName: resultOverlayPtr,
statics: staticResults ];
END;
DeAllocPkt: PROCEDURE [ nest: Nest, options: Options, transferInfo: TransferInfo, pktSize: INT, pktOnStack: BOOL] ={
SELECT transferInfo.kind FROM
Signal, Error =>
These reuse the Dispatcher's call pkt.
{};
ENDCASE => {
Procedures (and the rest) use a freshly declared pkt.
IF options.targetLanguage = Cedar AND ~pktOnStack THEN {
IF options.inlinePacketAllocateCount > 0 THEN {
WFS[Indent[nest], "RpcPrivate.DeAllocInline[LOOPHOLE[pkt], RpcPrivate.pktOverhead"];
WF1["+%g];\n", [integer[pktSize]]];
options.inlinePacketAllocateCount ← options.inlinePacketAllocateCount - 1;
}
ELSE {
WFS[Indent[nest], "RpcPrivate.DeAlloc[LOOPHOLE[pkt], RpcPrivate.pktOverhead"];
WF1["+%g];\n", [integer[pktSize]]];
};
};
};
};
ParameterConstructor: PROCEDURE [
paramInfo: ParamInfo,
overlayPtrName: String,
statics: ParamLocation ] =
BEGIN
DoField: Marshal.ParamProcedure =
BEGIN
IF paramIndex > 1 THEN WFS1[", "];
SELECT paramFieldInfo.location FROM
inConversation => WFS1[Private.GetString[dispatcherConversation]];
inPktOverlay => {
IF statics=inPktOverlay THEN WFS[overlayPtrName, "."];
Declare.WriteParameterName[paramName, paramIndex] };
inFrame, inFrameAndOverlay =>
Declare.WriteParameterName[paramName, paramIndex];
ENDCASE => ERROR;
END; -- DoField.
WFS1["["];
Marshal.EnumerateParams[paramInfo, DoField];
WFS1["]"];
END;
FullParameterList: PROCEDURE [
argInfo, resultInfo: ParamInfo,
extraFirstArg: String,
printingComment: BOOLEAN,
nest: Nest,
options: Options ] =
BEGIN
IF argInfo.paramCount > 0 THEN {
forceComma: BOOL ← FALSE;
ArgNameTypeList: Marshal.ParamProcedure =
BEGIN
IF paramIndex > 1 OR forceComma THEN WFS1[", "];
Declare.WriteParameterName[paramName, paramIndex];
WFS1[": "]; Declare.WriteTypeName[paramType];
END; -- ArgNameTypeList.
WFS1["["];
IF ~IsNull[extraFirstArg] THEN {
forceComma ← TRUE;
WFS1[extraFirstArg];
};
Marshal.EnumerateParams[argInfo, ArgNameTypeList];
WFS1["]"];
}
ELSE {
IF ~IsNull[extraFirstArg] THEN {
WFS1["["];
WFS1[extraFirstArg];
WFS1["]"];
};
};
IF resultInfo.paramCount > 0
THEN BEGIN
keywordComments: BOOLEAN =
~printingComment AND OverlayStaticsStayInPkt[resultInfo, options];
If the overlay never moves, do not allocate needless space for
results by assigning keywords. This means that nonstatics
will have no keywords and be undeclared too. Their needed
declarations are handled separately by ParamsAsLocalVars.
ResultNameTypeList: Marshal.ParamProcedure =
BEGIN
IF paramIndex > 1 THEN WFS1[", "];
IF keywordComments THEN WFS1["--"];
Declare.WriteParameterName[paramName, paramIndex];
WFS1[IF keywordComments THEN ":-- " ELSE ": "];
Declare.WriteTypeName[paramType];
END; -- ResultNameTypeList.
SELECT argInfo.paramCount FROM
0 => NULL;
IN [1..2] => WFS1[" "];
>2 =>
WFS["\n", Indent[nest+1], (IF printingComment THEN "-- " ELSE "")];
ENDCASE => NULL;
WFS1["RETURNS ["];
Marshal.EnumerateParams[resultInfo, ResultNameTypeList];
WFS1["]"];
END;
END;
ParamsAsLocalVars: PROCEDURE [
paramInfo: ParamInfo,
doOnlyAnonymousParams: BOOLEAN←FALSE,
doOnlyAddressParams: BOOLEAN←FALSE,
nest: Nest,
options: Options ] =
BEGIN
DeclareLocalVar: Marshal.ParamProcedure =
BEGIN
IF doOnlyAnonymousParams AND ~ST.IsAnonymous[paramName] THEN RETURN;
IF doOnlyAddressParams AND ~OverlayStaticsStayInPkt[paramInfo, options] THEN RETURN;
IF ParamStaysInPkt[paramInfo, paramFieldInfo] THEN RETURN;
SELECT paramFieldInfo.location FROM
inFrame, inPktOverlay, inFrameAndOverlay =>
BEGIN
WFS1[Indent[nest]];
Declare.WriteParameterName[paramName, paramIndex];
WFS1[": "];
Declare.WriteTypeName[paramType];
WFS1[";\n"];
END;
ENDCASE => NULL; -- Skip others (eg, conversation, stream).
END; -- DeclareLocalVar.
Marshal.EnumerateParams[paramInfo, DeclareLocalVar];
END;
ParamStaysInPkt: PROCEDURE [
paramInfo: ParamInfo, fieldInfo: Marshal.FieldInfo ]
RETURNS [--yes:-- BOOLEAN] =
INLINE BEGIN OPEN info: paramInfo;
RETURN[
fieldInfo.location = inPktOverlay AND
( info.alwaysOnePkt OR
info.transferSite=caller AND info.paramRecordKind=argument OR
info.transferSite=callee AND info.paramRecordKind=result ) ];
END;
OverlayStaticsStayInPkt: PROCEDURE [paramInfo: ParamInfo, options: Options]
RETURNS [--yes:-- BOOLEAN] =
INLINE BEGIN
RETURN[ options.targetLanguage = Mesa AND paramInfo.hasOverlayParamType[static] AND paramInfo.alwaysOnePkt ];
END;
Overlay record, overlay pointer, and packet length routines.
OverlayRecord: PROCEDURE [
paramInfo: ParamInfo,
transferIndexName: String←StringNIL,
nest: Nest] =
BEGIN
overlayIndex: Marshal.Words ← paramInfo.sizeOf.overlayHeader;
printedOne: BOOLEAN ← FALSE;
DeclareField: Marshal.ParamProcedure =
BEGIN
SELECT paramFieldInfo.location FROM
inPktOverlay, inFrameAndOverlay =>
BEGIN
IF printedOne THEN WFS1[", "] ELSE printedOne ← TRUE;
Declare.WriteParameterName[paramName, paramIndex];
WF1[" (%g): ", [integer[overlayIndex]]];
overlayIndex ← overlayIndex + paramFieldInfo.size;
Declare.WriteTypeName[paramType];
END;
ENDCASE => NULL;
END; -- DeclareField.
SELECT paramInfo.paramRecordKind FROM
argument =>
IF paramInfo.hasOverlayParams OR paramInfo.transferSite=caller
THEN BEGIN
WFSL[Indent[nest],
"ArgumentOverlay: TYPE = MACHINE DEPENDENT RECORD [\B",
"transferIndex (0): RpcControl.",
(SELECT paramInfo.transferType FROM
Procedure => Private.GetString[procedureIndex],
Signal, Error => Private.GetString[signalIndex],
ENDCASE => ERROR) ];
IF ~IsNull[transferIndexName] THEN WFS[" ← ", transferIndexName];
SELECT paramInfo.transferDeclaration FROM
inRoutine => WFS1[", callback (1): RpcPrivate.Dispatcher"];
ENDCASE => NULL;
printedOne ← TRUE;
Marshal.EnumerateParams[paramInfo, DeclareField];
WFS1["];\n"];
END;
result =>
IF paramInfo.hasOverlayParams
THEN BEGIN
WFS[ Indent[nest],
"ResultOverlay: TYPE = MACHINE DEPENDENT RECORD [\B" ];
Marshal.EnumerateParams[
paramInfo: paramInfo, paramProc: DeclareField,
includeRESULTs: TRUE ];
WFS1["];\n"];
END;
ENDCASE => ERROR;
IF overlayIndex # paramInfo.sizeOf.overlayParamRecord THEN ERROR;
END;
OverlayPointer: PROCEDURE [
paramInfo: ParamInfo,
pktName, overlayPtrName: String,
do: {declare, assign, both},
nest: Nest ] =
BEGIN
IF NOT ( paramInfo.hasOverlayParams OR
(paramInfo.paramRecordKind=argument AND paramInfo.transferSite=caller) )
THEN RETURN;
WFS[Indent[nest], overlayPtrName];
SELECT do FROM
declare, both =>
WFSL[
(SELECT paramInfo.pktSite FROM
rpcRuntime => ": LONG ", stubFrame => ": ", ENDCASE => ERROR),
"POINTER TO ",
(SELECT paramInfo.paramRecordKind FROM
argument => "Argument", result => "Result", ENDCASE => ERROR),
"Overlay"];
ENDCASE => NULL;
SELECT do FROM assign => WFS1[" ← "]; both => WFS1[" = "]; ENDCASE => NULL;
SELECT do FROM
assign, both => WFS["@", pktName, ".data[0]"];
ENDCASE => NULL;
WFS1[";\n"];
END;
LocalPacket: PROCEDURE [pktName: String, size: Marshal.Words, nest: Nest, options: Options] RETURNS [onStack: BOOL ← TRUE] = BEGIN
IF options.targetLanguage = Mesa OR size < 64-38 THEN {
WFS[Indent[nest], pktName, "Buffer: ARRAY [1..RpcPrivate.pktOverhead"];
WF1["+%g] OF WORD;\n", [integer[size]]];
WFLL[nest, pktName, ": RpcPrivate.StubPkt = RpcPrivate.GetStubPkt[space: @",
pktName, "Buffer];"];
}
ELSE {
IF options.inlinePacketAllocateCount > 0 THEN {
WFS[Indent[nest], pktName, ": RpcPrivate.RPCPkt = RpcPrivate.GetPkt[space: RpcPrivate.AllocInline[RpcPrivate.pktOverhead"];
WF1["+%g]];\n", [integer[size]]];
onStack ← FALSE;
}
ELSE {
WFS[Indent[nest], pktName, ": RpcPrivate.RPCPkt = RpcPrivate.GetPkt[space: RpcPrivate.Alloc[RpcPrivate.pktOverhead"];
WF1["+%g]];\n", [integer[size]]];
onStack ← FALSE;
};
};
END;
PacketLength: PROCEDURE [
paramInfo: ParamInfo,
pktLengthName: String,
declare, assign: {yes, ifNeeded, no},
nest: Nest ] =
BEGIN
HasInFrameParams: PROC [paramInfo: ParamInfo] RETURNS [BOOLEAN] =
INLINE {RETURN[
paramInfo.adrInfo.hasAddresses OR
paramInfo.adrInfo.hasDynamics OR
~paramInfo.alwaysOnePkt ]};
declareNeeded: BOOLEAN = SELECT declare FROM
yes => TRUE, no => FALSE, ifNeeded => HasInFrameParams[paramInfo],
ENDCASE => ERROR;
assignNeeded: BOOLEAN = SELECT assign FROM
yes => TRUE, no => FALSE, ifNeeded => HasInFrameParams[paramInfo],
ENDCASE => ERROR;
IF declareNeeded OR assignNeeded THEN WFS[Indent[nest], pktLengthName];
IF declareNeeded THEN WFS1[": RpcPrivate.DataLength"];
IF assignNeeded
THEN WF1[" ← %g", [integer[paramInfo.sizeOf.overlayParamRecord]]];
IF declareNeeded OR assignNeeded THEN WFS1[";\n"];
END;
ParamInfo veneer.
GetArgResultInfo: PUBLIC PROCEDURE [
transferInfo: TransferInfo,
transferDeclaration: TransferDeclaration,
transferSite: TransferSite,
pktSite: PktSite,
options: Options ]
RETURNS [argInfo, resultInfo: ParamInfo] =
BEGIN
argInfo ← Marshal.MakeParamInfo[
paramRecord: transferInfo.argumentType,
paramRecordKind: argument,
transferType: transferInfo.kind,
transferDeclaration: transferDeclaration,
transferSite: transferSite,
pktSite: pktSite,
options: options ];
resultInfo ← Marshal.MakeParamInfo[
paramRecord: transferInfo.resultType,
paramRecordKind: result,
RESULTsParamInfo: argInfo,
transferType: transferInfo.kind,
transferDeclaration: transferDeclaration,
transferSite: transferSite,
pktSite: pktSite,
options: options
! UNWIND => Marshal.FreeParamInfo[argInfo] ];
END;
FreeArgResultInfo: PROCEDURE [argInfo, resultInfo: ParamInfo] =
INLINE BEGIN
Marshal.FreeParamInfo[argInfo];
Marshal.FreeParamInfo[resultInfo];
END;
GetTransferInfo: PUBLIC PROCEDURE [typeHandle: ST.TypeHandle]
RETURNS[--transferInfo:-- TransferInfo] =
BEGIN
typeInfo: ST.TypeInfo = ST.GetTypeInfo[type: typeHandle];
WITH typeInfo: typeInfo SELECT FROM
Transfer => RETURN[typeInfo];
ENDCASE => RETURN[ERROR];
END;
END. -- LupineDeclareStubsImpl.
Bob Hagmann February 12, 1985 12:57:01 pm PST
changes to: DeAllocPkt, LocalPacket