home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / KAYPRO / SKIPMAP.LBR / MERGEPRL.PZI / MERGEPRL.PLI
Text File  |  2000-06-30  |  5KB  |  252 lines
  1. mergeprl:    procedure options(main);
  2. /* program to interactively patch a PRL file with
  3. a CDL hex file.  Layout is assumed to be standard
  4. PPS system track */
  5.  
  6. declare
  7.     imptr            pointer,
  8.     float_ptr        pointer,
  9.     map_ptr            pointer,
  10.     cmd_ptr            pointer,
  11.  
  12.     command            char(79) varying based(cmd_ptr),
  13.  
  14.  
  15.     i                bin fixed(15),
  16.     j                bin fixed(15),
  17.     k                bin fixed(7),
  18.  
  19.  
  20.     inp                file,
  21.     oup                file,
  22.     patch            file;
  23.  
  24.  
  25.  
  26. /*complete image of the PRL file*/
  27.  
  28. /*slightly different layout of same area of
  29. memory*/
  30.  
  31. declare
  32.     1 sysimg    based(imptr),
  33.         2 pad1            bit(8),        /*place to put lxi b*/
  34.         2 imglen        bin fixed(15),
  35.         2 pad2(253)        bit(8),        /*normal empty page*/
  36.  
  37.         2 data(0:8063)    bit(8);        /* 7K plus bitmap max */
  38.  
  39. declare
  40.     bitmap(0:895)        bit(8)    based(map_ptr);
  41.  
  42.  
  43. declare
  44.     image(8320)    bin fixed(7) based(imptr);
  45.  
  46.  
  47. declare
  48.     1 input_buf            static,
  49.         2 max_buf        bin fixed(7) init(14),
  50.         2 filename        char(14) varying;
  51.  
  52.  
  53. declare
  54.     signon_msg            char(79) static
  55. init('^M^J^JMERGEPRL v1.0 -- Copyright (c) 1985,86 Plu*Perfect Systems$'),
  56.  
  57.     usage_msg            char(128) static
  58. init('^M^JUsage:^M^JMERGEPRL  infile   outfile^M^J^J
  59. Where infile and outfile are standard ORG 0 Digital Research PRL files$'),
  60.  
  61.     bad_wrt_msg            char(79) static
  62. init('^M^JUnable to write PRL file.$'),
  63.  
  64.     bad_rd_msg            char(79) static
  65. init('^M^JUnable to read PRL file.$'),
  66.  
  67.     prompt_msg            char(79) static
  68. init('^M^JEnter name of CDL format REL file to merge: $'),
  69.  
  70.     no_patch_msg        char(79) static
  71. init('^M^J               not found.$');
  72.  
  73. %include 'DIOCON.DCL';
  74.  
  75. /****************************************************/
  76.     call wrstr(addr(signon_msg));
  77.  
  78.  
  79. /*get space for the file image*/
  80.     allocate image set (imptr);
  81.  
  82. /*zero out all the bytes that will be filled in later*/
  83.         do i=1 to 8320;
  84.             image(i)=0;
  85.         end;
  86.  
  87. /* check for ? on command line */
  88.     unspec(cmd_ptr)='0080'b4;
  89.     if index(command,'?') ^= 0 then
  90.     do;
  91.         call wrstr(addr(usage_msg));
  92.         stop;
  93.     end;
  94.  
  95.  
  96.     
  97.     on undefinedfile(inp) begin;
  98.         call wrstr(addr(bad_rd_msg));
  99.         stop;
  100.     end;
  101.  
  102.     open file(inp) record input title('$1.PRL');
  103.     read file(inp) into (image);
  104.  
  105. /* now get length of PRL and position bitmap correctly */
  106.     map_ptr=addr(data(imglen));
  107.     
  108.  
  109. /* now prompt for CDL type REL file to read in and
  110. patch PRL*/
  111.  
  112.     call wrstr(addr(prompt_msg));
  113.     
  114. /* get name of patch file and add REL suffix*/
  115.     call rdbuf(addr(input_buf));
  116.  
  117. /* uppercase file name and add REL if needed */
  118.     do i=1 to length(filename);
  119.         substr(filename,i,1)=uppercase(substr(filename,i,1));
  120.     end;
  121.     if substr(filename,length(filename)-3,4) ^= '.REL' then
  122.         filename=filename!!'.REL';
  123.  
  124. /* patch PRL image with CDL  file */
  125.     call patchit(filename);
  126.  
  127. on undefinedfile(oup) go to badout;
  128. on error(14) go to badout;
  129.  
  130. /*now write out the patched system*/
  131.     open file(oup) record output
  132.                 title('$2.PRL');
  133.     write file(oup) from (image);
  134.     close file(oup);
  135.     stop;
  136.  
  137. badout:
  138.     call wrstr(addr(bad_wrt_msg));
  139.  
  140.         
  141. patchit:    procedure(pfile);
  142. /*procedure to read through current CDL format REL
  143. file and patch the image and bitmap*/
  144. declare
  145.     inchar            char(1),
  146.     pfile            char(14) varying,
  147.     in_rec_length    bit(8),
  148.     record_length    bin fixed(7),
  149.     rel_addr        bit(16),
  150.     rel_base        bit(8),
  151.     record_address    bin fixed(15),
  152.     n                bin fixed(7),
  153.     j                bin fixed(7),
  154.     k                bin fixed(7),
  155.     i                bin fixed(7),
  156.     reloc_byte        bit(8),
  157.     this_address    bin fixed(15),
  158.     this_bit        bin fixed(15),
  159.     prv_bit            bit(1),
  160.     rel_bit            bit(1);
  161.  
  162.  
  163. substr(no_patch_msg,3,14)=pfile;
  164.  
  165. on undefinedfile(patch) begin;
  166.     call wrstr(addr(no_patch_msg));
  167.     stop;
  168. end;
  169.  
  170.  
  171. on endfile(patch) go to finish;
  172.  
  173. open file(patch) stream input
  174.             title(pfile);
  175.  
  176. do while('1'b);
  177.     inchar=' ';
  178.     /*find start of record*/
  179.     do while(inchar^=';');
  180.         get file(patch) edit(inchar)(a(1));
  181.     end;
  182.  
  183.     get file(patch) edit(in_rec_length)(b4(2));
  184.     if in_rec_length = '00'b4 then
  185.             signal endfile(patch);
  186.  
  187.     /*convert from unsigned bit string to number*/
  188.     unspec(record_length)=in_rec_length;
  189.  
  190.     /*now get the address for this record*/
  191.     get file(patch) edit(rel_addr,rel_base)
  192.                     (b4(4),b4(2));
  193.     /*convert to number*/
  194.     unspec(record_address)=rel_addr;
  195.  
  196.  
  197.     /*now loop over relocation bits and data
  198.     till record is exhausted*/
  199.     j=0;    /*actual offset from record base*/
  200.     k=0;    /*bit counter*/
  201.     do    i=1 to record_length;
  202.         if k=0 then
  203.             get file(patch) edit(reloc_byte)(b4(2));
  204.         else
  205.         do;
  206.             /*compute this data byte address*/
  207.             this_address=j+record_address;
  208.             j=j+1;
  209.  
  210.             /*now compute position in the bitmap*/
  211.             this_bit=this_address/8;
  212.             n=mod(this_address,8)+1;
  213.  
  214.  
  215.             get file(patch) edit(data(this_address))
  216.                         (b4(2));
  217.  
  218.             rel_bit=substr(reloc_byte,k,1);
  219.             if  prv_bit = '0'b then
  220.                 substr(bitmap(this_bit),n,1)='0'b;
  221.             else
  222.             do;
  223.                 substr(bitmap(this_bit),n,1)='1'b;
  224.                 prv_bit='0'b;
  225.             end;
  226.  
  227.             if rel_bit ='1'b then
  228.                 prv_bit='1'b;
  229.             else
  230.                 prv_bit='0'b;
  231.                     
  232.         end;
  233.         k=k+1;
  234.         if k > 8 then
  235.             k=0;
  236.     end;
  237.  
  238. end;            
  239. finish:
  240.     close file(patch);
  241. end patchit;
  242.  
  243. /********************************************************/
  244.  
  245. %include 'UPCASE.PLI';
  246.  
  247. end mergeprl;
  248. mber*/
  249.     unspec(record_address)=rel_addr;
  250.  
  251.  
  252.     /*now loop over reloc