home *** CD-ROM | disk | FTP | other *** search
- ****************************************************************************
- *
- * $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
- ;;
- ****************************************************************************
-
-