home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / Misc / OB3.2D2.DMS / in.adf / Module / OberonLib.mod < prev    next >
Encoding:
Text File  |  1994-08-05  |  27.6 KB  |  966 lines
  1. (*-------------------------------------------------------------------------*)
  2. (*                                                                         *)
  3. (*  Amiga Oberon Library Module: OberonLib            Date: 02-Nov-92      *)
  4. (*                                                                         *)
  5. (*   © 1992 by Fridtjof Siebert                                            *)
  6. (*                                                                         *)
  7. (*-------------------------------------------------------------------------*)
  8.  
  9. (*
  10.  * This is Oberon's startup module. It has some basic routines, variables
  11.  * and types that are needed to launch and run an Oberon program.
  12.  *
  13.  * The compiler depends on the existance of the routines and variables
  14.  * defined here. Modifying them will very likely cause severe problems.
  15.  *
  16.  * With this module, some standard procedures may not be used. They are:
  17.  * NEW, DISPOSE and HALT. LONGINT multiplication, DIV and MOD are not
  18.  * allowed here. This module may not import modules that are not compiled
  19.  * with Option 'Implementation' set to '-'.
  20.  *
  21.  * For libraries, a slightly modified basic module has to be used. You may
  22.  * create this module by compiling OberonLib.mod with "SET LibLink". After
  23.  * compilation, you have to rename the created object file from
  24.  * "obj/OberonLib.obj*" to "obj/LibOberonLib.obj*".
  25.  *
  26.  *)
  27.  
  28. MODULE OberonLib;
  29.  
  30. IMPORT SYSTEM*;
  31.  
  32. TYPE
  33.  
  34. (*
  35.  * Exec stuff:
  36.  *)
  37.  
  38.   APTR = SYSTEM.ADDRESS;
  39.   STRPTR = APTR;
  40.   PROC = PROCEDURE;
  41.   BYTE = SYSTEM.BYTE;
  42.  
  43.   CommonNode = STRUCT END;
  44.   CommonNodePtr = UNTRACED POINTER TO CommonNode;
  45.  
  46.   NodePtr = UNTRACED POINTER TO Node;
  47.   Node = STRUCT (dummy: CommonNode)
  48.     succ   : NodePtr;
  49.     pred   : NodePtr;
  50.     type   : SHORTINT;
  51.     pri    : SHORTINT;
  52.     name   : STRPTR;
  53.   END;
  54.  
  55.   MinNodePtr = UNTRACED POINTER TO MinNode;
  56.   MinNode = STRUCT (dummy: CommonNode)
  57.     succ : MinNodePtr;
  58.     pred : MinNodePtr;
  59.   END;
  60.  
  61.   CommonList = STRUCT END;
  62.   CommonListPtr = UNTRACED POINTER TO CommonList;
  63.  
  64.   List = STRUCT (dummy: CommonList)
  65.     head    : NodePtr;
  66.     tail    : NodePtr;
  67.     tailPred: NodePtr;
  68.     type    : SHORTINT;
  69.     pad     : BYTE;
  70.   END;
  71.  
  72.   MinList = STRUCT (dummy: CommonList)
  73.    head, tail, tailPred: MinNodePtr;
  74.   END;
  75.  
  76.   TaskPtr = UNTRACED POINTER TO Task;
  77.   Task = STRUCT (node : Node)
  78.     flags       : SHORTSET;
  79.     state       : SHORTSET;
  80.     idNestCnt   : SHORTINT;         (* intr disabled nesting*)
  81.     tdNestCnt   : SHORTINT;         (* task disabled nesting*)
  82.     sigAlloc    : LONGSET;          (* sigs allocated *)
  83.     sigWait     : LONGSET;          (* sigs we are waiting for *)
  84.     sigRecvd    : LONGSET;          (* sigs we have received *)
  85.     sigExcept   : LONGSET;          (* sigs we will take excepts for *)
  86.     trapAlloc   : SET;              (* traps allocated *)
  87.     trapAble    : SET;              (* traps enabled *)
  88.     exceptData  : APTR;             (* points to except data *)
  89.     exceptCode  : PROC;             (* points to except code *)
  90.     trapData    : APTR;             (* points to trap code *)
  91.     trapCode    : PROC;             (* points to trap data *)
  92.     spReg       : APTR;             (* stack pointer        *)
  93.     spLower     : APTR;             (* stack lower bound    *)
  94.     spUpper     : APTR;             (* stack upper bound + 2*)
  95.     switch      : PROC;             (* task losing CPU    *)
  96.     launch      : PROC;             (* task getting CPU  *)
  97.     memEntry    : List;             (* Allocated memory. Freed by RemTask() *)
  98.     userData    : APTR;             (* For use by the task; no restrictions! *)
  99.   END;
  100.  
  101.   MsgPortPtr = UNTRACED POINTER TO MsgPort;
  102.   MsgPort = STRUCT (node : Node)
  103.     flags   : SHORTINT;
  104.     sigBit  : SHORTINT;        (* signal bit number    *)
  105.     sigTask : APTR;            (* object to be signalled *)
  106.     msgList : List;            (* message linked list  *)
  107.   END;
  108.  
  109.   MessagePtr = APTR;
  110.  
  111.   Process * = UNTRACED POINTER TO STRUCT (task: Task)
  112.                    msgPort       : MsgPort;
  113.                    pad           : INTEGER;
  114.                    segList       : LONGINT;
  115.                    stackSize     : LONGINT;
  116.                    globVec       : LONGINT;
  117.                    taskNum       : LONGINT;
  118.                    stackBase     : LONGINT;
  119.                    result2       : LONGINT;
  120.                    currentDir    : LONGINT;
  121.                    cis           : LONGINT;
  122.                    cos           : LONGINT;
  123.                    consoleTask   : MsgPortPtr;
  124.                    fileSystemTask: MsgPortPtr;
  125.                    cli           : APTR;
  126.                    returnAddr    : LONGINT;
  127.                    pktWait       : LONGINT;
  128.                    windowPtr     : LONGINT;
  129.                  END;
  130.  
  131.   IntVector = STRUCT
  132.     data : APTR;
  133.     code : PROC;
  134.     node : NodePtr;
  135.   END;
  136.   SoftIntList = STRUCT (list : List)   (* For EXEC use ONLY! *)
  137.     pad : INTEGER;
  138.   END;
  139.  
  140.   Library = STRUCT (node : Node)
  141.     flags   : SHORTSET;
  142.     pad     : BYTE;
  143.     negSize : INTEGER;
  144.     posSize : INTEGER;
  145.     version : INTEGER;
  146.     revision: INTEGER;
  147.     idString: STRPTR;
  148.     sum     : LONGINT;
  149.     openCnt : INTEGER;
  150.   END;
  151.  
  152.   ExecBasePtr = UNTRACED POINTER TO ExecBase;
  153.   ExecBase = STRUCT (libNode : Library)
  154.         softVer              : INTEGER;
  155.         lowMemChkSum         : INTEGER;
  156.         chkBase              : LONGINT;
  157.         coldCapture          : APTR;
  158.         coolCapture          : APTR;
  159.         warmCapture          : APTR;
  160.         sysStkUpper          : APTR;
  161.         sysStkLower          : APTR;
  162.         maxLocMem            : APTR;
  163.         debugEntry           : APTR;
  164.         debugData            : APTR;
  165.         alertData            : APTR;
  166.         maxExtMem            : APTR;
  167.         chkSum               : INTEGER;
  168.         intVects             : ARRAY 16 OF IntVector;
  169.         thisTask             : TaskPtr;
  170.         idleCount            : LONGINT;
  171.         dispCount            : LONGINT;
  172.         quantum              : INTEGER;
  173.         elapsed              : INTEGER;
  174.         sysFlags             : SET;
  175.         idNestCnt            : SHORTINT;
  176.         tdNestCnt            : SHORTINT;
  177.         attnFlags            : SET;
  178.         attnResched          : INTEGER;
  179.         resModules           : APTR;
  180.         taskTrapCode         : PROC;
  181.         taskExceptCode       : PROC;
  182.         taskExitCode         : PROC;
  183.         taskSigAlloc         : LONGSET;
  184.         taskTrapAlloc        : SET;
  185.         memList              : List;
  186.         resourceList         : List;
  187.         deviceList           : List;
  188.         intrList             : List;
  189.         libList              : List;
  190.         portList             : List;
  191.         taskReady            : List;
  192.         taskWait             : List;
  193.         softInts             : ARRAY 5 OF SoftIntList;
  194.         lastAlert            : ARRAY 4 OF LONGINT;
  195.         vblankFrequency      : SHORTINT;
  196.         powerSupplyFrequency : SHORTINT;
  197.         semaphoreList        : List;
  198.         kickMemPtr           : APTR;
  199.         kickTagPtr           : APTR;
  200.         kickCheckSum         : APTR;
  201.         pad0                 : INTEGER;
  202.         launchPoint          : LONGINT;
  203.         ramLibPrivate        : APTR;
  204.         eClockFrequency      : LONGINT;
  205.         cacheControl         : APTR;
  206.         taskID               : LONGINT;
  207.         reserved1            : ARRAY 5 OF LONGINT;
  208.         mmuLock              : APTR;
  209.         reserved2            : ARRAY 3 OF LONGINT;
  210.         memHandlers          : MinList;
  211.         memHandler           : APTR;
  212.       END;
  213.  
  214.  
  215. CONST
  216.   memClear = 16;
  217.  
  218.  
  219. (*
  220.  * execBase.thisTask.trapData points to this structure.
  221.  * Global data may be got from here.
  222.  *
  223.  * To set up new Oberon-Taks correctly, use the Concurreny.mod.
  224.  *)
  225.  
  226. TYPE
  227.   TaskTrapDataPtr = UNTRACED POINTER TO TaskTrapData;
  228.   TaskTrapData * = STRUCT
  229.  
  230.     mutator * : SYSTEM.ADDRESS;
  231.                           (*
  232.                            * This tasks mutator-structure used by
  233.                            * garbagecollector.library. Only used when
  234.                            * compiled with garbage-collector activated.
  235.                            *
  236.                            * The compiler depends on this element to be
  237.                            * at offset 0!
  238.                            *)
  239.  
  240.     a5 * : SYSTEM.ADDRESS;   (*
  241.                            * Pointer to global variables, only needed for
  242.                            * small data model.
  243.                            *)
  244.  
  245.     haltProc * : PROC;    (*
  246.                            * Procedure to be called when HALT() is
  247.                            * executed.
  248.                            *
  249.                            * Only valid if LibLink is not set.
  250.                            *
  251.                            *)
  252.  
  253.     oldSP * : SYSTEM.ADDRESS;(*
  254.                            * Original Contents of A7
  255.                            *)
  256.  
  257.     reserverd: ARRAY 6 OF SYSTEM.ADDRESS;
  258.                           (*
  259.                            * will be used in future
  260.                            *)
  261.  
  262.     user * : ARRAY 32 OF SYSTEM.ADDRESS;
  263.                           (*
  264.                            * May be used by application modules.
  265.                            * Use AllocUser() and FreeUser() to
  266.                            * lock elements of this array for your
  267.                            * private use.
  268.                            *)
  269.  
  270.   END;   (* TaskTrapData *)
  271.  
  272.  
  273. (*
  274.  * This variable may be used to easily access the trapData
  275.  * of this task:
  276.  *)
  277.  
  278. VAR
  279.   execBase -, AbsExecBase[4] : UNTRACED POINTER TO STRUCT dummy: ARRAY 276 OF CHAR;
  280.     thisTask-: UNTRACED POINTER TO STRUCT dummy: ARRAY 46 OF CHAR;
  281.       trapData-: TaskTrapDataPtr;
  282.     END;
  283.   END;
  284.  
  285. PROCEDURE Forbid     {execBase,-132};
  286. PROCEDURE Permit     {execBase,-138};
  287. PROCEDURE AllocMem   {execBase,-198}(byteSize{0}: LONGINT; requirements{1}: LONGSET): APTR;
  288. PROCEDURE FreeMem    {execBase,-210}(memoryBlock{9}: APTR; byteSize{0}   : LONGINT);
  289. PROCEDURE AddHead    {execBase,-240}(VAR list{8}   : CommonList; node{9}       : CommonNodePtr);
  290. PROCEDURE Remove     {execBase,-252}(node{9}       : CommonNodePtr);
  291. PROCEDURE GetMsg     {execBase,-372}(port{8}       : MsgPortPtr): MessagePtr;
  292. PROCEDURE ReplyMsg   {execBase,-378}(message{9}    : MessagePtr);
  293. PROCEDURE WaitPort   {execBase,-384}(port{8}       : MsgPortPtr);
  294. PROCEDURE CopyMemAPTR{execBase,-624}(source{8}: APTR; dest{9}: APTR; size{0}: LONGINT);
  295.  
  296.  
  297. VAR
  298.  
  299.   wbStarted-: BOOLEAN;            (* Was this program started from Workbench?
  300.                                    * (undefined if you link your program to
  301.                                    * a library or a device)
  302.                                    *)
  303.  
  304.   dosCmdLen-: LONGINT;            (* When started from CLI: length and
  305.                                    *)
  306.   dosCmdBuf-: APTR;               (* address of command line arguments.
  307.                                    * Do not use these variables if wbStarted
  308.                                    * is TRUE.
  309.                                    *)
  310.  
  311.   wbenchMsg-: MessagePtr;         (* Startup-Message from Workbench. Do not
  312.                                    * use this variable if wbStarted is FALSE.
  313.                                    *)
  314.  
  315.   closing * : BOOLEAN;            (* Indicates that this program is 'closing',
  316.                                    * ie it's currently executing the CLOSE-
  317.                                    * Statements.
  318.                                    *)
  319.  
  320.   Break * : BOOLEAN;              (* This variable is set to TRUE when this
  321.                                    * program was stopped using ^C or Break.
  322.                                    *)
  323.  
  324.   HaltProc*: PROC;                (*
  325.                                    * This procedure is called when HALT() is
  326.                                    * executed.
  327.                                    *
  328.                                    * HALT(x) is equivalent to
  329.                                    *
  330.                                    *   Result := n; HaltProc;
  331.                                    *)
  332.   Result*: LONGINT;               (*
  333.                                    * Return-code of this program. HALT()'s
  334.                                    * parameter is stored here.
  335.                                    *)
  336.  
  337.   OldSP-:  UNTRACED POINTER TO STRUCT
  338.                                   (* Contents of A7 when this program was
  339.                                    * started.
  340.                                    *)
  341.     returnAdr-: LONGINT;          (* This program's return address
  342.                                    *)
  343.     stackSize-: LONGINT;          (* This Program's stack size
  344.                                    *)
  345.   END;
  346.  
  347.   Me-: Process;                   (* This program's main process
  348.                                    *)
  349.  
  350.   MemReqs*: LONGSET;              (* Memory requirements used by NEW(). NOTE:
  351.                                    * These requirements are only used for
  352.                                    * UNTRACED POINTERs.
  353.                                    *)
  354.  
  355.   OutOfMemHandler * : PROCEDURE();
  356.       (* You may set this variable to a procedure that will be called when
  357.        * NEW() fails to allocate some memory.
  358.        *
  359.        * This procedure should try to free some memory or inform the user
  360.        * that this program needs some more memory.
  361.        *
  362.        * When this routine returns, NEW() retries to allocate
  363.        * the memory.
  364.        *
  365.        * An example of a memory Handler:
  366.        *
  367.        *   PROCEDURE * MyMemHandler();
  368.        *   BEGIN
  369.        *     IF ~ Requests.Request("My Program:",
  370.        *                           "I ran out of memory!",
  371.        *                           "retry","abort")
  372.        *     THEN
  373.        *       HALT(20);
  374.        *     END;
  375.        *   END MyMemHandler;
  376.        *
  377.        * NOTE:
  378.        *   Do not try to allocate memory within your memory handler via
  379.        *   NEW()! This will cause a endless recursion.
  380.        *)
  381.  
  382.  
  383. (* $IF LibLink *)
  384.  
  385.   OpenOk["LibraryHead.OpenOk"]: BOOLEAN;
  386.   
  387. (* $END *)
  388.  
  389.  
  390. (*-------------------------------------------------------------------------*)
  391.  
  392.  
  393. (*
  394.  * Memory list:
  395.  *
  396.  * Untraced objects allocated using NEW() stored within this list. They
  397.  * will be freed automatically when this program exits.
  398.  *)
  399.  
  400. TYPE
  401.   MemElementPtr = UNTRACED POINTER TO MemElement;
  402.   MemElement = STRUCT (node : MinNode);
  403.                  size: LONGINT;            (* the block's size  *)
  404.                  mem: INTEGER;             (* the actual data   *)
  405.                END;
  406.  
  407. VAR
  408.   first: MinList;
  409.   el1,el2: MemElementPtr;
  410.   m: LONGINT;
  411.  
  412. (*
  413.  * original values of modified entries of our task:
  414.  *)
  415.  
  416.   oldTrapProc: PROCEDURE; (* original Me.trapCode *)
  417.   oldSPLower: LONGINT;    (* original Me.spLower  *)
  418.   oldTrapData: LONGINT;   (* original Me.trapData *)
  419.  
  420.   taskTrapData: TaskTrapData;
  421.       (*
  422.        * Trapdata of this program's main process.
  423.        *)
  424.  
  425.   usedUser: LONGSET;
  426.       (* Allocated entries of TaskTrapData.user
  427.        *)
  428.  
  429. (* $OvflChk- $RangeChk- $StackChk- $NilChk- $ReturnChk- $CaseChk- *)
  430.  
  431.  
  432. (*------  Integer Math functions:  ------*)
  433.  
  434.  
  435. PROCEDURE Mul*(a{0},b{1}:LONGINT): LONGINT; (* $EntryExitCode- *)
  436. (*
  437.  * Result = a * b
  438.  *)
  439.  
  440. BEGIN
  441. SYSTEM.INLINE(
  442.   048E7H,03000H,04A80H,05BC3H,06A02H,04480H,04A81H,06A04H,
  443.   04603H,04481H,04840H,04841H,04A40H,0670CH,04A41H,06706H,
  444.   0003CH,00002H,0601CH,0C340H,04840H,03401H,04841H,0C2C0H,
  445.   0C0C2H,04840H,04A40H,066E8H,0D081H,06BE4H,04A03H,06702H,
  446.   04480H,04CDFH,0000CH,04E75H);
  447. END Mul;
  448.  
  449. PROCEDURE ModDiv*(a{0},b{1}:LONGINT): LONGINT; (* $EntryExitCode- *)
  450. (*
  451.  * Result in D0 = a DIV b;
  452.  * Result in D1 = a MOD b;
  453.  *)
  454.  
  455. BEGIN
  456. SYSTEM.INLINE(
  457.   048E7H,03C00H,02800H,06A02H,04480H,02A01H,06A02H,04481H,
  458.   00C81H,00000H,0FFFFH,0621AH,03601H,03400H,04240H,04840H,
  459.   080C3H,02200H,04840H,03202H,082C3H,03001H,04241H,04841H,
  460.   0601EH,02601H,02200H,04241H,04841H,04840H,04240H,0740FH,
  461.   0D080H,0D381H,0B681H,06204H,09283H,05240H,051CAH,0FFF2H,
  462.   04A84H,06A02H,04481H,0BB84H,06A0AH,04480H,04A81H,06704H,
  463.   05380H,0D285H,04CDFH,0003CH,04E75H);
  464. END ModDiv;
  465.  
  466.  
  467. (*------  Memory functions:  ------*)
  468.  
  469.  
  470. PROCEDURE New*(VAR adr: APTR;
  471.                   size: LONGINT);
  472. (*
  473.  * Allocates size bytes of memory. Assigns a reference to the allocated
  474.  * memory to adr.
  475.  *
  476.  * If you link your program to a executable program, this routine ensures
  477.  * that the allocation succeeds. If there's not enough memory, New() will
  478.  * terminate the execution of this program.
  479.  *
  480.  * If you want to link your program to a library (using the oberon library
  481.  * linker LibLink), this routine may fail to allocate the memory. In this
  482.  * case, adr will be set to NIL. This routine is called everytime a untraced
  483.  * object is allocated using NEW(), so you'll have to check an object
  484.  * allocated using NEW() (if you're using LibLink).
  485.  *)
  486.  
  487. VAR
  488.   mem: MemElementPtr;
  489.  
  490. BEGIN
  491.   INC(size,SYSTEM.SIZE(MinNode)+SYSTEM.SIZE(LONGINT));
  492.  
  493.   (* $IF LibLink THEN *)
  494.  
  495.     Forbid;   (* Disable Taskswitching to make NEW() reentrant *)
  496.       mem := AllocMem(size,MemReqs);
  497.   
  498.       IF mem=NIL THEN
  499.         adr := NIL;
  500.       ELSE
  501.         mem.size := size;
  502.         AddHead(first,mem);
  503.         adr := SYSTEM.ADR(mem.mem);
  504.       END;
  505.     Permit;
  506.  
  507.   (* $ELSE *)
  508.  
  509.     Forbid;   (* Disable Taskswitching to make NEW() reentrant *)
  510.       REPEAT
  511.         mem := AllocMem(size,MemReqs);
  512.         IF mem=NIL THEN
  513.           Permit;
  514.             OutOfMemHandler();
  515.           Forbid;
  516.         END;
  517.       UNTIL mem#NIL;
  518.   
  519.       mem.size := size;
  520.       AddHead(first,mem);
  521.  
  522.     Permit;
  523.  
  524.     adr := SYSTEM.ADR(mem.mem);
  525.  
  526.   (* $END *)
  527.  
  528. END New;
  529.  
  530.  
  531. PROCEDURE Dispose*(VAR adr: APTR);
  532. (*
  533.  * Dispose() frees the memory used by an object allocated using New().
  534.  *
  535.  * This routine is called whenever DISPOSE() is used.
  536.  *
  537.  *)
  538.  
  539. VAR mem: MemElementPtr;
  540.  
  541. BEGIN
  542.   IF adr#NIL THEN
  543.     mem := SYSTEM.VAL(APTR,SYSTEM.VAL(LONGINT,adr)-
  544.                              (SIZE(MinNode)+SIZE(LONGINT)));
  545.     Forbid;  (* DIPOSE() should be reentrant *)
  546.       Remove(mem);
  547.       FreeMem(mem,mem.size);
  548.     Permit;
  549.     adr := NIL;
  550.   END;
  551. END Dispose;
  552.  
  553.  
  554. (*------  Allocate:  ------*)
  555.  
  556.  
  557. PROCEDURE Allocate*(VAR adr: APTR;
  558.                     size: LONGINT);
  559. (*
  560.  * Allocates size bytes of memory. Assigns a reference to the allocated
  561.  * memory to adr.
  562.  *
  563.  * If there's not enough memory, the result will be NIL, so you'll always
  564.  * have to check adr#NIL.
  565.  *
  566.  *)
  567.  
  568. VAR
  569.   mem: MemElementPtr;
  570.  
  571. BEGIN
  572.  
  573.   INC(size,SYSTEM.SIZE(MinNode)+SYSTEM.SIZE(LONGINT));
  574.  
  575.   Forbid;  (* Disable Taskswitching to make ALLOCATE() reentrant *)
  576.  
  577.     mem := AllocMem(size,MemReqs);
  578.  
  579.     IF mem=NIL THEN
  580.       adr := NIL;
  581.     ELSE
  582.       mem.size := size;
  583.       AddHead(first,mem);
  584.       adr := SYSTEM.ADR(mem.mem);
  585.     END;
  586.  
  587.   Permit;
  588.  
  589. END Allocate;
  590.  
  591.  
  592. (*------  String Copy:  ------*)
  593.  
  594.  
  595. PROCEDURE Copy*(    source: ARRAY OF CHAR;    (* $EntryExitCode- *)
  596.                 VAR dest:   ARRAY OF CHAR);
  597. (*
  598.  * Copy strings. This routine is called whenever COPY() is used.
  599.  *
  600.  * This routine is (c) 1993 by. Carsten A. Duske. Thanks to
  601.  * Carsten for permission to use his code. -- Fridtjof.
  602.  *)
  603.  
  604. BEGIN
  605.   SYSTEM.INLINE(
  606.          02C5FH,         (* Copy:     MOVEA.L   (A7)+,A6     *)
  607.          0221FH,         (*           MOVE.L    (A7)+,D1     *)
  608.          0225FH,         (*           MOVEA.L   (A7)+,A1     *)
  609.          0201FH,         (*           MOVE.L    (A7)+,D0     *)
  610.          0205FH,         (*           MOVEA.L   (A7)+,A0     *)
  611.          0B081H,         (*           CMP.L     D1,D0        *)
  612.          06B0EH,         (*           BMI.S     \start       *)
  613.          02001H,         (*           MOVE.L    D1,D0        *)
  614.          05380H,         (*           SUBQ.L    #1,D0        *)
  615.          06B18H,         (*           BMI.S     \done        *)
  616.          06712H,         (*           BEQ.S     \term        *)
  617.          06004H,         (*           BRA.S     \start       *)
  618.          04840H,         (* \upper    SWAP.W    D0           *)
  619.          012D8H,         (* \lower    MOVE.B    (A0)+,(A1)+  *)
  620.          057C8H,0FFFCH,  (* \start    DBEQ      D0,\lower    *)
  621.          0670AH,         (*           BEQ.S     \done        *)
  622.          04840H,         (*           SWAP.W    D0           *)
  623.          051C8H,0FFF2H,  (*           DBRA      D0,\upper    *)
  624.          07200H,         (* \term     MOVEQ     #0,D1        *)
  625.          01281H,         (*           MOVE.B    D1,(A1)      *)
  626.          04ED6H          (* \done     JMP       (A6)         *)
  627.       );
  628. END Copy;
  629.  
  630.  
  631. (*------  Stack Check:  ------*)
  632.  
  633.  
  634. PROCEDURE StackChk*(size{0}: LONGINT);
  635. (*
  636.  * This routine is used by the compiler to check free stack space.
  637.  *
  638.  * This routine also checks if ^C was hit (this does only work in
  639.  * conjunction with Break.mod or BreakRq.mod).
  640.  *
  641.  * Note:
  642.  *   The compiler assumes that this routine preserves all registers
  643.  *   apart from D0.
  644.  *
  645.  *)
  646.  
  647. CONST
  648.   TRAP8 = 04E48H;
  649.  
  650. BEGIN
  651.  
  652. (* $IFNOT LibLink (no stack checking within libraries and devices *)
  653.  
  654.   IF Break THEN SYSTEM.INLINE(TRAP8) END;
  655.   SYSTEM.INLINE(
  656.         02F0DH,           (*     MOVE.L  A5,-(A7)                   *)
  657.         02A78H,00004H,    (*     MOVEA.L 0004H,A5       IF AbsExecBase *)
  658.         02A6DH,00114H,    (*     MOVEA.L 276(A5),A5       .thisTask *)
  659.         02A6DH,0003AH,    (*     MOVEA.L 58(A5),A5        .spLower  *)
  660.         0DAFCH,00600H,
  661.                           (*     ADDA.W  #0600H,A5        + 600H + MaxListParSize *)
  662.         0DBC0H,           (*     ADDA.L  D0,A5            + D0      *)
  663.         0BBCFH,           (*     CMPA.L  A7,A5            > A7      *)
  664.         06302H,           (*     BLS.S   ok;            THEN        *)
  665.         04E42H,           (*     TRAP    #2               TRAP #2   *)
  666.         02A5FH);          (* ok: MOVEA.L     (A7)+,A5   END;        *)
  667.         
  668. (* $END *)
  669.         
  670. END StackChk;
  671.  
  672.  
  673. (*------  Check Precessor:  ------*)
  674.  
  675.  
  676. PROCEDURE CheckProcessor*(what{0}: SET); (* $EntryExitCode- *)
  677. (*
  678.  * Check if this machine has a processer wich satifies the given
  679.  * AttnFlags (see Exec.mod).
  680.  *)
  681.  
  682. BEGIN
  683.   SYSTEM.INLINE(02078H,00004H,       (*    MOVEA.L 4,A0              *)
  684.              03228H,00128H,       (*    MOVE.W  attnFlags(A0),D1  *)
  685.              0C240H,              (*    AND.W   D0,D1             *)
  686.              0B240H,              (*    CMP.W   D0,D1             *)
  687.              06602H,              (*    BNE.S   x                 *)
  688.              04E75H,              (*    RTS                       *)
  689.              04E46H);             (* x: TRAP    #6                *)
  690. END CheckProcessor;
  691.  
  692.  
  693. (*------  SetA5:  ------*)
  694.  
  695.  
  696. PROCEDURE SetA5*;
  697. (*
  698.  * Set A5 to point to the global variables area.
  699.  * This must be done in the small data model before global variables
  700.  * are touched by a handler routine and similar things.
  701.  *
  702.  * NOTE: This may not be used to set A5 within an interrupt routine
  703.  *       or within a task not launched via Concurrency.mod. In these
  704.  *       cases you'll have to pass A5 using the interrupt's or task's
  705.  *       userData or similar attributes.
  706.  *)
  707.  
  708. (* $IF SmallData *)
  709.   (* $IF LibLink *)
  710.   VAR
  711.     globals["LibraryHead.Globals"]: LONGINT;
  712.   (* $END *)
  713.   BEGIN
  714.   (* $IF LibLink *)
  715.     SYSTEM.SETREG(13,globals);
  716.   (* $ELSE *)
  717.     SYSTEM.SETREG(13,AbsExecBase.thisTask.trapData.a5);
  718.   (* $END *)
  719. (* $END *)
  720. END SetA5;
  721.  
  722.  
  723. (*------  Trap Handler:  ------*)
  724.  
  725.  
  726. PROCEDURE TrapHandler();
  727. BEGIN
  728.   SetA5;
  729.   SYSTEM.SETREG(15,execBase.thisTask.trapData.oldSP);
  730.   Result := -1;
  731.   HaltProc();
  732. END TrapHandler;
  733.  
  734.  
  735. PROCEDURE * TrapProc(); (* $EntryExitCode- *)
  736. (*
  737.  * Default trap handler. Stops execution of this program in case
  738.  * of a run time error.
  739.  *)
  740. BEGIN
  741.   SYSTEM.SETREG(8,TrapHandler);
  742.   SYSTEM.INLINE(
  743.         0201FH,             (*    MOVE.L  (A7)+,D0   *)
  744.         00C40H,00003H,      (*    CMPI.W  #3,D0      *)
  745.         06202H,             (*    BHI.S   l          *)
  746.         0504FH,             (*    ADDQ.W  #8,A7      *)
  747.         02F48H,00002H,      (* l: MOVE.L  A0,2(A7)   *)
  748.         04E73H);            (*    RTE                *)
  749. END TrapProc;
  750.  
  751.  
  752. (*------  Halt:  ------*)
  753.  
  754. (* $IF LibLink *)
  755.  
  756. (*
  757.  * HaltProc for libraries:
  758.  *)
  759.  
  760. PROCEDURE CloseAll{"LibraryHead.CloseAll"};
  761.  
  762. PROCEDURE Halt;
  763. CONST RTS = 4E75H;
  764. BEGIN
  765.   CloseAll;
  766.   OpenOk := FALSE;
  767.   SYSTEM.SETREG(15,OldSP);
  768.   SYSTEM.INLINE(RTS);         (* $EntryExitCode- tricky, no exit code *)
  769. END Halt;
  770.  
  771. (* $ELSE *)
  772.  
  773. (*
  774.  * HaltProc. Calls Halt procedure of current process.
  775.  *)
  776.  
  777. PROCEDURE Halt;
  778. BEGIN
  779.   SYSTEM.SETREG(15,AbsExecBase.thisTask.trapData.oldSP);
  780.   execBase.thisTask.trapData.haltProc;
  781. END Halt;
  782.  
  783. (* $END *)
  784.  
  785.  
  786. (*------  Default Out of Mem Handler:  ------*)
  787.  
  788.  
  789. PROCEDURE DefaultOutOfMemHandler;   (* $EntryExitCode- *)
  790. (*
  791.  * This does nothing but a TRAP #9 to indicate an out of memory situation.
  792.  *)
  793. CONST TRAP9= 04E49H;
  794. BEGIN
  795.   SYSTEM.INLINE(TRAP9);
  796. END DefaultOutOfMemHandler;
  797.  
  798.  
  799. (*------  Alloc and Free TaskTrapData.user[] entries:  ------*)
  800.  
  801.  
  802. PROCEDURE AllocUser * (): INTEGER;
  803. (*
  804.  * Obtain the right to use one of the TaskTrapData.user[] entries.
  805.  * Result is the number of the allocated entry or -1 when all
  806.  * entries are used.
  807.  *)
  808. VAR
  809.   i: INTEGER;
  810. BEGIN
  811.   i := 31;
  812.   LOOP
  813.     IF i < 0            THEN                   EXIT
  814.     ELSIF i IN usedUser THEN DEC(i)
  815.                         ELSE INCL(usedUser,i); EXIT
  816.     END;
  817.   END;
  818.   RETURN i;
  819. END AllocUser;
  820.  
  821.  
  822. PROCEDURE FreeUser * (i: INTEGER);
  823. (*
  824.  * Release the right to use one of the TaskTrapData.user[] entries
  825.  * obtained by AllocUser.
  826.  *
  827.  *)
  828. BEGIN
  829.   EXCL(usedUser,i);
  830. END FreeUser;
  831.  
  832.  
  833. (*------  SYSTEM Routines:  ------*)
  834.  
  835.  
  836. PROCEDURE Bit*(a: SYSTEM.ADDRESS; n: LONGINT): BOOLEAN;
  837. TYPE LSP = UNTRACED POINTER TO LONGSET;
  838. BEGIN
  839.   RETURN n IN SYSTEM.VAL(LSP,a)^;
  840. END Bit;
  841.  
  842.  
  843. PROCEDURE Move*(a0,a1: SYSTEM.ADDRESS; n: LONGINT);
  844. VAR
  845.   p0,p1: UNTRACED POINTER TO ARRAY MAX(LONGINT)-1 OF SYSTEM.BYTE;
  846.   i: LONGINT;
  847. BEGIN
  848.   IF    (SYSTEM.VAL(LONGINT,a0)   <= SYSTEM.VAL(LONGINT,a1)) &
  849.         (SYSTEM.VAL(LONGINT,a0)+n >  SYSTEM.VAL(LONGINT,a1))
  850.   THEN                                 (* a1 liegt in src:          *)
  851.     p0 := a0; p1 := a1;                (*  |-----src-----|          *)
  852.     WHILE n>0 DO                       (*         |-----dst-----|   *)
  853.       DEC(n);
  854.       p1[n] := p0[n];
  855.     END;
  856.   ELSIF (SYSTEM.VAL(LONGINT,a1)   <= SYSTEM.VAL(LONGINT,a0)) &
  857.         (SYSTEM.VAL(LONGINT,a1)+n >  SYSTEM.VAL(LONGINT,a0))
  858.   THEN                                 (* a0 liegt in dst:          *)
  859.     p0 := a0; p1 := a1;                (*         |-----src-----|   *)
  860.     FOR i:=0 TO n-1 DO                 (*  |-----dst-----|          *)
  861.       p1[i] := p0[i];
  862.     END;
  863.   ELSE
  864.     CopyMemAPTR(a0,a1,n);
  865.   END;
  866. END Move;
  867.  
  868.  
  869. (*------  Init:  ------*)
  870.  
  871.  
  872. BEGIN
  873.  
  874.   execBase := AbsExecBase;
  875.  
  876. (* $IF LibLink *)
  877.  
  878.   OldSP     := SYSTEM.REG(8); (* Library startup code has copied A7 to A0   *)
  879.  
  880.   dosCmdLen := 0;          (* all these variables mustn't be used within *)
  881.   dosCmdBuf := NIL;        (* a library!                                 *)
  882.   wbenchMsg := NIL;
  883.   Me := NIL;
  884.  
  885.   HaltProc := Halt;
  886.  
  887.   OpenOk := TRUE;
  888.   
  889. (* $ELSE *)
  890.  
  891.   dosCmdLen := SYSTEM.REG(0);
  892.   dosCmdBuf := SYSTEM.REG(8);
  893.   
  894.   Me := SYSTEM.VAL(Process,execBase.thisTask);
  895.  
  896.   taskTrapData.a5       := SYSTEM.REG(13);
  897.   taskTrapData.haltProc := HaltProc;
  898.   taskTrapData.oldSP    := OldSP;
  899.   HaltProc              := Halt;
  900.   oldTrapData           := Me.task.trapData;
  901.   Me.task.trapData      := SYSTEM.ADR(taskTrapData);
  902.  
  903.   oldSPLower := Me.task.spLower;
  904.   Me.task.spLower  := SYSTEM.VAL(LONGINT,OldSP) - OldSP.stackSize + 256;
  905.  
  906.   oldTrapProc      := Me.task.trapCode; (* install Traphandler *)
  907.  
  908.   Me.task.trapCode := TrapProc;
  909.  
  910.   wbStarted := Me.cli=NIL;
  911.  
  912.   IF wbStarted THEN
  913.  
  914.     WaitPort(SYSTEM.ADR(Me.msgPort));
  915.     wbenchMsg := GetMsg(SYSTEM.ADR(Me.msgPort));
  916.  
  917.   END;
  918.  
  919. (* $END *)
  920.  
  921.   Result := 0;
  922.   closing := FALSE;
  923.  
  924.   OutOfMemHandler := DefaultOutOfMemHandler;
  925.  
  926.   Break := FALSE;
  927.  
  928.   MemReqs := LONGSET{memClear};
  929.  
  930.   first.head     := SYSTEM.ADR(first.tail);
  931.   first.tailPred := SYSTEM.ADR(first.head);
  932.   first.tail     := NIL;
  933.  
  934.   usedUser := LONGSET{};
  935.  
  936. CLOSE
  937.  
  938.   el1 := first.head;
  939.   LOOP
  940.     el2 := el1.node.succ;
  941.     IF el2=NIL THEN EXIT END;
  942.     FreeMem(el1,el1.size);
  943.     el1 := el2
  944.   END;
  945.   
  946. (* $IFNOT LibLink *)
  947.  
  948.   Me.task.trapCode := oldTrapProc; (* remove Traphandler *)
  949.   Me.task.spLower  := oldSPLower;
  950.   Me.task.trapData := oldTrapData;
  951.  
  952.   IF wbStarted THEN
  953.  
  954.     Forbid;
  955.     ReplyMsg(wbenchMsg);
  956.  
  957.   END;
  958.  
  959.   SYSTEM.SETREG(0,Result);
  960.   
  961. (* $END *)
  962.  
  963. END OberonLib.
  964.  
  965.  
  966.