program scsi(input,output);

{*** Copyright Notice: This source Code belongs to the book
     "The SCSI Bus and IDE Interface" from Addison-Wesley.

     It may be used, ported and modified for non-commercial
     purposes when this copyright notice is included.
     Authorisation from the publisher is necessary for
     commercial purposes.
}

uses CRT, DOS;

const
  PNAM         : string='SCSI-Monitor V1.0 rev 024e 18.7.94 (fs)';

{Generic Constants}

  HEX_CHAR     : string='0123456789ABCDEF';

{BIOS Functions}
  BIOS_SERVICES                      = $10;

  BIOS_SETCURSOR                     = $01;

{DOS Interrupts}

  DOS_INT21                          = 21;

  DOS_OPEN_FILE                      = $3D;
  DOS_CLOSE_FILE                     = $3E;
  DOS_IOCTL_READ                     = $4402;

{ASPI Specific Constants}

  ASPI_NAME        = 'SCSIMGR$';
  ASPI_ENTRY_LENGTH= 4;
  ASPI_SRB_LENGHT  = $7F;

  SRB_COMMAND_CODE = $00;
  SRB_STATUS       = $01;
  SRB_TARGET_ID    = $08;
  SRB_LUN          = $09;
  SRB_DATA_LENGTH  = $0A;
  SRB_BUFFER_OFS   = $0F;
  SRB_BUFFER_SEG   = $11;
  SRB_SCSI_LEN     = $17;
  SRB_HA_STATUS    = $18;
  SRB_TARGET_STATUS= $19;
  SRB_SCSI_CMD     = $40;

  SRB_X_SCSICMD    = $02;

{SCSI Specific Constants}

{Program specific constants}

  CURSOR_ON        = 2;
  CURSOR_OFF       = 0;
  MIN_LINE         = 1;
  MIN_ROW          = 1;
  MAX_LINE         = 25;
  MAX_ROW          = 80;
  CMD_BUFFERS      = 9;
  CMD_LENGTH       = 11;
  CMD_LINE         = 3;
  STAT_ROW         = 57;
  ID_LENGTH        = 1;
  MAX_ID           = 7;
  DATA_BUFFERS     = 9;
  DATA_LENGTH      = $0FFE;
  DATA_LINE        = 5;
  INSTR_LINE       = 24; { MAX_LINE-1 }
  STATUS_LINE      = 25; { MAX_LINE }


  PROMPT           = 'Command: ';
  CMD_PROMPT       = 'SCSI Command ';
  DATA_PROMPT      = 'SCSI Data Buffer Nr. ';
  STAT_LABEL       = 'St';
  ID_LABEL         = 'Id';
  LUN_LABEL        = 'Lu';
  TIME_LABEL       = 'Zt';
  LEN_LABEL        = 'lN';
  LINK_LABEL       = 'nX';

{SCSI Simulator}

const SIMULATOR_ID    = $00;
      SIMULATOR_LUN   = $00;

      TEST_UNIT_READY = $00;
      REQUEST_SENSE   = $03;
      INQUIRY         = $12;

      GOOD            = $00;
      CHECK_CONDITION = $02;
      ID_NOT_PRESENT  = $FE;

      SENSE_KEY       = 2;
      SENSE_CODE      = 12;
      ADD_LENGTH      = 7;

  {Sense Keys}

      NOT_READY       = $02;
      ILLEGAL_REQUEST = $05;

  {Sense Codes}

      LUN_NOT_SUPPORTED : array[0..1] of byte = ($25,$00);
      ILLEGAL_OPCODE    : array[0..1] of byte = ($20,$00);
      INVALID_CDB_Field : array[0..1] of byte = ($24,$00);

      INQUIRY_DATA : Array [0..35] of Byte = ($1F,$00,$02,$02,30,$00,$00,$00,
                                              ord('S'),ord('C'),ord('H'),ord('M'),
                                              ord('I'),ord('D'),ord('T'),$20,
                                              ord('S'),ord('C'),ord('S'),ord('I'),
                                              ord('-'),ord('S'),ord('I'),ord('M'),
                                              ord('U'),ord('L'),ord('A'),ord('T'),
                                              ord('O'),ord('R'),ord(' '),ord(' '),
                                              ord('0'),ord('0'),ord('2'),ord('0'));



