home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 339.lha / M2Lib / LibraryStub.mod < prev    next >
Text File  |  1990-02-08  |  8KB  |  208 lines
  1. MODULE LibraryStub;
  2. (*
  3.    This program compiles under TDI version 3.00A.
  4.    For other Modula-2 systems, you will have to change the IMPORT statements.
  5. *)
  6.  
  7. (*
  8.    A Modula-2 stub for a loadable Exec library. You must compile&link, then
  9.    run the object code against program 'm2lib'. ( Ex: m2lib librarystub )
  10.    All this is only necessary because Modula-2 does not support static initialization
  11.    of global variables.
  12. *)
  13.  
  14. FROM  AMIGAX   IMPORT
  15.    ExecBase;
  16.  
  17. FROM  Resident IMPORT
  18.    RTFColdStart;           (* Our library will be self-initializing. The alternative
  19.                               is RTFAutoInit, which will be initialized by Exec.  *)
  20.  
  21. FROM  Libraries   IMPORT
  22.    LibraryPtr, Library;
  23.  
  24. FROM  Nodes IMPORT
  25.    NTLibrary;
  26.  
  27.  
  28. FROM  SYSTEM   IMPORT
  29.    ADR,  ADDRESS, BYTE, NULL, SETREG,  CODE, REGISTER;
  30.  
  31. CONST
  32.    LibName='stub.library';
  33.    LibId='stub.library Ver 1.0 (05 Jan 1990)  '; (* Trailing 2 spaces necessary *)
  34.  
  35.    JMP=4EF9H;  (* JMP machine instruction *)
  36.    JSRA6=4EAEH;(* JSR xxx(a6) machine instruction *)
  37.    PUSHREGS=48E7H;
  38.    POPREGS=4CDFH;
  39.    LVOAddLibrary=0FE74H;
  40.    D0thruA5=0FFFCH;
  41.    A5thruD0=3FFFH;
  42.    D0thruA6=0FFFEH;
  43.    A6thruD0=7FFFH;
  44.  
  45. TYPE
  46.    JumpEntry=
  47.       RECORD
  48.          jeJMP:INTEGER;          (* Will move JMP to here   *)
  49.          jeProc:PROC;
  50.       END;
  51. VAR
  52.    SegList:ADDRESS;
  53.    JumpTable:ARRAY[ 1..4 ] OF JumpEntry;
  54.    LibraryBase:Library;
  55.  
  56. (*$P-*)  (* This is NOT an executable procedure       *)
  57. (*$S-*)  (* DO NOT check stack space EVER ! *)
  58. PROCEDURE RomTag;
  59. (*
  60.    This procedure does NOT get executed, it just places
  61.    a partially initialized Resident structure in the hunk. We have to
  62.    change it so that it will be a valid Resident structure at LoadSeg()
  63.    time. Program 'm2lib' will search for the characters 'ZXCV', which
  64.    will be considered the first 4 bytes BEFORE the Resident structure
  65.    begins.
  66.  
  67.    Here is the format for a Resident structure.
  68.       Resident=RECORD
  69.          rtMatchWord:CARDINAL;   (* MUST equal 4AFCH           *)
  70.          rtMatchTag:ADDRESS      (* MUST point at rtMatchWord.
  71.                                     A valid Resident structure MUST have
  72.                                     rtMatchTag=ADR( rtMatchWord ) *)
  73.          rtEndSkip:ADDRESS       (* Set to NULL                *)
  74.          rtFlags:BYTE            (* Set to RTFColdStart        *)
  75.          rtVersion:BYTE          (* Set to your library version*)
  76.          rtType:BYTE             (* Set to NTLibrary           *)
  77.          rtPri:BYTE              (* Set to 0                   *)
  78.          rtName:ADDRESS          (* Set to NULL                *)
  79.          rtIdString:ADDRESS      (* Set to NULL                *)
  80.          rtInit:ADDRESS          (* Point at self-initialization routine *)
  81.       END;
  82.  
  83. *)
  84.  
  85. BEGIN
  86.    CODE( 5A58H , 4356H ); (* 'ZXCV' literal. Helps to find this RomTag in RAM *)
  87.    RomTag;                (* rtMatchWord and rtMatchTag                       *)
  88.                           (*  This will produce a JSR RomTag, 6 bytes.        *)
  89.                           (* We will change the first 2 bytes to hex 4AFC,    *)
  90.                           (* which is the MatchWord value Exec searches for   *)
  91.                           (* after it LoadSeg()'s this library.               *)
  92.                           (* We will add 4 to the value in the last 4 bytes,  *)
  93.                           (* so that the relative location is bumped past the *)
  94.                           (* 'ZXCV' literal, and points at rtMatchWord.       *)
  95.  
  96.    CODE( 0 , 0 );                         (* rtEndSkip *)
  97.    CODE( RTFColdStart*256 + 1 );          (* rtFlags and rtVersion   *)
  98.    CODE( CARDINAL( NTLibrary )*256 + 0 ); (* rtType and rtPri        *)
  99.    CODE( 0 , 0 );                         (* rtName                  *)
  100.    CODE( 0 );                             (* First 2 bytes of rtIdString *)
  101.    Initialize;                            (* Second 2 bytes of rtIdString and rtInit *)
  102.                           (* This produces a JSR Initialize, 6 bytes.         *)
  103.                           (* We will change the first 2 bytes to 0000.        *)
  104. END RomTag;
  105.  
  106. PROCEDURE STRADR(VAR s:ARRAY OF CHAR):ADDRESS;
  107. BEGIN
  108.    RETURN(ADR(s));
  109. END STRADR;
  110.  
  111. (*
  112.    Exec will JSR to this routine AFTER it has found the Resident structure.
  113.    Register A0 will contain the SegList pointer, which you must save for later.
  114.    Be careful what ROM routines you call here. Stick to stuff that does not
  115.    cause any Wait() or Forbid() calls. Basically, just do what I have done and
  116.    you should be okay.
  117. *)
  118.  
  119. PROCEDURE Initialize;
  120. VAR
  121.    i:INTEGER;
  122. BEGIN
  123.    CODE(PUSHREGS,D0thruA5);                  (* movem.l  d0-d7/a0-a5,-(SP) *)
  124.    SegList := REGISTER( 8 );                 (* save SegList for later  *)
  125.    FOR i := 1 TO 4 DO
  126.       JumpTable[ i ].jeJMP := JMP;     (* Setup LVO jump table *)
  127.    END;
  128.    JumpTable[ 4 ].jeProc := Open;      (* These 4 vectors are REQUIRED and must *)
  129.    JumpTable[ 3 ].jeProc := Close;     (* be in THIS order.                     *)
  130.    JumpTable[ 2 ].jeProc := Expunge;   (* Note the subscripts are DESCENDING.   *)
  131.    JumpTable[ 1 ].jeProc := Reserved;
  132.  
  133.    WITH LibraryBase DO
  134.       libNode.lnType := BYTE( NTLibrary );   (* We are a LIBRARY, of course!   *)
  135.       libNode.lnName := STRADR( LibName );   (* This is how subsequent OpenLibrary()
  136.                                                 calls will find us            *)
  137.       libNegSize := 24;                      (* LVO jump table size           *)
  138.       libPosSize := 0;                       (* Size of variables AFTER Library *)
  139.       libVersion := 1;                       (* Our current Version           *)
  140.       libRevision := 0;                      (* Our current Revision          *)
  141.       libIdString := STRADR( LibId );        (* A formal ID for the library   *)
  142.       libOpenCnt := 0;                       (* We are unused right now       *)
  143.    END;
  144.    CODE(POPREGS,A5thruD0);                  (* movem.l  (SP)+,d0-d7/a0-a5 *)
  145.    CODE(PUSHREGS,D0thruA6);                 (* movem.l  d0-d7/a0-a6,-(SP) *)
  146.    SETREG(9,ADR(LibraryBase));              (* lea      a1,LibraryBase    *)
  147.    SETREG(14,ExecBase);                     (* movea.l  4,a6              *)
  148.    CODE(JSRA6,LVOAddLibrary);               (* jsr   _LVOAddLibrary(a6)   *)
  149.    CODE(POPREGS,A6thruD0);                  (* movem.l  (SP)+,d0-d7/a0-a6 *)
  150. END Initialize;
  151.  
  152. (*
  153.    Exec will JSR to this immediately after you return from your
  154.    self-initialization routine.
  155.    Do whatever you want in it, but be quick.
  156. *)
  157. PROCEDURE Open;
  158. BEGIN
  159.    INC( LibraryBase.libOpenCnt );
  160. END Open;
  161.  
  162. (*
  163.    Exec calls this when someone does a CloseLibrary().
  164.    Again, do whatever you want in it.
  165.    Exec expects 2 possible return values in D0:
  166.       NULL - Exec does nothing.
  167.       non-NULL - Exec assumes that D0 contains the SegList it passed you
  168.                  in the initialization routine. If Exec sees this, it will
  169.                  UnloadSeg() you! A GURU is assured if you pass a non-valid
  170.                  SegList pointer in D0!!!
  171. *)
  172.  
  173. PROCEDURE Close;
  174. BEGIN
  175.    DEC( LibraryBase.libOpenCnt );
  176.    IF LibraryBase.libOpenCnt # 0 THEN
  177.       SETREG( 0 , NULL );              (* Leave us in RAM   *)
  178.    ELSE
  179.       SETREG( 0 , SegList );           (* UnloadSeg() us now     *)
  180.    END;
  181. END Close;
  182.  
  183. (*
  184.    Exec calls this from the memory allocation routine when Exec needs
  185.    to free up some memory. 
  186.    Exec expects 2 possible return values in D0:
  187.       NULL - Exec does nothing. ( You stay loaded in RAM )
  188.       non-NULL - Exec assumes that D0 contains the SegList it passed you
  189.                  in the initialization routine. If Exec sees this, it will
  190.                  UnloadSeg() you! A GURU is assured if you pass a non-valid
  191.                  SegList pointer in D0!!!
  192. *)
  193.  
  194. PROCEDURE Expunge;
  195. BEGIN
  196.    SETREG( 0 , SegList );              (* UnloadSeg() us now   *)
  197. END Expunge;
  198.  
  199. PROCEDURE Reserved;
  200. BEGIN
  201.    SETREG( 0 , NULL );                 (* ALWAYS return NULL   *)
  202. END Reserved;
  203.  
  204. BEGIN
  205.    RomTag;         (* Place these references so that the linkage optimizer  *)
  206.                    (* leaves the procedure RomTag in the code.              *)
  207. END LibraryStub.
  208.