home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 8 / FreshFishVol8-CD1.bin / useful / dev / obero / oberon-a / source / oberonsys / new.asm < prev    next >
Encoding:
Assembly Source File  |  1994-08-08  |  5.7 KB  |  175 lines
  1. ****************************************************************************
  2. *
  3. *    $RCSfile: NEW.asm $
  4. * Description: Runtime support for the Oberon-A compiler
  5. *
  6. *  Created by: fjc (Frank Copeland)
  7. *   $Revision: 1.4 $
  8. *     $Author: fjc $
  9. *       $Date: 1994/07/24 18:28:24 $
  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 procedures NEW() and SYSTEM.NEW().
  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.      XREF      OberonSys_CLEANUP
  44.  
  45. ABSEXECBASE    EQU  4
  46.  
  47. AllocMem       EQU  -198
  48.  
  49. ;---------------------------------------------------------------------
  50. ;    Macros
  51.  
  52. CALLSYS MACRO
  53.         JSR \1(A6)
  54.         ENDM
  55.  
  56. ;---------------------------------------------------------------------
  57. ; PROCEDURE OberonSys_NEW (
  58. ;   pSize {D0} : LONGINT;
  59. ;   pTag  {D1} : ADDRESS)
  60. ;
  61. ; A call to this procedure is generated by the compiler when it
  62. ; translates a call to NEW () with an Oberon pointer variable.
  63. ; The type tag for the variable is passed in D1.  If bit 1 in the
  64. ; type tag is set, an ArrayBlk is allocated using the size passed
  65. ; in D0, otherwise a RecordBlk is allocated using the size in the
  66. ; type descriptor.  The procedure calculates the actual number of
  67. ; bytes required by adding 8 bytes for a RecordBlk or 20 for an
  68. ; ArrayBlk.  See Memory.doc for a discussion of the memory
  69. ; allocation strategy.
  70. ;
  71. ; TYPE
  72. ;   RecordBlkPtr = POINTER TO RecordBlk;
  73. ;   RecordBlk = RECORD
  74. ;     link, tag : ADDRESS;
  75. ;     data : ...
  76. ;   END;
  77. ;   ArrayBlkPtr = POINTER TO ArrayBlk;
  78. ;   ArrayBlk = RECORD
  79. ;     arrpos, elemSize, size : LONGINT;
  80. ;     link, tag : ADDRESS;
  81. ;     data : ...
  82. ;   END;
  83. ;
  84. ; CONST
  85. ;     MEMCLEAR = {16};
  86. ;
  87. ; VAR
  88. ;     size {D0} : LONGINT;
  89. ;     memReqs {D1} : LONGSET;
  90. ;     savedSize {D2} : LONGINT;
  91. ;     mem {A0} : ADDRESS;
  92. ;     tag {A2} : ADDRESS;
  93. ;
  94. ;---------------------------------------------------------------------
  95.  
  96.      SECTION OberonSys,CODE
  97.  
  98.      XDEF      OberonSys_NEW
  99.  
  100. OberonSys_NEW:
  101.  
  102.      BTST      #31,D1                  ;   IF 31 IN pTag THEN
  103.      BEQ.S     1$
  104.      LEA       OberonSys_VAR,A5        ;     HALT (OS_BadTag)
  105.      MOVE.L    #OS_BadTag,OS_returnCode(A5)
  106.      JMP       OberonSys_CLEANUP
  107. 1$                                     ;   END;
  108.      MOVEA.L   D1,A2                   ;   tag := pTag;
  109.      BTST      #1,D1                   ;   IF 1 IN tag THEN (* ArrayBlk *)
  110.      BEQ.S     2$
  111.      MOVE.L    D0,D2                   ;     savedSize := pSize;
  112.      ADDI.L    #20,D0                  ;     INC (size, 20)
  113.      BRA.S     5$
  114. 2$                                     ;   ELSE
  115.      MOVE.L    (A2),D0                 ;     size := tag.size;
  116.      ADDQ.L    #8,D0                   ;     INC (size, 8)
  117. 5$                                     ;   END;
  118.      MOVEQ     #1,D1                   ;   memReqs := MEMCLEAR;
  119.      SWAP      D1
  120.      MOVEA.L   ABSEXECBASE,A6          ;   mem := Exec.AllocMem (size, memReqs);
  121.      CALLSYS   AllocMem
  122.      MOVEA.L   D0,A0
  123.      TST.L     D0                      ;   IF mem = NIL THEN RETURN NIL END;
  124.      BEQ.S     3$
  125.      MOVE.L    A2,D0                   ;   IF 1 IN tag THEN
  126.      BTST      #1,D0
  127.      BEQ.S     4$
  128.      MOVE.L    -2(A2),4(A0)            ;     mem.elemSize := tag.size
  129.      MOVE.L    D2,8(A0)                ;     mem.size := savedSize
  130.      ADDQ.L    #8,A0                   ;     INC (mem, 12)
  131.      ADDQ.L    #4,A0
  132. 4$                                     ;   END;
  133.      MOVE.L    A5,-(A7)
  134.      LEA       OberonSys_VAR,A5
  135.      MOVE.L    OS_memList(A5),(A0)     ;   mem.link := memList;
  136.      MOVE.L    A0,OS_memList(A5)       ;   memList := mem;
  137.      MOVE.L    (A7)+,A5
  138.      MOVE.L    A2,4(A0)                ;   mem.tag := tag;
  139.      ADDQ.L    #8,A0                   ;   INC (mem, 8)
  140.      MOVE.L    A0,D0                   ;   RETURN mem
  141. 3$
  142.      RTS
  143.  
  144. ;---------------------------------------------------------------------
  145.  
  146.      END  ; OberonSys
  147.  
  148. ****************************************************************************
  149. *
  150. * $Log: NEW.asm $
  151. * Revision 1.4  1994/07/24  18:28:24  fjc
  152. * - Changed code for calling HALT().
  153. *
  154. * Revision 1.3  1994/05/12  20:31:15  fjc
  155. * - Prepared for release
  156. *
  157. * Revision 1.2  1994/02/24  16:54:28  fjc
  158. * Changed parameters to pass size in D0 and tag in D1
  159. *
  160. * Revision 1.1  1994/01/15  18:31:52  fjc
  161. * Start of revision control
  162. *
  163. * (12 Jan 1994) Modified to handle change in ArrayBlk (elemSize added)
  164. *               Modified to assemble with PhxAss instead of A68K
  165. * ( 4 Jan 1994) Complete rewrite as part of implementation of the
  166. *               garbage collector.  OberonSysNEW is now one of two
  167. *               allocator procedures, instead of the sole allocator.
  168. * (28 Jun 1993) Changed the way it handles the sizeTag field.
  169. *               General overhaul.
  170. * (29 May 1993) Split OberonSys.asm into several files to create
  171. *               OberonSys.lib.
  172. *
  173. ****************************************************************************
  174.  
  175.