head     56.3;
access   paws bayes jws quist brad dew jwh;
symbols  ;
locks    ; strict;
comment  @# @;


56.3
date     93.01.27.13.17.22;  author jwh;  state Exp;
branches ;
next     56.2;

56.2
date     93.01.27.11.58.42;  author jwh;  state Exp;
branches ;
next     56.1;

56.1
date     91.11.05.09.54.29;  author jwh;  state Exp;
branches ;
next     55.1;

55.1
date     91.08.25.10.29.53;  author jwh;  state Exp;
branches ;
next     54.3;

54.3
date     91.08.21.10.34.17;  author jwh;  state Exp;
branches ;
next     54.2;

54.2
date     91.08.21.09.38.59;  author jwh;  state Exp;
branches ;
next     54.1;

54.1
date     91.03.18.15.31.53;  author jwh;  state Exp;
branches ;
next     53.1;

53.1
date     91.03.11.19.31.46;  author jwh;  state Exp;
branches ;
next     52.1;

52.1
date     91.02.19.09.16.26;  author jwh;  state Exp;
branches ;
next     51.1;

51.1
date     91.01.30.16.16.02;  author jwh;  state Exp;
branches ;
next     50.1;

50.1
date     90.10.29.16.30.28;  author jwh;  state Exp;
branches ;
next     49.1;

49.1
date     90.08.14.14.14.14;  author jwh;  state Exp;
branches ;
next     48.1;

48.1
date     90.07.26.11.20.32;  author jwh;  state Exp;
branches ;
next     47.1;

47.1
date     90.05.14.11.05.02;  author dew;  state Exp;
branches ;
next     46.1;

46.1
date     90.05.07.08.52.02;  author jwh;  state Exp;
branches ;
next     45.1;

45.1
date     90.04.19.16.00.02;  author jwh;  state Exp;
branches ;
next     44.1;

44.1
date     90.04.01.22.17.08;  author jwh;  state Exp;
branches ;
next     43.1;

43.1
date     90.03.20.14.09.36;  author jwh;  state Exp;
branches ;
next     42.1;

42.1
date     90.01.23.17.54.02;  author jwh;  state Exp;
branches ;
next     41.1;

41.1
date     89.12.22.11.36.17;  author jwh;  state Exp;
branches ;
next     40.1;

40.1
date     89.09.29.11.57.25;  author jwh;  state Exp;
branches ;
next     39.1;

39.1
date     89.09.26.16.42.11;  author dew;  state Exp;
branches ;
next     38.1;

38.1
date     89.08.29.11.34.05;  author jwh;  state Exp;
branches ;
next     37.1;

37.1
date     89.05.12.11.47.49;  author dew;  state Exp;
branches ;
next     36.1;

36.1
date     89.02.06.10.25.29;  author dew;  state Exp;
branches ;
next     35.1;

35.1
date     89.02.02.13.40.52;  author dew;  state Exp;
branches ;
next     34.1;

34.1
date     89.01.23.16.16.07;  author jwh;  state Exp;
branches ;
next     33.1;

33.1
date     89.01.16.11.47.38;  author dew;  state Exp;
branches ;
next     32.1;

32.1
date     89.01.10.11.56.40;  author bayes;  state Exp;
branches ;
next     31.1;

31.1
date     88.12.14.18.17.41;  author bayes;  state Exp;
branches ;
next     30.1;

30.1
date     88.12.09.13.54.43;  author dew;  state Exp;
branches ;
next     29.1;

29.1
date     88.10.31.15.39.21;  author bayes;  state Exp;
branches ;
next     28.1;

28.1
date     88.10.06.11.05.44;  author dew;  state Exp;
branches ;
next     27.1;

27.1
date     88.09.29.11.48.20;  author bayes;  state Exp;
branches ;
next     26.3;

26.3
date     88.09.28.13.31.05;  author bayes;  state Exp;
branches ;
next     26.2;

26.2
date     88.09.28.13.30.55;  author bayes;  state Exp;
branches ;
next     26.1;

26.1
date     88.09.28.13.30.44;  author bayes;  state Exp;
branches ;
next     24.1;

24.1
date     87.08.31.10.10.56;  author jws;  state Exp;
branches ;
next     23.1;

23.1
date     87.08.26.10.53.51;  author bayes;  state Exp;
branches ;
next     22.1;

22.1
date     87.08.17.11.35.25;  author bayes;  state Exp;
branches ;
next     21.1;

21.1
date     87.08.12.14.19.20;  author bayes;  state Exp;
branches ;
next     20.1;

20.1
date     87.07.30.11.31.10;  author bayes;  state Exp;
branches ;
next     19.1;

19.1
date     87.06.01.08.43.40;  author jws;  state Exp;
branches ;
next     18.1;

18.1
date     87.05.20.15.49.54;  author bayes;  state Exp;
branches ;
next     17.1;

17.1
date     87.04.30.10.55.08;  author jws;  state Exp;
branches ;
next     16.1;

16.1
date     87.04.26.16.05.46;  author jws;  state Exp;
branches ;
next     15.1;

15.1
date     87.04.13.09.45.14;  author jws;  state Exp;
branches ;
next     14.1;

