home *** CD-ROM | disk | FTP | other *** search
/ Gold Fish 3 / goldfish_volume_3.bin / files / dev / obero / oberon-a / source / kernel / markdbg.asm < prev   
Encoding:
Assembly Source File  |  1995-06-29  |  8.1 KB  |  230 lines
  1. **********************************************************************
  2. *
  3. *    $RCSfile: MarkDbg.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: 1995/06/04 23:22:06 $
  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. ;---------------------------------------------------------------------
  20. ;    Program unit hunk name
  21. ;    !! DO NOT CHANGE UNLESS YOU KNOW WHAT YOU ARE DOING !!
  22.  
  23.     TTL Kernel
  24.  
  25. ;---------------------------------------------------------------------
  26. ;    Defines
  27.  
  28. SysBit          EQU 0
  29. ArrayBit        EQU 1
  30. MarkBitB        EQU 7
  31. MarkBitL        EQU 31
  32. tag             EQU -4
  33. size            EQU -16
  34. elemSize        EQU -20
  35. arrpos          EQU -24
  36. PtrTabOffset    EQU 68
  37.  
  38. id              EQU -8
  39. RecordBlkId     EQU $52424C4B
  40. ArrayBlkId      EQU $41424C4B
  41. SysBlkId        EQU $53424C4B
  42.  
  43. ;---------------------------------------------------------------------
  44. ;
  45. ; PROCEDURE Kernel_Mark (q {A0} : Pointer)
  46. ;
  47. ; NB: This is a special debug version that checks the id field of each
  48. ; memory block and causes a trap if it is not legal.
  49. ;
  50. ; Kernel_Mark is a direct implementation of the algorithm described in
  51. ; the Oberon Technical Notes, part 5 (see TechNotes.doc).  It forms
  52. ; the inner loop of the mark phase and assumes that the root pointer
  53. ; variable passed in A0 has already been marked.  The algorithm has
  54. ; been modified slightly to reflect the different tag encodings and
  55. ; memory block formats used by Oberon-A.
  56. ;
  57. ; Address registers A1-A3 and all the data registers are free on
  58. ; entry.
  59. ;
  60. ; VAR
  61. ;   n {A1}, t {A2}, tos {A3} : Pointer;
  62. ;   offset {D0}, tag {A4,D3} : LONGINT;
  63. ;   qmask {D1}, ntag {D2} : SET;
  64. ;
  65. ;---------------------------------------------------------------------
  66.  
  67.     SECTION OberonSys,CODE
  68.  
  69.     XDEF    Kernel_Mark
  70.  
  71. Kernel_Mark:
  72.  
  73.     MOVE.L  A4,-(A7)                ; (* Create an extra free register *)
  74.     BTST.B  #ArrayBit,tag+3(A0)     ; IF 1 IN q.tag THEN
  75.     BEQ.S   2$
  76.     CMPI.L  #ArrayBlkId,id(A0)      ;   ASSERT (q.id = ArrayBlkId);
  77.     BEQ.S   1$
  78.     TRAP    #6
  79.     BRA.S   1$
  80.     DC.L    11$
  81.     DC.L    10000
  82. 1$  CLR.L   arrpos(A0)              ;   q.arrpos := 0;
  83.     MOVE.L  #$80000002,D1           ;   qmask := {1, 31}
  84.     BRA.S   3$
  85. 2$                                  ; ELSE
  86.     CMPI.L  #RecordBlkId,id(A0)     ;   ASSERT (q.id = RecordBlkId);
  87.     BEQ.S   12$
  88.     TRAP    #6
  89.     BRA.S   12$
  90.     DC.L    11$
  91.     DC.L    $20000
  92. 12$ MOVE.L  #$80000000,D1           ;   qmask := {31}
  93. 3$                                  ; END;
  94.     MOVE.L  A0,A2                   ; t := q;
  95.     MOVE.L  tag(A0),D3              ; tag := q.tag - {1, 31} + PtrTabOffset
  96.     AND.L   #$7FFFFFFD,D3
  97.     ADD.L   #PtrTabOffset,D3
  98.     SUB.L   A3,A3                   ; tos := NIL;
  99. 4$                                  ; LOOP {H}
  100.     MOVE.L  D3,A4                   ;   offset := mem[tag];
  101.     MOVE.L  (A4),D0
  102.     BPL.S   7$                      ;   IF offset < 0 THEN
  103.     MOVE.L  D3,D4                   ;     q.tag := tag + offset + qmask;
  104.     ADD.L   D0,D4
  105.     OR.L    D1,D4
  106.     MOVE.L  D4,tag(A0)
  107.     BTST.B  #ArrayBit,D1            ;     IF 1 IN qmask
  108.     BEQ.S   5$
  109.     MOVE.L  elemSize(A0),D4
  110.     ADD.L   arrpos(A0),D4
  111.     CMP.L   size(A0),D4             ;     & (q.arrpos + q.elemSize # q.size) THEN
  112.     BEQ.S   5$
  113.     MOVE.L  elemSize(A0),D4         ;       INC(q.arrpos,q.elemSize);
  114.     ADD.L   D4,arrpos(A0)
  115.     ADD.L   D0,D3                   ;       INC(tag, offset + PtrTabOffset - 4);
  116.     ADD.L   #PtrTabOffset-4,D3
  117.     ADD.L   elemSize(A0),A2         ;       INC(t, q.elemSize)
  118.     BRA     9$
  119. 5$:
  120.     MOVE.L  A3,D4                   ;     ELSIF tos = NIL THEN
  121.     BEQ     10$                    ;       EXIT
  122.                                     ;     ELSE
  123.     MOVE.L  tag(A3),D1              ;       qmask := tos.tag;
  124.     MOVE.L  D1,D3                   ;       tag := qmask - {1, 31};
  125.     AND.L   #$7FFFFFFD,D3
  126.     AND.L   #$80000002,D1           ;       qmask := qmask * {1, 31};
  127.     MOVE.L  A3,A2                   ;       t := tos;
  128.     BTST.B  #ArrayBit,D1            ;       IF 1 IN qmask THEN
  129.     BEQ.S   6$
  130.     ADD.L   arrpos(A3),A2           ;         INC (t, tos.arrpos)
  131. 6$:                                 ;       END;
  132.     MOVE.L  D3,A4                   ;       offset := mem[tag];
  133.     MOVE.L  (A4),D0
  134.     MOVE.L  0(A2,D0.L),A1           ;       n := mem[t + offset];
  135.     MOVE.L  A0,0(A2,D0.L)           ;       mem[t + offset] := q;
  136.     MOVE.L  A3,A0                   ;       q := tos;
  137.     MOVE.L  A1,A3                   ;       tos := n
  138.     BRA     9$                      ;     END
  139. 7$:                                 ;   ELSE
  140.     MOVE.L  0(A2,D0.L),D4           ;     n := mem[t + offset];
  141.     BEQ     9$                      ;     IF (n # NIL) THEN
  142.     MOVE.L  D4,A1
  143.     MOVE.L  tag(A1),D2              ;       ntag := n.tag;
  144.     BTST.L  #MarkBitL,D2            ;       IF ~(31 IN ntag) [Unmarked]
  145.     BNE     9$
  146.  
  147.     BTST.L  #SysBit,D2              ;         IF 0 IN ntag THEN
  148.     BEQ.S   13$
  149.     CMPI.L  #SysBlkId,id(A1)        ;           ASSERT (n.id = SysBlkId)
  150.     BEQ.S   14$
  151.     TRAP    #6
  152.     BRA.S   14$
  153.     DC.L    11$
  154.     DC.L    $30000
  155. 13$ BTST.L  #ArrayBit,D2            ;         ELSIF 1 IN ntag THEN
  156.     BEQ.S   15$
  157.     CMPI.L  #ArrayBlkId,id(A1)      ;           ASSERT (n.id = ArrayBlkId)
  158.     BEQ.S   14$
  159.     TRAP    #6
  160.     BRA.S   14$
  161.     DC.L    11$
  162.     DC.L    $40000
  163. 15$                                 ;         ELSE
  164.     CMPI.L  #RecordBlkId,id(A1)     ;           ASSERT (n.id = RecordBlkId)
  165.     BEQ.S   14$
  166.     TRAP    #6
  167.     BRA.S   14$
  168.     DC.L    11$
  169.     DC.L    $50000
  170. 14$                                 ;         END;
  171.  
  172.     BSET.B  #MarkBitB,tag(A1)       ;         n.tag := n.tag + {31};
  173.     BTST.L  #SysBit,D2              ;         IF ~(0 IN ntag) THEN [~SysBlk]
  174.     BNE.S   9$
  175.     MOVE.L  D3,tag(A0)              ;           q.tag := tag + qmask;
  176.     OR.L    D1,tag(A0)
  177.     BTST.B  #ArrayBit,D2            ;           IF ~(1 IN ntag) THEN
  178.     BNE.S   8$
  179.     MOVE.L  A3,0(A2,D0.L)           ;             mem[t + offset] := tos;
  180.     MOVE.L  A0,A3                   ;             tos := q;
  181.     MOVE.L  A1,A0                   ;             q := n;
  182.     MOVE.L  A0,A2                   ;             t := q;
  183.     MOVE.L  D2,D3                   ;             tag := ntag + PtrTabOffset - 4;
  184.     ADD.L   #PtrTabOffset-4,D3
  185.     MOVE.L  #$80000000,D1           ;             qmask := {31}
  186.     BRA.S   9$
  187. 8$:
  188.     BTST.B  #SysBit,D2              ;           ELSIF ~(0 IN ntag) THEN
  189.     BNE.S   9$
  190.     MOVE.L  A3,0(A2,D0.L)           ;             mem[t + offset] := tos;
  191.     MOVE.L  A0,A3                   ;             tos := q;
  192.     MOVE.L  A1,A0                   ;             q := n;
  193.     CLR.L   arrpos(A0)              ;             q.arrpos := 0;
  194.     MOVE.L  A0,A2                   ;             t := q;
  195.     MOVE.L  D2,D3                   ;             tag := ntag - {1} + PtrTabOffset - 4;
  196.     BCLR.B  #ArrayBit,D3
  197.     ADD.L   #PtrTabOffset-4,D3
  198.     MOVE.L  #$80000002,D1           ;             qmask := {1, 31}
  199.                                     ;           END (* ELSIF *)
  200.                                     ;         END
  201.                                     ;       END (* IF *)
  202.                                     ;     END (* IF *)
  203. 9$:                                 ;   END; (* ELSE *)
  204.     ADDQ.L  #4,D3                   ;   INC(tag, 4)
  205.     BRA     4$                      ; END (* LOOP *)
  206. 10$:
  207.     MOVE.L  (A7)+,A4                ; (* restore A4 *)
  208.     RTS
  209.  
  210. 11$:
  211.     DC.B    "Kernel_Mark",0
  212.  
  213. ;---------------------------------------------------------------------
  214.  
  215.     END  ; Kernel
  216.  
  217. **********************************************************************
  218. *
  219. * $Log: MarkDbg.asm $
  220. ;; Revision 1.3  1995/06/04  23:22:06  fjc
  221. ;; - Release 1.6
  222. ;;
  223. ;; Revision 1.2  1995/01/26  00:37:31  fjc
  224. ;; - Release 1.5
  225. ;;
  226. ;; Revision 1.1  1995/01/09  18:29:01  fjc
  227. ;; Initial revision
  228. ;;
  229. **********************************************************************
  230.