(*-------------------------------------------------------------------------*)
(*                                                                         *)
(*  Amiga Oberon Library Module: OberonLib            Date: 02-Nov-92      *)
(*                                                                         *)
(*   © 1992 by Fridtjof Siebert                                            *)
(*   Additional memory management by Lars Düning                           *)
(*                                                                         *)
(*-------------------------------------------------------------------------*)

(*
 * This is Oberon's startup module. It has some basic routines, variables
 * and types that are needed to launch and run an Oberon program.
 *
 * The compiler depends on the existance of the routines and variables
 * defined here. Modifying them will very likely cause severe problems.
 *
 * With this module, some standard procedures may not be used. They are:
 * NEW, DISPOSE and HALT. LONGINT multiplication, DIV and MOD are not
 * allowed here. This module may not import modules that are not compiled
 * with Option 'Implementation' set to '-'.
 *
 * For libraries, a slightly modified basic module has to be used. You may
 * create this module by compiling OberonLib.mod with "SET LibLink". After
 * compilation, you have to rename the created object file from
 * "obj/OberonLib.obj*" to "obj/LibOberonLib.obj*".
 *-------------------------------------------------------------------------
 * This is a modified version of OberonLib which is able to use an external
 * memory manager module named 'ExtMemory'. Just compile with "SET ExternMem"
 * for the proper routine calles.
 * For proper linkage you have to import 'ExtMemory' at least once into your
 * program.
 *
 *)

MODULE OberonLib;

IMPORT SYSTEM*;

TYPE