14.1
date     87.04.01.15.53.51;  author jws;  state Exp;
branches ;
next     13.1;

13.1
date     87.02.28.18.49.14;  author jws;  state Exp;
branches ;
next     12.1;

12.1
date     87.02.02.13.41.47;  author jws;  state Exp;
branches ;
next     11.1;

11.1
date     87.01.19.10.08.29;  author jws;  state Exp;
branches ;
next     10.1;

10.1
date     86.12.24.11.23.11;  author jws;  state Exp;
branches ;
next     9.1;

9.1
date     86.12.12.15.06.02;  author bayes;  state Exp;
branches ;
next     8.1;

8.1
date     86.11.27.12.17.09;  author jws;  state Exp;
branches ;
next     7.1;

7.1
date     86.11.20.14.26.08;  author hal;  state Exp;
branches ;
next     6.1;

6.1
date     86.11.04.18.22.08;  author paws;  state Exp;
branches ;
next     5.1;

5.1
date     86.10.28.17.09.31;  author hal;  state Exp;
branches ;
next     4.1;

4.1
date     86.09.30.20.06.00;  author hal;  state Exp;
branches ;
next     3.1;

3.1
date     86.09.01.12.16.18;  author hal;  state Exp;
branches ;
next     2.1;

2.1
date     86.07.30.15.05.20;  author hal;  state Exp;
branches ;
next     1.1;

1.1
date     86.06.30.16.29.15;  author danm;  state tmp;
branches ;
next     ;


desc
@Base file for PWS 3.2 release.

@


56.3
log
@
pws2rcs automatic delta on Wed Jan 27 13:14:25 MST 1993
@
text
@$debug off$
$ucsd,modcal$

program export_text(input,output);

const
	vidleng = 7;
	tidleng = 15;
	fblksize = 512;

type
	byte = 0..255;
	shortint = -32768..32767;

	filekind = (UNTYPEDFILE,XDSKFILE,CODEFILE,TEXTFILE,
		    fkind4,DATAFILE,fkind6,fkind7,fkind8);

	errcode  = (ERRLIBREAD, ERRMODDIRREAD, ERRDIRSIZE, ERRDIRWRITE,
		    ERRCOPYREAD, ERRCOPYWRITE, ERRLIBWRITE);

	dirrange = 0..235;
	string255 = string[255];

	dirptr = ^moduledirectory;
	fdirptr = ^filedirectory;
	entryptr = ^direntry;
	strptr = ^string255;

	vid = string[vidleng];
	tid = string[tidleng];

	daterec = packed record
		  year: 0..127;
		  day : 0..31;
		  month: 0..12;
		  end;

	direntry = record
		   dfirstblk: shortint;
		   dlastblk:  shortint;
		   case dfkind: filekind of

		   UNTYPEDFILE:
			(dvid: vid;
			 deovblk: shortint;
			 dnumfiles: dirrange;
			 dloadtime: shortint;
			 dlastboot: daterec);

		   XDSKFILE,CODEFILE,TEXTFILE,DATAFILE:
			(dtid: tid;
			 dlastbyte: 1..fblksize;
			 daccess: daterec)

		   end;

	moduledirectory = packed record
		date: daterec;
		revision: daterec;
		producer: char;
		systemid: byte;
		notice: string[80];
		directorysize: integer;
		modulesize: integer;
		executable: boolean;
		relocatablesize, relocatablebase: integer;
		globalsize, globalbase: integer;
		extblock, extsize: integer;
		defblock, defsize : integer;
		sourceblock, sourcesize : integer;
		textrecords: integer;
	      { mname: string [ (variable) ];        }
	      { startaddress: gvr;   (if executable) }
	      { repeat for each text record          }
	      {     textstart,textsize : integer;    }
	      {     refstart,refsize : integer;      }
	      {     loadaddress: gvr;                }
		end;

	addrec = record
		 case integer of
		 1: (i:integer);
		 2: (a:integer);
		 3: (p:^integer);
		 4: (m:dirptr);
		 5: (e:entryptr);
		 6: (l:fdirptr);
		 7: (s:strptr);
		 end;

	filedirectory = array[dirrange] of direntry;

var
	infile, outfile : file;
	infile_name, outfile_name : string[40];
	position : integer;
	errstr : string[80];
	libptr : addrec;
	lib_blks : integer;
	module_count : dirrange;
	total_blocks : integer;

$page$
function read_libdirectory(var libptr : addrec; var module_count : dirrange) : integer;

var
	start : addrec;
	blk_cnt, lib_blks : integer;


procedure getbytes $alias 'asm_newbytes'$ (var p : anyptr; bytes : integer); external;

begin
		mark(start.p);
		getbytes(libptr.p, fblksize);

		blk_cnt := blockread(infile, libptr.p^, 1, 0);
		if (blk_cnt <> 1) or (ioresult <> 0) then escape(ord(ERRLIBREAD));

		lib_blks := libptr.e^.dlastblk;

		release(start.p);
		getbytes(libptr.p, lib_blks * fblksize);

		blk_cnt := blockread(infile, libptr.p^, lib_blks, 0);
		if (blk_cnt <> lib_blks) or (ioresult <> 0) then escape(ord(ERRLIBREAD));
		module_count := libptr.e^.dnumfiles;

		read_libdirectory := lib_blks;

