[clean-list] htoclean sorrows

[John van Groningen]

Juraj Hercek wrote:
>...
> Emboldened by this I attempted to link in
>daxpy from 3 different BLAS libraries,  libacm_dll.dll,  an MS VC generated
>library,  libacml.dll,  a pgi compiled library and XP_P4.dll, and an ATLAS
>library compiled by gcc.  All libraries are 32 bit windows compatible DLLs
>and have been verified outside of clean.  All libraries show a daxpy symbol
>using dumpbin /exports.
>
>Under Projects->Options->Dynamic Libraries I've set it to XP_P4.dll and
>under Projects->Options->Linker I've set the DLL symbol resource to
>acml_library, which currently reads
>
>XP_P4.dll
>cblas_daxpy at 28
>
>
>My source compiles just fine and reads as
>module matrix
>import StdEnv
>import StdList
>import StdArray
>
>:: *State :== Int;
>
>cblas_daxpy :: !Int !Real !{Real}  Int !{#Real} !Int !State-> State ;
>cblas_daxpy a0 a1 a2 a3 a4 a5 a6 = code {
>	ccall cblas_daxpy "IRAIAI:V:I"
>}
>
>x :: {Real}
>x = {0.5, -0.5, 1.0, -1.0}
>
>// unboxed array IO, uniqueness
>
>y :: *{#Real}
>y = {0.0}
>
>st0 :: State
>st0 = 0
>
>Start :: (*{#Real}, State)
>Start
># y = {1.0, 2.0, 3.0, 4.0}
>#! st0 = cblas_daxpy 4 -2.0 x 1 y 1 st0
>= (y, st0)
>
>But when I attempt to bring it up to date the linker says undefined symbols
>cblas_daxpy

Yes, because the name of the function in the .dll is cblas_daxpy at 28,
not cblas_daxp. In the ccall you should use cblas_daxpy at 28, and because
this is not a normal C call, but a stdcall, you should add a P at the
start of the string after ccall, so:

	ccall cblas_daxpy at 28 "PIRAIAI:V:I"

>The same thing happens for libacml_dll.dll (undefined daxpy),  but for the
>pgi library (which would be the best choice since it's multi-threaded and I
>have a dual core processor) the code links 'without error', ie no error
>messages ; but fails to produce an executable!

I don't know why this happens.

>For these other options I
>change the .dll file names, strip the cblas_ prefix and change the symbols
>files.
>
>I haven't yet tried to install the .dll's in the clean system file, but is
>the linking procedure different in this case?

No

>Is there a way to use, say
>microsofts linker to make the executable?

Yes, the object files can be linked with the microsoft linker:

- link _startup.o, _startup1.o, _startup2.o and _system.obj before all
  other object files. Your program will probably crash if you don't.
- use /release, otherwise the linker inserts extra zeros that cause crashes.
- the executables will be larger, because the linker does not
  remove unused code.

When I started developing the 64 bit version of Clean I wrote a small
C program (see below) that converts most of the arguments for the Clean
linker to a call to the Microsoft linker. To use it, compile it with
visual c, copy the executable to the Tools/Clean System folder, and change
the Static Linker file name in the Environment to this executable.
Before starting the Clean IDE, initialise the environment variables
for the linker (run vcvars32.bat) from the DOS command prompt, then
start the Clean IDE from the command line.

Kind regards,

John van Groningen


/* call_ms_linker.c : */

#include <windows.h>

#include <stdio.h>

struct line {
	struct line *next;
	char chars[0];
};

static char *string_copy (char *d,char *s)
{
	char c;
	
	while (c=*s++,c!='\0')
		*d++=c;
	*d=c;
	return d;
}

int skip_to_next_line (int c,FILE *input_file)
{
	while (c!='\n' && c!='\r' && c!=EOF)
		c=getc (input_file);
	if (c!=EOF)
		c=getc (input_file);

	return c;
}

void main (int argc,char *argv[])
{
	char *command_line,*command_line_p,*command_line_begin;
	char *input_file_name,*output_file_name;
	FILE *input_file,*error_file;
	static char application_name[257];
	int application_name_i;
	struct line *first_line,**next_line_p;
	int n,c,n_lines,n_chars_in_lines,n_arg_chars;

	input_file_name=NULL;
	output_file_name=NULL;

	if (argc>=5){
		if (!strcmp (argv[argc-4],"-I"))
			input_file_name=argv[argc-3];
		else if (!strcmp (argv[argc-2],"-I"))
			input_file_name=argv[argc-1];

		if (!strcmp (argv[argc-4],"-O"))
			output_file_name=argv[argc-3];
		else if (!strcmp (argv[argc-2],"-O"))
			output_file_name=argv[argc-1];
	}

	if (input_file_name==NULL)
		printf ("-I input_file_name missing\n");
	if (output_file_name==NULL)
		printf ("-I output_file_name missing\n");

	if (input_file_name==NULL || output_file_name==NULL)
		return;

	{
	int arg_i;
	
	n_arg_chars=0;
	for (arg_i=1; arg_i<argc-4; ++arg_i)
		n_arg_chars+=strlen (argv[arg_i]);
	}

	input_file=fopen (input_file_name,"r");
	if (input_file==NULL){
		printf ("Couldn't open %s\n",input_file_name);
		return;
	}

	error_file=fopen (output_file_name,"w");
	if (input_file==NULL){
		printf ("Couldn't create %s\n",output_file_name);
		return;
	}

	n_lines=0;
	n_chars_in_lines=0;
	next_line_p=&first_line;

	c=getc (input_file);

	while (c!=EOF){
		int i;
		
		i=0;
		while (c=="ExePath:"[i] && c!='\0'){
			c=getc (input_file);
			++i;
		}
		if (i==sizeof ("ExePath:")-1){
			c=getc (input_file);
			break;
		}

		c=skip_to_next_line (c,input_file);
	}

	if (c==EOF){
		fprintf (error_file,"ExePath: not found in input file\n");
		fclose (error_file);
		return;
	}

	application_name_i=0;
	while (c!='\n' && c!='\r' && c!=EOF){
		if (application_name_i==256){
			fprintf (error_file,"application name too long");
			fclose (error_file);
			return;
		}
		application_name[application_name_i++]=c;
		c=getc (input_file);
	}

	application_name[application_name_i]='\0';

	while (c!=EOF){
		int i;
		
		i=0;
		while (c=="ObjectPaths"[i] && c!='\0'){
			c=getc (input_file);
			++i;
		}
		if (i==sizeof ("ObjectPaths")-1){
			c=getc (input_file);
			break;
		}

		c=skip_to_next_line (c,input_file);
	}

	while (c!=EOF){
		static char line[257];
		int i,line_i;
		
		i=0;
		while (c=="\tPath:\t"[i] && c!='\0'){
			c=getc (input_file);
			++i;
		}
		if (i!=sizeof ("\tPath:\t")-1)
			break;

		line_i=0;
		while (c!='\n' && c!='\r' && c!=EOF){
			if (line_i==256){
				fprintf (error_file,"file name too long");
				fclose (error_file);
				return;
			}
			line[line_i++]=c;
			c=getc (input_file);
		}
		line[line_i]='\0';
		if (line_i>0){
			struct line *next_line;
			
			next_line=malloc (sizeof (struct line)+line_i+1);
			if (next_line==NULL){
				fprintf (error_file,"not enough memory");
				fclose (error_file);
				return;			
			}
			
			strcpy (next_line->chars,line);
			
			++n_lines;
			n_chars_in_lines+=line_i;
			*next_line_p=next_line;
			next_line_p=&next_line->next;
		}
		if (c!=EOF){
			c=getc (input_file);
		}
	}

	*next_line_p=NULL;

	fclose (input_file);

#if 1
	command_line_begin = "link.exe /nologo /release /entry:mainCRTStartup /subsystem:console"
						 " kernel32.lib";
#else
	command_line_begin = "link.exe /nologo /release /debug /machine:AMD64";
#endif

	command_line=malloc (strlen (command_line_begin)+8+n_arg_chars+(argc-5)+application_name_i+2+n_lines*3+n_chars_in_lines+1);
	
	command_line_p=command_line;
	command_line_p=string_copy (command_line_p,command_line_begin);

	{
	int arg_i;
	
	for (arg_i=1; arg_i<argc-4; ++arg_i){
		*command_line_p++=' ';
		command_line_p=string_copy (command_line_p,argv[arg_i]);
	}
	}

	command_line_p=string_copy (command_line_p," \"/out:");

	command_line_p=string_copy (command_line_p,application_name);
	*command_line_p++='\"';
	*command_line_p++=' ';

	{
		struct line *line_p;
		
		for (line_p=first_line; line_p!=NULL; line_p=line_p->next){
			*command_line_p++=' ';
			*command_line_p++='\"';
			command_line_p=string_copy (command_line_p,line_p->chars);
			*command_line_p++='\"';
		}

		*command_line_p='\0';
	}

	fclose (error_file);

	{
	STARTUPINFO si;
	PROCESS_INFORMATION pi;
	SECURITY_ATTRIBUTES sa;

	sa.nLength = sizeof (SECURITY_ATTRIBUTES);
	sa.bInheritHandle = TRUE;
	sa.lpSecurityDescriptor = NULL;

	ZeroMemory (&si,sizeof(si));
	si.cb = sizeof(si);
	si.hStdOutput =
		CreateFile (output_file_name,GENERIC_WRITE,0,&sa,CREATE_ALWAYS,FILE_ATTRIBUTE_NORMAL,NULL);

	si.hStdInput=GetStdHandle (STD_INPUT_HANDLE);
	si.hStdError=GetStdHandle (STD_ERROR_HANDLE);
	if (si.hStdOutput==INVALID_HANDLE_VALUE)
		si.hStdOutput=GetStdHandle (STD_OUTPUT_HANDLE);
	si.dwFlags=STARTF_USESTDHANDLES;

	ZeroMemory (&pi,sizeof(pi));

	if (! CreateProcess (NULL,command_line,NULL,NULL,TRUE,0,NULL,NULL,&si,&pi))
	{
		fprintf (error_file,"CreateProcess failed\n");
		fclose (error_file);
  		return;
	}

	WaitForSingleObject (pi.hProcess,INFINITE);

	CloseHandle (pi.hProcess);
	CloseHandle (pi.hThread);
	}
}