(*
 * Exec stuff:
 *)

  APTR = SYSTEM.ADDRESS;
  STRPTR = APTR;
  PROC = PROCEDURE;
  BYTE = SYSTEM.BYTE;

  CommonNode = STRUCT END;
  CommonNodePtr = UNTRACED POINTER TO CommonNode;

  NodePtr = UNTRACED POINTER TO Node;
  Node = STRUCT (dummy: CommonNode)
    succ   : NodePtr;
    pred   : NodePtr;
    type   : SHORTINT;
    pri    : SHORTINT;
    name   : STRPTR;
  END;

  MinNodePtr = UNTRACED POINTER TO MinNode;
  MinNode = STRUCT (dummy: CommonNode)
    succ : MinNodePtr;
    pred : MinNodePtr;
  END;

  CommonList = STRUCT END;
  CommonListPtr = UNTRACED POINTER TO CommonList;

  List = STRUCT (dummy: CommonList)
    head    : NodePtr;
    tail    : NodePtr;
    tailPred: NodePtr;
    type    : SHORTINT;
    pad     : BYTE;
  END;

  MinList = STRUCT (dummy: CommonList)
   head, tail, tailPred: MinNodePtr;
  END;

  TaskPtr = UNTRACED POINTER TO Task;
  Task = STRUCT (node : Node)
    flags       : SHORTSET;
    state       : SHORTSET;
    idNestCnt   : SHORTINT;         (* intr disabled nesting*)
    tdNestCnt   : SHORTINT;         (* task disabled nesting*)
    sigAlloc    : LONGSET;          (* sigs allocated *)
    sigWait     : LONGSET;          (* sigs we are waiting for *)
    sigRecvd    : LONGSET;          (* sigs we have received *)
    sigExcept   : LONGSET;          (* sigs we will take excepts for *)
    trapAlloc   : SET;              (* traps allocated *)
    trapAble    : SET;              (* traps enabled *)
    exceptData  : APTR;             (* points to except data *)
    exceptCode  : PROC;             (* points to except code *)
    trapData    : APTR;             (* points to trap code *)
    trapCode    : PROC;             (* points to trap data *)
    spReg       : APTR;             (* stack pointer        *)
    spLower     : APTR;             (* stack lower bound    *)
    spUpper     : APTR;             (* stack upper bound + 2*)
    switch      : PROC;             (* task losing CPU    *)
    launch      : PROC;             (* task getting CPU  *)
    memEntry    : List;             (* Allocated memory. Freed by RemTask() *)
    userData    : APTR;             (* For use by the task; no restrictions! *)
  END;

  MsgPortPtr = UNTRACED POINTER TO MsgPort;
  MsgPort = STRUCT (node : Node)
    flags   : SHORTINT;
    sigBit  : SHORTINT;        (* signal bit number    *)
    sigTask : APTR;            (* object to be signalled *)
    msgList : List;            (* message linked list  *)
  END;

  MessagePtr = APTR;

  Process * = UNTRACED POINTER TO STRUCT (task: Task)
                   msgPort       : MsgPort;
                   pad           : INTEGER;
                   segList       : LONGINT;
                   stackSize     : LONGINT;
                   globVec       : LONGINT;
                   taskNum       : LONGINT;
                   stackBase     : LONGINT;
                   result2       : LONGINT;
                   currentDir    : LONGINT;
                   cis           : LONGINT;
                   cos           : LONGINT;
                   consoleTask   : MsgPortPtr;
                   fileSystemTask: MsgPortPtr;
                   cli           : APTR;
                   returnAddr    : LONGINT;
                   pktWait       : LONGINT;
                   windowPtr     : LONGINT;
                 END;

  IntVector = STRUCT
    data : APTR;
    code : PROC;
    node : NodePtr;
  END;
  SoftIntList = STRUCT (list : List)   (* For EXEC use ONLY! *)
    pad : INTEGER;
  END;

  Library = STRUCT (node : Node)
    flags   : SHORTSET;
    pad     : BYTE;
    negSize : INTEGER;
    posSize : INTEGER;
    version : INTEGER;
    revision: INTEGER;
    idString: STRPTR;
    sum     : LONGINT;
    openCnt : INTEGER;
  END;

  ExecBasePtr = UNTRACED POINTER TO ExecBase;
  ExecBase = STRUCT (libNode : Library)
        softVer              : INTEGER;
        lowMemChkSum         : INTEGER;
        chkBase              : LONGINT;
        coldCapture          : APTR;
        coolCapture          : APTR;
        warmCapture          : APTR;
        sysStkUpper          : APTR;
        sysStkLower          : APTR;
        maxLocMem            : APTR;
        debugEntry           : APTR;
        debugData            : APTR;
        alertData            : APTR;
        maxExtMem            : APTR;
        chkSum               : INTEGER;
        intVects             : ARRAY 16 OF IntVector;
        thisTask             : TaskPtr;
        idleCount            : LONGINT;
        dispCount            : LONGINT;
        quantum              : INTEGER;
        elapsed              : INTEGER;
        sysFlags             : SET;
        idNestCnt            : SHORTINT;
        tdNestCnt            : SHORTINT;
        attnFlags            : SET;
        attnResched          : INTEGER;
        resModules           : APTR;
        taskTrapCode         : PROC;
        taskExceptCode       : PROC;
        taskExitCode         : PROC;
        taskSigAlloc         : LONGSET;
        taskTrapAlloc        : SET;
        memList              : List;
        resourceList         : List;
        deviceList           : List;
        intrList             : List;
        libList              : List;
        portList             : List;
        taskReady            : List;
        taskWait             : List;
        softInts             : ARRAY 5 OF SoftIntList;
        lastAlert            : ARRAY 4 OF LONGINT;
        vblankFrequency      : SHORTINT;
        powerSupplyFrequency : SHORTINT;
        semaphoreList        : List;
        kickMemPtr           : APTR;
        kickTagPtr           : APTR;
        kickCheckSum         : APTR;
        pad0                 : INTEGER;
        launchPoint          : LONGINT;
        ramLibPrivate        : APTR;
        eClockFrequency      : LONGINT;
        cacheControl         : APTR;
        taskID               : LONGINT;
        reserved1            : ARRAY 5 OF LONGINT;
        mmuLock              : APTR;
        reserved2            : ARRAY 3 OF LONGINT;
        memHandlers          : MinList;
        memHandler           : APTR;
      END;


CONST
  memClear = 16;


(*
 * execBase.thisTask.trapData points to this structure.
 * Global data may be got from here.
 *
 * To set up new Oberon-Taks correctly, use the Concurreny.mod.
 *)

