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


56.8
date     93.11.20.11.43.10;  author jwh;  state Exp;
branches ;
next     56.7;

56.7
date     93.07.08.15.51.34;  author jwh;  state Exp;
branches ;
next     56.6;

56.6
date     93.07.06.16.08.32;  author jwh;  state Exp;
branches ;
next     56.5;

56.5
date     93.07.06.15.52.51;  author jwh;  state Exp;
branches ;
next     56.4;

56.4
date     93.07.06.10.19.49;  author jwh;  state Exp;
branches ;
next     56.3;

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

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

56.1
date     91.11.05.10.02.39;  author jwh;  state Exp;
branches ;
next     55.2;

55.2
date     91.08.30.15.54.52;  author jwh;  state Exp;
branches ;
next     55.1;

55.1
date     91.08.25.10.37.28;  author jwh;  state Exp;
branches ;
next     54.1;

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

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

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

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

50.1
date     90.10.29.16.34.52;  author jwh;  state Exp;
branches ;
next     49.2;

49.2
date     90.09.26.14.55.36;  author dew;  state Exp;
branches ;
next     49.1;

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

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

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

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

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

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

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

42.1
date     90.01.23.18.00.44;  author jwh;  state Exp;
branches ;
next     41.2;

41.2
date     90.01.10.15.04.55;  author dew;  state Exp;
branches ;
next     41.1;

41.1
date     89.12.22.11.42.23;  author jwh;  state Exp;
branches ;
next     40.9;

40.9
date     89.12.21.15.57.34;  author jwh;  state Exp;
branches ;
next     40.8;

40.8
date     89.10.31.13.53.46;  author dew;  state Exp;
branches ;
next     40.7;

40.7
date     89.10.30.16.55.21;  author dew;  state Exp;
branches ;
next     40.6;

40.6
date     89.10.25.16.07.48;  author dew;  state Exp;
branches ;
next     40.5;

40.5
date     89.10.24.14.19.10;  author dew;  state Exp;
branches ;
next     40.4;

40.4
date     89.10.24.13.30.06;  author dew;  state Exp;
branches ;
next     40.3;

40.3
date     89.10.18.17.06.54;  author dew;  state Exp;
branches ;
next     40.2;

40.2
date     89.10.11.17.05.51;  author dew;  state Exp;
branches ;
next     40.1;

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

39.1
date     89.09.26.16.48.27;  author dew;  state Exp;
branches ;
next     1.3;

1.3
date     89.09.26.15.35.36;  author dew;  state Exp;
branches ;
next     1.2;

1.2
date     89.09.14.13.53.32;  author dew;  state Exp;
branches ;
next     1.1;

1.1
date     89.09.14.10.38.19;  author dew;  state Exp;
branches ;
next     ;


desc
@scsidisk is the PWS SCSI disk Transfer Method (TM).
@


56.8
log
@
Handled a glitch by just going back to the "old" version of tape
transfer. Same as "transfer" but it uses ScsiTapeRead and ScsiTapeWrite
in place of ScsiDiskRead and ScsiDiskWrite. I thought I could make
tape_transfer smaller than transfer (with tape transfer, partial
blocks are impossible) but it's not worth the effort.

JWH 11/20/93.
@
text
@{system options}
$modcal on$
$allow_packed on$
$partial_eval on$

{code generation options}
$debug off$
$LINENUM 10000$
$iocheck off$
$ovflcheck off$
$range off$
$stackcheck off$

{listing options}
$lines 57$
$pagewidth 130$
$copyright 'Hewlett Packard Company, 1989'$

