Back to OpenVMS
Back to OpenVMS Demo Index
Back to HomeNeil Rieck
Kitchener - Waterloo - Cambridge, Ontario, Canada.
//========================================================================================
// title : basic_calling_c_demo1_part2_100.c
// author : Neil Rieck (http://www3.sympatico.ca/n.rieck) (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 OpenVMS
Back to OpenVMS Demo Index
Back to Home
Neil Rieck
Kitchener - Waterloo - Cambridge, Ontario, Canada.