TYPE
  TaskTrapDataPtr = UNTRACED POINTER TO TaskTrapData;
  TaskTrapData * = STRUCT

    mutator * : SYSTEM.ADDRESS;
                          (*
                           * This tasks mutator-structure used by
                           * garbagecollector.library. Only used when
                           * compiled with garbage-collector activated.
                           *
                           * The compiler depends on this element to be
                           * at offset 0!
                           *)

    a5 * : SYSTEM.ADDRESS;   (*
                           * Pointer to global variables, only needed for
                           * small data model.
                           *)

    haltProc * : PROC;    (*
                           * Procedure to be called when HALT() is
                           * executed.
                           *
                           * Only valid if LibLink is not set.
                           *
                           *)

    oldSP * : SYSTEM.ADDRESS;(*
                           * Original Contents of A7
                           *)

    reserverd: ARRAY 6 OF SYSTEM.ADDRESS;
                          (*
                           * will be used in future
                           *)

    user * : ARRAY 32 OF SYSTEM.ADDRESS;
                          (*
                           * May be used by application modules.
                           * Use AllocUser() and FreeUser() to
                           * lock elements of this array for your
                           * private use.
                           *)

  END;   (* TaskTrapData *)


(*
 * This variable may be used to easily access the trapData
 * of this task:
 *)

VAR
  execBase -, AbsExecBase[4] : UNTRACED POINTER TO STRUCT dummy: ARRAY 276 OF CHAR;
    thisTask-: UNTRACED POINTER TO STRUCT dummy: ARRAY 46 OF CHAR;
      trapData-: TaskTrapDataPtr;
    END;
  END;

PROCEDURE Forbid     {execBase,-132};
PROCEDURE Permit     {execBase,-138};
PROCEDURE AllocMem   {execBase,-198}(byteSize{0}: LONGINT; requirements{1}: LONGSET): APTR;
PROCEDURE FreeMem    {execBase,-210}(memoryBlock{9}: APTR; byteSize{0}   : LONGINT);
PROCEDURE AddHead    {execBase,-240}(VAR list{8}   : CommonList; node{9}       : CommonNodePtr);
PROCEDURE Remove     {execBase,-252}(node{9}       : CommonNodePtr);
PROCEDURE GetMsg     {execBase,-372}(port{8}       : MsgPortPtr): MessagePtr;
PROCEDURE ReplyMsg   {execBase,-378}(message{9}    : MessagePtr);
PROCEDURE WaitPort   {execBase,-384}(port{8}       : MsgPortPtr);
PROCEDURE CopyMemAPTR{execBase,-624}(source{8}: APTR; dest{9}: APTR; size{0}: LONGINT);


VAR

  wbStarted-: BOOLEAN;            (* Was this program started from Workbench?
                                   * (undefined if you link your program to
                                   * a library or a device)
                                   *)

  dosCmdLen-: LONGINT;            (* When started from CLI: length and
                                   *)
  dosCmdBuf-: APTR;               (* address of command line arguments.
                                   * Do not use these variables if wbStarted
                                   * is TRUE.
                                   *)

  wbenchMsg-: MessagePtr;         (* Startup-Message from Workbench. Do not
                                   * use this variable if wbStarted is FALSE.
                                   *)

  closing * : BOOLEAN;            (* Indicates that this program is 'closing',
                                   * ie it's currently executing the CLOSE-
                                   * Statements.
                                   *)

  Break * : BOOLEAN;              (* This variable is set to TRUE when this
                                   * program was stopped using ^C or Break.
                                   *)

  HaltProc*: PROC;                (*
                                   * This procedure is called when HALT() is
                                   * executed.
                                   *
                                   * HALT(x) is equivalent to
                                   *
                                   *   Result := n; HaltProc;
                                   *)
  Result*: LONGINT;               (*
                                   * Return-code of this program. HALT()'s
                                   * parameter is stored here.
                                   *)

  OldSP-:  UNTRACED POINTER TO STRUCT
                                  (* Contents of A7 when this program was
                                   * started.
                                   *)
    returnAdr-: LONGINT;          (* This program's return address
                                   *)
    stackSize-: LONGINT;          (* This Program's stack size
                                   *)
  END;

  Me-: Process;                   (* This program's main process
                                   *)

  MemReqs*: LONGSET;              (* Memory requirements used by NEW(). NOTE:
                                   * These requirements are only used for
                                   * UNTRACED POINTERs.
                                   *)

  OutOfMemHandler * : PROCEDURE();
      (* You may set this variable to a procedure that will be called when
       * NEW() fails to allocate some memory.
       *
       * This procedure should try to free some memory or inform the user
       * that this program needs some more memory.
       *
       * When this routine returns, NEW() retries to allocate
       * the memory.
       *
       * An example of a memory Handler:
       *
       *   PROCEDURE * MyMemHandler();
       *   BEGIN
       *     IF ~ Requests.Request("My Program:",
       *                           "I ran out of memory!",
       *                           "retry","abort")
       *     THEN
       *       HALT(20);
       *     END;
       *   END MyMemHandler;
       *
       * NOTE:
       *   Do not try to allocate memory within your memory handler via
       *   NEW()! This will cause a endless recursion.
       *)


