OpenVMS Source Code Demos
basic_calling_c_demo5_part2
//========================================================================================
// title : basic_calling_c_demo5_part2.c
// author : Neil Rieck (https://neilrieck.net) (mailto:n.rieck@bell.net)
// 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"
// NSR 20180102 a few tweaks before republishing this
//========================================================================================
#define __NEW_STARLET 1 // enable strict starlet (>= OpenVMS70)
#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 create VMS strings in c space
// 2. the $DESCRIPTOR macro does something similar employing sizeof-1
// 3. this macro combines two operations
// 4. use str$copy_dx() to copy string data up to the calling program
//
#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 create VMS strings in VMS space
// 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 *pv; // pointer with little 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 = (unsigned char*) 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 HomeNeil Rieck
Waterloo, Ontario, Canada.