OpenVMS Source Code Demos

basic_calling_c_demo3_part2

//========================================================================================
// title  : basic_calling_c_demo3_part2_100.c
// author : Neil Rieck	(https://neilrieck.net) (mailto:[email protected])
// notes  : 1)	This file contains code for a function 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 20141112 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
//
struct xyz {							//
	long	gCmn_sanity;					//
	long	gCmnArraySize;					// last subscript
	long	gCmnStrLen[41];					// 0-40 items
	char	gCmnString[41][99];				// 0-40 strings
	long	gCmn_last;					//
};
#pragma member_alignment restore				//

//==============================================================================
// function: basic_calling_c_demo_c8
// BASIC declaration:
//	external long function basic_calling_c_demo_c8
//==============================================================================
long basic_calling_c_demo_c8()					{
	//
	long rv		= 0;					// return value
	char test0[]	= "this is a test";			//
	char test1[]	= "this line is a little longer";	//
	//
	#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_c8\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
	}
	if (abc.gCmnArraySize<0) {
	    printf("-e-no room in array to store data\n");
	    exit;						// just die
	}
	for (long i=0; i<abc.gCmnArraySize; i++) {
	    long junk;
	    char* ptr;
	    if (i==0) {
		junk = strlen(test0);				// measure length
		abc.gCmnStrLen[i] = junk;			// save here
		ptr = &abc.gCmnString[i][0];			// ptr is address of string
		strncpy(ptr,test0,junk);			// copy data via ptr
		rv++;						// update return value
	    }
	    if (i==1) {
		junk = strlen(test1);				// measure length
		abc.gCmnStrLen[i] = junk;			// save here
		strncpy(&abc.gCmnString[i][0],test1,junk);	// copy w/o ptr
		rv++;						// update return value
	    }
	}
	return (rv);						// number of strings written
}

---

Back to Home
Neil Rieck
Waterloo, Ontario, Canada.