Garbo/Garbo.cdr/mac/source/xxcmd.sit/XXCMD.p/XXCMD.p

Text File | 1990-06-29 | 9.2 KB | 353 lines | [TEXT/MPS ]

{
XXCMD - an XCMD for running external XCMDs

by brad pickering
}

{$r-}

UNIT dummy;

  INTERFACE

    USES MemTypes, Quickdraw, OSIntf, ToolIntf, HyperXCmd, HyperXXCmd;

    PROCEDURE EntryPoint(paramPtr: XCmdPtr);

  IMPLEMENTATION

    PROCEDURE XXCMD(paramPtr: XCmdPtr);

      FORWARD;

    PROCEDURE EntryPoint(paramPtr: XCmdPtr);

    { The EntryPoint must be the first piece of code in the XCMD. It
      simply calls the routine that does the main processing.
    }

      BEGIN
        XXCMD(paramPtr);
      END;

    PROCEDURE Execute(a5, pc: longint);

    { Execute the XXCMD given its global pointer and program counter.
        move.l  (sp)+,a0    ; pc
        move.l  (sp)+,a1    ; a5
        movem.l a2-a5/d2-d7,-(sp)
        move.l  a1,a5
        jsr (a0)
        movem.l (sp)+,a2-a5/d2-d7
    }

      INLINE $205F, $225F, $48E7, $3F3C, $2A49, $4E90, $4CDF, $3CFC;

    PROCEDURE XXCMD(paramPtr: XCmdPtr);

      TYPE
        JTEntry = RECORD
          rOff, opcode: integer;
          value: longint;
          END;
        JTPtr = ^JTEntry;

      VAR
        h: Handle;
        xname, jtname, tstr: Str255;
        jt: JTPtr;
        xdata: XXCmdHandle;
        xp: XXCmdHandlePtr;

      PROCEDURE LoadXXCMD;

        CONST
          maxRes = 25;

        VAR
          h: Handle;
          i: integer;
          seg: ARRAY [1..maxRes] OF Ptr;
          xdata: XXCmdHandle;
          xp: XXCmdHandlePtr;

        PROCEDURE LoadSegs;

          VAR
            xfile, i: integer;

          PROCEDURE LoadErr(msg: Str255);

            VAR
              i: integer;
              h: Handle;

            BEGIN

              { Clean up and exit. }

              CloseResFile(xfile);
              FOR i := 1 TO maxRes DO
                IF seg[i] <> NIL THEN BEGIN
                  h := RecoverHandle(seg[i]);
                  DisposHandle(h);
                END;
              paramPtr^.returnValue := PasToZero(paramPtr, msg);
              exit(XXCMD);
            END;

          PROCEDURE OpenXXCMD;

            VAR
              fcb: FCBPBRec;
              status: OSErr;
              h: Handle;
              apname: Str255;

            BEGIN

              { Try opening the resource file in the same directory as the current stack. }

              fcb.ioCompletion := NIL;
              fcb.ioNamePtr := NIL;
              fcb.ioVRefNum := 0;
              fcb.ioRefNum := CurResFile;
              fcb.ioFCBIndx := 0;
              status := PBGetFCBInfo(@fcb, false);
              IF status = noErr THEN
                xfile := HOpenResFile(fcb.ioFCBVRefNum, fcb.ioFCBParID, xname, fsRdPerm);
              IF (status <> noErr) OR (ResError <> noErr) THEN BEGIN

                { Try opening the resource file in the same directory as HyperCard. }

                fcb.ioCompletion := NIL;
                fcb.ioNamePtr := NIL;
                fcb.ioVRefNum := 0;
                GetAppParms(apname, fcb.ioRefNum, h);
                fcb.ioFCBIndx := 0;
                status := PBGetFCBInfo(@fcb, false);
                IF status = noErr THEN
                  xfile := HOpenResFile(fcb.ioFCBVRefNum, fcb.ioFCBParID, xname, fsRdPerm);
                IF (status <> noErr) OR (ResError <> noErr) THEN BEGIN

                  { Try opening the resource file in the System Folder (PMSP). }

                  xfile := OpenRFPerm(xname, 0, fsRdPerm);
                  IF ResError <> noErr THEN BEGIN
                    paramPtr^.returnValue := PasToZero(paramPtr, concat('ERROR: can''t open resource file ', xname, '.'));
                    exit(XXCMD);
                  END;

                END;
              END;
            END;

          PROCEDURE ReadXXCMD;

            TYPE
              CodeHead = RECORD
                above, below, jtlen, jtoff: longint;
                END;

            VAR
              i, id: integer;
              h: Handle;
              rname: Str255;
              rtype: ResType;
              p: longint;
              code: CodeHead;

            BEGIN

              { Load each code segment. }

              FOR i := 1 TO Count1Resources('CODE') DO BEGIN

                { Load it. }

                h := Get1IndResource('CODE', i);
                IF ResError <> noErr THEN
                  LoadErr('ERROR: can''t read code resource.');

                { Check that the resource id is not too high. }

                GetResInfo(h, id, rtype, rname);
                IF id > maxRes THEN
                  LoadErr('ERROR: code resource number is too high.');

                { Check whether this is the jump table segment or a regular segment. }

                IF id = 0 THEN BEGIN

                  { Allocate and fill the jump table. }

                  BlockMove(h^, Ptr(@code), sizeof(CodeHead));
                  Ptr(p) := NewPtr(code.above + code.below);
                  IF MemError <> noErr THEN
                    LoadErr('ERROR: out of memory.');
                  jt := JTPtr(p + code.below + code.jtoff);
                  BlockMove(Ptr(longint(h^) + sizeof(CodeHead)), Ptr(jt), code.jtlen);
                  ReleaseResource(h);

                END
                ELSE BEGIN

                  { Free the╩segment and lock it down. }

                  DetachResource(h);
                  MoveHHi(h);
                  HLock(h);
                  seg[id] := h^;

                END;
              END;
            END;

          BEGIN

            { Initialize the data. }

            jt := NIL;
            FOR i := 1 TO maxRes DO
              seg[i] := NIL;

            { Open the XXCMD and Read in the code segments. }

            OpenXXCMD;
            ReadXXCMD;

            { Check that the resource file was in application format then clean up. }

            IF jt = NIL THEN
              LoadErr('ERROR: can''t find code resource 0.');
            CloseResFile(xfile);

          END;

        PROCEDURE FixJT;

          TYPE
            SegHead = RECORD
              firstOff, eCount: integer;
              END;
            SegHeadPtr = ^SegHead;

          VAR
            i, j: integer;
            sHead: SegHeadPtr;
            jtp: JTPtr;

          PROCEDURE MakeLoaded(VAR jTE: JTEntry; seg: Ptr);

            CONST
              jmp = $4EF9;

            BEGIN

              { Setup the jump table entry with the instruction to jump to the correct routine. }

              WITH jTE DO BEGIN
                opcode := jmp;
                value := longint(seg) + sizeof(SegHead) + longint(rOff);
              END;

            END;

          BEGIN

            { Setup the jump table entries for each routine for each segment. }

            FOR i := 1 TO maxRes DO
              IF seg[i] <> NIL THEN BEGIN
                sHead := SegHeadPtr(seg[i]);
                jtp := JTPtr(longint(jt) + sHead^.firstOff);
                FOR j := 1 TO sHead^.eCount DO BEGIN
                  MakeLoaded(jtp^, seg[i]);
                  jtp := JTPtr(longint(jtp) + sizeof(JTEntry));
                END;
              END;

          END;

        BEGIN

          { Read the XXCMD in to memory and setup the jump table. }

          LoadSegs;
          FixJT;

          { Set up a block of data to pass to the XXCMD as the Application Parameters. }

          xdata := XXCmdHandle(NewHandle(sizeof(XXCmdBlock)));
          IF MemError <> noErr THEN BEGIN
            FOR i := 1 TO maxRes DO
              IF seg[i] <> NIL THEN BEGIN
                h := RecoverHandle(seg[i]);
                DisposHandle(h);
              END;
            paramPtr^.returnValue := PasToZero(paramPtr, 'ERROR: out of memory.');
            exit(XXCMD);
          END;
          WITH xdata^^ DO BEGIN
            message := 0;
            count := 0;
            sig := $87654321; { Signature so that the XXCMD can tell it's not being run from the finder. }
            nextpc := longint(jt) + 2; { The main program starts with the first jump table entry. }
          END;
          { a5 := jt - 32; finder info := a5 + 16 }
          xp := XXCmdHandlePtr(longint(jt) - 32 + 16);
          xp^ := xdata;

        END;

      BEGIN

        { Check that the first parameter is the name of the XXCMD. }

        IF paramPtr^.paramCount = 0 THEN BEGIN
          paramPtr^.returnValue := PasToZero(paramPtr, 'ERROR: expected name of XXCMD to execute.');
          exit(XXCMD);
        END;

        { Check if the XXCMD is already loaded. }

        ZeroToPas(paramPtr, paramPtr^.params[1]^, xname);
        jtname := concat(xname, 'jt');
        h := GetGlobal(paramPtr, jtname);
        IF (h = NIL) | (h^ = NIL) | (h^^ = 0) THEN BEGIN
          IF h <> NIL THEN
            DisposHandle(h);

          { Load the XXCMD. }

          LoadXXCMD;

          { Save a pointer to its jump table in HyperCard. }

          LongToStr(paramPtr, longint(jt), tstr);
          h := PasToZero(paramPtr, tstr);
          SetGlobal(paramPtr, jtname, h);
          DisposHandle(h);

        END
        ELSE BEGIN

          { Get a pointer to the XXCMD's jump table from HyperCard. }

          ZeroToPas(paramPtr, h^, tstr);
          DisposHandle(h);
          jt := JTPtr(StrToLong(paramPtr, tstr));

        END;

        { Execute the XXCMD. }

        xp := XXCmdHandlePtr(longint(jt) - 32 + 16);
        xdata := xp^;
        xdata^^.paramPtr := paramPtr;
        Execute(longint(jt) - 32, xdata^^.nextpc);

      END;

END.