{Messages}

  ILLEGAL_INSTR             ='Illegal comand!';
  ILLEGAL_HEXBYTE           ='Illegal hexadezimal value for a byte: ';
  ILLEGAL_CMD_OFFSET        ='Command offset too big: ';
  ILLEGAL_DATA_OFFSET       ='Data offset too big: ';
  ILLEGAL_ID_OFFSET         ='No offset at SCSI ID and LUN possible: ';
  ILLEGAL_ID                ='Illegal SCSI ID: ';
  ILLEGAL_LUN               ='Illegal LUN: ';
  ILLEGAL_CMD_NUMBER        ='Command Number too big: ';
  ILLEGAL_DATA_NUMBER       ='Buffer number too big: ';
  COMMAND_NOT_IMPLEM        ='This command is not yet implemented!';
  BYTES_IGNORED             ='Hint: Bytes from Byte 2 on ignored';
  NO_REPLICATE              ='This command supports no replication count: ';
  NO_OFFSET                 ='This command supports no offset: ';
  ERROR_OPEN_OUTFILE        ='Output file could not be opened: ';
  NO_SCSI_DRIVER            ='No SCSI driver loaded!';
  ASPI_CONNECTED            ='ASPI loaded';
  SIMULATOR_CONN            ='SCSI target simulator loaded';
  ASPI_OPEN_ERROR           ='Error opening ASPI';
  HELP_MESSAGE              ='Commands: Command, Data, dRriver, Go, Help, Id, Lun, leNgth, neXt, Quit' ;
  ASPI_MINIMUM              ='SCSI commandos under ASPI must be at least two bytes long!';

type

{Generic Types}
   MemAdress = record
                  Offset:  integer;
                  Segment: integer;
                 end;


{ASPI-Types}

   SRBsize= 0..ASPI_SRB_LENGHT;
   SRBarray = array[SRBsize] of byte;

{SCSI-Types}

   SCSICmd = record
               Command: array[0..11] of byte;
               Status: byte;
               ID: byte;
               LUN: byte;
               Len: byte;
               TimeOut: byte;
               Next: byte;
             end;

   SCSIBuffers = 0..CMD_BUFFERS;

   DataBuffers = 0..DATA_BUFFERS;
   BufferLength = 0..DATA_LENGTH;
   DataBufferType = array[DataBuffers,BufferLength] of byte;

var
  CommandBuffer: array[SCSIBuffers] of SCSICmd;
  CommandNumber: byte;

  DataBuffer   : DataBufferType;
  DataBufferPointer : array[DataBuffers] of word;
  DataBufferNbr: Byte;

  RunTime:       boolean;
  MaintMode: boolean; {Maintenance mode display SRB if ASPI}

  Instruction, SavedInstruction, SavedStatusLine: String;

  AspiFileHandle: integer;
  AspiEntryPoint: MemAdress;
  SRB: SRBarray;
  SCSIConnected: string;

  outfile: text;
  FileName: string;

  SenseData: array[0..17] of byte;

{**** Low Level Functions}

procedure SaveScreen(var outfile:text);

const  ScreenOffset  = $0;
       ScreenSegment = $B800;

var k,l: byte;

begin
  for k:=0 to 24 do
    begin
      for l:=0 to 79 do  write(outfile,char(mem[ScreenSegment:ScreenOffset+(k*160)+2*l]));
      writeln(outfile);
    end;
end;

function FileOpen(FileName:string):integer;

var register: registers;

begin
  FileName:=FileName+chr(0);
  with register
  do
    begin
      ax := DOS_OPEN_FILE shl 8;
      bx:=0;
      cx:=0;
      ds := seg(FileName);
      dx := ofs(FileName)+1; { because T4 strings have the length in byte 0 }
    end;
    MSDOS(register);
    if (register.flags and FCarry) > 0
    then FileOpen:=-1
    else FileOpen:=register.ax;
end;

function FileClose(FileHandle:integer):integer;

var register: registers;

begin
  with register
  do
    begin
      ax := DOS_CLOSE_FILE shl 8;
      bx:=FileHandle;
    end;
    MSDOS(register);
    if (register.flags and FCarry) = 0
    then FileClose:=0
    else FileClose:=register.ax;
end;

procedure SetCursor(CursorSize:byte);
var regs: registers;
    MaxCurs: byte;
begin
  if LastMode<7 then MaxCurs:=7 {CGA Adapter}
  else MaxCurs:=13;
  regs.AH:=BIOS_SETCURSOR;
  if CursorSize=0
  then begin regs.CH:=$FF; regs.CL:=$FF; end
  else begin regs.CH:=MaxCurs-CursorSize+1; regs.CL:=MaxCurs; end;

  intr(BIOS_SERVICES, regs)
end;

{**** Miscellanous Generic Functions}

function Byte2Hex(byt:byte):string;

const hexarray : array [0..$F] of char = '0123456789ABCDEF';
begin
  Byte2Hex:=hexarray[byt shr 4] + hexarray[byt and $F];
end;

function Integer2Hex(byt:Integer):string;

const hexarray : array [0..$F] of char = '0123456789ABCDEF';
begin
  Integer2Hex:=hexarray[(byt and $F000) shr 12] +
               hexarray[(byt and $0F00) shr 8] +
               hexarray[(byt and $00F0) shr 4] +
               hexarray[byt and $F];
