home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 8 / FreshFishVol8-CD1.bin / useful / dev / obero / oberon-a / source / oberonsys / gc.asm < prev    next >
Encoding:
Assembly Source File  |  1994-08-08  |  13.3 KB  |  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.     MOVE.L  D3,A4                   ;       offset := mem[tag];
  214.     MOVE.L  (A4),D0
  215.     MOVE.L  0(A2,D0.L),A1           ;       n := mem[t + offset];
  216.     MOVE.L  A0,0(A2,D0.L)           ;       mem[t + offset] := q;
  217.     MOVE.L  A3,A0                   ;       q := tos;
  218.     MOVE.L  A1,A3                   ;       tos := n
  219.     BRA.S   L5                      ;     END
  220. L3:                                 ;   ELSE
  221.     MOVE.L  0(A2,D0.L),D4           ;     n := mem[t + offset];
  222.     BEQ.S   L5                      ;     IF (n # NIL) THEN
  223.     MOVE.L  D4,A1
  224.     MOVE.L  tag(A1),D2              ;       ntag := n.tag;
  225.     BTST.L  #MarkBitL,D2            ;       IF ~(31 IN ntag) [Unmarked]
  226.     BNE.S   L5
  227.     BTST.L  #SysBit,D2              ;       & ~(0 IN ntag) THEN [~SysBlk]
  228.     BNE.S   L5
  229.     MOVE.L  D3,tag(A0)              ;         q.tag := tag + qmask;
  230.     OR.L    D1,tag(A0)
  231. ;    MOVE.L  D2,D4                  ;         n.tag := ntag + {31};
  232. ;    BSET.L  #MarkBitL,D4
  233. ;    MOVE.L  D4,tag(A1)
  234.     BSET.B  #MarkBitB,tag(A1)       ;         n.tag := n.tag + {31};
  235.     BTST.B  #ArrayBit,D2            ;         IF ~(1 IN ntag) THEN
  236.     BNE.S   L4
  237.     MOVE.L  A3,0(A2,D0.L)           ;           mem[t + offset] := tos;
  238.     MOVE.L  A0,A3                   ;           tos := q;
  239.     MOVE.L  A1,A0                   ;           q := n;
  240.     MOVE.L  A0,A2                   ;           t := q;
  241.     MOVE.L  D2,D3                   ;           tag := ntag + PtrTabOffset - 4;
  242.     ADD.L   #PtrTabOffset-4,D3
  243.     MOVE.L  #$80000000,D1           ;           qmask := {31}
  244.     BRA.S   L5
  245. L4:
  246.     BTST.B  #SysBit,D2              ;         ELSIF ~(0 IN ntag) THEN
  247.     BNE.S   L5
  248.     MOVE.L  A3,0(A2,D0.L)           ;           mem[t + offset] := tos;
  249.     MOVE.L  A0,A3                   ;           tos := q;
  250.     MOVE.L  A1,A0                   ;           q := n;
  251.     CLR.L   arrpos(A0)              ;           q.arrpos := 0;
  252.     MOVE.L  A0,A2                   ;           t := q;
  253.     MOVE.L  D2,D3                   ;           tag := ntag - {1} + PtrTabOffset - 4;
  254.     BCLR.B  #ArrayBit,D3
  255.     ADD.L   #PtrTabOffset-4,D3
  256.     MOVE.L  #$80000002,D1           ;           qmask := {1, 31}
  257.                                     ;         END (* ELSIF *)
  258.                                     ;       END (* IF *)
  259.                                     ;     END (* IF *)
  260. L5:                                 ;   END; (* ELSE *)
  261.     ADDQ.L  #4,D3                   ;   INC(tag, 4)
  262.     BRA     Loop                    ; END (* LOOP *)
  263. Exit:
  264.     MOVE.L (A7)+,A4                 ; (* restore A4 *)
  265.     RTS
  266.  
  267. ;---------------------------------------------------------------------------
  268. ;
  269. ; PROCEDURE OberonSys_Sweep ()
  270. ;
  271. ; This procedure implements the sweep phase of the garbage collector.  It
  272. ; walks the list of allocated blocks anchored in the OberonSys.memList
  273. ; variable, unmarking marked blocks and freeing unmarked blocks.
  274. ;
  275. ; VAR
  276. ;   tag {A0}, block {A1}, prev {A2}, next {A3} : ADDRESS;
  277. ;   size {D0} : LONGINT;
  278. ;
  279. ;---------------------------------------------------------------------------
  280.  
  281.     SECTION OberonSys,CODE
  282.  
  283. OberonSys_Sweep:
  284.  
  285.     LEA     OS_memList(A5),A2           ; prev := ADR (OberonSys.memList);
  286.     MOVEA.L OS_memList(A5),A3           ; next := OberonSys.memList;
  287. S1:
  288.     MOVE.L  A3,D0                       ; WHILE next # NIL DO
  289.     BEQ.S   S6
  290.     BCLR.B  #7,4(A3)                    ;   IF Marked (next) THEN
  291.     BEQ.S   S2
  292.     ; Already done by BCLR above              Unmark (next);
  293.     MOVEA.L A3,A2                       ;     prev := next;
  294.     MOVEA.L (A3),A3                     ;     next := next.link
  295.     BRA.S   S1
  296. S2:                                     ;   ELSE
  297.     MOVEA.L A3,A1                       ;     block := next;
  298.     MOVEA.L (A3),A3                     ;     next := next.link;
  299.     MOVE.L  A3,(A2)                     ;     prev.link := next;
  300.     MOVE.L  4(A1),D1
  301.     BTST    #0,D1                       ;     IF 0 IN mem.tag THEN
  302.     BEQ.S   S3
  303.     MOVE.L  D1,D0                       ;       size := mem.tag + 7
  304.     ADDQ.L  #7,D0
  305.     BRA.S   S5
  306. S3:
  307.     BTST    #1,D1                       ;     ELSIF 1 IN mem.tag THEN
  308.     BEQ.S   S4
  309.     SUBQ.L  #8,A1                       ;       DEC (mem, 12);
  310.     SUBQ.L  #4,A1
  311.     MOVE.L  8(A1),D0                    ;       size := mem.size + 20
  312.     ADDI.L  #20,D0
  313.     BRA.S   S5
  314. S4:                                     ;     ELSE
  315.     MOVEA.L 4(A1),A0                    ;       size := mem.tag.size + 8
  316.     MOVE.L  (A0),D0
  317.     ADDQ.L  #8,D0
  318. S5:                                     ;     END;
  319.     MOVE.L  ABSEXECBASE,A6
  320.     CALLSYS FreeMem                     ;     FreeMem(mem,size)
  321.                                         ;   END; (* IF *)
  322.     BRA.S   S1                          ; END; (* WHILE *)
  323. S6:
  324.  
  325.     RTS
  326.  
  327. ;---------------------------------------------------------------------------
  328.  
  329.     END  ; OberonSys
  330.  
  331. ****************************************************************************
  332. *
  333. * $Log: GC.asm $
  334. * Revision 1.3  1994/05/16  16:32:13  fjc
  335. * - Fixed bug in OberonSys_Mark.  It didn't check for SysBlks
  336. *   in the right place and was trying to trace them as if they
  337. *   RecordBlks.  What a maroon.
  338. *
  339. * Revision 1.2  1994/05/12  20:31:15  fjc
  340. * - Prepared for release
  341. *
  342. * Revision 1.1  1994/01/15  18:31:52  fjc
  343. * Start of revision control
  344. *
  345. * (11 Jan 1994) First implementation
  346. * ( 4 Jan 1994) Stub created.
  347. *
  348. ****************************************************************************
  349.  
  350.