home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / plbin.zip / pl / src / pl-load.c < prev    next >
C/C++ Source or Header  |  1993-02-23  |  21KB  |  741 lines
  1. /*  pl-load.c,v 1.7 1993/02/23 13:16:36 jan Exp
  2.  
  3.     Copyright (c) 1990 Jan Wielemaker. All rights reserved.
  4.     See ../LICENCE to find out about your rights.
  5.     jan@swi.psy.uva.nl
  6.  
  7.     Purpose: load foreign files
  8. */
  9.  
  10. /*
  11. ** This file contains changes which are part of a port to HPUX 8.0
  12. ** T. Kielmann, 01 Jun 92
  13. */
  14.  
  15. #include "pl-incl.h"
  16. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  17. Make sure the symbolfile and  orgsymbolfile  attributes  of  the  global
  18. structure status are filled properly.
  19. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  20.  
  21. bool
  22. getSymbols()
  23. { char *symbols, *abs_symbols;
  24.  
  25.   if ( loaderstatus.symbolfile != (Atom) NULL )
  26.     succeed;
  27.   
  28.   if ( (symbols = Symbols()) == (char *)NULL )
  29.   { warning("Failed to find symbol table. Trying %s\n", mainArgv[0]);
  30.     symbols = mainArgv[0];
  31.   }
  32.   DEBUG(2, printf("Symbol file = %s\n", symbols));
  33.   if ( (abs_symbols = AbsoluteFile(PrologPath(symbols))) == NULL )
  34.     fail;
  35.  
  36.   loaderstatus.symbolfile = loaderstatus.orgsymbolfile = lookupAtom(abs_symbols);
  37.  
  38.   succeed;
  39. }
  40.  
  41. #if O_FOREIGN
  42.  
  43. forwards bool create_a_out();
  44. forwards int  openExec();
  45. forwards int  sizeExec();
  46. forwards Func loadExec();
  47. forwards bool scanSymbols();
  48. forwards char *symbolString();
  49.  
  50. #include <sys/file.h>
  51. #include <a.out.h>
  52.  
  53. #if !hpux
  54. extern char *sbrk(/*int*/);
  55. extern int lseek(/*int, long, int*/);
  56. #endif
  57. extern int system(/*char **/);
  58. extern int unlink(/*char **/);
  59.  
  60. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  61. Load an object file and link it to the system.  The intented  schema  is
  62. to  call  the  standard  system  loader `ld' to proceduce an incremental
  63. executable starting at some specified address.  As we only need 1  entry
  64. point  (the foreign module's initialisation function) we call the loader
  65. with -e <function> which will make the loader put the  address  of  that
  66. function in the header of the executable, thus avoiding the need to scan
  67. the  symbol table.  With the new dynamic linking facilities of SunOs 4.0
  68. this appears not to work any more.  Therefore a NOENTRY  flag  has  been
  69. introduced  to  indicate that `-e' does not work properly and the symbol
  70. table is to be scanned for the entry point.
  71.  
  72. If the size of the executable is not provided by the user, we first make
  73. an executable for an arbitrary base address (0) to deterimine the  size.
  74. Next  we  allocate  memory  and  produce  an  executable to start at the
  75. allocated memory base.  Finally, we read the text and  initialised  data
  76. segment  from  the  executable,  clear  the  bss area and call the entry
  77. point.
  78.  
  79. Normally, the entry point will install foreign language  functions,  but
  80. the user is allowed to do anything (s)he likes (even take over control).
  81.  
  82. This module is a bit of a mess due to all the #ifdef.  We should  define
  83. a better common basis to get rid of most of these things.
  84. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  85.  
  86. #if sun | vax
  87. #define NOENTRY 1
  88. #else
  89. #define NOENTRY 0
  90. #endif
  91.  
  92. #if hpux
  93. #define N_DATOFF(x)    DATA_OFFSET(x)
  94. #define N_TXTOFF(x)    TEXT_OFFSET(x)
  95. #define PAGSIZ        0x1000
  96. #endif
  97.  
  98. #if vax
  99. #define PAGSIZ        0x400
  100. #endif
  101.  
  102. #ifndef N_DATOFF            /* SunOs 3.4 does not define this */
  103. #define N_DATOFF(x) ( N_TXTOFF(x) + (x).a_text )
  104. #endif
  105.  
  106. #define LOADER    "ld"            /* Unix loader command name */
  107.  
  108. #if NOENTRY
  109. #define MAXSYMBOL 256            /* maximum length of a function name */
  110.  
  111. typedef struct
  112. { char *string;                /* name of function (withouth _) */
  113.   Func function;            /* functions address */
  114. } textSymbol;
  115.  
  116. char *symbolString();            /* forwards */
  117. #endif /* NOENTRY */
  118.  
  119. static struct exec header;        /* a.out header */  
  120.  
  121. void
  122. resetLoader()
  123. { loaderstatus.symbolfile = loaderstatus.orgsymbolfile = NULL;
  124. }
  125.  
  126. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  127. Allocate room for text and data segment of executable.  The  SUN  has  a
  128. special  function  for  this  called valloc(). On some systems you might
  129. need to start the text and data segment on a page  boundary,  on  others
  130. not.
  131. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  132.  
  133. #if hpux || vax
  134. #define valloc malloc
  135. #endif
  136.  
  137. long
  138. allocText(size)
  139. long size;
  140. {
  141. #if !hpux
  142.     extern char *valloc();
  143. #endif
  144.   long base;
  145.  
  146.   if ( size < sizeof(word) )
  147.     return 0;                /* test run */
  148.  
  149.   size = ROUND(size, sizeof(long));
  150.  
  151.   if ( (base = (long) valloc((malloc_t) size)) == 0L )
  152.     fatalError("%s", OsError());
  153.  
  154.   statistics.heap += size;
  155.  
  156.   return base;
  157. }
  158.  
  159.  
  160. word
  161. pl_load_foreign(file, entry, options, libraries, size)
  162. Word file, entry, options, libraries, size;
  163. { char *sfile, *sentry, *soptions, *slibraries;
  164.   int sz, nsz, n;
  165.   Atom execName;
  166.   char *execFile;
  167.   long base;
  168.   int fd;
  169.  
  170.   if ( !isAtom(*file) ||
  171.        !isAtom(*entry) ||
  172.        !isAtom(*options) ||
  173.        !isAtom(*libraries) ||
  174.        !isInteger(*size) )
  175.     return warning("pl_load_foreign/5: instantiation fault");
  176.  
  177.   sfile = stringAtom(*file);
  178.   sentry = stringAtom(*entry);
  179.   soptions = stringAtom(*options);
  180.   slibraries = stringAtom(*libraries);
  181.   sz = valNum(*size);
  182.   if ( sz < 0 )
  183.     sz = 0;
  184.   
  185.   TRY( getSymbols() );
  186.   execName = TemporaryFile("ld");
  187.   execFile = stringAtom(execName);
  188.  
  189.   for( n=0; n<2; n++)
  190.   { base = (long) allocText(sz);
  191. #if NOENTRY
  192.     TRY( create_a_out(sfile, soptions, slibraries, base, execFile) );
  193. #else
  194.     TRY( create_a_out(sfile, sentry, soptions, slibraries, base, execFile) );
  195. #endif
  196.     if ( (fd = openExec(execFile)) < 0 )
  197.       fail;
  198.  
  199.     if ( sizeExec() <= sz )
  200.     { Func entry;
  201. #if NOENTRY
  202.       if ( (entry = loadExec(fd, base, sentry)) == NULL )
  203.         fail;
  204. #else
  205.       if ( (entry = loadExec(fd, base)) == NULL )
  206.     fail;
  207. #endif
  208.       loaderstatus.symbolfile = execName;
  209.       DEBUG(1, printf("Calling entry point at 0x%x\n", entry));
  210.       (*entry)();
  211.       DEBUG(1, printf("Entry point returned successfully\n"));
  212.  
  213.       succeed;
  214.     }
  215.  
  216.     if ( base > 0 )            /* used for test runs */
  217.       freeHeap(base, sz);
  218.     nsz = sizeExec();
  219.     if ( sz > 0 )
  220.     { Putf("! Executable %s does not fit in %d bytes\n", sfile, sz);
  221.       Putf("Size: %d bytes (%d text %d data, %d bss) (reloading ...)\n",
  222.         nsz, header.a_text, header.a_data, header.a_bss);
  223.     }
  224.     sz = nsz;
  225.   }
  226.  
  227.   return sysError("Can't fit executable %s", execFile);
  228. }
  229.  
  230. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  231. Create an a.out file from a .o file.
  232. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  233.  
  234. static
  235. bool
  236. #if NOENTRY
  237. create_a_out(files, options, libraries, base, outfile)
  238. #else
  239. create_a_out(files, entry, options, libraries, base, outfile)
  240. char *entry;
  241. #endif
  242. char *files;
  243. char *options;
  244. char *libraries;
  245. long base;
  246. char *outfile;
  247. { char command[10240];
  248.  
  249. #if NOENTRY
  250.   sprintf(command, "%s -N -A %s -T %x -o %s %s %s %s -lc",
  251. #else
  252.   sprintf(command, "%s -N -A %s -R %x -e _%s -o %s %s %s %s -lc",
  253. #endif
  254.        LOADER,                 /* name of loader */
  255.        stringAtom(loaderstatus.symbolfile),    /* name of symbol file */
  256.        base,                 /* base address */
  257. #if !NOENTRY
  258.        entry,                 /* entry point */
  259. #endif
  260.        outfile,                /* temp. executable */
  261.        options,                /* additional options */
  262.        files,                /* files to be loaded */
  263.        libraries);                /* libraries */
  264.   
  265.   DEBUG(1, printf("Calling loader: %s\n", command) );
  266.   if (system(command) == 0)
  267.     succeed;
  268.  
  269.   unlink(outfile);
  270.   return warning("load_foreign/5: Failed to create an executable from %s\ncommand was %s",
  271.          files,
  272.          command);
  273. }
  274.  
  275. #ifndef O_BINARY
  276. #define O_BINARY 0
  277. #endif
  278.  
  279. static
  280. int
  281. openExec(execFile)
  282. char *execFile;
  283. { int fd;
  284.  
  285.                     /* O_BINARY needed on OS2 && EMX  */
  286.   if ((fd=open(execFile, O_RDONLY|O_BINARY)) < 0)
  287.   { warning("load_foreign/5: Cannot open %s", execFile);
  288.     return -1;
  289.   }
  290.  
  291.   if (read(fd, &header, sizeof(struct exec)) != sizeof(struct exec) ||
  292.       N_BADMAG(header) != 0)
  293.   { warning("load_foreign/5: Bad magic number in %s", execFile);
  294.     close(fd);
  295.     return -1;
  296.   }
  297.  
  298.   return fd;
  299. }
  300.  
  301.  
  302. static
  303. int
  304. sizeExec()
  305. { return ROUND(header.a_text, 4) +
  306.      ROUND(header.a_data, 4) +
  307.      ROUND(header.a_bss, 4);
  308. }
  309.  
  310.  
  311. static Func
  312. #if NOENTRY
  313. loadExec(fd, base, sentry)
  314. char *sentry;
  315. #else
  316. loadExec(fd, base)
  317. #endif
  318. int fd;
  319. ulong base;
  320. { Func entry;
  321.   long *text, text_off, text_size;
  322.   long *data, data_off, data_size;
  323.   long *bss, bss_size;
  324.  
  325.   text = (long *)base;            /* address of text in memory */
  326.   text_size = header.a_text;        /* size of text area */
  327.   data = (long *)(base+text_size);    /* address of data in memory */
  328.   data_size = header.a_data;        /* size of data area */
  329.   text_off = N_TXTOFF(header);        /* offset of text in file */
  330.   data_off = N_DATOFF(header);        /* offset of data in file */
  331.   bss = (long *)(base + text_size + data_size);
  332.   bss_size = header.a_bss;
  333.  
  334.   DEBUG(1, printf("Text offset = %d, Data offset = %d\n", text_off, data_off));
  335.   DEBUG(1, printf("Base = 0x%x (= %d), text at 0x%x, %d bytes, data at 0x%x, %d bytes\n",
  336.             base, base, text, text_size, data, data_size) );
  337.  
  338.   if ( lseek(fd, text_off, 0) < 0 ||
  339.        text_size != read(fd, text, text_size) ||
  340.        lseek(fd, data_off, 0) < 0 ||
  341.        data_size != read(fd, data, data_size) )
  342.   { warning("load_foreign/5: Failed to read text segment");
  343.     close(fd);
  344.     return NULL;
  345.   }
  346.  
  347. #if NOENTRY
  348.   { textSymbol ts[1];
  349.     ts[0].string = sentry;
  350.     ts[0].function = (Func) NULL;
  351.  
  352.     TRY( scanSymbols(fd, 1, ts) );
  353.     entry = ts[0].function;
  354.   }
  355. #else
  356. #  if hpux
  357.   entry = (Func)(header.a_entry + (long)text);
  358.   DEBUG(2, printf("a_entry = 0x%x; text = 0x%x, entry = 0x%x\n",
  359.                 header.a_entry, text, entry));
  360. #  else
  361.   entry = (Func)(header.a_entry);
  362. #  endif
  363. #endif
  364.  
  365.   close(fd);
  366.  
  367.   DEBUG(1, printf("Cleaning BSS %d bytes from 0x%x (=%d)\n", 
  368.           bss_size, bss, bss));
  369.   memset(bss, 0, bss_size);
  370.  
  371.   return entry;
  372. }
  373.  
  374. #if NOENTRY
  375.  
  376. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  377. Scan the symbol table and try to resolve all textSymbols given  in  `tv'
  378. (target  vector).   The  first `tc' (target count) members of this array
  379. are valid.  TRUE is returned if  all  functions  are  found.   Otherwise
  380. FALSE is returned.
  381.  
  382. Searching starts at the end of the symbol table, as this  is  the  place
  383. were the incrementally loaded symbols normally lives.
  384.  
  385. It assumes a global struct exec `header'  to  hold  the  header  of  the
  386. symbol  file and the argument `fd' to be an open file descriptor on that
  387. file.
  388. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  389.  
  390. static
  391. bool
  392. scanSymbols(fd, tc, tv)
  393. int fd;
  394. int tc;
  395. textSymbol * tv;
  396. { long symbols, strings;
  397.   long next_symbol;
  398.   struct nlist name;
  399.   char *s;
  400.   int n, left = tc;
  401.  
  402.   symbols = N_SYMOFF(header);
  403.   strings = N_STROFF(header);
  404.  
  405.   n = (strings - symbols)/sizeof(struct nlist);
  406.   next_symbol = symbols+(n-1)*sizeof(struct nlist);
  407.  
  408.   for(; next_symbol >= symbols; next_symbol -= sizeof(struct nlist) )
  409.   { if (lseek(fd, next_symbol, 0) < 0)
  410.       return warning("seek on executables' symbol table failed");
  411.     if (read(fd, &name, sizeof(struct nlist) ) != sizeof(struct nlist) )
  412.       return warning("failed to read symbol in executable");
  413.  
  414.     if (name.n_type == (unsigned char)(N_TEXT|N_EXT))
  415.     { s = symbolString(fd, name.n_un.n_strx+strings);
  416.  
  417.       for(n = 0; n < tc; n++)
  418.       { if ( streq(tv[n].string, s+1) )
  419.     { tv[n].function = (Func) name.n_value;
  420.       if ( --left <= 0 )
  421.         succeed;
  422.     }
  423.       }
  424.     }
  425.   }
  426.  
  427.   if ( left > 0 )
  428.   { for(n = 0; n < tc; n++)
  429.     { if ( tv[n].function == (Func) NULL )
  430.         warning("Dynamic loader: undefined: %s", tv[n].string);
  431.     }
  432.     fail;
  433.   }
  434.   succeed;
  435. }
  436.  
  437. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  438. Return the char string at offset `n' in the string table.   The  strings
  439. are supposed not to be longer than MAXSYMBOL characters.
  440. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  441.  
  442. static
  443. char *
  444. symbolString(fd, n)
  445. int fd;
  446. long n;
  447. { static char temp[MAXSYMBOL+1];
  448.   int l;
  449.  
  450.   if (n == 0)
  451.     return "";
  452.   if (lseek(fd, n, 0) < 0)
  453.   { warning("Failed to seek to string in executable");
  454.     return (char *) NULL;
  455.   }
  456.   l = read(fd, temp, MAXSYMBOL);
  457.   temp[l] = EOS;
  458.  
  459.   return temp;
  460. }
  461.  
  462. #endif /* NOENTRY */
  463.  
  464. #else
  465. #if O_AIX_FOREIGN
  466.  
  467. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  468. The AIX foreign interface  is completely different to the SUN/VAX/HPUX
  469. version.  The  latter cannot  be used  because ld is  lacking   the -A
  470. option and AIX uses  XCOFF  format a.out files.  Instead, AIX supplies
  471. the  load()  and loadbind() functions  to   load executable  code in a
  472. running  image.   This makes   the implementation a   lot  easier (and
  473. supported by official functions).
  474.  
  475. There is  still a problem in  the cooperation with save_program/[1,2].
  476. Normally, it appears the foreign code is loaded in  the program's data
  477. area and save nicely  by save_program.  If the loaded   code  is small
  478. however it will be put below &_data, in  which case save_program won't
  479. ave it.   Currently,  there is  only detection  of  this  problem.  We
  480. should try  to figure out  the starting adres  of the loaded code  and
  481. communicate this to save_program.  How to do this?
  482.  
  483. Note  than  the  Prolog   part    is  also different    for AIX.   See
  484. boot/aixforeign.pl.
  485. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  486.  
  487. #include <sys/ldr.h>
  488.  
  489. static Func main_entry;        /* my entry-point */
  490.  
  491. void
  492. resetLoader()
  493. { loaderstatus.symbolfile = loaderstatus.orgsymbolfile = NULL;
  494.   main_entry = NULL;
  495. }
  496.  
  497. word
  498. pl_load_foreign1(file)
  499. Word file;
  500. { char *sfile;
  501.   long rval;
  502.   Func entry;
  503.   char *libpath = (getenv("LIBPATH") == NULL ? "/lib:/usr/lib" : NULL);
  504.   extern int _data;
  505.  
  506.   if ( !isAtom(*file) )
  507.     return warning("pl_load_foreign/5: instantiation fault");
  508.  
  509.   sfile = stringAtom(*file);
  510.  
  511.   if ( main_entry == NULL )
  512.   { char *me;
  513.  
  514.     TRY(getSymbols());
  515.     me = stringAtom(loaderstatus.symbolfile);
  516.  
  517.     DEBUG(1, printf("Loading %s ... ", me); fflush(stdout));
  518.     if ( (main_entry = (Func) load(me, L_NOAUTODEFER, libpath)) == NULL )
  519.       return warning("load_foreign/5: %s: %s", me, OsError());
  520.     DEBUG(1, printf("ok\n"));
  521.   }
  522.  
  523.   DEBUG(1, printf("Loading %s ... ", sfile); fflush(stdout));
  524.   if ((entry = (Func) load(sfile, L_NOAUTODEFER, libpath)) == NULL)
  525.   { char *buf[1024];
  526.     warning("load_foreign/5: %s: %s", sfile, OsError());
  527.  
  528.     buf[0] = "execerror";
  529.     buf[1] = sfile;
  530.     if ( loadquery(L_GETMESSAGES, &buf[2], sizeof(buf) - 8) < 0 )
  531.       warning("load_foreign/5: loadquery: %s", OsError());
  532.     else
  533.     { switch ( fork() )
  534.       { case 0:
  535.       execvp("/etc/execerror", buf);
  536.     case -1:
  537.       warning("Couldn't exec /etc/execerror: %s", OsError());
  538.     }
  539.     }
  540.     fail;
  541.   }
  542.   DEBUG(1, printf("ok\n"));
  543.  
  544.   if ( entry < (Func) &_data )
  545.     cannot_save_program = "Foreign code loaded outside data area";
  546.  
  547.   DEBUG(1, printf("Loadbind() ... "); fflush(stdout));
  548.   if ( loadbind(0, main_entry, entry) != 0 )
  549.     return warning("load_foreign/5: loadbind: %s", OsError());
  550.   DEBUG(1, printf("ok\n"));
  551.  
  552.   DEBUG(1, printf("Calling entry-point at 0x%x\n", entry));
  553.   rval = (*entry)();
  554.   DEBUG(1, printf("rval = %d (0x%x)\n", rval, rval));
  555.  
  556.   succeed;
  557. }
  558.  
  559. #else
  560. #if O_MACH_FOREIGN
  561. /*
  562. The NeXT foreign interface  is completely different to the SUN/VAX/HPUX
  563. version. The  latter cannot  be used  because
  564. the NeXT uses  MACH format a.out files.  Instead, MACH supplies
  565. the  rld_load()  and rld_lookup() functions  to   load executable  code in a
  566. running  image.   This makes   the implementation a   lot  easier (and
  567. supported by official functions).
  568.  
  569. The prolog part is identical to the SUN versions. However, 
  570. the only arguments of load_foreign/5 that are used are 'File', 
  571. 'Libraries', and 'Entry'. The other arguments are ignored. 
  572. 'Libraries' is not expanded by the C code; filenames should be 
  573. either full pathnames or 'library()' names that expand to a full pathname.
  574. */
  575.  
  576. #include <rld.h>
  577. #include <strings.h>
  578. #include <streams/streams.h>
  579.  
  580. extern int    unlink(const char *), mkstemp (char *template), close(int);
  581. extern char *mktemp(char *template);
  582.  
  583. /* the rld_... routines spew their complaints on a stream of
  584.  * type NXStream. We do not want to print these to stderr or stdout, because 
  585.  * the 'current stream' mechanism of prolog is circumvented in this way.
  586.  * We open a temp file instead, informing the user this file exists only
  587.  * if an error occurred and errno == 0.
  588.  *
  589.  * Be aware of the fact rld_load()
  590.  * may fail and not set errno to !0. For example, the call
  591.  * rld_load(rld_err_stream,_,"i_do_not_exist",_) will result in the string
  592.  * "rld(): Can't open: i_do_not_exist (No such file or directory, errno = 2)"
  593.  * being sent to the appropriate stream, with errno == 2, while the call
  594.  * rld_load(rld_err_stream,_,"/dev/null",_) will result in 
  595.  * "rld(): file: /dev/null is empty (not an object or archive)" 
  596.  * being printed, with errno == 0.
  597.  */
  598.  
  599. word
  600. pl_load_foreign(file, entry, options, libraries, size)
  601. Word file, entry, options, libraries, size;
  602. { char *sfile, *sentry, *soptions, *slibraries;
  603.  
  604.   struct mach_header *m_header;
  605.   long rld_result, rval;
  606.   unsigned long rld_adress;
  607.   Func entry_func;
  608.   char **object_filenames;
  609.   char *tmp;
  610.   int stringno, maxstrings, i;
  611.  
  612.   /* errorhandling */
  613.   char      *errorBuffer;
  614.   int        streamLength, maxLength;
  615.   NXStream  *rld_err_stream;
  616.   
  617.   char underscore = '_';
  618.  
  619.   status.debugLevel = 1;
  620.   rld_err_stream = NXOpenMemory(NULL,0,NX_WRITEONLY);
  621.  
  622.   if ( !isAtom(*file) ||
  623.        !isAtom(*entry) ||
  624.        !isAtom(*libraries) ) 
  625.     return warning("pl_load_foreign/5: instantiation fault");
  626.  
  627.   sfile = stringAtom(*file);
  628.   sentry = stringAtom(*entry);
  629.   slibraries = stringAtom(*libraries);
  630.   DEBUG(1, 
  631.    printf("** sfile = \"%s\"\n",sfile);
  632.    printf("** sentry = \"%s\"\n",sentry);
  633.    printf("** slibraries = \"%s\"\n",slibraries);
  634.    fflush(stdout));
  635.   
  636.   /* append object-files and libraries */
  637.   if (strlen(slibraries) > 0)
  638.     sfile = strcat(strcat(sfile," "),slibraries);
  639.   
  640.   /* as *file as well as *libraries may point to a string containing >1
  641.    * filename, we have to break *sfile up in pieces, in order to get 
  642.    * the type of argument rld_load() expects: char **
  643.    */
  644.    
  645.       /* estimate max number of sub-strings in string */
  646.    maxstrings = (strlen(sfile)/ 2) +1;
  647.    if ((object_filenames = 
  648.       (char **)calloc((size_t)maxstrings,sizeof(char *))) == (void *)NULL)
  649.    fatalError("%s", OsError());
  650.  
  651.    stringno = 0;
  652.    if (*sfile != '\0') 
  653.       do {
  654.         object_filenames[stringno] = sfile; /* sub-string */
  655.         tmp = index(sfile,' '); /* try to find a space */
  656.         if (tmp != (char *)0) /* space found */
  657.         {  *tmp = '\0'; /* terminate previous string (replace ' ' by '\0') */
  658.            stringno++;
  659.           tmp++; sfile = tmp;            
  660.         } else { /* no space left in string pointed to by tmp */
  661.            object_filenames[stringno + 1] = NULL; /* signals end of char** to rld_load */
  662.         }
  663.       } while (tmp != (char *)0); /* end of sfile reached */
  664.    else /* sfile == "" */
  665.      object_filenames[0] = NULL;
  666.    
  667.   DEBUG(1, 
  668.     printf("Calling rld_load(), file(s):\n");
  669.     for (i = 0; i <= stringno; i++)
  670.       printf("\t \"%s\"\n",object_filenames[i]);
  671.     fflush(stdout));
  672.   
  673.   rld_result = rld_load(rld_err_stream,&m_header,object_filenames,NULL);
  674.   /* get rid of these as soon as we can */
  675.   free((void *)object_filenames);
  676.  
  677.   if (rld_result == 0) 
  678.   {     
  679.     NXFlush(rld_err_stream);
  680.     NXGetMemoryBuffer(rld_err_stream, &errorBuffer, &streamLength, &maxLength);
  681.     warning("load_foreign/5: rld_load() failed (%s)",errorBuffer);
  682.     NXCloseMemory (rld_err_stream, NX_FREEBUFFER);
  683.     fail;
  684.   } 
  685.   DEBUG(1, printf("\nrld_load returned ok (adress of mach-header: %ld)\n",m_header));
  686.  
  687.   DEBUG(1, printf("Calling rld_lookup()\n"); fflush(stdout));
  688.   /* Add an underscore to sentry (as in symbol-table looked at by 
  689.    * rld_lookup())
  690.    *
  691.    *     Problems:
  692.    *
  693.    * Rld_error_stream not used here; rld_lookup() seems to alter
  694.    * the stream; even if the stream * is NOT passed to it !!
  695.    * Functions using the stream dump core on us;
  696.    * unfortunately I can't replicate the error in a small program.
  697.    */ 
  698.   if ( rld_lookup(NULL,strcat(&underscore,sentry), &rld_adress) == 0 )
  699.   {
  700.     warning("load_foreign/5: rld_lookup() of \"%s()\" failed",sentry);
  701.     fail;
  702.   }
  703.   DEBUG(1, printf("rld_lookup returned ok\n"));
  704.  
  705.   entry_func = (Func)rld_adress;
  706.   DEBUG(1, printf("Calling entry-point at 0x%x\n", entry_func));
  707.   rval = (*entry_func)();
  708.   if (!rval > 0) {
  709.       warning("load_foreign/5: entry-function failed (%s())",sentry);
  710.     fail;
  711.   }
  712.   DEBUG(1, printf("Entry point returned successfully\n"));
  713.   DEBUG(1, printf("rval = %d (0x%x)\n", rval, rval));
  714.   
  715.   succeed;
  716. }
  717.  
  718. void
  719. resetLoader()
  720. { loaderstatus.symbolfile = loaderstatus.orgsymbolfile = NULL;
  721. }
  722.  
  723. #else                    /* No foreign language interface */
  724.  
  725. void
  726. resetLoader()
  727. { loaderstatus.symbolfile = loaderstatus.orgsymbolfile = NULL;
  728. }
  729.  
  730. word
  731. pl_load_foreign(file, entry, options, libraries, size)
  732. Word file, entry, options, libraries, size;
  733. { warning("Foreign language loader not (yet) available for this machine");
  734.  
  735.   fail;
  736. }
  737.  
  738. #endif /* O_MACH_FOREIGN */
  739. #endif /* O_AIX_FOREIGN */
  740. #endif /* O_FOREIGN */
  741.