end;

function upper(InString:string):string;
var k: byte;
begin
  for k:=1 to ord(Instring[0]) do Instring[k]:=UpCase(Instring[k]);
  upper:=InString;
end;

function space(len:integer):string;
var k:          byte;
    result:     string;

begin
  result:='';
  if len>0 then
    begin
     if len>$FF then len:=$FF;
     for k:=1 to len do result:=concat(result,' ');
   end;
  space:=result;
end;

function token(WorkString: string; Number: byte): string;
var k:     byte;

begin
  token:='';
  for k:=1 to Number-1 do
    if pos(' ',Workstring)>0
    then
      WorkString:=copy(WorkString,pos(' ',Workstring)+1, 255)
    else
      begin WorkString:=''; exit; end;
    if pos(' ',Workstring)>0
    then
      WorkString:=copy(WorkString,1,pos(' ',Workstring)-1);
  token:=WorkString;
end;

function ltrim(CString: string): string;
begin
while ((length(CString)>0) and (CString[1]=' ')) do cString:=copy(CString,2,$FF);
ltrim:=cString;
end;

function LegalHex(var HexByte:String; IsInteger: boolean):boolean;
var k:      byte;
    result: boolean;
    ProperLength: byte;

begin
  if IsInteger then ProperLength:=4 else ProperLength:=2;
  HexByte:=upper(HexByte);
  Result:=length(Hexbyte)<=ProperLength;
  if Result
  then
    begin
      for k:=length(HexByte)+1 to ProperLength do HexByte:=concat('0',HexByte);
      for k:=1 to ProperLength do Result:=(pos(HexByte[k],HEX_CHAR)>0) and Result;
    end;
  LegalHex:=Result;
end;

function Hex2Byte(HexByte:String):byte;
begin
  Hex2Byte:=(pos(HexByte[1],HEX_CHAR)-1)*16+pos(HexByte[2],HEX_CHAR)-1;
end;

function Hex2Integer(Hex:String):Integer;
begin
  Hex2Integer:=(pos(Hex[1],HEX_CHAR)-1)*$1000
               +(pos(Hex[2],HEX_CHAR)-1)*$100
               +(pos(Hex[3],HEX_CHAR)-1)*$10
               +pos(Hex[4],HEX_CHAR)-1
               ;
end;

function Min(X,Y:integer):integer;
begin
  if X>Y then min:=Y else min:=X;
end;

{**** SCSI generic functions}

function SCSICmdLen(Opcode: byte):byte;
begin
 SCSICmdLen:=0;
 if Opcode and $E0 = $00 then SCSICmdLen:=6;
 if Opcode and $E0 = $20 then SCSICmdLen:=10;
 if Opcode and $E0 = $40 then SCSICmdLen:=10;
 if Opcode and $E0 = $A0 then SCSICmdLen:=12;
end;

function SimulIdLun(var CommandBuffer: SCSICmd; ID,LUN: Byte; var LUNStatus:byte): boolean;
const LUN_SUPP_CONN = $00;
      LUN_NOT_SUPP  = $03;
begin
  if CommandBuffer.ID=ID
  then
    begin
      SimulIdLun:=true;
      if CommandBuffer.LUN=LUN
      then LUNStatus:=LUN_SUPP_CONN else LUNStatus:=LUN_NOT_SUPP;
    end
  else SimulIdLUN:=false;
end;

procedure CheckCommand(var CommandBuffer: SCSICmd; CommandMask: array of byte);

var k:byte;

begin
with CommandBuffer do
for k:=0 to CMD_LENGTH do
  if (((Command[k] and CommandMask[k])>0) and (Status=GOOD))
  then
    begin
      Status:=CHECK_CONDITION;
      SenseData[0]:=$70;
      SenseData[SENSE_KEY]:=ILLEGAL_REQUEST;
      SenseData[ADD_LENGTH]:=high(Sensedata)-ADD_LENGTH;
      SenseData[SENSE_CODE]:=INVALID_CDB_FIELD[0];
      SenseData[SENSE_CODE+1]:=INVALID_CDB_FIELD[1];
    end;
end;


procedure SCSISimulator(var CommandBuffer :SCSICmd ;var Data :array of byte);

const CMD_00_MASK : array[0..CMD_LENGTH] of byte =
                    ($0,$1F,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF);
      CMD_03_MASK : array[0..CMD_LENGTH] of byte =
                    ($0,$1F,$FF,$FF,$00,$FF,$FF,$FF,$FF,$FF,$FF,$FF);
      CMD_12_MASK : array[0..CMD_LENGTH] of byte =
                    ($0,$1F,$FF,$FF,$00,$FF,$FF,$FF,$FF,$FF,$FF,$FF);


