MODULE LibraryStub;
(*
   This program compiles under TDI version 3.00A.
   For other Modula-2 systems, you will have to change the IMPORT statements.
*)

(*
   A Modula-2 stub for a loadable Exec library. You must compile&link, then
   run the object code against program 'm2lib'. ( Ex: m2lib librarystub )
   All this is only necessary because Modula-2 does not support static initialization
   of global variables.
*)

FROM  AMIGAX   IMPORT
   ExecBase;

FROM  Resident IMPORT
   RTFColdStart;           (* Our library will be self-initializing. The alternative
                              is RTFAutoInit, which will be initialized by Exec.  *)

FROM  Libraries   IMPORT
   LibraryPtr, Library;

FROM  Nodes IMPORT
   NTLibrary;


FROM  SYSTEM   IMPORT
   ADR,  ADDRESS, BYTE, NULL, SETREG,  CODE, REGISTER;

CONST
   LibName='stub.library';
   LibId='stub.library Ver 1.0 (05 Jan 1990)  '; (* Trailing 2 spaces necessary *)

   JMP=4EF9H;  (* JMP machine instruction *)
   JSRA6=4EAEH;(* JSR xxx(a6) machine instruction *)
   PUSHREGS=48E7H;
   POPREGS=4CDFH;
   LVOAddLibrary=0FE74H;
   D0thruA5=0FFFCH;
   A5thruD0=3FFFH;
   D0thruA6=0FFFEH;
   A6thruD0=7FFFH;

TYPE
   JumpEntry=
      RECORD
         jeJMP:INTEGER;          (* Will move JMP to here   *)
         jeProc:PROC;
      END;
VAR
   SegList:ADDRESS;
   JumpTable:ARRAY[ 1..4 ] OF JumpEntry;
   LibraryBase:Library;

(*$P-*)  (* This is NOT an executable procedure       *)
(*$S-*)  (* DO NOT check stack space EVER ! *)
PROCEDURE RomTag;
(*
   This procedure does NOT get executed, it just places
   a partially initialized Resident structure in the hunk. We have to
   change it so that it will be a valid Resident structure at LoadSeg()
   time. Program 'm2lib' will search for the characters 'ZXCV', which
   will be considered the first 4 bytes BEFORE the Resident structure
   begins.

   Here is the format for a Resident structure.
      Resident=RECORD
         rtMatchWord:CARDINAL;   (* MUST equal 4AFCH           *)
         rtMatchTag:ADDRESS      (* MUST point at rtMatchWord.
                                    A valid Resident structure MUST have
                                    rtMatchTag=ADR( rtMatchWord ) *)
         rtEndSkip:ADDRESS       (* Set to NULL                *)
         rtFlags:BYTE            (* Set to RTFColdStart        *)
         rtVersion:BYTE          (* Set to your library version*)
         rtType:BYTE             (* Set to NTLibrary           *)
         rtPri:BYTE              (* Set to 0                   *)
         rtName:ADDRESS          (* Set to NULL                *)
         rtIdString:ADDRESS      (* Set to NULL                *)
         rtInit:ADDRESS          (* Point at self-initialization routine *)
      END;

*)

