home *** CD-ROM | disk | FTP | other *** search
/ norge.freeshell.org (192.94.73.8) / 192.94.73.8.tar / 192.94.73.8 / pub / computers / cpm / alphatronic / DRIPAK.ZIP / CPM_3-0 / SOURCES / SERI-002.PLI < prev    next >
Text File  |  1982-12-31  |  7KB  |  250 lines
  1.  
  2.     /* SERIALIZATION FOR CP/M  VERSION 3.0  */
  3.  
  4.     /************************************************************
  5.     * NOTE:  This program contains Digital Research proprietary *
  6.     * information and must not be reproduced, copied, or        *
  7.     * transcribed in any form whatsoever.                       *
  8.     *************************************************************
  9.  
  10.  
  11.  
  12.     COPYRIGHT (C) 1980
  13.     DIGITAL RESEARCH
  14.     BOX 579
  15.     PACIFIC GROVE, CA. 93950    */
  16.  
  17. serial:
  18.     /************************************************************
  19.     *                                                           *
  20.     * áThi≤ prograφ i≤ calleΣ b∙ thσ roo⌠ productioε modulσ t∩  *
  21.     *áád∩á thσ serializatioε oµ CP/M-3.0.á I⌠ use≤ fou≥ágloba∞  *
  22.     *áávariable≤ froφ thσ roo⌠ module║á srce_drive¼ dest_drivσ  *
  23.     *ááorg_number¼ááá anΣáá ser_number«                         *
  24.     *                                     12/30/80 DLD          *
  25.     *                                      8/09/82 DRL          *
  26.     *                                                           *
  27.     ************************************************************/
  28.  
  29.     proc;
  30.     %replace
  31.         TRUE          by '1'b,
  32.         FALSE         by '0'b,
  33.         invalid_address by 66,
  34.         max_programs by 18,
  35.         too_many_programs by 68;
  36.  
  37.     /* global variables */
  38.     dcl
  39.         (srce_drive char(1),
  40.         dest_drive char(1),
  41.         seri_init_flag bit(1),
  42.         debug_flag bit(1),
  43.         org_number bit(16),
  44.         ser_number bit(16)) external;
  45.  
  46.     /* local variables */
  47.     dcl
  48.         k fixed bin(7),
  49.         name char(12),
  50.         number_of_programs fixed bin(7),
  51.         data file,
  52.         end_of_file bit(1),
  53.         line char(80) varying,
  54.         patchrecord fixed bin(15),
  55.         patchbyte fixed bin(15),
  56.         patch file,
  57.         product_code bit(8) static initial('00'b4);
  58.  
  59.     /* serialization data structure */
  60.     dcl
  61.         1 serial(max_programs),
  62.             2 filename char(12) varying,
  63.             2 byteoffset bit(16);
  64.  
  65.     /* initialize serialization data if flag is false */
  66.     if ^seri_init_flag then
  67.         begin;
  68.  
  69.         on endfile(data)
  70.         begin;
  71.             number_of_programs = k - 1;
  72.             end_of_file = true;
  73.             end;
  74.  
  75.         on error(too_many_programs)
  76.         begin;
  77.             put skip list
  78.             ('FATAL ERROR -- Too Many Programs To Be Serialized.');
  79.             put skip edit
  80.             ('This program needs to be recompiled with the ',
  81.              'following change:','the constant "max_programs" ',
  82.              'needs to be set to a greater number -- probably ',
  83.              max_programs+5,' will do.')
  84.             (a,a,skip,x(5),a,a,f(2),a);
  85.             stop;
  86.             end;
  87.  
  88.         seri_init_flag = true;
  89.         open file(data) stream input title('SERI-002.DAT');
  90.         end_of_file = false;
  91.         do k = 1 repeat(k + 1)  while(^end_of_file);
  92.         get file(data) edit (line) (a);
  93.         if ^end_of_file then
  94.         do;
  95.         if k > max_programs then signal error(too_many_programs);
  96.         serial(k).filename = substr(line,1,12);
  97.         serial(k).byteoffset = hex_to_bit(substr(line,17,1))||
  98.                                hex_to_bit(substr(line,18,1))||
  99.                                hex_to_bit(substr(line,19,1))||
  100.                                hex_to_bit(substr(line,20,1));
  101.         if debug_flag then
  102.         do;
  103.         /* display header for diagnostics */
  104.         put skip(2) edit
  105.         (' Serialization Diagnostics: ')
  106.         (column(24),a);
  107.         put skip edit
  108.         ('File: ',serial(k).filename,
  109.          'Byte: ',serial(k).byteoffset)
  110.         (a,x(1),a,x(1),a,x(1),b4);
  111.         end;        /* debug diagnostics */
  112.         end;        /* ^end_of_file */
  113.         end;        /* do -- repeat -- while  loop */
  114.         close file(data);
  115.  
  116.         /* message to operator */
  117.         put skip(3) list
  118.         ('The files to be serialized for this product are:');
  119.         put skip(2) edit
  120.         ((serial(k).filename do k = 1 to number_of_programs))
  121.         (5(a(12),x(4)),skip);
  122.         return;
  123.         end;        /* serial initialization */
  124.  
  125.     /* error conditions */
  126.     on undefinedfile(patch)
  127.         begin;
  128.         put skip list
  129.         (name, ' NOT serialized');
  130.         k = k + 1;
  131.         goto loop;
  132.         end;
  133.  
  134.     /* serialization loop */
  135.     k = 1;
  136.     loop:
  137.     do while(k <= number_of_programs);
  138.     name = serial(k).filename;
  139.  
  140.     /* initialize remaining variables */
  141.     patchrecord = binary(substr(serial(k).byteoffset,1,9));
  142.     patchbyte = binary(serial(k).byteoffset & '007F'b4);
  143.  
  144.     open file(patch) input title(dest_drive || ':' || name);
  145.     close file(patch);
  146.     open file(patch) direct update env(f(128),b(128))
  147.         title(dest_drive  || ':' || name);
  148.  
  149.     call serialize_6;
  150.  
  151.     put skip list
  152.     (name, ' has been serialized');
  153.     close file(patch);
  154.     k = k + 1;
  155.     end;
  156.  
  157.     serialize_6:
  158.     /************************************************************
  159.     *                                                           *
  160.     *  This procedure does a standard consecutive six byte      *
  161.     *  serialization using the variables patchrecord, patchbyte *
  162.     *  org_number, ser_number, and patch(file).                 *
  163.     *                                                           *
  164.     ************************************************************/
  165.  
  166.     proc;
  167.     dcl
  168.         i fixed bin(7),
  169.         patch_byte(6) bit(8),
  170.         test_byte(6) bit(8) static
  171.             initial('36'b4,'35'b4,'34'b4,'33'b4,'32'b4,'31'b4),
  172.         p ptr,
  173.         serial_byte(2) bit(8) based(p),
  174.         q ptr,
  175.         origin_byte(2) bit(8) based(q);
  176.  
  177.     /* patch buffer */
  178.     dcl
  179.         1 record,
  180.             2 byte(0:127) bit(8);
  181.  
  182.     /* set error conditions */
  183.     on error(invalid_address)
  184.         begin;
  185.         put skip(2) list('FATAL ERROR: INVALID SERIAL ADDRESS');
  186.         put skip edit
  187.         ('File: ',name,
  188.         'Record: ',patchrecord,'Byte: ',patchbyte)
  189.          (a,a,skip,a,f(6),x(3),a,f(6));
  190.         stop;
  191.         end;
  192.  
  193.     /* set serial number bytes */
  194.     p = addr(ser_number);
  195.     q = addr(org_number);
  196.     patch_byte(1) = origin_byte(1);        /* low order byte */
  197.     patch_byte(2) = product_code;
  198.     patch_byte(3) = origin_byte(2);        /* high order byte */
  199.     patch_byte(4) = '00'b4;
  200.     patch_byte(5) = serial_byte(2);
  201.     patch_byte(6) = serial_byte(1);
  202.  
  203.     /* read patchrecord into buffer and set serial byte */
  204.     do i = 1 to 6;
  205.     if debug_flag then
  206.     do;
  207.     put skip edit
  208.     ('patchrecord: ',patchrecord,
  209.      'patchbyte:   ',patchbyte)
  210.     (a,f(5),skip);
  211.     end;
  212.     read file(patch) into(record) key(patchrecord);
  213.  
  214.     if record.byte(patchbyte) ^= test_byte(i) then
  215.         signal error(invalid_address);
  216.  
  217.     record.byte(patchbyte) = patch_byte(i);
  218.  
  219.     /* write buffer back to file */
  220.     write file(patch) from(record) keyfrom(patchrecord);
  221.     patchbyte = patchbyte + 1;
  222.     patchrecord = patchrecord + patchbyte/128;
  223.     patchbyte = mod(patchbyte,128);
  224.     end;
  225.     end serialize_6;
  226.  
  227.     hex_to_bit:
  228.     proc(xc) returns(bit(4));
  229.     dcl
  230.         xc char(1),
  231.         xi fixed bin(7),
  232.         hex(16) bit(4) static initial
  233.         ('0000','0001','0010','0011',
  234.          '0100','0101','0110','0111',
  235.          '1000','1001','1010','1011',
  236.          '1100','1101','1110','1111'),
  237.         list char(16) static initial
  238.         ('0123456789ABCDEF');
  239.     xi = index(list,xc);
  240.     if xi = 0 then
  241.         do;
  242.         put skip list('INVALID HEX CHARACTER:');
  243.     signal error(1);
  244.     end;
  245.     else
  246.     return(hex(xi));
  247.     end hex_to_bit;
  248.  
  249. end serial;
  250.