var k, LUNStatus: byte;

begin
  delay(200);
  with CommandBuffer do
    begin
      Status:=CHECK_CONDITION;
      if Command[0]<>REQUEST_SENSE
      then for k:=0 to high(SenseData) do SenseData[k]:=0;
      Case Command[0] of
        TEST_UNIT_READY : begin
                            if not SimulIdLun(CommandBuffer,SIMULATOR_ID,SIMULATOR_LUN,LUNstatus)
                            then Status:=ID_NOT_PRESENT
                            else
                              if LUNStatus=0
                              then
                                begin
                                  Status:=GOOD;
                                  CheckCommand(CommandBuffer, CMD_00_MASK);
                                end;
                          end;
        INQUIRY         : begin
                            if not SimulIdLun(CommandBuffer,SIMULATOR_ID,SIMULATOR_LUN,LUNstatus)
                            then Status:=ID_NOT_PRESENT
                            else
                              Begin
                                Status:=GOOD;
                                CheckCommand(CommandBuffer, CMD_12_MASK);
                                if Status=GOOD
                                then
                                  begin
                                    for k:=0 to min(Command[4]-1,high(INQUIRY_DATA))
                                    do Data[k]:=INQUIRY_DATA[k];
                                    Data[0]:=(LUNStatus shl 5) or Data[0];
                                  end;
                              end;
                          end;
       REQUEST_SENSE    : begin
                            if not SimulIdLun(CommandBuffer,SIMULATOR_ID,SIMULATOR_LUN,LUNstatus)
                            then Status:=ID_NOT_PRESENT
                            else
                             begin
                                Status:=GOOD;
                                CheckCommand(CommandBuffer, CMD_12_MASK);
                                if Status=GOOD
                                then
                                  begin
                                    if LUNStatus>0
                                    then
                                      begin
                                        SenseData[0]:=$70;
                                        SenseData[SENSE_KEY]:=ILLEGAL_REQUEST;
                                        SenseData[ADD_LENGTH]:=high(Sensedata)-ADD_LENGTH;
                                        SenseData[SENSE_CODE]:=LUN_NOT_SUPPORTED[0];
                                        SenseData[SENSE_CODE+1]:=LUN_NOT_SUPPORTED[1];
                                      end;
                                    for k:=0 to min(Command[4]-1,high(SenseData))
                                    do Data[k]:=SenseData[k];
                                    for k:=0 to high(SenseData) do SenseData[k]:=0;
                                    SenseData[0]:=$70; SenseData[ADD_LENGTH]:=high(Sensedata)-ADD_LENGTH;
                                   end;
                                 end;
                          end;
      else
                          begin
                            SenseData[0]:=$70;
                            SenseData[SENSE_KEY]:=ILLEGAL_REQUEST;
                            SenseData[ADD_LENGTH]:=high(Sensedata)-ADD_LENGTH;
                            SenseData[SENSE_CODE]:=ILLEGAL_OPCODE[0];
                            SenseData[SENSE_CODE+1]:=ILLEGAL_OPCODE[1];
                          end;

      end; {Case}
    end;
end;

{**** ASPI-specific functions}

procedure GetASPIEntry(FileHandle:integer; var AspiEntry:MemAdress);

var register: registers;

begin
  with register
  do
    begin
      ax := DOS_IOCTL_READ;
      bx:=FileHandle;
      cx:=ASPI_ENTRY_LENGTH;
      ds := seg(AspiEntry);
      dx := ofs(AspiEntry);
    end;
    MSDOS(register);
end;

procedure SCSI2SRB(var SRB: SRBarray; Command: SCSICmd; DataBufNbr: byte);

var k:integer;

begin
  for k:=0 to High(SRB) do SRB[k]:=0;
  SRB[SRB_COMMAND_CODE]:=SRB_X_SCSICMD;
  SRB[SRB_TARGET_ID]:=Command.ID;
  SRB[SRB_LUN]:=Command.LUN;
  SRB[SRB_DATA_LENGTH]:=lo(DATA_LENGTH);
  SRB[SRB_DATA_LENGTH+1]:=hi(DATA_LENGTH);
  if Command.Len=0
  then SRB[SRB_SCSI_LEN]:=SCSICmdLen(Command.Command[0])
  else SRB[SRB_SCSI_LEN]:=Command.Len;
  for k:=0 to SRB[SRB_SCSI_LEN]-1
  do SRB[SRB_SCSI_CMD+k]:=Command.Command[k];

  SRB[SRB_BUFFER_SEG]:=lo(seg(DataBuffer[DataBufNbr]));
  SRB[SRB_BUFFER_SEG+1]:=hi(seg(DataBuffer[DataBufNbr]));
  SRB[SRB_BUFFER_OFS]:=lo(ofs(DataBuffer[DataBufNbr]));
  SRB[SRB_BUFFER_OFS+1]:=hi(ofs(DataBuffer[DataBufNbr]));

