home *** CD-ROM | disk | FTP | other *** search
/ GEMini Atari / GEMini_Atari_CD-ROM_Walnut_Creek_December_1993.iso / files / language / sbprolog / loader.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-10-23  |  20.8 KB  |  703 lines
  1. /************************************************************************
  2. *                                    *
  3. * The SB-Prolog System                            *
  4. * Copyright SUNY at Stony Brook, 1986; University of Arizona, 1987    *
  5. *                                    *
  6. ************************************************************************/
  7.  
  8. /*-----------------------------------------------------------------
  9. SB-Prolog is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY.  No author or distributor
  11. accepts responsibility to anyone for the consequences of using it
  12. or for whether it serves any particular purpose or works at all,
  13. unless he says so in writing.  Refer to the SB-Prolog General Public
  14. License for full details.
  15.  
  16. Everyone is granted permission to copy, modify and redistribute
  17. SB-Prolog, but only under the conditions described in the
  18. SB-Prolog General Public License.   A copy of this license is
  19. supposed to have been given to you along with SB-Prolog so you
  20. can know your rights and responsibilities.  It should be in a
  21. file named COPYING.  Among other things, the copyright notice
  22. and this notice must be preserved on all copies. 
  23. ------------------------------------------------------------------ */
  24. /* loader.c */
  25.  
  26. #include "sim.h"
  27. #include "inst.h"
  28. #include "aux.h"
  29.  
  30. #define GET_DATA(x,y)  (y*sizeof(*x) - fread(x,sizeof(char),y*sizeof(*x),fp))
  31. #define PUT_DATA(x,y)  (fwrite(x, sizeof(char), y*sizeof(*x), fp)/sizeof(*x))
  32.     /* GET_DATA and PUT_DATA are defined in this way to avoid byte
  33.        ordering problems when words are written out -- this way we
  34.        write things out,  and read them in,  a byte at a time.    */
  35. #define ST_PTRPTRPSC(i_addr) \
  36.    *(LONG_PTR *)i_addr = reloc_table[*(LONG_PTR)i_addr];
  37.  
  38. #define ST_PTRPSC(i_addr)    \
  39.    *(LONG_PTR)i_addr = *reloc_table[*(LONG_PTR)i_addr];
  40.  
  41. static WORD_PTR inst_addr;
  42. static LONG_PTR hptr;
  43. static LONG_PTR reloc_table[500];
  44. static LONG_PTR last_text;
  45.  
  46. WORD   eof_flag;
  47. LONG   psc_bytes, text_bytes, index_bytes, magic;
  48.  
  49. int    (*load_routine[20])();
  50.  
  51. static FILE *fp;
  52. static BYTE perm = PERM;
  53.  
  54. extern LONG_PTR reloc_addr();        /* actually it is defined below */
  55.  
  56. /****************************************************************************/
  57. /*                                                                          */
  58. /* fix_bb4: fixes the byte-backwards problem.  It is passed a pointer to a  */
  59. /* sequence of 4 bytes read in from a file as bytes.  It then converts      */
  60. /* those bytes to represent a number.  This code works for any machine, and */
  61. /* makes the byte-code machine independent.                                 */
  62. /*                                                                          */
  63. /****************************************************************************/
  64. fix_bb4(lptr)
  65. BYTE_PTR lptr;
  66. {
  67.    LONG_PTR numptr = (LONG_PTR)lptr;
  68.  
  69.    *numptr = (((((*lptr << 8) | *(lptr+1)) << 8) | *(lptr+2)) << 8) | *(lptr+3);
  70. }
  71.  
  72. /****************************************************************************/
  73. /*                                                                          */
  74. /* fix_bb2: fixes the byte-backwards problem.  It is passed a pointer to a  */
  75. /* sequence of 2 bytes read in from a file as bytes.  It then converts      */
  76. /* those bytes to represent a number.  This code works for any machine, and */
  77. /* makes the byte-code machine independent.                                 */
  78. /*                                                                          */
  79. /****************************************************************************/
  80. fix_bb2(lptr)
  81. BYTE_PTR lptr;
  82. {
  83.    WORD_PTR numptr = (WORD_PTR)lptr;
  84.  
  85.    *numptr = (*lptr << 8) | *(lptr+1);
  86. }
  87.  
  88. /****************************************************************************/
  89. /*                                                                          */
  90. /*    Load the file into permanent space, starting from "curr_fence".       */
  91. /* Data segment first (mixed psc entries and name strings), then text       */
  92. /* segment, ended with a virtual instruction "endfile <pointer>" where the  */
  93. /* pointer is a pointer to the next text segment (of another byte code      */
  94. /* file).                                                                   */
  95. /*                                                                          */
  96. /****************************************************************************/
  97. loader(file)
  98. CHAR_PTR file;
  99. {
  100.    CHAR_PTR restore;
  101.    WORD     err_msg;
  102.  
  103.    fp = fopen(file, "r");
  104.    if (fp == NULL)
  105.       return 10;
  106.    if (hitrace)
  107.       printf("\n     ...... loading file %s\n", file);
  108.  
  109.    while ((eof_flag = GET_DATA(&magic, 1)) == 0) {
  110.       if (eof_flag = GET_DATA(&psc_bytes, 1))
  111.      return 1;
  112.       if (eof_flag = GET_DATA(&text_bytes, 1))
  113.      return 1;
  114.       if (eof_flag = GET_DATA(&index_bytes, 1))
  115.      return 1;
  116.  
  117.       err_msg = load_syms();
  118.  
  119.       if (err_msg != 0) {
  120.          printf("error %d loading file %s: bad symbol table\n", err_msg, file);
  121.          exit(1);  /* eventually upper level routines will determine */
  122.       } else {
  123.          restore = curr_fence;
  124.          err_msg = load_text();
  125.          if (err_msg != 0) {
  126.             printf("error %d loading file %s: bad text segment\n", err_msg, file);
  127.             curr_fence = restore;
  128.             exit(1);  /* eventually upper level routines will determine */
  129.          } else {
  130.             err_msg = load_index();
  131.             if (err_msg != 0) {
  132.                printf("error %d in (index) loading file %s: bad index segment\n", err_msg, file);
  133.                curr_fence = restore;
  134.                exit(1);  /*eventually upper level routines will determine */
  135.             } else {
  136.                if (eof_flag = GET_DATA(inst_addr, 4))
  137.                   return eof_flag;
  138.                fix_bb2(inst_addr);
  139.                if (*inst_addr != endfile)
  140.                    *inst_addr = endfile;
  141.                inst_addr += 2;              /* skip opcode and pad */
  142.                *(LONG_PTR)inst_addr = 0;    /* force 0 address (LONG) */
  143.                last_text  = (LONG_PTR)inst_addr;
  144.                inst_addr += 2;
  145.                curr_fence = (CHAR_PTR)inst_addr;
  146.                if (curr_fence >= max_fence)
  147.                   quit("Program area overflow\n");
  148.             }
  149.          }
  150.       }
  151.    }
  152.    fclose(fp);
  153.    return 0;
  154. }  /* end of loader */
  155.  
  156. /*************************************************************************
  157. *                                                                        *
  158. * Load_syms is a function which loads a symbol table given in a byte     *
  159. * code file into an appropriate format in the pcs table.  As part of     *
  160. * its function it resolves entry points for byte code intructions (call  *
  161. * to relloc_addr), and maintains a tableau so that instructions          *
  162. * with indices into the pcs table may have those indices resloved before *
  163. * loading them in the intruction array (byte code program space).  The   *
  164. * intructions are loaded by a separate function.                         *
  165. * The function returns a short integer which is an error code.  Relevant *
  166. * error codes are listed below.                                          *
  167. *                                                                        *
  168. *      1: in load_syms: incomplete or missing psc count                  *
  169. *      2: in load_syms: incomplete or missing ep in record dec           *
  170. *      3: in load_syms: incomplete or missing arity in record dec        *
  171. *      4: in load_syms: incomplete or missing length in record dec       *
  172. *      5: in load_syms: incomplete or missing name in record dec         *
  173. *      8: can not open file                                              *
  174. *                                                                        *
  175. *************************************************************************/
  176. load_syms()
  177. {
  178.    CHAR     name[256];
  179.    LONG     ep_offset;
  180.    LONG     i = 0, j, count = 0;
  181.    BYTE     temp_len;
  182.    BYTE     temp_arity;
  183.    LONG_PTR insert();
  184.  
  185.    fix_bb4(&psc_bytes);       /* caller read psc_bytes, we just fix it */
  186.  
  187.    while (count < psc_bytes && eof_flag == 0) {
  188.       if (eof_flag = GET_DATA(&ep_offset, 1))
  189.      return 2;
  190.       fix_bb4(&ep_offset);
  191.       if (eof_flag = GET_DATA(&temp_arity, 1))
  192.      return 3;
  193.       if (eof_flag = GET_DATA(&temp_len, 1))
  194.      return 4;
  195.       if (eof_flag = GET_DATA(name, temp_len))
  196.      return 5;
  197.       reloc_table[i] = insert(name, temp_len, temp_arity, &perm);
  198.       set_temp_ep(*reloc_table[i], ep_offset);
  199.       count += temp_len + 6;
  200.       i++;
  201.    }
  202.  
  203.    for (j = 0; j < i; j++)
  204.       set_real_ep(*reloc_table[j], curr_fence);
  205.    pspace_used = ((LONG)curr_fence - (LONG)(pspace)) / 4;
  206.    return 0;
  207. }  /* end of load_syms */
  208.  
  209. /************************************************************************
  210. *                                                                       *
  211. * Load_text loads the byte code instruction from a byte code file to    *
  212. * the byte code program space.  References to indices to the pcs table  *
  213. * are resolved with the use of the macro st_index.  New index relies    *
  214. * on the symbol table array which is assigned values by load_syms.      *
  215. * The routine assumes the current length (8/18/84) of byte code         *
  216. * intructions when reading from the byte code file.                     *
  217. * The function returns a short integer which is a error code.  Relevant *
  218. * error codes are listed below.                                         *
  219. *                                                                       *
  220. *      6: in load_text: byte code Operands are non-existent             *
  221. *      7: in load_text: Illegal instruction from PIL file               *
  222. *      8: can not open file                                             *
  223. *                                                                       *
  224. ************************************************************************/
  225. load_text()
  226. {
  227.    WORD current_opcode = 0;
  228.    LONG count = 0;
  229.    WORD opval;
  230.  
  231.    /* set text segments chain */
  232.    if (inst_begin == 0) 
  233.       inst_begin = (WORD_PTR)curr_fence;
  234.    else 
  235.       *last_text = (LONG)curr_fence;
  236.  
  237.    inst_addr = (WORD_PTR)curr_fence;
  238.  
  239.    fix_bb4(&text_bytes);
  240.  
  241.    while (count < text_bytes &&
  242.       (eof_flag = GET_DATA(¤t_opcode, 1)) == 0) {
  243.       fix_bb2(¤t_opcode);
  244.  
  245.       *inst_addr++ = current_opcode;
  246.  
  247.       if (current_opcode >= 100) {
  248.          switch (current_opcode - 100) {
  249.             case 0 : opval = 0x05;  break;
  250.             case 1 : opval = 0x08;  break;
  251.             case 2 : opval = 0x11;  break;
  252.             case 3 : opval = 0x46;  break;
  253.             case 4 : opval = 0x05;  break;
  254.             case 5 : opval = 0x27;  break;
  255.             case 6 : opval = 0x27;  break;
  256.             case 7 : opval = 0x03;  break;
  257.             case 8 : opval = 0x07;  break;
  258.          }
  259.          (*load_routine[xxopcode[opval].type])();
  260.          count += xxopcode[opval].size;
  261.       } else {
  262.          (*load_routine[xxopcode[current_opcode].type])();
  263.          count += xxopcode[current_opcode].size;
  264.       }
  265.   }
  266.  
  267.   if (count != text_bytes)   
  268.      return 9;               /* missing instructions */
  269.    return 0;
  270. }  /* end of load_text */
  271.  
  272.  
  273. load_index()
  274. {
  275.    LONG     psc_offset, clause_no, temp_len;
  276.    LONG     count = 0;
  277.    LONG_PTR psc;
  278.    WORD_PTR gen_index();
  279.  
  280.    fix_bb4(&index_bytes);
  281.  
  282.    while (count < index_bytes && eof_flag == 0) {
  283.       if (eof_flag = GET_DATA(&psc_offset, 1))
  284.      return 10;
  285.       fix_bb4(&psc_offset);
  286.       psc = (LONG_PTR)*reloc_table[psc_offset];
  287.       if (eof_flag = GET_DATA(&clause_no, 1))
  288.      return 1;
  289.       fix_bb4(&clause_no);
  290.       if (eof_flag = get_index_tab(clause_no, &temp_len))
  291.      return eof_flag;
  292.       inst_addr = gen_index(clause_no, psc);
  293.       count += (8 + temp_len);
  294.    }
  295.    return 0;
  296. }
  297.  
  298.  
  299. get_index_tab(clause_no, lenptr)
  300. LONG     clause_no;
  301. LONG_PTR lenptr;
  302. {
  303.    LONG     hashval, size, j;
  304.    LONG     count = 0;
  305.    BYTE     type;
  306.    LONG     val;
  307.    LONG_PTR label, reloc_addr();
  308.  
  309.    hptr = hreg;
  310.    size = hsize(clause_no);
  311.    for (j = 0; j < size; j++) {
  312.       indextab[j].l = 0;
  313.       indextab[j].link = (LONG_PTR)(&(indextab[j].link));
  314.    }
  315.    for (j = 0; j < clause_no; j++) {
  316.       if (eof_flag = GET_DATA(&type, 1))
  317.      return 11;
  318.       switch (type) {
  319.         case 'i': if (eof_flag = GET_DATA(&val, 1))
  320.              return 12;
  321.                   fix_bb4(&val);
  322.           count += 9;
  323.                   break;
  324.         case 'l': /* val = UNTAGGED(list_str); */
  325.               val = *(LONG_PTR)UNTAGGED(list_str);
  326.                   count += 5;
  327.                   break;
  328.         case 'n': /* val = UNTAGGED(nil_sym); */
  329.                   val = *(LONG_PTR)UNTAGGED(nil_sym);
  330.                   count += 5;
  331.                   break;
  332.         case 's': if (eof_flag = GET_DATA(&val, 1))
  333.              return 12;
  334.                   fix_bb4(&val);
  335.           count += 9;
  336.                   /* val = (WORD)reloc_table[val]; */
  337.                   val = *reloc_table[val];
  338.                   break;
  339.         case 'c': if (eof_flag = GET_DATA(&val, 1))
  340.              return 12;
  341.                   fix_bb4(&val);
  342.           count += 9;
  343.                   /* val = (WORD)reloc_table[val]; */
  344.                   val = *reloc_table[val];
  345.                   break;
  346.       }
  347.       if (eof_flag = GET_DATA(&label, 1))
  348.      return 13;
  349.       fix_bb4(&label);
  350.       label = reloc_addr((LONG)label);
  351.       hashval = IHASH(val, size);
  352.       inserth(label, &indextab[hashval]);
  353.    }
  354.  
  355.    *lenptr = count;
  356.    return 0;
  357. }  /* end of get_index_tab */
  358.  
  359.  
  360. WORD_PTR gen_index(clause_no, psc_ptr)
  361. LONG        clause_no;
  362. PSC_REC_PTR psc_ptr;
  363. {
  364.    WORD_PTR ep1, ep2;
  365.    LONG     j, size;
  366.    LONG_PTR temp;
  367.  
  368.    size = hsize(clause_no);
  369.    ep1  = inst_addr;
  370.    *ep1++ = hash;             /* opcode 'hash' */
  371.    *ep1++ = size;
  372.    ep2 = inst_addr + 2 + 2 * size;
  373.    temp = GET_EP(psc_ptr) + 1;             /* here the hash table size is */
  374.    *temp++ = (LONG)(inst_addr + 2);        /* computed and inserted into  */
  375.    *temp = size;                           /* sob instructions            */
  376.    for (j = 0; j < size; j++) {
  377.       if (indextab[j].l == 0) {
  378.          *(LONG_PTR)ep1 = (LONG)trap_vector[0];
  379.      ep1 += 2;
  380.       } else  if (indextab[j].l == 1) {
  381.          *(LONG_PTR)ep1 = (LONG)*(indextab[j].link);
  382.      ep1 += 2;
  383.       } else {
  384.          /* otherwise create try/retry/trust instruction */
  385.          *(LONG_PTR)ep1 = (LONG)ep2;
  386.      ep1 += 2;
  387.          temp = (LONG_PTR)(indextab[j].link);
  388.          GEN_TRY(try, GET_ARITY(psc_ptr), *temp++, ep2);
  389.          while (*temp != (LONG)temp) {
  390.             temp = (LONG_PTR)*temp;
  391.             GEN_TRY(retry, GET_ARITY(psc_ptr), *temp++, ep2);
  392.          }
  393.          *(ep2 - 4) = trust;
  394.       }
  395.    }
  396.    return ep2;
  397. }
  398.  
  399.  
  400. inserth(label, bucket)
  401. LONG_PTR label;
  402. struct   hrec *bucket;
  403. {
  404.    LONG_PTR temp;
  405.  
  406.    bucket->l++;
  407.    temp = (LONG_PTR)&(bucket->link);
  408.    if (bucket->l > 1) {
  409.       temp = (LONG_PTR)*temp;
  410.       while ((LONG_PTR)*temp != temp)
  411.          temp = (LONG_PTR)*(++temp);
  412.    }
  413.    *temp = (LONG)hptr;
  414.    *hptr++ = (LONG)label;
  415.    *hptr++ = *temp + 4;     /* *hptr++ = (LONG)hptr; */
  416. }
  417.  
  418.  
  419. hsize(numentry)
  420. LONG numentry;
  421. {
  422.    LONG i, j, temp;
  423.  
  424.    temp = numentry + 1;
  425.  
  426. hashsod:
  427.    j = temp / 2 + 1;
  428.    for (i = 2; i <= j; i++) {
  429.       if (i != temp && (temp % i) == 0) {
  430.          temp++;
  431.          goto hashsod;
  432.       }
  433.    }
  434.    return temp;
  435. }
  436.  
  437. /************************************************************************
  438. *                                                                       *
  439. * Reloc_addr calculates the entry point of the code using the entry     *
  440. * point stored in the byte code file as an offset, and the stack        *
  441. * pointer curr_fence as the relative address.  Note trap vectors are    *
  442. * are indicated with a - 1, in the byte code file.                      *
  443. *                                                                       *
  444. ************************************************************************/
  445. LONG_PTR reloc_addr(offset)
  446. LONG offset;
  447. {
  448.    if (offset >= 0)
  449.       return (LONG_PTR)((LONG)curr_fence + offset);
  450.    else if (-(offset+1) <= MAXTRAPS)
  451.       return trap_vector[-(offset+1)];
  452.    else
  453.       return (LONG_PTR)((LONG)curr_fence + offset);
  454. }
  455.  
  456.  
  457. l_E()
  458. {
  459. }
  460.  
  461. l_P()      /* pad only, no operands */
  462. {
  463.    if (GET_DATA(inst_addr, 1))
  464.       quit("incomplete instruction\n");
  465.    inst_addr++;
  466. }
  467.  
  468. l_PSS()    /* pad; operand 1 = 2 bytes; operand 2 = 2 bytes */
  469. {
  470.    if (GET_DATA(inst_addr, 3))
  471.       quit("incomplete instruction\n");
  472.    else {
  473.       inst_addr++;
  474.       fix_bb2(inst_addr);
  475.       inst_addr++;
  476.       fix_bb2(inst_addr);
  477.       inst_addr++;
  478.    }
  479. }
  480.  
  481. l_PC()     /* pad; operand 1 = 4 bytes */
  482. {
  483.    if (GET_DATA(inst_addr, 3))
  484.       quit("incomplete instruction\n");
  485.    else {
  486.       inst_addr++;
  487.       fix_bb4(inst_addr);
  488.       ST_PTRPTRPSC(inst_addr);
  489.       inst_addr += 2;
  490.    }
  491. }
  492.  
  493. l_PL()     /* pad; operand 1 = 4 bytes (number) */
  494. {
  495.    if (GET_DATA(inst_addr, 3))
  496.       quit("incomplete instruction\n"); 
  497.    else {
  498.       inst_addr++;
  499.       fix_bb4(inst_addr);
  500.       inst_addr += 2;
  501.    }
  502. }
  503.  
  504. l_PW()     /* operand 1 = 4 bytes (index) */
  505. {
  506.    if (GET_DATA(inst_addr, 3))
  507.       quit("incomplete instruction\n"); 
  508.    else {
  509.       inst_addr++;
  510.       fix_bb4(inst_addr);
  511.       ST_PTRPSC(inst_addr);
  512.       inst_addr += 2;
  513.    }
  514. }
  515.  
  516. l_PA()     /* operand 1 = 4 bytes (address) */
  517. {
  518.    if (GET_DATA(inst_addr, 3))
  519.       quit("incomplete instruction\n"); 
  520.    else {
  521.       inst_addr++;
  522.       fix_bb4(inst_addr);
  523.       *(LONG_PTR)inst_addr = (LONG)reloc_addr(*(LONG_PTR)inst_addr);
  524.       inst_addr += 2;
  525.    }
  526. }
  527.  
  528. l_PWW()
  529. {
  530. }
  531.  
  532. l_S()      /* operand 1 = 2 bytes */
  533. {
  534.    if (GET_DATA(inst_addr, 1))
  535.       quit("incomplete instruction\n");
  536.    else {
  537.       fix_bb2(inst_addr);
  538.       inst_addr++;
  539.    }
  540. }
  541.  
  542. l_SSS()    /* operands 1, 2 & 3 = 2 bytes */
  543. {
  544.    if (GET_DATA(inst_addr, 3))
  545.       quit("incomplete instruction\n");
  546.    else {
  547.       fix_bb2(inst_addr);
  548.       inst_addr++;
  549.       fix_bb2(inst_addr);
  550.       inst_addr++;
  551.       fix_bb2(inst_addr);
  552.       inst_addr++;
  553.    }
  554. }
  555.  
  556. l_SC()     /* operand 1 = 2 bytes (index); operand 2 = 4 bytes */
  557. {
  558.    if (GET_DATA(inst_addr, 3))
  559.       quit("incomplete instruction\n"); 
  560.    else {
  561.       fix_bb2(inst_addr);
  562.       inst_addr++;
  563.       fix_bb4(inst_addr);
  564.       ST_PTRPTRPSC(inst_addr);
  565.       inst_addr += 2;
  566.    }
  567. }
  568.  
  569. l_SL()     /* operand 1 = 2 bytes (number); operand 2 = 4 bytes (reg) */
  570. {
  571.    if (GET_DATA(inst_addr, 3))
  572.       quit("incomplete instruction\n");
  573.    else {
  574.       fix_bb2(inst_addr);
  575.       inst_addr++;
  576.       fix_bb4(inst_addr);
  577.       inst_addr += 2;
  578.    }
  579. }
  580.  
  581. l_SW()     /* operand 1 = 2 bytes (index); operand 2 = 4 bytes */
  582. {
  583.    if (GET_DATA(inst_addr, 3))
  584.       quit("incomplete instruction\n");
  585.    else {
  586.       fix_bb2(inst_addr);
  587.       inst_addr++;
  588.       fix_bb4(inst_addr);
  589.       ST_PTRPSC(inst_addr);
  590.       inst_addr += 2;
  591.    }
  592. }
  593.  
  594. l_SA()     /* operand 1 = 2 bytes (reg); operand 2 = 4 bytes (address) */
  595. {
  596.    if (GET_DATA(inst_addr, 3))
  597.       quit("incomplete instruction\n"); 
  598.    else {
  599.       fix_bb2(inst_addr);
  600.       inst_addr++;
  601.       fix_bb4(inst_addr);
  602.       *(LONG_PTR *)inst_addr = (LONG_PTR)reloc_addr(*(LONG_PTR)inst_addr);
  603.       inst_addr += 2;
  604.    }
  605. }
  606.  
  607. l_SAA()    /* operand 1 = 2 bytes (reg); operands 2 & 3 = 4 bytes (addr) */ 
  608. {
  609.    if (GET_DATA(inst_addr, 5))
  610.       quit("incomplete instruction\n"); 
  611.    else {
  612.       fix_bb2(inst_addr);
  613.       inst_addr++;
  614.       fix_bb4(inst_addr);
  615.       *(LONG_PTR)inst_addr = (LONG)reloc_addr(*(LONG_PTR)inst_addr);
  616.       inst_addr += 2;
  617.       fix_bb4(inst_addr);
  618.       *(LONG_PTR)inst_addr = (LONG)reloc_addr(*(LONG_PTR)inst_addr);
  619.       inst_addr += 2;
  620.    }
  621. }
  622.  
  623. l_BBW()     /* operands 1 & 2 = 1 byte; operand 3 = 4 bytes */
  624. {
  625.    if (GET_DATA(inst_addr, 3))
  626.       quit("incomplete instruction\n");
  627.    else {
  628.       inst_addr++;
  629.       fix_bb4(inst_addr);
  630.       ST_PTRPSC(inst_addr);
  631.       inst_addr += 2;
  632.    }
  633. }
  634.  
  635. l_BBA()     /* operands 1 & 2 = 1 byte; operand 3 = 4 bytes (address) */
  636. {
  637.    if (GET_DATA(inst_addr, 3))
  638.       quit("incomplete instruction\n"); 
  639.    else {
  640.       inst_addr++;
  641.       fix_bb4(inst_addr);
  642.       *(LONG_PTR *)inst_addr = (LONG_PTR)reloc_addr(*(LONG_PTR)inst_addr);
  643.       inst_addr += 2;
  644.    }
  645. }
  646.  
  647. init_load_routine()
  648. {
  649.    load_routine[ E   ] = l_E;
  650.    load_routine[ P   ] = l_P;
  651.    load_routine[ PSS ] = l_PSS;
  652.    load_routine[ PC  ] = l_PC;
  653.    load_routine[ PL  ] = l_PL;
  654.    load_routine[ PW  ] = l_PW;
  655.    load_routine[ PA  ] = l_PA;
  656.    load_routine[ PWW ] = l_PWW;
  657.  
  658.    load_routine[ S   ] = l_S;
  659.    load_routine[ SSS ] = l_SSS;
  660.    load_routine[ SC  ] = l_SC;
  661.    load_routine[ SL  ] = l_SL;
  662.    load_routine[ SW  ] = l_SW;
  663.    load_routine[ SA  ] = l_SA;
  664.    load_routine[ SAA ] = l_SAA;
  665.    load_routine[ BBW ] = l_BBW;
  666.    load_routine[ BBA ] = l_BBA;
  667. }
  668.  
  669. dyn_loader(psc_ptr)
  670. PSC_REC_PTR psc_ptr;
  671. {
  672.    extern   CHAR_PTR getenv();
  673.    CHAR     s[256], s1[256], s3[256];
  674.    CHAR_PTR s2;
  675.    WORD     i, returnval;
  676.  
  677.    namestring(psc_ptr, s1);
  678.    if (*s1 == '/') 
  679.       return loader(s1);
  680.    else if (*s1 == '.') 
  681.       return loader(s1);
  682.    else {
  683.       /* printf("using dynamic loader! %s\n", s1); */
  684.       s2 = getenv("SIMPATH");
  685.       while (1) {
  686.          while (*s2 == ':' || *s2 == ' ')
  687.         s2++;
  688.          i = 0;
  689.          if (*s2 == '\0')    /* file not found */
  690.             return 1;
  691.          while (*s2 && *s2 != ' ' && *s2 != ':') 
  692.             s[i++] = *s2++;
  693.          s[i++] = '/';
  694.          s[i] = '\0';
  695.          scat(s, s1, s3);
  696.          returnval = loader(s3);
  697.  
  698.          if (returnval == 0)
  699.             return 0;
  700.       }
  701.    }
  702. }
  703.