program scsidisc_init{{(INPUT, OUTPUT){For DEBUG and XDEBUG};

{}
$search 'SCSILIB.'$
{{
$search 'SCSILIB.', 'PWS_SCSI'$
{PWS_SCSI needed for TDEBUG}
$page$

module SCSIDISCMODULE;

import sysglobals, asm, IODECLARATIONS, SCSILIB, LOADER;

export

const
	MAXBLOCKSIZE = 65536; { 4096; } { JWH for McBeth support }
	DEBUG  = FALSE; {general debug info output to screen - have to change SCSIIF!}
	TDEBUG = FALSE; {trace is generated on internal err - have to change SCSIIF!}
	XDEBUG = FALSE; {transfer information output to screen}

	{
	  dvrtemp2 values.
	  dvrtemp2 initialized to -1 by CTABLE.
	}
	DeviceOK = -1;
	DeviceAlwaysOffline = 1;

type
	ScsiTmRecType = packed record
		CurrentBlock:integer;
		BlockBuffer:packed array [ 0 .. (MAXBLOCKSIZE-1) ] of char;
		SB:SessionBlockType;
	end;
	PtrScsiTmRecType = ^ScsiTmRecType;


var
	$if TDEBUG$
	      LISTING:TEXT;
	      LocTracePtr:ANYPTR;
	$END$

	pTmRec:PtrScsiTmRecType;


	procedure scsidisc(fp      : fibp;
			 request   : amrequesttype;
		  anyvar buffer    : window;
			 length,
			 position  : integer);

implement
{ type
	uep_type = ^unitentry; } { JWH now in SCSIIF }

Function  CheckDev(pUnit:uep_type; pSB:PtrSessionBlockType):boolean;
begin
	{
	  return TRUE if medium has changed, FALSE for ALL other cases
	}
	with pTmRec^ do
	begin
		ScsiCheckDev(pSB);
		if (ioresult = ord(zmediumchanged)) then
		begin
			CheckDev := TRUE;
			if (not pUnit^.ureportchange) then
			begin
				{
				  continue to talk with device, but force internal buffers
				  to be empty.
				}
				CurrentBlock := -1;
				ioresult := ord(inoerror);
			end;

		      { for McBeth tape drive : }
			if pUnit^.devid = -2 then
			begin
			 if SyncMcBeth(pSB) = 0 then
			  begin
			   CheckDev := FALSE;
			   ioresult := ord(inoerror);
			  end;
			end;
		end
		else
			CheckDev := FALSE;
	end;
end;

Procedure Inquire(pUnit:uep_type; pSB:PtrSessionBlockType);
var
	DevType, AnsiVersion:integer;
	Removable:boolean;
	s:string255;
begin
	with pUnit^ do
	begin
		ScsiDevInfo(pSB, DevType, AnsiVersion, Removable, s);
		if ioresult = ORD(inoerror) then
		begin
			{
			  set the uisfixed flag in the unitable.
			  pad = 1 means to treat removable media like hard disk.
			}
			if (pad = 1) then
			begin
				uisfixed := TRUE;
				if (NOT Removable) then
					pad := 0;
			end
			else
				uisfixed :=  NOT Removable;
		end;
	end;
end;

Procedure ReadCapacity(pUnit:uep_type; pSB:PtrSessionBlockType);
var
	i:integer;
	BlockSize, NumBlocks:integer;
begin
	with pUnit^ do
	begin
		ScsiDiscBlocks(pSB, BlockSize, NumBlocks);
		if ioresult = ORD(inoerror) then
		begin
			dvrtemp := BlockSize;

			$IF DEBUG$
				WRITELN('READ CAPACITY:  BLOCK SIZE IS ',BlockSize);
				WRITELN('READ CAPACITY:  MEDIUM SIZE IS ', BlockSize*(NumBlocks));
			$END$

			{
			  if block is not a power of 2, then then can't support this device.
			}
			i := BlockSize;
			while(i > 0) and not odd(i) do
			begin
				i := i div 2;
			end;
			if (i <> 1) {blocksize isn't a power of 2!} or
			   (BlockSize > MAXBLOCKSIZE) then
			begin
				dvrtemp := 0;
				ioresult := ord(znomedium);
			end
			else if NOT uisfixed OR (umaxbytes = -1) then
				umaxbytes := BlockSize * NumBlocks;
		end
		else
			dvrtemp := 0;
	end;
end;

Procedure tmSCSIstatus(pUnit:uep_type; pSB:PtrSessionBlockType);
var
	NewDevice, MediumHasChanged:boolean;
	DAV:DeviceAddressVectorsType;
	iotemp:integer;
begin
	with pUnit^, pTmRec^, pSB^ do
	begin
		NewDevice := FALSE;
		MediumHasChanged := FALSE;
		if (sc <> SelectCode) or (ba <> Device) or
		   (du <> LUN)        or (dv <> SUN)    or
		   (dvrtemp = 0) then
		begin
			 $IF DEBUG$
			    WRITELN('INITIALIZING SCSI');
			 $END$
			 NewDevice := TRUE;
			 DAV.sc := sc;
			 DAV.ba := ba;
			 DAV.du := du;
			 DAV.dv := 0;
			 ScsiSBInit(pSB, addr(DAV));
			 $if TDEBUG$
				 DoTrace := TRUE;
				 TraceSize := trace_size;
				 TracePtr := LocTracePtr;
			 $end$
		end;

		if (NewDevice) or (NOT uisfixed) then
		begin
			MediumHasChanged := CheckDev(pUnit, pSB);

			{
			  CRITICAL HOTSITE DEFECT REPAIR  DEW 09/26/90

			  Problem is that umaxbytes is being overwritten in tmSCSIstatus
			  on first call to TM.  This causes partitioned discs to loose their
			  boundaries, opening up the disc to potential data loss, i.e. unit
			  #11 can now overwrite unit#12.  Umaxbytes is being overwritten in
			  the ReadCapacity call below because uisfixed is not set correctly.
			  The uisfixed field is set by the Inquire command.  An Inquire only
			  needs to be done when dvrtemp = 0, which indicates CTABLE has just
			  called the TM for the first time.

			  As Inquire will swallow the status required by CheckDev, the Inquire
			  follows this call.  As the ioresult value set by CheckDev is checked
			  after the Inqurie, ioresult needs to be saved.
			}
			if (dvrtemp = 0) then
			begin
				iotemp := ioresult;
				Inquire(pUnit, pSB);
				ioresult := iotemp;
			end;
			if (dvrtemp = 0) or ((MediumHasChanged) and (NOT uisfixed)) then
			begin
				ReadCapacity(pUnit, pSB);
			end
			else if (pad = 1) and {removable media treated like hard disk}
			      (  (MediumHasChanged) or
				 (ioresult = ord(znotready))
			      ) then
			begin
				{
				  user has removed a floppy that is supposed to be treated
				  like a hard disk - do not talk to it any more.
				}
				dvrtemp2 := DeviceAlwaysOffline;
				ioresult := ord(znodevice);
			end;
		end;
		if (NewDevice) or (MediumHasChanged) or (ioresult <> ord(inoerror)) then
			CurrentBlock := -1;
	end;
end;


{*******************************************************************}
{ Same as transfer but for sequential devices , dt = 1.             }
{ For McBeth support 5/18/93 JWH , devid = -2 in the unit table.    }
{                                                                   }
{ Note - for tape_transfer, the number of bytes to transfer must be }
{        an exact multiple of the blocksize !                       }
{        Also, the transfer must begin exactly on a block boundary !}
{*******************************************************************}

procedure tape_transfer(pSB:PtrSessionBlockType;
		   uep: uep_type; request: amrequesttype;
		   bufptr: charptr; abs_position, length: integer);
var
	blocksize: integer;
	block, intra_block_offset, partial_length: integer;

	procedure checkio;
	begin
		if ioresult <> ord(inoerror) then
			escape(-10);
	end;

begin {tape_transfer}
with pTmRec^ do
begin
try
	{ block size is known }
	blocksize := uep^.dvrtemp;

	block := abs_position div blocksize;
	intra_block_offset := abs_position mod blocksize;
	 $IF XDEBUG$
		WRITELN;
		WRITELN;
		WRITELN;
		WRITELN('TAPE TRANSFER REQUEST: ', REQUEST);
		WRITELN('LENGTH:           ', LENGTH);
		WRITELN('POSITION:         ', ABS_POSITION);
		WRITELN('SCSI BLOCK:       ', BLOCK);
		WRITELN('SCSI INTRA-BLOCK: ', INTRA_BLOCK_OFFSET);
		WRITELN('SCSI BLOCKSIZE:   ', BLOCKSIZE);
		readln;
	 $END$

	if (blocksize <= 256) and (intra_block_offset<>0) then
	begin
		ioresult   := ord(zbadmode);
		escape(-10);
	end;

	{
	  Calculate partial first block parameters.
	}
	partial_length := blocksize-intra_block_offset;
	if partial_length > length then {entire transfer in one block}
	partial_length := length;

	case request of
	readbytes, startread:
	begin
		{
		  handle partial block at beginning of transfer.
		}
		{ For tapes, this can never happen, but ... }
		if intra_block_offset>0 then
		begin
			$IF XDEBUG$
				WRITELN('READING FIRST PARTIAL BLOCK');
			$END$

			{read block into TMRec}
			if CurrentBlock <> block then
			begin
				 $IF XDEBUG$
	   WRITELN('ScsiDiscRead necessary: ',BLOCKSIZE:1,' ',BLOCK:1);
				 $END$
				CurrentBlock := block;
				ScsiTapeRead(pSB,
				 block, 1, BlockSize, addr(BlockBuffer[0]));
				checkio;
			end;

			{move data from TMRec into user's buffer}
			moveleft(BlockBuffer[intra_block_offset], bufptr^, partial_length);
			bufptr := addr(bufptr^, partial_length);
			block := block + 1;
			length := length-partial_length;
		end;

		{
		  set up for multiple block read in middle and
		  partial read on last block.
		}
		partial_length := length mod blocksize;
		length := length div blocksize;
		if (blocksize <= 256) and (partial_length <> 0) then
		begin
			{read entire last block for small last partial block reads}
			partial_length := 0;
			length := length + 1;
		end;

		{
		 handle multiple block reads
		}
		if (length>0) then
		begin
			 $IF XDEBUG$
				WRITELN('READING MULTIPLE MIDDLE BLOCKS');
			 $END$
			{read directly into user's buffer}
			ScsiTapeRead(pSB,
			  block, length, blocksize, bufptr);
			checkio;
			bufptr := addr(bufptr^, length*blocksize);
			block := block+length;
			length:=0;
		end;

		{
		  handle partial block at end of transfer.
		}
		{ For tapes, this can never happen, but ... }
		if (partial_length > 0) then  {partial block at back}
		begin
			$IF XDEBUG$
				WRITELN('READING LAST PARTIAL BLOCK');
			$END$
			{read block into TmRec}
			if CurrentBlock <> block then
			begin
				$IF XDEBUG$
					WRITELN('ScsiDiscRead necessary: ',BLOCKSIZE:1,' ',BLOCK:1);
				$END$
				CurrentBlock := block;
				ScsiTapeRead(pSB,
				  block, 1, blocksize, addr(BlockBuffer[0]));
				checkio;
			end;

			{read data from TmRec into user's buffer}
			moveleft(BlockBuffer[0], bufptr^, partial_length);
		end;
	end;
	writebytes, startwrite:
	begin
		{
		  handle partial block at beginning of transfer.
		}
		{ For tapes, this can never happen, but ... }
		if intra_block_offset>0 then
		begin
			$IF XDEBUG$
				WRITELN('WRITING PARTIAL BLOCK AT FRONT');
			$END$
			{read block into TMRec}
			if CurrentBlock <> block then
			begin
				$IF XDEBUG$
					WRITELN('ScsiDiscRead necessary: ',BLOCKSIZE:1,' ',BLOCK:1);
				$END$
				CurrentBlock := block;
				ScsiTapeRead(pSB, block, 1,
				  BlockSize, addr(BlockBuffer[0]));
				checkio;
			end;

			{read user's data into TmRec block}
			moveleft(bufptr^, BlockBuffer[intra_block_offset], partial_length);

			{write TmRec block back to disc}
			ScsiTapeWrite(pSB, block, 1,
			  BlockSize, addr(BlockBuffer[0]));
			checkio;

			bufptr := addr(bufptr^, partial_length);
			block := block + 1;
			length := length-partial_length;
		end;

		{
		  set up for multiple block write in middle and
		  partial write on last block.
		}
		partial_length := length mod blocksize;
		length := length div blocksize;  {length is number of blocks}


		{
		  handle blocks in middle.
		}
		if length>0 then
		begin
			$IF XDEBUG$
				WRITELN('WRITING MIDDLE BLOCKS');
			$END$
			{write user's buffer to disc}
			ScsiTapeWrite(pSB, block, length, blocksize, bufptr);
			checkio;
			bufptr := addr(bufptr^, length*blocksize);
			block := block + length;
		end;

		{
		  handle partial block at end of transfer.
		}
		{ For tapes, this can never happen, but ... }
		if partial_length>0 then
		begin
			$IF XDEBUG$
				WRITELN('WRITING LAST PARTIAL BLOCK');
			$END$

			{
			  zero pad small sectors instead of
			  the read modify write operation used for big block sizes
			}
			if blocksize < 256 then
			begin
				{overwrite block in TmRec, using zero pad}
				CurrentBlock := block;
				moveleft(bufptr^, BlockBuffer[0], partial_length);
				BlockBuffer[partial_length] := #0;
				moveleft(BlockBuffer[partial_length],
					BlockBuffer[partial_length+1],
					blocksize-partial_length-1);
			end
			else
			begin
				{read last partial block into TmRec}
				if CurrentBlock <> block then
				begin
					$IF XDEBUG$
						WRITELN('ScsiDiscRead necessary: ',BLOCKSIZE:1,' ',BLOCK:1);
					$END$
					CurrentBlock := block;
					ScsiTapeRead(pSB, block,
					 1, blocksize, addr(BlockBuffer[0]));
					checkio;
				end;

				{move user's buffer into TmRec}
				moveleft(bufptr^, BlockBuffer[0], partial_length);
			end;

			{write out TmRec into last block}
			ScsiTapeWrite(pSB, block, 1,
					 BlockSize, addr(BlockBuffer[0]));
			checkio;
		end;

	       CurrentBlock := -1;   { JWH 8/30/91 }
	end; { writebytes }
	end; {case}
recover
begin
	if escapecode <> -10 then escape(escapecode);
	CurrentBlock := -1;
	$IF XDEBUG$
		blocksize := ioresult;
		WRITELN('TRANSFER ERROR, IOTEMP: ',BLOCKSIZE);
		ioresult := blocksize;
	$END$
end; {try/recover}
end; {with}
end; {tape_transfer}

procedure transfer(pSB:PtrSessionBlockType;
		   uep: uep_type; request: amrequesttype;
		   bufptr: charptr; abs_position, length: integer);
var
	blocksize: integer;
	block, intra_block_offset, partial_length: integer;

	procedure checkio;
	begin
		if ioresult <> ord(inoerror) then
			escape(-10);
	end;

begin {transfer}
with pTmRec^ do
begin
try
	{block size is known}
	blocksize := uep^.dvrtemp;

	block := abs_position div blocksize;
	intra_block_offset := abs_position mod blocksize;
	$IF XDEBUG$
		WRITELN;
		WRITELN;
		WRITELN;
		WRITELN('TRANSFER REQUEST: ', REQUEST);
		WRITELN('LENGTH:           ', LENGTH);
		WRITELN('POSITION:         ', ABS_POSITION);
		WRITELN('SCSI BLOCK:       ', BLOCK);
		WRITELN('SCSI INTRA-BLOCK: ', INTRA_BLOCK_OFFSET);
		WRITELN('SCSI BLOCKSIZE:   ', BLOCKSIZE);
		readln;
	$END$

	if (blocksize <= 256) and (intra_block_offset<>0) then
	begin
		ioresult   := ord(zbadmode);
		escape(-10);
	end;

	{
	  Calculate partial first block parameters.
	}
	partial_length := blocksize-intra_block_offset;
	if partial_length > length then {entire transfer in one block}
	partial_length := length;

	case request of
	readbytes, startread:
	begin
		{
		  handle partial block at beginning of transfer.
		}
		if intra_block_offset>0 then
		begin
			$IF XDEBUG$
				WRITELN('READING FIRST PARTIAL BLOCK');
			$END$

			{read block into TMRec}
			if CurrentBlock <> block then
			begin
				$IF XDEBUG$
					WRITELN('ScsiDiscRead necessary: ',BLOCKSIZE:1,' ',BLOCK:1);
				$END$
				CurrentBlock := block;
				ScsiDiscRead(pSB, block, 1, BlockSize, addr(BlockBuffer[0]));
				checkio;
			end;

			{move data from TMRec into user's buffer}
			moveleft(BlockBuffer[intra_block_offset], bufptr^, partial_length);
			bufptr := addr(bufptr^, partial_length);
			block := block + 1;
			length := length-partial_length;
		end;

		{
		  set up for multiple block read in middle and
		  partial read on last block.
		}
		partial_length := length mod blocksize;
		length := length div blocksize;
		if (blocksize <= 256) and (partial_length <> 0) then
		begin
			{read entire last block for small last partial block reads}
			partial_length := 0;
			length := length + 1;
		end;

		{
		 handle multiple block reads
		}
		if (length>0) then
		begin
			$IF XDEBUG$
				WRITELN('READING MULTIPLE MIDDLE BLOCKS');
			$END$
			{read directly into user's buffer}
			ScsiDiscRead(pSB, block, length, blocksize, bufptr);
			checkio;
			bufptr := addr(bufptr^, length*blocksize);
			block := block+length;
			length:=0;
		end;

		{
		  handle partial block at end of transfer.
		}
		if (partial_length > 0) then  {partial block at back}
		begin
			$IF XDEBUG$
				WRITELN('READING LAST PARTIAL BLOCK');
			$END$
			{read block into TmRec}
			if CurrentBlock <> block then
			begin
				$IF XDEBUG$
					WRITELN('ScsiDiscRead necessary: ',BLOCKSIZE:1,' ',BLOCK:1);
				$END$
				CurrentBlock := block;
				ScsiDiscRead(pSB, block, 1, blocksize, addr(BlockBuffer[0]));
				checkio;
			end;

			{read data from TmRec into user's buffer}
			moveleft(BlockBuffer[0], bufptr^, partial_length);
		end;
	end;
	writebytes, startwrite:
	begin
		{
		  handle partial block at beginning of transfer.
		}
		if intra_block_offset>0 then
		begin
			$IF XDEBUG$
				WRITELN('WRITING PARTIAL BLOCK AT FRONT');
			$END$
			{read block into TMRec}
			if CurrentBlock <> block then
			begin
				$IF XDEBUG$
					WRITELN('ScsiDiscRead necessary: ',BLOCKSIZE:1,' ',BLOCK:1);
				$END$
				CurrentBlock := block;
				ScsiDiscRead(pSB, block, 1, BlockSize, addr(BlockBuffer[0]));
				checkio;
			end;

			{read user's data into TmRec block}
			moveleft(bufptr^, BlockBuffer[intra_block_offset], partial_length);

			{write TmRec block back to disc}
			ScsiDiscWrite(pSB, block, 1, BlockSize, addr(BlockBuffer[0]));
			checkio;

			bufptr := addr(bufptr^, partial_length);
			block := block + 1;
			length := length-partial_length;
		end;

		{
		  set up for multiple block write in middle and
		  partial write on last block.
		}
		partial_length := length mod blocksize;
		length := length div blocksize;  {length is number of blocks}


		{
		  handle blocks in middle.
		}
		if length>0 then
		begin
			$IF XDEBUG$
				WRITELN('WRITING MIDDLE BLOCKS');
			$END$
			{write user's buffer to disc}
			ScsiDiscWrite(pSB, block, length, blocksize, bufptr);
			checkio;
			bufptr := addr(bufptr^, length*blocksize);
			block := block + length;
		end;

		{
		  handle partial block at end of transfer.
		}
		if partial_length>0 then
		begin
			$IF XDEBUG$
				WRITELN('WRITING LAST PARTIAL BLOCK');
			$END$

			{
			  zero pad small sectors instead of
			  the read modify write operation used for big block sizes
			}
			if blocksize < 256 then
			begin
				{overwrite block in TmRec, using zero pad}
				CurrentBlock := block;
				moveleft(bufptr^, BlockBuffer[0], partial_length);
				BlockBuffer[partial_length] := #0;
				moveleft(BlockBuffer[partial_length],
					BlockBuffer[partial_length+1],
					blocksize-partial_length-1);
			end
			else
			begin
				{read last partial block into TmRec}
				if CurrentBlock <> block then
				begin
					$IF XDEBUG$
						WRITELN('ScsiDiscRead necessary: ',BLOCKSIZE:1,' ',BLOCK:1);
					$END$
					CurrentBlock := block;
					ScsiDiscRead(pSB, block, 1, blocksize, addr(BlockBuffer[0]));
					checkio;
				end;

				{move user's buffer into TmRec}
				moveleft(bufptr^, BlockBuffer[0], partial_length);
			end;

			{write out TmRec into last block}
			ScsiDiscWrite(pSB, block, 1, BlockSize, addr(BlockBuffer[0]));
			checkio;
		end;

	       CurrentBlock := -1;   { JWH 8/30/91 }
	end; { writebytes }
	end; {case}
recover
begin
	if escapecode <> -10 then escape(escapecode);
	CurrentBlock := -1;
	$IF XDEBUG$
		blocksize := ioresult;
		WRITELN('TRANSFER ERROR, IOTEMP: ',BLOCKSIZE);
		ioresult := blocksize;
	$END$
end; {try/recover}
end; {with}
end; {transfer}


Procedure ZapBadDevice(pUnit:uep_type);
type
	CompareType = packed record
			Ctm:amtype;
			Csc: byte;
			Cba: byte;
			Cdu: byte;
			Cdv: byte;
		end;
	pCompareType = ^CompareType;
var
	i:integer;
	pC:pCompareType;
begin
	{
	  Kill all units that are talking to the same device as
	  this unit.
	}
	pC := addr(pUnit^.tm);
	for i := 0 to maxunit do
	with uep_type(addr(unitable^[i]))^, pC^ do
	begin
		if (sc = Csc) and (ba = Cba) and (du = Cdu) and (dv = Cdv) then
			dvrtemp2 := DeviceAlwaysOffLine;
	end;
end;



procedure scsidisc(fp       : fibp;
		  request   : amrequesttype;
	   anyvar buffer    : window;
		  length,
		  position  : integer);
label 1;
var
	pSB:PtrSessionBlockType;
	pUnit:uep_type;
	Num16MXfer, Mod16MSize, i:integer;
begin
	$IF DEBUG$
		WRITELN('SCSITM REQUEST: ',REQUEST);
	$END$
	ioresult := ord(inoerror);
	pSB := addr(pTmRec^.SB);
	pUnit := addr(unitable^[fp^.funit]);
	with fp^, pUnit^, pSB^ do
	begin
		if (offline) or (dvrtemp2 = DeviceAlwaysOffline) then
		begin
			ioresult := ord(znodevice);
			goto 1;
		end;

		case request of
		clearunit:
		begin
			dvrtemp2 := DeviceOK;
			LUN := 255;
			tmSCSIstatus(pUnit, pSB);
			if (ioresult = ord(zmediumchanged)) or
			   (ioresult = ord(znotready)) then
				ioresult := ord(inoerror);
			{
			  CRITICAL HOTSITE DEFECT REPAIR  DEW 09/26/90

			  Problem is that umaxbytes is being overwritten in tmSCSIstatus
			  on first call to TM.  This causes partitioned discs to loose their
			  boundaries, opening up the disc to potential data loss, i.e. unit
			  #11 can now overwrite unit#12.  The fact the uisfixed field of the
			  unitable is not set correctly prior to calling tmSCSIstatus causes
			  the problem.  The purpose of the Inquire call (below) is to set the
			  uisfixed field.  This is done to complete the handshake between CTABLE
			  and the TM.  The Inquire call can not be made prior to tmSCSIstatus
			  because the Inquire could swallow the status needed by a call to CheckDev
			  that determines if the media has been changed.  CheckDev is made in
			  tmSCSIstatus and is appropriate there.  Thus, Inquire is moved to
			  tmSCSIstatus.

			  if (ioresult = ord(inoerror)) then
				Inquire(pUnit, pSB);
			}
		end;

		unitstatus:
			fbusy := false; {overlap not implemented}

		flush:;

		readbytes, writebytes,
		startread, startwrite: {startread, startwrite means overlap - not implemented}
		begin
			tmSCSIstatus(pUnit, pSB);
			if ioresult = ord(inoerror) then
			begin
				if ureportchange and not umediavalid then
					ioresult := ord(zmediumchanged)
				else if (position<0) or (length<0) or (position+length>fpeof) then
					ioresult := ord(ieof)
				else
				begin
					if (length > hex('00ffffff')) then {scsi max xfer is $00ffffff}
					begin
						Num16MXfer := length div hex('00ffffff');
						Mod16MSize := length mod hex('00ffffff');
					end
					else
					begin
						Num16MXfer := 0;
						Mod16MSize := length;
					end;
					while (Num16MXfer > 0) do
					begin

				       if devid = -2 then { JWH 6/93 }
					tape_transfer(pSB, pUnit, request,
					   addr(buffer),
					   position+fileid+byteoffset,
						hex('00ffffff'))
				       else { disks - same as before }
					transfer(pSB, pUnit, request,
					   addr(buffer),
					   position+fileid+byteoffset,
						hex('00ffffff'));

						if (ioresult <> ord(inoerror)) then goto 1;
						position := position + hex('00ffffff');
						Num16MXfer := Num16MXfer - 1;
					end;

				       if devid = -2 then { JWH 6/93 }
					tape_transfer(pSB, pUnit, request,
						 addr(buffer),
						 position+fileid+byteoffset,
						 Mod16MSize)
					else { disks ... }
					  transfer(pSB, pUnit, request,
						 addr(buffer),
						 position+fileid+byteoffset,
						 Mod16MSize);

				end;
			end;
		end;

		otherwise
			ioresult := ord(ibadrequest);
		end; {case}

		1:
		if ioresult <> ord(inoerror) then
		begin
			LUN := 255;
			if ioresult = ord(zmediumchanged) then
			begin
				umediavalid := false;
			end;

			if (ioresult = ord(znodevice)) and (dvrtemp2 = DeviceAlwaysOffLine) then
			begin
				{
				  find all other units this device is attached to, and make sure
				  they are turned off!
				}
				ZapBadDevice(pUnit);
			end;
		end;

		$IF DEBUG$
			i := IORESULT;
			WRITELN('EXITING TM RESULT IS: ',i);
			ioresult := i;
		$END$
	end; {with}
end;

end; {SCSIDISCMODULE}



import SCSIDISCMODULE, loader, ASM
       {{,sysglobals,iodeclarations {for auto insertion into unitable}
       {{,SCSILIB {FOR TDEBUG} ;

$if FALSE$
  VAR
    dam_proc:
      packed record case integer of
	0: (dam: damtype);
	1: (value, slink: integer);
      end;

   function value(symbol: string255): integer;
     var
       modp: moddescptr;
       ptr, valueptr: addrec;
       found: boolean;
     begin {value}
       value := 0;
       found := false;
       modp := sysdefs;
       while (modp<>nil) and not found do
	 with modp^ do
	   begin
	     ptr := defaddr;
	     while (ptr.a<defaddr.a+defsize) and not found do
	       begin
		 found := ptr.syp^=symbol;
		 ptr.a := ptr.a+strlen(ptr.syp^)+1;
		 ptr.a := ptr.a+ord(odd(ptr.a));
		 valueptr.a := ptr.a+2;
		 if found then
		   value := valueptr.vep^.value;
		 ptr.a := ptr.a+ptr.gvp^.short;
	       end; {while}
	     modp := link;
	   end; {with modp^}
     end; {value}
$end$

BEGIN
    newbytes(pTmRec, sizeof(ScsiTmRecType)+4);
    pTmRec := addr(pTmRec^, 4 - (integer(pTmRec) mod 4)); {force long word alignment}
    $if TDEBUG$
	    newbytes(LocTracePtr, trace_size);
    $end$
    markuser;

    $if FALSE$

    pTmRec^.SB.SelectCode := 14;
    with unitable^[14] do
    begin { load up unit entry 14 }
      dam_proc.value := value('LIFMODULE_LIFDAM');
      dam_proc.slink := 0;
      DAM := dam_proc.dam;
      tm := scsidisc;
      sc := 14;
      ba := 0;
      du := 0;
      dv := 0;
      byteoffset := 0;
      uvid := '';
      letter := 'S';
      offline := false;
      uisinteractive := false;
      umediavalid := false;
      uisfixed := true;
      ureportchange := TRUE;
      uisblkd := true;
      umaxbytes := -1;
    end;
    unitable^[15] := unitable^[14];
    unitable^[15].ba := 1;

    $end$
end.
@


56.7
log
@Cleaned up the routine tape_transfer.
@
text
@a278 1

d282 1
a282 1
	{block size is known }
a286 4
	partial_length := length mod blocksize;

	length := length div blocksize; { now holds # blocks not bytes }

d300 1
a300 4
	if ((intra_block_offset<>0) { doesn't start on block boundary !! }
	    OR
	    (partial_length <> 0)) { not even multiple of blocks !! }
	 then
d306 7
d316 9
d326 11
a336 2
		{ read the number of blocks requested }
		{ directly into users buffer :        }
d338 23
d363 3
d370 3
d374 25
d402 20
d423 2
a424 2
		{ write the number of blocks requested }
		{ directly from users buffer :         }
d426 21
d449 3
d455 2
d459 49
d513 1
a521 1

@


56.6
log
@forgot a ;
@
text
@d256 8
a263 2
{ Same as transfer but for sequential devices , dt = 1 }
{ For McBeth support 5/18/93 JWH , devid = -2 in the unit table. }
d279 1
a279 1
   { writeln('ENTERING TAPE TRANSFER'); }
d283 1
a283 1
	{block size is known ???? }
d286 3
a288 5
	{ if request = writebytes then
	 begin
	  uep^.umaxbytes := uep^.umaxbytes + length;
	  writeln('umaxbytes bumped to : ',uep^.umaxbytes);
	 end; }
d290 1
a291 2
	block := abs_position div blocksize;
	intra_block_offset := abs_position mod blocksize;
d305 4
a308 1
	if (blocksize <= 256) and (intra_block_offset<>0) then
a313 7
	{
	  Calculate partial first block parameters.
	}
	partial_length := blocksize-intra_block_offset;
	if partial_length > length then {entire transfer in one block}
	partial_length := length;

a316 8
		{
		  handle partial block at beginning of transfer.
		}
		if intra_block_offset>0 then
		begin
			$IF XDEBUG$
				WRITELN('READING FIRST PARTIAL BLOCK');
			$END$
d318 2
a319 11
			{read block into TMRec}
			if CurrentBlock <> block then
			begin
				 $IF XDEBUG$
	   WRITELN('ScsiDiscRead necessary: ',BLOCKSIZE:1,' ',BLOCK:1);
				 $END$
				CurrentBlock := block;
				ScsiTapeRead(pSB,
				 block, 1, BlockSize, addr(BlockBuffer[0]));
				checkio;
			end;
a320 23
			{move data from TMRec into user's buffer}
			moveleft(BlockBuffer[intra_block_offset], bufptr^, partial_length);
			bufptr := addr(bufptr^, partial_length);
			block := block + 1;
			length := length-partial_length;
		end;

		{
		  set up for multiple block read in middle and
		  partial read on last block.
		}
		partial_length := length mod blocksize;
		length := length div blocksize;
		if (blocksize <= 256) and (partial_length <> 0) then
		begin
			{read entire last block for small last partial block reads}
			partial_length := 0;
			length := length + 1;
		end;

		{
		 handle multiple block reads
		}
a322 3
			 $IF XDEBUG$
				WRITELN('READING MULTIPLE MIDDLE BLOCKS');
			 $END$
a326 3
			bufptr := addr(bufptr^, length*blocksize);
			block := block+length;
			length:=0;
a327 26

		{
		  handle partial block at end of transfer.
		}
		if (partial_length > 0) then  {partial block at back}
		begin
			$IF XDEBUG$
				WRITELN('READING LAST PARTIAL BLOCK');
			$END$
			{read block into TmRec}
			if CurrentBlock <> block then
			begin
				$IF XDEBUG$
					WRITELN('ScsiDiscRead necessary: ',BLOCKSIZE:1,' ',BLOCK:1);
				$END$
				CurrentBlock := block;
				{ writeln('reading it ..'); }
				ScsiTapeRead(pSB,
				  block, 1, blocksize, addr(BlockBuffer[0]));
				{ writeln('read it.'); }
				checkio;
			end;

			{read data from TmRec into user's buffer}
			moveleft(BlockBuffer[0], bufptr^, partial_length);
		end;
a330 19
		{
		  handle partial block at beginning of transfer.
		}
		if intra_block_offset>0 then
		begin
			$IF XDEBUG$
				WRITELN('WRITING PARTIAL BLOCK AT FRONT');
			$END$
			{read block into TMRec}
			if CurrentBlock <> block then
			begin
				$IF XDEBUG$
					WRITELN('ScsiDiscRead necessary: ',BLOCKSIZE:1,' ',BLOCK:1);
				$END$
				CurrentBlock := block;
				ScsiTapeRead(pSB, block, 1,
				  BlockSize, addr(BlockBuffer[0]));
				checkio;
			end;
d332 2
a333 2
			{read user's data into TmRec block}
			moveleft(bufptr^, BlockBuffer[intra_block_offset], partial_length);
a334 21
			{write TmRec block back to disc}
			ScsiTapeWrite(pSB, block, 1,
			  BlockSize, addr(BlockBuffer[0]));
			checkio;

			bufptr := addr(bufptr^, partial_length);
			block := block + 1;
			length := length-partial_length;
		end;

		{
		  set up for multiple block write in middle and
		  partial write on last block.
		}
		partial_length := length mod blocksize;
		length := length div blocksize;  {length is number of blocks}


		{
		  handle blocks in middle.
		}
a336 3
			$IF XDEBUG$
				WRITELN('WRITING MIDDLE BLOCKS');
			$END$
a339 2
			bufptr := addr(bufptr^, length*blocksize);
			block := block + length;
a341 48
		{
		  handle partial block at end of transfer.
		}
		if partial_length>0 then
		begin
			$IF XDEBUG$
				WRITELN('WRITING LAST PARTIAL BLOCK');
			$END$

			{
			  zero pad small sectors instead of
			  the read modify write operation used for big block sizes
			}
			if blocksize < 256 then
			begin
				{overwrite block in TmRec, using zero pad}
				CurrentBlock := block;
				moveleft(bufptr^, BlockBuffer[0], partial_length);
				BlockBuffer[partial_length] := #0;
				moveleft(BlockBuffer[partial_length],
					BlockBuffer[partial_length+1],
					blocksize-partial_length-1);
			end
			else
			begin
				{read last partial block into TmRec}
				if CurrentBlock <> block then
				begin
					$IF XDEBUG$
						WRITELN('ScsiDiscRead necessary: ',BLOCKSIZE:1,' ',BLOCK:1);
					$END$
					CurrentBlock := block;
					ScsiTapeRead(pSB, block,
					 1, blocksize, addr(BlockBuffer[0]));
					checkio;
				end;

				{move user's buffer into TmRec}
				moveleft(bufptr^, BlockBuffer[0], partial_length);
			end;

			{write out TmRec into last block}
			ScsiTapeWrite(pSB, block, 1,
					 BlockSize, addr(BlockBuffer[0]));
			checkio;
		end;

	       CurrentBlock := -1;   { JWH 8/30/91 }
a346 1
	CurrentBlock := -1;
a353 1
  { writeln('LEAVING TAPE TRANSFER'); }
@


56.5
log
@Added call to tape_transfer for devid = -2 devices.
@
text
@d896 1
a896 1
						hex('00ffffff'))
@


56.4
log
@Added routine tape_transfer for McBeth support.
@
text
@d886 12
a897 2
						transfer(pSB, pUnit, request, addr(buffer),
							 position+fileid+byteoffset, hex('00ffffff'));
d902 12
a913 2
					transfer(pSB, pUnit, request, addr(buffer),
						position+fileid+byteoffset, Mod16MSize);
@


56.3
log
@
pws2rcs automatic delta on Wed Jan 27 13:14:25 MST 1993
@
text
@d35 1
a35 1
	MAXBLOCKSIZE = 4096;
d72 2
a73 2
type
	uep_type = ^unitentry;
d95 10
d254 269
@


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


56.1
log
@Automatic bump of revision number for PWS version 3.25
@
text
@a0 730
{system options}
$modcal on$
$allow_packed on$
$partial_eval on$

{code generation options}
$debug off$
$LINENUM 10000$
$iocheck off$
$ovflcheck off$
$range off$
$stackcheck off$

{listing options}
$lines 57$
$pagewidth 130$
$copyright 'Hewlett Packard Company, 1989'$

program scsidisc_init{{(INPUT, OUTPUT){For DEBUG and XDEBUG};

{}
$search 'SCSILIB.'$
{{
$search 'SCSILIB.', 'PWS_SCSI'$
{PWS_SCSI needed for TDEBUG}
$page$

module SCSIDISCMODULE;

import sysglobals, asm, IODECLARATIONS, SCSILIB, LOADER;

export

const
	MAXBLOCKSIZE = 4096;
	DEBUG  = FALSE; {general debug info output to screen - have to change SCSIIF!}
	TDEBUG = FALSE; {trace is generated on internal err - have to change SCSIIF!}
	XDEBUG = FALSE; {transfer information output to screen}

	{
	  dvrtemp2 values.
	  dvrtemp2 initialized to -1 by CTABLE.
	}
	DeviceOK = -1;
	DeviceAlwaysOffline = 1;

type
	ScsiTmRecType = packed record
		CurrentBlock:integer;
		BlockBuffer:packed array [ 0 .. (MAXBLOCKSIZE-1) ] of char;
		SB:SessionBlockType;
	end;
	PtrScsiTmRecType = ^ScsiTmRecType;


var
	$if TDEBUG$
	      LISTING:TEXT;
	      LocTracePtr:ANYPTR;
	$END$

	pTmRec:PtrScsiTmRecType;


	procedure scsidisc(fp      : fibp;
			 request   : amrequesttype;
		  anyvar buffer    : window;
			 length,
			 position  : integer);

implement
type
	uep_type = ^unitentry;

Function  CheckDev(pUnit:uep_type; pSB:PtrSessionBlockType):boolean;
begin
	{
	  return TRUE if medium has changed, FALSE for ALL other cases
	}
	with pTmRec^ do
	begin
		ScsiCheckDev(pSB);
		if (ioresult = ord(zmediumchanged)) then
		begin
			CheckDev := TRUE;
			if (not pUnit^.ureportchange) then
			begin
				{
				  continue to talk with device, but force internal buffers
				  to be empty.
				}
				CurrentBlock := -1;
				ioresult := ord(inoerror);
			end;
		end
		else
			CheckDev := FALSE;
	end;
end;

Procedure Inquire(pUnit:uep_type; pSB:PtrSessionBlockType);
var
	DevType, AnsiVersion:integer;
	Removable:boolean;
	s:string255;
begin
	with pUnit^ do
	begin
		ScsiDevInfo(pSB, DevType, AnsiVersion, Removable, s);
		if ioresult = ORD(inoerror) then
		begin
			{
			  set the uisfixed flag in the unitable.
			  pad = 1 means to treat removable media like hard disk.
			}
			if (pad = 1) then
			begin
				uisfixed := TRUE;
				if (NOT Removable) then
					pad := 0;
			end
			else
				uisfixed :=  NOT Removable;
		end;
	end;
end;

Procedure ReadCapacity(pUnit:uep_type; pSB:PtrSessionBlockType);
var
	i:integer;
	BlockSize, NumBlocks:integer;
begin
	with pUnit^ do
	begin
		ScsiDiscBlocks(pSB, BlockSize, NumBlocks);
		if ioresult = ORD(inoerror) then
		begin
			dvrtemp := BlockSize;

			$IF DEBUG$
				WRITELN('READ CAPACITY:  BLOCK SIZE IS ',BlockSize);
				WRITELN('READ CAPACITY:  MEDIUM SIZE IS ', BlockSize*(NumBlocks));
			$END$

			{
			  if block is not a power of 2, then then can't support this device.
			}
			i := BlockSize;
			while(i > 0) and not odd(i) do
			begin
				i := i div 2;
			end;
			if (i <> 1) {blocksize isn't a power of 2!} or
			   (BlockSize > MAXBLOCKSIZE) then
			begin
				dvrtemp := 0;
				ioresult := ord(znomedium);
			end
			else if NOT uisfixed OR (umaxbytes = -1) then
				umaxbytes := BlockSize * NumBlocks;
		end
		else
			dvrtemp := 0;
	end;
end;

Procedure tmSCSIstatus(pUnit:uep_type; pSB:PtrSessionBlockType);
var
	NewDevice, MediumHasChanged:boolean;
	DAV:DeviceAddressVectorsType;
	iotemp:integer;
begin
	with pUnit^, pTmRec^, pSB^ do
	begin
		NewDevice := FALSE;
		MediumHasChanged := FALSE;
		if (sc <> SelectCode) or (ba <> Device) or
		   (du <> LUN)        or (dv <> SUN)    or
		   (dvrtemp = 0) then
		begin
			 $IF DEBUG$
			    WRITELN('INITIALIZING SCSI');
			 $END$
			 NewDevice := TRUE;
			 DAV.sc := sc;
			 DAV.ba := ba;
			 DAV.du := du;
			 DAV.dv := 0;
			 ScsiSBInit(pSB, addr(DAV));
			 $if TDEBUG$
				 DoTrace := TRUE;
				 TraceSize := trace_size;
				 TracePtr := LocTracePtr;
			 $end$
		end;

		if (NewDevice) or (NOT uisfixed) then
		begin
			MediumHasChanged := CheckDev(pUnit, pSB);

			{
			  CRITICAL HOTSITE DEFECT REPAIR  DEW 09/26/90

			  Problem is that umaxbytes is being overwritten in tmSCSIstatus
			  on first call to TM.  This causes partitioned discs to loose their
			  boundaries, opening up the disc to potential data loss, i.e. unit
			  #11 can now overwrite unit#12.  Umaxbytes is being overwritten in
			  the ReadCapacity call below because uisfixed is not set correctly.
			  The uisfixed field is set by the Inquire command.  An Inquire only
			  needs to be done when dvrtemp = 0, which indicates CTABLE has just
			  called the TM for the first time.

			  As Inquire will swallow the status required by CheckDev, the Inquire
			  follows this call.  As the ioresult value set by CheckDev is checked
			  after the Inqurie, ioresult needs to be saved.
			}
			if (dvrtemp = 0) then
			begin
				iotemp := ioresult;
				Inquire(pUnit, pSB);
				ioresult := iotemp;
			end;
			if (dvrtemp = 0) or ((MediumHasChanged) and (NOT uisfixed)) then
			begin
				ReadCapacity(pUnit, pSB);
			end
			else if (pad = 1) and {removable media treated like hard disk}
			      (  (MediumHasChanged) or
				 (ioresult = ord(znotready))
			      ) then
			begin
				{
				  user has removed a floppy that is supposed to be treated
				  like a hard disk - do not talk to it any more.
				}
				dvrtemp2 := DeviceAlwaysOffline;
				ioresult := ord(znodevice);
			end;
		end;
		if (NewDevice) or (MediumHasChanged) or (ioresult <> ord(inoerror)) then
			CurrentBlock := -1;
	end;
end;


procedure transfer(pSB:PtrSessionBlockType;
		   uep: uep_type; request: amrequesttype;
		   bufptr: charptr; abs_position, length: integer);
var
	blocksize: integer;
	block, intra_block_offset, partial_length: integer;

	procedure checkio;
	begin
		if ioresult <> ord(inoerror) then
			escape(-10);
	end;

begin {transfer}
with pTmRec^ do
begin
try
	{block size is known}
	blocksize := uep^.dvrtemp;

	block := abs_position div blocksize;
	intra_block_offset := abs_position mod blocksize;
	$IF XDEBUG$
		WRITELN;
		WRITELN;
		WRITELN;
		WRITELN('TRANSFER REQUEST: ', REQUEST);
		WRITELN('LENGTH:           ', LENGTH);
		WRITELN('POSITION:         ', ABS_POSITION);
		WRITELN('SCSI BLOCK:       ', BLOCK);
		WRITELN('SCSI INTRA-BLOCK: ', INTRA_BLOCK_OFFSET);
		WRITELN('SCSI BLOCKSIZE:   ', BLOCKSIZE);
		readln;
	$END$

	if (blocksize <= 256) and (intra_block_offset<>0) then
	begin
		ioresult   := ord(zbadmode);
		escape(-10);
	end;

	{
	  Calculate partial first block parameters.
	}
	partial_length := blocksize-intra_block_offset;
	if partial_length > length then {entire transfer in one block}
	partial_length := length;

	case request of
	readbytes, startread:
	begin
		{
		  handle partial block at beginning of transfer.
		}
		if intra_block_offset>0 then
		begin
			$IF XDEBUG$
				WRITELN('READING FIRST PARTIAL BLOCK');
			$END$

			{read block into TMRec}
			if CurrentBlock <> block then
			begin
				$IF XDEBUG$
					WRITELN('ScsiDiscRead necessary: ',BLOCKSIZE:1,' ',BLOCK:1);
				$END$
				CurrentBlock := block;
				ScsiDiscRead(pSB, block, 1, BlockSize, addr(BlockBuffer[0]));
				checkio;
			end;

			{move data from TMRec into user's buffer}
			moveleft(BlockBuffer[intra_block_offset], bufptr^, partial_length);
			bufptr := addr(bufptr^, partial_length);
			block := block + 1;
			length := length-partial_length;
		end;

		{
		  set up for multiple block read in middle and
		  partial read on last block.
		}
		partial_length := length mod blocksize;
		length := length div blocksize;
		if (blocksize <= 256) and (partial_length <> 0) then
		begin
			{read entire last block for small last partial block reads}
			partial_length := 0;
			length := length + 1;
		end;

		{
		 handle multiple block reads
		}
		if (length>0) then
		begin
			$IF XDEBUG$
				WRITELN('READING MULTIPLE MIDDLE BLOCKS');
			$END$
			{read directly into user's buffer}
			ScsiDiscRead(pSB, block, length, blocksize, bufptr);
			checkio;
			bufptr := addr(bufptr^, length*blocksize);
			block := block+length;
			length:=0;
		end;

		{
		  handle partial block at end of transfer.
		}
		if (partial_length > 0) then  {partial block at back}
		begin
			$IF XDEBUG$
				WRITELN('READING LAST PARTIAL BLOCK');
			$END$
			{read block into TmRec}
			if CurrentBlock <> block then
			begin
				$IF XDEBUG$
					WRITELN('ScsiDiscRead necessary: ',BLOCKSIZE:1,' ',BLOCK:1);
				$END$
				CurrentBlock := block;
				ScsiDiscRead(pSB, block, 1, blocksize, addr(BlockBuffer[0]));
				checkio;
			end;

			{read data from TmRec into user's buffer}
			moveleft(BlockBuffer[0], bufptr^, partial_length);
		end;
	end;
	writebytes, startwrite:
	begin
		{
		  handle partial block at beginning of transfer.
		}
		if intra_block_offset>0 then
		begin
			$IF XDEBUG$
				WRITELN('WRITING PARTIAL BLOCK AT FRONT');
			$END$
			{read block into TMRec}
			if CurrentBlock <> block then
			begin
				$IF XDEBUG$
					WRITELN('ScsiDiscRead necessary: ',BLOCKSIZE:1,' ',BLOCK:1);
				$END$
				CurrentBlock := block;
				ScsiDiscRead(pSB, block, 1, BlockSize, addr(BlockBuffer[0]));
				checkio;
			end;

			{read user's data into TmRec block}
			moveleft(bufptr^, BlockBuffer[intra_block_offset], partial_length);

			{write TmRec block back to disc}
			ScsiDiscWrite(pSB, block, 1, BlockSize, addr(BlockBuffer[0]));
			checkio;

			bufptr := addr(bufptr^, partial_length);
			block := block + 1;
			length := length-partial_length;
		end;

		{
		  set up for multiple block write in middle and
		  partial write on last block.
		}
		partial_length := length mod blocksize;
		length := length div blocksize;  {length is number of blocks}


		{
		  handle blocks in middle.
		}
		if length>0 then
		begin
			$IF XDEBUG$
				WRITELN('WRITING MIDDLE BLOCKS');
			$END$
			{write user's buffer to disc}
			ScsiDiscWrite(pSB, block, length, blocksize, bufptr);
			checkio;
			bufptr := addr(bufptr^, length*blocksize);
			block := block + length;
		end;

		{
		  handle partial block at end of transfer.
		}
		if partial_length>0 then
		begin
			$IF XDEBUG$
				WRITELN('WRITING LAST PARTIAL BLOCK');
			$END$

			{
			  zero pad small sectors instead of
			  the read modify write operation used for big block sizes
			}
			if blocksize < 256 then
			begin
				{overwrite block in TmRec, using zero pad}
				CurrentBlock := block;
				moveleft(bufptr^, BlockBuffer[0], partial_length);
				BlockBuffer[partial_length] := #0;
				moveleft(BlockBuffer[partial_length],
					BlockBuffer[partial_length+1],
					blocksize-partial_length-1);
			end
			else
			begin
				{read last partial block into TmRec}
				if CurrentBlock <> block then
				begin
					$IF XDEBUG$
						WRITELN('ScsiDiscRead necessary: ',BLOCKSIZE:1,' ',BLOCK:1);
					$END$
					CurrentBlock := block;
					ScsiDiscRead(pSB, block, 1, blocksize, addr(BlockBuffer[0]));
					checkio;
				end;

				{move user's buffer into TmRec}
				moveleft(bufptr^, BlockBuffer[0], partial_length);
			end;

			{write out TmRec into last block}
			ScsiDiscWrite(pSB, block, 1, BlockSize, addr(BlockBuffer[0]));
			checkio;
		end;

	       CurrentBlock := -1;   { JWH 8/30/91 }
	end; { writebytes }
	end; {case}
recover
begin
	if escapecode <> -10 then escape(escapecode);
	CurrentBlock := -1;
	$IF XDEBUG$
		blocksize := ioresult;
		WRITELN('TRANSFER ERROR, IOTEMP: ',BLOCKSIZE);
		ioresult := blocksize;
	$END$
end; {try/recover}
end; {with}
end; {transfer}


Procedure ZapBadDevice(pUnit:uep_type);
type
	CompareType = packed record
			Ctm:amtype;
			Csc: byte;
			Cba: byte;
			Cdu: byte;
			Cdv: byte;
		end;
	pCompareType = ^CompareType;
var
	i:integer;
	pC:pCompareType;
begin
	{
	  Kill all units that are talking to the same device as
	  this unit.
	}
	pC := addr(pUnit^.tm);
	for i := 0 to maxunit do
	with uep_type(addr(unitable^[i]))^, pC^ do
	begin
		if (sc = Csc) and (ba = Cba) and (du = Cdu) and (dv = Cdv) then
			dvrtemp2 := DeviceAlwaysOffLine;
	end;
end;



procedure scsidisc(fp       : fibp;
		  request   : amrequesttype;
	   anyvar buffer    : window;
		  length,
		  position  : integer);
label 1;
var
	pSB:PtrSessionBlockType;
	pUnit:uep_type;
	Num16MXfer, Mod16MSize, i:integer;
begin
	$IF DEBUG$
		WRITELN('SCSITM REQUEST: ',REQUEST);
	$END$
	ioresult := ord(inoerror);
	pSB := addr(pTmRec^.SB);
	pUnit := addr(unitable^[fp^.funit]);
	with fp^, pUnit^, pSB^ do
	begin
		if (offline) or (dvrtemp2 = DeviceAlwaysOffline) then
		begin
			ioresult := ord(znodevice);
			goto 1;
		end;

		case request of
		clearunit:
		begin
			dvrtemp2 := DeviceOK;
			LUN := 255;
			tmSCSIstatus(pUnit, pSB);
			if (ioresult = ord(zmediumchanged)) or
			   (ioresult = ord(znotready)) then
				ioresult := ord(inoerror);
			{
			  CRITICAL HOTSITE DEFECT REPAIR  DEW 09/26/90

			  Problem is that umaxbytes is being overwritten in tmSCSIstatus
			  on first call to TM.  This causes partitioned discs to loose their
			  boundaries, opening up the disc to potential data loss, i.e. unit
			  #11 can now overwrite unit#12.  The fact the uisfixed field of the
			  unitable is not set correctly prior to calling tmSCSIstatus causes
			  the problem.  The purpose of the Inquire call (below) is to set the
			  uisfixed field.  This is done to complete the handshake between CTABLE
			  and the TM.  The Inquire call can not be made prior to tmSCSIstatus
			  because the Inquire could swallow the status needed by a call to CheckDev
			  that determines if the media has been changed.  CheckDev is made in
			  tmSCSIstatus and is appropriate there.  Thus, Inquire is moved to
			  tmSCSIstatus.

			  if (ioresult = ord(inoerror)) then
				Inquire(pUnit, pSB);
			}
		end;

		unitstatus:
			fbusy := false; {overlap not implemented}

		flush:;

		readbytes, writebytes,
		startread, startwrite: {startread, startwrite means overlap - not implemented}
		begin
			tmSCSIstatus(pUnit, pSB);
			if ioresult = ord(inoerror) then
			begin
				if ureportchange and not umediavalid then
					ioresult := ord(zmediumchanged)
				else if (position<0) or (length<0) or (position+length>fpeof) then
					ioresult := ord(ieof)
				else
				begin
					if (length > hex('00ffffff')) then {scsi max xfer is $00ffffff}
					begin
						Num16MXfer := length div hex('00ffffff');
						Mod16MSize := length mod hex('00ffffff');
					end
					else
					begin
						Num16MXfer := 0;
						Mod16MSize := length;
					end;
					while (Num16MXfer > 0) do
					begin
						transfer(pSB, pUnit, request, addr(buffer),
							 position+fileid+byteoffset, hex('00ffffff'));
						if (ioresult <> ord(inoerror)) then goto 1;
						position := position + hex('00ffffff');
						Num16MXfer := Num16MXfer - 1;
					end;
					transfer(pSB, pUnit, request, addr(buffer),
						position+fileid+byteoffset, Mod16MSize);
				end;
			end;
		end;

		otherwise
			ioresult := ord(ibadrequest);
		end; {case}

		1:
		if ioresult <> ord(inoerror) then
		begin
			LUN := 255;
			if ioresult = ord(zmediumchanged) then
			begin
				umediavalid := false;
			end;

			if (ioresult = ord(znodevice)) and (dvrtemp2 = DeviceAlwaysOffLine) then
			begin
				{
				  find all other units this device is attached to, and make sure
				  they are turned off!
				}
				ZapBadDevice(pUnit);
			end;
		end;

		$IF DEBUG$
			i := IORESULT;
			WRITELN('EXITING TM RESULT IS: ',i);
			ioresult := i;
		$END$
	end; {with}
end;

end; {SCSIDISCMODULE}



import SCSIDISCMODULE, loader, ASM
       {{,sysglobals,iodeclarations {for auto insertion into unitable}
       {{,SCSILIB {FOR TDEBUG} ;

$if FALSE$
  VAR
    dam_proc:
      packed record case integer of
	0: (dam: damtype);
	1: (value, slink: integer);
      end;

   function value(symbol: string255): integer;
     var
       modp: moddescptr;
       ptr, valueptr: addrec;
       found: boolean;
     begin {value}
       value := 0;
       found := false;
       modp := sysdefs;
       while (modp<>nil) and not found do
	 with modp^ do
	   begin
	     ptr := defaddr;
	     while (ptr.a<defaddr.a+defsize) and not found do
	       begin
		 found := ptr.syp^=symbol;
		 ptr.a := ptr.a+strlen(ptr.syp^)+1;
		 ptr.a := ptr.a+ord(odd(ptr.a));
		 valueptr.a := ptr.a+2;
		 if found then
		   value := valueptr.vep^.value;
		 ptr.a := ptr.a+ptr.gvp^.short;
	       end; {while}
	     modp := link;
	   end; {with modp^}
     end; {value}
$end$

BEGIN
    newbytes(pTmRec, sizeof(ScsiTmRecType)+4);
    pTmRec := addr(pTmRec^, 4 - (integer(pTmRec) mod 4)); {force long word alignment}
    $if TDEBUG$
	    newbytes(LocTracePtr, trace_size);
    $end$
    markuser;

    $if FALSE$

    pTmRec^.SB.SelectCode := 14;
    with unitable^[14] do
    begin { load up unit entry 14 }
      dam_proc.value := value('LIFMODULE_LIFDAM');
      dam_proc.slink := 0;
      DAM := dam_proc.dam;
      tm := scsidisc;
      sc := 14;
      ba := 0;
      du := 0;
      dv := 0;
      byteoffset := 0;
      uvid := '';
      letter := 'S';
      offline := false;
      uisinteractive := false;
      umediavalid := false;
      uisfixed := true;
      ureportchange := TRUE;
      uisblkd := true;
      umaxbytes := -1;
    end;
    unitable^[15] := unitable^[14];
    unitable^[15].ba := 1;

    $end$
end.
@


55.2
log
@Set CurrentBlock to -1 at the end of a writebytes transfer to ensure
that the drivers buffer is in sync with the disk. This is a bug fix.

JWH 8/30/91.
@
text
@@


55.1
log
@Automatic bump of revision number for PWS version 3.25A
@
text
@d476 3
a478 1
	end;
@


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


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.2
log
@
Fix for critical/HOTSITE defect.  The umaxbytes field of
the unitable was being overwritten by the total #of bytes
on the disc.  Thus, unit #11 can overwrite unit#12.
Problem was that CTABLE calls the TM with a clearunit
request as first call to TM.  TM should set the uisfixed
field.  Previously, uisfixed was being set too late, causing
poor decisions to be made by the ReadCapacity command.
@
text
@@


49.1
log
@Automatic bump of revision number for PWS version 3.24b
@
text
@d171 1
d200 23
d555 17
a571 1
			if (ioresult = ord(inoerror)) then
d573 1
@


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.2
log
@Updated to 1) use SCSILIB instead of SCSIIF even in DEBUG code, and
           2) to use the DAV interface for ScsiSBInit.
@
text
@@


41.1
log
@Automatic bump of revision number for PWS version 3.23d
@
text
@d24 2
a25 2
$search 'SCSIIF', 'PWS_SCSI'$
{}
d170 1
d184 5
a188 1
			 ScsiSBInit(pSB, pUnit);
d613 1
a613 1
       {{,SCSIIF {FOR TDEBUG} ;
@


40.9
log
@
pws2rcs automatic delta on Thu Dec 21 14:54:59 MST 1989
@
text
@@


40.8
log
@1) Turn the pad flag, which indicates that this is a removable media being
   treated like a hard disc, if the media is NOT removable.  Thus, a hard
   device can be powered off and on w/out affecting the current configuration,
   but a removable device that is being treated like a hard device can not.

2) Don't modify the offline flag.  TMs do not own this flag and can only
   reference it.
@
text
@d22 1
a22 1
$search 'SCSIDVR.'$
d30 1
a30 1
import sysglobals, asm, IODECLARATIONS, SCSIIF, LOADER;
@


40.7
log
@Major updates.

  o Updated to support SCSI floppies as hard disks.
  o rewrote tmSCSIstatus for better efficiency.
  o Inquire is only called with a clearunit.
  o Changed interface definition of CheckDev, ReadCapacity, Inquire, and 
    tmSCSIstatus for better efficiency.

@
text
@d117 5
a121 1
				uisfixed := TRUE
a206 1
				offline := true;
@


40.6
log
@Update for trace after Programmer's Interface modifications.
@
text
@d40 7
d75 1
a75 1
function CheckDev(pUnit:uep_type; pSB:PtrSessionBlockType; MediumHasChanged:boolean):boolean;
d77 3
d85 1
a85 1
			MediumHasChanged := TRUE; {forces a read capacity for new medium}
a94 5
		end;
		if ioresult <> ord(inoerror) then
		begin
			CurrentBlock := -1;
			CheckDev := FALSE;
d97 1
a97 1
		   CheckDev := TRUE;
d101 1
a101 1
function Inquire(pUnit:uep_type; pSB:PtrSessionBlockType):BOOLEAN;
d112 8
a119 7
			Inquire := TRUE;
			devid := DevType;
			uisfixed :=  NOT Removable;
		end
		else
		begin
			Inquire := FALSE;
d124 1
a124 1
function ReadCapacity(pUnit:uep_type; pSB:PtrSessionBlockType):BOOLEAN;
a133 1
			ReadCapacity := TRUE;
a153 1
				ReadCapacity := FALSE;
d159 1
a159 3
		begin
			ReadCapacity := FALSE;
		end;
d163 1
a163 1
function tmSCSIstatus(pUnit:uep_type; pSB:PtrSessionBlockType):BOOLEAN;
d165 1
a165 2
	MediumHasChanged:boolean;
	Status:boolean;
d169 1
d171 3
a173 2
		if (dvrtemp = 0) or (sc <> SelectCode) or (ba <> Device) or
		   (du <> LUN) or (dv <> SUN) then
d178 1
a184 1
			 MediumHasChanged := TRUE;
d187 1
a187 1
		if (MediumHasChanged) or (not uisfixed) then
d189 2
a190 2
			Status := CheckDev(pUnit, pSB, MediumHasChanged);
			if Status and MediumHasChanged then
d192 14
a205 4
				CurrentBlock := -1;
				if (not Inquire(pUnit, pSB)) or
				   (not ReadCapacity(pUnit, pSB)) then
					Status := FALSE;
d207 3
a209 3
		end
		else
			Status := TRUE;
a210 1
	tmSCSIstatus := Status;
d460 29
a495 1
	t:boolean;
d508 1
a508 1
		if offline then
d517 1
d519 6
a524 5
			t := tmSCSIstatus(pUnit, pSB);
			if ioresult =ord(inoerror) then
				offline := false
			else
				offline := true;
d535 2
a536 1
			if (tmSCSIstatus(pUnit, pSB)) then
a574 1
			dvrtemp := 0;
d579 9
@


40.5
log
@Updated to work with the latest version of the SCSI programmer's interface
definition.  Also, changed all 'disk' to 'disc'.
@
text
@d554 1
a554 1
       {{,SCSI_DEFS {for TDEBUG} ;
@


40.4
log
@scsidisc should search SCSIDVR, as the ERS defines, not SCSIIF.  Furthermore,
SCSI_DEFS is no longer required for importing - in fact it would cause a
multiply defined symbol error.
@
text
@d19 1
a19 1
program scsidisk_init{{(INPUT, OUTPUT){For DEBUG and XDEBUG};
d28 1
a28 1
module SCSIDISKMODULE;
d58 1
a58 1
	procedure scsidisk(fp      : fibp;
d125 1
a125 1
		ScsiDiskBlocks(pSB, BlockSize, NumBlocks);
d266 1
a266 1
					WRITELN('ScsiRead necessary: ',BLOCKSIZE:1,' ',BLOCK:1);
d269 1
a269 1
				ScsiRead(pSB, block, 1, BlockSize, addr(BlockBuffer[0]));
d302 1
a302 1
			ScsiRead(pSB, block, length, blocksize, bufptr);
d321 1
a321 1
					WRITELN('ScsiRead necessary: ',BLOCKSIZE:1,' ',BLOCK:1);
d324 1
a324 1
				ScsiRead(pSB, block, 1, blocksize, addr(BlockBuffer[0]));
d346 1
a346 1
					WRITELN('ScsiRead necessary: ',BLOCKSIZE:1,' ',BLOCK:1);
d349 1
a349 1
				ScsiRead(pSB, block, 1, BlockSize, addr(BlockBuffer[0]));
d356 2
a357 2
			{write TmRec block back to disk}
			ScsiWrite(pSB, block, 1, BlockSize, addr(BlockBuffer[0]));
d381 2
a382 2
			{write user's buffer to disk}
			ScsiWrite(pSB, block, length, blocksize, bufptr);
d417 1
a417 1
						WRITELN('ScsiRead necessary: ',BLOCKSIZE:1,' ',BLOCK:1);
d420 1
a420 1
					ScsiRead(pSB, block, 1, blocksize, addr(BlockBuffer[0]));
d429 1
a429 1
			ScsiWrite(pSB, block, 1, BlockSize, addr(BlockBuffer[0]));
d448 1
a448 1
procedure scsidisk(fp       : fibp;
d548 1
a548 1
end; {SCSIDISKMODULE}
d552 1
a552 1
import SCSIDISKMODULE, loader, ASM
d608 1
a608 1
      tm := scsidisk;
@


40.3
log
@Forced long word alignment of the internal buffer.
This assists DMA operations.
@
text
@d22 1
a22 1
$search 'SCSIIF'$
d30 1
a30 1
import sysglobals, asm, IODECLARATIONS, SCSI_DEFS, SCSIIF, LOADER;
@


40.2
log
@Modifications to help out with debugging.
@
text
@d19 1
a19 1
program scsidisk_init;
a41 1
		SB:SessionBlockType;
d44 1
d552 1
a552 1
import SCSIDISKMODULE, loader
d554 1
a554 1
       {{,SCSI_DEFS,ASM {for TDEBUG} ;
d593 2
a594 1
    new(pTmRec);
@


40.1
log
@Automatic bump of revision number for PWS version 3.23c
@
text
@d21 1
d23 3
d556 1
a556 1
$if false$
d599 1
a599 1
    $if false$
d607 1
a607 1
      tm := scsitm;
@


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


1.3
log
@
pws2rcs automatic delta on Tue Sep 26 14:31:31 MDT 1989
@
text
@@


1.2
log
@Updated the program and module names to scsidisk as opposed to scsitm.
This is a because a seperate tm needs to be generated for tapes, printers,
etc.
@
text
@d544 1
a544 1
end; {SCSITMMODULE}
d548 1
a548 1
import SCSITMMODULE, loader
@


1.1
log
@Initial revision
@
text
@d19 1
a19 1
program scsitm_init(INPUT,OUTPUT);
d24 1
a24 1
module SCSITMMODULE;
d54 1
a54 1
	procedure scsitm(fp        : fibp;
d444 1
a444 1
procedure scsitm( fp        : fibp;
@
