Gold Fish 3/goldfish_volume_3.bin/files/dev/obero/oberon-a/source/kernel/kernel_1.4.mod

Text File | 1995-06-04 | 6.9 KB | 226 lines

(**************************************************************************

     $RCSfile: Kernel_1.4.mod $
  Description: Oberon-A run-time support module.

   Created by: fjc (Frank Copeland)
    $Revision: 1.3 $
      $Author: fjc $
        $Date: 1994/11/11 16:48:27 $

  Copyright © 1994, Frank Copeland.
  This file is part of Oberon-A.
  See Oberon-A.doc for conditions of use and distribution.
  _________________________________________________________________________

  Module Kernel will have a unique status in the Oberon-A system,
  starting with Release 1.5. It will implement the startup and exit code
  for each program, as well as the run-time support code for standard
  procedures such as NEW that are too large or complex to be generated
  inline by the compiler. Currently these tasks are handled by the code
  in OberonSys.lib, which is written in assembly language. However, this
  will require changes to the compiler to remove defunct procedures in
  module SYSTEM and to change hard-coded assumptions about the calling
  conventions and linker symbols of procedures in the run-time support
  code.

  This module is provided to help smooth the transition, without waiting
  for Release 1.5. It provides what will hopefully be close to the
  interface to the final module Kernel, but uses the features of the
  current Release 1.4 module SYSTEM to implement them.

  Existing code should be modified now to use module Kernel instead of
  the extended features that are due to be removed from module SYSTEM.
  These are:

    SYSTEM.ARGLEN and SYSTEM.ARGS -- replace with the fromWorkbench,
      dosCmdBuf, dosCmdLen and WBenchMsg variables exported by module
      Kernel.
    SYSTEM.SETCLEANUP -- replace with Kernel.SetCleanup.
    SYSTEM.GC -- replace with Kernel.GC.
    SYSTEM.GETNAME -- replace with Kernel.Name.
    SYSTEM.SIZETAG -- replace with Kernel.Size.
    SYSTEM.NEWTAG -- replace with Kernel.NewFromTag.
    SYSTEM.NEW -- when using the optional memory requirements parameter,
      use Kernel.New.

**************************************************************************)

<* STANDARD- *>
<* INITIALISE- *>
<* MAIN- *>

MODULE Kernel ["OberonSys.lib"];

(* Turn off ALL compiler checks. *)

<*$ CaseChk- IndexChk- NilChk- RangeChk- StackChk- TypeChk- OvflChk- *>

IMPORT SYS := SYSTEM;

TYPE

  STRPTR = POINTER [1] TO ARRAY 32767 OF CHAR;

(*-----------------------------------------------------------------------**
** These variables are used to hold the arguments passed to the program  **
** by AmigaDOS or Workbench. Do NOT make them writeable.                 **
**-----------------------------------------------------------------------*)

VAR

  fromWorkbench -: BOOLEAN;  (* TRUE if the program was started from
                             ** Workbench, FALSE if it was started by a
                             ** Shell or CLI.
                             *)

  dosCmdBuf     -: STRPTR;   (* When started from a Shell or CLI, this
                             ** variable will hold the command line used
                             ** to run the program. Only valid if
                             ** fromWorkbench is FALSE.
                             *)

  dosCmdLen     -: LONGINT;  (* The length in characters of the command
                             ** line. Only valid if fromWorkbench is
                             ** FALSE.
                             *)

  WBenchMsg     -: SYS.CPTR; (* The startup message sent to the program
                             ** by Workbench. Only valid if fromWorkbench
                             ** is TRUE. This must be cast to a
                             ** Workbench.WBStartupPtr to gain access to
                             ** the arguments.
                             *)


(*-----------------------------------------------------------------------**
** These types are used to implement the automatic cleanup system.       **
**-----------------------------------------------------------------------*)

TYPE

  CleanupProc * = PROCEDURE (VAR rc : LONGINT);

  CleanupPtr = POINTER [1] TO CleanupRec;
  CleanupRec = RECORD [1]
    link : CleanupPtr;
    proc : CleanupProc;
  END; (* CleanupRec *)


(*-----------------------------------------------------------------------**
** This variable is used to hold the list of installed cleanup           **
** procedures.                                                           **
**-----------------------------------------------------------------------*)

VAR

  cleanupList : CleanupPtr;

(*-----------------------------------------------------------------------*)

PROCEDURE* DoCleanup;

  VAR rc : LONGINT; cleanupPtr : CleanupPtr;

BEGIN (* DoCleanup *)
  (* Execute any installed cleanup procedures. *)

  rc := SYS.RC(); cleanupPtr := cleanupList;
  cleanupList := NIL; (* This avoids loops if an error occurs in a
                      ** cleanup procedure.
                      *)
  WHILE cleanupPtr # NIL DO
    cleanupPtr.proc (rc);
    cleanupPtr := cleanupPtr.link
  END;
END DoCleanup;


(* SetCleanup() installs a procedure that will be executed automatically
** when the program exits.
*)

PROCEDURE SetCleanup * ( proc : CleanupProc );

  VAR newCleanup : CleanupPtr;

BEGIN (* SetCleanup *)
  NEW (newCleanup); ASSERT (newCleanup # NIL, 25);
  newCleanup.link := cleanupList; cleanupList := newCleanup;
  newCleanup.proc := proc
END SetCleanup;


(* Size() returns the size in bytes of the record type whose type tag
** is passed as a parameter. The type tag is obtained by a call to
** SYSTEM.TAG.
*)

PROCEDURE Size * ( type : SYS.TYPETAG ) : LONGINT;

  VAR size : LONGINT;

BEGIN (* Size *)
  ASSERT (type # NIL, 132);
  RETURN SYS.SIZETAG (type)
END Size;


(* Name() copies the name of the type whose type tag is passed as a
** parameter into a string variable. The type tag is obtained by a call to
** SYSTEM.TAG.
*)

PROCEDURE Name * ( type : SYS.TYPETAG; VAR buf : ARRAY OF CHAR );

BEGIN (* Name *)
  ASSERT (type # NIL, 132);
  SYS.GETNAME (type, buf)
END Name;


(* NewFromTag() allocates a new record from the type tag passed as a
** parameter. The type tag is obtained by a call to SYSTEM.TAG.
*)

PROCEDURE NewFromTag * ( VAR v : SYS.PTR; type : SYS.TYPETAG );
BEGIN (* NewFromTag *)
  ASSERT (type # NIL, 132);
  SYS.NEWTAG (v, type)
END NewFromTag;


(* New() allocates a block of memory, with a specific set of memory
** requirements. The memory requirements are the same as those used by
** Exec.AllocMem().
*)

PROCEDURE New * ( VAR v : SYS.CPTR; size : LONGINT; reqs : SET );
BEGIN (* New *)
  SYS.NEW (v, size, reqs)
END New;


(*
** GC is a straight replacement for SYSTEM.GC
*)

PROCEDURE GC *;
BEGIN
  SYS.GC
END GC;

BEGIN (* Kernel *)
  SYS.ARGLEN (dosCmdLen);
  fromWorkbench := (dosCmdLen < 0);
  IF fromWorkbench THEN
    dosCmdBuf := NIL;
    SYS.ARGS (SYS.VAL (LONGINT, WBenchMsg))
  ELSE
    SYS.ARGS (SYS.VAL (LONGINT, dosCmdBuf));
    WBenchMsg := NIL
  END;
  SYS.SETCLEANUP (DoCleanup)
END Kernel.