mirror of
https://github.com/SEPPDROID/Digital-Research-Source-Code.git
synced 2025-10-24 17:04:19 +00:00
759 lines
20 KiB
Plaintext
759 lines
20 KiB
Plaintext
|
||
/************************************************************
|
||
* 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-
|
||
<product_code>§ wherå <product_code¾ ió á threå digiô
|
||
numbeò whicè correspondó tï thå producô numbeò iî thå
|
||
menu® Thió filå ió loadeä aó aî overlaù oveò thå rooô
|
||
anä copù overlay¬ froí thå defaulô drivå beforå thå
|
||
masteò copù disë ió inserteä */
|
||
dcl
|
||
serial_program char(10);
|
||
|
||
/* direct CP/M call for resetting drives */
|
||
dcl
|
||
curdsk entry returns(fixed bin(7)),
|
||
select entry(fixed bin(7)),
|
||
reset entry;
|
||
|
||
/* determine production control drive */
|
||
ctrl_drive_number = curdsk();
|
||
ctrl_drive = ascii(ctrl_drive_number + 65);
|
||
|
||
/* set up error conditions */
|
||
on error(1)
|
||
begin;
|
||
put skip(2) list
|
||
('Non-Fatal Error in Data Entry. Restarting.');
|
||
put skip(2);
|
||
goto operator_prompt;
|
||
end;
|
||
|
||
/* write banner */
|
||
put page skip(3) edit
|
||
('DIGITAL RESEARCH PRODUCTION SERIALIZER',
|
||
'******* ******** ********** **********')
|
||
(2(x(15),a,skip));
|
||
first_time_flag = true;
|
||
|
||
/* initialize production variables */
|
||
do while(true);
|
||
operator_prompt:
|
||
copy_init_flag = false;
|
||
seri_init_flag = false;
|
||
put skip(5) list('Debugging Diagnostics On (Y or N) ? ');
|
||
get list(response);
|
||
response = upper(response);
|
||
if response = 'Y' then
|
||
debug_flag = true;
|
||
else
|
||
debug_flag = false;
|
||
if debug_flag then
|
||
put skip edit
|
||
('Prod control drive -- ',ctrl_drive,':')
|
||
(a,a(1),a);
|
||
|
||
call display_product_menu;
|
||
put skip(2) list('Product Number ? ');
|
||
get list(prod_number);
|
||
if prod_number = 0 then system_flag = true;
|
||
else if prod_number = 2 then system_flag = true;
|
||
else if prod_number = 4 then system_flag = true;
|
||
else if prod_number = 8 then system_flag = true;
|
||
else if prod_number = 9 then system_flag = true;
|
||
else if prod_number = 10 then system_flag = true;
|
||
else system_flag = false;
|
||
prod_code = convert(prod_number);
|
||
|
||
call media_defaults;
|
||
|
||
put skip list('Origin Number ? ');
|
||
get list(origin_number);
|
||
if origin_number > 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;
|