end;

$page$

function read_module_directory(start_block : integer; modptr : addrec) : integer;

var
	blk_cnt, diff : integer;
	tmp_ptr : addrec;

begin

		blk_cnt := blockread(infile, modptr.p^, 1, start_block);
		if (blk_cnt <> 1) or (ioresult <> 0) then escape(ord(ERRMODDIRREAD));

		tmp_ptr.a := modptr.a + sizeof(moduledirectory);
		tmp_ptr.a := tmp_ptr.a + length(tmp_ptr.s^) +
			     2 + ord(odd(length(tmp_ptr.s^)));

		diff := tmp_ptr.a - modptr.a;
		if diff > fblksize then escape(ord(ERRDIRSIZE));

		read_module_directory := diff;
end;

$page$
procedure update_module_directory(mdirp : addrec; start_block, dir_size, ext_blks : integer);

var
	blk_cnt, blks : integer;

begin
	with mdirp.m^ do
		begin
		directorysize := dir_size;
		modulesize := (ext_blks + 1) * fblksize;
		executable := false;
		relocatablesize := 0;
		relocatablebase := 0;
		globalsize := 0;
		globalbase := 0;
		extblock := 0;
		extsize := 0;
		defblock := 0;
		defsize := 0;
		sourceblock := 1;
		textrecords := 0;
		end;

	blks := (dir_size + fblksize -1) div fblksize;

	blk_cnt := blockwrite(outfile, mdirp.p^, blks, start_block);
	if (blk_cnt <> blks) or (ioresult <> 0) then escape(ord(ERRDIRWRITE));

end;

$page$
procedure copy_export_text(start_block, number_of_blocks, output_start : integer);

var
	blk_cnt : integer;
	start, bufptr  : addrec;

procedure getbytes $alias 'asm_newbytes'$ (var p : anyptr; bytes : integer); external;

begin
	mark(start.p);
	getbytes(bufptr.p, number_of_blocks * fblksize);

	blk_cnt := blockread(infile, bufptr.p^, number_of_blocks, start_block);
	if (blk_cnt <> number_of_blocks) or (ioresult <> 0) then escape(ord(ERRCOPYREAD));

	blk_cnt := blockwrite(outfile, bufptr.p^, number_of_blocks, output_start);
	if (blk_cnt <> number_of_blocks) or (ioresult <> 0) then escape(ord(ERRCOPYWRITE));

	release(start.p);

end;

$page$
procedure process_modules(libptr : addrec; module_count : dirrange;
			  var total_blocks : integer; offset : integer);

var
	entry : dirrange;
	current_position : integer;
	export_blocks : integer;
	module_directory_size : integer;
	new_firstblk : integer;
	export_offset : integer;
	mdirp : addrec;
	directory_buffer : packed array[1..fblksize] of char;

begin
	total_blocks := 0;
	current_position := offset;
	mdirp.p := addr(directory_buffer);

	for entry := 1 to module_count do
		with libptr.l^[entry] do
		begin
		if dfkind = CODEFILE then
			begin
			writeln(output,'MODULE ',dtid);

			module_directory_size := read_module_directory(dfirstblk,mdirp);

			export_blocks := (mdirp.m^.sourcesize + fblksize - 1) div fblksize;

		    { save export relative start and output file    }
		    { position before updating the module directory }

			export_offset := mdirp.m^.sourceblock;
			new_firstblk := current_position;

			update_module_directory(mdirp, current_position,
					       module_directory_size, export_blocks);

			current_position := current_position +
					    (module_directory_size + fblksize - 1) div fblksize;

			copy_export_text(dfirstblk + export_offset,
					 export_blocks, current_position);

			current_position := current_position + export_blocks;

		    { update library directory entry with new start and  }
		    { end blocks.  set dlast to fblksize always.         }

			dfirstblk := new_firstblk;
			dlastblk := current_position;
			dlastbyte := fblksize;

		    { keep a running total of blocks written to output file }
		    { used to update dlastblk in library directory entry 0  }

			total_blocks := total_blocks +
					(module_directory_size + fblksize - 1) div fblksize +
					export_blocks;
			end
		else
			writeln(output,'ILLEGAL TYPE : ',ord(dfkind));
		end;
end;

$page$
procedure write_libdirectory(libptr : addrec; module_blocks, lib_blks : integer);

var
	blk_cnt : integer;

begin
	libptr.l^[0].dlastblk := total_blocks;

	blk_cnt := blockwrite(outfile, libptr.p^, lib_blks, 0);
	if (blk_cnt <> lib_blks) or (ioresult <> 0) then escape(ord(ERRLIBWRITE));

end;