end;

procedure SRB2SCSI(SRB: SRBarray; var Command: SCSICmd);

var k:integer;

begin
  if SRB[SRB_HA_STATUS]<>$00
  then Command.Status:=$FE
  else Command.Status:=SRB[SRB_TARGET_STATUS];
end;

procedure SRBexecute(var SRB: SRBarray; var SCSIBuffer: Array of byte);
var SRBsegment, SRBoffset: integer;

begin

  SRBsegment:=seg(SRB);
  SRBoffset:=ofs(SRB);

  asm
  mov ax, SRBsegment
  push ax
  mov ax, SRBoffset
  push ax
  LEA BX, AspiEntryPoint
  call DWORD PTR [bx]
  add sp,4
  end;
end;

function InitializeASPI: boolean;
label FatalError;
var result: integer;
begin
  InitializeASPI:=false;
  AspiFileHandle:=FileOpen(ASPI_NAME);
  if AspiFileHandle<=-1 then goto FatalError;

  AspiEntryPoint.segment:=0;   AspiEntryPoint.offset:=0;
  GetASPIEntry(AspiFileHandle,AspiEntryPoint);

  result:=FileClose(AspiFileHandle);
  if result<>0 then goto FatalError;
  InitializeASPI:=true;
FatalError:
end;

{*** Program specific functions
  most of these work on the global variables rather than on passed parameters}

procedure Message(MessageText:string;Wait:boolean);
var dummy: char;
begin
  GotoXY(MIN_ROW,STATUS_LINE);
  write(MessageText);
  if wait then repeat until keypressed;
  GotoXY(MIN_ROW,STATUS_LINE);
  write(space(MAX_ROW-1));
  SavedStatusLine:=MessageText;
end;

function DisplStatus(status:byte):String;
begin
DisplStatus:=Byte2Hex(Status);
if Status=$FF then DisplStatus:='??';
if Status=$FE then DisplStatus:='--';
end;

Procedure DisplayCommand(CommandBuffer: array of SCSICmd; CommandNumber:byte);

var ByteNbr: byte;

begin
with CommandBuffer[CommandNumber] do
 begin
  GotoXY(MIN_ROW,CMD_LINE);
  write(CMD_PROMPT,Byte2Hex(CommandNumber),': ');
  for ByteNbr:=0 to CMD_LENGTH do
    write(Byte2Hex(Command[ByteNbr]),' ');
  GotoXY(STAT_ROW,CMD_LINE-1);
  write(ID_LABEL,' ',LUN_LABEL,' ',STAT_LABEL,' ',LEN_LABEL,' ',LINK_LABEL);
  GotoXY(STAT_ROW,CMD_LINE);
  write(Byte2Hex(ID),' ',Byte2Hex(LUN),' ',DisplStatus(Status),' ',Byte2Hex(Len),' ',Byte2Hex(Next));
 end;
end;

procedure UpdateStatus(Text: string);
var SavedAttrib: byte;
begin
  SavedAttrib:=TextAttr;
  TextAttr:=TextAttr+blink;
  GotoXY(STAT_ROW+6,CMD_LINE);
  write(Text);
  TextAttr:=SavedAttrib;
end;

Procedure DisplayBuffer(var DataBuffer: DataBufferType; DataBufferNbr:byte);
                       { var, because else a local copy of DataBuffer
                         is generated, that takes too much space }

const BYTES_PER_LINE:  byte=16;
      NUMBER_OF_LINES: byte=16;

var ByteNbr, LineNbr, ThisByte, SavedAttrib: byte;
    StartByte: Integer;

begin
  StartByte:=DataBufferPointer[DataBufferNbr] and $FFF0;
  if StartByte>$80 then StartByte:=StartByte-$80 else StartByte:=0;
  if StartByte>DATA_LENGTH then StartByte:=DATA_LENGTH-$80;
  GotoXY(MIN_ROW,DATA_LINE);
  write(DATA_PROMPT,Byte2Hex(DataBufferNbr),': ');
  for LineNbr:=0 to NUMBER_OF_LINES-1 do
  if LineNbr*BYTES_PER_LINE+StartByte<DATA_LENGTH then
   begin
    GotoXY(MIN_ROW,DATA_LINE+LineNbr+2);
    write(Integer2Hex(LineNbr*BYTES_PER_LINE+StartByte),': ');
    for ByteNbr:=0 to BYTES_PER_LINE-1 do
      write(Byte2Hex(DataBuffer[DataBufferNbr,StartByte+ByteNbr+LineNbr*(BYTES_PER_LINE)]),' ');
    write('  ');
    for ByteNbr:=0 to BYTES_PER_LINE-1 do
      begin
        ThisByte:=DataBuffer[DataBufferNbr,StartByte+ByteNbr+LineNbr*(BYTES_PER_LINE)];
        if ((ThisByte>$1F) or (ThisByte=0)) then write(chr(ThisByte))
        else
          begin
            SavedAttrib:=TextAttr;
            TextAttr:=(TextAttr and $77) shl 4;
            write(chr(ThisByte + $40));
            TextAttr:=SavedAttrib;
          end;
      end;
   end
  else writeln(space(79));
