-- RTTypesRemoteImpl.Mesa
-- last modified on December 21, 1982 3:16 pm by Paul Rovner

DIRECTORY
    AMBridge USING[TVToCardinal, WordSequenceRecord, WordSequence, RemoteRef,
                         RemotePointer, RemoteSED, RemotePD, RemoteFrameHandle,
                         RemoteGlobalFrameHandle, nilRemotePD, nilRemoteSED, TVToLC],
    AMTypes USING[Error, Class, TypeClass, UnderType, TVType, TypedVariable, Status, Type,
                        TV],
    AtomsPrivate USING[AtomRec],
    Environment USING[bitsPerWord],
    Rope USING[RopeRep],
    RTCommon USING[ShortenLongCardinal],
    RTSymbolDefs USING[BodyIndex, nullBodyIndex],
    RTTypesBasic USING[nullType, fhType, gfhType, EquivalentTypes],
    RTTypesPrivate USING[TypedVariableRec, GetTVZones, BitsForType],
    RTTypesRemotePrivate USING[GetRemoteReferentType, GetRemoteProcedureType,
                                       GetRemoteSignalType, AcquireBTIFromRemoteFH,
                                       IsRemoteCatchFrame],
    WorldVM USING[CurrentIncarnation, Long, LocalWorld, World, Address];

RTTypesRemoteImpl: PROGRAM
   IMPORTS AMBridge, AMTypes, RTCommon, RTTypesBasic, RTTypesPrivate,
              RTTypesRemotePrivate, WorldVM
   EXPORTS AMBridge
   SHARES Rope

= BEGIN OPEN AMBridge, AMTypes, Environment, RTCommon, RTSymbolDefs, RTTypesBasic,
                 RTTypesPrivate, RTTypesRemotePrivate, WorldVM;

tvZone: ZONE;
tvPrefixedZone: ZONE;

-- P R O C E D U R E S
IsRemote: PUBLIC PROC[tv: TypedVariable] RETURNS[BOOLEAN] =
 {WITH tv SELECT FROM
    tvr: REF TypedVariableRec =>
          WITH tvh: tvr.head SELECT FROM
            remoteReference, remotePointer, remoteGFH,
            remoteFH, copiedRemoteObject, remoteConstant
                        => IF GetRemoteWorld[tv] = WorldVM.LocalWorld[]
                                     THEN ERROR
                                     ELSE RETURN[TRUE];
           ENDCASE => RETURN[FALSE];
   ENDCASE => RETURN[FALSE]};

TVForRemoteReferent: PUBLIC PROC[remoteRef: RemoteRef, status: Status _ mutable]
      RETURNS[TypedVariable] =
  { type: Type;
    bitsForType: LONG CARDINAL;     
    type _ GetRemoteReferentType[remoteRef];

    IF type = nullType THEN RETURN[NIL];
    
    IF RTTypesBasic.EquivalentTypes[type, CODE[AtomsPrivate.AtomRec]]
      OR RTTypesBasic.EquivalentTypes[type, CODE[Rope.RopeRep]]
     THEN ERROR Error[reason: typeFault, type: type];
     

    bitsForType _ BitsForType[type].bft;

    RETURN[
      IF bitsForType < bitsPerWord
       THEN
        tvZone.NEW[TypedVariableRec _
                        [referentType: [type],
                         head: [remoteReference[remoteRef: remoteRef]],
                         status: status,
                         field: embedded[fd: [wordOffset: 0,
                                                 extent: small[field: [bitFirst: bitsPerWord-bitsForType,
                                                                        bitCount: ShortenLongCardinal[bitsForType]]]]]]]
       ELSE tvZone.NEW[TypedVariableRec _ [referentType: [type],
                                                       head: [remoteReference[remoteRef: remoteRef]],
                                                       status: status,
                                                       field: entire[]]]]};