begin
	try
		begin
		write(output,'input file: ');
		readln(input,infile_name);

		reset(infile,infile_name);
		if ioresult <> 0 then escape(escapecode);

		write(output,'output file: ');
		readln(input,outfile_name);

		position := pos('.CODE',outfile_name);
		if position = 0 then
			outfile_name := concat(outfile_name,'.CODE');

		rewrite(outfile,outfile_name);
		if ioresult <> 0 then escape(escapecode);

		lib_blks := read_libdirectory(libptr, module_count);

		process_modules(libptr, module_count, total_blocks, lib_blks);

		write_libdirectory(libptr,total_blocks, lib_blks);

		close(outfile,'lock');

		end;

	recover
		begin

		case escapecode of
		ord(ERRLIBREAD):        errstr := 'Error reading library directory';
		ord(ERRMODDIRREAD):     errstr := 'Error reading module directory';
		ord(ERRDIRSIZE):        errstr := 'Module directory > 512 bytes';
		ord(ERRDIRWRITE):       errstr := 'Error writing module directory';
		ord(ERRCOPYREAD):       errstr := 'Error reading export text';
		ord(ERRCOPYWRITE):      errstr := 'Error writing export text';
		ord(ERRLIBWRITE):       errstr := 'Error writing library directory';
		otherwise               escape(escapecode);
		end;

		writeln(output,errstr);
		end;

end.





@


56.2
log
@
pws2rcs automatic delta on Wed Jan 27 11:57:27 MST 1993
@
text
@d1 342
@


56.1
log
@Automatic bump of revision number for PWS version 3.25
@
text
@a0 342
$debug off$
$ucsd,modcal$

program export_text(input,output);

const
	vidleng = 7;
	tidleng = 15;
	fblksize = 512;

type
	byte = 0..255;
	shortint = -32768..32767;

	filekind = (UNTYPEDFILE,XDSKFILE,CODEFILE,TEXTFILE,
		    fkind4,DATAFILE,fkind6,fkind7,fkind8);

	errcode  = (ERRLIBREAD, ERRMODDIRREAD, ERRDIRSIZE, ERRDIRWRITE,
		    ERRCOPYREAD, ERRCOPYWRITE, ERRLIBWRITE);

	dirrange = 0..235;
	string255 = string[255];

	dirptr = ^moduledirectory;
	fdirptr = ^filedirectory;
	entryptr = ^direntry;
	strptr = ^string255;

	vid = string[vidleng];
	tid = string[tidleng];

	daterec = packed record
		  year: 0..127;
		  day : 0..31;
		  month: 0..12;
		  end;

	direntry = record
		   dfirstblk: shortint;
		   dlastblk:  shortint;
		   case dfkind: filekind of

		   UNTYPEDFILE:
			(dvid: vid;
			 deovblk: shortint;
			 dnumfiles: dirrange;
			 dloadtime: shortint;
			 dlastboot: daterec);

		   XDSKFILE,CODEFILE,TEXTFILE,DATAFILE:
			(dtid: tid;
			 dlastbyte: 1..fblksize;
			 daccess: daterec)

		   end;

	moduledirectory = packed record
		date: daterec;
		revision: daterec;
		producer: char;
		systemid: byte;
		notice: string[80];
		directorysize: integer;
		modulesize: integer;
		executable: boolean;
		relocatablesize, relocatablebase: integer;
		globalsize, globalbase: integer;
		extblock, extsize: integer;
		defblock, defsize : integer;
		sourceblock, sourcesize : integer;
		textrecords: integer;
	      { mname: string [ (variable) ];        }
	      { startaddress: gvr;   (if executable) }
	      { repeat for each text record          }
	      {     textstart,textsize : integer;    }
	      {     refstart,refsize : integer;      }
	      {     loadaddress: gvr;                }
		end;

	addrec = record
		 case integer of
		 1: (i:integer);
		 2: (a:integer);
		 3: (p:^integer);
		 4: (m:dirptr);
		 5: (e:entryptr);
		 6: (l:fdirptr);
		 7: (s:strptr);
		 end;

	filedirectory = array[dirrange] of direntry;

var
	infile, outfile : file;
	infile_name, outfile_name : string[40];
	position : integer;
	errstr : string[80];
	libptr : addrec;
	lib_blks : integer;
	module_count : dirrange;
	total_blocks : integer;

$page$
function read_libdirectory(var libptr : addrec; var module_count : dirrange) : integer;

var
	start : addrec;
	blk_cnt, lib_blks : integer;


procedure getbytes $alias 'asm_newbytes'$ (var p : anyptr; bytes : integer); external;

begin
		mark(start.p);
		getbytes(libptr.p, fblksize);

		blk_cnt := blockread(infile, libptr.p^, 1, 0);
		if (blk_cnt <> 1) or (ioresult <> 0) then escape(ord(ERRLIBREAD));

		lib_blks := libptr.e^.dlastblk;

		release(start.p);
		getbytes(libptr.p, lib_blks * fblksize);

		blk_cnt := blockread(infile, libptr.p^, lib_blks, 0);
		if (blk_cnt <> lib_blks) or (ioresult <> 0) then escape(ord(ERRLIBREAD));
		module_count := libptr.e^.dnumfiles;

		read_libdirectory := lib_blks;

end;

$page$

function read_module_directory(start_block : integer; modptr : addrec) : integer;

var
	blk_cnt, diff : integer;
	tmp_ptr : addrec;

