|
DataMuseum.dkPresents historical artifacts from the history of: Bogika Butler |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Bogika Butler Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 14208 (0x3780)
Types: TextFile
Names: »VC-006.INC«
└─⟦398ae89d3⟧ Bits:30009789/_.ft.Ibm2.50007353.imd Mogens Pelles Zilog 80,000 / EOS projekt
└─⟦this⟧ »VC-006.INC«
(******************************************************************************)
(* *)
(* *)
(* This file contains parts of the *)
(* source text for program VERSACON *)
(* *)
(* Copyright (C) 1985 by Lars G. Jakobsen and Metanic Aps. *)
(* *)
(* *)
(******************************************************************************)
(******************************************************************************)
(* *)
(* MAIN PROCEDURES *)
(* *)
(******************************************************************************)
PROCEDURE primary_entry(VAR status: status_type
;VAR error_out: text
;VAR print_out: text
;VAR v_file: v_file_type
;VAR pde: pde_type
; first_file_no: integer
;VAR current_file_no: integer
; path_name: path_name_type
);
VAR
c_file_name: c_file_name_type; (* name of c_file *)
c_file: c_file_type; (* cp/m file to write *)
lsn_current: psn_type; (* current logical sector number *)
lrn_current: psn_type; (* current logical record number *)
lbn_current: psn_type; (* current logical byte number *)
flk_psn: psn_type; (* psn of next fab *)
x_psn: psn_type; (* temporary *)
BEGIN (* primary_entry *)
WITH pde DO
BEGIN
IF test( (.t_5.) ) THEN
BEGIN
write(test_out, '= = PDE = = ');
write(test_out, ' CURR. FILE NO: ', current_file_no:6);
write(test_out, ' ATT: ', hex_2(att) );
write(test_out, ' FS: '); write_psn(test_out, fs);
write(test_out, ' FE: '); write_psn(test_out, fe);
write(test_out, ' EOF: '); write_psn(test_out, pde.eof);
write(test_out, ' EOR: '); write_psn(test_out, eor);
write(test_out, ' FAB: ', fab);
write(test_out, ' DAT: ', dat);
writeln(test_out);
END;
IF ord( fil(.1.) ) <> 0 (* entry used *) THEN
BEGIN
current_file_no := current_file_no + 1;
IF current_file_no > first_file_no THEN
BEGIN
open_c_file(status, error_out, c_file, c_file_name, fil, ext);
IF status = succes THEN
BEGIN
lsn_current := minus_1_psn;
lrn_current := minus_1_psn;
lbn_current := minus_1_psn;
flk_psn := fs;
print_pre_file(status, print_out, current_file_no
, fil, ext, c_file_name);
CASE (att mod 4) OF
0: (* contiguous *)
writeln(error_out, '*** "Contiguous files" ',
'ikke implementeret.');
1: (* sequential Variable + Fixed *)
BEGIN
writeln(error_out, '*** "Sequential file" ',
'*** ADVARSEL ***');
IF equal_16(lrl, null_16) THEN
BEGIN
WHILE (status = succes) and
not equal_psn(flk_psn, null_psn) DO
fab_3(status, error_out,
v_file, c_file, flk_psn,
lsn_current, lrn_current);
END
END;
2: (* Keyed ISAM No duplicate keys *)
writeln(error_out, '*** "Keyed ISAM files ',
'(no duplicate keys)" ',
'ikke implementeret.');
3: (* Keyed ISAM Duplicate + Null keys *)
IF (key = 0) and equal_16(lrl, null_16) THEN
BEGIN
WHILE (status = succes) and
not equal_psn(flk_psn, null_psn) DO
fab_3(status, error_out,
v_file, c_file, flk_psn,
lsn_current, lrn_current);
END
END; (* case *)
close(c_file);
IF status <> succes THEN
writeln(error_out, '*** Fejl under kopiering ***');
IF not equal_psn(lrn_current, pde.eor) THEN
BEGIN
write(error_out, '*** Ukorrekt antal poster kopieret ');
write(error_out, '*** EOR LSN: ');
write_psn(error_out, pde.eor);
writeln(error_out);
END;
IF equal_psn(lsn_current, pde.eof) = false THEN
BEGIN
write(error_out, '*** Ukorrekt antal sektorer kopieret ');
write(error_out, '*** EOF LSN: ');
write_psn(error_out, pde.eof);
writeln(error_out);
END;
sum_32_i(lrn_current, 1);
sum_32_i(lsn_current, 1);
print_post_file(status, print_out, lsn_current, lrn_current);
IF test( (.t_8 .) ) THEN
IF current_file_no > 0 THEN
status := exit;
END
END
END
END
END; (* primary_entry *)
PROCEDURE primary(VAR status: status_type
;VAR error_out: text
;VAR print_out: text
;VAR v_file: v_file_type
;VAR pdp_psn: psn_type
; first_file_no: integer
;VAR current_file_no: integer
; path_name: path_name_type
);
VAR
pdb: block_type; (* current pdb *)
pde_number: 0..20; (* index of pde in pdb *)
BEGIN (* primary *)
pdb.kind := pdb_tag;
get_block(status, error_out, v_file, pdp_psn, recs_per_pdb, pdb);
WITH pdb.pdb DO
BEGIN
IF test( (.t_4.) ) THEN
BEGIN
write(test_out, '= = PDB = = ');
write_status(test_out, status);
write(test_out, ' PDP: '); write_psn(test_out, fpt);
write(test_out, ' CURR. FILE NO: ', current_file_no:6);
writeln(test_out);
END;
IF status = succes THEN
BEGIN
path_name.pdb_clg := clg;
print_dir(status, print_out, path_name);
pdp_psn := fpt;
pde_number := 1;
WHILE (status = succes) and
(ord( pde(.pde_number.).fil(.1.) ) <> 0 ) and
(pde_number <= 20) DO
BEGIN
primary_entry(status, error_out, print_out, v_file,
pde(.pde_number.),
first_file_no, current_file_no, path_name);
pde_number := pde_number + 1;
END
END
END
END; (* primary *)
PROCEDURE secondary_entry(VAR status: status_type
;VAR error_out: text
;VAR print_out: text
;VAR v_file: v_file_type
;VAR sde: sde_type
; first_file_no: integer
;VAR current_file_no: integer
; path_name: path_name_type
);
VAR
pdp_psn: psn_type; (* psn of next PDB *)
BEGIN (* secondary_entry *)
WITH sde DO
BEGIN
IF test( (.t_3.) ) THEN
BEGIN
write(test_out, '= SDE = = = ');
write_status(test_out, status);
write(test_out, ' PDP: '); write_psn(test_out, pdp);
write(test_out, ' CURR. FILE NO: ', current_file_no:4);
write(test_out, ' CLG: ', clg:8);
writeln(test_out);
END;
path_name.sdb_clg := clg;
pdp_psn := pdp;
WHILE (status = succes) and not equal_psn(pdp_psn, null_psn) DO
primary(status, error_out, print_out, v_file, pdp_psn,
first_file_no, current_file_no, path_name);
END
END; (* secondary_entry *)
PROCEDURE secondary(VAR status: status_type
;VAR error_out: text
;VAR print_out: text
;VAR v_file: v_file_type
;VAR sds_psn: psn_type
; first_file_no: integer
;VAR current_file_no: integer
; path_name: path_name_type
);
VAR
sdb: block_type; (* current sdb *)
sde_number: 0..15; (* index of sde in sdb *)
BEGIN (* secondary *)
sdb.kind := sdb_tag;
get_block(status, error_out, v_file, sds_psn, recs_per_sdb, sdb);
WITH sdb.sdb DO
BEGIN
IF test( (.t_2.) ) THEN
BEGIN
write(test_out, '=SDB= = = = ');
write_status(test_out, status);
write(test_out, ' FPT: '); write_psn(test_out, fpt);
write(test_out, ' CURR. FILE NO: ', current_file_no);
writeln(test_out);
END;
IF status = succes THEN
BEGIN
sds_psn := fpt;
sde_number := 1;
WHILE (status = succes) and
not equal_psn( sde(.sde_number.).pdp, null_psn ) and
(sde_number <= 15) DO
BEGIN
secondary_entry(status, error_out, print_out, v_file,
sde(.sde_number.),
first_file_no, current_file_no, path_name);
sde_number := sde_number + 1;
END
END
END
END; (* secondary *)
PROCEDURE volume(VAR status: status_type
;VAR error_out: text
;VAR print_out: text
;VAR oper_in: text
;VAR oper_out: text
);
VAR
vid: block_type; (* current and only vid *)
sds_psn: psn_type; (* psn of next sdb *)
v_file: v_file_type; (* CP/M source file holding
Versados file system *)
v_file_name: c_file_name_type; (* name of v_file *)
first_file_no: integer; (* name of first file to convert.
Files numbered 0... *)
current_file_no: integer; (* number of current file *)
usr_vidvol: string_4; (* Volume label stated by operator
to be verified against volume *)
vid_vol: text_4; (* volume label of volume *)
path_name: path_name_type; (* path name of current file *)
BEGIN (* volume *)
vid.kind := vid_tag;
operator(status, oper_in, oper_out, v_file, v_file_name,
first_file_no, usr_vidvol);
IF status = succes THEN
BEGIN
get_block(status, error_out, v_file, null_psn, recs_per_vid, vid);
WITH vid.vid DO
BEGIN
IF test( (.t_1.) ) THEN
BEGIN
END;
IF status = succes THEN
IF vol = usr_vidvol THEN
BEGIN
print_header(status, print_out, v_file_name, first_file_no);
path_name.vol := vol;
path_name.usn := usn;
current_file_no := 0;
sds_psn := sds;
WHILE (status = succes) and
not equal_psn(sds_psn, null_psn) DO
secondary(status, error_out, print_out, v_file, sds_psn,
first_file_no, current_file_no, path_name);
IF test( (.t_1,t_2,t_3,t_4,t_5,t_6,t_7,t_8,t_9,t_10.) ) THEN
BEGIN
write(test_out, 'VOL 2 = = = ');
write_status(test_out,status);
writeln(test_out);
END;
print_footer(status, oper_out,
current_file_no - first_file_no);
print_footer(status, print_out,
current_file_no - first_file_no);
END
ELSE
writeln(error_out, '*** Uoverensstemmende "Volume-ids". ',
'VID.VOL = ', vol);
close(v_file)
END
END
END; (* volume *)
«eof»