end;

procedure RefreshScreen;

begin
  ClrScr;
  GotoXY(MIN_ROW,MIN_LINE);
  write(PNAM);

  DisplayCommand(CommandBuffer, CommandNumber);
  DisplayBuffer(DataBuffer, DataBufferNbr);

  GotoXY(MIN_ROW,INSTR_LINE);
  write(PROMPT);
end;


procedure GetInstruction;
begin
  SavedInstruction:=Instruction;
  GotoXY(MIN_ROW,INSTR_LINE);
  write(PROMPT,space(MAX_ROW-length(PROMPT)-1));
  GotoXY(MIN_ROW+length(PROMPT),INSTR_LINE);
  SetCursor(CURSOR_ON);
  readln(Instruction);
  SetCursor(CURSOR_OFF);
  Instruction:=ltrim(Upper(Instruction));
end;

procedure ModifyBuffer(Instruction: string; var BufferNbr:byte; WhichBuffer: char);

label error;

var k:                word;
    DataPointer,Replicate:      word;
    ThisToken, SubToken:        string;
    Offset, TokenNbr: byte;

begin
  DataPointer:=0;

  {process first token: Command}
  TokenNbr:=1;
  ThisToken:=token(Instruction,1);
  for k:=1 to length(ThisToken)
  do if ThisToken[k]=',' then ThisToken[k]:=' ';   {replace , with space}

  {first subtoken: BufferNumber}
  SubToken:=copy(token(ThisToken,1),2,$FF); { cut 1st character in 1st subtoken}
  if length(SubToken)>0
  then begin
   if LegalHex(SubToken,false)
   then
     if WhichBuffer in ['C','I','L','T','N'] then
       if Hex2Byte(SubToken)<=CMD_BUFFERS
       then BufferNbr:=Hex2Byte(SubToken)
       else begin
           Message(concat(ILLEGAL_CMD_NUMBER,ThisToken[1],SubToken),true);
           goto error;
         end
     else
       if WhichBuffer='D'then
         if Hex2Byte(SubToken)<=DATA_BUFFERS
         then BufferNbr:=Hex2Byte(SubToken)
         else begin
             Message(concat(ILLEGAL_DATA_NUMBER,ThisToken[1],SubToken),true);
             goto error;
           end
   else Message(concat(ILLEGAL_HEXBYTE,SubToken),true);
  end;

  {second subtoken: Offset}
  SubToken:=token(ThisToken,2);
  if length(SubToken)>0
  then begin
      if WhichBuffer in ['I','L','T','N']
      then begin
          Message(concat(NO_OFFSET,Subtoken),true);
          goto error;
        end;
      if LegalHex(SubToken,true)
      then
        begin
          DataPointer:=Hex2Integer(SubToken);
          DataBufferPointer[BufferNbr]:=DataPointer;
        end
      else  Message(concat(ILLEGAL_HEXBYTE,SubToken),true);
    end;

  {third subtoken: Replicate}
  Replicate:=1;
  SubToken:=token(ThisToken,3);
  if length(SubToken)>0
  then begin
      if WhichBuffer in ['I','L','T','N']
      then begin
          Message(concat(NO_REPLICATE,Subtoken),true);
          goto error;
        end;
      if LegalHex(SubToken,true)
      then Replicate:=Hex2Integer(SubToken)
      else  Message(concat(ILLEGAL_HEXBYTE,SubToken),true);
      if Replicate=0 then goto Error;
    end;


  {process further tokens}
   TokenNbr:=2;
   ThisToken:=token(Instruction,TokenNbr);
   while length(ThisToken)>0
   do
     begin
       if ((Replicate>1) and (TokenNbr>2))
       then begin
           Message(BYTES_IGNORED,true);
           goto Error;
         end;
       Case WhichBuffer of
        'C': if DataPointer>CMD_LENGTH
             then begin
                 if Replicate=1 then Message(concat(ILLEGAL_CMD_OFFSET,Integer2Hex(DataPointer)),true);
                 goto error;
               end;
        'D': if DataPointer>DATA_LENGTH
             then begin
                 if Replicate=1 then Message(concat(ILLEGAL_DATA_OFFSET,Integer2Hex(DataPointer)),true);
                 goto error;
               end;
        'I': if DataPointer>0
             then begin Message(concat(ILLEGAL_ID_OFFSET,Integer2Hex(DataPointer)),true); goto error; end;
        'L': if DataPointer>0
             then begin Message(concat(ILLEGAL_ID_OFFSET,Integer2Hex(DataPointer)),true); goto error; end;
       end;

       if LegalHex(ThisToken,false)
       then
         case WhichBuffer of
           'C': begin
                  CommandBuffer[BufferNbr].Status:=$FF; {No Command Executed}
                  for k:=1 to Replicate do begin
                    CommandBuffer[BufferNbr].Command[DataPointer]:=Hex2Byte(ThisToken);
                    inc(DataPointer);
                    if DataPointer>CMD_LENGTH then goto Error; {Done, no error message}
                  end;
                end;
           'D': begin
                  DataBufferPointer[BufferNbr]:=DataPointer;
                  for k:=1 to Replicate do begin
                    DataBuffer[BufferNbr,DataPointer]:=Hex2Byte(ThisToken);
                    inc(DataPointer);
                    if DataPointer>DATA_LENGTH+1 then goto Error; {Done, no error message}
                  end;
                end;
           'I': if Hex2Byte(ThisToken)<=MAX_ID
                then
                  begin
                    CommandBuffer[BufferNbr].ID:=Hex2Byte(ThisToken);
                    CommandBuffer[BufferNbr].Status:=$FF;
                  end
                else Message(concat(ILLEGAL_ID,ThisToken),true);
           'L': if Hex2Byte(ThisToken)<=MAX_ID
                then
                  begin
                    CommandBuffer[BufferNbr].LUN:=Hex2Byte(ThisToken);
                    CommandBuffer[BufferNbr].Status:=$FF;
                  end
                else Message(concat(ILLEGAL_LUN,ThisToken),true);
           'N': begin
                  CommandBuffer[BufferNbr].len:=Hex2Byte(ThisToken);
                  CommandBuffer[BufferNbr].Status:=$FF;
                end;
           'X': CommandBuffer[BufferNbr].Next:=Hex2Byte(ThisToken);
         end
       else begin
           Message(concat(ILLEGAL_HEXBYTE,ThisToken),true);
           goto Error;
         end;
       inc(TokenNbr);
       ThisToken:=token(Instruction,TokenNbr);
     end;