-- raises notMutable, internalTV, typeFault
RemoteRefFromTV: PUBLIC PROC[tv: TypedVariable] RETURNS[RemoteRef] =
 {WITH tv SELECT FROM
    tr: REF TypedVariableRec =>
          {IF tr.tag # entire
            THEN ERROR Error[reason: internalTV]
            ELSE IF tr.status # mutable
                  THEN ERROR Error[reason: notMutable]
                  ELSE WITH head: tr.head SELECT FROM
                           remoteReference => RETURN[head.remoteRef];
                          ENDCASE => ERROR Error[reason: internalTV]};
   ENDCASE => ERROR Error[reason: typeFault, type: nullType]};

        -- If possible, this returns the REF which points to the value represented by the specified
        -- TypedVariable. Raises InternalTV if tv is embedded, NotVar if TVStatus[tv] # mutable.


TVForRemotePointerReferent: PUBLIC PROC[remotePointer: RemotePointer,
                                        type: Type,
                                        status: Status _ mutable]
      RETURNS[TypedVariable] =
 {bitsForType: LONG CARDINAL;
   bitsForType _ BitsForType[type].bft;
   RETURN[
    IF bitsForType < bitsPerWord
     THEN
      tvZone.NEW[TypedVariableRec _
                      [referentType: [type],
                       head: [remotePointer[remotePointer: remotePointer]],
                       status: status,
                       field: embedded[fd: [wordOffset: 0,
                                               extent: small[field: [bitFirst: bitsPerWord-bitsForType,
                                                                      bitCount: ShortenLongCardinal[bitsForType]]]]]]]
     ELSE tvZone.NEW[TypedVariableRec _ [referentType: [type],
                                                     head: [remotePointer[remotePointer: remotePointer]],
                                                     status: status,
                                                     field: entire[]]]]};

        -- If possible, RemotePointerFromTV returns the LONG POINTER which points
        -- to the value represented by the specified TypedVariable.
        -- Raises Error[reason: internalTV] if tv is embedded and not word aligned
        -- Raises NotVar if TVStatus[tv] # mutable.
-- raises notMutable, internalTV, typeFault
RemotePointerFromTV: PUBLIC PROC[tv: TypedVariable] RETURNS[RemotePointer] =
 {WITH tv SELECT FROM
    tr: REF TypedVariableRec =>
          {IF tr.status # mutable THEN ERROR Error[reason: notMutable];
           WITH etr: tr SELECT FROM
             embedded =>
               WITH fd: etr.fd SELECT FROM
                 large => {rp: RemotePointer _ GetRemoteHeadPointer[tr];
                             rp.ptr _ rp.ptr + fd.wordOffset;
                             RETURN[rp]};
                 small => IF fd.field.bitFirst = 0
                           THEN {rp: RemotePointer _ GetRemoteHeadPointer[tr];
                                    rp.ptr _ rp.ptr + fd.wordOffset;
                                    RETURN[rp]}
                           ELSE ERROR Error[reason: internalTV];
                ENDCASE => ERROR;
             entire =>  RETURN[GetRemoteHeadPointer[tr]];   --may have been narrowed--
            ENDCASE => ERROR}
   ENDCASE => ERROR Error[reason: typeFault, type: nullType]};
        
-- raises typeFault
GetRemoteHeadPointer: PROC[tr: REF TypedVariableRec] RETURNS[RemotePointer] =
 {RETURN[(WITH head: tr.head SELECT FROM
                 remotePointer => head.remotePointer,
                 remoteGFH => [world: head.remoteGlobalFrameHandle.world,
                                   worldIncarnation:
                                        CurrentIncarnation[head.remoteGlobalFrameHandle.world],
                                   ptr: Long[world: head.remoteGlobalFrameHandle.world,
                                               addr: head.remoteGlobalFrameHandle.gfh]],
                 remoteFH => [world: head.remoteFrameHandle.world,
                                 worldIncarnation:
                                        CurrentIncarnation[head.remoteFrameHandle.world],
                                 ptr: Long[world: head.remoteFrameHandle.world,
                                               addr: head.remoteFrameHandle.fh]]
                ENDCASE => ERROR Error[reason: typeFault, type: nullType])]};

