OpenVMS Source Code Demos

GETRMI_DEMO_MSCP.BAS

1000	%title "getrmi_mscp_demo_xxx.bas"					!
	%ident                      "version 100.1"				! <<<---+--- these must match
	declare string constant k_version = "100.1"			,	! <<<---+			&
				k_program = "getrmi_mscp_demo"			!
	!=======================================================================
	! title  : getrmi_mscp_demo_xxx.bas
	! author : Neil Rieck ([email protected])
	! created: 2012.03.24
	! Notes  : will return all zeros if you do not have any MSCP disks
	!
	! ver who when     what
	! --- --- -------- -----------------------------------------------------
	! 100 NSR 20120324 1. original work
	!
	!	remember to update k_version above
	!=======================================================================
	option type=explicit							! no kid stuff
	!
	declare long	rc%	,	&
			i%	,	&
			ef%
	!
	!	pull in some stuff from STARTLET (the compiler is our friend)
	!
	%include "starlet"      %from %library "sys$library:basic$starlet"      ! system services
	%include "$ssdef"       %from %library "sys$library:basic$starlet"      ! ss$
	%include "$rmidef"      %from %library "sys$library:basic$starlet"      ! rmi$
	%include "$efndef"      %from %library "sys$library:basic$starlet"      ! efn$
	%include "$iledef"      %from %library "sys$library:basic$starlet"      ! ile$
	%include "$iosbdef"     %from %library "sys$library:basic$starlet"      ! iosb$
	!
	!	create a new record called ItemRec
	!	(I did this just to show how it could be done,
	!	 it would be better if you used the ILE3 predefined structure in starlet)
	!
%if %declared (%ITEMREC) = 0 %then
        record ItemRec								! structure of item record
            variant
		case
		    group one
		        word    BuffLen
		        word    ItemCode
		        long    BuffAddr
		        long    RtnLenAdr
		    end group one
		case
		    group two
		        long    List_Terminator
		        long    Junk1
		        long    Junk2
		    end group two
            end variant
        end record ItemRec
%let %ITEMREC = 1
%end %if
	!
	!	create a new datatype called RmiRec
	!
	record RmiRec								! structure of Rmi Record
!~~~	   ile3    ItemVar(?)							x ile3 is defined in starlet
	   ItemRec ItemVar(0)							! 0 -> 0 items (increase as necessary)
	   long    list_term							! for end-of-list marker
	end record RmiRec							!
	!
	!	now use the new datatype in a declaration statement
	!
	declare	RmiRec	RmiBuf							! Now declare a variable using it
	!
	record	switcheroo							! need this to fake out the compiler
	    variant								!
		case								!
		    group one							!
			IOSB my_iosb						! IOSB is defined in starlet
		    end group							!
		case								!
		    group two							!
			basic$quadword iosb_quad				! use this in the call
		    end group							!
	    end variant								!
	end record								!
	declare switcheroo	sw_iosb						!
	!
	!	Storage for info returned by GETRMI
	!
	declare long constant	k_mscp_max = 34					!
	map(mscp)	long	mscp_item(k_mscp_max)				! array is 0-34 items
	MAP(rmi)	long	l_RMI$_MSCP_EVERYTHING				!
	!
	!=======================================================================
	!	Main
	!=======================================================================
	main:
	print k_program +"_"+ k_version
	print string$(len(k_program +"_"+ k_version), asc("="))			! what will the optimizer do with this?
	!
	!	now data-fill the request list
	!	note: we'll do the first one this way just to show how
	!
	RmiBuf::ItemVar(0)::BuffLen	= (k_mscp_max + 1) * 4			! byte-size of data buffer (v_RMI$_BLKAST is LONG)
	RmiBuf::ItemVar(0)::ItemCode	= RMI$_MSCP_EVERYTHING			! requested data or operation
	RmiBuf::ItemVar(0)::BuffAddr	= loc( mscp_item(0) )			! address of our storage location
	RmiBuf::ItemVar(0)::RtnLenAdr	= loc( l_RMI$_MSCP_EVERYTHING)		! address of bytes written (0=don't care)
	!
	RmiBuf::LIST_TERM		= Rmi$C_ListEnd				! end of list
	!
	!	Okay, now make the call
	!
	!	docs:		SYS$GETRMI [efn] [,nullarg] [,nullarg] ,itmlst [,iosb] [,astadr] [,astprm]
	!	BASIC$STARLET:	LONG FUNCTION  SYS$GETRMI ( &
	!				LONG  BY VALUE, &
	!				LONG  BY VALUE, &
	!				LONG  BY VALUE, &
	!				ANY  BY REF, &
	!				BASIC$QUADWORD BY REF, &
	!				LONG  BY REF, &
	!				LONG  BY VALUE )
	!EFN$C_ENF
	!EFN$C_CTX
	rc% = sys$GetRmi(EFN$C_CTX,,,RmiBuf,sw_iosb::iosb_quad,,)		!
	print " getRmi-rc:     "+ str$(rc%)					!
	print " getRmi-iosb-rc "+ str$(sw_iosb::my_iosb::IOSB$W_STATUS)		!
	!
	!	Okay, now display the results
	!
	for i% = 0 to k_mscp_max
	    print using "## ";i%;
	    print mscp_item(i%)
	next i%
	print " bytes returned: "+str$(l_RMI$_MSCP_EVERYTHING)
	!
	end