error:
end;

procedure DumpBuffer(var Buffer: Array of byte; Offset:byte; Length:byte; Tab:String);

const BYTES_PER_LINE:  byte=$10;

var ByteNbr, LineNbr: byte;
    StartByte: Integer;

begin
  StartByte:=Offset; ByteNbr:=0; LineNbr:=0;
  while StartByte < Offset+Length-1 do
  begin
   write(Tab, Byte2Hex(StartByte),': ');
   for ByteNbr:=0 to BYTES_PER_LINE-1 do
    if StartByte+ByteNbr < Offset+Length+1
    then write(Byte2Hex(Buffer[StartByte+ByteNbr]),' ')
    else write('  ');
   write('  ');
   for ByteNbr:=0 to BYTES_PER_LINE-1 do
    if StartByte+ByteNbr < Offset+Length+1
    then write(chr(Buffer[StartByte+ByteNbr]));
   LineNbr:=LineNbr+1;
   StartByte:=StartByte+BYTES_PER_LINE;
   writeln;
  end;
end;


procedure LoadDriver(WhichDriver: string);

var k: byte;

begin
  If length(WhichDriver)=0
  then
    begin
      if SCSIConnected = 'ASPI' then Message(ASPI_CONNECTED,true);
      if SCSIConnected = 'SIMUL' then Message(SIMULATOR_CONN,true);
      if SCSIConnected = '' then Message(NO_SCSI_DRIVER,true);
    end
  else
    begin
      if copy(WhichDriver,1,1)='A'
      then if InitializeASPI
           then begin SCSIConnected:='ASPI'; message(ASPI_CONNECTED,true); end
           else begin message(ASPI_OPEN_ERROR,true); SCSIConnected:='SIMUL'; end;
      if copy(WhichDriver,1,1)='S'
      then
      begin SCSIConnected:='SIMUL';
        message(SIMULATOR_CONN,true);
        for k:=0 to high(SenseData) do SenseData[k]:=0;
      end;
    end;
end;


procedure ExecuteInstruction;

var NextCommand: byte;