TVForRemoteProc: PUBLIC PROC[remotePD: RemotePD] RETURNS[TypedVariable--procedure--] =
  {RETURN[TVForRemotePD[remotePD]]};

TVForRemotePD: PUBLIC PROC[remotePD: RemotePD] RETURNS[TypedVariable--procedure--] =
  {ws: WordSequence;
    ws _ NEW[WordSequenceRecord[1]];
    ws[0] _ LOOPHOLE[remotePD.pd, CARDINAL];
     RETURN[NEW[TypedVariableRec _ [referentType: [GetRemoteProcedureType[remotePD]],
                                              head: [remoteConstant
                                                           [world: remotePD.world,
                                                            worldIncarnation:
                                                                 CurrentIncarnation[remotePD.world]]],
                                               status: const,
                                               field: constant[value: ws]]]]};

TVForRemoteSignal: PUBLIC PROC[remoteSED: RemoteSED]
      RETURNS[TypedVariable--signal, error--] = {RETURN[TVForRemoteSED[remoteSED]]};

TVForRemoteSED: PUBLIC PROC[remoteSED: RemoteSED]
      RETURNS[TypedVariable--signal, error--] =
  {ws: WordSequence;
    ws _ NEW[WordSequenceRecord[1]];
    ws[0] _ LOOPHOLE[remoteSED.sed, CARDINAL];
     RETURN[NEW[TypedVariableRec _ [referentType: [GetRemoteSignalType[remoteSED]],
                                               head: [remoteConstant
                                                         [world: remoteSED.world,
                                                          worldIncarnation:
                                                                 CurrentIncarnation[remoteSED.world]]],
                                               status: const,
                                               field: constant[value: ws]]]]};


-- raises typeFault
TVToRemoteProc: PUBLIC PROC[tv: TypedVariable--procedure, program--]
      RETURNS[RemotePD] = {RETURN[TVToRemotePD[tv]]};

TVToRemotePD: PUBLIC PROC[tv: TypedVariable--procedure, program--]
      RETURNS[RemotePD] =
 { SELECT TypeClass[UnderType[TVType[tv]]] FROM
      nil => RETURN[nilRemotePD];
      program, procedure => NULL;
     ENDCASE => ERROR Error[reason: typeFault, type: TVType[tv]];
   RETURN[[world: GetWorld[tv],
               worldIncarnation: CurrentIncarnation[GetWorld[tv]],
               pd: TVToCardinal[tv]]]};

-- raises typeFault
TVToRemoteSignal: PUBLIC PROC[tv: TypedVariable] RETURNS[RemoteSED] =
  {RETURN[TVToRemoteSED[tv]]};

TVToRemoteSED: PUBLIC PROC[tv: TypedVariable] RETURNS[RemoteSED] =
 { SELECT TypeClass[UnderType[TVType[tv]]] FROM
      signal, error => NULL;
      nil => RETURN[nilRemoteSED];
     ENDCASE => ERROR Error[reason: typeFault, type: TVType[tv]];
   RETURN[[world: GetWorld[tv],
               worldIncarnation: CurrentIncarnation[GetWorld[tv]],
               sed: TVToCardinal[tv]]]};

  -- MOVE
