OpenVMS Source Code Demos
basic_calling_c_demo5_part2
//======================================================================================== // title : basic_calling_c_demo5_part2.c // author : Neil Rieck (https://neilrieck.net) (mailto:[email protected]) // 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.