begin

		blk_cnt := blockread(infile, modptr.p^, 1, start_block);
		if (blk_cnt <> 1) or (ioresult <> 0) then escape(ord(ERRMODDIRREAD));

		tmp_ptr.a := modptr.a + sizeof(moduledirectory);
		tmp_ptr.a := tmp_ptr.a + length(tmp_ptr.s^) +
			     2 + ord(odd(length(tmp_ptr.s^)));

		diff := tmp_ptr.a - modptr.a;
		if diff > fblksize then escape(ord(ERRDIRSIZE));

		read_module_directory := diff;
end;

$page$
procedure update_module_directory(mdirp : addrec; start_block, dir_size, ext_blks : integer);

var
	blk_cnt, blks : integer;

begin
	with mdirp.m^ do
		begin
		directorysize := dir_size;
		modulesize := (ext_blks + 1) * fblksize;
		executable := false;
		relocatablesize := 0;
		relocatablebase := 0;
		globalsize := 0;
		globalbase := 0;
		extblock := 0;
		extsize := 0;
		defblock := 0;
		defsize := 0;
		sourceblock := 1;
		textrecords := 0;
		end;

	blks := (dir_size + fblksize -1) div fblksize;

	blk_cnt := blockwrite(outfile, mdirp.p^, blks, start_block);
	if (blk_cnt <> blks) or (ioresult <> 0) then escape(ord(ERRDIRWRITE));

end;

$page$
procedure copy_export_text(start_block, number_of_blocks, output_start : integer);

var
	blk_cnt : integer;
	start, bufptr  : addrec;

procedure getbytes $alias 'asm_newbytes'$ (var p : anyptr; bytes : integer); external;

begin
	mark(start.p);
	getbytes(bufptr.p, number_of_blocks * fblksize);

	blk_cnt := blockread(infile, bufptr.p^, number_of_blocks, start_block);
	if (blk_cnt <> number_of_blocks) or (ioresult <> 0) then escape(ord(ERRCOPYREAD));

	blk_cnt := blockwrite(outfile, bufptr.p^, number_of_blocks, output_start);
	if (blk_cnt <> number_of_blocks) or (ioresult <> 0) then escape(ord(ERRCOPYWRITE));

	release(start.p);

end;

$page$
procedure process_modules(libptr : addrec; module_count : dirrange;
			  var total_blocks : integer; offset : integer);

var
	entry : dirrange;
	current_position : integer;
	export_blocks : integer;
	module_directory_size : integer;
	new_firstblk : integer;
	export_offset : integer;
	mdirp : addrec;
	directory_buffer : packed array[1..fblksize] of char;

begin
	total_blocks := 0;
	current_position := offset;
	mdirp.p := addr(directory_buffer);

	for entry := 1 to module_count do
		with libptr.l^[entry] do
		begin
		if dfkind = CODEFILE then
			begin
			writeln(output,'MODULE ',dtid);

			module_directory_size := read_module_directory(dfirstblk,mdirp);

			export_blocks := (mdirp.m^.sourcesize + fblksize - 1) div fblksize;

		    { save export relative start and output file    }
		    { position before updating the module directory }

			export_offset := mdirp.m^.sourceblock;
			new_firstblk := current_position;

			update_module_directory(mdirp, current_position,
					       module_directory_size, export_blocks);

			current_position := current_position +
					    (module_directory_size + fblksize - 1) div fblksize;

			copy_export_text(dfirstblk + export_offset,
					 export_blocks, current_position);

			current_position := current_position + export_blocks;

		    { update library directory entry with new start and  }
		    { end blocks.  set dlast to fblksize always.         }

			dfirstblk := new_firstblk;
			dlastblk := current_position;
			dlastbyte := fblksize;

		    { keep a running total of blocks written to output file }
		    { used to update dlastblk in library directory entry 0  }

			total_blocks := total_blocks +
					(module_directory_size + fblksize - 1) div fblksize +
					export_blocks;
			end
		else
			writeln(output,'ILLEGAL TYPE : ',ord(dfkind));
		end;
end;

$page$
procedure write_libdirectory(libptr : addrec; module_blocks, lib_blks : integer);

var
	blk_cnt : integer;

begin
	libptr.l^[0].dlastblk := total_blocks;

	blk_cnt := blockwrite(outfile, libptr.p^, lib_blks, 0);
	if (blk_cnt <> lib_blks) or (ioresult <> 0) then escape(ord(ERRLIBWRITE));

end;


begin
	try
		begin
		write(output,'input file: ');
		readln(input,infile_name);

		reset(infile,infile_name);
		if ioresult <> 0 then escape(escapecode);

		write(output,'output file: ');
		readln(input,outfile_name);

		position := pos('.CODE',outfile_name);
		if position = 0 then
			outfile_name := concat(outfile_name,'.CODE');

		rewrite(outfile,outfile_name);
		if ioresult <> 0 then escape(escapecode);

		lib_blks := read_libdirectory(libptr, module_count);

		process_modules(libptr, module_count, total_blocks, lib_blks);

		write_libdirectory(libptr,total_blocks, lib_blks);

		close(outfile,'lock');

		end;

	recover
		begin

		case escapecode of
		ord(ERRLIBREAD):        errstr := 'Error reading library directory';
		ord(ERRMODDIRREAD):     errstr := 'Error reading module directory';
		ord(ERRDIRSIZE):        errstr := 'Module directory > 512 bytes';
		ord(ERRDIRWRITE):       errstr := 'Error writing module directory';
		ord(ERRCOPYREAD):       errstr := 'Error reading export text';
		ord(ERRCOPYWRITE):      errstr := 'Error writing export text';
		ord(ERRLIBWRITE):       errstr := 'Error writing library directory';
		otherwise               escape(escapecode);
		end;

		writeln(output,errstr);
		end;

