//======================================================================================== // 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.