PROGRAM   EXAMPLE;                     {This is an example user}
                                       {program written in TURBO}
                                       {Pascal (4.0 or 5.0) which}
                                       {uses the TDRIVER memory}
                                       {resident software to write}
                                       {and read blocks of data to}
                                       {and from a 9 track tape drive}

USES      DOS,CRT;


CONST     TDINT =     $44;             {software interrupt vector}

          BLKSIZE =   1000;            {tape block size}
          NUMBLKS =   350;             {nbr of blocks to write}

TYPE      STR80 =     STRING[80];

          TF =                         {TDRIVER function codes}
                      (RUTHERE,ALLOC,FLUSH,W,WFM,ERS,
                       R,RR,MF,MB,MFF,MBF,REW,REWUL);


VAR       REG:        REGISTERS;


          BUF:        ARRAY[1..BLKSIZE]
                        OF BYTE;       {our I/O buffer space for}
                                       {reading/writing to tape}




PROCEDURE IO(F: TF);  FORWARD;


VAR       ABORTED:    BOOLEAN;         {Prevents endless recursion}
                                       {between ABORT and IO}

PROCEDURE ABORT(MSG:  STR80);          {Error termination procedure}
  BEGIN
  IF NOT ABORTED THEN
    BEGIN
    ABORTED:=TRUE;   WRITELN(CHR(7));   WRITELN(MSG);   IO(FLUSH);
    END;
  HALT;
  END {ABORT};




PROCEDURE FILLBUF;                     {Fills BUF w/ test values}
VAR  I:  INTEGER;
  BEGIN
  FOR I:=1 TO BLKSIZE DO BUF[I]:=LO(I);
  END {FILLBUF};




PROCEDURE TESTBUF;                     {Checks BUF contents}
VAR  I:  INTEGER;
  BEGIN
  FOR I:=1 TO BLKSIZE DO
    IF BUF[I] <> LO(I)
    THEN ABORT('The data read from tape is in error.');
  END {TESTBUF};




PROCEDURE IO{F: TF};                   {Performs tape I/O function}
VAR  S:  STRING[5];                    {via a call to TDRIVER and}
  BEGIN                                {checks result status code.}
  REG.AX:=ORD(F);   INTR(TDINT,REG);   {The INTR calls TDRIVER.}
  IF LO(REG.AX) <> 0 THEN
    BEGIN
    STR(LO(REG.AX),S);
    ABORT('Bad status code from tape driver software = ' + S);
    END;
  END {IO};




PROCEDURE WRITEOUT;                    {Writes blocks to tape}
VAR  I:  INTEGER;                      {does initial rewind and}
  BEGIN                                {writes 2 file marks at end}
  IO(REW);   FILLBUF;
  WRITELN;   WRITELN('Writing ',NUMBLKS,' blocks to tape:');

  FOR I:=1 TO NUMBLKS DO               {write NUMBLKS blocks}
    BEGIN                              {& check for end of tape}
    WRITE('.');
    REG.BX:=BLKSIZE;   REG.CX:=SEG(BUF);   REG.DX:=OFS(BUF);   IO(W);
    IF HI(REG.AX) <> 0 THEN ABORT('Writing off the end of tape.');
    END;

  WRITELN;
  IO(WFM);   IO(WFM);                  {write 2 file marks and}
  IO(FLUSH);                           {flush the buffer queue}
  END {WRITEOUT};




PROCEDURE READIN;                      {Reads blocks back from tape}
VAR  I:  INTEGER;                      {does initial rewind}
  BEGIN
  IO(REW);   WRITELN('Reading from tape:');   I:=0;

  REPEAT                               {read until a file mark}
    REG.BX:=BLKSIZE;   REG.CX:=SEG(BUF);   REG.DX:=OFS(BUF);   IO(R);
    WRITE('.');
    IF REG.BX <> 0 THEN
      BEGIN
      I:=I+1;                          {count blocks read}
      IF HI(REG.AX) <> 0 THEN ABORT('Tape blk size > buffer size.');
      IF REG.BX <> BLKSIZE             {check block size}
      THEN ABORT('Incorrect block size read from tape.');
      TESTBUF;                         {check the input data}
      END;
  UNTIL REG.BX = 0;

  WRITELN;   WRITE(I,' blocks read from tape.');
  IF I <> NUMBLKS
  THEN ABORT('Incorrect number of blocks read back.');
  IO(FLUSH);
  END {READIN};




PROCEDURE MP;                          {Main program procedure}
VAR  CH:  CHAR;
  BEGIN
  REG.BX:=9;   IO(RUTHERE);            {see if TDRIVER is loaded}
  IF REG.BX <> 81 THEN ABORT('TDRIVER is not in memory.');

  REG.BX:=BLKSIZE;   IO(ALLOC);        {allocate TDRIVER buffers}
  IF REG.BX = 0                        {using our block size}
  THEN ABORT('No TDRIVER buffers allocated.')
  ELSE WRITELN('TDRIVER has ',REG.BX,' buffers in its queue.');

  WRITELN;                             {ask for a tape load}
  WRITE('Load a tape on which I may write.   Ans "Y" to continue: ');
  CH:=READKEY;   WRITELN(CH);   IF UPCASE(CH) <> 'Y' THEN HALT;

  REPEAT                               {do a write/read cycle}
    WRITEOUT;   READIN;
    WRITE('   Ans "Y" to continue: ');   CH:=READKEY;   WRITELN(CH);
  UNTIL UPCASE(CH) <> 'Y';

  IO(FLUSH);   IO(REW);                {close out the tape}
  END {MP};



BEGIN
ABORTED:=FALSE;   WRITELN;   MP;
END.