/************************************************************ * NOTE: This program contains Digital Research proprietary * * information and must not be reproduced, copied, or * * transcribed in any form whatsoever. * ************************************************************* COPYRIGHT (C) 1981 DIGITAL RESEARCH BOX 579 PACIFIC GROVE, CA. 93950 */ prod_root: /*********************************************************** * * *  Thió  modulå  ió thå rooô modulå foò  controllinç  thå * *  productioî  anä  serializatioî oæ  alì  products®  Iô * *  calló   overlayó  tï  dï  thå  serializatioî  oæ  each * *  product¬  thuó allowinç foò individuaì optimizatioî oæ * *  thå  desigî oæ thå serializatioî  process®  Thå  rooô * *  modulå  containó  globaì variableó anä promptó tï  thå * *  operatoò foò productioî information. * * * ***********************************************************/ proc options(main); %replace true by '1'b, false by '0'b; /* global variables */ dcl (srce_drive char(1), dest_drive char(1), debug_flag bit(1), sec_per_trk fixed bin(15), copy_init_flag bit(1), seri_init_flag bit(1), org_number bit(16), ser_number bit(16)) external; /* local variables */ dcl ctrl_drive char(1), ctrl_drive_number fixed bin(7), srce_drive_number fixed bin(7), dest_drive_number fixed bin(7), first_time_flag bit(1), prod_number fixed bin(7), media_number fixed bin(7), prod_code char(3), response char(1), number_of_products fixed bin(7), system_flag bit(1), phy_sector_size fixed bin(15), skew_factor fixed bin(15), origin_number fixed dec(8,0), serial_number fixed dec(8,0), one_decimal fixed dec(1,0) static initial(1), initial_serial_number fixed dec(8,0), final_serial_number fixed dec(8,0); /* thå  serializatioî prograí calleä ió determineä bù thå    producô  numbeò  selecteä  bù thå  operatoò  froí  thå    producô  menu¬  anä  musô  havå  thå  filenamå  'SERI-    § wherå 65535 then signal error(1); put skip list('Starting Serial Number ? '); get list(initial_serial_number); if initial_serial_number > 65535 then signal error(1); put skip list('Final Serial Number ? '); get list(final_serial_number); if final_serial_number > 65535 | final_serial_number < initial_serial_number then signal error(1); put skip list('Source Drive ? '); get list(srce_drive); srce_drive = upper(srce_drive); srce_drive_number = rank(srce_drive) - 65; if srce_drive_number < 0 | srce_drive_number > 15 then signal error(1); put skip list('Destination Drive ? '); get list(dest_drive); dest_drive = upper(dest_drive); dest_drive_number = rank(dest_drive) - 65; if dest_drive_number < 0 | dest_drive_number > 15 then signal error(1); /* cancel ON ERROR(1) condition */ revert error(1); /* load serialization overlay */ serial_program = ctrl_drive || ':' || 'SERI-' || prod_code; call load_overlay(serial_program); /* initialize serialization program before inserting master copy disk in current default drive */ /* return with seri_init_flag set to true */ call overlay(serial_program); /* insert master copy disk */ put skip(3) list ('Insert Product Master Disk in Drive ' || srce_drive || ': and Type RETURN'); get skip(2); call reset(); /* initialize copy segment from dpb of master disk */ /* return with copy_init_flag set to true */ call copy_routine; /* convert origin number */ org_number = dec8_to_bit16((origin_number)); /* copy and serialization loop */ do serial_number = initial_serial_number to final_serial_number by one_decimal; ser_number = dec8_to_bit16((serial_number)); put skip(3) edit ('Preparing to copy and serialize ',origin_number,' - ',serial_number) (a,f(5)); put skip(2) list ('Insert new diskette in drive ' || dest_drive || ': and type RETURN'); get skip; call reset(); call copy_routine; call overlay(serial_program); end; /* reselect and reinitialize production drive */ if ctrl_drive = srce_drive | ctrl_drive = dest_drive then do; put skip(2) list ('Insert Production Control Disk in Drive ' || ctrl_drive || ': and type RETURN'); get skip; call reset(); end; call select(ctrl_drive_number); first_time_flag = false; end; /* while loop */ /* utilities for root module */ display_product_menu: /* readó  thå PRODUCT.DAÔ filå anä associateó  witè  eacè    producô  á  producô  numbeò whicè ió selecteä  bù  thå    operatoò tï determinå productioî */ proc; dcl product file, end_of_file bit(1), product_name char(78) varying, i fixed bin(7); /* set return condition */ on endfile(product) begin; i = i - 1; number_of_products = i; end_of_file = true; end; /* open data file */ open file(product) stream input title(ctrl_drive||':'||'PRODUCT.DAT'); /* display product menu */ end_of_file = false; put skip(2) edit ('PRODUCT LIST','******* ****') (2(x(7),a,skip)); put skip; do i = 1 repeat(i + 1) while(^end_of_file); get file(product) list(product_name); if ^end_of_file then put skip list(product_name); end; close file(product); end display_product_menu; media_defaults: /* displays the current defaults of the skew table and asks if the user would like to change any of the values */ proc; phy_sector_size = 1; skew_factor = 2; put skip(2) edit ('The current default values for the skew table are:', 'Logical Sectors Per Physical Sector : ',phy_sector_size, 'Physical Skew Factor : ',skew_factor, 'Do you want to change these values (Y or N) ? ') (a,skip(2),a,f(2),skip,a,f(2),skip(2),a); get list(response); response = upper(response); if response = 'Y' then do; put skip list ('New value for Logical Sectors Per Physical Sector ? '); get list(phy_sector_size); put list('New Value for Physical Skew Factor ? '); get list(skew_factor); end; end media_defaults; convert: /* converts integer to char string with leading zeros */ proc(x) returns(char(3)); dcl c char(9), x fixed bin(7), y fixed bin(15); y = x; y = y + 1000; c = char(y); return(substr(c,7,3)); end convert; load_overlay: /* loads .OVL file with drive and filename in 'name' */ proc(name); dcl ?ovlay entry(char(10),fixed bin(1)), name char(10); call ?ovlay(name,0); end load_overlay; overlay: /* used to call .OVL file which has been loaded */ proc(name); dcl ?ovlay entry(char(10), fixed bin(1)), dummy entry, name char(10); call ?ovlay(name,0); call dummy; end overlay; dec8_to_bit16: /* converts dec(8,0) to bit(16) */ proc(dec_number) returns(bit(16)); dcl dec_number fixed dec(8,0), signed_binary fixed dec(8,0) static initial(32768), sign_bit bit(1), bit_string bit(16); if dec_number >= signed_binary then do; dec_number = dec_number - signed_binary; sign_bit = '1'b; end; else sign_bit = '0'b; substr(bit_string,2) = binary(dec_number,15); substr(bit_string,1,1) = sign_bit; return(bit_string); end dec8_to_bit16; upper: /* converts char(1) to upper case */ proc(x) returns(char(1)); dcl x char(1); return(translate(x,'ABCDEFGHIJKLMNOPQRSTUVWXYZ', 'abcdefghijklmnopqrstuvwxyz')); end upper; copy_routine: proc; /*********************************************************** * * * Thió tracë tï tracë copù witè verifù routinå ió calleä * *  bù   thå  rooô  productioî  modulå  witè  thå   globaì * *  variableó  froí  thå rooô module®  Iô setó itó  locaì * *  variableó froí thå disë parameteò blocë oæ thå  sourcå * *  disk¬   anä   ió   thuó  intendeä  tï  bå  aó   easilù * *  transportablå aó possible® * * 01/07/81 DLD * * 07/07/82 DRL * * * ***********************************************************/ /* global variable for the serialize_hex routines of the serializing programs. */ dcl sector_offset fixed bin(15) external; /* local variables */ dcl disk_buffering bit(1), /* T = copy whole disk into RAM F = copy a few tracks at a time */ disk_buff_diagnos char(3), k fixed bin(7), default_DMA_ptr ptr, default_DMA char(128) based(default_DMA_ptr), order fixed bin(15), sector fixed bin(15), track_series fixed bin(15), track fixed bin(15), max_track fixed bin(15), initial_track fixed bin(15), final_track fixed bin(15), number_of_tracks fixed bin(15), words_per_buffer fixed bin(15), tpb fixed bin(15), /* tracks per buffer */ log_sectors_per_track fixed bin(15), phy_sectors_per_track fixed bin(15); /* copy utilities */ /* direct cp/m functions */ dcl seldsk entry (fixed(7)) returns (ptr), settrk entry (fixed(15)), setsec entry (fixed(15)), bstdma entry (ptr), bflush entry, rdsec entry returns (fixed(7)), wrsec entry returns (fixed(7)), sectrn entry (fixed(15),ptr) returns (fixed(15)); dcl memptr entry returns (ptr), memsiz entry returns (fixed(15)), memwds entry returns (fixed(15)), dfcb0 entry returns (ptr), dfcb1 entry returns (ptr), dbuff entry returns (ptr), reboot entry, rdcon entry returns (char(1)), wrcon entry (char(1)), rdrdr entry returns (char(1)), wrpun entry (char(1)), wrlst entry (char(1)), coninp entry returns (char(1)), conout entry (char(1)), rdstat entry returns (bit(1)), getio entry returns (bit(8)), setio entry (bit(8)), wrstr entry (ptr), rdbuf entry (ptr), break entry returns (bit(1)), vers entry returns (bit(16)), reset entry, select entry (fixed(7)), open entry (ptr) returns (fixed(7)), close entry (ptr) returns (fixed(7)), sear entry (ptr) returns (fixed(7)), searn entry returns (fixed(7)), delete entry (ptr), rdseq entry (ptr) returns (fixed(7)), wrseq entry (ptr) returns (fixed(7)), make entry (ptr) returns (fixed(7)), rename entry (ptr), logvec entry returns (bit(16)), curdsk entry returns (fixed(7)), setdma entry (ptr), allvec entry returns (ptr), wpdisk entry, rovec entry returns (bit(16)), filatt entry (ptr), getdpb entry returns (ptr), getusr entry returns (fixed(7)), setusr entry (fixed(7)), rdran entry (ptr) returns (fixed(7)), wrran entry (ptr) returns (fixed(7)), filsiz entry (ptr), setrec entry (ptr), resdrv entry (bit(16)), wrranz entry (ptr) returns (fixed(7)); /* dynamic storage management */ dcl maxwds entry returns(fixed bin(15)), allwds entry(fixed bin(15)) returns(ptr); /* skew table */ dcl skew_table_ptr ptr, skew_table(0:0) fixed bin(15) based(skew_table_ptr); /* sector translation table */ dcl dph ptr, /* disk parameter header */ XLT_ptr ptr based(dph); /* buffer management */ dcl (buff_ptr, cbuff_ptr) ptr, buffer(0:0) char(128) based(buff_ptr), compare_buffer(0:0) char(128) based(cbuff_ptr); /* allocation vector */ dcl alloc_ptr ptr, alloc(1:1) bit(8) based(alloc_ptr); /* disk parameter table */ dcl dpb_ptr ptr, 1 dpb based(dpb_ptr), 2 spt fixed bin(15), 2 bsh fixed bin(7), 2 blm fixed bin(7), 2 exm fixed bin(7), 2 dsm fixed bin(15), 2 drm fixed bin(15), 2 fill bit(16), 2 cks fixed bin(15), 2 off fixed bin(7); /* initialization */ if ^copy_init_flag then do; copy_init_flag = true; /* free previously allocated storage? */ if ^first_time_flag then do; free skew_table_ptr -> skew_table; free buff_ptr -> buffer; free cbuff_ptr -> compare_buffer; end; default_DMA_ptr = dbuff(); call select(srce_drive_number); dph = seldsk(curdsk()); sector_offset = sectrn(0,XLT_ptr); dpb_ptr = getdpb(); sec_per_trk = spt; alloc_ptr = allvec(); log_sectors_per_track = spt; phy_sectors_per_track = log_sectors_per_track / phy_sector_size; /* initialize skew table */ order = phy_sectors_per_track / gcd(skew_factor,phy_sectors_per_track); skew_table_ptr = allwds(log_sectors_per_track); do sector = 0 to log_sectors_per_track - 1; skew_table(sector) = log_skew(sector) + sector_offset; end; number_of_tracks = calculate(srce_drive_number); if system_flag then initial_track = 0; else initial_track = off; final_track = off + number_of_tracks - 1; tpb = min(calc_trk_buf(),final_track-initial_track+1); if (tpb < 1) then do; puô skið(4) lisô ('Insufficienô Buffeò Space to Perform Track Copying'); put skip(3); stop; end; /* allocate space for the buffers */ words_per_buffer = 64 * spt * tpb; buff_ptr = allwds(words_per_buffer); if ^disk_buffering then cbuff_ptr = allwds(words_per_buffer); /* message to operator */ put skip(2) edit ('Final track to copy: ',final_track)(a,f(6)); if debug_flag then do; put skip(2) list('Debugging Diagnostics:'); if disk_buffering = true then disk_buff_diagnos = 'Yes'; else disk_buff_diagnos = ' No'; put skip edit ('Number of log sec per trk: ',log_sectors_per_track, 'Number of phy sec per trk: ',phy_sectors_per_track, 'Buffering entire disk ? : ',disk_buff_diagnos, 'First track to copy: ',initial_track, 'Tracks per buffer: ',tpb, 'Sector offset: ',sector_offset, 'Skew factor: ',skew_factor, 'Skew table:') (2(a,f(6),skip),a,x(3),a,skip,4(a,f(6),skip),a); put skip edit ((skew_table(sector) do sector = 0 to log_sectors_per_track - 1)) (15f(5),skip); end; return; end; /* of initialization */ /* track to track copy */ put skip; do track_series = initial_track to final_track by tpb; max_track = min(track_series+tpb-1, final_track); put skip(0) edit ('Copying tracks: ',track_series,' - ',max_track) (a,column(20),f(3),a,f(3)); /* read the source tracks if necessary */ if ^disk_buffering | serial_number = initial_serial_number then do; call select(srce_drive_number); do track = track_series to max_track; call settrk(track); /* fill buffer from source */ do sector = 0 to log_sectors_per_track - 1; call bstdma(addr(buffer(sub(track,sector)))); call setsec(skew_table(sector)); if rdsec() ^= 0 then do; put skip list('Fatal Read Error on Source'); return; end; end; /* do sector */ end; /* do track */ end; /* if ^disk_buffering ... */ call select(dest_drive_number); do track = track_series to max_track; call settrk(track); /* write buffer to destination */ do sector = 0 to log_sectors_per_track - 1; call bstdma(addr(buffer(sub(track,sector)))); call setsec(skew_table(sector)); if wrsec() ^= 0 then do; put skip list('Fatal Write Error on Destination'); return; end; end; /* reread and compare destination with source */ if disk_buffering then do; /* fill default DMA from destination for verification */ call bstdma(default_DMA_ptr); do sector = 0 to log_sectors_per_track - 1; call setsec(skew_table(sector)); if rdsec() ^= 0 then do; put skip list('Fatal Read Error on Destination'); return; end; /* compare and verify buffers */ if default_DMA ^= buffer(sub(track,sector)) then do; put skip(2) edit ('Verify Error on Track ',track,' Sector ',sector) (2(a,f(3))); return; end; end; /* do sector */ end; /* if disk_buffering */ else do; /* fill compare buffer for verification from destination */ do sector = 0 to log_sectors_per_track - 1; call bstdma(addr(compare_buffer(sub(track,sector)))); call setsec(skew_table(sector)); if rdsec() ^= 0 then do; put skip list('Fatal Read Error on Destination'); return; end; end; /* fill compare buffer */ /* compare buffers */ do sector = 0 to log_sectors_per_track - 1; if buffer(sub(track,sector)) ^= compare_buffer(sub(track,sector)) then do; put skip(2) edit ('Verify Error on Track ',track,' Sector ',sector) (2(a,f(3))); return; end; end; /* compare buffers */ end; /* else disk_buffering */ end; /* do track */ end; /* do track_series */ /* force deblocking buffers to be flushed */ call bflush(); /* reset directory in memory */ call reset(); put skip; log_skew: proc(x) returns(fixed bin(15)); dcl (i,j) fixed bin(15), x fixed bin(15); j = mod(x, phy_sector_size); i = (x - j) / phy_sector_size; i = phy_skew(i); return(i * phy_sector_size + j); end log_skew; phy_skew: proc(x) returns(fixed bin(15)); dcl (i,j) fixed bin(15), x fixed bin(15); i = mod(x,order); j = (x - i) / order; i = mod(i * skew_factor, phy_sectors_per_track); return(i + j); end phy_skew; calculate: proc(x) returns(fixed bin(15)); dcl (i,j) fixed bin(15), x fixed bin(7), return_value fixed bin(15), current_drive fixed bin(7), old_dpb_ptr ptr, old_alloc_ptr ptr; current_drive = curdsk(); if current_drive ^= x then do; old_dpb_ptr = dpb_ptr; old_alloc_ptr = alloc_ptr; call select(x); dpb_ptr = getdpb(); alloc_ptr = allvec(); end; i = ceil(float(dsm+1) / 8.0); do i = i to 1 by -1 while(alloc(i) = '00'b4); end; do j = 8 to 1 by -1 while(substr(alloc(i),j,1)='0'b); end; return_value = ceil(float((((i-1)*8)+j)*(blm+1))/float(spt)); if current_drive ^= x then do; dpb_ptr = old_dpb_ptr; alloc_ptr = old_alloc_ptr; call select(current_drive); end; return(return_value); end calculate; calc_trk_buf: proc returns(fixed bin(15)); dcl tracks_to_copy fixed bin(15), max_tracks fixed bin(15); tracks_to_copy = final_track - initial_track + 1; max_tracks = maxwds() / (64*spt); if max_tracks >= tracks_to_copy then disk_buffering = true; else disk_buffering = false; if ^disk_buffering then max_tracks = max_tracks / 2; /* for track pairs */ return(max_tracks); end calc_trk_buf; sub: /* calculates the subscript to the buffer */ proc(track,sector) returns(fixed bin(15)); dcl (track,sector) fixed bin(15); return((track-track_series)*spt + sector); end sub; gcd: proc(m,n) returns(fixed bin(15)) recursive; /* greatest common divisor */ dcl (m,n) fixed bin(15); iæ (í ¼ 0© theî í ½ -m; if (n < 0) then n = -n; if (m = 0) then return(n); if (n = 0) then return(m); if (m > n) then return(gcd(mod(m,n),n)); return(gcd(m,mod(n,m))); end gcd; end copy_routine; end prod_root;