Skip to content

Instantly share code, notes, and snippets.

@drikosev

drikosev/Dictionary.txt

Last active February 11, 2022 08:18
Show Gist options
  • Star 1 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save drikosev/d35956f266ff7af49074e7e669cd34df to your computer and use it in GitHub Desktop.
Save drikosev/d35956f266ff7af49074e7e669cd34df to your computer and use it in GitHub Desktop.
Download ZIP
BOZ Literal Constants in function "ulen"
Raw
c_dictionary.f90
!Fortran API to the Dictionary
module c_dictionary
use iso_c_binding, only: C_CHAR, C_NULL_CHAR
interface
! The desired, but unsupported, structure of the key-value dictionary:
! TYPE, BIND(C) :: key_text_t
! integer :: key=0
! character(:), allocatable :: word
! end type key_text_t
!
! The desired, but unsupported, Dictionary Table declaration:
! type(key_text_t), parameter :: dictionary(:)
! Number of Elements in the dictionary, exluding guards.
integer function d_elements() bind(C, name="d_elements")
use iso_c_binding, only: c_char
end function d_elements
! This function returns the positive key at position, if
! the position is valid, -1 otherwise.
integer function d_key(pos) bind(C, name="d_key")
use iso_c_binding, only: c_char
integer, intent(in) :: pos
end function d_key
! This function converts Unicode characters to UTF-8
! encoding, which are displayable in a Mac/Linux terminal.
function d_text(pos,word,strlen,max_chars) bind(C, name="d_text")
use iso_c_binding, only: c_char
integer, intent(in) :: pos
character(kind=c_char), intent(inout) :: word(*)
integer, intent(inout) :: strlen
integer, intent(in), optional :: max_chars
integer :: d_text
end function d_text
! This function converts Unicode characters to UTF-8
! encoding which are displayable in a Mac/Linux terminal.
! Yet, the array "bytes" contains the numeric values of them.
function d_bytes(pos,bytes,strlen,max_chars) bind(C, name="d_bytes")
use iso_c_binding, only: c_int
integer, intent(in) :: pos
integer(c_int), intent(inout) :: bytes(*)
integer, intent(inout) :: strlen
integer, intent(in), optional :: max_chars
integer :: d_bytes
end function d_bytes
! Searches this key in the dictionary and if found returns
! the position. Otherwise, it returns -1.
function d_pos(key) bind(C, name="d_pos")
use iso_c_binding, only: c_char
integer, intent(in) :: key
integer :: d_pos
end function d_pos
! Searches this key in the dictionary and if found returns
! the text in that position. Otherwise, it returns -1.
function d_search(key,word,strlen,max_chars) bind(C, name="d_search")
use iso_c_binding, only: c_char
integer, intent(in) :: key
character(kind=c_char), intent(inout) :: word(*)
integer, intent(inout) :: strlen
integer, intent(in), optional :: max_chars
integer :: d_search
end function d_search
! Sets the locale for non english text, mainly on Windows.
subroutine SetConsoleLocale() bind(C, name="SetConsoleLocale")
end subroutine SetConsoleLocale
end interface
end module
Raw
d_compile.c
/*
This C program compiles the texts defined in "dictionary.c" and
creates a Fortran module that contains a text buffer along with an
index, where all values and positions are precomputed.
A. Compile the Texts and as a first test display them.
-----------------------------------------------------------------------------
A.1 Create a Module with the compiled texts and a main program
gcc -DF_DRIVER dictionary.c d_compile.c -o d_compile && ./d_compile
OR
pgcc -DF_DRIVER dictionary.c d_compile.c -o d_compile && ./d_compile
OR
clang -DF_DRIVER dictionary.c d_compile.c -o d_compile && ./d_compile
A.2 Compile and run the Fortran program with the compiled texts.
gfortran d_compiled.f90 -o d_compiled && ./d_compiled
OR
pgfortran d_compiled.f90 -o d_compiled && ./d_compiled
B. Compile the Texts into a final Fortran Module (without a main program).
-----------------------------------------------------------------------------
B.1 Create the final Module with the compiled texts.
gcc dictionary.c d_compile.c -o d_compile && ./d_compile
OR
pgcc dictionary.c d_compile.c -o d_compile && ./d_compile
OR
clang dictionary.c d_compile.c -o d_compile && ./d_compile
OR
CL /DUTF_BOM dictionary_bom.c d_compile.c -o d_compile.exe
.\d_compile.exe
B.2 Confirm that this is a valid Fortran compilation unit.
-------------------------------------------------------------
gfortran -c d_compiled.f90 -o d_compiled.o
OR
pgfortran -c d_compiled.f90 -o d_compiled.o
-----------------------------------------------------------------------------
*/
#include <wchar.h>
#include <locale.h>
#include <stdio.h>
#include <string.h>
#define D_BUF_LEN 255
#define D_BUF_LEN_C (D_BUF_LEN+1)
extern int d_elements() ;
extern int d_key(int *pos);
extern int d_text(int *pos, char* string, int *len, int *max_chars);
extern int d_bytes(int *pos, int bytes[], int *len, int *max_chars);
extern int posofkey( int key ) ;
extern int d_pos(int *key) ;
extern int d_search(int *key, char* string, int *len, int *max_chars);
extern int d_wsearch(int *key, wchar_t* string, int *len);
extern void SetConsoleLocale() ;
int d_buffer_length() {
int rc=0,total=0, l_elements=d_elements() ;
int i=0,target=10,max_chars=0, _dlength,len ;
char string[D_BUF_LEN_C];
for ( i=1; i<= l_elements; i++ ) {
if ( d_text( &i,string,&len,&max_chars)>=0 )
total=total + len + 1 ;
else {
fprintf( stderr, "d_text(%d) returned negative length\n", i );
return -1;
}
}//
return total;
}
int _72=72;
char _6[7]=" ";
char _5[6]=" ";
int out_head(FILE *f, char *module){
fprintf( f, "\n" );
fprintf( f, "%s!Programmatically Compiled Texts for a static Fortran Dictionary \n", _6 );
fprintf( f, "\n" );
fprintf( f, "%smodule %s \n", _6 , module );
return 0;
}//
int out_compiled_elements(FILE *f){
fprintf( f, "\n" );
fprintf( f, "%sINTEGER, parameter :: compiled_elements = %d\n", _6, d_elements() );
return 0;
}//
int out_end(FILE *f, char *module){
fprintf( f, "\n" );
fprintf( f, "%send module %s \n", _6 , module );
fprintf( f, "\n" );
return 0;
}//
int out_d_buffer_head(FILE *f, char *access){
char string[D_BUF_LEN_C];
char comma=',';
int i=0, line_length=0, len = d_buffer_length() ;
if ( len < 0 )
return -1;
if (len==0)
comma=' ';
fprintf( f, "\n" );
if ( access && (
(strcmp(access,"private")==0) ||
(strcmp(access,"protected")==0) ||
(strcmp(access,"public")==0)
) )
line_length=sprintf( string, "%scharacter, %s, parameter :: d_buffer(0:%i) = char([0%c", _6, access, len, comma );
else
line_length=sprintf( string, "%scharacter, parameter :: d_buffer(0:%i) = char([0%c", _6 , len, comma );
fprintf( f, "%s" , string );
if ( line_length < 0 ) {
fprintf( stderr, "out_d_bufffer_head(), sprintf returned negative length\n" );
return -1;
}
for ( i=line_length; i < _72 ; i++)
fprintf( f, " " );
fprintf( f, "&\n" );
return 0;
}//
int out_key_text_t(FILE *f,char *outfile){
fprintf( f, "%s\n" , _6 );
fprintf( f, "%sTYPE :: key_text_t\n" , _6 );
fprintf( f, "%s\n" , _6 );
fprintf( f, "%s integer, private :: p_key=0\n" , _6 );
fprintf( f, "%s integer, private :: txt_begin=0, txt_end=0\n" , _6 );
fprintf( f, "%s\n" , _6 );
fprintf( f, "%s contains\n" , _6 );
fprintf( f, "%s\n" , _6 );
fprintf( f, "%s procedure, public :: key => key\n" , _6 );
fprintf( f, "%s procedure, public :: word => word\n" , _6 );
fprintf( f, "%s\n" , _6 );
fprintf( f, "%send type key_text_t\n" , _6 );
return 0;
}//
int out_d_index_head(FILE *f){
char string[D_BUF_LEN_C];
char comma=',';
int i=0, line_length=0, len = d_elements() ;
if ( len < 0 )
return -1;
if ( len == 0 )
comma=' ';
fprintf( f, "\n" );
line_length=sprintf( string, "%sINTEGER, parameter :: d_index( 3, 0:%d ) = RESHAPE ((/", _6 , len );
fprintf( f, "%s" , string );
if ( line_length < 0 ) {
fprintf( stderr, "out_d_bufffer_head(), sprintf returned negative length\n" );
return -1;
}
for ( i=line_length; i < _72 ; i++)
fprintf( f, " " );
fprintf( f, "&\n" );
//the guard
line_length=sprintf( string, "%s& 0,0,0%c", _5 , comma );
fprintf( f, "%s" , string );
for ( i=line_length; i < _72 ; i++)
fprintf( f, " " );
fprintf( f, "&\n" );
return 0;
}//
int out_d_buffer_lines(FILE *f){
int rc=0,total=0, l_elements=d_elements() ;
int i=0,j,k,w,target=10,max_chars=0, _dlength,len,line_length=0;
char comma, string[D_BUF_LEN_C], number[7], number_len, line[D_BUF_LEN_C], split[D_BUF_LEN_C];
int bytes[D_BUF_LEN_C];
for ( i=1; i<=l_elements ; i++ ) {
if ( d_text( &i,string,&len,&max_chars)>=0 ) {
total=total + len + 1 ;
fprintf( f, "%s!-----------------------------------------------------------------&\n" , _6);
fprintf( f, "%s! %s\n", _6, string );
//Copy the byte sequence, up to 72 columns per line
if ( d_bytes( &i,bytes,&len,&max_chars)>=0 ) {
line[0]='\0' ;
sprintf(line,"%s&",_5);
line_length= (int) strlen(line) ;
for ( j=0; j<=len; j++ ) {
//Last ',' should be removed
if (i==l_elements && j==len )
comma='\0' ;
else
comma=',' ;
if ( bytes[j] < 10 )
sprintf(number,"%1d%1c",bytes[j],comma);
else if ( bytes[j] < 100 )
sprintf(number,"%2d%1c",bytes[j],comma);
else if ( bytes[j] < 1000 )
sprintf(number,"%3d%1c",bytes[j],comma);
number_len=strlen(number);
//If we have to split the line now
if ( (line_length+number_len) > _72 ) {
fprintf( f, "%s" , line );
for ( w = line_length ; w < _72 ; w++)
fprintf( f, " " );
fprintf( f, "&\n" );
sprintf(line,"%s&",_5);
line_length= (int) strlen(line) ;
}//
line_length=line_length+number_len;
strcat(line,number);
}//for j
if ( line_length > 0 ) {
fprintf( f, "%s" , line );
for ( w = line_length ; w < _72 ; w++)
fprintf( f, " " );
fprintf( f, "&\n" );
}
}
else {
fprintf( stderr, "out_d_bufffer_lines(), d_bytes(%d) returned negative length\n", i );
return -1;
}
}
else {
fprintf( stderr, "out_d_bufffer_lines(), d_text(%d) returned negative length\n", i );
return -1;
}
}//
return total;
}//
int out_d_buffer_end(FILE *f){
fprintf( f, "%s&])\n", _5 );
return 0;
}//
int out_d_index_lines(FILE *f){
int rc=0,pos=1,end=1, l_elements=d_elements() ;
int i=0,j,k,w,target=10,max_chars=0, _dlength,len,line_length=0,key;
char comma, string[D_BUF_LEN_C], number[7], number_len, line[D_BUF_LEN_C], split[D_BUF_LEN_C];
int bytes[D_BUF_LEN_C];
for ( i=1; i<=l_elements ; i++ ) {
//Last ',' should be removed
if (i==l_elements)
comma='\0' ;
else
comma=',' ;
key=d_key(&i);
if ( d_text( &i,string,&len,&max_chars)>=0 ) {
fprintf( f, "%s!-----------------------------------------------------------------&\n" , _6);
fprintf( f, "%s! key: %5d, word: \"%s\"\n", _6, key, string );
sprintf(line,"%s& %d,%d,%d%c",_5,key,pos,pos+len-1,comma);
line_length= (int) strlen(line) ;
if ( line_length > 0 ) {
fprintf( f, "%s" , line );
for ( w = line_length ; w < _72 ; w++)
fprintf( f, " " );
fprintf( f, "&\n" );
}
pos=pos+len+1;
}
else {
fprintf( stderr, "out_d_index_lines(), d_text(%d) returned negative length\n", i );
return -1;
}
}//
return pos;
}//
int out_d_index_end(FILE *f){
fprintf( f, "%s&/), (/3, %d/))\n", _5, (int) d_elements() + 1 );
return 0;
}//
int out_d_buffer(FILE *f,char *outfile, char *access){
if ( out_d_buffer_head(f,access) < 0 ) {
fprintf( stderr, "Failed to write a buffer declaration: %s \n", outfile );
return -1;
}
if ( out_d_buffer_lines(f) < 0 ) {
fprintf( stderr, "Failed to write text lines in buffer declaration: %s \n", outfile );
return -1;
}
if ( out_d_buffer_end(f) < 0 ) {
fprintf( stderr, "Failed to write a buffer declaration: %s \n", outfile );
return -1;
}
return 0;
}//
int out_d_index(FILE *f,char *outfile){
if ( out_d_index_head(f) < 0 ) {
fprintf( stderr, "Failed to write an index declaration: %s \n", outfile );
return -1;
}
if ( out_d_index_lines(f) < 0 ) {
fprintf( stderr, "Failed to write positions in index declaration: %s \n", outfile );
return -1;
}
if ( out_d_index_end(f) < 0 ) {
fprintf( stderr, "Failed to write a buffer declaration: %s \n", outfile );
return -1;
}
return 0;
}//
int out_oo_dictionary_head(FILE *f, int with_guard){
char string[D_BUF_LEN_C];
char comma=',';
int i=0, line_length=0, len = d_elements() ;
if ( len < 0 )
return -1;
if ( len == 0 )
comma=' ';
fprintf( f, "\n" );
if ( with_guard > 0 )
line_length=sprintf( string, "%stype (key_text_t), public, parameter :: dictionary( 0:%d ) = [", _6 , len );
else
line_length=sprintf( string, "%stype (key_text_t), public, parameter :: dictionary( %d ) = [", _6 , len );
fprintf( f, "%s" , string );
if ( line_length < 0 ) {
fprintf( stderr, "out_oo_dictionary_head(), sprintf returned negative length\n" );
return -1;
}
for ( i=line_length; i < _72 ; i++)
fprintf( f, " " );
fprintf( f, "&\n" );
//the guard
if ( with_guard > 0 ) {
line_length=sprintf( string, "%s& key_text_t(0,0,0)%c", _5 , comma );
fprintf( f, "%s" , string );
for ( i=line_length; i < _72 ; i++)
fprintf( f, " " );
fprintf( f, "&\n" );
}
return 0;
}//
int out_oo_dictionary_lines(FILE *f){
int rc=0,pos=1,end=1, l_elements=d_elements() ;
int i=0,j,k,w,target=10,max_chars=0, _dlength,len,line_length=0,key;
char comma, string[D_BUF_LEN_C], number[7], number_len, line[D_BUF_LEN_C], split[D_BUF_LEN_C];
int bytes[D_BUF_LEN_C];
for ( i=1; i<=l_elements ; i++ ) {
//Last ',' should be removed
if (i==l_elements)
comma='\0' ;
else
comma=',' ;
key=d_key(&i);
if ( d_text( &i,string,&len,&max_chars)>=0 ) {
fprintf( f, "%s!-----------------------------------------------------------------&\n" , _6);
fprintf( f, "%s! key: %5d, word: \"%s\"\n", _6, key, string );
sprintf(line,"%s& key_text_t(%5d,%5d,%5d)%c",_5,key,pos,pos+len-1,comma);
line_length= (int) strlen(line) ;
if ( line_length > 0 ) {
fprintf( f, "%s" , line );
for ( w = line_length ; w < _72 ; w++)
fprintf( f, " " );
fprintf( f, "&\n" );
}
pos=pos+len+1;
}
else {
fprintf( stderr, "out_oo_dictionary_lines(), d_text(%d) returned negative length\n", i );
return -1;
}
}//
return pos;
}//
int out_oo_dictionary_end(FILE *f){
fprintf( f, "%s& ]\n", _5 );
return 0;
}//
int out_oo_dictionary(FILE *f,char *outfile,int with_guard){
if ( out_oo_dictionary_head(f,with_guard) < 0 ) {
fprintf( stderr, "Failed to write an oo dictionary declaration: %s \n", outfile );
return -1;
}
if ( out_oo_dictionary_lines(f) < 0 ) {
fprintf( stderr, "Failed to write positions in dictionary declaration: %s \n", outfile );
return -1;
}
if ( out_oo_dictionary_end(f) < 0 ) {
fprintf( stderr, "Failed to write a buffer declaration: %s \n", outfile );
return -1;
}
return 0;
}//
int out_oo_contains(FILE *f, char *module){
fprintf( f, "\n" );
fprintf( f, "%scontains\n", _6);
fprintf( f, "\n" );
fprintf( f, "%sfunction key(this)\n", _6);
fprintf( f, "%s implicit none\n\n", _6);
fprintf( f, "%s class(key_text_t), intent(in) :: this\n", _6);
fprintf( f, "%s integer key\n\n", _6);
fprintf( f, "%s key = this %c p_key\n\n", _6, '%' );
fprintf( f, "%send function\n", _6);
fprintf( f, "\n" );
fprintf( f, "%sfunction word(this) result(string)\n", _6);
fprintf( f, "%s implicit none\n", _6);
fprintf( f, "\n" );
fprintf( f, "%s class(key_text_t), intent(in) :: this\n", _6);
fprintf( f, "%s character(kind=1,len=:),allocatable:: string\n", _6);
fprintf( f, "\n" );
fprintf( f, "%s integer l_strlen, i\n", _6);
fprintf( f, "\n" );
fprintf( f, "%s !\n", _6);
fprintf( f, "%s ! Here I want to copy some characters from the\n", _6);
fprintf( f, "%s ! private buffer to the returned string but I\n", _6);
fprintf( f, "%s ! am not aware of a simple way (and it should\n", _6);
fprintf( f, "%s ! work also with gfortran-4.8.5).\n", _6);
fprintf( f, "%s !\n", _6);
fprintf( f, "%s l_strlen = this %c txt_end - this %c txt_begin + 1\n", _6,'%','%');
fprintf( f, "%s allocate( character(len=l_strlen) :: string )\n", _6);
fprintf( f, "%s do i=1,l_strlen\n", _6);
fprintf( f, "%s string(i:i) = d_buffer(this %c txt_begin+i - 1)\n", _6,'%');
fprintf( f, "%s end do\n", _6);
fprintf( f, "\n" );
fprintf( f, "%send function word\n", _6);
fprintf( f, "\n" );
return 0;
}//
int out_main_driver(FILE *f,char *module){
int i,l_elements=(int) d_elements();
#ifdef F_DRIVER
char qmark=' ';
#else
char qmark='!';
#endif
fprintf( f, "%c%sprogram main \n",qmark, _5 );
fprintf( f, "%c%suse %s \n",qmark, _5, module );
fprintf( f, "%c%sinteger :: i,j\n",qmark, _5 );
fprintf( f, "%c%s\n",qmark, _5 );
fprintf( f, "%c%sprint *, ''\n",qmark, _5 );
fprintf( f, "%c%sprint *, 'Sequential'\n",qmark, _5 );
fprintf( f, "%c%sprint *, '----------'\n",qmark, _5 );
fprintf( f, "%c%sdo i=1,compiled_elements\n",qmark, _5 );
fprintf( f, "%c%s print *,d_index(1,i),'->',d_buffer(d_index(2,i):d_index(3,i))\n",qmark,_5);
fprintf( f, "%c%send do\n",qmark, _5 );
fprintf( f, "%c%sprint *, '----------'\n",qmark, _5 );
fprintf( f, "%c%s\n",qmark, _5 );
fprintf( f, "%c%send\n",qmark, _5 );
return 0;
}//
int out_oo_main_driver(FILE *f, char *module,int with_guard){
int i,l_elements=(int) d_elements();
#ifdef F_DRIVER
char qmark=' ';
#else
char qmark='!';
#endif
fprintf( f, "%c%sprogram main \n",qmark, _5 );
fprintf( f, "%c%suse %s \n",qmark, _5, module );
fprintf( f, "%c%sinteger :: i,j\n",qmark, _5 );
fprintf( f, "%c%stype(key_text_t) t \n",qmark, _5 );
fprintf( f, "%c%s\n",qmark, _5 );
fprintf( f, "%c%sprint *, 'Sequential'\n",qmark, _5 );
fprintf( f, "%c%sprint *, '----------'\n",qmark, _5 );
if (with_guard>0)
fprintf( f, "%c%sdo i=1,size(dictionary)-1\n",qmark, _5 );
else
fprintf( f, "%c%sdo i=1,size(dictionary)\n",qmark, _5 );
fprintf( f, "%c%s t=dictionary(i) \n",qmark, _5 );
fprintf( f, "%c%s print *, t %c key() , \" -> \", t %c word()\n",qmark,_5,'%','%');
fprintf( f, "%c%send do\n",qmark, _5 );
fprintf( f, "%c%sprint *, '----------'\n",qmark, _5 );
fprintf( f, "%c%s\n",qmark, _5 );
fprintf( f, "%c%send\n",qmark, _5 );
return 0;
}//
int export_f1(char *outfile, char *module) {
FILE *f=fopen( outfile , "w" );
if ( f == NULL ) {
fprintf( stderr, "Failed to Open file: %s \n", outfile );
return -1;
}
#ifdef UTF_BOM
// To properly display this file in Wordpad, Notepad, e.t.c
fprintf( f,"\xef\xbb\xbf");
#endif
if ( out_head(f,module) < 0 ) {
fprintf( stderr, "Failed to write module header to file: %s \n", outfile );
return -1;
}
if ( out_d_buffer(f,outfile,"public") < 0 ) {
fprintf( stderr, "Failed to write dictionary buffer to file: %s, exiting! \n", outfile );
return -1;
}
if ( out_d_index(f,outfile) < 0 ) {
fprintf( stderr, "Failed to write dictionary index to file: %s, exiting! \n", outfile );
return -1;
}
if ( out_compiled_elements(f) < 0 ) {
fprintf( stderr, "Failed to write compiled elements to file: %s \n", outfile );
return -1;
}
if ( out_end(f, module) < 0 ) {
fprintf( stderr, "Failed to write module end statement to file: %s \n", outfile );
return -1;
}
if ( out_main_driver(f,module) < 0 ) {
fprintf( stderr, "Failed to write main driver to file: %s \n", outfile );
return -1;
}
return 0;
}//
int export_f2(char *outfile, char *module) {
#ifdef OO_GUARD
int with_guard=1;
#else
int with_guard=0;
#endif
FILE *f=fopen( outfile , "w" );
if ( f == NULL ) {
fprintf( stderr, "Failed to Open file: %s \n", outfile );
return -1;
}
#ifdef UTF_BOM
// To properly display this file in Wordpad, Notepad, e.t.c
fprintf( f,"\xef\xbb\xbf");
#endif
if ( out_head(f,module) < 0 ) {
fprintf( stderr, "Failed to write module header to file: %s \n", outfile );
return -1;
}
if ( out_d_buffer(f,outfile,"private") < 0 ) {
fprintf( stderr, "Failed to write dictionary buffer to file: %s, exiting! \n", outfile );
return -1;
}
if ( out_key_text_t(f,outfile) < 0 ) {
fprintf( stderr, "Failed to write dictionary index to file: %s, exiting! \n", outfile );
return -1;
}
if ( out_oo_dictionary(f,outfile,with_guard) < 0 ) {
fprintf( stderr, "Failed to write dictionary index to file: %s, exiting! \n", outfile );
return -1;
}
if ( with_guard > 0 )
if ( out_compiled_elements(f) < 0 ) {
fprintf( stderr, "Failed to write compiled elements to file: %s \n", outfile );
return -1;
}
if ( out_oo_contains(f, module) < 0 ) {
fprintf( stderr, "Failed to write module end statement to file: %s \n", outfile );
return -1;
}
if ( out_end(f, module) < 0 ) {
fprintf( stderr, "Failed to write module end statement to file: %s \n", outfile );
return -1;
}
if ( out_oo_main_driver(f,module,with_guard) < 0 ) {
fprintf( stderr, "Failed to write main driver to file: %s \n", outfile, module );
return -1;
}
return 0;
}//
int usage(char *program) {
fprintf( stderr, "Expected: -o <file-name>, ie: %s -o d_compiled.f90 \n" , program );
fprintf( stderr, " OR \n" );
fprintf( stderr, "Expected: -oo <file-name>, ie: %s -o d_οο_compiled.f90 \n" , program );
return -1;
}
int main(int argc, char **argv) {
char outfile1[32] = "d_compiled.f90" ; char module1[32] = "d_compiled";
char outfile2[32] = "d_οο_compiled.f90" ; char module2[32] = "d_οο_compiled";
int rc=0, l_rc=0, i;
int f1=1, f2=0;
//Parse arguments
if ( argc>1 ) {
f1=0;
f2=0;
for (i=1;i<argc;i++) {
if (argv[i] && ( strcmp(argv[i],"-o")==0 )) {
i++;
if ( i<argc ) {
if ( *(argv[i]) == '-' )
return usage(argv[0]) ;
}
else
return usage(argv[0]) ;
f1=1;
strncpy(outfile1,argv[i],31);
}//if
else if (argv[i] && ( strcmp(argv[i],"-oo")==0 )) {
i++;
if ( i<argc ) {
if ( *(argv[i]) == '-' )
return usage(argv[0]) ;
}
else
return usage(argv[0]) ;
f2=1;
strncpy(outfile2,argv[i],31);
}//if
else
return usage(argv[0]) ;
}//for
}//if
if ( f1 > 0 ) {
l_rc = export_f1(outfile1,module1) ;
if ( l_rc < 0 )
rc = l_rc;
}
if ( f2 > 0 ) {
l_rc = export_f2(outfile2,module2) ;
if ( l_rc < 0 )
rc = l_rc;
}
return rc;
}//
Raw
d_compiled.f90
!Programmatically Compiled Texts for a static Fortran Dictionary
module d_compiled
character, public, parameter :: d_buffer(0:198) = char([0, &
!-----------------------------------------------------------------&
! © Ev. Drikos <drikosev@gmail.com>
&194,169,32,69,118,46,32,68,114,105,107,111,115,32,60,100,114,105, &
&107,111,115,101,118,64,103,109,97,105,108,46,99,111,109,62,0, &
!-----------------------------------------------------------------&
! key-1
&107,101,121,45,49,0, &
!-----------------------------------------------------------------&
! key-2 longer
&107,101,121,45,50,32,108,111,110,103,101,114,0, &
!-----------------------------------------------------------------&
! key-3 even longer
&107,101,121,45,51,32,101,118,101,110,32,108,111,110,103,101,114,0,&
!-----------------------------------------------------------------&
! Dollar symbol: $ (Code U+0024, typed $)
&68,111,108,108,97,114,32,115,121,109,98,111,108,58,32,36,32,40,67,&
&111,100,101,32,85,43,48,48,50,52,44,32,116,121,112,101,100,32,36, &
&41,0, &
!-----------------------------------------------------------------&
! British Pound: £ (Code U+00A3, typed £)
&66,114,105,116,105,115,104,32,80,111,117,110,100,58,32,194,163,32,&
&40,67,111,100,101,32,85,43,48,48,65,51,44,32,116,121,112,101,100, &
&32,194,163,41,0, &
!-----------------------------------------------------------------&
! Euro: € (Code U+20AC, typed €)
&32,32,32,32,32,32,32,32,32,69,117,114,111,58,32,226,130,172,32,40,&
&67,111,100,101,32,85,43,50,48,65,67,44,32,116,121,112,101,100,32, &
&226,130,172,41,0 &
&])
INTEGER, parameter :: d_index( 3, 0:7 ) = RESHAPE ((/ &
& 0,0,0, &
!-----------------------------------------------------------------&
! key: 1, word: "© Ev. Drikos <drikosev@gmail.com>"
& 1,1,34, &
!-----------------------------------------------------------------&
! key: 5, word: "key-1"
& 5,36,40, &
!-----------------------------------------------------------------&
! key: 10, word: "key-2 longer"
& 10,42,53, &
!-----------------------------------------------------------------&
! key: 15, word: "key-3 even longer"
& 15,55,71, &
!-----------------------------------------------------------------&
! key: 20, word: "Dollar symbol: $ (Code U+0024, typed $)"
& 20,73,111, &
!-----------------------------------------------------------------&
! key: 25, word: "British Pound: £ (Code U+00A3, typed £)"
& 25,113,153, &
!-----------------------------------------------------------------&
! key: 30, word: " Euro: € (Code U+20AC, typed €)"
& 30,155,197 &
&/), (/3, 8/))
INTEGER, parameter :: compiled_elements = 7
end module d_compiled
! program main
! use d_compiled
! integer :: i,j
!
! print *, ''
! print *, 'Sequential'
! print *, '----------'
! do i=1,compiled_elements
! print *,d_index(1,i),'->',d_buffer(d_index(2,i):d_index(3,i))
! end do
! print *, '----------'
!
! end
Raw
dic2bom.c
/*
This program may be used in Windows for the conversion
of the file 'dictionary.c' to file 'dictionary_bom.c'
In Linux/MacOS/Cygwin one can simply type instead:
echo -n -e '\xef\xbb\xbf' > dictionary_bom.c
cat dictionary.c >> dictionary_bom.c
*/
// Unicode 16 LE BOM:
// 1st byte: ch=255, uch=FF
// 2nd byte: ch=254, uch=FE
//
// U+03C0 is π=3.14
// The two bytes are
// 1st byte: ch=192, uch=C0
// 2nd byte: ch=3, uch= 3
//
// UTF-8 BOM
// \xef\xbb\xbf
//
#include <wchar.h>
#include <locale.h>
#include <stdio.h>
#include <string.h>
#define BOMS_LENGTH 7
#define UTF7 1
#define UTF8 2
#define UTF16LE 3
#define UTF16BE 4
#define UTF32 5
struct bom_text_t {
int key ;
char *word ;
} ;
static const struct bom_text_t boms[BOMS_LENGTH] =
{
{ 0, "" } , //guard
{ 1, "UTF7"} ,
{ 2, "UTF8"} ,
{ 3, "UTF-16LE"} ,
{ 4, "UTF-16BE" },
{ 5, "UTF_32" },
{ 0, "" } , //guard
};
int getbom(char *infile) {
int ch,i=0,rc=0;
FILE *f=NULL;
unsigned char bom[4] ;
bom[0]=bom[1]=bom[2]=bom[3]=0;
f=fopen(infile, "r" );
if ( f==NULL) {
fprintf( stderr, "Failed to Open file %s \n" , infile );
return -1;
}//
while ( (i<4) && (ch=fgetc(f)) >=0 ) {
bom[i]=ch;
i++;
if ( i==2 ) {
if (bom[0] == 0xff && bom[1] == 0xfe) { rc = UTF16LE; break; } //UTF-16LE
if (bom[0] == 0xfe && bom[1] == 0xff) { rc = UTF16BE; break; } //UTF-16BE
}
if ( i==3 ) {
if (bom[0] == 0x2b && bom[1] == 0x2f && bom[2] == 0x76) { rc = UTF7; break; }
if (bom[0] == 0xef && bom[1] == 0xbb && bom[2] == 0xbf) { rc = UTF8; break; }
}
if ( i==4 ) {
if (bom[0] == 0 && bom[1] == 0 && bom[2] == 0xfe && bom[3] == 0xff) { rc = UTF32; break; }
}
}//if
if ( f != NULL )
fclose(f);
return rc;
}
int cp_with_bom(char *program, char *infile, char *outfile) {
FILE *fin=NULL, *fout=NULL;
unsigned char bom[3] ;
int rc=0, l_rc=0, prev=-1, ch=0, bom_id=getbom(infile);
if ( bom_id < 0 )
return bom_id;
else if (( bom_id > 0 ) && ( bom_id != UTF8 ) ){
fprintf( stderr, " %s error: file '%s' has BOM %s .\n" , program, infile, boms[bom_id].word );
return -1;
}//
else if (( bom_id > 0 ) && ( bom_id == UTF8 ) ){
fprintf( stderr, " %s warning: file '%s' has allready the desired BOM %s .\n" , program, infile, boms[bom_id].word );
}
//Open the Input/Output files.
fin=fopen(infile, "r" );
if ( fin==NULL) {
fprintf( stderr, "Failed to Open file %s \n" , infile );
return -1;
}//
fout=fopen(outfile, "w" );
if ( fout==NULL) {
fprintf( stderr, "Failed to Open file %s \n" , outfile );
if ( fin != NULL )
fclose(fin);
return -1;
}//
if ( bom_id == 0 ){
//Setup the New BOM Header
bom[0] = 0xef ; bom[1] = 0xbb ; bom[2] = 0xbf;
fputc(bom[0],fout);
fputc(bom[1],fout);
fputc(bom[2],fout);
}//
//Copy the File contents
while ( (ch=fgetc(fin)) >=0 ) {
#ifndef _WIN32
if ( ch=='\n' && prev != '\r' ) {
prev='\r';
l_rc=fputc( prev,fout);
if ( l_rc<0 ) {
rc=l_rc;
fprintf( stderr, " %s error: in writting file '%s' \n" , program, outfile );
break;
}//
}
prev=ch;
#endif
l_rc=fputc(ch,fout);
if ( l_rc<0 ) {
rc=l_rc;
fprintf( stderr, " %s error: in writting file '%s' \n" , program, outfile );
break;
}//
}//
//Close the files
if ( fin != NULL )
fclose(fin);
if ( fout != NULL )
fclose(fout);
return rc;
}//convert()
int usage(char *program) {
fprintf( stderr, "Expected: -o <file-name>, ie: %s -o dictionary_bom.c \n" , program );
fprintf( stderr, " OR \n" );
fprintf( stderr, "Expected: -o <file-name>, ie: %s dictionary.c -o dictionary_bom.c \n" , program );
fprintf( stderr, "where 'dictionary.c' should be a UTF-8 formatted file. \n" );
return -1;
}
int main(int argc, char **argv) {
char infile[255] = "dictionary.c" ;
char outfile[255] = "dictionary_bom.c" ;
int rc=0, l_rc=0, i;
int f1=1, f2=1;
//Parse arguments
if ( argc>1 ) {
f1=0;
f2=0;
for (i=1;i<argc;i++) {
if (( f2==0 ) && (argv[i] && ( strcmp(argv[i],"-o")==0 ))) {
i++;
if ( i<argc ) {
if ( *(argv[i]) == '-' )
return usage(argv[0]) ;
}
else
return usage(argv[0]) ;
f2=1;
strncpy(outfile,argv[i],254);
}//if
else if (( f1==0 ) && ( *(argv[i]) != '-' )) {
f1=1;
strncpy(infile,argv[i],254);
}//if
else
return usage(argv[0]) ;
}//for
}//if
//fprintf( stdout, "cmd: %s %s -o %s \n" , argv[0], infile, outfile );
return cp_with_bom(argv[0],infile, outfile);
}//
Raw
dictionary.c
#include <wchar.h>
#include <locale.h>
#include <stdio.h>
#define DICTIONARY_LENGTH 9
struct key_text_t {
int key ;
wchar_t *word ;
} ;
/*
We add sample values to the dictionary, including localized text,
which in turn might need special handling once saved as UTF-8.
One can use ie \x20AC for the Euro Currency Symbol '€', instead
of typing it directly. Otherwise, one might need to add a UTF-8
BOM header to port this program to Windows. But this requirement
mainly depends on the C compiler being used (cl accepts /utf-8).
The UTF-8 BOM header, if needed, is a sequence of: 0xEF,0xBB,0xBF
To insert manually such a BOM header in a separate file, type:
echo -n -e '\xef\xbb\xbf' > dictionary_bom.c
cat dictionary.c >> dictionary_bom.c
Read more at: https://en.wikipedia.org/wiki/Byte_order_mark#UTF-8
*/
static const struct key_text_t dictionary[DICTIONARY_LENGTH] =
{
{ 0, L"" } , //guard
{ 1, L"© Ev. Drikos <drikosev@gmail.com>"} ,
{ 5, L"key-1"} ,
{ 10, L"key-2 longer"} ,
{ 15, L"key-3 even longer" },
{ 20, L"Dollar symbol: \x0024 (Code U+0024, typed $)" },
{ 25, L"British Pound: \x00A3 (Code U+00A3, typed £)" },
{ 30, L" Euro: \x20AC (Code U+20AC, typed €)" },
{ 0, L"" } , //guard
};
//elements should be equal to: -2 + DICTIONARY_LENGTH .
static const int elements = -2 + sizeof(dictionary) / sizeof(struct key_text_t) ;
/* Some helper functions */
int length(const struct key_text_t *array) {
int i;
for ( i=1; array[i].key || *(array[i].word) != '\0' ; i++ ) ;
return (i-1) ;
}
#define D_BUF_LEN 255
#define D_BUF_LEN_C (D_BUF_LEN+1)
#define D_BUF_LEN_1 (D_BUF_LEN-1)
#define D_BUF_LEN_2 (D_BUF_LEN-2)
#define D_BUF_LEN_3 (D_BUF_LEN-3)
#define D_BUF_LEN_4 (D_BUF_LEN-4)
static const int BUF_LEN = D_BUF_LEN ;
static const int BUF_LEN_1 = D_BUF_LEN_1 ;
static const int BUF_LEN_2 = D_BUF_LEN_2 ;
static const int BUF_LEN_3 = D_BUF_LEN_3 ;
static const int BUF_LEN_4 = D_BUF_LEN_4 ;
/*
Fortran API
-----------
1. d_elements()
Number of Elements in the dictionary, exluding guards.
2. d_key(int *pos)
This function returns the positive key at position, if
the position is valid, -1 otherwise.
3. d_text(int *pos, char* string, int *len, int *max_chars)
This function converts Unicode characters to UTF-8
encoding, which are displayable in a Mac/Linux terminal.
4. d_bytes(int *pos, int* bytes, int *len, int *max_chars)
This function converts Unicode characters to UTF-8
encoding, which are displayable in a Mac/Linux terminal.
Yet, the array "bytes" contains the numeric values of them.
5. d_pos(int *key)
Searches this key in the dictionary and if found returns
the position. Otherwise, it returns -1.
6. d_search(int *key, char* string, int *len, int *max_chars)
Searches this key in the dictionary and if found returns
the text in that position. Otherwise, it returns -1.
7. void SetConsoleLocale()
Sets the locale for non english text, mainly on Windows.
*/
int d_elements() {
return elements;
}
int d_key(int *pos){
int i,j,characters ;
wchar_t* c=NULL;
wchar_t ch;
if ( *pos >= 0 && *pos <= elements ) {
return dictionary[*pos].key;
}
else
return -1;
}//d_key()
int d_text(int *pos, char* string, int *len, int *max_chars){
int i,j,characters ;
wchar_t* c=NULL;
wchar_t ch;
if ( *pos > 0 && *pos <= elements ) {
if ( max_chars && *max_chars )
characters=*max_chars;
else
characters=BUF_LEN_1;
c=dictionary[*pos].word;
if ( c == NULL )
return -1;
for ( i=0,j=0; i < characters ; i++, j++ ) {
ch= c[i] ;
if (( ch>=0 ) && (ch<=0x7f)) {
if ( j < BUF_LEN_1 ) {
string[j] = ch ;
if (c[i] == '\0' )
break;
}
else
break;
}
else if ( ch >= 0x80 && ch <= 0x7ff )
{
if ( j < BUF_LEN_2 ) {
string[j] = ( 0xc0 | (ch >> 6) );
j++;
string[j] = ( 0x80 | (ch & 0x3f) );
continue ;
}
else
break;
}
else if ( ch >= 0x800 && ch <= 0xffff ) {
if ( j < BUF_LEN_3 ) {
string[j] = ( 0xe0 | ( ch >> 12) );
j++;
string[j] = ( 0x80 | ((ch >> 6) & 0x3f) );
j++;
string[j] = ( 0x80 | ( ch & 0x3f) );
continue;
}
else
break;
}
else if ( 0x10000 <= ch && ch <= 0x1fffff )
{
if ( j < BUF_LEN_4 ) {
string[j] = ( 0xf0 | ( ch >> 18) );
j++;
string[j] = ( 0x80 | ((ch >> 12) & 0x3f) );
j++;
string[j] = ( 0x80 | ((ch >> 6) & 0x3f) );
j++;
string[j] = ( 0x80 | ( ch & 0x3f) );
continue ;
}
else
break;
}
#if defined( __PGI )
/* If UTF-8 strings are kept as UTF-8 sequences. */
else if ((ch & 0xe0)==0xc0) {
//UTF-8 (2 bytes)
if ( j < BUF_LEN_2 ) {
string[j] = ch ;
j++;
i++;
string[j] = ch = c[i] ;
characters+=1;
continue;
}
else
break;
}
else if ((ch & 0xf0)==0xe0) {
//UTF-8 (ie € is 3 bytes)
if ( j < BUF_LEN_3 ) {
string[j] = ch ;
j++;
i++;
string[j] = ch = c[i] ;
j++;
i++;
string[j] = ch = c[i] ;
characters+=2;
continue;
}
else
break;
}
else if ( ( ch & 0xF8) == 0xF0 ) {
//UTF-8 (4 bytes)
if ( j < BUF_LEN_4 ) {
string[j] = ch ;
j++;
i++;
string[j] = ch = c[i] ;
j++;
i++;
string[j] = ch = c[i] ;
j++;
i++;
string[j] = ch = c[i] ;
characters+=3;
continue;
}
else
break;
}
#endif
else {
if ( j < BUF_LEN_1 ) {
string[j] = '?' ;
if (c[i] == '\0' )
break;
}
else
break;
}
}//for
*len=j;
}//if ( pos >= 0 )
else {
*len=-1;
}
return *len;
}//d_text()
int d_bytes(int *pos, int bytes[], int *len, int *max_chars){
char string[D_BUF_LEN_C];
int i, chars ;
unsigned char uch;
chars = d_text( pos, string, len, max_chars);
if ( chars >= 0 ) {
for ( i=0; i < *len; i++) {
uch = string[i];
bytes[i]=uch;
}
if ( i < D_BUF_LEN_C) {
bytes[i]=0;
}
}//
else {
bytes[0] = 0;
}
return chars;
}//d_bytes()
/*
Binary Search for key -> word
*/
int posofkey( int key ) {
int first = 1 ;
int last = elements ;
int mid ;
int target;
while ( first <= last ) {
mid = first + ( last - first ) / 2 ;
target = dictionary[ mid ].key ;
if ( key < target )
last = mid -1 ;
else if ( key > target )
first = mid + 1;
else
return mid ;
}
return -1 ;
}//posOfKey(int)
int d_pos(int *key) {
return posofkey( *key );
}//d_pos()
int d_search(int *key, char* string, int *len, int *max_chars){
int pos = posofkey( *key );
if ( pos >= 0 ) {
return d_text(&pos, string, len, max_chars);
}
else
return -1;
}//d_search
/*
d_wsearch()
requires Fortran support for character(kind=4)
*/
int d_wsearch(int *key, wchar_t* string, int *len){
int pos = posofkey( *key );
if ( pos >= 0 ) {
//Unfortunatelly, here we copy the string
//value instead of assigning the pointer.
wcsncpy(string,dictionary[pos].word,BUF_LEN_1);
*len=(int) wcslen(string);
}
else {
*len=-1;
}
return *len;
}
void SetConsoleLocale() {
#if defined(_WIN32) && defined(_MSC_VER)
setlocale(LC_ALL,"en_US.UTF-8");
if ( ! SetConsoleOutputCP(65001) ) {
fprintf(stderr, "failed to set console cp 65001\n");
}
else {
//printf("set console cp 65001\n");
}
#elif defined ( __linux__ ) || defined( __CYGWIN__ )
setlocale(LC_ALL,"en_US.UTF-8");
#endif
}
#if defined( C_DRIVER )
/*
pgcc -DC_DRIVER dictionary.c && ./a.out
OR
gcc -DC_DRIVER dictionary.c && ./a.out
OR
clang -DC_DRIVER dictionary.c && ./a.out
OR with
CL /DC_DRIVER dictionary_bom.c -o a.exe
Notes:
1. In Windows 8.1 ie run a.exe in a blue PowerShell Console.
2. With MSVC we compile a file having a UTF-8 BOM header.
*/
int main() {
int i=0,j, target=10,max_chars=0, _dlength , prev=-1 ;
int bytes[1024];
char string[D_BUF_LEN_C];
wchar_t wstring[D_BUF_LEN_C];
int key,len;
SetConsoleLocale();
printf("\n");
printf( " Size of integer: %ld \n", (long) sizeof(int) );
printf( "Size of key_text_t: %ld \n", (long) sizeof(struct key_text_t) );
printf( "Size of dictionary: %ld \n", (long) sizeof(dictionary) );
printf( "Number of elements: %ld \n", (long) elements );
_dlength = length(dictionary) ;
printf( "Function length() : %d \n", _dlength );
if ( ( ( elements + 2 ) != DICTIONARY_LENGTH ) ||
( ( elements ) != _dlength ) ){
fprintf( stderr, "Wrong Number of elements: %ld \n", (long) elements );
return -1;
}
printf("\n");
string[BUF_LEN] = '\0' ;
// Verify a guard at position 0
if ( dictionary[0].key != 0 ) {
fprintf( stderr, "A guard with key = 0 expected at pos = 0, found %d .\n", dictionary[0].key );
return -1;
}//
// Verify ascending order
for ( i=0; i<=elements ; i++ ) {
key = dictionary[i].key ;
if ( prev >= key ) {
if ( prev == key )
fprintf( stderr, "Duplicate Keys aren't allowed in this dictionary:\n");
else
fprintf( stderr, "Unsorted Keys aren't allowed in this dictionary:\n");
i--;
if ( d_text( &i,string,&len,&max_chars)>=0 )
fprintf( stderr, "dictionary[%2d]={%3d, %s}\n", i, prev , string );
else
fprintf( stderr, "dictionary[%2d]={%3d, NULL}\n", i, prev );
i++;
if ( d_text( &i,string,&len,&max_chars)>=0 )
fprintf( stderr, "dictionary[%2d]={%3d, %s}\n", i, key , string );
else
fprintf( stderr, "dictionary[%2d]={%3d, NULL}\n", i, key );
return -1;
}//if ( prev >= key )
prev=key;
}//
for ( i=0; i<=elements ; i++ ) {
key = dictionary[i].key ;
if ( d_text( &i,string,&len,&max_chars)>=0 )
printf( "dictionary[%2d]={%3d, %s}\n", i, key , string );
else
printf( "dictionary[%2d]={%3d, NULL}\n", i, key );
if ( d_search( &key,string,&len,&max_chars)>=0 )
printf( "dictionary[%2d]={%3d, %s}\n", i, d_key(&i) , string );
else
printf( "dictionary[%2d]={%3d, NULL}\n", i, d_key(&i) );
}
for ( i=d_elements(); i<=d_elements() ; i++ ) {
if ( d_bytes( &i, bytes, &len, &max_chars) >= 0 ) {
for ( j=0; j<=len; j++ ) {
printf( "%d, ", bytes[j] );
}//for j
printf("\n");
}//
}//for
//dictionary[1].key=22;
//The above assignment would give the error:
//dictionary.c:491:7: error: assignment of member 'key' in read-only object
printf("\n finished. \n");
return 0;
}
#endif
Raw
Dictionary.txt
This Fortran/C interoperability example implements a static dictionary
containing <numeric key, unicode text> pairs, which are defined in file
"dictionary.c" and a Fortran program ie can print them in a terminal.
To build the project in a Linux, MacOS, or Cygwin terminal you can use
the Makefile. If you have GNU Fortran installed, then just type "make".
In Windows 8.1 ie run dictionary.exe in a blue PowerShell Console.
Raw
f_dictionary.f90
!Fortran Static Dictionary that uses Compiled Texts
module c_dictionary
use iso_c_binding, only: C_CHAR, C_NULL_CHAR
use d_compiled
! The desired, but unsupported, structure of the key-value dictionary:
! TYPE, BIND(C) :: key_text_t
! integer :: key=0
! character(:), allocatable :: word
! end type key_text_t
!
! The desired, but unsupported, Dictionary Table declaration:
! type(key_text_t), parameter :: dictionary(:)
contains
! Number of Elements in the dictionary, exluding guards.
integer function d_elements() bind(C, name="d_elements")
use iso_c_binding, only: c_char
d_elements=compiled_elements
end function d_elements
! This function returns the positive key at position, if
! the position is valid, -1 otherwise.
integer function d_key(pos) bind(C, name="d_key")
use iso_c_binding, only: c_char
integer, intent(in) :: pos
if ( pos > 0 .and. pos <= d_elements() ) then
d_key = d_index(1,pos)
else
d_key = -1
end if
end function d_key
! Returns the length of the utf-8 sequence that begins at character.
!
! Note: I've found the limits (ie Z'E0') used in this function in
! another Fortran program and my assumption here is that these
! limits are equivalent to the ones used in file "dictionary.c"
! which is also restricted to UTF-8 up to 4 bytes.
!
function ulen(ch)
use iso_c_binding, only: c_char
implicit none
character(kind=c_char), intent(in) ::ch
integer :: ulen, ich
ulen=0
ich = ichar(ch)
if ( ich < int(Z'80') ) THEN
ulen=1
else if ( (ich > ( int(Z'C0') + 1)) .and. ( ich < int(Z'E0') )) THEN
ulen=2
else if ( ich < int(Z'F0') ) THEN
ulen=3
else if ( ich <= int(Z'F4') ) THEN
ulen=4
else
ulen=1 !assume we process larger sequqences, 1 by 1 bytes
end if
end function
! This function converts Unicode characters to UTF-8
! encoding, which are displayable in a Mac/Linux terminal.
function d_text(pos,word,strlen,max_chars) bind(C, name="d_text")
use iso_c_binding, only: c_char
implicit none
integer, intent(in) :: pos
character(kind=c_char), intent(inout) :: word(*)
integer, intent(inout) :: strlen
integer, intent(in), optional :: max_chars
integer :: d_text
integer i,j, l_max_chars
if ( pos > 0 .and. pos <= d_elements() ) then
if( present(max_chars)) then
l_max_chars=max_chars
else
l_max_chars=0;
end if
strlen = d_index(3,pos) - d_index(2,pos) + 1
if ( l_max_chars > 0 .and. l_max_chars < strlen ) then
! compute how many chars to return.
j=0
do, i=1, l_max_chars
j=j+ulen( d_buffer( d_index(2,pos)+j ) )
end do
strlen=j
end if
word(1:strlen) = d_buffer(d_index(2,pos):d_index(2,pos)+strlen-1)
word(strlen+1:strlen+1) = d_buffer(0:0)
strlen = strlen
d_text = strlen
else
word(1:1) = d_buffer(0:0)
strlen = -1
d_text = -1
end if
! d_buffer(d_index(2,i):d_index(3,i))
end function d_text
! This function converts Unicode characters to UTF-8
! encoding which are displayable in a Mac/Linux terminal.
! Yet, the array "bytes" contains the numeric values of them.
function d_bytes(pos,bytes,strlen,max_chars) bind(C, name="d_bytes")
use iso_c_binding, only: c_int
integer, intent(in) :: pos
integer(c_int), intent(inout) :: bytes(*)
integer, intent(inout) :: strlen
integer, intent(in), optional :: max_chars
integer :: d_bytes
integer i,j, l_max_chars
!well, this was required to compile the texts.
if ( pos > 0 .and. pos <= d_elements() ) then
if( present(max_chars)) then
l_max_chars=max_chars
else
l_max_chars=0;
end if
strlen = d_index(3,pos) - d_index(2,pos) + 1
if ( l_max_chars > 0 .and. l_max_chars < strlen ) then
! compute how many chars to return.
j=0
do, i=1, l_max_chars
j=j+ulen( d_buffer( d_index(2,pos)+j ) )
end do
strlen=j
end if
do, i=1,strlen
bytes(i) = ichar(d_buffer(d_index(2,pos)+i-1))
end do
bytes(strlen+1:strlen+1) = 0
d_bytes = strlen
else
bytes(1:1) = 0
strlen = -1
d_bytes = -1
end if
end function d_bytes
! Searches this key in the dictionary and if found returns
! the position. Otherwise, it returns -1.
function d_pos(key) bind(C, name="d_pos")
use iso_c_binding, only: c_char, c_int
implicit none
integer, intent(in) :: key
integer :: d_pos
integer first
integer last
integer(c_int) mid
integer(c_int) target
first = 1 ;
last = d_elements()
d_pos = -1
do, while ( first <= last )
mid = first + ( last - first ) / 2 ;
target = d_index(1,mid)
if ( key < target ) then
last = mid -1 ;
else if ( key > target ) then
first = mid + 1;
else
d_pos = mid
return
end if
end do
end function d_pos
! Searches this key in the dictionary and if found returns
! the text in that position. Otherwise, it returns -1.
function d_search(key,word,strlen,max_chars) bind(C, name="d_search")
use iso_c_binding, only: c_char
implicit none
integer, intent(in) :: key
character(kind=c_char), intent(inout) :: word(*)
integer, intent(inout) :: strlen
integer, intent(in), optional :: max_chars
integer :: d_search
integer :: pos
pos = d_pos( key );
if ( pos >= 0 ) then
d_search = d_text(pos, word, strlen, max_chars);
else
d_search = -1
end if
end function d_search
! Sets the locale for non english text, mainly on Windows.
subroutine SetConsoleLocale() bind(C, name="SetConsoleLocale")
use iso_fortran_env
implicit none
open(output_unit,encoding='utf-8')
end subroutine SetConsoleLocale
end module
Raw
f_driver.f90
! gfortran dictionary.c c_dictionary.f90 f_driver.f90 -o dictionary
! OR
!pgfortran dictionary.c c_dictionary.f90 f_driver.f90 -o dictionary
! In alternative one can use the compiled texts (see d_compile.c).
!
! gfortran d_compiled.f90 f_dictionary.f90 f_driver.f90 -o dictionary
! OR
!pgfortran d_compiled.f90 f_dictionary.f90 f_driver.f90 -o dictionary
program f_driver
use iso_c_binding
use c_dictionary
implicit none
integer :: keys(8) = [ 1, 5, 10, 15, 20, 25, 30, 35 ]
integer i,pos,strlen
character(kind=c_char) :: string(255)
integer(c_int) :: bytes(255)
! Set the locale for non english text, mainly on Windows.
call SetConsoleLocale()
! Iterate on the Dictionary Keys, with O(1) functions
print *, "Sequential"
print *, "----------"
do i=1,d_elements()
if ( d_text( i ,string,strlen,max_chars=63) >= 0 ) then
print *, d_key(i), " -> ", string(1:strlen)
else
print *, d_key(i), " -> ", "NULL"
end if
end do
! Search by key a few values, with a N*Log(N) function.
print *, ""
print *, "Binary Search"
print *, "-------------"
do i=1,size(keys)
if ( d_search(keys(i),string,strlen,max_chars=63) >= 0 ) then
print *, keys(i), " -> ", string(1:strlen)
else
print *, keys(i), " -> ", "NULL"
end if
end do
print *, ""
print *, "Bytes of the first two Entries (only for 3 chars, including a tail byte)"
print *, "------------------------------------------------------------------------"
do i=1,2
if ( d_text( i ,string,strlen,max_chars=3) >= 0 ) then
if ( d_bytes( i ,bytes,strlen,max_chars=3) >= 0 ) then
print *, d_key(i), " -> ", string(1:strlen), ' [',bytes(1:strlen+1),']'
end if
else
print *, d_key(d_elements()), " -> ", "NULL"
end if
end do
end program f_driver
Raw
Makefile
# Be aware of the tab characters (the recipes require them).
SHELL=/bin/bash
FFLAGS=-g -O2
CFLAGS=-g -O2 -DUTF_BOM
LFLAGS=
FC=pgfortran
CC=pgcc
PGILIBS=-lpgf90 -lpgf902 -lpgf90_rpm1
FC=gfortran
CC=gcc
GNULIBS=-lgfortran
PGILINKER=pgcc
LIBS=
all: new_line tmp.exe tmp.out.txt dictionary dictionary_bom.c \
d_compile d_compiled.f90 d_compiled.o dictionary2f \
diff.out.txt
@echo "All Done (you may also try: make diff2.out.txt)."
@echo ""
diff.out.txt: dictionary dictionary2f
@echo 'Comparing the output of "dictionary" vs "dictionary2f"...'
./dictionary > dc.out.txt
./dictionary2f > df.out.txt
diff -u dc.out.txt df.out.txt > diff.out.txt.part
mv diff.out.txt.part diff.out.txt
@echo "The comparison was successful!"
@echo ""
dictionary2f: d_compiled.f90 f_dictionary.f90 f_driver.f90
@echo "Creating a pure Fortran dictionary driver..."
${FC} ${FFLAGS} ${LFLAGS} d_compiled.f90 f_dictionary.f90 f_driver.f90 -o dictionary2f
@echo ""
dictionary: dictionary.c c_dictionary.f90 f_driver.f90
@echo "Creating a dictionary driver that uses Fortran/C interoperability..."
${FC} ${FFLAGS} ${LFLAGS} dictionary.c c_dictionary.f90 f_driver.f90 -o dictionary
@echo ""
scripted_dictionary_bom.c: dictionary.c
@echo "Creating a C dictionary source file with a BOM header..."
echo -n -e '\xef\xbb\xbf' > dictionary_bom.c
cat dictionary.c >> dictionary_bom.c
@echo ""
dictionary_bom.c: dictionary.c dic2bom.exe
@echo "Creating a C dictionary source file with a BOM header..."
./dic2bom.exe dictionary.c -o dictionary_bom.c
@echo ""
dic2bom.exe: dic2bom.c
@echo "Compiling a cross platform BOM converter..."
${CC} ${CFLAGS} -DC_DRIVER dic2bom.c -o dic2bom.exe
@echo ""
d_compiled.o: d_compiled.f90 d_compile
@echo "Checking whether the module of compiled texts is a valid Fortran unit..."
${FC} ${FFLAGS} -c d_compiled.f90 -o d_compiled.o
@echo ""
d_compiled.f90: d_compile dictionary.c d_compile.c
@echo "Compiling the texts for a pure Fortran dictionary..."
./d_compile
@echo ""
d_compile: dictionary.c d_compile.c
@echo "Creating a texts compiler..."
${CC} ${CFLAGS} ${LFLAGS} dictionary.c d_compile.c -o d_compile
@echo ""
tmp.out.txt: dictionary.c tmp.exe
@echo "Validating the C dictionary..."
./tmp.exe > tmp.out.txt.part
mv tmp.out.txt.part tmp.out.txt
@echo ""
tmp.exe: dictionary.c
@echo "Compiling the C dictionary..."
${CC} ${CFLAGS} -DC_DRIVER dictionary.c -o tmp.exe
@echo ""
.Phony:new_line
new_line:
@echo ""
diff2.out.txt: d_compile d_recompile.exe f_dictionary.f90
@echo "Checking if the Fortran dictionary with the compiled texts is functional when called by a C program..."
./d_recompile.exe -o d_recompiled.f90
./d_compile -o d_compiled.f90
@echo ""
@echo 'Comparing the output of the two text compilers, "d_compile" vs "d_recompile.exe"...'
diff -u d_compiled.f90 d_recompiled.f90 > diff2.out.txt.part
mv diff2.out.txt.part diff2.out.txt
@echo "The comparison was successful!"
@echo ""
d_recompile.exe: d_compiled.f90 f_dictionary.f90 d_compile.c
@if [ "${FC}" = "pgfortran" ]; then \
echo "Creating another texts compiler, by utilising the compiled texts..." ; \
echo ${CC} ${CFLAGS} -c d_compile.c ; \
${CC} ${CFLAGS} -c d_compile.c ; \
echo ${FC} ${FFLAGS} -c d_compiled.f90 f_dictionary.f90 ; \
${FC} ${FFLAGS} -c d_compiled.f90 f_dictionary.f90 ; \
echo ${PGILINKER} ${LFLAGS} ${LIBS} ${PGILIBS} d_compile.o d_compiled.o f_dictionary.o -o d_recompile.exe ; \
${PGILINKER} ${LFLAGS} ${LIBS} ${PGILIBS} d_compile.o d_compiled.o f_dictionary.o -o d_recompile.exe ; \
echo "" ;\
elif [ "${FC}" = "gfortran" ]; then \
echo "Creating another texts compiler, by utilising the compiled texts..." ; \
echo ${FC} ${FFLAGS} ${LFLAGS} ${LIBS} ${GNULIBS} d_compiled.f90 f_dictionary.f90 ${CFLAGS} d_compile.c -o d_recompile.exe ;\
${FC} ${FFLAGS} ${LFLAGS} ${LIBS} ${GNULIBS} d_compiled.f90 f_dictionary.f90 ${CFLAGS} d_compile.c -o d_recompile.exe ;\
echo "" ;\
else \
echo "Creating another texts compiler, by utilising the compiled texts..." ; \
echo ${FC} ${FFLAGS} ${LFLAGS} ${LIBS} d_compiled.f90 f_dictionary.f90 ${CFLAGS} d_compile.c -o d_recompile.exe ;\
${FC} ${FFLAGS} ${LFLAGS} ${LIBS} d_compiled.f90 f_dictionary.f90 ${CFLAGS} d_compile.c -o d_recompile.exe ;\
echo "" ;\
fi
clean:
rm -rf ../*.mod ../*.o *.mod *.o *.dSYM dictionary d_compile dic2bom.exe a.out *.obj
rm -rf a.exe compile.exe dictionary.exe tmp.exe dictionary2f dictionary2f.exe d_recompile.exe
rm -rf *.out.txt *.out.txt.part d_recompiled.f90
Raw
Makefile.mak
# Be aware of the tab characters (the recipes require them).
#
# To use this file in Windows, you need the command line tools
# of MSVC, type:
#
# nmake -f Makefile.mak all
#
#
LIBTOOL=CL
LDFLAGS=/Gd /link
CC=cl
CDEBUG=
CFLAGS=/utf-8 $(CDEBUG)
CPPFLAGS=/DUTF_BOM
all: tmp.exe d_compile.exe d_compiled.f90
@echo -----------------------------------------------
@echo The C part of the solution seems to be portable!
d_compiled.f90:
.\d_compile.exe
tmp.exe: dictionary_bom.c
@echo @$(CC) $(CFLAGS) /DC_DRIVER dictionary_bom.c /Fe tmp.exe
@$(CC) $(CFLAGS) /DC_DRIVER dictionary_bom.c
@del dictionary_bom.obj 2>NUL
@copy dictionary_bom.exe tmp.exe
@del dictionary_bom.exe 2>NUL
d_compile.exe: dictionary_bom.obj d_compile.obj
$(LIBTOOL) dictionary_bom.obj d_compile.obj /Fed_compile.exe $(LDFLAGS)
d_compile.obj:
$(CC) $(CPPFLAGS) $(CFLAGS) /c d_compile.c
dictionary_bom.obj: dictionary_bom.c
$(CC) $(CPPFLAGS) $(CFLAGS) /c dictionary_bom.c
dictionary_bom.c: dictionary.c dic2bom.exe
@echo Creating a C dictionary source file with a BOM header...
.\dic2bom.exe dictionary.c -o dictionary_bom.c
dic2bom.exe: dic2bom.c
@echo Compiling a cross platform BOM converter...
$(CC) $(CPPFLAGS) $(CFLAGS) /c dic2bom.c
$(LIBTOOL) dic2bom.obj /Fedic2bom.exe
clean:
@del ..\*.mod ..\*.o *.mod *.o *.dSYM dictionary d_compile a.out dic2bom.exe 2>NUL
@del a.exe compile.exe dictionary.exe tmp.exe dictionary2f dictionary2f.exe d_recompile.exe 2>NUL
@del *.out.txt *.out.txt.part d_recompiled.f90 2>NUL
@del *.obj 2>NUL
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment