|
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: 10240 (0x2800)
Types: TextFile
Names: »VC-006.BAK«
└─⟦ec7c10e12⟧ Bits:30009789/_.ft.Ibm2.50007351.imd Mogens Pelles Zilog 80,000 / EOS projekt
└─⟦this⟧ »VC-006.BAK«
(******************************************************************************)
(* *)
(* MAIN PROCEDURES II *)
(* *)
(******************************************************************************)
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 *)
BEGIN (* primary_entry *)
WITH pde DO
BEGIN
IF test( (.t_3.) ) 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, ' FPT: ');
write_psn(test_out, fpt);
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
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 ',
'not implemented.');
1: (* sequential Variable + Fixed *)
writeln(error_out, 'Sequential files ',
'not implemented.');
2: (* Keyed ISAM No duplicate keys *)
writeln(error_out, 'Keyed ISAM files ',
'(no duplicate keys) ',
'not implemented.');
3: (* Keyed ISAM Duplicate + Null keys *)
IF (key = 0) and (lrl =0) THEN
WHILE (status = succes) and
not equal_psn(fs, null_psn) DO
BEGIN
isam_dup(status, error_out,
v_file, c_file,
fs, pde.eof, eor, fab, dat);
END
END; (* case *)
close_erase_c_file(status, error_out, c_file,
status <> succes);
(* print_post_file(status, print_out, recs, bytes);*)
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
; 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, pdb_psn, recs_per_pdb, pdb);
IF status = succes THEN
WITH pdb.pdb DO
BEGIN
path_name.pdb_clg := clg;
print_dir(status, print_out, path_name);
pdb_psn := fpt;
pde_number := 0;
WHILE (status = succes) and (pde_number < 20) DO
BEGIN
pde_number := pde_number + 1;
primary_entry(status, error_out, print_out, v_file,
pde(.pde_number.),
first_file_no,, current_file_no, path_name)
END
END
IF test( (.t_2,t_3.) ) THEN
BEGIN
write(test_out, '=== primary > ===');
write_status(test_out, status);
write(test_out, ' CURR. FILE NO: ', current_file_no:6);
writeln(test_out);
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
);
BEGIN (* secondary_entry *)
WITH sde DO
BEGIN
IF test( (.t_2.) ) THEN
BEGIN
write(test_out, '=== secondary-1 ===');
(* write(test_out, ' SDE NUMBER: ', sde_number);
*) write(test_out, ' PDP: '); write_psn(test_out, pdp);
write(test_out, ' CLG: ', clg:8);
write(test_out, ' FPT: '); write_psn(test_out, fpt);
writeln(test_out);
END;
path_name.sdb_clg := clg;
WHILE (status = succes) and not equal_psn(pdp, null_psn) DO
primary(status, error_out, print_out, v_file, pdp,
first_file_no, current_file_no, path_name);
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);
IF status = succes THEN
WITH sdb.sdb DO
BEGIN
sds_psn := fpt;
sde_number := 0;
WHILE (sde_number < 15) and (status = succes) DO
BEGIN
sde_number := sde_number + 1;
secondary_entry(status, error_out, print_out, v_file,
sde(.sde_number.),
first_file_no, current_file_no, path_name)
END
END;
IF test( (.t_1,t_2.) ) THEN
BEGIN
write(test_out, '=== secondary > ===');
write_status(test_out, status);
write(test_out, ' CURR. FILE NO: ', current_file_no);
writeln(test_out);
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_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 *)
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);
IF test( (.t_1.) ) THEN
BEGIN
write(test_out, '=== volume-1 ===');
write_status(test_out,status);
write(test_out, ' vid.vol: ', vid.vid.vol:4);
writeln(test_out);
END;
IF status = succes THEN
WITH vid.vid DO
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 := vid.vid.sds;
WHILE (status = succes) and not equal_psn(sds, null_psn) DO
secondary(status, error_out, print_out, v_file, sds,
first_file_no, current_file_no, path_name);
writeln(oper_out, current_file_no - 1, ' files transferred.');
print_footer(status, print_out, current_file_no);
END
ELSE
writeln(error_out, 'conflicting volume identifier.')
END
END; (* volume *)
«eof»