end.





@


55.1
log
@Automatic bump of revision number for PWS version 3.25A
@
text
@@


54.3
log
@
pws2rcs automatic delta on Wed Aug 21 10:27:27 MDT 1991
@
text
@@


54.2
log
@
pws2rcs automatic delta on Wed Aug 21 09:35:48 MDT 1991
@
text
@d1 342
@


54.1
log
@Automatic bump of revision number for PWS version 3.24
@
text
@a0 342
$debug off$
$ucsd,modcal$

program export_text(input,output);

const
	vidleng = 7;
	tidleng = 15;
	fblksize = 512;

type
	byte = 0..255;
	shortint = -32768..32767;

	filekind = (UNTYPEDFILE,XDSKFILE,CODEFILE,TEXTFILE,
		    fkind4,DATAFILE,fkind6,fkind7,fkind8);

	errcode  = (ERRLIBREAD, ERRMODDIRREAD, ERRDIRSIZE, ERRDIRWRITE,
		    ERRCOPYREAD, ERRCOPYWRITE, ERRLIBWRITE);

	dirrange = 0..235;
	string255 = string[255];

	dirptr = ^moduledirectory;
	fdirptr = ^filedirectory;
	entryptr = ^direntry;
	strptr = ^string255;

	vid = string[vidleng];
	tid = string[tidleng];

	daterec = packed record
		  year: 0..127;
		  day : 0..31;
		  month: 0..12;
		  end;

	direntry = record
		   dfirstblk: shortint;
		   dlastblk:  shortint;
		   case dfkind: filekind of

		   UNTYPEDFILE:
			(dvid: vid;
			 deovblk: shortint;
			 dnumfiles: dirrange;
			 dloadtime: shortint;
			 dlastboot: daterec);

		   XDSKFILE,CODEFILE,TEXTFILE,DATAFILE:
			(dtid: tid;
			 dlastbyte: 1..fblksize;
			 daccess: daterec)

		   end;

	moduledirectory = packed record
		date: daterec;
		revision: daterec;
		producer: char;
		systemid: byte;
		notice: string[80];
		directorysize: integer;
		modulesize: integer;
		executable: boolean;
		relocatablesize, relocatablebase: integer;
		globalsize, globalbase: integer;
		extblock, extsize: integer;
		defblock, defsize : integer;
		sourceblock, sourcesize : integer;
		textrecords: integer;
	      { mname: string [ (variable) ];        }
	      { startaddress: gvr;   (if executable) }
	      { repeat for each text record          }
	      {     textstart,textsize : integer;    }
	      {     refstart,refsize : integer;      }
	      {     loadaddress: gvr;                }
		end;

	addrec = record
		 case integer of
		 1: (i:integer);
		 2: (a:integer);
		 3: (p:^integer);
		 4: (m:dirptr);
		 5: (e:entryptr);
		 6: (l:fdirptr);
		 7: (s:strptr);
		 end;

	filedirectory = array[dirrange] of direntry;

var
	infile, outfile : file;
	infile_name, outfile_name : string[40];
	position : integer;
	errstr : string[80];
	libptr : addrec;
	lib_blks : integer;
	module_count : dirrange;
	total_blocks : integer;

$page$
function read_libdirectory(var libptr : addrec; var module_count : dirrange) : integer;

var
	start : addrec;
	blk_cnt, lib_blks : integer;


procedure getbytes $alias 'asm_newbytes'$ (var p : anyptr; bytes : integer); external;

begin
		mark(start.p);
		getbytes(libptr.p, fblksize);

		blk_cnt := blockread(infile, libptr.p^, 1, 0);
		if (blk_cnt <> 1) or (ioresult <> 0) then escape(ord(ERRLIBREAD));

		lib_blks := libptr.e^.dlastblk;

		release(start.p);
		getbytes(libptr.p, lib_blks * fblksize);

		blk_cnt := blockread(infile, libptr.p^, lib_blks, 0);
		if (blk_cnt <> lib_blks) or (ioresult <> 0) then escape(ord(ERRLIBREAD));
		module_count := libptr.e^.dnumfiles;

		read_libdirectory := lib_blks;

end;

$page$

function read_module_directory(start_block : integer; modptr : addrec) : integer;

var
	blk_cnt, diff : integer;
	tmp_ptr : addrec;

begin

		blk_cnt := blockread(infile, modptr.p^, 1, start_block);
		if (blk_cnt <> 1) or (ioresult <> 0) then escape(ord(ERRMODDIRREAD));

		tmp_ptr.a := modptr.a + sizeof(moduledirectory);
		tmp_ptr.a := tmp_ptr.a + length(tmp_ptr.s^) +
			     2 + ord(odd(length(tmp_ptr.s^)));

		diff := tmp_ptr.a - modptr.a;
		if diff > fblksize then escape(ord(ERRDIRSIZE));

		read_module_directory := diff;
