//_Header
//*******************************************************************
//    NOVA CONTROL SYSTEM  ---  Lawrence Livermore Laboratory
//
//    Copyright 1984 by The Regents of the University of California
//*******************************************************************
//
//_Module_Name:  VMSPROC		_File:  vmspro$src:VMSPROC.PRX
//
//_Description:
//	This module contains the support procedures for the VMS stubs
//_Call:
//	{See individual routines}
//_Identifier: { none }
//*******************************************************************
//_Author:  A. J. De Groot		_Creation_Date:  22-FEB-1985
//_Revisions:
//  1.000  29-Nov-1982	AJD	Initial Key-in.
%ident "1.000"
//*******************************************************************
//_End

module VMSPROC

use	DSCDEF
use	VMSTYPES

Export	Allocate_String_descriptor,
	Load_string_descriptor,
	Address


//Function to return the address of a variable
Function Address(x: in ref general) returns i: Integer
    Code "VAX" Do
	movl	4(ap),(sp)
      endcode
endfunction  {Address}

//Function to generate a string descriptor block
Function Allocate_String_Descriptor
    param
	text_string:	in ref packed array [1..?N] of char
	length:		optional in integer initially -1
    endparam
  Returns pntr: descriptor_pointer	//Returns pointer to generate block

    pntr:= allocate descriptor_pointer()
    pntr@.dsc'$t_pointer:= Force long_integer_pointer(address(text_string))
    pntr@.dsc'$w_length:= when length=-1 then N else length
    pntr@.dsc'$b_dtype:= dsc'$K_dtype_t
    pntr@.dsc'$b_class:= dsc'$K_class_s
endfunction  {Allocate_String_Descriptor}

// Procedure to load a string descriptor block
procedure Load_string_descriptor
    param
	desc:		inout ref descriptor
	text_string:	in ref packed array [1..?N] of char
	length:		optional in integer initially -1
    endparam

    desc.dsc'$t_pointer:= Force long_integer_pointer(address(text_string))
    desc.dsc'$w_length:= when length=-1 then N else length
    desc.dsc'$b_dtype:= dsc'$K_dtype_t
    desc.dsc'$b_class:= dsc'$K_class_s

endprocedure {Load_string_descriptor}

endmodule  {VMSPROC}