BEGIN
   CODE( 5A58H , 4356H ); (* 'ZXCV' literal. Helps to find this RomTag in RAM *)
   RomTag;                (* rtMatchWord and rtMatchTag                       *)
                          (*  This will produce a JSR RomTag, 6 bytes.        *)
                          (* We will change the first 2 bytes to hex 4AFC,    *)
                          (* which is the MatchWord value Exec searches for   *)
                          (* after it LoadSeg()'s this library.               *)
                          (* We will add 4 to the value in the last 4 bytes,  *)
                          (* so that the relative location is bumped past the *)
                          (* 'ZXCV' literal, and points at rtMatchWord.       *)

   CODE( 0 , 0 );                         (* rtEndSkip *)
   CODE( RTFColdStart*256 + 1 );          (* rtFlags and rtVersion   *)
   CODE( CARDINAL( NTLibrary )*256 + 0 ); (* rtType and rtPri        *)
   CODE( 0 , 0 );                         (* rtName                  *)
   CODE( 0 );                             (* First 2 bytes of rtIdString *)
   Initialize;                            (* Second 2 bytes of rtIdString and rtInit *)
                          (* This produces a JSR Initialize, 6 bytes.         *)
                          (* We will change the first 2 bytes to 0000.        *)
END RomTag;

PROCEDURE STRADR(VAR s:ARRAY OF CHAR):ADDRESS;
BEGIN
   RETURN(ADR(s));
END STRADR;

(*
   Exec will JSR to this routine AFTER it has found the Resident structure.
   Register A0 will contain the SegList pointer, which you must save for later.
   Be careful what ROM routines you call here. Stick to stuff that does not
   cause any Wait() or Forbid() calls. Basically, just do what I have done and
   you should be okay.
*)

PROCEDURE Initialize;
VAR
   i:INTEGER;
BEGIN
   CODE(PUSHREGS,D0thruA5);                  (* movem.l  d0-d7/a0-a5,-(SP) *)
   SegList := REGISTER( 8 );                 (* save SegList for later  *)
   FOR i := 1 TO 4 DO
      JumpTable[ i ].jeJMP := JMP;     (* Setup LVO jump table *)
   END;
   JumpTable[ 4 ].jeProc := Open;      (* These 4 vectors are REQUIRED and must *)
   JumpTable[ 3 ].jeProc := Close;     (* be in THIS order.                     *)
   JumpTable[ 2 ].jeProc := Expunge;   (* Note the subscripts are DESCENDING.   *)
   JumpTable[ 1 ].jeProc := Reserved;

   WITH LibraryBase DO
      libNode.lnType := BYTE( NTLibrary );   (* We are a LIBRARY, of course!   *)
      libNode.lnName := STRADR( LibName );   (* This is how subsequent OpenLibrary()
                                                calls will find us            *)
      libNegSize := 24;                      (* LVO jump table size           *)
      libPosSize := 0;                       (* Size of variables AFTER Library *)
      libVersion := 1;                       (* Our current Version           *)
      libRevision := 0;                      (* Our current Revision          *)
      libIdString := STRADR( LibId );        (* A formal ID for the library   *)
      libOpenCnt := 0;                       (* We are unused right now       *)
   END;
   CODE(POPREGS,A5thruD0);                  (* movem.l  (SP)+,d0-d7/a0-a5 *)
   CODE(PUSHREGS,D0thruA6);                 (* movem.l  d0-d7/a0-a6,-(SP) *)
   SETREG(9,ADR(LibraryBase));              (* lea      a1,LibraryBase    *)
   SETREG(14,ExecBase);                     (* movea.l  4,a6              *)
   CODE(JSRA6,LVOAddLibrary);               (* jsr   _LVOAddLibrary(a6)   *)
   CODE(POPREGS,A6thruD0);                  (* movem.l  (SP)+,d0-d7/a0-a6 *)
END Initialize;

(*
   Exec will JSR to this immediately after you return from your
   self-initialization routine.
   Do whatever you want in it, but be quick.
*)
PROCEDURE Open;
BEGIN
   INC( LibraryBase.libOpenCnt );
END Open;

(*
   Exec calls this when someone does a CloseLibrary().
   Again, do whatever you want in it.
   Exec expects 2 possible return values in D0:
      NULL - Exec does nothing.
      non-NULL - Exec assumes that D0 contains the SegList it passed you
                 in the initialization routine. If Exec sees this, it will
                 UnloadSeg() you! A GURU is assured if you pass a non-valid
                 SegList pointer in D0!!!
*)

PROCEDURE Close;
BEGIN
   DEC( LibraryBase.libOpenCnt );
   IF LibraryBase.libOpenCnt # 0 THEN
      SETREG( 0 , NULL );              (* Leave us in RAM   *)
   ELSE
      SETREG( 0 , SegList );           (* UnloadSeg() us now     *)
   END;
END Close;

(*
   Exec calls this from the memory allocation routine when Exec needs
   to free up some memory. 
   Exec expects 2 possible return values in D0:
      NULL - Exec does nothing. ( You stay loaded in RAM )
      non-NULL - Exec assumes that D0 contains the SegList it passed you
                 in the initialization routine. If Exec sees this, it will
                 UnloadSeg() you! A GURU is assured if you pass a non-valid
                 SegList pointer in D0!!!
*)

PROCEDURE Expunge;
BEGIN
   SETREG( 0 , SegList );              (* UnloadSeg() us now   *)
END Expunge;

PROCEDURE Reserved;
BEGIN
   SETREG( 0 , NULL );                 (* ALWAYS return NULL   *)
END Reserved;

BEGIN
   RomTag;         (* Place these references so that the linkage optimizer  *)
                   (* leaves the procedure RomTag in the code.              *)
END LibraryStub.