Google
 

Trailing-Edge - PDP-10 Archives - DEC_CMS-20_V1.0_SRC - cms/sources/stoage.bli
There are no other files named stoage.bli in the archive.
module stoage (	! Storage management facilities
		ident = '1',
		%if
		    %bliss(bliss32)
		%then
		    language(bliss32),
		    addressing_mode(external=long_relative,
				    nonexternal=long_relative)
		%else
		    language(bliss36)
		%fi
		) =
begin

!
!			  COPYRIGHT (C) 1982 BY
!	      DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
!
! THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND  COPIED
! ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH  LICENSE AND WITH THE
! INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR  ANY  OTHER
! COPIES  THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
! OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF  THE  SOFTWARE  IS  HEREBY
! TRANSFERRED.
!
! THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE  WITHOUT  NOTICE
! AND  SHOULD  NOT  BE  CONSTRUED  AS  A COMMITMENT BY DIGITAL EQUIPMENT
! CORPORATION.
!
! DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR  RELIABILITY  OF  ITS
! SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
!

!++
! Facility:  CMS Library Processor
!
! Abstract:
!
!	This module contains routines and declarations for managing zones
!	of main memory.  Segments are allocated individually in zones,
!	but cannot be individually freed.  An entire zone can be freed, however.
!
! Environment:  Transportable
!
! Author:  Earl Van Horn	Creation Date:  April, 1979
!
!--
!
! Table of Contents:
!
forward routine
    zalloc,			! Allocates a segment in a zone.
    zflush,			! Frees all storage allocated for a zone.
    zparam : novalue ;		! Sets the parameters of a zone.

!
! Include Files:
!
%if %bliss(bliss32) %then
    library 'sys$library:starlet';
%else
    require 'jsys:';
%fi
library 'XPORT:' ;
require 'BLISSX:' ;
require 'ZONUSR:' ;

!
! Macros:
!

!
! Equated Symbols:
!

!
! Own Storage:
!

!
! External References:
!
external routine
    bug : novalue ;		! Report a bug.
global routine zalloc(units, a_zone) =

!++
! Functional Description:
!
!	This routine allocates a segment having the supplied number of
!	addressable units, and returns the address of the segment.
!	The segment is allocated in the supplied zone.
!
! Formal Parameters:
!
!	units		Number of addressable units to be allocated.
!	a_zone:		Address of the block for the desired zone.
!			K_NULL means allocate in storage that will never
!			be freed.
!
! Implicit Inputs:
!
!	None
!
! Implicit Outputs:
!
!	None
!
! Routine Value:
! Completion Codes:
!
!	The address of the allocated segment.
!
! Side Effects:
!
!	The segment is allocated in system storage by $XPO_GET_MEM.
!
!--

    begin	! ZALLOC
    bind
	zone = .a_zone : zone_block ;

    local
	a_segment ;			! Address of allocated segment.

    if zone neq k_null
    then
	if .zone[zon_recognition] neq k_zon_recognition
	then
	    bug(lit('ZALLOC was given an invalid zone')) ;

    $xpo_get_mem(units = .units, result = a_segment) ;	! Ignore zone for now.

    .a_segment
    end ;	! ZALLOC
global routine zflush(a_zone) =

!++
! Functional Description:
!
!	This routine frees all the storage allocated in the given zone,
!	and returns the minimum number of addressable units that would
!	be needed to allocate the same objects in a single extent.
!
! Formal Parameters:
!
!	a_zone:		Address of the block for the zone to be flushed.
!
! Implicit Inputs:
!
!	None
!
! Implicit Outputs:
!
!	None
!
! Routine Value:
! Completion Codes:
!
!	The minimum number of addressable units that would be required to
!	allocate the same objects in a single extent.
!
! Side Effects:
!
!	The storage for the zone is freed by calling $XPO_FREE_MEM.
!
!--

    begin	! ZFLUSH
    bind
	zone = .a_zone : zone_block ;

    if zone eql k_null
    then
	bug(lit('ZFLUSH was called with K_NULL')) ;
    if .zone[zon_recognition] neq k_zon_recognition
    then
	bug(lit('ZFLUSH was given an invalid zone')) ;

    ! No-op for now.
    0
    end ;	! ZFLUSH
global routine zparam(a_zone, first_units, other_units, max_units) : novalue =

!++
! Functional Description:
!
!	This routine changes the parameters of a zone.  The NEW_ZONE macro,
!	which is declared in ZONUSR.REQ, not only creates a zone definition
!	block, but initializes it to the default values mentioned below.
!	Values other than the default may be specified by calling this routine.
!
!	This routine may be called at any time, and any number of times,
!	even after storage has been allocated in the zone.  The new parameters
!	affect subsequent operations.
!
!	The parameters are checked for consistency among themselves, and for
!	lack of conflict with the current parameters and state of the zone.
!
! Formal Parameters:
!
!	a_zone:		Address of the definition block for the zone whose
!			parameters are to be changed.
!	first_units:	The number of addressable units to be allocated in
!			the first extent of the zone.  If the first request is
!			larger than the	specified number of units, this
!			parameter is ignored, and only enough units are
!			allocated to satisfy the request.  Zero, which is the
!			default, therefore means to allocate only enough to
!			satisfy the first request.
!
!	other_units:	Same for extents and requests after the first.  A new
!			extent is allocated only if there is no more room in
!			the most recently allocated extent.
!
! Implicit Inputs:
!
!	None
!
! Implicit Outputs:
!
!	None
!
! Routine Value:
! Completion Codes:
!
!	None
!
! Side Effects:
!
!	None
!
!--

    begin	! ZPARAM
    bind
	zone = .a_zone : zone_block ;

    if zone eql k_null
    then
	bug(lit('ZPARAM was called with K_NULL')) ;
    if .zone[zon_recognition] neq k_zon_recognition
    then
	bug(lit('ZPARAM was given an invalid zone')) ;

    0 ;					! Noop for now.
    end ;	! ZPARAM
end				! Module STOAGE
eludom