home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 8 / FreshFishVol8-CD1.bin / useful / dev / obero / oberon-a / source / oberonsys / dispose.asm < prev    next >
Encoding:
Assembly Source File  |  1994-08-08  |  6.3 KB  |  193 lines
  1. ****************************************************************************
  2. *
  3. *    $RCSfile: DISPOSE.asm $
  4. * Description: Runtime support for the Oberon-A compiler
  5. *
  6. *  Created by: fjc (Frank Copeland)
  7. *   $Revision: 1.3 $
  8. *     $Author: fjc $
  9. *       $Date: 1994/07/24 18:24:34 $
  10. *
  11. * Copyright © 1994, Frank Copeland.
  12. * This file is part of the Oberon-A Library.
  13. * See Oberon-A.doc for conditions of use and distribution.
  14. *
  15. * Log entries are at the end of the file.
  16. *
  17. ****************************************************************************
  18. *
  19. * This file contains the MC68000 source code for part of the runtime
  20. * support library of the Oberon-A compiler.  It contains the code to
  21. * implement the Oberon standard procedure SYSTEM.DISPOSE().
  22. *
  23. * Other parts of the runtime system may be found in the other files in
  24. * this directory.  The object files resulting from assembling these
  25. * files are concatenated to create OberonSys.lib.
  26. *
  27. * This code is by definition *not* re-entrant and is not suitable for
  28. * creating shared-code libraries.
  29. *
  30. ****************************************************************************
  31.  
  32. ;---------------------------------------------------------------------
  33. ;    Program unit hunk name
  34. ;    !! DO NOT CHANGE UNLESS YOU KNOW WHAT YOU ARE DOING !!
  35.  
  36.      TTL OberonSys
  37.  
  38. ;---------------------------------------------------------------------
  39. ;    Imports
  40.  
  41.      INCLUDE   "OberonSys.i"
  42.  
  43. ABSEXECBASE    EQU  4
  44.  
  45. FreeMem        EQU  -210
  46.  
  47. ;---------------------------------------------------------------------
  48. ;    Macros
  49.  
  50. CALLSYS MACRO
  51.         JSR \1(A6)
  52.         ENDM
  53.  
  54. ;---------------------------------------------------------------------
  55. ; PROCEDURE OberonSys_DISPOSE (
  56. ;   var {D0} : ADDRESS)
  57. ;
  58. ; A call to this procedure is generated by the compiler when it
  59. ; translates a call to SYSTEM.DISPOSE ().  The contents of the
  60. ; variable to be freed is passed in D0.  The procedure first checks to
  61. ; see that the variable points to a block that has actually been
  62. ; allocated.  If not it halts the program. If the variable is NIL then
  63. ; it returns without taking any action.  Once it has confirmed the
  64. ; block is valid, it removes it from the list of allocated blocks and
  65. ; frees it.
  66. ;
  67. ; TYPE
  68. ;   RecordBlkPtr = POINTER TO RecordBlk;
  69. ;   RecordBlk = RECORD
  70. ;     link, tag : ADDRESS;
  71. ;     data : ...
  72. ;   END;
  73. ;   ArrayBlkPtr = POINTER TO ArrayBlk;
  74. ;   ArrayBlk = RECORD
  75. ;     arrpos, size : LONGINT;
  76. ;     link, tag : ADDRESS;
  77. ;     data : ...
  78. ;   END;
  79. ;   SysBlkPtr = POINTER TO SysBlk;
  80. ;   SysBlk = RECORD
  81. ;     link : ADDRESS;
  82. ;     size : LONGINT;
  83. ;     data : ...
  84. ;   END;
  85. ;
  86. ; CONST NIL {D1} = 0;
  87. ;
  88. ; VAR mem {A1}, prev {A2}, next {A3} : ADDRESS;
  89. ;     tag {A2} : ADDRESS;
  90. ;     size {D0} : LONGINT;
  91. ;
  92. ;---------------------------------------------------------------------
  93.  
  94.      SECTION OberonSys,CODE
  95.  
  96.      XDEF      OberonSys_DISPOSE
  97.      XREF      OberonSys_CLEANUP
  98.  
  99. OberonSys_DISPOSE:
  100.  
  101.      MOVEQ.L   #0,D1               ; D1 = NIL
  102.      CMP.L     D0,D1               ; IF var # NIL THEN
  103.      BEQ       9$
  104.      MOVE.L    D0,A1               ;   mem := var - 8
  105.      SUBQ.L    #8,A1
  106.      MOVE.L    A5,-(A7)
  107.      LEA       OberonSys_VAR,A5    ;   Get base pointer for variables
  108.      LEA       OS_untraced(A5),A2  ;   prev := ADR (untraced)
  109.      MOVE.L    OS_untraced(A5),A3  ;   next := untraced;
  110. 1$
  111.      CMPA.L    D1,A3               ;   WHILE (next # NIL)
  112.      BEQ.S     2$
  113.      CMPA.L    A1,A3               ;   & (next # mem) DO
  114.      BEQ.S     2$
  115.      MOVE.L    A3,A2               ;     prev := next
  116.      MOVE.L    (A3),A3             ;     next := next.link
  117.      BRA.S     1$                  ;   END
  118. 2$
  119.      CMPA.L    D1,A3               ;   IF next = NIL THEN
  120.      BNE.S     5$
  121.      LEA       OS_memList(A5),A2   ;     prev := ADR (memList)
  122.      MOVE.L    OS_memList(A5),A3   ;     next := memList;
  123. 3$
  124.      CMPA.L    D1,A3               ;     WHILE (next # NIL)
  125.      BEQ.S     4$
  126.      CMPA.L    A1,A3               ;     & (next # mem) DO
  127.      BEQ.S     4$
  128.      MOVE.L    A3,A2               ;       prev := next
  129.      MOVE.L    (A3),A3             ;       next := next.link
  130.      BRA.S     3$                  ;     END
  131. 4$
  132.      CMPA.L    D1,A3               ;     IF next = NIL THEN
  133.      BNE.S     5$
  134.                                    ; HALT (OS_DisposeFail)
  135.      MOVE.L    #OS_DisposeFail,OS_returnCode(A5)
  136.      BRA       OberonSys_CLEANUP
  137.                                    ;     END (* IF *)
  138. 5$                                 ;   END (* IF *)
  139.      MOVE.L    (A7)+,A5            ;   Restore registers
  140.      MOVE.L    (A3),(A2)           ;   prev.link := next.link
  141.      MOVE.L    4(A1),D1
  142.      BTST      #0,D1               ;   IF 0 IN mem.tag THEN
  143.      BEQ.S     6$
  144.      MOVE.L    D1,D0               ;     size := mem.tag + 7
  145.      ADDQ      #7,D0
  146.      BRA.S     8$
  147. 6$
  148.      BTST      #1,D1               ;   ELSIF 1 IN mem.tag THEN
  149.      BEQ.S     7$
  150.      SUBQ.L    #8,A1               ;     DEC (mem, 12);
  151.      SUBQ.L    #4,A1
  152.      MOVE.L    8(A1),D0            ;     size := mem.size + 20
  153.      ADD.L     #20,D0
  154.      BRA.S     8$
  155. 7$                                 ;   ELSE
  156.      MOVEA.L   4(A1),A0            ;     size := mem.tag.size + 8
  157.      MOVE.L    (A0),D0
  158.      ADDQ.L    #8,D0
  159. 8$                                 ;   END;
  160.      MOVE.L    ABSEXECBASE,A6
  161.      CALLSYS   FreeMem             ;   FreeMem(mem,size)
  162. 9$                                 ; END (* IF *)
  163.      RTS
  164.  
  165. ;---------------------------------------------------------------------
  166.  
  167.      END  ; OberonSys
  168.  
  169. ****************************************************************************
  170. *
  171. * $Log: DISPOSE.asm $
  172. * Revision 1.3  1994/07/24  18:24:34  fjc
  173. * - Changed code far calling HALT().
  174. *
  175. * Revision 1.2  1994/05/12  20:31:15  fjc
  176. * - Prepared for release
  177. *
  178. * Revision 1.1  1994/01/15  18:31:52  fjc
  179. * Start of revision control
  180. *
  181. * (12 Jan 1994) Modified to handle change in ArrayBlk (elemSize added)
  182. *               Modified to assemble with PhxAss instead of A68K
  183. * ( 4 Jan 1994) Complete rewrite as part of implementation of the
  184. *               garbage collector.
  185. * ( 9 Jul 1993) Changed return code to OS_DisposeFail.
  186. * (28 Jun 1993) Changed the way it handles the sizeTag field.
  187. *               General overhaul.
  188. * (29 May 1993) Split OberonSys.asm into several files to create
  189. *               OberonSys.lib.
  190. *
  191. ****************************************************************************
  192.  
  193.