home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 8 / FreshFishVol8-CD2.bin / bbs / dev / oberon-a-1.4ß.lha / Oberon-A / source / oberonsys / GC.asm < prev    next >
Assembly Source File  |  1994-08-08  |  14KB  |  350 lines
  1. ****************************************************************************
  2. *
  3. *    $RCSfile: GC.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/05/16 16:32:13 $
  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 support
  20. * library of the Oberon-A compiler.  It contains the code to implement the
  21. * Oberon-A garbage collector.
  22. *
  23. * Other parts of the runtime system may be found in the other files in this
  24. * directory.  The object files resulting from assembling these files are
  25. * 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. FreeMem     EQU -210
  45.  
  46. ;---------------------------------------------------------------------------
  47. ;    Macros
  48.  
  49. CALLSYS MACRO
  50.         JSR \1(A6)
  51.         ENDM
  52.  
  53. ;---------------------------------------------------------------------------
  54. ;    Defines
  55.  
  56. SysBit          EQU 0
  57. ArrayBit        EQU 1
  58. MarkBitB        EQU 7
  59. MarkBitL        EQU 31
  60. tag             EQU -4
  61. size            EQU -12
  62. elemSize        EQU -16
  63. arrpos          EQU -20
  64. PtrTabOffset    EQU 36
  65.  
  66. ;---------------------------------------------------------------------------
  67. ; PROCEDURE OberonSys_GC ()
  68. ;
  69. ; A call to this procedure is generated by the compiler when it translates a
  70. ; call to SYSTEM.GC.  OberonSys_GC implements a mark-and-sweep garbage
  71. ; collector.  See TechNotes.doc and Memory.doc for a discussion of the
  72. ; memory management system and the garbage collector.
  73. ;
  74. ; This procedure forms the outer loop of the mark phase and OberonSys_Mark
  75. ; is the inner loop.  It walks the list of global variable descriptors
  76. ; generated by the compiler and applies the mark algorithm to each global
  77. ; pointer variable.  After marking is completed OberonSys_Sweep is called to
  78. ; collect the unmarked memory.  The global variable descriptors are accessed
  79. ; through the offsetPtr variable.  They consist of a link field, a pointer
  80. ; to the base of the corresponding module's global variables, and an array
  81. ; of offsets.  The offsetPtr variable is also used to access this array by
  82. ; repeatedly incrementing it by the size of an offset (4 bytes).  The offset
  83. ; array is terminated by a negative value which is initialised so that
  84. ; adding it to offsetPtr restores it to point to the base of the descriptor.
  85. ;
  86. ; VAR
  87. ;   offsetPtr {A6} :
  88. ;     POINTER TO UNION
  89. ;       offsetBlock : RECORD
  90. ;         link : ADDRESS;
  91. ;         varBase : ADDRESS;
  92. ;       END;
  93. ;       offset : LONGINT;
  94. ;     END;
  95. ;   varBase {A4} : ADDRESS;
  96. ;   ptr {A0} : ADDRESS;
  97. ;   offset {D7} : LONGINT;
  98. ;
  99. ;---------------------------------------------------------------------------
  100.  
  101.     SECTION OberonSys,CODE
  102.  
  103.     XDEF      OberonSys_GC
  104.  
  105. OberonSys_GC:
  106.  
  107.     MOVEM.L A4-A5,-(A7)             ; (* preserve registers *)
  108.     LEA     OberonSys_VAR,A5        ; (* load OberonSys_VAR *)
  109.     MOVEA.L OS_GCVars(A5),A6        ; offsetPtr := OberonSys.GCVars;
  110. G1:
  111.     MOVE.L  A6,D0                   ; WHILE offsetPtr # NIL DO
  112.     BEQ.S   G4
  113.     MOVEA.L 4(A6),A4                ;   varBase := offsetPtr.varBase;
  114.     ADDQ.L  #8,A6                   ;   INC (offsetPtr, 8);
  115. G2:                                 ;   LOOP
  116.     MOVE.L  (A6)+,D7                ;     offset := offsetPtr.offset;
  117.                                     ;     INC (offsetPtr, 4)
  118.     BMI.S   G3                      ;     IF offset >= 0 THEN
  119.     MOVE.L  0(A4,D7.L),D0           ;       ptr := mem [varBase + offset];
  120.     BEQ.S   G2                      ;       IF (ptr # NIL)
  121.     MOVE.L  D0,A0
  122.     BSET.B  #MarkBitB,tag(A0)       ;       & Unmarked(ptr)
  123.     BNE.S   G2
  124.     BTST.B  #SysBit,tag+3(A0)       ;       & ~SysBlk (ptr) THEN
  125.     BNE.S   G2
  126.     ; Already done by BSET above              SetMark (ptr);
  127.     BSR     OberonSys_Mark          ;         OberonSys_Mark (ptr)
  128.     BRA     G2                      ;       END;
  129. G3:                                 ;     ELSE
  130.     ADDA.L  D7,A6                   ;       offsetPtr := offsetPtr+offset;
  131.     SUBQ.L  #4,A6                   ;       (* compensate for increment *)
  132.                                     ;       EXIT
  133.                                     ;     END
  134.                                     ;   END; (* LOOP *)
  135.     MOVEA.L (A6),A6                 ;   offsetPtr := offsetPtr.link
  136.     BRA.S   G1
  137. G4:                                 ; END; (* WHILE *)
  138.     BSR     OberonSys_Sweep         ; OberonSys_Sweep ()
  139.     MOVEM.L (A7)+,A4-A5             ; (* restore registers *)
  140.     RTS
  141.  
  142. ;---------------------------------------------------------------------------
  143. ;
  144. ; PROCEDURE OberonSys_Mark (q {A0} : Pointer)
  145. ;
  146. ; OberonSys_Mark is a direct implementation of the algorithm described in
  147. ; the Oberon Technical Notes, part 5 (see TechNotes.doc).  It forms the
  148. ; inner loop of the mark phase and assumes that the root pointer variable
  149. ; passed in A0 has already been marked.  The algorithm has been modified
  150. ; slightly to reflect the different tag encodings and memory block formats
  151. ; used by Oberon-A.
  152. ;
  153. ; Address registers A1-A3 and all the data registers are free on entry.
  154. ;
  155. ; VAR
  156. ;   n {A1}, t {A2}, tos {A3} : Pointer;
  157. ;   offset {D0}, tag {A4,D3} : LONGINT;
  158. ;   qmask {D1}, ntag {D2} : SET;
  159. ;
  160. ;---------------------------------------------------------------------------
  161.  
  162.     SECTION OberonSys,CODE
  163.  
  164. OberonSys_Mark:
  165.  
  166.     MOVE.L  A4,-(A7)                ; (* Create an extra free register *)
  167.     BTST.B  #ArrayBit,tag+3(A0)     ; IF 1 IN q.tag THEN
  168.     BEQ.S   M1
  169.     CLR.L   arrpos(A0)              ;   q.arrpos := 0;
  170.     MOVE.L  #$80000002,D1           ;   qmask := {1, 31}
  171.     BRA.S   M2
  172. M1:                                 ; ELSE
  173.     MOVE.L  #$80000000,D1           ;   qmask := {31}
  174. M2:                                 ; END;
  175.     MOVE.L  A0,A2                   ; t := q;
  176.     MOVE.L  tag(A0),D3              ; tag := q.tag - {1, 31} + PtrTabOffset
  177.     AND.L   #$7FFFFFFD,D3
  178.     ADD.L   #PtrTabOffset,D3
  179.     SUB.L   A3,A3                   ; tos := NIL;
  180. Loop:                               ; LOOP {H}
  181.     MOVE.L  D3,A4                   ;   offset := mem[tag];
  182.     MOVE.L  (A4),D0
  183.     BPL.S   L3                      ;   IF offset < 0 THEN
  184.     MOVE.L  D3,D4                   ;     q.tag := tag + offset + qmask;
  185.     ADD.L   D0,D4
  186.     OR.L    D1,D4
  187.     MOVE.L  D4,tag(A0)
  188.     BTST.B  #ArrayBit,D1            ;     IF 1 IN qmask
  189.     BEQ.S   L1
  190.     MOVE.L  elemSize(A0),D4
  191.     ADD.L   arrpos(A0),D4
  192.     CMP.L   size(A0),D4             ;     & (q.arrpos + q.elemSize # q.size) THEN
  193.     BEQ.S   L1
  194.     MOVE.L  elemSize(A0),D4         ;       INC(q.arrpos,q.elemSize);
  195.     ADD.L   D4,arrpos(A0)
  196.     ADD.L   D0,D3                   ;       INC(tag, offset + PtrTabOffset - 4);
  197.     ADD.L   #PtrTabOffset-4,D3
  198.     ADD.L   elemSize(A0),A2         ;       INC(t, q.elemSize)
  199.     BRA     L5
  200. L1:
  201.     MOVE.L  A3,D4                   ;     ELSIF tos = NIL THEN
  202.     BEQ     Exit                    ;       EXIT
  203.                                     ;     ELSE
  204.     MOVE.L  tag(A3),D1              ;       qmask := tos.tag;
  205.     MOVE.L  D1,D3                   ;       tag := qmask - {1, 31};
  206.     AND.L   #$7FFFFFFD,D3
  207.     AND.L   #$80000002,D1           ;       qmask := qmask * {1, 31};
  208.     MOVE.L  A3,A2                   ;       t := tos;
  209.     BTST.B  #ArrayBit,D1            ;       IF 1 IN qmask THEN
  210.     BEQ.S   L2
  211.     ADD.L   arrpos(A3),A2           ;         INC (t, tos.arrpos)
  212. L2:                                 ;       END;
  213.     MO