home *** CD-ROM | disk | FTP | other *** search
/ Complete Linux / Complete Linux.iso / docs / devel / lisp / kcl_tar.z / kcl_tar / c / unixfasl.c < prev    next >
Encoding:
C/C++ Source or Header  |  1987-06-04  |  7.5 KB  |  370 lines
  1. /*
  2. (c) Copyright Taiichi Yuasa and Masami Hagiya, 1984.  All rights reserved.
  3. Copying of this file is authorized to users who have executed the true and
  4. proper "License Agreement for Kyoto Common LISP" with SIGLISP.
  5. */
  6.  
  7. #include "include.h"
  8.  
  9.  
  10. #ifdef BSD
  11. #include <a.out.h>
  12. #endif
  13.  
  14. #ifdef ATT
  15. #include <filehdr.h>
  16. #include <scnhdr.h>
  17. #include <syms.h>
  18. #endif
  19.  
  20. #ifdef E15
  21. #include <a.out.h>
  22. #define exec        bhdr
  23. #define a_text        tsize
  24. #define a_data        dsize
  25. #define a_bss        bsize
  26. #define a_syms        ssize
  27. #define a_trsize    rtsize
  28. #define a_drsize    rdsize
  29. #endif
  30.  
  31.  
  32. #define    MAXPATHLEN    1024
  33.  
  34.  
  35. int
  36. fasload(faslfile)
  37. object faslfile;
  38. {
  39.  
  40. #ifdef BSD
  41.     struct exec header, newheader;
  42. #define    textsize    header.a_text
  43. #define    datasize    header.a_data
  44. #define    bsssize        header.a_bss
  45. #define    textstart    sizeof(header)
  46. #define    newbsssize    newheader.a_bss
  47. #endif
  48.  
  49. #ifdef ATT
  50.     struct filehdr fileheader;
  51.     struct scnhdr sectionheader;
  52.     int textsize, datasize, bsssize;
  53.     int textstart;
  54. #endif
  55.  
  56. #ifdef E15
  57.     struct exec header;
  58. #define    textsize    header.a_text
  59. #define    datasize    header.a_data
  60. #define    bsssize        header.a_bss
  61. #define    textstart    sizeof(header)
  62. #endif
  63.  
  64.     object memory, data, tempfile;
  65.     FILE *fp;
  66.     char filename[MAXPATHLEN];
  67.     char tempfilename[32];
  68.     char command[MAXPATHLEN * 2];
  69.     int i;
  70.     object *old_vs_base = vs_base;
  71.     object *old_vs_top = vs_top;
  72. #ifdef IBMRT
  73.  
  74. #endif
  75.  
  76.     coerce_to_filename(faslfile, filename);
  77.  
  78.     faslfile = open_stream(faslfile, smm_input, Cnil, Kerror);
  79.     vs_push(faslfile);
  80.     fp = faslfile->sm.sm_fp;
  81.  
  82. #ifdef BSD
  83.     fread(&header, sizeof(header), 1, fp);
  84. #endif
  85. #ifdef ATT
  86.     fread(&fileheader, sizeof(fileheader), 1, fp);
  87. #ifdef S3000
  88.         if(fileheader.f_opthdr != 0) fseek(fp,fileheader.f_opthdr,1);
  89. #endif
  90.     fread(§ionheader, sizeof(sectionheader), 1, fp);
  91.     textsize = sectionheader.s_size;
  92.     textstart = sectionheader.s_scnptr;
  93.     fread(§ionheader, sizeof(sectionheader), 1, fp);
  94.     datasize = sectionheader.s_size;
  95.     fread(§ionheader, sizeof(sectionheader), 1, fp);
  96.     if (strcmp(sectionheader.s_name, ".bss") == 0)
  97.         bsssize = sectionheader.s_size;
  98.     else
  99.         bsssize = 0;
  100. #endif
  101. #ifdef E15
  102.     fread(&header, sizeof(header), 1, fp);
  103. #endif
  104.  
  105.     memory = alloc_object(t_cfun);
  106.     memory->cf.cf_name = memory->cf.cf_data = OBJNULL;
  107.     memory->cf.cf_start = NULL;
  108.     memory->cf.cf_size = textsize + datasize + bsssize;
  109.     vs_push(memory);
  110.     memory->cf.cf_start = alloc_contblock(memory->cf.cf_size);
  111.  
  112. #ifdef BSD
  113.     fseek(fp,
  114.           header.a_text+header.a_data+
  115.           header.a_syms+header.a_trsize+header.a_drsize,
  116.           1);
  117.     fread(&i, sizeof(i), 1, fp);
  118.     fseek(fp, i - sizeof(i), 1);
  119. #endif
  120.  
  121. #ifdef ATT
  122.     fseek(fp,
  123.           fileheader.f_symptr + SYMESZ*fileheader.f_nsyms,
  124.           0);
  125.     fread(&i, sizeof(i), 1, fp);
  126.     fseek(fp, i - sizeof(i), 1);
  127.     while ((i = getc(fp)) == 0)
  128.         ;
  129.     ungetc(i, fp);
  130. #endif
  131.  
  132. #ifdef E15
  133.     fseek(fp,
  134.           header.a_text+header.a_data+
  135.           header.a_syms+header.a_trsize+header.a_drsize,
  136.           1);
  137. #endif
  138.  
  139.     data = read_fasl_vector(faslfile);
  140.     vs_push(data);
  141.     close_stream(faslfile, TRUE);
  142.  
  143.     sprintf(tempfilename, "/tmp/fasltemp%d", getpid());
  144.  
  145. AGAIN:
  146.  
  147. #ifdef BSD
  148.     sprintf(command,
  149.         "ld -d -N -x -A %s -T %x %s -o %s",
  150.         kcl_self,
  151.         memory->cf.cf_start,
  152.         filename,
  153.         tempfilename);
  154. #endif
  155. #ifdef ATT
  156.     coerce_to_filename(symbol_value(siVsystem_directory),
  157.                system_directory);
  158.     sprintf(command,
  159.         "%sild %s %d %s %s",
  160.         system_directory,
  161.         kcl_self,
  162.         memory->cf.cf_start,
  163.         filename,
  164.         tempfilename);
  165. #endif
  166. #ifdef E15
  167.     coerce_to_filename(symbol_value(siVsystem_directory),
  168.                system_directory);
  169.     sprintf(command,
  170.         "%sild %s %d %s %s",
  171.         system_directory,
  172.         kcl_self,
  173.         memory->cf.cf_start,
  174.         filename,
  175.         tempfilename);
  176. #endif
  177.  
  178.     if (system(command) != 0)
  179.         FEerror("The linkage editor failed.", 0);
  180.  
  181.     tempfile = make_simple_string(tempfilename);
  182.     vs_push(tempfile);
  183.     tempfile = open_stream(tempfile, smm_input, Cnil, Kerror);
  184.     vs_push(tempfile);
  185.     fp = tempfile->sm.sm_fp;
  186.  
  187. #ifdef BSD
  188.     fread(&newheader, sizeof(header), 1, fp);
  189.     if (newbsssize != bsssize) {
  190.         insert_contblock(memory->cf.cf_start, memory->cf.cf_size);
  191.         bsssize = newbsssize;
  192.         memory->cf.cf_start = NULL;
  193.         memory->cf.cf_size = textsize + datasize + bsssize;
  194.         memory->cf.cf_start = alloc_contblock(memory->cf.cf_size);
  195.         close_stream(tempfile, TRUE);
  196.         unlink(tempfilename);
  197.         goto AGAIN;
  198.     }
  199. #endif
  200.  
  201.     if (fseek(fp, textstart, 0) < 0)
  202.         error("file seek error");
  203.  
  204.     fread(memory->cf.cf_start, textsize + datasize, 1, fp);
  205.  
  206.     close_stream(tempfile, TRUE);
  207.  
  208. #ifdef IBMRT
  209.  
  210.  
  211.  
  212. #endif
  213.  
  214.     unlink(tempfilename);
  215.  
  216. #ifdef IBMRT
  217.  
  218. #else
  219.     (*(int (*)())(memory->cf.cf_start))
  220. #endif
  221.         (memory->cf.cf_start, memory->cf.cf_size, data);
  222.  
  223.     vs_base = old_vs_base;
  224.     vs_top = old_vs_top;
  225.  
  226.     return(memory->cf.cf_size);
  227. }
  228.  
  229. #ifdef BSD
  230.  
  231. int
  232. faslink(faslfile, ldargstring)
  233. object faslfile, ldargstring;
  234. {
  235.     struct exec header, faslheader;
  236. #define    textsize    header.a_text
  237. #define    datasize    header.a_data
  238. #define    bsssize        header.a_bss
  239. #define    textstart    sizeof(header)
  240.  
  241.     object memory, data, tempfile;
  242.     FILE *fp;
  243.     char filename[MAXPATHLEN];
  244.     char ldargstr[MAXPATHLEN];
  245.     char tempfilename[32];
  246.     char command[MAXPATHLEN * 2];
  247.     char buf[BUFSIZ];
  248.     int i;
  249.     object *old_vs_base = vs_base;
  250.     object *old_vs_top = vs_top;
  251. #ifdef IBMRT
  252.  
  253. #endif
  254.  
  255.     coerce_to_filename(ldargstring, ldargstr);
  256.     coerce_to_filename(faslfile, filename);
  257.  
  258.     sprintf(tempfilename, "/tmp/fasltemp%d", getpid());
  259.  
  260.     sprintf(command,
  261.         "ld -d -N -x -A %s -T %x %s %s -o %s",
  262.         kcl_self,
  263.         (int)core_end,
  264.         filename,
  265.         ldargstr,
  266.         tempfilename);
  267.  
  268.     if (system(command) != 0)
  269.         FEerror("The linkage editor failed.", 0);
  270.  
  271.     fp = fopen(tempfilename, "r");
  272.     setbuf(fp, buf);
  273.     fread(&header, sizeof(header), 1, fp);
  274.     memory = alloc_object(t_cfun);
  275.     memory->cf.cf_name = memory->cf.cf_data = OBJNULL;
  276.     memory->cf.cf_start = NULL;
  277.     memory->cf.cf_size = textsize + datasize + bsssize;
  278.     vs_push(memory);
  279.     memory->cf.cf_start = alloc_contblock(memory->cf.cf_size);
  280.     fclose(fp);
  281.  
  282.     faslfile = open_stream(faslfile, smm_input, Cnil, Kerror);
  283.     vs_push(faslfile);
  284.     fp = faslfile->sm.sm_fp;
  285.     fread(&faslheader, sizeof(faslheader), 1, fp);
  286.     fseek(fp,
  287.           faslheader.a_text+faslheader.a_data+
  288.           faslheader.a_syms+faslheader.a_trsize+faslheader.a_drsize,
  289.           1);
  290.     fread(&i, sizeof(i), 1, fp);
  291.     fseek(fp, i - sizeof(i), 1);
  292.  
  293.     data = read_fasl_vector(faslfile);
  294.     vs_push(data);
  295.     close_stream(faslfile, TRUE);
  296.  
  297.     sprintf(command,
  298.         "ld -d -N -x -A %s -T %x %s %s -o %s",
  299.         kcl_self,
  300.         memory->cf.cf_start,
  301.         filename,
  302.         ldargstr,
  303.         tempfilename);
  304.  
  305.     if (system(command) != 0)
  306.         FEerror("The linkage editor failed.", 0);
  307.  
  308.     tempfile = make_simple_string(tempfilename);
  309.     vs_push(tempfile);
  310.     tempfile = open_stream(tempfile, smm_input, Cnil, Kerror);
  311.     vs_push(tempfile);
  312.     fp = tempfile->sm.sm_fp;
  313.  
  314.     if (fseek(fp, textstart, 0) < 0)
  315.         error("file seek error");
  316.  
  317.     fread(memory->cf.cf_start, textsize + datasize, 1, fp);
  318.  
  319.     close_stream(tempfile, TRUE);
  320.  
  321. #ifdef IBMRT
  322.  
  323.  
  324.  
  325. #endif
  326.  
  327.     unlink(tempfilename);
  328.  
  329. #ifdef IBMRT
  330.  
  331. #else
  332.     (*(int (*)())(memory->cf.cf_start))
  333.         (memory->cf.cf_start, memory->cf.cf_size, data);
  334. #endif
  335.  
  336.     vs_base = old_vs_base;
  337.     vs_top = old_vs_top;
  338.  
  339.     return(memory->cf.cf_size);
  340. }
  341.  
  342. siLfaslink()
  343. {
  344.     bds_ptr old_bds_top;
  345.     int i;
  346.     object package;
  347.  
  348.     check_arg(2);
  349.     check_type_or_pathname_string_symbol_stream(&vs_base[0]);
  350.     check_type_string(&vs_base[1]);
  351.     vs_base[0] = coerce_to_pathname(vs_base[0]);
  352.     vs_base[0]->pn.pn_type = FASL_string;
  353.     vs_base[0] = namestring(vs_base[0]);
  354.     package = symbol_value(Vpackage);
  355.     old_bds_top = bds_top;
  356.     bds_bind(Vpackage, package);
  357.     i = faslink(vs_base[0], vs_base[1]);
  358.     bds_unwind(old_bds_top);
  359.     vs_top = vs_base;
  360.     vs_push(make_fixnum(i));
  361. }
  362.  
  363. #endif
  364. init_unixfasl()
  365. {
  366. #ifdef BSD
  367.     make_si_function("FASLINK", siLfaslink);
  368. #endif
  369. }
  370.