**************************************************************************** * * $RCSfile: OberonSysGC.asm $ * Description: Runtime support for the Oberon-A compiler * * Created by: fjc (Frank Copeland) * $Revision: 1.3 $ * $Author: fjc $ * $Date: 1994/05/16 16:32:13 $ * * Copyright © 1994, Frank Copeland. * This file is part of the Oberon-A Library. * See Oberon-A.doc for conditions of use and distribution. * * Log entries are at the end of the file. * **************************************************************************** * * This file contains the MC68000 source code for part of the runtime support * library of the Oberon-A compiler. It contains the code to implement the * Oberon-A garbage collector. * * Other parts of the runtime system may be found in the other files in this * directory. The object files resulting from assembling these files are * concatenated to create OberonSys.lib. * * This code is by definition *not* re-entrant and is not suitable for * creating shared-code libraries. * **************************************************************************** ;--------------------------------------------------------------------------- ; Program unit hunk name ; !! DO NOT CHANGE UNLESS YOU KNOW WHAT YOU ARE DOING !! TTL OberonSys ;--------------------------------------------------------------------------- ; Imports INCLUDE "OberonSys.i" ABSEXECBASE EQU 4 FreeMem EQU -210 ;--------------------------------------------------------------------------- ; Macros CALLSYS MACRO JSR \1(A6) ENDM ;--------------------------------------------------------------------------- ; Defines SysBit EQU 0 ArrayBit EQU 1 MarkBitB EQU 7 MarkBitL EQU 31 tag EQU -4 size EQU -12 elemSize EQU -16 arrpos EQU -20 PtrTabOffset EQU 36 ;--------------------------------------------------------------------------- ; PROCEDURE OberonSys_GC () ; ; A call to this procedure is generated by the compiler when it translates a ; call to SYSTEM.GC. OberonSys_GC implements a mark-and-sweep garbage ; collector. See TechNotes.doc and Memory.doc for a discussion of the ; memory management system and the garbage collector. ; ; This procedure forms the outer loop of the mark phase and OberonSys_Mark ; is the inner loop. It walks the list of global variable descriptors ; generated by the compiler and applies the mark algorithm to each global ; pointer variable. After marking is completed OberonSys_Sweep is called to ; collect the unmarked memory. The global variable descriptors are accessed ; through the offsetPtr variable. They consist of a link field, a pointer ; to the base of the corresponding module's global variables, and an array ; of offsets. The offsetPtr variable is also used to access this array by ; repeatedly incrementing it by the size of an offset (4 bytes). The offset ; array is terminated by a negative value which is initialised so that ; adding it to offsetPtr restores it to point to the base of the descriptor. ; ; VAR ; offsetPtr {A6} : ; POINTER TO UNION ; offsetBlock : RECORD ; link : ADDRESS; ; varBase : ADDRESS; ; END; ; offset : LONGINT; ; END; ; varBase {A4} : ADDRESS; ; ptr {A0} : ADDRESS; ; offset {D7} : LONGINT; ; ;--------------------------------------------------------------------------- SECTION OberonSys,CODE XDEF OberonSys_GC OberonSys_GC: MOVEM.L A4-A5,-(A7) ; (* preserve registers *) LEA OberonSys_VAR,A5 ; (* load OberonSys_VAR *) MOVEA.L OS_GCVars(A5),A6 ; offsetPtr := OberonSys.GCVars; G1: MOVE.L A6,D0 ; WHILE offsetPtr # NIL DO BEQ.S G4 MOVEA.L 4(A6),A4 ; varBase := offsetPtr.varBase; ADDQ.L #8,A6 ; INC (offsetPtr, 8); G2: ; LOOP MOVE.L (A6)+,D7 ; offset := offsetPtr.offset; ; INC (offsetPtr, 4) BMI.S G3 ; IF offset >= 0 THEN MOVE.L 0(A4,D7.L),D0 ; ptr := mem [varBase + offset]; BEQ.S G2 ; IF (ptr # NIL) MOVE.L D0,A0 BSET.B #MarkBitB,tag(A0) ; & Unmarked(ptr) BNE.S G2 BTST.B #SysBit,tag+3(A0) ; & ~SysBlk (ptr) THEN BNE.S G2 ; Already done by BSET above SetMark (ptr); BSR OberonSys_Mark ; OberonSys_Mark (ptr) BRA G2 ; END; G3: ; ELSE ADDA.L D7,A6 ; offsetPtr := offsetPtr+offset; SUBQ.L #4,A6 ; (* compensate for increment *) ; EXIT ; END ; END; (* LOOP *) MOVEA.L (A6),A6 ; offsetPtr := offsetPtr.link BRA.S G1 G4: ; END; (* WHILE *) BSR OberonSys_Sweep ; OberonSys_Sweep () MOVEM.L (A7)+,A4-A5 ; (* restore registers *) RTS ;--------------------------------------------------------------------------- ; ; PROCEDURE OberonSys_Mark (q {A0} : Pointer) ; ; OberonSys_Mark is a direct implementation of the algorithm described in ; the Oberon Technical Notes, part 5 (see TechNotes.doc). It forms the ; inner loop of the mark phase and assumes that the root pointer variable ; passed in A0 has already been marked. The algorithm has been modified ; slightly to reflect the different tag encodings and memory block formats ; used by Oberon-A. ; ; Address registers A1-A3 and all the data registers are free on entry. ; ; VAR ; n {A1}, t {A2}, tos {A3} : Pointer; ; offset {D0}, tag {A4,D3} : LONGINT; ; qmask {D1}, ntag {D2} : SET; ; ;--------------------------------------------------------------------------- SECTION OberonSys,CODE OberonSys_Mark: MOVE.L A4,-(A7) ; (* Create an extra free register *) BTST.B #ArrayBit,tag+3(A0) ; IF 1 IN q.tag THEN BEQ.S M1 CLR.L arrpos(A0) ; q.arrpos := 0; MOVE.L #$80000002,D1 ; qmask := {1, 31} BRA.S M2 M1: ; ELSE MOVE.L #$80000000,D1 ; qmask := {31} M2: ; END; MOVE.L A0,A2 ; t := q; MOVE.L tag(A0),D3 ; tag := q.tag - {1, 31} + PtrTabOffset AND.L #$7FFFFFFD,D3 ADD.L #PtrTabOffset,D3 SUB.L A3,A3 ; tos := NIL; Loop: ; LOOP {H} MOVE.L D3,A4 ; offset := mem[tag]; MOVE.L (A4),D0 BPL.S L3 ; IF offset < 0 THEN MOVE.L D3,D4 ; q.tag := tag + offset + qmask; ADD.L D0,D4 OR.L D1,D4 MOVE.L D4,tag(A0) BTST.B #ArrayBit,D1 ; IF 1 IN qmask BEQ.S L1 MOVE.L elemSize(A0),D4 ADD.L arrpos(A0),D4 CMP.L size(A0),D4 ; & (q.arrpos + q.elemSize # q.size) THEN BEQ.S L1 MOVE.L elemSize(A0),D4 ; INC(q.arrpos,q.elemSize); ADD.L D4,arrpos(A0) ADD.L D0,D3 ; INC(tag, offset + PtrTabOffset - 4); ADD.L #PtrTabOffset-4,D3 ADD.L elemSize(A0),A2 ; INC(t, q.elemSize) BRA L5 L1: MOVE.L A3,D4 ; ELSIF tos = NIL THEN BEQ Exit ; EXIT ; ELSE MOVE.L tag(A3),D1 ; qmask := tos.tag; MOVE.L D1,D3 ; tag := qmask - {1, 31}; AND.L #$7FFFFFFD,D3 AND.L #$80000002,D1 ; qmask := qmask * {1, 31}; MOVE.L A3,A2 ; t := tos; BTST.B #ArrayBit,D1 ; IF 1 IN qmask THEN BEQ.S L2 ADD.L arrpos(A3),A2 ; INC (t, tos.arrpos) L2: ; END; MOVE.L D3,A4 ; offset := mem[tag]; MOVE.L (A4),D0 MOVE.L 0(A2,D0.L),A1 ; n := mem[t + offset]; MOVE.L A0,0(A2,D0.L) ; mem[t + offset] := q; MOVE.L A3,A0 ; q := tos; MOVE.L A1,A3 ; tos := n BRA.S L5 ; END L3: ; ELSE MOVE.L 0(A2,D0.L),D4 ; n := mem[t + offset]; BEQ.S L5 ; IF (n # NIL) THEN MOVE.L D4,A1 MOVE.L tag(A1),D2 ; ntag := n.tag; BTST.L #MarkBitL,D2 ; IF ~(31 IN ntag) [Unmarked] BNE.S L5 BTST.L #SysBit,D2 ; & ~(0 IN ntag) THEN [~SysBlk] BNE.S L5 MOVE.L D3,tag(A0) ; q.tag := tag + qmask; OR.L D1,tag(A0) ; MOVE.L D2,D4 ; n.tag := ntag + {31}; ; BSET.L #MarkBitL,D4 ; MOVE.L D4,tag(A1) BSET.B #MarkBitB,tag(A1) ; n.tag := n.tag + {31}; BTST.B #ArrayBit,D2 ; IF ~(1 IN ntag) THEN BNE.S L4 MOVE.L A3,0(A2,D0.L) ; mem[t + offset] := tos; MOVE.L A0,A3 ; tos := q; MOVE.L A1,A0 ; q := n; MOVE.L A0,A2 ; t := q; MOVE.L D2,D3 ; tag := ntag + PtrTabOffset - 4; ADD.L #PtrTabOffset-4,D3 MOVE.L #$80000000,D1 ; qmask := {31} BRA.S L5 L4: BTST.B #SysBit,D2 ; ELSIF ~(0 IN ntag) THEN BNE.S L5 MOVE.L A3,0(A2,D0.L) ; mem[t + offset] := tos; MOVE.L A0,A3 ; tos := q; MOVE.L A1,A0 ; q := n; CLR.L arrpos(A0) ; q.arrpos := 0; MOVE.L A0,A2 ; t := q; MOVE.L D2,D3 ; tag := ntag - {1} + PtrTabOffset - 4; BCLR.B #ArrayBit,D3 ADD.L #PtrTabOffset-4,D3 MOVE.L #$80000002,D1 ; qmask := {1, 31} ; END (* ELSIF *) ; END (* IF *) ; END (* IF *) L5: ; END; (* ELSE *) ADDQ.L #4,D3 ; INC(tag, 4) BRA Loop ; END (* LOOP *) Exit: MOVE.L (A7)+,A4 ; (* restore A4 *) RTS ;--------------------------------------------------------------------------- ; ; PROCEDURE OberonSys_Sweep () ; ; This procedure implements the sweep phase of the garbage collector. It ; walks the list of allocated blocks anchored in the OberonSys.memList ; variable, unmarking marked blocks and freeing unmarked blocks. ; ; VAR ; tag {A0}, block {A1}, prev {A2}, next {A3} : ADDRESS; ; size {D0} : LONGINT; ; ;--------------------------------------------------------------------------- SECTION OberonSys,CODE OberonSys_Sweep: LEA OS_memList(A5),A2 ; prev := ADR (OberonSys.memList); MOVEA.L OS_memList(A5),A3 ; next := OberonSys.memList; S1: MOVE.L A3,D0 ; WHILE next # NIL DO BEQ.S S6 BCLR.B #7,4(A3) ; IF Marked (next) THEN BEQ.S S2 ; Already done by BCLR above Unmark (next); MOVEA.L A3,A2 ; prev := next; MOVEA.L (A3),A3 ; next := next.link BRA.S S1 S2: ; ELSE MOVEA.L A3,A1 ; block := next; MOVEA.L (A3),A3 ; next := next.link; MOVE.L A3,(A2) ; prev.link := next; MOVE.L 4(A1),D1 BTST #0,D1 ; IF 0 IN mem.tag THEN BEQ.S S3 MOVE.L D1,D0 ; size := mem.tag + 7 ADDQ.L #7,D0 BRA.S S5 S3: BTST #1,D1 ; ELSIF 1 IN mem.tag THEN BEQ.S S4 SUBQ.L #8,A1 ; DEC (mem, 12); SUBQ.L #4,A1 MOVE.L 8(A1),D0 ; size := mem.size + 20 ADDI.L #20,D0 BRA.S S5 S4: ; ELSE MOVEA.L 4(A1),A0 ; size := mem.tag.size + 8 MOVE.L (A0),D0 ADDQ.L #8,D0 S5: ; END; MOVE.L ABSEXECBASE,A6 CALLSYS FreeMem ; FreeMem(mem,size) ; END; (* IF *) BRA.S S1 ; END; (* WHILE *) S6: RTS ;--------------------------------------------------------------------------- END ; OberonSys **************************************************************************** * * $Log: OberonSysGC.asm $ * Revision 1.3 1994/05/16 16:32:13 fjc * - Fixed bug in OberonSys_Mark. It didn't check for SysBlks * in the right place and was trying to trace them as if they * RecordBlks. What a maroon. * * Revision 1.2 1994/05/12 20:31:15 fjc * - Prepared for release * * Revision 1.1 1994/01/15 18:31:52 fjc * Start of revision control * * (11 Jan 1994) First implementation * ( 4 Jan 1994) Stub created. * ****************************************************************************