end;

$page$
procedure update_module_directory(mdirp : addrec; start_block, dir_size, ext_blks : integer);

var
	blk_cnt, blks : integer;

begin
	with mdirp.m^ do
		begin
		directorysize := dir_size;
		modulesize := (ext_blks + 1) * fblksize;
		executable := false;
		relocatablesize := 0;
		relocatablebase := 0;
		globalsize := 0;
		globalbase := 0;
		extblock := 0;
		extsize := 0;
		defblock := 0;
		defsize := 0;
		sourceblock := 1;
		textrecords := 0;
		end;

	blks := (dir_size + fblksize -1) div fblksize;

	blk_cnt := blockwrite(outfile, mdirp.p^, blks, start_block);
	if (blk_cnt <> blks) or (ioresult <> 0) then escape(ord(ERRDIRWRITE));

end;

$page$
procedure copy_export_text(start_block, number_of_blocks, output_start : integer);

var
	blk_cnt : integer;
	start, bufptr  : addrec;

procedure getbytes $alias 'asm_newbytes'$ (var p : anyptr; bytes : integer); external;

begin
	mark(start.p);
	getbytes(bufptr.p, number_of_blocks * fblksize);

	blk_cnt := blockread(infile, bufptr.p^, number_of_blocks, start_block);
	if (blk_cnt <> number_of_blocks) or (ioresult <> 0) then escape(ord(ERRCOPYREAD));

	blk_cnt := blockwrite(outfile, bufptr.p^, number_of_blocks, output_start);
	if (blk_cnt <> number_of_blocks) or (ioresult <> 0) then escape(ord(ERRCOPYWRITE));

	release(start.p);

end;

$page$
procedure process_modules(libptr : addrec; module_count : dirrange;
			  var total_blocks : integer; offset : integer);

var
	entry : dirrange;
	current_position : integer;
	export_blocks : integer;
	module_directory_size : integer;
	new_firstblk : integer;
	export_offset : integer;
	mdirp : addrec;
	directory_buffer : packed array[1..fblksize] of char;

begin
	total_blocks := 0;
	current_position := offset;
	mdirp.p := addr(directory_buffer);

	for entry := 1 to module_count do
		with libptr.l^[entry] do
		begin
		if dfkind = CODEFILE then
			begin
			writeln(output,'MODULE ',dtid);

			module_directory_size := read_module_directory(dfirstblk,mdirp);

			export_blocks := (mdirp.m^.sourcesize + fblksize - 1) div fblksize;

		    { save export relative start and output file    }
		    { position before updating the module directory }

			export_offset := mdirp.m^.sourceblock;
			new_firstblk := current_position;

			update_module_directory(mdirp, current_position,
					       module_directory_size, export_blocks);

			current_position := current_position +
					    (module_directory_size + fblksize - 1) div fblksize;

			copy_export_text(dfirstblk + export_offset,
					 export_blocks, current_position);

			current_position := current_position + export_blocks;

		    { update library directory entry with new start and  }
		    { end blocks.  set dlast to fblksize always.         }

			dfirstblk := new_firstblk;
			dlastblk := current_position;
			dlastbyte := fblksize;

		    { keep a running total of blocks written to output file }
		    { used to update dlastblk in library directory entry 0  }

			total_blocks := total_blocks +
					(module_directory_size + fblksize - 1) div fblksize +
					export_blocks;
			end
		else
			writeln(output,'ILLEGAL TYPE : ',ord(dfkind));
		end;
end;

$page$
procedure write_libdirectory(libptr : addrec; module_blocks, lib_blks : integer);

var
	blk_cnt : integer;

begin
	libptr.l^[0].dlastblk := total_blocks;

	blk_cnt := blockwrite(outfile, libptr.p^, lib_blks, 0);
	if (blk_cnt <> lib_blks) or (ioresult <> 0) then escape(ord(ERRLIBWRITE));

end;


begin
	try
		begin
		write(output,'input file: ');
		readln(input,infile_name);

		reset(infile,infile_name);
		if ioresult <> 0 then escape(escapecode);

		write(output,'output file: ');
		readln(input,outfile_name);

		position := pos('.CODE',outfile_name);
		if position = 0 then
			outfile_name := concat(outfile_name,'.CODE');

		rewrite(outfile,outfile_name);
		if ioresult <> 0 then escape(escapecode);

		lib_blks := read_libdirectory(libptr, module_count);

		process_modules(libptr, module_count, total_blocks, lib_blks);

		write_libdirectory(libptr,total_blocks, lib_blks);

		close(outfile,'lock');

		end;

	recover
		begin

		case escapecode of
		ord(ERRLIBREAD):        errstr := 'Error reading library directory';
		ord(ERRMODDIRREAD):     errstr := 'Error reading module directory';
		ord(ERRDIRSIZE):        errstr := 'Module directory > 512 bytes';
		ord(ERRDIRWRITE):       errstr := 'Error writing module directory';
		ord(ERRCOPYREAD):       errstr := 'Error reading export text';
		ord(ERRCOPYWRITE):      errstr := 'Error writing export text';
		ord(ERRLIBWRITE):       errstr := 'Error writing library directory';
		otherwise               escape(escapecode);
		end;

		writeln(output,errstr);
		end;

