home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 8 / FreshFishVol8-CD1.bin / useful / dev / obero / oberon-a / source / oberonsys / setcleanup.asm < prev    next >
Encoding:
Assembly Source File  |  1994-08-08  |  3.3 KB  |  115 lines

  1. ****************************************************************************
  2. *
  3. *    $RCSfile: SETCLEANUP.asm $
  4. * Description: Runtime support for the Oberon-A compiler
  5. *
  6. *  Created by: fjc (Frank Copeland)
  7. *   $Revision: 1.1 $
  8. *     $Author: fjc $
  9. *       $Date: 1994/07/24 18:31:15 $
  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 procedure SYSTEM.SETCLEANUP().
  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. ABSEXECBASE    EQU  4
  44.  
  45. ;---------------------------------------------------------------------
  46. ;    Macros
  47.  
  48. CALLSYS MACRO
  49.         JSR \1(A6)
  50.         ENDM
  51.  
  52. ;---------------------------------------------------------------------
  53. ; PROCEDURE OberonSys_SETCLEANUP (
  54. ;   proc {D0} : PROCEDURE)
  55. ;
  56. ; A call to this procedure is generated by the compiler when it
  57. ; translates a call to SYSTEM.SETCLEANUP (). The address of the
  58. ; procedure to be installed as a cleanup procedure is passed in D0.
  59. ;
  60. ; The procedure calls OberonSys_SYSNEW to allocate a small structure
  61. ; to hold the cleanup procedure and a link pointer.
  62. ;
  63. ;
  64. ;---------------------------------------------------------------------
  65.  
  66.      SECTION OberonSys,CODE
  67.  
  68.      XDEF      OberonSys_SETCLEANUP
  69.      XREF      OberonSys_SYSNEW
  70.  
  71. ; PROCEDURE SETCLEANUP (proc {D0} : PROCEDURE);
  72. ;
  73. ; TYPE
  74. ;   NodePtr = CPOINTER TO Node;
  75. ;   Node = RECORD link : NodePtr; proc : PROCEDURE END;
  76. ;
  77. ; VAR node {A0} : NodePtr;
  78.  
  79. OberonSys_SETCLEANUP:
  80.  
  81.         TST.L   D0             ;  IF proc # NIL THEN
  82.         BEQ.S   1$
  83.         MOVE.L  D0,-(A7)       ;    SYSTEM.NEW (node);
  84.         MOVEQ   #8,D0
  85.         MOVEQ   #0,D1
  86.         SF      D2,
  87.         BSR     OberonSys_SYSNEW
  88.         TST.L   D0
  89.         BNE.S   2$
  90.         TRAP    #2
  91. 2$
  92.         MOVEA.L D0,A0
  93.         MOVE.L  (A7)+,4(A0)    ;    node.proc := proc;
  94.         LEA     OberonSys_VAR,A1
  95.         MOVE.L  OS_cleanupProc(A1),(A0)
  96.                                ;    node.link := OberonSys.cleanupProc;
  97.         MOVE.L  A0,OS_cleanupProc(A1)
  98.                                ;    OberonSys.cleanupProc := node
  99. 1$                             ;  END
  100.  
  101.         RTS
  102.  
  103. ;---------------------------------------------------------------------
  104.  
  105.      END  ; OberonSys
  106.  
  107. ****************************************************************************
  108. *
  109. * $Log: SETCLEANUP.asm $
  110. ;; Revision 1.1  1994/07/24  18:31:15  fjc
  111. ;; Initial revision
  112. ;;
  113. ****************************************************************************
  114.  
  115.