TVForRemoteFrame: PUBLIC PROC[remoteFrameHandle: RemoteFrameHandle,
                                           evalStack: WordSequence _ NIL,
                                           return: BOOL _ FALSE,
                                           contextPC: BOOL _ FALSE]
      RETURNS[ans: TV _ NIL] =
 {bti: BodyIndex;
   isCatchFrame: BOOLEAN _ FALSE;
   IF remoteFrameHandle.fh = 0 THEN RETURN[NIL];
   bti _ AcquireBTIFromRemoteFH[remoteFrameHandle, contextPC];-- returns BTNull if no symbols
   IF bti # nullBodyIndex
    THEN [isCatchFrame, bti] _ IsRemoteCatchFrame[remoteFrameHandle, bti];
   RETURN[tvZone.NEW[TypedVariableRec
                       _ [referentType: [fhType],
                          head: [remoteFH[remoteFrameHandle: remoteFrameHandle,
                                              evalStack: evalStack,
                                              bti: bti,
                                              isCatchFrame: isCatchFrame,
                                              return: return,
                                              contextPC: contextPC]],
                          status: mutable,
                          field: entire[]]]]};

-- raises typeFault
RemoteFHFromTV: PUBLIC PROC[tv: TypedVariable] RETURNS[RemoteFrameHandle] =
 {WITH tv SELECT FROM
    tvr: REF TypedVariableRec =>
          WITH tvh: tvr.head SELECT FROM
            remoteFH => RETURN[tvh.remoteFrameHandle];
           ENDCASE => ERROR Error[reason: typeFault, type: fhType];
   ENDCASE => ERROR Error[reason: typeFault, type: fhType]};

        -- all such tvs have the same (distinguished) type: gfhType
TVForRemoteGFHReferent: PUBLIC PROC[remoteGlobalFrameHandle: RemoteGlobalFrameHandle]
      RETURNS[TypedVariable] =
 { IF remoteGlobalFrameHandle.gfh = 0 THEN RETURN[NIL];
    RETURN[tvZone.NEW[TypedVariableRec
                      _ [referentType: [gfhType],
                          head: [remoteGFH[remoteGlobalFrameHandle: remoteGlobalFrameHandle]],
                          status: mutable,
                          field: entire[]]]]};

-- raises typeFault
RemoteGFHFromTV: PUBLIC PROC[tv: TypedVariable] RETURNS[RemoteGlobalFrameHandle] =
 {WITH tv SELECT FROM
    tvr: REF TypedVariableRec =>
          WITH tvh: tvr.head SELECT FROM
            remoteGFH => RETURN[tvh.remoteGlobalFrameHandle];
           ENDCASE => ERROR Error[reason: typeFault, type: gfhType];
   ENDCASE => ERROR Error[reason: typeFault, type: gfhType]};

GetRemoteWorld: PROC[tv: TypedVariable] RETURNS[World] =
 {WITH tv SELECT FROM
       tvr: REF TypedVariableRec =>
          WITH tvh: tvr.head SELECT FROM
            remoteReference => RETURN[tvh.remoteRef.world];
            remotePointer => RETURN[tvh.remotePointer.world];
            remoteFH => RETURN[tvh.remoteFrameHandle.world];
            remoteGFH => RETURN[tvh.remoteGlobalFrameHandle.world];
            copiedRemoteObject => RETURN[tvh.world];
            remoteConstant => RETURN[tvh.world];
           ENDCASE => ERROR;
     ENDCASE => ERROR;
};

GetWorld: PUBLIC PROC[tv: TypedVariable] RETURNS[World] =
 {IF IsRemote[tv]
   THEN RETURN[GetRemoteWorld[tv]]
   ELSE RETURN[LocalWorld[]];
  };

GetWorldIncarnation: PUBLIC PROC[tv: TypedVariable] RETURNS[LONG CARDINAL] =
 {IF IsRemote[tv]
   THEN
     WITH tv SELECT FROM
       tvr: REF TypedVariableRec =>
          WITH tvh: tvr.head SELECT FROM
            remoteReference => RETURN[tvh.remoteRef.worldIncarnation];
            remotePointer => RETURN[tvh.remotePointer.worldIncarnation];
            remoteFH => RETURN[tvh.remoteFrameHandle.worldIncarnation];
            remoteGFH => RETURN[tvh.remoteGlobalFrameHandle.worldIncarnation];
            copiedRemoteObject => RETURN[tvh.worldIncarnation];
            remoteConstant => RETURN[tvh.worldIncarnation];
           ENDCASE => ERROR;
      ENDCASE => ERROR
   ELSE RETURN[CurrentIncarnation[LocalWorld[]]];
  };