begin
  NextCommand:=CommandNumber;
  if instruction[1]<>'S' then SavedStatusLine:='';
  if length(Instruction)>0 then
  case Instruction[1] of
    'D': begin
           ModifyBuffer(Instruction,DataBufferNbr,'D');
           DisplayBuffer(DataBuffer,DataBufferNbr);
         end;
    'Q':  RunTime:=false;
    'G':  repeat
          begin
            DisplayCommand(CommandBuffer, NextCommand);
            UpdateStatus('**');
            if SCSIConnected='ASPI'
            then
              begin
                SCSI2SRB(SRB, CommandBuffer[NextCommand], DataBufferNbr);
                if SRB[SRB_SCSI_LEN]>1 then
                  begin
                    SRBexecute(SRB, Databuffer[DataBufferNbr]);
                    repeat keypressed {allow ^C} until SRB[SRB_STATUS]<>0;
                    SRB2SCSI(SRB, CommandBuffer[NextCommand]);
                  end
                else message(ASPI_MINIMUM,true);
              end;
            if SCSIConnected='SIMUL' then SCSISimulator(CommandBuffer[NextCommand], Databuffer[DataBufferNbr]);
            if SCSIConnected='' then Message(NO_SCSI_DRIVER,true);
            DisplayCommand(CommandBuffer, NextCommand);
            DisplayBuffer(DataBuffer,DataBufferNbr);
            if MaintMode
            then
              begin
                GotoXY(MIN_ROW,DATA_LINE+11);
                writeln('SRB dump:',space(MAX_ROW-1-length('SRB dump')));
                DumpBuffer(SRB, 00, $5F,'  ');
              end;
            NextCommand:=CommandBuffer[NextCommand].Next
          end;
          until ((NextCommand=$FF) or keypressed);
    'H': Message(HELP_MESSAGE,true);
    'I': begin
           ModifyBuffer(Instruction,CommandNumber,'I');
           DisplayCommand(CommandBuffer, CommandNumber);
         end;
    'C': begin
           ModifyBuffer(Instruction,CommandNumber,'C');
           DisplayCommand(CommandBuffer, CommandNumber);
         end;
    'L': begin
           ModifyBuffer(Instruction,CommandNumber,'L');
           DisplayCommand(CommandBuffer, CommandNumber);
         end;
    'M':  MaintMode:=not MaintMode;
    'N': begin
           ModifyBuffer(Instruction,CommandNumber,'N');
           DisplayCommand(CommandBuffer, CommandNumber);
         end;
    'R': LoadDriver(token(Instruction,2));

    'S': begin
            FileName:=token(Instruction,2);
            if length(FileName)>0 then
              begin
                Assign (Outfile,FileName);
                {$I-}
                rewrite (outfile);
                {$I+}
                if IOresult=0 then
                  begin
                    GotoXY(MIN_ROW,INSTR_LINE);
                    writeln(Prompt,SavedInstruction,space(MAX_ROW-length(PROMPT)-length(SavedInstruction)-1));
                    write(SavedStatusLine);
                    SaveScreen(outfile);
                    close (outfile);
                    gotoXY(MIN_ROW,INSTR_LINE);
                    writeln(PROMPT,Instruction,space(MAX_ROW-length(PROMPT)-length(Instruction)-1));
                    write(Space(79));
                    gotoXY(MIN_ROW+length(PROMPT),INSTR_LINE);
                  end
                else message(concat(ERROR_OPEN_OUTFILE,FileName),true);
            end;
         end;
    'X': begin
           ModifyBuffer(Instruction,CommandNumber,'X');
           DisplayCommand(CommandBuffer, CommandNumber);
         end;
    '?': Message(HELP_MESSAGE,true);
  else
    Message(ILLEGAL_INSTR,true)
  end;
end;

procedure initialize;

var BufNbr,ByteNbr : integer;

begin
  CommandNumber:=0;
  Instruction:='';
  SavedInstruction:=''
  {space(79-length(PROMPT))};
  SavedStatusLine:=''{space(79)};
  for BufNbr:=0 to CMD_BUFFERS do
    with CommandBuffer[BufNbr] do
    begin
      for ByteNbr:=0 to CMD_LENGTH do
        Command[ByteNbr]:=0;
      ID:=0;
      LUN:=0;
      Status:=$FF;
      Len:=0;
      TimeOut:=0;
      Next:=$FF;
    end;
  DataBufferNbr:=0;
  for BufNbr:=0 to DATA_BUFFERS do
    begin
      for ByteNbr:=0 to DATA_LENGTH do DataBuffer[BufNbr,ByteNbr]:=0;
      DataBufferPointer[BufNbr]:=0;
    end;
  RunTime:=true;
  MaintMode:=false;
end;

begin
  SetCursor(CURSOR_OFF);
  initialize;
  RefreshScreen;
  if InitializeASPI
  then begin SCSIConnected:='ASPI'; message(ASPI_CONNECTED,true); end
  else begin SCSIConnected:='SIMUL'; message(SIMULATOR_CONN,true); end;
  while RunTime do
    begin
      GetInstruction;
      ExecuteInstruction;
    end;
  SetCursor(CURSOR_ON);
end.