OpenVMS Source Code Demos

basic_calling_c_demo1_part2

//========================================================================================
// title  : basic_calling_c_demo1_part2_100.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 20141107 original effort
//========================================================================================
#define __NEW_STARLET	1					// enable strict starlet (>= OpenVMS70)
#include <stdio.h>						//
#include <stdlib.h>						//
#include <string.h>						//
#include <descrip.h>						// for VMS string descriptors
//
#pragma member_alignment save					//
#pragma nomember_alignment					// force the next struct to be packed like a BASIC common
								// note: this could harm system performance (if not a file record
								// then consider inserting padding so variables are aligned on
								// longword (Alpha) or quadword (Itanium) boundaries)
//
//	the layout of this structure must match the layout of the common declared in BASIC
//	caveat: VMS-BASIC has no unsigned data types so "char sanity" is limited to 127
//
struct xyz {							//
	char	gCmn_sanity;					//  8-bit
	long	gCmnL;						// 32-bit
	short	gCmnW;						// 16-bit
	char	gCmnB;						//  8-bit
	short	gCmnStrLen;					// 16-bit
	char	gCmnStr[30];					//  8-bit
	char	gCmn_last;					//  8-bit
};
#pragma member_alignment restore				//

//==============================================================================
// function: basic_calling_c_demo_c1
// BASIC declaration:
//	external long function basic_calling_c_demo_c1(string by desc,	&
//		long by ref,word by ref,byte by ref)
//==============================================================================
long basic_calling_c_demo_c1(	struct dsc$descriptor_s * p1	,
				long			* p2	,
				short			* p3	,
				char			* p4	) {
	#pragma extern_model save
	#pragma extern_model common_block
	extern struct xyz abc;				// abc is a common area defined in BASIC
	#pragma extern_model restore
	//
	printf("c function: basic_calling_c_demo_c1\n");
	//
	//	if the common area in C isn't the same size as the one computed by BASIC
	//	1) because someone might have modified one but not the other	...
	//	2) or one language packed the structure while the other did not	...
	//	3) or "extern" was not entered					...
	//	then print an error before exiting.
	//
	if (sizeof(abc)!=abc.gCmn_sanity) {
	    printf("-e-common block sanity error\n");
	    printf("   C:     sizeof(abc) = %ld\n", sizeof(abc));
	    printf("   BASIC: abc.sanity  = %ld\n", abc.gCmn_sanity);
	    printf("   Note: the BASIC common <> C common\n");
	    exit;					// just die
	}
	//
	//	display variables passed here
	//
//	printf("p1 = %s\n",p1->dsc$a_pointer);		// NO! This is not null terminated
	printf("p1 = ");
	fwrite(p1->dsc$a_pointer,1,p1->dsc$w_length,stdout);
	printf("\n");
	printf("p2 = %d\n",*p2);
	printf("p3 = %d\n",*p3);
	printf("p4 = %d\n",*p4);
	//
	//	display common global variables
	//
	abc.gCmnStr[abc.gCmnStrLen] = '\0';		// null terminate the fixed length string
	printf("fx = %s\n", abc.gCmnStr);
	//
	//	modify common global variables
	//
	abc.gCmnL = 123;				// change a few shared variables
	abc.gCmnW = 45;					//
	abc.gCmnB = 6;					//
	return (12345);					// return something
}
//==============================================================================
// function: basic_calling_c_demo_c2
// BASIC declaration:
//	external sub basic_calling_c_demo_c2(string by desc,	&
//		long by ref,word by ref,byte by ref)
//==============================================================================
void basic_calling_c_demo_c2(	struct dsc$descriptor_s * p1	,
				long			* p2	,
				short			* p3	,
				char			* p4	) {
	#pragma extern_model save
	#pragma extern_model common_block
	extern struct xyz abc;				// abc is a common area defined in BASIC
	#pragma extern_model restore
	//
	printf("c function: basic_calling_c_demo_c2\n");
	//
	if (sizeof(abc)!=abc.gCmn_sanity) {
	    printf("-e-common block sanity error\n");
	    printf("   C:     sizeof(abc) = %ld\n", sizeof(abc));
	    printf("   BASIC: abc.sanity  = %ld\n", abc.gCmn_sanity);
	    printf("   Note: the BASIC common <> C common\n");
	    exit;					// just die
	}
	//
	//	display variables passed here
	//
//	printf("p1 = %s\n",p1->dsc$a_pointer);		// NO! This is not null terminated
	fwrite(p1->dsc$a_pointer,1,p1->dsc$w_length,stdout);
	printf("\n");
	printf("p2 = %d\n",*p2);
	printf("p3 = %d\n",*p3);
	printf("p4 = %d\n",*p4);
	//
	//	modify common global variables
	//
	abc.gCmnL = 789;				// change a few shared variables
	abc.gCmnW = 12;					//
	abc.gCmnB = 3;					//
}
//==============================================================================
// function: basic_calling_c_demo_c3
// BASIC declaration:
//	external sub basic_calling_c_demo_c3(string by desc)
//==============================================================================
void basic_calling_c_demo_c3(	struct dsc$descriptor_s * p1	) {
	char buf[100];
	//
	printf("c function: basic_calling_c_demo_c3\n");
	//
	if ( (p1->dsc$w_length-1) > sizeof(buf)) {
	    printf("-e-error, no room to copy string\n");
	    printf("   buffer size: %ld bytes\n", sizeof(buf));
	    printf("   data size  : %ld bytes\n", p1->dsc$w_length);
	    exit;
	}
	//
	sprintf(buf,"%s","aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa");	// data-fill to debug
	strncpy(buf,p1->dsc$a_pointer,p1->dsc$w_length);	//
	buf[p1->dsc$w_length] = '\0';				// append a NULL
	printf("p1 = %s\n", buf);				//
}
//==============================================================================
// function: basic_calling_c_demo_c4
// BASIC declaration:
//	external sub basic_calling_c_demo_c4(string by desc)
//==============================================================================
void basic_calling_c_demo_c4(	struct dsc$descriptor_s * p1	) {
	char *buf;
	//
	printf("c function: basic_calling_c_demo_c4\n");
	//
	buf = malloc(p1->dsc$w_length+1);			// allocate some memory
	//
	if (buf==0) {						// optional test
	    printf("-e-oops, no memory available\n");		// optional test
	    exit;						// optional test
	}
	//
	strncpy(buf,p1->dsc$a_pointer,p1->dsc$w_length);	// copy data into memory
	buf[p1->dsc$w_length] = '\0';				//
	printf("p1 = %s\n", buf);				//
	//
	free(buf);						// optional memory cleanup
}

---

Back to Home
Neil Rieck
Waterloo, Ontario, Canada.