****************************************************************************
*
*    $RCSfile: SETCLEANUP.asm $
* Description: Runtime support for the Oberon-A compiler
*
*  Created by: fjc (Frank Copeland)
*   $Revision: 1.1 $
*     $Author: fjc $
*       $Date: 1994/07/24 18:31:15 $
*
* 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 standard procedure SYSTEM.SETCLEANUP().
*
* 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

;---------------------------------------------------------------------
;    Macros

CALLSYS MACRO
        JSR \1(A6)
        ENDM

;---------------------------------------------------------------------
; PROCEDURE OberonSys_SETCLEANUP (
;   proc {D0} : PROCEDURE)
;
; A call to this procedure is generated by the compiler when it
; translates a call to SYSTEM.SETCLEANUP (). The address of the
; procedure to be installed as a cleanup procedure is passed in D0.
;
; The procedure calls OberonSys_SYSNEW to allocate a small structure
; to hold the cleanup procedure and a link pointer.
;
;
;---------------------------------------------------------------------

     SECTION OberonSys,CODE

     XDEF      OberonSys_SETCLEANUP
     XREF      OberonSys_SYSNEW

; PROCEDURE SETCLEANUP (proc {D0} : PROCEDURE);
;
; TYPE
;   NodePtr = CPOINTER TO Node;
;   Node = RECORD link : NodePtr; proc : PROCEDURE END;
;
; VAR node {A0} : NodePtr;

OberonSys_SETCLEANUP:

        TST.L   D0             ;  IF proc # NIL THEN
        BEQ.S   1$
        MOVE.L  D0,-(A7)       ;    SYSTEM.NEW (node);
        MOVEQ   #8,D0
        MOVEQ   #0,D1
        SF      D2,
        BSR     OberonSys_SYSNEW
        TST.L   D0
        BNE.S   2$
        TRAP    #2
2$
        MOVEA.L D0,A0
        MOVE.L  (A7)+,4(A0)    ;    node.proc := proc;
        LEA     OberonSys_VAR,A1
        MOVE.L  OS_cleanupProc(A1),(A0)
                               ;    node.link := OberonSys.cleanupProc;
        MOVE.L  A0,OS_cleanupProc(A1)
                               ;    OberonSys.cleanupProc := node
1$                             ;  END

        RTS

;---------------------------------------------------------------------

     END  ; OberonSys

****************************************************************************
*
* $Log: SETCLEANUP.asm $
;; Revision 1.1  1994/07/24  18:31:15  fjc
;; Initial revision
;;
****************************************************************************