TVToRemoteRef: PUBLIC PROC[tv: TypedVariable] RETURNS[RemoteRef] =
  { IF GetWorld[tv] = LocalWorld[]
     THEN ERROR Error[reason: typeFault, msg: "Can't get a remote REF for a local object"];
    
    SELECT TypeClass[UnderType[TVType[tv]]] FROM
      atom, rope, list, ref => RETURN[[world: GetWorld[tv],
                                            worldIncarnation: GetWorldIncarnation[tv],
                                            ref: LOOPHOLE[TVToLC[tv], WorldVM.Address]]];
     ENDCASE => ERROR Error[reason: typeFault, type: TVType[tv]];
  };


-- START HERE
[qz: tvZone, pz: tvPrefixedZone] _ GetTVZones[];

END.
                       
Κά–
"Mesa" style˜IprocšΙΟcWœ
Οk	œžœξ
žœbžœžœžœžœžœ(žœ-žœAžœFžœΜ
žœLžœžœkžœ
žœ	žœ
žœ
žœžœΟnœžœ
žœžœ
žœžœžœ
žœ
žœžœžœ
žœŒ
žœPžœ
žœ&žœ
žœ
žœžœžœ
žœžœžœ
žœŸœžœ
žœ7žœ3žœ
žœ9žœžœ
žœ
žœžœ$žœžœ$žœžœ
žœ\žœžœ"žœžœΫžœžœ₯,Ÿœžœ
žœžœžœžœ
žœ	žœ žœžœ
žœ'žœ
žœ'žœ
žœ-žœ
žœžœ
žœ/žœ,žœžœ žœžœ5\œYœŸœžœ
žœ›
žœ!žœ
žœ-žœžœ žœžœΣžœžœ­Jœ<œKœXŸœžœ
žœžœžœžœ
žœ	žœ žœžœ
žœ'žœ	žœ
žœ)žœžœ
žœ₯
žœ!žœ2žœ™
žœ!žœ
žœ,žœžœžœœ
žœžœžœžœ5Ÿœžœžœžœžœžœžœ
žœΘžœžœ/Ÿœžœ
žœžœ
œžœŸ
œžœ
žœžœ
œ"žœ%žœžœžœ
žœ‘Ÿœžœ
žœžœœžœŸœžœ
žœžœœ"žœ%žœžœžœ
žœŸŸœžœ
žœœžœžœŸœžœ
žœœžœžœ"žœžœ+žœžœžœ0žœƒ
Ÿœžœ
žœžœžœŸ
œžœ
žœžœžœ"žœžœžœžœžœ0žœ„
ŸŸœžœ
žœlžœ5žœžœ8žœžœžœžœžœ'žœžœžœžœ
žœ
žœA œžœžœFžœžœΉŸœžœ
žœžœžœžœ
žœ
žœžœžœ
žœžœ$žœžœ,žœžœ3<Ÿœžœ
žœ9žœžœ!žœ
žœ
žœžœžœώ
Ÿœžœ
žœžœžœžœ
žœ
žœžœžœ
žœžœ*žœžœ-žœžœ,Ÿœžœžœžœžœ
žœ
žœžœžœ
žœ žœ4žœ3žœ8žœGžœ+žœžœžœžœžœŸœžœ
žœžœžœžœ
žœžœ
žœŸœžœ
žœžœ
žœ
žœžœžœžœžœ
žœ
žœžœžœ
žœ žœ?žœ>žœCžœRžœ6žœ#žœžœžœžœžœ
žœ*Ÿ
œžœ
žœžœžœ"žœ
žœVžœ"žœ žœŸ
žœ&žœžœ4œ2žœ˜βu—…—:δ@Ζ