end.





@


53.1
log
@Automatic bump of revision number for PWS version 3.24B
@
text
@@


52.1
log
@Automatic bump of revision number for PWS version 3.24A
@
text
@@


51.1
log
@Automatic bump of revision number for PWS version 3.24d
@
text
@@


50.1
log
@Automatic bump of revision number for PWS version 3.23c
@
text
@@


49.1
log
@Automatic bump of revision number for PWS version 3.24b
@
text
@@


48.1
log
@Automatic bump of revision number for PWS version 3.24a
@
text
@@


47.1
log
@Automatic bump of revision number for PWS version 3.23
@
text
@@


46.1
log
@Automatic bump of revision number for PWS version 3.23
@
text
@@


45.1
log
@Automatic bump of revision number for PWS version 3.23C
@
text
@@


44.1
log
@Automatic bump of revision number for PWS version 3.23B
@
text
@@


43.1
log
@Automatic bump of revision number for PWS version 3.23aA
@
text
@@


42.1
log
@Automatic bump of revision number for PWS version 3.23e
@
text
@@


41.1
log
@Automatic bump of revision number for PWS version 3.23d
@
text
@@


40.1
log
@Automatic bump of revision number for PWS version 3.23c
@
text
@@


39.1
log
@Automatic bump of revision number for PWS version 3.23b
@
text
@@


38.1
log
@Automatic bump of revision number for PWS version 3.23a
@
text
@@


37.1
log
@Automatic bump of revision number for PWS version 3.3a
@
text
@@


36.1
log
@Automatic bump of revision number for PWS version 3.22
@
text
@@


35.1
log
@Automatic bump of revision number for PWS version 3.22
@
text
@@


34.1
log
@Automatic bump of revision number for PWS version 3.22
@
text
@@


33.1
log
@Automatic bump of revision number for PWS version 3.22D
@
text
@@


32.1
log
@Automatic bump of revision number for PWS version 3.22C
@
text
@@


31.1
log
@Automatic bump of revision number for PWS version 3.22B
@
text
@@


30.1
log
@Automatic bump of revision number for PWS version 3.22A
@
text
@@


29.1
log
@Automatic bump of revision number for PWS version 3.22b
@
text
@@


28.1
log
@Automatic bump of revision number for PWS version 3.3b
@
text
@@


27.1
log
@Automatic bump of revision number for PWS version 3.3a
@
text
@@


26.3
log
@
Comment from auto synch of clock fix:
date: 88/03/02 17:13:48;  author: quist;  state: Exp;  lines added/del: 1/1
SYSDATE fixes. RDQ
@
text
@@


26.2
log
@
Comment from auto synch of clock fix:
date: 88/03/02 09:41:46;  author: bayes;  state: Exp;  lines added/del: 0/0
Automatic bump of revision number for PWS version 3.2Y
@
text
@d33 1
a33 1
		  year: 0..100;
@


26.1
log
@Automatic bump of revision number for PWS version 3.3 Synch
@
text
@@


24.1
log
@Automatic bump of revision number for PWS version 3.2
@
text
@@


23.1
log
@Automatic bump of revision number for PWS version 3.2P
@
text
@@


22.1
log
@Automatic bump of revision number for PWS version 3.2N
@
text
@@


21.1
log
@Automatic bump of revision number for PWS version 3.2M
@
text
@@


20.1
log
@Automatic bump of revision number for PWS version 3.2L
@
text
@@


19.1
log
@Automatic bump of revision number for PWS version 3.2K
@
text
@@


18.1
log
@Automatic bump of revision number for PWS version 3.2J
@
text
@@


17.1
log
@Automatic bump of revision number for PWS version 3.2I+
@
text
@@


16.1
log
@Automatic bump of revision number for PWS version 3.2I
@
text
@@


15.1
log
@Automatic bump of revision number for PWS version 3.2H
@
text
@@


14.1
log
@Automatic bump of revision number for PWS version 3.2G
@
text
@@


13.1
log
@Automatic bump of revision number for PWS version 3.2F
@
text
@@


12.1
log
@Automatic bump of revision number for PWS version 3.2E
@
text
@@


11.1
log
@Automatic bump of revision number for PWS version 3.2D
@
text
@@


10.1
log
@Automatic bump of revision number for PWS version 3.2C
@
text
@@


9.1
log
@Automatic bump of revision number for PWS version 3.2B
@
text
@@


8.1
log
@Automatic bump of revision number for PWS version 3.2A
@
text
@@


7.1
log
@Automatic bump of revision number for PWS version 3.2l
@
text
@@


6.1
log
@Automatic bump of revision number for PWS version 3.2k
@
text
@@


5.1
log
@Automatic bump of revision number for PWS version 3.2j
@
text
@@


4.1
log
@Automatic bump of revision number for PWS version 3.2i
@
text
@@


3.1
log
@Automatic bump of revision number for PWS version 3.2h
@
text
@@


2.1
log
@Auto bump rev number to 2.1 for sys 3.2e.
@
text
@@


1.1
log
@Initial revision
@
text
@@
