OpenVMS Source-Code Demos

basic_calling_c_demo5_part2

//========================================================================================
// title  : basic_calling_c_demo5_part2.c
// author : Neil Rieck	(http://neilrieck.net) (mailto:n.rieck@sympatico.ca)
// notes  : 1)	This file contains code for two functions which will be called from BASIC.
//		This means there is no main() or transfer address to call from a CLI
//	    2)	VMS-BASIC-1.7 up-cases everything written to the symbol table. This means
//		all C symbols must be up-cased as well. This is done by actually using
//		upper case or compiling with C with switch /NAMES=(UPPERCASE,TRUNCATED)
// history:
// ver who when     what
// --- --- -------- ----------------------------------------------------------------------
// 100 NSR 20170531 original effort
//     NSR 20170823 added example functions 53+54 (just hacking here)
//     NSR 20170824 added support for more array descriptor fields
//		    changed "dsc$descriptor_a" to "dsc$descriptor_nca"
//========================================================================================
#include <stdio.h>						//
#include <stdlib.h>						//
#include <string.h>						//
#include <descrip.h>						// for VMS string descriptors in C
#include <str$routines.h>					// for VMS string descriptors in VMS
//
//	VMSIFY
//      a macro for use in the VMS world (VMS strings employ this structure)
//	notes:	1.this macro can be used to pass VMS strings down to lower modules
//		2.the $DESCRIPTOR macro does something similar employing sizeof-1
//		3.this macro combines two operations
//
#define VMSIFY(a,b) {						\
    a.dsc$b_dtype = DSC$K_DTYPE_T;				\
    a.dsc$b_class = DSC$K_CLASS_S;				\
    a.dsc$w_length = strlen(b);					\
    a.dsc$a_pointer = (char *) malloc(strlen(b));		\
    strncpy(a.dsc$a_pointer,b,a.dsc$w_length);			\
}
//	VMSIFY2
//      a macro for use in the VMS world (VMS strings employ this structure)
//	notes:	1.this macro can be used to pass VMS strings up to calling modules
//		2.the $DESCRIPTOR macro does something similar employing sizeof-1
//		3.this macro combines two operations
//		4.unlike malloc, memory allocated via "str$get1_dx" will survive
//		  after this module exits.
//
#define VMSIFY2(a,b) {						\
    a.dsc$b_dtype = DSC$K_DTYPE_T;				\
    a.dsc$b_class = DSC$K_CLASS_D;				\
    a.dsc$w_length = strlen(b);					\
    a.dsc$a_pointer = NULL;					\
    rc = str$get1_dx(&a.dsc$w_length,&a);			\
    if ((rc & 7)!=1) printf("-e-str$get1_dx-rc: %ld\n",rc);	\
    strncpy(a.dsc$a_pointer,b,a.dsc$w_length);			\
}
//
//	forward declarations
//
void display_descriptor_a_details( struct dsc$descriptor_nca	*);
//
//==============================================================================
// c-function: basic_calling_c_demo_example_51()
//
// 1) when BASIC sends max=3 there are actually 4 (0-3) subscripts
// 2) BASIC declaration:
//	external long function basic_calling_c_demo_example_51(long by ref, string dim() by ref)
//==============================================================================
long basic_calling_c_demo_example_51(	long			*x_max,
					struct dsc$descriptor_d	*p1	) {
	int				i, j, max;		//
	char				*buf;			//
	int				rc;			//
	char				c_misc[999];		// bad idea but okay for a demo
	struct	dsc$descriptor_d	*p2;			// temporary pointer for real simple demo
	struct	dsc$descriptor_s	vms_misc1;		//
	struct	dsc$descriptor_s	vms_misc2;		// only used in conditional compile
	struct	dsc$descriptor_s	vms_misc3;		//	''
	//
	printf("c function: basic_calling_c_demo_example_51\n");
	p2 = p1;						// copy address (preserve p1)
	max = (*x_max)+1;					//
	for (i=0; i<max; i++, p2++) {
	    printf("-i-count      : %ld\n",i);
	    printf("-i-stuff-class: %ld type: %ld length: %ld address: %p\n",
		p2->dsc$b_dtype,
		p2->dsc$b_class,
		p2->dsc$w_length,
		p2->dsc$a_pointer				);
//	    printf("-i-string data: %s\n",   p2->dsc$a_pointer);			// fails because not NULL terminated
	    printf("-i-string data: %.*s\n", p2->dsc$w_length, p2->dsc$a_pointer);	// works properly
	    printf("===============\n");
	}
	//------------------------------------------------------
	//	prep to return more string data to the calling routine
	//------------------------------------------------------
	p2 = p1;						// copy address (preserve p1)
	max = (*x_max)+1;					//
	for (i=0; i<max; i++, p2++){				//
#define METHOD51 1						// choose 1 or 2
#if (METHOD51==1)
	    //
	    //	will only work provided malloc'd data is copied before this module exits
	    //
	    printf("using method 1 to concat\n");		//
	    sprintf(c_misc, " stuff tacked on");		// prep
	    VMSIFY(vms_misc1, c_misc);				// prep
	    rc = str$concat(p2, p2, &vms_misc1);		//
	    if ((rc & 7) != 1)					//
		printf("-e-str$concat-rc:%ld\n",rc);		//
	    free (vms_misc1.dsc$a_pointer);			// not really necessary
#else
	    //
	    //	This method creates a VMS string "up there" (associated with the
	    //	calling module's memory space) and is then manipulated "up there"
	    //	This is just shown as a proof of concept.
	    //
	    printf("using method 2 to concat\n");		//
	    VMSIFY2(vms_misc2, c_misc);				//
	    VMSIFY2(vms_misc3, "");				// created outside this routine
	    rc = str$concat(&vms_misc3, p2, &vms_misc2);	//
	    if ((rc & 7) != 1)					//
		printf("-e-str$concat-rc:%ld\n",rc);		//
	    rc = str$copy_dx(p2, &vms_misc3);			//
	    if ((rc & 7) != 1)					//
		printf("-e-str$copy_dx-rc:%ld\n",rc);		//
#endif
	}
	return (1);						// return something
}
//==============================================================================
// c-function: basic_calling_c_demo_example_52()
//
// 1) BASIC sends the function a 2d array (but stores it as a huge 1d array)
// 2) when BASIC sends max=3 there are actually 4 (0-3) subscripts
// 3) BASIC declaration:
//	external long function basic_calling_c_demo_example_52(long by ref, long by ref, string dim() by ref)
//==============================================================================
long basic_calling_c_demo_example_52(	long			*y_max,
					long			*x_max,
					struct dsc$descriptor_d *p1	) {
	int				i, j;			//
	int				x, y, max, offset;	//
	int				rc;			//
//	struct	dsc$descriptor_d	*p2;			// temporary pointer for real simple demo IS GONE
	char				c_misc[999];		//  bad idea but okay for a demo
	struct	dsc$descriptor_s	vms_misc1;		//
	struct	dsc$descriptor_s	vms_misc2;		// only used in conditional compile
	struct	dsc$descriptor_s	vms_misc3;		//	''
	//
	printf("c function: basic_calling_c_demo_example_52\n");
	//------------------------------------------------------
	//	method #1: extract as a 1d array (eg. list)
	//------------------------------------------------------
	printf("\n-i-method #1  : extract as a list\n");
	max = ((*y_max)+1) * ((*x_max)+1);			//
	for (i=0; i < max; i++){				//
	    printf("-i-count      : %ld\n",i);
	    printf("-i-stuff-class: %ld type: %ld length: %ld address: %p\n",
		(p1+i)->dsc$b_dtype,
		(p1+i)->dsc$b_class,
		(p1+i)->dsc$w_length,
		(p1+i)->dsc$a_pointer);
//	    printf("-i-string data: %s\n",   (p1+i)->dsc$a_pointer);				// would fail (not NULL terminated)
	    printf("-i-string data: %.*s\n", (p1+i)->dsc$w_length, (p1+i)->dsc$a_pointer);	// works properly
	    printf("===============\n");
	}
	//------------------------------------------------------
	//	method #2: extract as a 2d array
	//------------------------------------------------------
	printf("\n-i-method #2  : extract as a 2d array\n");
	max = ((*y_max)+1) * ((*x_max)+1);			//
	i = 0;							//
	for (y=0; y <= *y_max; y++){				//
	    for (x=0; x <= *x_max; x++){			//
		//
		// notes:
		// 1) this is sometimes referred as a stride calculation since
		// 	'y' movement is based upon the full stride of 'x'
		// 2) rememeber that BASIC told us to run from 0-to-max
		//
		offset = (((*x_max)+1) * y) + x;
		printf("-i-count      : %ld\n", i);
	 	printf("-i-stuff-class: %ld type: %ld length: %ld address: %p\n",
		    (p1+offset)->dsc$b_dtype,
		    (p1+offset)->dsc$b_class,
		    (p1+offset)->dsc$w_length,
		    (p1+offset)->dsc$a_pointer);
//		printf("-i-string data: %s\n"  ,
//			(p1+offset)->dsc$a_pointer);			// would fail because not NULL terminated
		printf("-i-string data: %.*s\n",
			(p1+offset)->dsc$w_length,
			(p1+offset)->dsc$a_pointer);			// works properly
		i++;
		printf("===============\n");
	    }
	}
	//------------------------------------------------------
	//	prep to return more string data to the calling routine
	//------------------------------------------------------
	max = ((*y_max)+1) * ((*x_max)+1);			//
	for (i=0; i < max; i++){				// process as a list
#define METHOD52 1						// choose 1 or 2
#if (METHOD52==1)
	    //
	    //	will only work provided malloc'd data is copied before this module exits
	    //
	    printf("using method 1 to concat\n");		//
	    sprintf(c_misc, " stuff tacked on");		// prep
	    VMSIFY(vms_misc1, c_misc);				//
	    rc = str$concat((p1+i),(p1+i), &vms_misc1);		//
	    if ((rc & 7) != 1)					//
		printf("-e-str$concat-rc:%ld\n",rc);		//
	    free (vms_misc1.dsc$a_pointer);			// not really necessary
#else
	    //
	    //	This method creates a VMS string "up there" (associated with the
	    //	calling module's memory space) and is then manipulated "up there"
	    //	This is just shown as a proof of concept.
	    //
	    printf("using method 2 to concat\n");		//
	    VMSIFY2(vms_misc2, c_misc);				//
	    VMSIFY2(vms_misc3, "");				// created outside this routine
	    rc = str$concat(&vms_misc3, (p1+i), &vms_misc2);	//
	    if ((rc & 7) != 1)					//
		printf("-e-str$concat-rc:%ld\n",rc);		//
	    rc = str$copy_dx((p1+i), &vms_misc3);		//
	    if ((rc & 7) != 1)					//
		printf("-e-str$copy_dx-rc:%ld\n",rc);		//
#endif
	}
	return (1);
}
//==============================================================================
// c-function: basic_calling_c_demo_example_53()
//
// 1) BASIC declaration:
//	external long function basic_calling_c_demo_example_53(string dim() by desc)
// 2) Here we try to find the string descriptor list address from the array descriptor
//==============================================================================
long basic_calling_c_demo_example_53( struct dsc$descriptor_nca	*p1	) {
	printf("c function: basic_calling_c_demo_example_53\n");
	display_descriptor_a_details(p1);
	return (1);
}
//==============================================================================
// c-function: basic_calling_c_demo_example_54()
//
// 1) BASIC declaration:
//	external long function basic_calling_c_demo_example_54(string dim(,) by desc)
// 2) Here we try to find the string descriptor list address from the array descriptor
//==============================================================================
long basic_calling_c_demo_example_54( struct dsc$descriptor_nca	*p1	) {
	printf("c function: basic_calling_c_demo_example_54\n");
	display_descriptor_a_details(p1);
	return (1);
}
//==============================================================================
//	display_descriptor_a_details()
//
// caveat: The first version of this routine employed "dsc$descriptor_a" but I changed that to
// "dsc$descriptor_nca" when I noticed that BASIC always set dsc$b_class = 10 (DSC$K_CLASS_NCA)
//==============================================================================
void display_descriptor_a_details( struct dsc$descriptor_nca * p1){
	//
	struct dsc$descriptor_d	*p3;				// pointer to dynamic string descriptor
	char			*p2;				//
	void			*pv;				// pointer with no flavor
	unsigned char		dimensions;			//
	//
	printf("-i-dsc address: %p\n", p1);			// which address is this pointing to?
	//
	//	display everything we could possibly know (see: SYS$STARLET_C.TLB)
	//
	printf("-i-length     : %d\n",	p1->dsc$w_length);	// data item length: 8 bytes for string descriptors
	printf("-i-type       : %d\n",	p1->dsc$b_dtype);	// data type code  : 24 = DSC$K_DTYPE_DSC
	printf("-i-class      : %d\n",	p1->dsc$b_class);	// descriptor class: 10 = DSC$K_CLASS_NCA
	printf("-i-addr       : %p\n",	p1->dsc$a_pointer);	// address of 1st byte of data storage
	printf("-i-scale      : %d\n",	p1->dsc$b_scale);	// see offical documentation
	printf("-i-digits     : %u\n",	p1->dsc$b_digits);	// see offical documentation
	printf("-i-fl.binscale: %d\n",	p1->dsc$b_aflags.dsc$v_fl_binscale);	// 1=power-of-two; otherwise 10
	printf("-i-fl.redim   : %d\n",	p1->dsc$b_aflags.dsc$v_fl_redim);	// 1=can be redimensioned
#define CLASS_A 0
#if (CLASS_A !=0)
	printf("-i-fl.column  : %d\n",  p1->dsc$b_aflags.dsc$v_fl_column);	// 1=column-major order (FORTRAN)
	printf("-i-fl.coeff   : %d\n",  p1->dsc$b_aflags.dsc$v_fl_coeff);	// 1=multipliers block present
	printf("-i-fl.bounds  : %d\n",	p1->dsc$b_aflags.dsc$v_fl_bounds);	// 1=bounds block present
#endif
	printf("-i-dimensions : %d\n",	p1->dsc$b_dimct);	// number of dimensions
	dimensions = p1->dsc$b_dimct;				// save this for later
	printf("-i-size       : %ld\n",	p1->dsc$l_arsize);	// total size of the array in bytes
	//
	//	this stuff is an extrapolation from data following the descriptor
	//	caveat: the value of dimensions will change the size of this area
	//
	printf("-i-additional information\n");
	pv = p1;						// copy address
	pv += 16;						// advance to area after descripter
	printf("-i-stride block address: %p\n", pv);		//
	pv = pv + 4;						// skip past *dsc$$a_a0
	pv = pv + (dimensions * 4);				// skip past strides
	for (int i=0; i<dimensions; i++){
	    printf("-i-dimension %d lower bound: %d\n", i, *(long*) pv);
	    pv += 4;
	    printf("-i-dimension %d upper bound: %d\n", i, *(long*) pv);
	    pv += 4;
	}
	//
	//	display 28 bytes after the first passed address
	//
	printf("\ndump #1 (48-byte dump of array descriptor)\n");
	p2 = (char*) p1;
	for (char i=0; i<48; i++){
	    printf("-i-addr: %p byte: %d %d\n", (p2+i), i, *(p2+i));
	}
	//
	//	display 28 bytes after the second passed address
	//
	printf("\ndump #2 (28-byte dump of string descriptor)\n");
	p2 = (char*) p1->dsc$a_pointer;
	for (char i=0; i<28; i++){
	    printf("-i-addr: %p byte: %d %d\n", (p2+i), i, *(p2+i));
	}
	//
	//	display 2 descriptors based upon the second passed address
	//
	printf("\n2-descriptor extract\n");
	p3 = (struct dsc$descriptor_d *) p1->dsc$a_pointer;
	for (char i=0; i<2; i++){
	    printf("-i-stuff-class: %ld type: %ld length: %ld address: %p\n",
		(p3+i)->dsc$b_dtype,
		(p3+i)->dsc$b_class,
		(p3+i)->dsc$w_length,
		(p3+i)->dsc$a_pointer);
	    printf("-i-string data: %.*s\n", (p3+i)->dsc$w_length, (p3+i)->dsc$a_pointer);
	}
}

Back to OpenVMS
Back to OpenVMS Demo Index
Back to Home
Neil Rieck
Kitchener - Waterloo - Cambridge, Ontario, Canada.