(* $IF LibLink *)

  OpenOk["LibraryHead.OpenOk"]: BOOLEAN;

(* $END *)


(*-------------------------------------------------------------------------*)

(* $IFNOT ExternMem *)

(*
 * Memory list:
 *
 * Untraced objects allocated using NEW() stored within this list. They
 * will be freed automatically when this program exits.
 *)

TYPE
  MemElementPtr = UNTRACED POINTER TO MemElement;
  MemElement = STRUCT (node : MinNode);
                 size: LONGINT;            (* the block's size  *)
                 mem: INTEGER;             (* the actual data   *)
               END;

VAR
  first: MinList;
  el1,el2: MemElementPtr;

(* $END *)

VAR
  m: LONGINT;

(*
 * original values of modified entries of our task:
 *)

  oldTrapProc: PROCEDURE; (* original Me.trapCode *)
  oldSPLower: LONGINT;    (* original Me.spLower  *)
  oldTrapData: LONGINT;   (* original Me.trapData *)

  taskTrapData: TaskTrapData;
      (*
       * Trapdata of this program's main process.
       *)

  usedUser: LONGSET;
      (* Allocated entries of TaskTrapData.user
       *)

(* $OvflChk- $RangeChk- $StackChk- $NilChk- $ReturnChk- $CaseChk- *)


(*------  Integer Math functions:  ------*)


PROCEDURE Mul*(a{0},b{1}:LONGINT): LONGINT; (* $EntryExitCode- *)
(*
 * Result = a * b
 *)

BEGIN
SYSTEM.INLINE(
  048E7H,03000H,04A80H,05BC3H,06A02H,04480H,04A81H,06A04H,
  04603H,04481H,04840H,04841H,04A40H,0670CH,04A41H,06706H,
  0003CH,00002H,0601CH,0C340H,04840H,03401H,04841H,0C2C0H,
  0C0C2H,04840H,04A40H,066E8H,0D081H,06BE4H,04A03H,06702H,
  04480H,04CDFH,0000CH,04E75H);
END Mul;

PROCEDURE ModDiv*(a{0},b{1}:LONGINT): LONGINT; (* $EntryExitCode- *)
(*
 * Result in D0 = a DIV b;
 * Result in D1 = a MOD b;
 *)

BEGIN
SYSTEM.INLINE(
  048E7H,03C00H,02800H,06A02H,04480H,02A01H,06A02H,04481H,
  00C81H,00000H,0FFFFH,0621AH,03601H,03400H,04240H,04840H,
  080C3H,02200H,04840H,03202H,082C3H,03001H,04241H,04841H,
  0601EH,02601H,02200H,04241H,04841H,04840H,04240H,0740FH,
  0D080H,0D381H,0B681H,06204H,09283H,05240H,051CAH,0FFF2H,
  04A84H,06A02H,04481H,0BB84H,06A0AH,04480H,04A81H,06704H,
  05380H,0D285H,04CDFH,0003CH,04E75H);
END ModDiv;


(*------  Memory functions:  ------*)

(* $IFNOT ExternMem *)

PROCEDURE New*(VAR adr: APTR;
                  size: LONGINT);
(*
 * Allocates size bytes of memory. Assigns a reference to the allocated
 * memory to adr.
 *
 * If you link your program to a executable program, this routine ensures
 * that the allocation succeeds. If there's not enough memory, New() will
 * terminate the execution of this program.
 *
 * If you want to link your program to a library (using the oberon library
 * linker LibLink), this routine may fail to allocate the memory. In this
 * case, adr will be set to NIL. This routine is called everytime a untraced
 * object is allocated using NEW(), so you'll have to check an object
 * allocated using NEW() (if you're using LibLink).
 *)

VAR
  mem: MemElementPtr;

BEGIN
  INC(size,SYSTEM.SIZE(MinNode)+SYSTEM.SIZE(LONGINT));

  (* $IF LibLink THEN *)

    Forbid;   (* Disable Taskswitching to make NEW() reentrant *)
      mem := AllocMem(size,MemReqs);

      IF mem=NIL THEN
        adr := NIL;
      ELSE
        mem.size := size;
        AddHead(first,mem);
        adr := SYSTEM.ADR(mem.mem);
      END;
    Permit;

  (* $ELSE *)

    Forbid;   (* Disable Taskswitching to make NEW() reentrant *)
      REPEAT
        mem := AllocMem(size,MemReqs);
        IF mem=NIL THEN
          Permit;
            OutOfMemHandler();
          Forbid;
        END;
      UNTIL mem#NIL;

      mem.size := size;
      AddHead(first,mem);

    Permit;

    adr := SYSTEM.ADR(mem.mem);

  (* $END *)

END New;


PROCEDURE Dispose*(VAR adr: APTR);
(*
 * Dispose() frees the memory used by an object allocated using New().
 *
 * This routine is called whenever DISPOSE() is used.
 *
 *)

VAR mem: MemElementPtr;

BEGIN
  IF adr#NIL THEN
    mem := SYSTEM.VAL(APTR,SYSTEM.VAL(LONGINT,adr)-
                             (SIZE(MinNode)+SIZE(LONGINT)));
    Forbid;  (* DIPOSE() should be reentrant *)
      Remove(mem);
      FreeMem(mem,mem.size);
    Permit;
    adr := NIL;
  END;
END Dispose;

(* $ELSE *)

PROCEDURE MemBegin {"ExtMemory.Begin"};
PROCEDURE MemClose {"ExtMemory.Close"};
PROCEDURE MemNew {"ExtMemory.new"} (VAR adr: APTR; size: LONGINT);
PROCEDURE MemAllocate {"ExtMemory.allocate"} (VAR adr: APTR; size: LONGINT);
PROCEDURE MemDispose {"ExtMemory.dispose"} (VAR adr: APTR);


PROCEDURE New * (VAR adr: APTR; size: LONGINT);
BEGIN
(* $IFNOT LibLink *)
  MemNew(adr, size);
(* $ELSE *)
  MemAllocate(adr, size);
(* $END *)
END New;

PROCEDURE Dispose * (VAR adr: APTR);
BEGIN MemDispose(adr); END Dispose;

(* $END *)

(*------  Allocate:  ------*)

(* $IFNOT ExternMem *)

PROCEDURE Allocate*(VAR adr: APTR;
                    size: LONGINT);
(*
 * Allocates size bytes of memory. Assigns a reference to the allocated
 * memory to adr.
 *
 * If there's not enough memory, the result will be NIL, so you'll always
 * have to check adr#NIL.
 *
 *)

VAR
  mem: MemElementPtr;

BEGIN

  INC(size,SYSTEM.SIZE(MinNode)+SYSTEM.SIZE(LONGINT));

  Forbid;  (* Disable Taskswitching to make ALLOCATE() reentrant *)

    mem := AllocMem(size,MemReqs);

    IF mem=NIL THEN
      adr := NIL;
    ELSE
      mem.size := size;
      AddHead(first,mem);
      adr := SYSTEM.ADR(mem.mem);
    END;

  Permit;

END Allocate;

(* $ELSE *)

PROCEDURE Allocate * (VAR adr: APTR; size: LONGINT);
BEGIN MemAllocate(adr, size); END Allocate;

(* $END *)

(*------  String Copy:  ------*)


PROCEDURE Copy*(    source: ARRAY OF CHAR;    (* $EntryExitCode- *)
                VAR dest:   ARRAY OF CHAR);
(*
 * Copy strings. This routine is called whenever COPY() is used.
 *
 * This routine is (c) 1993 by. Carsten A. Duske. Thanks to
 * Carsten for permission to use his code. -- Fridtjof.
 *)

BEGIN
  SYSTEM.INLINE(
         02C5FH,         (* Copy:     MOVEA.L   (A7)+,A6     *)
         0221FH,         (*           MOVE.L    (A7)+,D1     *)
         0225FH,         (*           MOVEA.L   (A7)+,A1     *)
         0201FH,         (*           MOVE.L    (A7)+,D0     *)
         0205FH,         (*           MOVEA.L   (A7)+,A0     *)
         0B081H,         (*           CMP.L     D1,D0        *)
         06B0EH,         (*           BMI.S     \start       *)
         02001H,         (*           MOVE.L    D1,D0        *)
         05380H,         (*           SUBQ.L    #1,D0        *)
         06B18H,         (*           BMI.S     \done        *)
         06712H,         (*           BEQ.S     \term        *)
         06004H,         (*           BRA.S     \start       *)
         04840H,         (* \upper    SWAP.W    D0           *)
         012D8H,         (* \lower    MOVE.B    (A0)+,(A1)+  *)
         057C8H,0FFFCH,  (* \start    DBEQ      D0,\lower    *)
         0670AH,         (*           BEQ.S     \done        *)
         04840H,         (*           SWAP.W    D0           *)
         051C8H,0FFF2H,  (*           DBRA      D0,\upper    *)
         07200H,         (* \term     MOVEQ     #0,D1        *)
         01281H,         (*           MOVE.B    D1,(A1)      *)
         04ED6H          (* \done     JMP       (A6)         *)
      );
END Copy;


(*------  Stack Check:  ------*)


PROCEDURE StackChk*(size{0}: LONGINT);
(*
 * This routine is used by the compiler to check free stack space.
 *
 * This routine also checks if ^C was hit (this does only work in
 * conjunction with Break.mod or BreakRq.mod).
 *
 * Note:
 *   The compiler assumes that this routine preserves all registers
 *   apart from D0.
 *
 *)

CONST
  TRAP8 = 04E48H;

BEGIN

(* $IFNOT LibLink (no stack checking within libraries and devices *)

  IF Break THEN SYSTEM.INLINE(TRAP8) END;
  SYSTEM.INLINE(
        02F0DH,           (*     MOVE.L  A5,-(A7)                   *)
        02A78H,00004H,    (*     MOVEA.L 0004H,A5       IF AbsExecBase *)
        02A6DH,00114H,    (*     MOVEA.L 276(A5),A5       .thisTask *)
        02A6DH,0003AH,    (*     MOVEA.L 58(A5),A5        .spLower  *)
        0DAFCH,00600H,
                          (*     ADDA.W  #0600H,A5        + 600H + MaxListParSize *)
        0DBC0H,           (*     ADDA.L  D0,A5            + D0      *)
        0BBCFH,           (*     CMPA.L  A7,A5            > A7      *)
        06302H,           (*     BLS.S   ok;            THEN        *)
        04E42H,           (*     TRAP    #2               TRAP #2   *)
        02A5FH);          (* ok: MOVEA.L     (A7)+,A5   END;        *)

(* $END *)

END StackChk;


(*------  Check Precessor:  ------*)


PROCEDURE CheckProcessor*(what{0}: SET); (* $EntryExitCode- *)
(*
 * Check if this machine has a processer wich satifies the given
 * AttnFlags (see Exec.mod).
 *)

BEGIN
  SYSTEM.INLINE(02078H,00004H,       (*    MOVEA.L 4,A0              *)
             03228H,00128H,       (*    MOVE.W  attnFlags(A0),D1  *)
             0C240H,              (*    AND.W   D0,D1             *)
             0B240H,              (*    CMP.W   D0,D1             *)
             06602H,              (*    BNE.S   x                 *)
             04E75H,              (*    RTS                       *)
             04E46H);             (* x: TRAP    #6                *)
END CheckProcessor;


(*------  SetA5:  ------*)


PROCEDURE SetA5*;
(*
 * Set A5 to point to the global variables area.
 * This must be done in the small data model before global variables
 * are touched by a handler routine and similar things.
 *
 * NOTE: This may not be used to set A5 within an interrupt routine
 *       or within a task not launched via Concurrency.mod. In these
 *       cases you'll have to pass A5 using the interrupt's or task's
 *       userData or similar attributes.
 *)

(* $IF SmallData *)
  (* $IF LibLink *)
  VAR
    globals["LibraryHead.Globals"]: LONGINT;
  (* $END *)
  BEGIN
  (* $IF LibLink *)
    SYSTEM.SETREG(13,globals);
  (* $ELSE *)
    SYSTEM.SETREG(13,AbsExecBase.thisTask.trapData.a5);
  (* $END *)
(* $END *)
END SetA5;


(*------  Trap Handler:  ------*)


PROCEDURE TrapHandler();
BEGIN
  SetA5;
  SYSTEM.SETREG(15,execBase.thisTask.trapData.oldSP);
  Result := -1;
  HaltProc();
END TrapHandler;


PROCEDURE * TrapProc(); (* $EntryExitCode- *)
(*
 * Default trap handler. Stops execution of this program in case
 * of a run time error.
 *)
BEGIN
  SYSTEM.SETREG(8,TrapHandler);
  SYSTEM.INLINE(
        0201FH,             (*    MOVE.L  (A7)+,D0   *)
        00C40H,00003H,      (*    CMPI.W  #3,D0      *)
        06202H,             (*    BHI.S   l          *)
        0504FH,             (*    ADDQ.W  #8,A7      *)
        02F48H,00002H,      (* l: MOVE.L  A0,2(A7)   *)
        04E73H);            (*    RTE                *)
END TrapProc;


(*------  Halt:  ------*)

(* $IF LibLink *)

(*
 * HaltProc for libraries:
 *)

PROCEDURE CloseAll{"LibraryHead.CloseAll"};

PROCEDURE Halt;
CONST RTS = 4E75H;
BEGIN
  CloseAll;
  OpenOk := FALSE;
  SYSTEM.SETREG(15,OldSP);
  SYSTEM.INLINE(RTS);         (* $EntryExitCode- tricky, no exit code *)
END Halt;

(* $ELSE *)

(*
 * HaltProc. Calls Halt procedure of current process.
 *)

PROCEDURE Halt;
BEGIN
  SYSTEM.SETREG(15,AbsExecBase.thisTask.trapData.oldSP);
  execBase.thisTask.trapData.haltProc;
END Halt;

(* $END *)


(*------  Default Out of Mem Handler:  ------*)


PROCEDURE DefaultOutOfMemHandler;   (* $EntryExitCode- *)
(*
 * This does nothing but a TRAP #9 to indicate an out of memory situation.
 *)
CONST TRAP9= 04E49H;
BEGIN
  SYSTEM.INLINE(TRAP9);
END DefaultOutOfMemHandler;


(*------  Alloc and Free TaskTrapData.user[] entries:  ------*)


PROCEDURE AllocUser * (): INTEGER;
(*
 * Obtain the right to use one of the TaskTrapData.user[] entries.
 * Result is the number of the allocated entry or -1 when all
 * entries are used.
 *)
VAR
  i: INTEGER;
BEGIN
  i := 31;
  LOOP
    IF i < 0            THEN                   EXIT
    ELSIF i IN usedUser THEN DEC(i)
                        ELSE INCL(usedUser,i); EXIT
    END;
  END;
  RETURN i;
END AllocUser;


PROCEDURE FreeUser * (i: INTEGER);
(*
 * Release the right to use one of the TaskTrapData.user[] entries
 * obtained by AllocUser.
 *
 *)
BEGIN
  EXCL(usedUser,i);
END FreeUser;


(*------  SYSTEM Routines:  ------*)


PROCEDURE Bit*(a: SYSTEM.ADDRESS; n: LONGINT): BOOLEAN;
TYPE LSP = UNTRACED POINTER TO LONGSET;
BEGIN
  RETURN n IN SYSTEM.VAL(LSP,a)^;
END Bit;


PROCEDURE Move*(a0,a1: SYSTEM.ADDRESS; n: LONGINT);
VAR
  p0,p1: UNTRACED POINTER TO ARRAY MAX(LONGINT)-1 OF SYSTEM.BYTE;
  i: LONGINT;
BEGIN
  IF    (SYSTEM.VAL(LONGINT,a0)   <= SYSTEM.VAL(LONGINT,a1)) &
        (SYSTEM.VAL(LONGINT,a0)+n >  SYSTEM.VAL(LONGINT,a1))
  THEN                                 (* a1 liegt in src:          *)
    p0 := a0; p1 := a1;                (*  |-----src-----|          *)
    WHILE n>0 DO                       (*         |-----dst-----|   *)
      DEC(n);
      p1[n] := p0[n];
    END;
  ELSIF (SYSTEM.VAL(LONGINT,a1)   <= SYSTEM.VAL(LONGINT,a0)) &
        (SYSTEM.VAL(LONGINT,a1)+n >  SYSTEM.VAL(LONGINT,a0))
  THEN                                 (* a0 liegt in dst:          *)
    p0 := a0; p1 := a1;                (*         |-----src-----|   *)
    FOR i:=0 TO n-1 DO                 (*  |-----dst-----|          *)
      p1[i] := p0[i];
    END;
  ELSE
    CopyMemAPTR(a0,a1,n);
  END;
END Move;


(*------  Init:  ------*)


BEGIN

  execBase := AbsExecBase;

(* $IF LibLink *)

  OldSP     := SYSTEM.REG(8); (* Library startup code has copied A7 to A0   *)

  dosCmdLen := 0;          (* all these variables mustn't be used within *)
  dosCmdBuf := NIL;        (* a library!                                 *)
  wbenchMsg := NIL;
  Me := NIL;

  HaltProc := Halt;

  OpenOk := TRUE;

(* $ELSE *)

  dosCmdLen := SYSTEM.REG(0);
  dosCmdBuf := SYSTEM.REG(8);

  Me := SYSTEM.VAL(Process,execBase.thisTask);

  taskTrapData.a5       := SYSTEM.REG(13);
  taskTrapData.haltProc := HaltProc;
  taskTrapData.oldSP    := OldSP;
  HaltProc              := Halt;
  oldTrapData           := Me.task.trapData;
  Me.task.trapData      := SYSTEM.ADR(taskTrapData);

  oldSPLower := Me.task.spLower;
  Me.task.spLower  := SYSTEM.VAL(LONGINT,OldSP) - OldSP.stackSize + 256;

  oldTrapProc      := Me.task.trapCode; (* install Traphandler *)

  Me.task.trapCode := TrapProc;

  wbStarted := Me.cli=NIL;

  IF wbStarted THEN

    WaitPort(SYSTEM.ADR(Me.msgPort));
    wbenchMsg := GetMsg(SYSTEM.ADR(Me.msgPort));

  END;

(* $END *)

  Result := 0;
  closing := FALSE;

  OutOfMemHandler := DefaultOutOfMemHandler;

  Break := FALSE;

  MemReqs := LONGSET{memClear};

(* $IFNOT ExternMem *)

  first.head     := SYSTEM.ADR(first.tail);
  first.tailPred := SYSTEM.ADR(first.head);
  first.tail     := NIL;

(* $ELSE *)

  MemBegin;

(* $END *)

  usedUser := LONGSET{};

CLOSE

(* $IFNOT ExternMem *)

  el1 := first.head;
  LOOP
    el2 := el1.node.succ;
    IF el2=NIL THEN EXIT END;
    FreeMem(el1,el1.size);
    el1 := el2
  END;

(* $ELSE *)

  MemClose;

(* $END *)

(* $IFNOT LibLink *)

  Me.task.trapCode := oldTrapProc; (* remove Traphandler *)
  Me.task.spLower  := oldSPLower;
  Me.task.trapData := oldTrapData;

  IF wbStarted THEN

    Forbid;
    ReplyMsg(wbenchMsg);

  END;

  SYSTEM.SETREG(0,Result);

(* $END *)

END OberonLib.