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


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

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

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

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

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

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

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

54.1
date     91.03.18.15.33.39;  author jwh;  state Exp;
branches ;
next     53.3;

53.3
date     91.03.18.13.31.49;  author jwh;  state Exp;
branches ;
next     53.2;

53.2
date     91.03.15.16.12.09;  author jwh;  state Exp;
branches ;
next     53.1;

53.1
date     91.03.11.19.33.30;  author jwh;  state Exp;
branches ;
next     52.2;

52.2
date     91.03.11.16.53.00;  author jwh;  state Exp;
branches ;
next     52.1;

52.1
date     91.02.19.09.19.35;  author jwh;  state Exp;
branches ;
next     51.2;

51.2
date     91.02.18.20.50.32;  author jwh;  state Exp;
branches ;
next     51.1;

51.1
date     91.01.30.16.18.04;  author jwh;  state Exp;
branches ;
next     50.2;

50.2
date     91.01.30.09.22.04;  author jwh;  state Exp;
branches ;
next     50.1;

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

49.2
date     90.10.29.14.13.39;  author jwh;  state Exp;
branches ;
next     49.1;

49.1
date     90.08.14.14.15.48;  author jwh;  state Exp;
branches ;
next     48.2;

48.2
date     90.08.14.09.40.26;  author jwh;  state Exp;
branches ;
next     48.1;

48.1
date     90.07.26.11.22.19;  author jwh;  state Exp;
branches ;
next     47.2;

47.2
date     90.07.24.14.58.52;  author jwh;  state Exp;
branches ;
next     47.1;

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

46.1
date     90.05.07.08.54.36;  author jwh;  state Exp;
branches ;
next     45.2;

45.2
date     90.05.04.14.55.32;  author jwh;  state Exp;
branches ;
next     45.1;

45.1
date     90.04.19.16.02.34;  author jwh;  state Exp;
branches ;
next     44.2;

44.2
date     90.04.19.13.24.41;  author jwh;  state Exp;
branches ;
next     44.1;

44.1
date     90.04.01.22.19.52;  author jwh;  state Exp;
branches ;
next     43.3;

43.3
date     90.04.01.16.24.39;  author jwh;  state Exp;
branches ;
next     43.2;

43.2
date     90.03.22.11.44.28;  author jwh;  state Exp;
branches ;
next     43.1;

43.1
date     90.03.20.14.12.40;  author jwh;  state Exp;
branches ;
next     42.2;

42.2
date     90.03.19.16.12.25;  author jwh;  state Exp;
branches ;
next     42.1;

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

41.2
date     90.01.20.16.44.14;  author jwh;  state Exp;
branches ;
next     41.1;

41.1
date     89.12.22.11.38.49;  author jwh;  state Exp;
branches ;
next     40.2;

40.2
date     89.12.21.15.07.06;  author jwh;  state Exp;
branches ;
next     40.1;

40.1
date     89.09.29.11.59.50;  author jwh;  state Exp;
branches ;
next     39.2;

39.2
date     89.09.28.17.28.20;  author jwh;  state Exp;
branches ;
next     39.1;

39.1
date     89.09.26.16.44.38;  author dew;  state Exp;
branches ;
next     38.2;

38.2
date     89.09.26.14.44.21;  author dew;  state Exp;
branches ;
next     38.1;

38.1
date     89.08.29.11.36.47;  author jwh;  state Exp;
branches ;
next     37.2;

37.2
date     89.08.28.12.27.25;  author jwh;  state Exp;
branches ;
next     37.1;

37.1
date     89.05.12.11.50.38;  author dew;  state Exp;
branches ;
next     36.3;

36.3
date     89.05.12.09.16.36;  author quist;  state Exp;
branches ;
next     36.2;

36.2
date     89.05.11.11.48.12;  author quist;  state Exp;
branches ;
next     36.1;

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

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

34.1
date     89.01.23.16.19.07;  author jwh;  state Exp;
branches ;
next     33.2;

33.2
date     89.01.20.16.30.25;  author jwh;  state Exp;
branches ;
next     33.1;

33.1
date     89.01.16.11.50.18;  author dew;  state Exp;
branches ;
next     32.3;

32.3
date     89.01.13.11.31.43;  author dew;  state Exp;
branches ;
next     32.2;

32.2
date     89.01.11.10.22.05;  author jws;  state Exp;
branches ;
next     32.1;

32.1
date     89.01.10.11.59.58;  author bayes;  state Exp;
branches ;
next     31.2;

31.2
date     89.01.09.12.04.44;  author dew;  state Exp;
branches ;
next     31.1;

31.1
date     88.12.14.18.20.44;  author bayes;  state Exp;
branches ;
next     30.2;

30.2
date     88.12.14.13.37.29;  author bayes;  state Exp;
branches ;
next     30.1;

30.1
date     88.12.09.13.57.40;  author dew;  state Exp;
branches ;
next     29.2;

29.2
date     88.12.08.15.45.48;  author bayes;  state Exp;
branches ;
next     29.1;

29.1
date     88.10.31.15.42.18;  author bayes;  state Exp;
branches ;
next     28.2;

28.2
date     88.10.31.10.47.59;  author bayes;  state Exp;
branches ;
next     28.1;

28.1
date     88.10.06.11.08.17;  author dew;  state Exp;
branches ;
next     27.2;

27.2
date     88.10.05.17.46.56;  author bayes;  state Exp;
branches ;
next     27.1;

27.1
date     88.09.29.11.51.24;  author bayes;  state Exp;
branches ;
next     26.1;

26.1
date     88.09.28.13.51.13;  author bayes;  state Exp;
branches ;
next     25.3;

25.3
date     88.03.18.10.16.57;  author quist;  state Exp;
branches ;
next     25.2;

25.2
date     88.03.09.09.02.53;  author quist;  state Exp;
branches ;
next     25.1;

25.1
date     88.03.02.09.46.45;  author bayes;  state Exp;
branches ;
next     24.2;

24.2
date     88.03.01.10.04.52;  author bayes;  state Exp;
branches ;
next     24.1;

24.1
date     87.08.31.10.19.24;  author jws;  state Exp;
branches ;
next     23.2;

23.2
date     87.08.30.16.28.23;  author jws;  state Exp;
branches ;
next     23.1;

23.1
date     87.08.26.11.06.04;  author bayes;  state Exp;
branches ;
next     22.2;

22.2
date     87.08.25.20.14.56;  author jws;  state Exp;
branches ;
next     22.1;

22.1
date     87.08.17.11.45.17;  author bayes;  state Exp;
branches ;
next     21.2;

21.2
date     87.08.15.18.16.16;  author larry;  state Exp;
branches ;
next     21.1;

21.1
date     87.08.12.14.29.31;  author bayes;  state Exp;
branches ;
next     20.2;

20.2
date     87.08.12.11.50.41;  author bayes;  state Exp;
branches ;
next     20.1;

20.1
date     87.07.30.11.41.06;  author bayes;  state Exp;
branches ;
next     19.2;

19.2
date     87.07.29.19.25.37;  author larry;  state Exp;
branches ;
next     19.1;

19.1
date     87.06.01.08.55.05;  author jws;  state Exp;
branches ;
next     18.2;

18.2
date     87.05.31.16.09.41;  author jws;  state Exp;
branches ;
next     18.1;

18.1
date     87.05.20.16.00.04;  author bayes;  state Exp;
branches ;
next     17.2;

17.2
date     87.05.20.12.01.34;  author bayes;  state Exp;
branches ;
next     17.1;

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

16.1
date     87.04.26.16.13.51;  author jws;  state Exp;
branches ;
next     15.2;

15.2
date     87.04.24.19.21.23;  author jws;  state Exp;
branches ;
next     15.1;

15.1
date     87.04.13.09.55.28;  author jws;  state Exp;
branches ;
next     14.2;

14.2
date     87.04.12.18.34.56;  author jws;  state Exp;
branches ;
next     14.1;

14.1
date     87.04.01.16.06.20;  author jws;  state Exp;
branches ;
next     13.2;

13.2
date     87.04.01.11.22.59;  author jws;  state Exp;
branches ;
next     13.1;

13.1
date     87.02.28.18.56.45;  author jws;  state Exp;
branches ;
next     12.2;

12.2
date     87.02.28.16.56.44;  author jws;  state Exp;
branches ;
next     12.1;

12.1
date     87.02.02.13.50.44;  author jws;  state Exp;
branches ;
next     11.2;

11.2
date     87.02.02.11.32.33;  author jws;  state Exp;
branches ;
next     11.1;

11.1
date     87.01.19.10.17.09;  author jws;  state Exp;
branches ;
next     10.2;

10.2
date     87.01.18.20.12.32;  author jws;  state Exp;
branches ;
next     10.1;

10.1
date     86.12.24.12.04.46;  author jws;  state Exp;
branches ;
next     9.2;

9.2
date     86.12.23.18.17.38;  author jws;  state Exp;
branches ;
next     9.1;

9.1
date     86.12.12.15.17.05;  author bayes;  state Exp;
branches ;
next     8.2;

8.2
date     86.12.12.11.59.35;  author bayes;  state Exp;
branches ;
next     8.1;

8.1
date     86.11.27.12.25.28;  author jws;  state Exp;
branches ;
next     7.2;

7.2
date     86.11.26.18.33.01;  author jws;  state Exp;
branches ;
next     7.1;

7.1
date     86.11.20.14.40.25;  author hal;  state Exp;
branches ;
next     6.2;

6.2
date     86.11.19.17.40.29;  author bayes;  state Exp;
branches ;
next     6.1;

6.1
date     86.11.04.18.30.44;  author paws;  state Exp;
branches ;
next     5.2;

5.2
date     86.11.04.14.50.22;  author paws;  state Exp;
branches ;
next     5.1;

5.1
date     86.10.28.17.20.40;  author hal;  state Exp;
branches ;
next     4.2;

4.2
date     86.10.28.12.51.28;  author hal;  state Exp;
branches ;
next     4.1;

4.1
date     86.09.30.20.14.29;  author hal;  state Exp;
branches ;
next     3.2;

3.2
date     86.09.30.16.25.09;  author hal;  state Exp;
branches ;
next     3.1;

3.1
date     86.09.01.12.25.37;  author hal;  state Exp;
branches ;
next     2.4;

2.4
date     86.09.01.10.09.16;  author hal;  state Exp;
branches ;
next     2.3;

2.3
date     86.08.20.13.56.48;  author danm;  state Exp;
branches ;
next     2.2;

2.2
date     86.08.19.14.14.28;  author danm;  state Exp;
branches ;
next     2.1;

2.1
date     86.07.30.15.14.34;  author hal;  state Exp;
branches ;
next     1.3;

1.3
date     86.07.30.11.55.32;  author geli;  state Exp;
branches ;
next     1.2;

1.2
date     86.07.15.18.19.27;  author geli;  state Exp;
branches ;
next     1.1;

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


desc
@Base file for PWS 3.2 release.

@


56.3
log
@
pws2rcs automatic delta on Wed Jan 27 13:14:25 MST 1993
@
text
@					       (*

 (c) Copyright Hewlett-Packard Company, 1985.
All rights are reserved.  Copying or other
reproduction of this program except for archival
purposes is prohibited without the prior
written consent of Hewlett-Packard Company.


	    RESTRICTED RIGHTS LEGEND

Use, duplication, or disclosure by the Government
is subject to restrictions as set forth in
paragraph (b) (3) (B) of the Rights in Technical
Data and Computer Software clause in
DAR 7-104.9(a).

HEWLETT-PACKARD COMPANY
Fort Collins, Colorado                         *)

$COPYRIGHT 'COPYRIGHT (C) 1985 BY HEWLETT-PACKARD COMPANY'$
$SYSPROG$ $DEBUG OFF$ $RANGE OFF$
$ALLOW_PACKED ON$  { JWS 4/10/85 }

PROGRAM ETU(KEYBOARD,INPUT,OUTPUT);
$SEARCH 'LIBR:EDRIVER'$
IMPORT SYSGLOBALS,MISC,FS,CI,EDRIVER,ASM,SYSDEVS;

VAR
  KEYBOARD      : TEXT;

(****************************************************************************)
PROCEDURE COMMANDLEVEL;
CONST
  SH_EXC     = CHR(27);
  K16        = 16384;
  MINSC      = 8;
  MAXSC      = 31;

TYPE
  PROMPTTYPE = STRING80;
  BUFTYPE    = PACKED ARRAY[0..MAXINT] OF CHAR;
  BIGPTR     = ^BUFTYPE;
  PASSTYPE   = (CHECK,BURN,VERIFY);
TYPE
  EPROMPTR   = ^EPROMREC;
  EPROMREC   = RECORD
		 NEXT     : EPROMPTR;
		 BASEADDR : INTEGER;
		 EPSIZE   : INTEGER;
		 EPINC    : INTEGER;
		 PRESENT  : ARRAY[0..7] OF BOOLEAN;
		 ADDRESS  : ARRAY[0..7] OF INTEGER;
	       END;
  DIRSTATUS  = (DNEEDED,DWANTED,DONTCARE);
  CONTROL    = RECORD
		 CFIB      : FIB;
		 PATH      : INTEGER;
		 DIROPEN   : BOOLEAN;
		 FILEOPEN  : BOOLEAN;
		 USEUNIT   : BOOLEAN;
		 MOUNTED   : BOOLEAN;
		 CPVOL     : VID;
		 CVOL      : VID;
		 CFILE     : FID;
		 DSTATUS   : DIRSTATUS;
	       END;

VAR
  SCODE : INTEGER;
  OP    : CHAR;
  FASTBURN      : BOOLEAN;
  TEMP          : INTEGER;
  EPINFO        : EPINFOREC;
  ERROR         : EPERROR;

  HEAPINUSE     : BOOLEAN;

  ININFO        : CONTROL;

  SAVEIO        : INTEGER;
  SAVEESC       : INTEGER;
  LHEAP         : ANYPTR;
  EPROMLIST     : EPROMPTR;
  EPROMDATA     : EPROMPTR;
  LEFTTOXFER    : INTEGER;
  OUTPOSITION   : INTEGER;
  OUTSTARTA     : INTEGER;
  PASS          : INTEGER;

(****************************************************************************)
PROCEDURE FIXLOCK;
BEGIN
  IF LOCKLEVEL<>0 THEN
  BEGIN LOCKLEVEL := 1; LOCKDOWN; END;
END;    { FIXLOCK }

(****************************************************************************)
PROCEDURE PRINTIOERRMSG;
VAR
  MSG   : STRING[80];
BEGIN
  IF IORESULT<>ORD(INOERROR) THEN
  BEGIN
    GETIOERRMSG(MSG,IORESULT);
    WRITELN('Error: ',MSG,CTEOL);
    IF STREAMING THEN ESCAPE(-1);
  END;
END;    { PRINTIOERRMSG }

(****************************************************************************)
PROCEDURE SHOWPROMPT(P : PROMPTTYPE);
BEGIN WRITE(HOMECHAR,P,CTEOL); END;

(****************************************************************************)
PROCEDURE GOODIO;
BEGIN IF IORESULT<>ORD(INOERROR) THEN ESCAPE(0); END;

(****************************************************************************)
PROCEDURE BADIO(IOCODE : IORSLTWD);
BEGIN IORESULT := ORD(IOCODE); ESCAPE(0); END;

(****************************************************************************)
PROCEDURE BADMESSAGE(P : PROMPTTYPE);
BEGIN
  WRITELN(P,CTEOL);
  IF STREAMING THEN ESCAPE(-1) ELSE BADIO(INOERROR);
END;    { BADMESSAGE }

(****************************************************************************)
PROCEDURE BADCOMMAND(C:CHAR);
BEGIN
  WRITELN('BAD COMMAND ''',C,'''',CTEOL);
  IF STREAMING THEN ESCAPE(-1) ELSE BADIO(INOERROR);
END;    { BADCOMMAND }

(****************************************************************************)
PROCEDURE READCHECK;
BEGIN
  IF IORESULT<>ORD(INOERROR) THEN
  BEGIN
    SAVEIO := IORESULT; WRITELN; IORESULT := SAVEIO;
    ESCAPE(0);
  END;
END;    { READCHECK }

(****************************************************************************)
PROCEDURE READNUMBER(VAR INT : INTEGER);
VAR
  I        : INTEGER;
  TI       : INTEGER;
  INSTRING : STRING[20];
BEGIN
  READLN(INSTRING);  GOODIO;
  INSTRING:=STRLTRIM(INSTRING);
  IF STRLEN(INSTRING)>0 THEN
  TRY
    IF INSTRING[1]=SH_EXC THEN ESCAPE(0);
    ZAPSPACES(INSTRING);
    IF STRLEN(INSTRING)>0 THEN
    BEGIN
      TI  := 0;
      FOR I:=1 TO STRLEN(INSTRING) DO
	IF (INSTRING[I]<'0') OR (INSTRING[I]>'9') THEN BADIO(IBADVALUE)
	ELSE TI := TI * 10 + (ORD(INSTRING[I]) - ORD('0'));
      INT := TI;
    END;
  RECOVER
    IF ESCAPECODE=-4 THEN BADIO(IBADVALUE)
		     ELSE ESCAPE(ESCAPECODE);
END;    { READNUMBER }

(****************************************************************************)
FUNCTION UNITNUMBER(VAR FVID : VID):BOOLEAN;
LABEL 1;
VAR
  SL,I : INTEGER;
BEGIN
  UNITNUMBER := FALSE;
  SL := STRLEN(FVID);
  IF SL<2 THEN GOTO 1;
  IF FVID[1]<>'#' THEN GOTO 1;
  FOR I:=2 TO SL DO IF (FVID[I]<'0') OR (FVID[I]>'9') THEN GOTO 1;
  UNITNUMBER := TRUE;
1:END;
	{ UNITNUMBER }
(****************************************************************************)
PROCEDURE UPCCHAR(VAR CH : CHAR);
BEGIN IF ('a'<=CH) AND (CH<='z') THEN CH:=CHR(ORD(CH)-32); END;

(****************************************************************************)
PROCEDURE PROMPTREAD(P:PROMPTTYPE; VAR ANSWER:CHAR; LIST:PROMPTTYPE;
		     DEFAULT:CHAR);
LABEL 1;
VAR
  I    : INTEGER;
BEGIN
  IF (DEFAULT<>SH_EXC) AND STREAMING THEN ANSWER:=DEFAULT
  ELSE
  BEGIN
    WRITE(P,CTEOL);
    REPEAT
      READ(KEYBOARD,ANSWER); READCHECK; UPCCHAR(ANSWER);
      IF ANSWER=SH_EXC THEN  BEGIN WRITELN; BADIO(INOERROR); END;
      FOR I:=1 TO STRLEN(LIST) DO  { IS CHARACTER IN THE LIST ? }
	IF ANSWER=LIST[I] THEN GOTO 1;
      IF STREAMING THEN BADCOMMAND(ANSWER);
    UNTIL FALSE;
   1:WRITELN(ANSWER);
  END;
END;    { PROMPTREAD }

(****************************************************************************)
PROCEDURE PROMPTYORN(P : PROMPTTYPE; VAR ANSWER :CHAR);
BEGIN
  PROMPTREAD(P+' ? (Y/N) ',ANSWER,'YN','Y');
END;    { PROMPTYORN }

(****************************************************************************)
PROCEDURE MOUNTVOLUME(SD : PROMPTTYPE ;VAR FINFO : CONTROL);
VAR
  ANSWER        : CHAR;
  UNIT          : INTEGER;
  TEMPNAME      : VID;

BEGIN
  WITH FINFO DO
  BEGIN
    IF STREAMING THEN
    BEGIN
      WRITELN('VOLUME ',CPVOL,' NOT ONLINE WHILE STREAMING',CTEOL);
      ESCAPE(-1);
    END;

    TEMPNAME := CPVOL;
    UNIT     := FINDVOLUME(TEMPNAME,FALSE); { CHECK FOR BAD UNIT # }
    IORESULT := ORD(INOERROR);

    REPEAT
      { CONSTRUCT THE PROMPT }
      WRITE('Please mount',SD);
      IF STRLEN(CVOL)>0 THEN WRITE(' volume ',CVOL);
      IF ((STRLEN(SD)>0) OR (STRLEN(CVOL)>0)) AND USEUNIT THEN WRITE(' in');
      IF USEUNIT THEN WRITE(' unit ',CPVOL);
      WRITELN(CTEOL);
      PROMPTREAD('''C'' continues, <sh_exc> aborts ',ANSWER,'C','C');

      IF USEUNIT THEN TEMPNAME := CPVOL ELSE TEMPNAME := CVOL;
      CFIB.FUNIT := FINDVOLUME(TEMPNAME,TRUE);

      IF CFIB.FUNIT>0 THEN
      BEGIN
	IF IORESULT=ORD(INODIRECTORY) THEN
	BEGIN
	  IF DSTATUS<>DONTCARE THEN WRITELN('NO DIRECTORY ON ',CPVOL);
	  SETSTRLEN(TEMPNAME,0);
	  CASE DSTATUS OF
	    DNEEDED: CFIB.FUNIT := 0;
	    DWANTED: BEGIN
		       PROMPTYORN('Use current media',ANSWER);
		       IF ANSWER='N' THEN CFIB.FUNIT := 0
				     ELSE DSTATUS    := DONTCARE;
		     END;
	    OTHERWISE
	  END;   { CASE DSTATUS }
	END
	ELSE
	BEGIN
	  IF IORESULT<>ORD(INOERROR) THEN
	  BEGIN
	    PRINTIOERRMSG; CFIB.FUNIT := 0;
	  END
	  ELSE
	  BEGIN { FOUND A DIRECTORY }
	    IF CVOL='' THEN CVOL := TEMPNAME
	    ELSE
	    IF CVOL<>TEMPNAME THEN CFIB.FUNIT := 0;
	  END;
	END;
      END;
    UNTIL CFIB.FUNIT>0;
    CFIB.FVID := CVOL;
    MOUNTED   := TRUE;
  END;
END;    { MOUNT VOLUME }

(****************************************************************************)
PROCEDURE SPACEWAIT;
VAR
  ANSWER        : CHAR;
BEGIN
  PROMPTREAD('<space> continues, <sh_exc> aborts ',ANSWER,' ',' ');
END;    { SPACEWAIT }

(****************************************************************************)
  PROCEDURE PROMPTFORCHAR(PL : PROMPTTYPE; VAR CH : CHAR);
  BEGIN
    FGOTOXY(OUTPUT,0,0); WRITE(PL,' ? ',CTEOL);
    READ(KEYBOARD,CH);    READCHECK;
    UPCCHAR(CH); WRITELN(CH);
    FGOTOXY(OUTPUT,0,1); WRITELN(CTEOL);
  END;    { PROMPTFORCHAR }

$IOCHECK OFF$
(****************************************************************************)
PROCEDURE SETUPFIBFORFILE(FILENAME      : FID;
		      VAR LFIB          : FIB;
		      VAR VNAME         : VID);
VAR
  LKIND : FILEKIND;
  SEGS  : INTEGER;

BEGIN
  SEGS     := 0;
  IORESULT := ORD(INOERROR);
  WITH LFIB DO
    IF SCANTITLE(FILENAME,FVID,FTITLE,SEGS,LKIND) THEN
    BEGIN
      VNAME      := FVID;
      FUNIT      := FINDVOLUME(FVID,TRUE);
      FKIND      := LKIND;      FEFT := EFTTABLE^[LKIND];
      FOPTSTRING := NIL;        FBUFFERED  := TRUE;
      FPOS       := SEGS * 512; FREPTCNT   := 0;
      FANONYMOUS := FALSE;      FMODIFIED  := FALSE;
      FBUFCHANGED:= FALSE;      FSTARTADDRESS := 0;
      FLASTPOS   := -1;         PATHID     := -1;
      FNOSRMTEMP := TRUE;       FLOCKED    := TRUE;
      FEOF       := FALSE;      FEOLN      := FALSE;
    END
    ELSE BADIO(IBADTITLE);
END;    { SETUPFIBFORFILE }

(****************************************************************************)
PROCEDURE CLOSEDIR;
BEGIN
  WITH ININFO, CFIB DO
  BEGIN
    IF DIROPEN THEN
    BEGIN
      LOCKUP;       { LOCK KEYBOARD FOR THIS OPERATION }
      PATHID := PATH;   { RESTORE PATHID }
      CALL(UNITABLE^[FUNIT].DAM,CFIB,FUNIT,CLOSEDIRECTORY);
      DIROPEN := FALSE;
      LOCKDOWN;
    END;
  END;
END;    { CLOSEDIR }

(****************************************************************************)
PROCEDURE OPENDIR(FILENAME      : FID;
	      VAR SOURCEFILE    : FID;
		  PROMPT        : PROMPTTYPE;
	      VAR FINFO         : CONTROL;
	      VAR DIRCATENTRY   : CATENTRY);
VAR
  UNIT     : INTEGER;

BEGIN   { OPENDIR }
  IORESULT := ORD(INOERROR);
  WITH FINFO, CFIB DO
  TRY
    SETUPFIBFORFILE(FILENAME,CFIB,CPVOL);
    USEUNIT := UNITNUMBER(CPVOL);       DSTATUS := DNEEDED;
    IF USEUNIT THEN CVOL := '' ELSE CVOL := CPVOL;
    IF (FUNIT=0) OR UNITNUMBER(FVID) THEN MOUNTVOLUME(PROMPT,FINFO)
				     ELSE MOUNTED := TRUE;
    WITH UNITABLE^[FUNIT] DO
    BEGIN
      LOCKUP;           { LOCK KEYBOARD }
      FWINDOW    := ADDR(DIRCATENTRY);
      CALL(DAM,CFIB,FUNIT,OPENDIRECTORY);
      DIROPEN    := (IORESULT=ORD(INOERROR));
      IF DIROPEN THEN
      BEGIN
	PATH       := PATHID;
	SOURCEFILE := FTITLE;
	CVOL       := DIRCATENTRY.CNAME;
      END;
      LOCKDOWN;         { UNLOCK KEYBOARD }
      IF NOT DIROPEN THEN ESCAPE(0);    { OPENDIRECTORY FAILED }
    END
  RECOVER
    IF ESCAPECODE<>0 THEN ESCAPE(ESCAPECODE);
END;    { OPENDIR }

(****************************************************************************)
PROCEDURE INMOUNT(SWAP : BOOLEAN);
BEGIN
  IF NOT ININFO.MOUNTED THEN
  WITH ININFO, CFIB DO
  BEGIN
    MOUNTVOLUME(' SOURCE',ININFO);
    UNITABLE^[FUNIT].UMEDIAVALID := TRUE;
  END;
END;    { INMOUNT }

(****************************************************************************)
PROCEDURE CLOSEINFILE;
BEGIN
  WITH ININFO ,CFIB DO
  BEGIN
    IF FILEOPEN THEN
    BEGIN
      LOCKUP;
      FMODIFIED := FALSE;
      CALL(UNITABLE^[FUNIT].DAM,CFIB,FUNIT,CLOSEFILE);
      FILEOPEN := FALSE;
      LOCKDOWN;
    END;
  END;
END;    { CLOSEINFILE }


(****************************************************************************)
PROCEDURE CLOSEALL;
BEGIN CLOSEINFILE; CLOSEDIR; END;

(****************************************************************************)
PROCEDURE ANYTOMEM(       FFIB   : FIBP;
		   ANYVAR BUFFER : BIGPTR;
			  MAXBUF : INTEGER);
VAR
  BUFREC    :  ^STRING255;
  BUFPTR    :  ^CHAR;
  LEFTINBUF :  INTEGER;

BEGIN   { ANYTOMEM }
  BUFPTR    := ADDR(BUFFER^);
  BUFPTR^   := CHR(0);  { DATA COMMING }
  BUFREC    := ADDR(BUFPTR^,1);
  SETSTRLEN(BUFREC^,0); { ZERO LENGTH RECORD }
  BUFPTR    := ADDR(BUFREC^,1);
  LEFTINBUF := MAXBUF;

  WITH FFIB^, UNITABLE^[FUNIT] DO
  BEGIN
    CALL(AM,FFIB,READTOEOL,BUFREC^,255,FPOS);
    GOODIO;
    REPEAT
      GOODIO; { CHECK IORESULT FROM LAST READTOEOL }
      LEFTTOXFER := LEFTTOXFER - STRLEN(BUFREC^);
      IF LEFTTOXFER<0 THEN
      BEGIN     { CLIP THIS LINE AND FAKE END OF FILE }
	SETSTRLEN(BUFREC^,STRLEN(BUFREC^)+LEFTTOXFER);
	LEFTTOXFER := 0;
      END;
      BUFPTR := ADDR(BUFPTR^,STRLEN(BUFREC^));

      LEFTINBUF := LEFTINBUF - STRLEN(BUFREC^) - 2;
      IF STRLEN(BUFREC^) = 255 THEN BUFPTR := ADDR(BUFPTR^,-1)
      ELSE
      BEGIN
	IF STRLEN(BUFREC^)=0 THEN
	BEGIN { DISCARD THE LENGTH BYTE }
	  BUFPTR := ADDR(BUFREC^,-1);
	  LEFTINBUF := LEFTINBUF + {1} 2; {BUGFIX SFB 5/2/85--SAME AS IN
					   FILER AND FILEPACK}
	END;

	   { CHECK END OF LINE/FILE }
	CALL(AM,FFIB,READBYTES,BUFPTR^,1,FPOS);
	IF FEOLN THEN
	BEGIN  { END OF LINE }
	  BUFPTR^ := CHR(1);  FEOLN := FALSE;
	  LEFTINBUF := LEFTINBUF - 1; {BUGFIX SFB 5/2/85--SAME AS IN
				       FILER AND FILEPACK}
	  IF IORESULT = ORD(IEOF) THEN BUFPTR := ADDR(BUFPTR^,1);
	END;
	IF (IORESULT=ORD(IEOF)) OR (LEFTTOXFER=0) THEN
	BEGIN  { END OF FILE }
	  BUFPTR^  := CHR(2);
	  IORESULT := ORD(INOERROR);
	  FEOF     := TRUE;
	END;
	GOODIO;       { CHECK IORESULT FROM READBYTES }
      END;
      IF NOT ((LEFTINBUF < 259) OR FEOF) THEN
      BEGIN { SETUP FOR TO READ THE NEXT LINE }
	BUFPTR    := ADDR(BUFPTR^,1);
	BUFPTR^   := CHR(0);  { DATA RECORD }
	BUFREC    := ADDR(BUFPTR^,1);
	SETSTRLEN(BUFREC^,0); { ZERO LENGTH RECORD }
	BUFPTR    := ADDR(BUFREC^,1);
	CALL(AM,FFIB,READTOEOL,BUFREC^,255,FPOS);
      END;
    UNTIL (LEFTINBUF < 259) OR FEOF;
    BUFPTR := ADDR(BUFPTR^,1);    BUFPTR^ := CHR(3); { END BUFFER }
  END;
END;    { ANYTOMEM }

(****************************************************************************)
FUNCTION CHECKSPACE(START,SIZE:INTEGER; VAR OKSIZE:INTEGER):BOOLEAN;

VAR
  POINT : INTEGER;
  PART  : INTEGER;

BEGIN { CHECK SPACE }
  OKSIZE := -1; CHECKSPACE := FALSE;
  WITH EPROMDATA^ DO
  BEGIN
    { FIND THE PART CONTAINING THE START ADDRESS }
    PART := 0;
    WHILE PART<8 DO
    BEGIN
      IF (START>=ADDRESS[PART]) AND
	 (START<(ADDRESS[PART]+EPINC)) THEN
      BEGIN
	IF PRESENT[PART] THEN
	BEGIN   { FOUND START NOW FIND END POINT }
	  POINT := START + SIZE - 1;    { END POINT }
	  WHILE PART<8 DO
	  BEGIN
	    IF PRESENT[PART] THEN
	    BEGIN
	      IF (POINT<(ADDRESS[PART]+EPINC)) THEN
	      BEGIN     { IT ALL FITS }
		OKSIZE := SIZE; CHECKSPACE:=TRUE; PART := 8; { FORCE EXIT }
	      END
	      ELSE     { FIGURE SPACE SO FAR }
	      BEGIN
		OKSIZE := (ADDRESS[PART]+EPINC)-START;
		PART := PART + 1;
	      END;
	    END { IF PRESENT }
	    ELSE PART := 8;     { FORCE EXIT }
	  END;  { WHILE }
	END;    { IF PRESENT }
	PART := 8;      { FORCE EXIT }
      END       { IF ADDRESS IN RANGE }
      ELSE PART := PART + 1;
    END;        { WHILE }
  END;  { WITH EPROMDATA }
END;    { CHECKSPACE }

(****************************************************************************)
PROCEDURE PASSFAILED(FAILCODE:PASSTYPE);
VAR
  PART : INTEGER;
  UL   : CHAR;
  I    : INTEGER;

BEGIN
  WITH EPROMDATA^ DO
  BEGIN
    FOR I := 0 TO 7 DO
      IF (OUTPOSITION>=ADDRESS[I]) AND
	 (OUTPOSITION<(ADDRESS[I]+EPINC)) THEN PART := I;

    IF ODD(OUTPOSITION) THEN UL := 'L' ELSE UL := 'U';
    WRITE(FAILCODE,' FAIL');
    WRITELN(' AT ABSOLUTE ADDRESS ',OUTPOSITION:1);
    WRITELN(' BYTE POSITION ',OUTPOSITION-OUTSTARTA:1,' FROM START LOCATION');
    WRITELN(' EPROM SOCKET ',PART:1,UL,
	    ' BYTE ',(OUTPOSITION-ADDRESS[PART]) DIV 2:1);
  END;
  IF STREAMING THEN ESCAPE(-1) ELSE BADIO(INOERROR);
END;    { PASSFAILED }

(****************************************************************************)
PROCEDURE PRINTBR;
BEGIN
  FGOTOXY(OUTPUT,0,4); WRITE('Burn rate   ');
  IF FASTBURN THEN WRITE('FAST') ELSE WRITE('SLOW');
  WRITELN(CTEOL);
END;

(****************************************************************************)
PROCEDURE BURNIT(ANYVAR BUFFER   : WINDOW;
			SIZE     : INTEGER);
VAR
  OLDPOSIT : INTEGER;
  OLDX,OLDY: INTEGER;
BEGIN
  IF PASS=1 THEN
  BEGIN        { CHECK IF CAN BURN }
    ERROR:=EPROG(SCODE,ECHECK,BUFFER,SIZE,OUTPOSITION);
    IF ERROR<>ENOERROR THEN PASSFAILED(CHECK);
  END
  ELSE
  BEGIN        { TRY TO BURN IT }
    OLDPOSIT := OUTPOSITION;    { SAVE POSITION FOR RETRY }
    ERROR:=EPROG(SCODE,ECWRITE,BUFFER,SIZE,OUTPOSITION);
    IF ERROR<>ENOERROR THEN
      IF NOT FASTBURN THEN
      BEGIN
	IF ERROR=ECFAIL THEN PASSFAILED(VERIFY)
			ELSE PASSFAILED(BURN);
      END
      ELSE
      BEGIN
	FASTBURN := FALSE;      { SET BURN RATE TO SLOW }
	FGETXY(OUTPUT,OLDX,OLDY);       { UPDATE THE DISPLAY }
	PRINTBR;
	FGOTOXY(OUTPUT,OLDX,OLDY);
	ERROR := EBRATE(SCODE,FASTBURN);
	OUTPOSITION := OLDPOSIT;{ RESET POSITION AND RETRY }
	ERROR:=EPROG(SCODE,ECWRITE,BUFFER,SIZE,OUTPOSITION);
	IF ERROR<>ENOERROR THEN
	  IF ERROR=ECFAIL THEN PASSFAILED(VERIFY)
			  ELSE PASSFAILED(BURN);
      END;
  END;
  IORESULT:=ORD(INOERROR);      { CLEAR I/O RESULT }
END;    { BURNIT }

(****************************************************************************)
PROCEDURE MEMTOEPROM(ANYVAR BUFFER : BIGPTR);
VAR
  BYTES : INTEGER;
  BUFPTR: ^CHAR;

BEGIN
  BUFPTR := ADDR(BUFFER^);
  BEGIN
    BYTES := 0;
    REPEAT
      BUFPTR := ADDR(BUFPTR^,BYTES);
      BYTES  := ORD(BUFPTR^);
      BUFPTR := ADDR(BUFPTR^,1);
      CASE BYTES OF
      0: BEGIN          { DATA BYTES }
	   BYTES := ORD(BUFPTR^);       { RECORD LENGTH }
	   BUFPTR:= ADDR(BUFPTR^,1);
	   BURNIT(BUFPTR^,BYTES);
	 END;
      1: BEGIN          { END RECORD }
	   BYTES := 0;
	 END;
      2: BEGIN          { END FILE }
	   BYTES := -1;
	 END;
      3: BYTES := -1;   { END BUFFER }
      OTHERWISE IORESULT := ORD(IBADREQUEST);
      END;
      GOODIO;
    UNTIL BYTES<0;
  END;
END;    { MEMTOEPROM }

(****************************************************************************)
  FUNCTION CHECKCARD(SC:INTEGER):BOOLEAN;
  VAR
    ECODE : EPERROR;
  BEGIN
    ECODE:=EINIT(SC);
    CHECKCARD:=(ECODE=ENOERROR) OR (ECODE=ENOEPROM);
  END;  { CHECKCARD }

(****************************************************************************)
  PROCEDURE CHECKSCODE;
  BEGIN
    IF NOT CHECKCARD(SCODE)
      THEN BADMESSAGE('*** NO PROGRAMMER CARD IN SYSTEM ***');
  END;

(****************************************************************************)
  PROCEDURE CHECKEPROM;
  VAR
    I       : INTEGER;
    DONE    : BOOLEAN;

  BEGIN
    CHECKSCODE;
    ERROR:=EGETINFO(SCODE,EPINFO);
    IF EPINFO.EPSTART=0 THEN
      BADMESSAGE('NO EPROM CARD ATTACHED TO PROGRAMMER CARD');

    EPROMDATA := EPROMLIST;
    DONE := FALSE;
    REPEAT
      IF EPROMDATA=NIL THEN
      BEGIN
	NEW(EPROMDATA);
	WITH EPROMDATA^ , EPINFO DO
	BEGIN
	  BASEADDR  := EPSTART;
	  EPSIZE    := EPEND-EPSTART;
	  EPINC     := EPSIZE DIV 8;
	  ADDRESS[0]:= BASEADDR;
	  PRESENT[0]:= TRUE;
	  FOR I:=1 TO 7 DO
	  BEGIN
	    ADDRESS[I]:= ADDRESS[I-1]+EPINC;
	    PRESENT[I]:= TRUE;
	  END;
	  NEXT := EPROMLIST;
	  EPROMLIST := EPROMDATA;
	  DONE := TRUE;
	END;
      END
      ELSE
      BEGIN
	IF EPROMDATA^.BASEADDR=EPINFO.EPSTART THEN DONE := TRUE
	ELSE EPROMDATA := EPROMDATA^.NEXT;
      END;
    UNTIL DONE;
  END; { CHECKEPROM }

(****************************************************************************)
  PROCEDURE FINDCARD(SCODES:BOOLEAN);
  VAR
    SC : INTEGER;
  BEGIN
    FOR SC:=MINSC TO MAXSC DO
    IF CHECKCARD(SC) THEN
    BEGIN
      IF SCODES THEN WRITE(SC:3);
      SCODE := SC;
    END;
  END; { FINDCARD }

(****************************************************************************)
  PROCEDURE DOCONFIGURE(DOPROMPT:BOOLEAN);
  VAR
    DONE : BOOLEAN;
    OLDSCODE : INTEGER;
    OP       : CHAR;
    I        : INTEGER;

    {-------------------------------------------------------------------------}
    PROCEDURE PRINTSC;
    BEGIN
      FGOTOXY(OUTPUT,0,3);
      WRITELN('Active programmer card at select code ',SCODE:1,CTEOL);
    END;


    {-------------------------------------------------------------------------}
    PROCEDURE PRINTEPINFO;
    BEGIN
      FGOTOXY(OUTPUT,0,5);
      TRY
	CHECKEPROM;
	TEMP := EPINFO.EPEND-EPINFO.EPSTART;
	WRITELN('EPROM at address ',EPINFO.EPSTART:1,' for ',
		  TEMP:1,' bytes',CTEOL);
	WRITELN('EPROM type XX',TEMP DIV 2048:1,CTEOL);
      RECOVER
	IF ESCAPECODE<>0 THEN ESCAPE(ESCAPECODE);
    END;

    {-------------------------------------------------------------------------}
    PROCEDURE PRINTSOCKETS;
    VAR
      I : INTEGER;
    BEGIN
      FGOTOXY(OUTPUT,0,7);
      WRITELN('Socket status (UL means EPROM pair present)');
      WITH EPROMDATA^ DO
      FOR I:= 0 TO 3 DO
      BEGIN
	WRITE(I:1);
	IF PRESENT[I] THEN WRITE('UL    ') ELSE WRITE(' empty');
	WRITE(I+4:4);
	IF PRESENT[I+4] THEN WRITE('UL    ') ELSE WRITE(' empty');
	WRITELN;
      END;
    END;

    {-------------------------------------------------------------------------}
  BEGIN { DOCONFIGURE }
    FGOTOXY(OUTPUT,0,2); WRITE(CTEOS);
    CHECKSCODE;
    OLDSCODE:=SCODE;
    WRITE('Programmer card(s) at ');
    FINDCARD(TRUE);
    SCODE := OLDSCODE;
    PRINTSC;
    PRINTBR;
    PRINTEPINFO;
    IF EPINFO.EPSTART>0 THEN PRINTSOCKETS;
    IF DOPROMPT THEN
    REPEAT
    TRY
      PROMPTFORCHAR('CONFIGURE: Selectcode Burnrate Emptysockets Qt',OP);
      FGOTOXY(OUTPUT,0,13); WRITE(CTEOS);
      IF OP=SH_EXC THEN OP:='Q';

      IF OP='S' THEN
      BEGIN     { NEW SELECT CODE }
	OLDSCODE := SCODE;
	WRITE('New select code (',SCODE:1,') ? '); READNUMBER(SCODE);
	IF (SCODE<MINSC) OR (SCODE>MAXSC) THEN
	BEGIN SCODE := OLDSCODE; BADMESSAGE('SELECT CODE OUT OF RANGE'); END;
	IF NOT CHECKCARD(SCODE) THEN
	BEGIN
	  SCODE := OLDSCODE; BADMESSAGE('SELECT CODE NOT A PROGRAMMER CARD');
	END;
	PRINTSC;
	PRINTBR;
	PRINTEPINFO;
	IF EPINFO.EPSTART>0 THEN PRINTSOCKETS ELSE WRITE(CTEOS);
      END
      ELSE
      IF OP='B' THEN
      BEGIN
	FASTBURN := NOT FASTBURN; PRINTBR;
      END
      ELSE
      IF OP='E' THEN
      BEGIN
	IF EPINFO.EPSTART>0 THEN
	BEGIN
	  I := -1;
	  WRITE('SOCKET (PAIR) NUMBER ? ',CTEOL); READNUMBER(I);
	  IF I>=0 THEN
	    IF (I<0) OR (I>7) THEN BADMESSAGE('SOCKET NUMBER OUT OF RANGE')
	    ELSE
	    BEGIN
	      EPROMDATA^.PRESENT[I] := NOT EPROMDATA^.PRESENT[I];
	      PRINTSOCKETS;
	    END;
	END
	ELSE BEEP;
      END
      ELSE
      IF (OP<>'Q') THEN
	IF STREAMING THEN BADCOMMAND(OP)
		     ELSE BEEP;

    RECOVER
    BEGIN
      LOCKUP;
      SAVEIO       := IORESULT;
      SAVEESC      := ESCAPECODE;
      IORESULT     := SAVEIO;
      IF (SAVEESC<>0) AND (SAVEESC<>-10) THEN IORESULT := ORD(INOERROR);
      LOCKDOWN;
      PRINTIOERRMSG;
      FIXLOCK;
      IF SAVEESC<>0 THEN ESCAPE(SAVEESC) ELSE OP := ' ';
    END;

    UNTIL OP='Q';
  END; { DOCONFIGURE }

(****************************************************************************)
  PROCEDURE DOTRANSFER;
  TYPE
    HEADREC = PACKED ARRAY[0..17] OF BYTE;

    HEADP = RECORD
	      CASE BOOLEAN OF
	      TRUE : (BINT:INTEGER);
	      FALSE: (BPTR:^HEADREC);
	    END;
  VAR
    FILENAME1     : FID;
    SOURCEFILE    : FID;

    FILEMOVED     : BOOLEAN;
    DONE          : BOOLEAN;
    FORMAT        : BOOLEAN;

    I             : INTEGER;
    J             : INTEGER;
    EPART         : INTEGER;
    INSTATE       : INTEGER;
    OUTSTATE      : INTEGER;
    BUF           : BIGPTR;
    POSITION      : INTEGER;
    MOVESIZE      : INTEGER;
    MSIZE         : INTEGER;
    BUFSIZE       : INTEGER;
    OUTSIZE       : INTEGER;
    SAVEIO        : INTEGER;
    SAVEESC       : INTEGER;
    DUMWINDOW     : WINDOWP;
    EDHEADER      : HEADREC;
    MSGLINE       : STRING[255];
    DIRCATENTRY   : CATENTRY;
    BLANKCHK      : HEADP;
    ANSWER        : CHAR;

  BEGIN   { DOTRANSFER }
    DOCONFIGURE(FALSE);
    FGOTOXY(OUTPUT,0,13);
    WRITELN('TRANSFER OPERATION',CTEOS);
    CHECKEPROM;

    WRITE('Source (',DKVID,':) ? ');
    READLN(FILENAME1);     GOODIO;
    FILENAME1 := STRLTRIM(STRRTRIM(FILENAME1));
    IF STRLEN(FILENAME1)=0 THEN FILENAME1:=DKVID+':';
    ZAPSPACES(FILENAME1);
    IF STRLEN(FILENAME1)>0 THEN
    WITH EPROMDATA^ DO
    BEGIN { HAVE A SOURCE NAME }
      WITH ININFO DO
	BEGIN DIROPEN := FALSE; FILEOPEN := FALSE; MOUNTED := FALSE; END;
      MARK(LHEAP);  HEAPINUSE := TRUE;
      NEWWORDS(DUMWINDOW,1);  { DUMMY WINDOW FOR FILE TRANSFER }
      TRY
	WITH ININFO, CFIB DO
	BEGIN
	  { OPEN THE SOURCE }
	  SETUPFIBFORFILE(FILENAME1,CFIB,CPVOL);
	  IF STRLEN(FTITLE)=0 THEN
	  BEGIN { VOLUME -> EPROM }
	    USEUNIT := UNITNUMBER(CPVOL);     DSTATUS := DWANTED;
	    IF USEUNIT THEN CVOL := '' ELSE CVOL := CPVOL;
	    MOUNTED := (FUNIT>0) AND NOT(UNITNUMBER(FVID));
	    IF MOUNTED THEN CVOL := FVID ELSE INMOUNT(TRUE);

	    LOCKUP;   { LOCK THE KEYBOARD THEN OPEN THE VOLUME }
	    FBUFFERED := FALSE;
	    FKIND     := UNTYPEDFILE;     FEFT := EFTTABLE^[FKIND];
	    CALL(UNITABLE^[FUNIT].DAM,CFIB,FUNIT,OPENVOLUME);
	    FILEOPEN  := (IORESULT=ORD(INOERROR));
	    LOCKDOWN; { UNLOCK THE KEYBOARD }
	    GOODIO;
		      { FINISH THE SETUPT }
	    OUTSIZE    := FPEOF;
	    SOURCEFILE := '';
	    FTID       := '';
	    FORMAT     := FALSE;
	    FGOTOXY(OUTPUT,0,14);
	    WRITELN('TRANSFERRING VOLUME ',FVID,':');
	  END { VOLUME -> EPROM }
	  ELSE
	  BEGIN { FILE -> EPROM }
	    OPENDIR(FILENAME1,SOURCEFILE,' SOURCE',ININFO,DIRCATENTRY);
	    IF NOT DIROPEN THEN ESCAPE(0);
	    IF STRLEN(SOURCEFILE)=0 THEN
	       BADMESSAGE('CAN''T TRANSFER A DIRECTORY');
	    FTITLE := SOURCEFILE;
	    FINITB(CFIB,DUMWINDOW,-3);
	    PATHID := PATH;
	    LOCKUP;
	    CALL(UNITABLE^[FUNIT].DAM,CFIB,FUNIT,OPENFILE);
	    FILEOPEN := IORESULT=ORD(INOERROR);
	    LOCKDOWN;
	    GOODIO;
	    FORMAT := (FKIND=ASCIIFILE) OR (FKIND=TEXTFILE);
	    OUTSIZE := FLEOF;
	    FGOTOXY(OUTPUT,0,14);
	    WRITELN('TRANSFERING FILE ',CVOL,':',SOURCEFILE,CTEOL);
	  END; { FILE -> EPROM }
	END;   { WITH ININFO, CFIB -- OPEN THE SOURCE }

	{ ALLOCATE BUFFER SPACE }
	BUFSIZE := (MEMAVAIL DIV 256) * 256 - 30 * 512; {SAME SOME FOR SLOP}
	IF BUFSIZE<512 THEN ESCAPE(-2);       { NOT ENOUGH ROOM }
	NEWWORDS(BUF,BUFSIZE DIV 2);          { ALLOCATE BUFFER SPACE }

	{ GET START ADDRESS ON EPROM }
	MSGLINE := '';
	WITH EPINFO DO
	IF SOURCEFILE='' THEN
	BEGIN     { VOLUME TRANSFER }
	  { SET DEFAULT START BLOCK }
	  TEMP := 0;
	  OUTSTARTA := EPSTART ;
	  DONE := FALSE;
	  REPEAT
	    IF PRESENT[TEMP] THEN
	    BEGIN       { SOCKET PRESENT, CHECK CONTENTS }
	      BLANKCHK.BINT := OUTSTARTA;
	      IF (BLANKCHK.BPTR^[0]=255) AND
		 (BLANKCHK.BPTR^[1]=255) THEN DONE := TRUE
	      ELSE
	      BEGIN     { INCREMENT TO NEXT BLOCK }
		OUTSTARTA := OUTSTARTA+K16;
		IF TEMP<7 THEN
		  IF OUTSTARTA>=ADDRESS[TEMP+1] THEN TEMP := TEMP+1;
	      END;
	    END
	    ELSE
	    BEGIN       { SKIP EMPTY SOCKET PAIR }
	      IF TEMP<7 THEN TEMP := TEMP+1;
	      OUTSTARTA := OUTSTARTA+EPINC;
	    END;
	  UNTIL DONE OR (OUTSTARTA>EPEND);

	  IF OUTSTARTA>EPEND THEN
	  BEGIN
	    WRITELN('*** NO BLANK BLOCK ON THIS EPROM CARD ***');
	    OUTSTARTA:=EPSTART;
	  END;
	  OUTSTARTA := (OUTSTARTA-EPSTART) DIV K16;

	  WRITE('Start at EPROM block offset (',OUTSTARTA:1,') ? ');
	  READNUMBER(OUTSTARTA); OUTSTARTA:=OUTSTARTA*K16;
	  STRWRITE(MSGLINE,1,I,'BLOCK OFFSET NOT IN RANGE 0..',
			       (EPSIZE DIV K16)-1:1);
	END
	ELSE
	BEGIN     { FILE TRANSFER }
	  OUTSTARTA := 0;        { DEFAULT VALUE }
	  WRITE('Start at EPROM byte offset (',OUTSTARTA:1,') ? ');
	  READNUMBER(OUTSTARTA);
	  STRWRITE(MSGLINE,1,I,'BYTE OFFSET NOT IN RANGE 0..',EPSIZE-1:1);
	END;

	IF OUTSTARTA>(EPSIZE-1) THEN BADMESSAGE(MSGLINE);
	OUTSTARTA := OUTSTARTA + EPINFO.EPSTART;

	{ CHECK TO SEE IF DATA WILL FIT IN AVAILABLE EPROM SPACE }
	J := OUTSIZE;     { VOL / FILE SIZE }
	IF SOURCEFILE='' THEN
	BEGIN
	  J := J + 18; { ADD HEADER }
	  J := J + (J DIV K16)*2; { ADD 16K HEADER GAPS }
	END;
	IF NOT CHECKSPACE(OUTSTARTA,J,I) THEN
	BEGIN
	  IF I<=0 THEN
	  BEGIN WRITELN('NO EPROM AT START ADDRESS'); BADIO(INOERROR); END;

	  WRITELN('DATA EXCEEDS EPROM SPACE BY ',J-I:1,' BYTES',CTEOL);
	  IF STREAMING THEN ESCAPE(-1);
	  PROMPTREAD('Abort transfer or Truncate file (A/T) ? ',
		      ANSWER,'AT',SH_EXC);
	  IF ANSWER='A' THEN ESCAPE(0);
	  IF SOURCEFILE='' THEN
	  BEGIN
	    OUTSIZE := (I-18); OUTSIZE := OUTSIZE - (OUTSIZE DIV K16)*2;
	  END
	  ELSE OUTSIZE := I;
	END;

	INSTATE  := 1;
	PASS     := 1;

	BEGIN       { TRY THE TRANSFER }
	    FILEMOVED := FALSE;
	    WITH ININFO, CFIB , EPROMDATA^ DO
	    REPEAT    { MOVE THE FILE }
	      DONE := FALSE;
	      REPEAT
		CASE INSTATE OF
		1: BEGIN      { INITIALIZE SOURCE PARAMETERS }
		     FGOTOXY(OUTPUT,0,16);
		     WRITELN('now on pass ',PASS:1,CTEOS);
		     OUTPOSITION := OUTSTARTA;
		     LEFTTOXFER  := OUTSIZE;
		     POSITION    := 0;
		     FEOF        := FALSE;   FEOLN    := FALSE;
		     FLASTPOS    := -1;      FPOS     := 0;
		     INSTATE     := 2;
		     OUTSTATE    := 1;
		   END;
		2: BEGIN      { READ THE FILE/VOLUME }
		     WRITE('reading ....',CTEOL,CHR(13));
		     IF FORMAT THEN
		     BEGIN    { FORMATED TRANSFER }
		       ANYTOMEM(ADDR(CFIB),BUF,BUFSIZE);
		       DONE := TRUE;
		       IF FEOF THEN LEFTTOXFER := 0;
		       GOODIO;
		     END
		     ELSE
		     BEGIN    { UNFORMATED TRANSFER }
		       IF BUFSIZE>LEFTTOXFER THEN MOVESIZE := LEFTTOXFER
					     ELSE MOVESIZE := BUFSIZE;
		       CALL(UNITABLE^[FUNIT].TM,ADDR(CFIB),READBYTES,
						BUF^,MOVESIZE,POSITION);
		       GOODIO;
		       LEFTTOXFER := LEFTTOXFER - MOVESIZE;
		       DONE := TRUE;
		     END;
		   END;
		END;  { CASE INSTATE }
	      UNTIL DONE;
	      WRITE(CTEOL);

	      DONE := FALSE;
	      IF NOT FILEMOVED THEN
	      REPEAT
		IF PASS=1 THEN WRITE('checking ...',CTEOL,CHR(13))
			  ELSE WRITE('writing ...',CTEOL,CHR(13));
		CASE OUTSTATE OF
		1: BEGIN
		     { SET BURN RATE }
		     ERROR:=EBRATE(SCODE,FASTBURN);
		     IF SOURCEFILE='' THEN
		     BEGIN        { VOLUME TRANSFER }
		       { PUT EDISC VOLUME HEADER }
		       FOR I := 0 TO 17 DO EDHEADER[I]:=0;
		       EDHEADER[0]:=HEX('F0');
		       EDHEADER[1]:=HEX('FF');
		       EDHEADER[2]:=ORD(' ');
		       EDHEADER[3]:=HEX('18');
		       EDHEADER[12]:=HEX('01');
		       EDHEADER[13]:=HEX('02');
		       BURNIT(EDHEADER,18);
		     END;
		     OUTSTATE := 2;
		   END;

		2: BEGIN  { WRITE DATA }
		     IF FORMAT THEN MEMTOEPROM(BUF)
		     ELSE
		     BEGIN
		       IF SOURCEFILE='' THEN
		       BEGIN      { TRANSFERING A VOLUME }
			 I := 0;
			 REPEAT
			   { WATCH FOR 16K BYTE BOUNDARIES }
			   MSIZE:=(((OUTPOSITION+K16) DIV K16)*K16)-OUTPOSITION;
			   IF MSIZE>MOVESIZE THEN MSIZE:=MOVESIZE;
			   BURNIT(BUF^[I],MSIZE);
			   I := I + MSIZE;
			   MOVESIZE := MOVESIZE - MSIZE;
			   IF ((OUTPOSITION MOD K16)=0) AND
			      ((MOVESIZE>0) OR (LEFTTOXFER>0)) THEN
			   BEGIN        { PUT ZEROES IN BOUNDARY BYTES }
			     J:=0; BURNIT(J,2);
			   END;
			 UNTIL MOVESIZE=0;
		       END
		       ELSE
		       BEGIN      { TRANSFERING A FILE }
			 BURNIT(BUF^,MOVESIZE);
		       END;
		     END;
		     DONE:=TRUE;
		     IF LEFTTOXFER=0 THEN
		     BEGIN
		       IF PASS=2 THEN FILEMOVED:=TRUE
		       ELSE
		       BEGIN  PASS:=2; INSTATE := 1; END;
		     END;
		   END;
		END;      { CASE OUTSTATE }
	      UNTIL DONE;
	      WRITE(CTEOL);
	    UNTIL FILEMOVED;
	    WRITELN('TRANSFER COMPLETED');
	    IF FORMAT THEN I := OUTPOSITION-OUTSTARTA
		      ELSE I := OUTSIZE;
	    WRITELN(I:1,' data bytes programmed and verified');
	  END;
	RELEASE(LHEAP);       HEAPINUSE := FALSE;
	CLOSEALL;
      RECOVER
      BEGIN
	LOCKUP;
	RELEASE(LHEAP);       HEAPINUSE := FALSE;
	SAVEIO    := IORESULT;
	SAVEESC   := ESCAPECODE;
	CLOSEALL;
	IORESULT  := SAVEIO;
	LOCKDOWN;
	PRINTIOERRMSG;
	IF SAVEESC<>0 THEN ESCAPE(SAVEESC);
      END;
    END;  { HAVE SOURCE NAME }
  END;    { DOTRANSFER }

(****************************************************************************)
  PROCEDURE PUTMENU(MSTRING:STRING80);
  BEGIN
    FGOTOXY(OUTPUT,0,2);
    WRITE(MSTRING,' ? ',CTEOL);
  END;

(****************************************************************************)
  PROCEDURE DOBLANKCHECK;
  TYPE
    TWOBYTES = PACKED ARRAY[0..1] OF BYTE;
  VAR
    OLDSTART    : INTEGER;
    START       : INTEGER;
    ENDSCAN     : INTEGER;
    NBYTES      : INTEGER;
    BLANKS      : BOOLEAN;
    LINES       : INTEGER;
    I           : INTEGER;
    X,Y         : INTEGER;
    BREC        : RECORD
		    CASE BOOLEAN OF
		    TRUE:(BPTR : ^TWOBYTES);
		    FALSE:(BINT : INTEGER);
		  END;
  BEGIN
    DOCONFIGURE(FALSE);
    FGOTOXY(OUTPUT,0,13);
    WRITELN('BLANK CHECK',CTEOS);
    CHECKEPROM;
    OLDSTART := 0;
    BLANKS := FALSE;
    FGETXY(OUTPUT,X,Y); LINES := 0;
    WITH EPROMDATA^ DO
    FOR I:=0 TO 7 DO    { DO ONE SOCKET PAIR AT A TIME }
    IF NOT PRESENT[I] THEN
    BEGIN       { CLOSE OFF REPORT OF PREVIOUS PAIR }
      IF BLANKS THEN
	 WRITELN(BREC.BINT-1-BASEADDR:1,' (',BREC.BINT-OLDSTART:1,')');
      BLANKS:=FALSE
    END
    ELSE
    BEGIN       { SOCKET PAIR PRESENT SO CHECK IT OUT }
      BREC.BINT := ADDRESS[I] ;
      ENDSCAN := BREC.BINT + EPINC;
      REPEAT
	IF BLANKS THEN
	BEGIN
	  IF BREC.BPTR^[0]<>255 THEN
	  BEGIN
	    WRITELN(BREC.BINT-1-BASEADDR:1,' (',BREC.BINT-OLDSTART:1,')');
	    BLANKS:=FALSE;
	  END;
	END
	ELSE
	BEGIN
	  IF BREC.BPTR^[0]=255 THEN
	  BEGIN
	    IF LINES>5 THEN
	    BEGIN
	      LINES := 0; SPACEWAIT;
	      FGOTOXY(OUTPUT,X,Y); WRITE(CTEOS);
	    END;
	    LINES := LINES + 1;
	    OLDSTART := BREC.BINT; WRITE(OLDSTART-BASEADDR,' - ');
	    BLANKS:=TRUE;
	  END;
	END;
	BREC.BINT := BREC.BINT + 1;
      UNTIL BREC.BINT=ENDSCAN;

      IF BLANKS AND (I=7) THEN
	 WRITELN(BREC.BINT-1-BASEADDR:1,' (',BREC.BINT-OLDSTART:1,')');

    END; { FOR I := ... }
    IF OLDSTART=0 THEN WRITELN('NO BLANK SPACE FOUND');
  END;  { DOBLANKCHECK }

(****************************************************************************)
BEGIN  { COMMANDLEVEL }
  FIXLOCK;
  WITH ININFO DO BEGIN DIROPEN:=FALSE; FILEOPEN:=FALSE; END;
  HEAPINUSE := FALSE;
  IORESULT  := ORD(INOERROR);
  SCODE := 0;     TEMP := 0;
  FASTBURN := FALSE;    { DEFAULT BURN RATE }
  EPROMLIST := NIL;     { NO EPROM CARD INFO YET }
  FINDCARD(FALSE);      { FIND A PROGRAMMER CARD }
  TRY
    DOCONFIGURE(FALSE); { DISPLAY DEFAULT CONFIGURATION }
  RECOVER
    IF ESCAPECODE<>0 THEN ESCAPE(ESCAPECODE);

  FGOTOXY(OUTPUT,0,13);
  WRITELN('Copyright Hewlett-Packard Company, 1983, 1991.');
  WRITELN('          All rights are reserved.');

  REPEAT
    TRY
      PROMPTFORCHAR('ETU: Transfer Configure Blankcheck Quit',OP);
      IF OP=SH_EXC THEN OP:='Q';

      IF OP='T' THEN DOTRANSFER
      ELSE
      IF OP='C' THEN DOCONFIGURE(TRUE)
      ELSE
      IF OP='B' THEN DOBLANKCHECK
      ELSE
      IF OP='Q' THEN BEGIN END
      ELSE
      IF STREAMING THEN BADCOMMAND(OP)
		   ELSE BEEP;
    RECOVER
    BEGIN
      LOCKUP;
      IF HEAPINUSE THEN RELEASE(LHEAP);
      HEAPINUSE    := FALSE;
      SAVEIO       := IORESULT;
      SAVEESC      := ESCAPECODE;
      CLOSEALL;
      IORESULT     := SAVEIO;
      IF (SAVEESC<>0) AND (SAVEESC<>-10) THEN IORESULT := ORD(INOERROR);
      LOCKDOWN;
      PRINTIOERRMSG;
      FIXLOCK;
      IF SAVEESC<>0 THEN ESCAPE(SAVEESC) ELSE OP := ' ';
    END;
  UNTIL OP='Q';
END {COMMANDLEVEL} ;

(****************************************************************************)
BEGIN
  WRITELN(CLEARSCR);
  FGOTOXY(OUTPUT,0,1);
  WRITELN('EPROM TRANSFER UTILITY (28-Oct-91)');
  COMMANDLEVEL;
END.

@


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


56.1
log
@Automatic bump of revision number for PWS version 3.25
@
text
@a0 1289
					       (*

 (c) Copyright Hewlett-Packard Company, 1985.
All rights are reserved.  Copying or other
reproduction of this program except for archival
purposes is prohibited without the prior
written consent of Hewlett-Packard Company.


	    RESTRICTED RIGHTS LEGEND

Use, duplication, or disclosure by the Government
is subject to restrictions as set forth in
paragraph (b) (3) (B) of the Rights in Technical
Data and Computer Software clause in
DAR 7-104.9(a).

HEWLETT-PACKARD COMPANY
Fort Collins, Colorado                         *)

$COPYRIGHT 'COPYRIGHT (C) 1985 BY HEWLETT-PACKARD COMPANY'$
$SYSPROG$ $DEBUG OFF$ $RANGE OFF$
$ALLOW_PACKED ON$  { JWS 4/10/85 }

PROGRAM ETU(KEYBOARD,INPUT,OUTPUT);
$SEARCH 'LIBR:EDRIVER'$
IMPORT SYSGLOBALS,MISC,FS,CI,EDRIVER,ASM,SYSDEVS;

VAR
  KEYBOARD      : TEXT;

(****************************************************************************)
PROCEDURE COMMANDLEVEL;
CONST
  SH_EXC     = CHR(27);
  K16        = 16384;
  MINSC      = 8;
  MAXSC      = 31;

TYPE
  PROMPTTYPE = STRING80;
  BUFTYPE    = PACKED ARRAY[0..MAXINT] OF CHAR;
  BIGPTR     = ^BUFTYPE;
  PASSTYPE   = (CHECK,BURN,VERIFY);
TYPE
  EPROMPTR   = ^EPROMREC;
  EPROMREC   = RECORD
		 NEXT     : EPROMPTR;
		 BASEADDR : INTEGER;
		 EPSIZE   : INTEGER;
		 EPINC    : INTEGER;
		 PRESENT  : ARRAY[0..7] OF BOOLEAN;
		 ADDRESS  : ARRAY[0..7] OF INTEGER;
	       END;
  DIRSTATUS  = (DNEEDED,DWANTED,DONTCARE);
  CONTROL    = RECORD
		 CFIB      : FIB;
		 PATH      : INTEGER;
		 DIROPEN   : BOOLEAN;
		 FILEOPEN  : BOOLEAN;
		 USEUNIT   : BOOLEAN;
		 MOUNTED   : BOOLEAN;
		 CPVOL     : VID;
		 CVOL      : VID;
		 CFILE     : FID;
		 DSTATUS   : DIRSTATUS;
	       END;

VAR
  SCODE : INTEGER;
  OP    : CHAR;
  FASTBURN      : BOOLEAN;
  TEMP          : INTEGER;
  EPINFO        : EPINFOREC;
  ERROR         : EPERROR;

  HEAPINUSE     : BOOLEAN;

  ININFO        : CONTROL;

  SAVEIO        : INTEGER;
  SAVEESC       : INTEGER;
  LHEAP         : ANYPTR;
  EPROMLIST     : EPROMPTR;
  EPROMDATA     : EPROMPTR;
  LEFTTOXFER    : INTEGER;
  OUTPOSITION   : INTEGER;
  OUTSTARTA     : INTEGER;
  PASS          : INTEGER;

(****************************************************************************)
PROCEDURE FIXLOCK;
BEGIN
  IF LOCKLEVEL<>0 THEN
  BEGIN LOCKLEVEL := 1; LOCKDOWN; END;
END;    { FIXLOCK }

(****************************************************************************)
PROCEDURE PRINTIOERRMSG;
VAR
  MSG   : STRING[80];
BEGIN
  IF IORESULT<>ORD(INOERROR) THEN
  BEGIN
    GETIOERRMSG(MSG,IORESULT);
    WRITELN('Error: ',MSG,CTEOL);
    IF STREAMING THEN ESCAPE(-1);
  END;
END;    { PRINTIOERRMSG }

(****************************************************************************)
PROCEDURE SHOWPROMPT(P : PROMPTTYPE);
BEGIN WRITE(HOMECHAR,P,CTEOL); END;

(****************************************************************************)
PROCEDURE GOODIO;
BEGIN IF IORESULT<>ORD(INOERROR) THEN ESCAPE(0); END;

(****************************************************************************)
PROCEDURE BADIO(IOCODE : IORSLTWD);
BEGIN IORESULT := ORD(IOCODE); ESCAPE(0); END;

(****************************************************************************)
PROCEDURE BADMESSAGE(P : PROMPTTYPE);
BEGIN
  WRITELN(P,CTEOL);
  IF STREAMING THEN ESCAPE(-1) ELSE BADIO(INOERROR);
END;    { BADMESSAGE }

(****************************************************************************)
PROCEDURE BADCOMMAND(C:CHAR);
BEGIN
  WRITELN('BAD COMMAND ''',C,'''',CTEOL);
  IF STREAMING THEN ESCAPE(-1) ELSE BADIO(INOERROR);
END;    { BADCOMMAND }

(****************************************************************************)
PROCEDURE READCHECK;
BEGIN
  IF IORESULT<>ORD(INOERROR) THEN
  BEGIN
    SAVEIO := IORESULT; WRITELN; IORESULT := SAVEIO;
    ESCAPE(0);
  END;
END;    { READCHECK }

(****************************************************************************)
PROCEDURE READNUMBER(VAR INT : INTEGER);
VAR
  I        : INTEGER;
  TI       : INTEGER;
  INSTRING : STRING[20];
BEGIN
  READLN(INSTRING);  GOODIO;
  INSTRING:=STRLTRIM(INSTRING);
  IF STRLEN(INSTRING)>0 THEN
  TRY
    IF INSTRING[1]=SH_EXC THEN ESCAPE(0);
    ZAPSPACES(INSTRING);
    IF STRLEN(INSTRING)>0 THEN
    BEGIN
      TI  := 0;
      FOR I:=1 TO STRLEN(INSTRING) DO
	IF (INSTRING[I]<'0') OR (INSTRING[I]>'9') THEN BADIO(IBADVALUE)
	ELSE TI := TI * 10 + (ORD(INSTRING[I]) - ORD('0'));
      INT := TI;
    END;
  RECOVER
    IF ESCAPECODE=-4 THEN BADIO(IBADVALUE)
		     ELSE ESCAPE(ESCAPECODE);
END;    { READNUMBER }

(****************************************************************************)
FUNCTION UNITNUMBER(VAR FVID : VID):BOOLEAN;
LABEL 1;
VAR
  SL,I : INTEGER;
BEGIN
  UNITNUMBER := FALSE;
  SL := STRLEN(FVID);
  IF SL<2 THEN GOTO 1;
  IF FVID[1]<>'#' THEN GOTO 1;
  FOR I:=2 TO SL DO IF (FVID[I]<'0') OR (FVID[I]>'9') THEN GOTO 1;
  UNITNUMBER := TRUE;
1:END;
	{ UNITNUMBER }
(****************************************************************************)
PROCEDURE UPCCHAR(VAR CH : CHAR);
BEGIN IF ('a'<=CH) AND (CH<='z') THEN CH:=CHR(ORD(CH)-32); END;

(****************************************************************************)
PROCEDURE PROMPTREAD(P:PROMPTTYPE; VAR ANSWER:CHAR; LIST:PROMPTTYPE;
		     DEFAULT:CHAR);
LABEL 1;
VAR
  I    : INTEGER;
BEGIN
  IF (DEFAULT<>SH_EXC) AND STREAMING THEN ANSWER:=DEFAULT
  ELSE
  BEGIN
    WRITE(P,CTEOL);
    REPEAT
      READ(KEYBOARD,ANSWER); READCHECK; UPCCHAR(ANSWER);
      IF ANSWER=SH_EXC THEN  BEGIN WRITELN; BADIO(INOERROR); END;
      FOR I:=1 TO STRLEN(LIST) DO  { IS CHARACTER IN THE LIST ? }
	IF ANSWER=LIST[I] THEN GOTO 1;
      IF STREAMING THEN BADCOMMAND(ANSWER);
    UNTIL FALSE;
   1:WRITELN(ANSWER);
  END;
END;    { PROMPTREAD }

(****************************************************************************)
PROCEDURE PROMPTYORN(P : PROMPTTYPE; VAR ANSWER :CHAR);
BEGIN
  PROMPTREAD(P+' ? (Y/N) ',ANSWER,'YN','Y');
END;    { PROMPTYORN }

(****************************************************************************)
PROCEDURE MOUNTVOLUME(SD : PROMPTTYPE ;VAR FINFO : CONTROL);
VAR
  ANSWER        : CHAR;
  UNIT          : INTEGER;
  TEMPNAME      : VID;

BEGIN
  WITH FINFO DO
  BEGIN
    IF STREAMING THEN
    BEGIN
      WRITELN('VOLUME ',CPVOL,' NOT ONLINE WHILE STREAMING',CTEOL);
      ESCAPE(-1);
    END;

    TEMPNAME := CPVOL;
    UNIT     := FINDVOLUME(TEMPNAME,FALSE); { CHECK FOR BAD UNIT # }
    IORESULT := ORD(INOERROR);

    REPEAT
      { CONSTRUCT THE PROMPT }
      WRITE('Please mount',SD);
      IF STRLEN(CVOL)>0 THEN WRITE(' volume ',CVOL);
      IF ((STRLEN(SD)>0) OR (STRLEN(CVOL)>0)) AND USEUNIT THEN WRITE(' in');
      IF USEUNIT THEN WRITE(' unit ',CPVOL);
      WRITELN(CTEOL);
      PROMPTREAD('''C'' continues, <sh_exc> aborts ',ANSWER,'C','C');

      IF USEUNIT THEN TEMPNAME := CPVOL ELSE TEMPNAME := CVOL;
      CFIB.FUNIT := FINDVOLUME(TEMPNAME,TRUE);

      IF CFIB.FUNIT>0 THEN
      BEGIN
	IF IORESULT=ORD(INODIRECTORY) THEN
	BEGIN
	  IF DSTATUS<>DONTCARE THEN WRITELN('NO DIRECTORY ON ',CPVOL);
	  SETSTRLEN(TEMPNAME,0);
	  CASE DSTATUS OF
	    DNEEDED: CFIB.FUNIT := 0;
	    DWANTED: BEGIN
		       PROMPTYORN('Use current media',ANSWER);
		       IF ANSWER='N' THEN CFIB.FUNIT := 0
				     ELSE DSTATUS    := DONTCARE;
		     END;
	    OTHERWISE
	  END;   { CASE DSTATUS }
	END
	ELSE
	BEGIN
	  IF IORESULT<>ORD(INOERROR) THEN
	  BEGIN
	    PRINTIOERRMSG; CFIB.FUNIT := 0;
	  END
	  ELSE
	  BEGIN { FOUND A DIRECTORY }
	    IF CVOL='' THEN CVOL := TEMPNAME
	    ELSE
	    IF CVOL<>TEMPNAME THEN CFIB.FUNIT := 0;
	  END;
	END;
      END;
    UNTIL CFIB.FUNIT>0;
    CFIB.FVID := CVOL;
    MOUNTED   := TRUE;
  END;
END;    { MOUNT VOLUME }

(****************************************************************************)
PROCEDURE SPACEWAIT;
VAR
  ANSWER        : CHAR;
BEGIN
  PROMPTREAD('<space> continues, <sh_exc> aborts ',ANSWER,' ',' ');
END;    { SPACEWAIT }

(****************************************************************************)
  PROCEDURE PROMPTFORCHAR(PL : PROMPTTYPE; VAR CH : CHAR);
  BEGIN
    FGOTOXY(OUTPUT,0,0); WRITE(PL,' ? ',CTEOL);
    READ(KEYBOARD,CH);    READCHECK;
    UPCCHAR(CH); WRITELN(CH);
    FGOTOXY(OUTPUT,0,1); WRITELN(CTEOL);
  END;    { PROMPTFORCHAR }

$IOCHECK OFF$
(****************************************************************************)
PROCEDURE SETUPFIBFORFILE(FILENAME      : FID;
		      VAR LFIB          : FIB;
		      VAR VNAME         : VID);
VAR
  LKIND : FILEKIND;
  SEGS  : INTEGER;

BEGIN
  SEGS     := 0;
  IORESULT := ORD(INOERROR);
  WITH LFIB DO
    IF SCANTITLE(FILENAME,FVID,FTITLE,SEGS,LKIND) THEN
    BEGIN
      VNAME      := FVID;
      FUNIT      := FINDVOLUME(FVID,TRUE);
      FKIND      := LKIND;      FEFT := EFTTABLE^[LKIND];
      FOPTSTRING := NIL;        FBUFFERED  := TRUE;
      FPOS       := SEGS * 512; FREPTCNT   := 0;
      FANONYMOUS := FALSE;      FMODIFIED  := FALSE;
      FBUFCHANGED:= FALSE;      FSTARTADDRESS := 0;
      FLASTPOS   := -1;         PATHID     := -1;
      FNOSRMTEMP := TRUE;       FLOCKED    := TRUE;
      FEOF       := FALSE;      FEOLN      := FALSE;
    END
    ELSE BADIO(IBADTITLE);
END;    { SETUPFIBFORFILE }

(****************************************************************************)
PROCEDURE CLOSEDIR;
BEGIN
  WITH ININFO, CFIB DO
  BEGIN
    IF DIROPEN THEN
    BEGIN
      LOCKUP;       { LOCK KEYBOARD FOR THIS OPERATION }
      PATHID := PATH;   { RESTORE PATHID }
      CALL(UNITABLE^[FUNIT].DAM,CFIB,FUNIT,CLOSEDIRECTORY);
      DIROPEN := FALSE;
      LOCKDOWN;
    END;
  END;
END;    { CLOSEDIR }

(****************************************************************************)
PROCEDURE OPENDIR(FILENAME      : FID;
	      VAR SOURCEFILE    : FID;
		  PROMPT        : PROMPTTYPE;
	      VAR FINFO         : CONTROL;
	      VAR DIRCATENTRY   : CATENTRY);
VAR
  UNIT     : INTEGER;

BEGIN   { OPENDIR }
  IORESULT := ORD(INOERROR);
  WITH FINFO, CFIB DO
  TRY
    SETUPFIBFORFILE(FILENAME,CFIB,CPVOL);
    USEUNIT := UNITNUMBER(CPVOL);       DSTATUS := DNEEDED;
    IF USEUNIT THEN CVOL := '' ELSE CVOL := CPVOL;
    IF (FUNIT=0) OR UNITNUMBER(FVID) THEN MOUNTVOLUME(PROMPT,FINFO)
				     ELSE MOUNTED := TRUE;
    WITH UNITABLE^[FUNIT] DO
    BEGIN
      LOCKUP;           { LOCK KEYBOARD }
      FWINDOW    := ADDR(DIRCATENTRY);
      CALL(DAM,CFIB,FUNIT,OPENDIRECTORY);
      DIROPEN    := (IORESULT=ORD(INOERROR));
      IF DIROPEN THEN
      BEGIN
	PATH       := PATHID;
	SOURCEFILE := FTITLE;
	CVOL       := DIRCATENTRY.CNAME;
      END;
      LOCKDOWN;         { UNLOCK KEYBOARD }
      IF NOT DIROPEN THEN ESCAPE(0);    { OPENDIRECTORY FAILED }
    END
  RECOVER
    IF ESCAPECODE<>0 THEN ESCAPE(ESCAPECODE);
END;    { OPENDIR }

(****************************************************************************)
PROCEDURE INMOUNT(SWAP : BOOLEAN);
BEGIN
  IF NOT ININFO.MOUNTED THEN
  WITH ININFO, CFIB DO
  BEGIN
    MOUNTVOLUME(' SOURCE',ININFO);
    UNITABLE^[FUNIT].UMEDIAVALID := TRUE;
  END;
END;    { INMOUNT }

(****************************************************************************)
PROCEDURE CLOSEINFILE;
BEGIN
  WITH ININFO ,CFIB DO
  BEGIN
    IF FILEOPEN THEN
    BEGIN
      LOCKUP;
      FMODIFIED := FALSE;
      CALL(UNITABLE^[FUNIT].DAM,CFIB,FUNIT,CLOSEFILE);
      FILEOPEN := FALSE;
      LOCKDOWN;
    END;
  END;
END;    { CLOSEINFILE }


(****************************************************************************)
PROCEDURE CLOSEALL;
BEGIN CLOSEINFILE; CLOSEDIR; END;

(****************************************************************************)
PROCEDURE ANYTOMEM(       FFIB   : FIBP;
		   ANYVAR BUFFER : BIGPTR;
			  MAXBUF : INTEGER);
VAR
  BUFREC    :  ^STRING255;
  BUFPTR    :  ^CHAR;
  LEFTINBUF :  INTEGER;

BEGIN   { ANYTOMEM }
  BUFPTR    := ADDR(BUFFER^);
  BUFPTR^   := CHR(0);  { DATA COMMING }
  BUFREC    := ADDR(BUFPTR^,1);
  SETSTRLEN(BUFREC^,0); { ZERO LENGTH RECORD }
  BUFPTR    := ADDR(BUFREC^,1);
  LEFTINBUF := MAXBUF;

  WITH FFIB^, UNITABLE^[FUNIT] DO
  BEGIN
    CALL(AM,FFIB,READTOEOL,BUFREC^,255,FPOS);
    GOODIO;
    REPEAT
      GOODIO; { CHECK IORESULT FROM LAST READTOEOL }
      LEFTTOXFER := LEFTTOXFER - STRLEN(BUFREC^);
      IF LEFTTOXFER<0 THEN
      BEGIN     { CLIP THIS LINE AND FAKE END OF FILE }
	SETSTRLEN(BUFREC^,STRLEN(BUFREC^)+LEFTTOXFER);
	LEFTTOXFER := 0;
      END;
      BUFPTR := ADDR(BUFPTR^,STRLEN(BUFREC^));

      LEFTINBUF := LEFTINBUF - STRLEN(BUFREC^) - 2;
      IF STRLEN(BUFREC^) = 255 THEN BUFPTR := ADDR(BUFPTR^,-1)
      ELSE
      BEGIN
	IF STRLEN(BUFREC^)=0 THEN
	BEGIN { DISCARD THE LENGTH BYTE }
	  BUFPTR := ADDR(BUFREC^,-1);
	  LEFTINBUF := LEFTINBUF + {1} 2; {BUGFIX SFB 5/2/85--SAME AS IN
					   FILER AND FILEPACK}
	END;

	   { CHECK END OF LINE/FILE }
	CALL(AM,FFIB,READBYTES,BUFPTR^,1,FPOS);
	IF FEOLN THEN
	BEGIN  { END OF LINE }
	  BUFPTR^ := CHR(1);  FEOLN := FALSE;
	  LEFTINBUF := LEFTINBUF - 1; {BUGFIX SFB 5/2/85--SAME AS IN
				       FILER AND FILEPACK}
	  IF IORESULT = ORD(IEOF) THEN BUFPTR := ADDR(BUFPTR^,1);
	END;
	IF (IORESULT=ORD(IEOF)) OR (LEFTTOXFER=0) THEN
	BEGIN  { END OF FILE }
	  BUFPTR^  := CHR(2);
	  IORESULT := ORD(INOERROR);
	  FEOF     := TRUE;
	END;
	GOODIO;       { CHECK IORESULT FROM READBYTES }
      END;
      IF NOT ((LEFTINBUF < 259) OR FEOF) THEN
      BEGIN { SETUP FOR TO READ THE NEXT LINE }
	BUFPTR    := ADDR(BUFPTR^,1);
	BUFPTR^   := CHR(0);  { DATA RECORD }
	BUFREC    := ADDR(BUFPTR^,1);
	SETSTRLEN(BUFREC^,0); { ZERO LENGTH RECORD }
	BUFPTR    := ADDR(BUFREC^,1);
	CALL(AM,FFIB,READTOEOL,BUFREC^,255,FPOS);
      END;
    UNTIL (LEFTINBUF < 259) OR FEOF;
    BUFPTR := ADDR(BUFPTR^,1);    BUFPTR^ := CHR(3); { END BUFFER }
  END;
END;    { ANYTOMEM }

(****************************************************************************)
FUNCTION CHECKSPACE(START,SIZE:INTEGER; VAR OKSIZE:INTEGER):BOOLEAN;

VAR
  POINT : INTEGER;
  PART  : INTEGER;

BEGIN { CHECK SPACE }
  OKSIZE := -1; CHECKSPACE := FALSE;
  WITH EPROMDATA^ DO
  BEGIN
    { FIND THE PART CONTAINING THE START ADDRESS }
    PART := 0;
    WHILE PART<8 DO
    BEGIN
      IF (START>=ADDRESS[PART]) AND
	 (START<(ADDRESS[PART]+EPINC)) THEN
      BEGIN
	IF PRESENT[PART] THEN
	BEGIN   { FOUND START NOW FIND END POINT }
	  POINT := START + SIZE - 1;    { END POINT }
	  WHILE PART<8 DO
	  BEGIN
	    IF PRESENT[PART] THEN
	    BEGIN
	      IF (POINT<(ADDRESS[PART]+EPINC)) THEN
	      BEGIN     { IT ALL FITS }
		OKSIZE := SIZE; CHECKSPACE:=TRUE; PART := 8; { FORCE EXIT }
	      END
	      ELSE     { FIGURE SPACE SO FAR }
	      BEGIN
		OKSIZE := (ADDRESS[PART]+EPINC)-START;
		PART := PART + 1;
	      END;
	    END { IF PRESENT }
	    ELSE PART := 8;     { FORCE EXIT }
	  END;  { WHILE }
	END;    { IF PRESENT }
	PART := 8;      { FORCE EXIT }
      END       { IF ADDRESS IN RANGE }
      ELSE PART := PART + 1;
    END;        { WHILE }
  END;  { WITH EPROMDATA }
END;    { CHECKSPACE }

(****************************************************************************)
PROCEDURE PASSFAILED(FAILCODE:PASSTYPE);
VAR
  PART : INTEGER;
  UL   : CHAR;
  I    : INTEGER;

BEGIN
  WITH EPROMDATA^ DO
  BEGIN
    FOR I := 0 TO 7 DO
      IF (OUTPOSITION>=ADDRESS[I]) AND
	 (OUTPOSITION<(ADDRESS[I]+EPINC)) THEN PART := I;

    IF ODD(OUTPOSITION) THEN UL := 'L' ELSE UL := 'U';
    WRITE(FAILCODE,' FAIL');
    WRITELN(' AT ABSOLUTE ADDRESS ',OUTPOSITION:1);
    WRITELN(' BYTE POSITION ',OUTPOSITION-OUTSTARTA:1,' FROM START LOCATION');
    WRITELN(' EPROM SOCKET ',PART:1,UL,
	    ' BYTE ',(OUTPOSITION-ADDRESS[PART]) DIV 2:1);
  END;
  IF STREAMING THEN ESCAPE(-1) ELSE BADIO(INOERROR);
END;    { PASSFAILED }

(****************************************************************************)
PROCEDURE PRINTBR;
BEGIN
  FGOTOXY(OUTPUT,0,4); WRITE('Burn rate   ');
  IF FASTBURN THEN WRITE('FAST') ELSE WRITE('SLOW');
  WRITELN(CTEOL);
END;

(****************************************************************************)
PROCEDURE BURNIT(ANYVAR BUFFER   : WINDOW;
			SIZE     : INTEGER);
VAR
  OLDPOSIT : INTEGER;
  OLDX,OLDY: INTEGER;
BEGIN
  IF PASS=1 THEN
  BEGIN        { CHECK IF CAN BURN }
    ERROR:=EPROG(SCODE,ECHECK,BUFFER,SIZE,OUTPOSITION);
    IF ERROR<>ENOERROR THEN PASSFAILED(CHECK);
  END
  ELSE
  BEGIN        { TRY TO BURN IT }
    OLDPOSIT := OUTPOSITION;    { SAVE POSITION FOR RETRY }
    ERROR:=EPROG(SCODE,ECWRITE,BUFFER,SIZE,OUTPOSITION);
    IF ERROR<>ENOERROR THEN
      IF NOT FASTBURN THEN
      BEGIN
	IF ERROR=ECFAIL THEN PASSFAILED(VERIFY)
			ELSE PASSFAILED(BURN);
      END
      ELSE
      BEGIN
	FASTBURN := FALSE;      { SET BURN RATE TO SLOW }
	FGETXY(OUTPUT,OLDX,OLDY);       { UPDATE THE DISPLAY }
	PRINTBR;
	FGOTOXY(OUTPUT,OLDX,OLDY);
	ERROR := EBRATE(SCODE,FASTBURN);
	OUTPOSITION := OLDPOSIT;{ RESET POSITION AND RETRY }
	ERROR:=EPROG(SCODE,ECWRITE,BUFFER,SIZE,OUTPOSITION);
	IF ERROR<>ENOERROR THEN
	  IF ERROR=ECFAIL THEN PASSFAILED(VERIFY)
			  ELSE PASSFAILED(BURN);
      END;
  END;
  IORESULT:=ORD(INOERROR);      { CLEAR I/O RESULT }
END;    { BURNIT }

(****************************************************************************)
PROCEDURE MEMTOEPROM(ANYVAR BUFFER : BIGPTR);
VAR
  BYTES : INTEGER;
  BUFPTR: ^CHAR;

BEGIN
  BUFPTR := ADDR(BUFFER^);
  BEGIN
    BYTES := 0;
    REPEAT
      BUFPTR := ADDR(BUFPTR^,BYTES);
      BYTES  := ORD(BUFPTR^);
      BUFPTR := ADDR(BUFPTR^,1);
      CASE BYTES OF
      0: BEGIN          { DATA BYTES }
	   BYTES := ORD(BUFPTR^);       { RECORD LENGTH }
	   BUFPTR:= ADDR(BUFPTR^,1);
	   BURNIT(BUFPTR^,BYTES);
	 END;
      1: BEGIN          { END RECORD }
	   BYTES := 0;
	 END;
      2: BEGIN          { END FILE }
	   BYTES := -1;
	 END;
      3: BYTES := -1;   { END BUFFER }
      OTHERWISE IORESULT := ORD(IBADREQUEST);
      END;
      GOODIO;
    UNTIL BYTES<0;
  END;
END;    { MEMTOEPROM }

(****************************************************************************)
  FUNCTION CHECKCARD(SC:INTEGER):BOOLEAN;
  VAR
    ECODE : EPERROR;
  BEGIN
    ECODE:=EINIT(SC);
    CHECKCARD:=(ECODE=ENOERROR) OR (ECODE=ENOEPROM);
  END;  { CHECKCARD }

(****************************************************************************)
  PROCEDURE CHECKSCODE;
  BEGIN
    IF NOT CHECKCARD(SCODE)
      THEN BADMESSAGE('*** NO PROGRAMMER CARD IN SYSTEM ***');
  END;

(****************************************************************************)
  PROCEDURE CHECKEPROM;
  VAR
    I       : INTEGER;
    DONE    : BOOLEAN;

  BEGIN
    CHECKSCODE;
    ERROR:=EGETINFO(SCODE,EPINFO);
    IF EPINFO.EPSTART=0 THEN
      BADMESSAGE('NO EPROM CARD ATTACHED TO PROGRAMMER CARD');

    EPROMDATA := EPROMLIST;
    DONE := FALSE;
    REPEAT
      IF EPROMDATA=NIL THEN
      BEGIN
	NEW(EPROMDATA);
	WITH EPROMDATA^ , EPINFO DO
	BEGIN
	  BASEADDR  := EPSTART;
	  EPSIZE    := EPEND-EPSTART;
	  EPINC     := EPSIZE DIV 8;
	  ADDRESS[0]:= BASEADDR;
	  PRESENT[0]:= TRUE;
	  FOR I:=1 TO 7 DO
	  BEGIN
	    ADDRESS[I]:= ADDRESS[I-1]+EPINC;
	    PRESENT[I]:= TRUE;
	  END;
	  NEXT := EPROMLIST;
	  EPROMLIST := EPROMDATA;
	  DONE := TRUE;
	END;
      END
      ELSE
      BEGIN
	IF EPROMDATA^.BASEADDR=EPINFO.EPSTART THEN DONE := TRUE
	ELSE EPROMDATA := EPROMDATA^.NEXT;
      END;
    UNTIL DONE;
  END; { CHECKEPROM }

(****************************************************************************)
  PROCEDURE FINDCARD(SCODES:BOOLEAN);
  VAR
    SC : INTEGER;
  BEGIN
    FOR SC:=MINSC TO MAXSC DO
    IF CHECKCARD(SC) THEN
    BEGIN
      IF SCODES THEN WRITE(SC:3);
      SCODE := SC;
    END;
  END; { FINDCARD }

(****************************************************************************)
  PROCEDURE DOCONFIGURE(DOPROMPT:BOOLEAN);
  VAR
    DONE : BOOLEAN;
    OLDSCODE : INTEGER;
    OP       : CHAR;
    I        : INTEGER;

    {-------------------------------------------------------------------------}
    PROCEDURE PRINTSC;
    BEGIN
      FGOTOXY(OUTPUT,0,3);
      WRITELN('Active programmer card at select code ',SCODE:1,CTEOL);
    END;


    {-------------------------------------------------------------------------}
    PROCEDURE PRINTEPINFO;
    BEGIN
      FGOTOXY(OUTPUT,0,5);
      TRY
	CHECKEPROM;
	TEMP := EPINFO.EPEND-EPINFO.EPSTART;
	WRITELN('EPROM at address ',EPINFO.EPSTART:1,' for ',
		  TEMP:1,' bytes',CTEOL);
	WRITELN('EPROM type XX',TEMP DIV 2048:1,CTEOL);
      RECOVER
	IF ESCAPECODE<>0 THEN ESCAPE(ESCAPECODE);
    END;

    {-------------------------------------------------------------------------}
    PROCEDURE PRINTSOCKETS;
    VAR
      I : INTEGER;
    BEGIN
      FGOTOXY(OUTPUT,0,7);
      WRITELN('Socket status (UL means EPROM pair present)');
      WITH EPROMDATA^ DO
      FOR I:= 0 TO 3 DO
      BEGIN
	WRITE(I:1);
	IF PRESENT[I] THEN WRITE('UL    ') ELSE WRITE(' empty');
	WRITE(I+4:4);
	IF PRESENT[I+4] THEN WRITE('UL    ') ELSE WRITE(' empty');
	WRITELN;
      END;
    END;

    {-------------------------------------------------------------------------}
  BEGIN { DOCONFIGURE }
    FGOTOXY(OUTPUT,0,2); WRITE(CTEOS);
    CHECKSCODE;
    OLDSCODE:=SCODE;
    WRITE('Programmer card(s) at ');
    FINDCARD(TRUE);
    SCODE := OLDSCODE;
    PRINTSC;
    PRINTBR;
    PRINTEPINFO;
    IF EPINFO.EPSTART>0 THEN PRINTSOCKETS;
    IF DOPROMPT THEN
    REPEAT
    TRY
      PROMPTFORCHAR('CONFIGURE: Selectcode Burnrate Emptysockets Qt',OP);
      FGOTOXY(OUTPUT,0,13); WRITE(CTEOS);
      IF OP=SH_EXC THEN OP:='Q';

      IF OP='S' THEN
      BEGIN     { NEW SELECT CODE }
	OLDSCODE := SCODE;
	WRITE('New select code (',SCODE:1,') ? '); READNUMBER(SCODE);
	IF (SCODE<MINSC) OR (SCODE>MAXSC) THEN
	BEGIN SCODE := OLDSCODE; BADMESSAGE('SELECT CODE OUT OF RANGE'); END;
	IF NOT CHECKCARD(SCODE) THEN
	BEGIN
	  SCODE := OLDSCODE; BADMESSAGE('SELECT CODE NOT A PROGRAMMER CARD');
	END;
	PRINTSC;
	PRINTBR;
	PRINTEPINFO;
	IF EPINFO.EPSTART>0 THEN PRINTSOCKETS ELSE WRITE(CTEOS);
      END
      ELSE
      IF OP='B' THEN
      BEGIN
	FASTBURN := NOT FASTBURN; PRINTBR;
      END
      ELSE
      IF OP='E' THEN
      BEGIN
	IF EPINFO.EPSTART>0 THEN
	BEGIN
	  I := -1;
	  WRITE('SOCKET (PAIR) NUMBER ? ',CTEOL); READNUMBER(I);
	  IF I>=0 THEN
	    IF (I<0) OR (I>7) THEN BADMESSAGE('SOCKET NUMBER OUT OF RANGE')
	    ELSE
	    BEGIN
	      EPROMDATA^.PRESENT[I] := NOT EPROMDATA^.PRESENT[I];
	      PRINTSOCKETS;
	    END;
	END
	ELSE BEEP;
      END
      ELSE
      IF (OP<>'Q') THEN
	IF STREAMING THEN BADCOMMAND(OP)
		     ELSE BEEP;

    RECOVER
    BEGIN
      LOCKUP;
      SAVEIO       := IORESULT;
      SAVEESC      := ESCAPECODE;
      IORESULT     := SAVEIO;
      IF (SAVEESC<>0) AND (SAVEESC<>-10) THEN IORESULT := ORD(INOERROR);
      LOCKDOWN;
      PRINTIOERRMSG;
      FIXLOCK;
      IF SAVEESC<>0 THEN ESCAPE(SAVEESC) ELSE OP := ' ';
    END;

    UNTIL OP='Q';
  END; { DOCONFIGURE }

(****************************************************************************)
  PROCEDURE DOTRANSFER;
  TYPE
    HEADREC = PACKED ARRAY[0..17] OF BYTE;

    HEADP = RECORD
	      CASE BOOLEAN OF
	      TRUE : (BINT:INTEGER);
	      FALSE: (BPTR:^HEADREC);
	    END;
  VAR
    FILENAME1     : FID;
    SOURCEFILE    : FID;

    FILEMOVED     : BOOLEAN;
    DONE          : BOOLEAN;
    FORMAT        : BOOLEAN;

    I             : INTEGER;
    J             : INTEGER;
    EPART         : INTEGER;
    INSTATE       : INTEGER;
    OUTSTATE      : INTEGER;
    BUF           : BIGPTR;
    POSITION      : INTEGER;
    MOVESIZE      : INTEGER;
    MSIZE         : INTEGER;
    BUFSIZE       : INTEGER;
    OUTSIZE       : INTEGER;
    SAVEIO        : INTEGER;
    SAVEESC       : INTEGER;
    DUMWINDOW     : WINDOWP;
    EDHEADER      : HEADREC;
    MSGLINE       : STRING[255];
    DIRCATENTRY   : CATENTRY;
    BLANKCHK      : HEADP;
    ANSWER        : CHAR;

  BEGIN   { DOTRANSFER }
    DOCONFIGURE(FALSE);
    FGOTOXY(OUTPUT,0,13);
    WRITELN('TRANSFER OPERATION',CTEOS);
    CHECKEPROM;

    WRITE('Source (',DKVID,':) ? ');
    READLN(FILENAME1);     GOODIO;
    FILENAME1 := STRLTRIM(STRRTRIM(FILENAME1));
    IF STRLEN(FILENAME1)=0 THEN FILENAME1:=DKVID+':';
    ZAPSPACES(FILENAME1);
    IF STRLEN(FILENAME1)>0 THEN
    WITH EPROMDATA^ DO
    BEGIN { HAVE A SOURCE NAME }
      WITH ININFO DO
	BEGIN DIROPEN := FALSE; FILEOPEN := FALSE; MOUNTED := FALSE; END;
      MARK(LHEAP);  HEAPINUSE := TRUE;
      NEWWORDS(DUMWINDOW,1);  { DUMMY WINDOW FOR FILE TRANSFER }
      TRY
	WITH ININFO, CFIB DO
	BEGIN
	  { OPEN THE SOURCE }
	  SETUPFIBFORFILE(FILENAME1,CFIB,CPVOL);
	  IF STRLEN(FTITLE)=0 THEN
	  BEGIN { VOLUME -> EPROM }
	    USEUNIT := UNITNUMBER(CPVOL);     DSTATUS := DWANTED;
	    IF USEUNIT THEN CVOL := '' ELSE CVOL := CPVOL;
	    MOUNTED := (FUNIT>0) AND NOT(UNITNUMBER(FVID));
	    IF MOUNTED THEN CVOL := FVID ELSE INMOUNT(TRUE);

	    LOCKUP;   { LOCK THE KEYBOARD THEN OPEN THE VOLUME }
	    FBUFFERED := FALSE;
	    FKIND     := UNTYPEDFILE;     FEFT := EFTTABLE^[FKIND];
	    CALL(UNITABLE^[FUNIT].DAM,CFIB,FUNIT,OPENVOLUME);
	    FILEOPEN  := (IORESULT=ORD(INOERROR));
	    LOCKDOWN; { UNLOCK THE KEYBOARD }
	    GOODIO;
		      { FINISH THE SETUPT }
	    OUTSIZE    := FPEOF;
	    SOURCEFILE := '';
	    FTID       := '';
	    FORMAT     := FALSE;
	    FGOTOXY(OUTPUT,0,14);
	    WRITELN('TRANSFERRING VOLUME ',FVID,':');
	  END { VOLUME -> EPROM }
	  ELSE
	  BEGIN { FILE -> EPROM }
	    OPENDIR(FILENAME1,SOURCEFILE,' SOURCE',ININFO,DIRCATENTRY);
	    IF NOT DIROPEN THEN ESCAPE(0);
	    IF STRLEN(SOURCEFILE)=0 THEN
	       BADMESSAGE('CAN''T TRANSFER A DIRECTORY');
	    FTITLE := SOURCEFILE;
	    FINITB(CFIB,DUMWINDOW,-3);
	    PATHID := PATH;
	    LOCKUP;
	    CALL(UNITABLE^[FUNIT].DAM,CFIB,FUNIT,OPENFILE);
	    FILEOPEN := IORESULT=ORD(INOERROR);
	    LOCKDOWN;
	    GOODIO;
	    FORMAT := (FKIND=ASCIIFILE) OR (FKIND=TEXTFILE);
	    OUTSIZE := FLEOF;
	    FGOTOXY(OUTPUT,0,14);
	    WRITELN('TRANSFERING FILE ',CVOL,':',SOURCEFILE,CTEOL);
	  END; { FILE -> EPROM }
	END;   { WITH ININFO, CFIB -- OPEN THE SOURCE }

	{ ALLOCATE BUFFER SPACE }
	BUFSIZE := (MEMAVAIL DIV 256) * 256 - 30 * 512; {SAME SOME FOR SLOP}
	IF BUFSIZE<512 THEN ESCAPE(-2);       { NOT ENOUGH ROOM }
	NEWWORDS(BUF,BUFSIZE DIV 2);          { ALLOCATE BUFFER SPACE }

	{ GET START ADDRESS ON EPROM }
	MSGLINE := '';
	WITH EPINFO DO
	IF SOURCEFILE='' THEN
	BEGIN     { VOLUME TRANSFER }
	  { SET DEFAULT START BLOCK }
	  TEMP := 0;
	  OUTSTARTA := EPSTART ;
	  DONE := FALSE;
	  REPEAT
	    IF PRESENT[TEMP] THEN
	    BEGIN       { SOCKET PRESENT, CHECK CONTENTS }
	      BLANKCHK.BINT := OUTSTARTA;
	      IF (BLANKCHK.BPTR^[0]=255) AND
		 (BLANKCHK.BPTR^[1]=255) THEN DONE := TRUE
	      ELSE
	      BEGIN     { INCREMENT TO NEXT BLOCK }
		OUTSTARTA := OUTSTARTA+K16;
		IF TEMP<7 THEN
		  IF OUTSTARTA>=ADDRESS[TEMP+1] THEN TEMP := TEMP+1;
	      END;
	    END
	    ELSE
	    BEGIN       { SKIP EMPTY SOCKET PAIR }
	      IF TEMP<7 THEN TEMP := TEMP+1;
	      OUTSTARTA := OUTSTARTA+EPINC;
	    END;
	  UNTIL DONE OR (OUTSTARTA>EPEND);

	  IF OUTSTARTA>EPEND THEN
	  BEGIN
	    WRITELN('*** NO BLANK BLOCK ON THIS EPROM CARD ***');
	    OUTSTARTA:=EPSTART;
	  END;
	  OUTSTARTA := (OUTSTARTA-EPSTART) DIV K16;

	  WRITE('Start at EPROM block offset (',OUTSTARTA:1,') ? ');
	  READNUMBER(OUTSTARTA); OUTSTARTA:=OUTSTARTA*K16;
	  STRWRITE(MSGLINE,1,I,'BLOCK OFFSET NOT IN RANGE 0..',
			       (EPSIZE DIV K16)-1:1);
	END
	ELSE
	BEGIN     { FILE TRANSFER }
	  OUTSTARTA := 0;        { DEFAULT VALUE }
	  WRITE('Start at EPROM byte offset (',OUTSTARTA:1,') ? ');
	  READNUMBER(OUTSTARTA);
	  STRWRITE(MSGLINE,1,I,'BYTE OFFSET NOT IN RANGE 0..',EPSIZE-1:1);
	END;

	IF OUTSTARTA>(EPSIZE-1) THEN BADMESSAGE(MSGLINE);
	OUTSTARTA := OUTSTARTA + EPINFO.EPSTART;

	{ CHECK TO SEE IF DATA WILL FIT IN AVAILABLE EPROM SPACE }
	J := OUTSIZE;     { VOL / FILE SIZE }
	IF SOURCEFILE='' THEN
	BEGIN
	  J := J + 18; { ADD HEADER }
	  J := J + (J DIV K16)*2; { ADD 16K HEADER GAPS }
	END;
	IF NOT CHECKSPACE(OUTSTARTA,J,I) THEN
	BEGIN
	  IF I<=0 THEN
	  BEGIN WRITELN('NO EPROM AT START ADDRESS'); BADIO(INOERROR); END;

	  WRITELN('DATA EXCEEDS EPROM SPACE BY ',J-I:1,' BYTES',CTEOL);
	  IF STREAMING THEN ESCAPE(-1);
	  PROMPTREAD('Abort transfer or Truncate file (A/T) ? ',
		      ANSWER,'AT',SH_EXC);
	  IF ANSWER='A' THEN ESCAPE(0);
	  IF SOURCEFILE='' THEN
	  BEGIN
	    OUTSIZE := (I-18); OUTSIZE := OUTSIZE - (OUTSIZE DIV K16)*2;
	  END
	  ELSE OUTSIZE := I;
	END;

	INSTATE  := 1;
	PASS     := 1;

	BEGIN       { TRY THE TRANSFER }
	    FILEMOVED := FALSE;
	    WITH ININFO, CFIB , EPROMDATA^ DO
	    REPEAT    { MOVE THE FILE }
	      DONE := FALSE;
	      REPEAT
		CASE INSTATE OF
		1: BEGIN      { INITIALIZE SOURCE PARAMETERS }
		     FGOTOXY(OUTPUT,0,16);
		     WRITELN('now on pass ',PASS:1,CTEOS);
		     OUTPOSITION := OUTSTARTA;
		     LEFTTOXFER  := OUTSIZE;
		     POSITION    := 0;
		     FEOF        := FALSE;   FEOLN    := FALSE;
		     FLASTPOS    := -1;      FPOS     := 0;
		     INSTATE     := 2;
		     OUTSTATE    := 1;
		   END;
		2: BEGIN      { READ THE FILE/VOLUME }
		     WRITE('reading ....',CTEOL,CHR(13));
		     IF FORMAT THEN
		     BEGIN    { FORMATED TRANSFER }
		       ANYTOMEM(ADDR(CFIB),BUF,BUFSIZE);
		       DONE := TRUE;
		       IF FEOF THEN LEFTTOXFER := 0;
		       GOODIO;
		     END
		     ELSE
		     BEGIN    { UNFORMATED TRANSFER }
		       IF BUFSIZE>LEFTTOXFER THEN MOVESIZE := LEFTTOXFER
					     ELSE MOVESIZE := BUFSIZE;
		       CALL(UNITABLE^[FUNIT].TM,ADDR(CFIB),READBYTES,
						BUF^,MOVESIZE,POSITION);
		       GOODIO;
		       LEFTTOXFER := LEFTTOXFER - MOVESIZE;
		       DONE := TRUE;
		     END;
		   END;
		END;  { CASE INSTATE }
	      UNTIL DONE;
	      WRITE(CTEOL);

	      DONE := FALSE;
	      IF NOT FILEMOVED THEN
	      REPEAT
		IF PASS=1 THEN WRITE('checking ...',CTEOL,CHR(13))
			  ELSE WRITE('writing ...',CTEOL,CHR(13));
		CASE OUTSTATE OF
		1: BEGIN
		     { SET BURN RATE }
		     ERROR:=EBRATE(SCODE,FASTBURN);
		     IF SOURCEFILE='' THEN
		     BEGIN        { VOLUME TRANSFER }
		       { PUT EDISC VOLUME HEADER }
		       FOR I := 0 TO 17 DO EDHEADER[I]:=0;
		       EDHEADER[0]:=HEX('F0');
		       EDHEADER[1]:=HEX('FF');
		       EDHEADER[2]:=ORD(' ');
		       EDHEADER[3]:=HEX('18');
		       EDHEADER[12]:=HEX('01');
		       EDHEADER[13]:=HEX('02');
		       BURNIT(EDHEADER,18);
		     END;
		     OUTSTATE := 2;
		   END;

		2: BEGIN  { WRITE DATA }
		     IF FORMAT THEN MEMTOEPROM(BUF)
		     ELSE
		     BEGIN
		       IF SOURCEFILE='' THEN
		       BEGIN      { TRANSFERING A VOLUME }
			 I := 0;
			 REPEAT
			   { WATCH FOR 16K BYTE BOUNDARIES }
			   MSIZE:=(((OUTPOSITION+K16) DIV K16)*K16)-OUTPOSITION;
			   IF MSIZE>MOVESIZE THEN MSIZE:=MOVESIZE;
			   BURNIT(BUF^[I],MSIZE);
			   I := I + MSIZE;
			   MOVESIZE := MOVESIZE - MSIZE;
			   IF ((OUTPOSITION MOD K16)=0) AND
			      ((MOVESIZE>0) OR (LEFTTOXFER>0)) THEN
			   BEGIN        { PUT ZEROES IN BOUNDARY BYTES }
			     J:=0; BURNIT(J,2);
			   END;
			 UNTIL MOVESIZE=0;
		       END
		       ELSE
		       BEGIN      { TRANSFERING A FILE }
			 BURNIT(BUF^,MOVESIZE);
		       END;
		     END;
		     DONE:=TRUE;
		     IF LEFTTOXFER=0 THEN
		     BEGIN
		       IF PASS=2 THEN FILEMOVED:=TRUE
		       ELSE
		       BEGIN  PASS:=2; INSTATE := 1; END;
		     END;
		   END;
		END;      { CASE OUTSTATE }
	      UNTIL DONE;
	      WRITE(CTEOL);
	    UNTIL FILEMOVED;
	    WRITELN('TRANSFER COMPLETED');
	    IF FORMAT THEN I := OUTPOSITION-OUTSTARTA
		      ELSE I := OUTSIZE;
	    WRITELN(I:1,' data bytes programmed and verified');
	  END;
	RELEASE(LHEAP);       HEAPINUSE := FALSE;
	CLOSEALL;
      RECOVER
      BEGIN
	LOCKUP;
	RELEASE(LHEAP);       HEAPINUSE := FALSE;
	SAVEIO    := IORESULT;
	SAVEESC   := ESCAPECODE;
	CLOSEALL;
	IORESULT  := SAVEIO;
	LOCKDOWN;
	PRINTIOERRMSG;
	IF SAVEESC<>0 THEN ESCAPE(SAVEESC);
      END;
    END;  { HAVE SOURCE NAME }
  END;    { DOTRANSFER }

(****************************************************************************)
  PROCEDURE PUTMENU(MSTRING:STRING80);
  BEGIN
    FGOTOXY(OUTPUT,0,2);
    WRITE(MSTRING,' ? ',CTEOL);
  END;

(****************************************************************************)
  PROCEDURE DOBLANKCHECK;
  TYPE
    TWOBYTES = PACKED ARRAY[0..1] OF BYTE;
  VAR
    OLDSTART    : INTEGER;
    START       : INTEGER;
    ENDSCAN     : INTEGER;
    NBYTES      : INTEGER;
    BLANKS      : BOOLEAN;
    LINES       : INTEGER;
    I           : INTEGER;
    X,Y         : INTEGER;
    BREC        : RECORD
		    CASE BOOLEAN OF
		    TRUE:(BPTR : ^TWOBYTES);
		    FALSE:(BINT : INTEGER);
		  END;
  BEGIN
    DOCONFIGURE(FALSE);
    FGOTOXY(OUTPUT,0,13);
    WRITELN('BLANK CHECK',CTEOS);
    CHECKEPROM;
    OLDSTART := 0;
    BLANKS := FALSE;
    FGETXY(OUTPUT,X,Y); LINES := 0;
    WITH EPROMDATA^ DO
    FOR I:=0 TO 7 DO    { DO ONE SOCKET PAIR AT A TIME }
    IF NOT PRESENT[I] THEN
    BEGIN       { CLOSE OFF REPORT OF PREVIOUS PAIR }
      IF BLANKS THEN
	 WRITELN(BREC.BINT-1-BASEADDR:1,' (',BREC.BINT-OLDSTART:1,')');
      BLANKS:=FALSE
    END
    ELSE
    BEGIN       { SOCKET PAIR PRESENT SO CHECK IT OUT }
      BREC.BINT := ADDRESS[I] ;
      ENDSCAN := BREC.BINT + EPINC;
      REPEAT
	IF BLANKS THEN
	BEGIN
	  IF BREC.BPTR^[0]<>255 THEN
	  BEGIN
	    WRITELN(BREC.BINT-1-BASEADDR:1,' (',BREC.BINT-OLDSTART:1,')');
	    BLANKS:=FALSE;
	  END;
	END
	ELSE
	BEGIN
	  IF BREC.BPTR^[0]=255 THEN
	  BEGIN
	    IF LINES>5 THEN
	    BEGIN
	      LINES := 0; SPACEWAIT;
	      FGOTOXY(OUTPUT,X,Y); WRITE(CTEOS);
	    END;
	    LINES := LINES + 1;
	    OLDSTART := BREC.BINT; WRITE(OLDSTART-BASEADDR,' - ');
	    BLANKS:=TRUE;
	  END;
	END;
	BREC.BINT := BREC.BINT + 1;
      UNTIL BREC.BINT=ENDSCAN;

      IF BLANKS AND (I=7) THEN
	 WRITELN(BREC.BINT-1-BASEADDR:1,' (',BREC.BINT-OLDSTART:1,')');

    END; { FOR I := ... }
    IF OLDSTART=0 THEN WRITELN('NO BLANK SPACE FOUND');
  END;  { DOBLANKCHECK }

(****************************************************************************)
BEGIN  { COMMANDLEVEL }
  FIXLOCK;
  WITH ININFO DO BEGIN DIROPEN:=FALSE; FILEOPEN:=FALSE; END;
  HEAPINUSE := FALSE;
  IORESULT  := ORD(INOERROR);
  SCODE := 0;     TEMP := 0;
  FASTBURN := FALSE;    { DEFAULT BURN RATE }
  EPROMLIST := NIL;     { NO EPROM CARD INFO YET }
  FINDCARD(FALSE);      { FIND A PROGRAMMER CARD }
  TRY
    DOCONFIGURE(FALSE); { DISPLAY DEFAULT CONFIGURATION }
  RECOVER
    IF ESCAPECODE<>0 THEN ESCAPE(ESCAPECODE);

  FGOTOXY(OUTPUT,0,13);
  WRITELN('Copyright Hewlett-Packard Company, 1983, 1991.');
  WRITELN('          All rights are reserved.');

  REPEAT
    TRY
      PROMPTFORCHAR('ETU: Transfer Configure Blankcheck Quit',OP);
      IF OP=SH_EXC THEN OP:='Q';

      IF OP='T' THEN DOTRANSFER
      ELSE
      IF OP='C' THEN DOCONFIGURE(TRUE)
      ELSE
      IF OP='B' THEN DOBLANKCHECK
      ELSE
      IF OP='Q' THEN BEGIN END
      ELSE
      IF STREAMING THEN BADCOMMAND(OP)
		   ELSE BEEP;
    RECOVER
    BEGIN
      LOCKUP;
      IF HEAPINUSE THEN RELEASE(LHEAP);
      HEAPINUSE    := FALSE;
      SAVEIO       := IORESULT;
      SAVEESC      := ESCAPECODE;
      CLOSEALL;
      IORESULT     := SAVEIO;
      IF (SAVEESC<>0) AND (SAVEESC<>-10) THEN IORESULT := ORD(INOERROR);
      LOCKDOWN;
      PRINTIOERRMSG;
      FIXLOCK;
      IF SAVEESC<>0 THEN ESCAPE(SAVEESC) ELSE OP := ' ';
    END;
  UNTIL OP='Q';
END {COMMANDLEVEL} ;

(****************************************************************************)
BEGIN
  WRITELN(CLEARSCR);
  FGOTOXY(OUTPUT,0,1);
  WRITELN('EPROM TRANSFER UTILITY (28-Oct-91)');
  COMMANDLEVEL;
END.

@


55.2
log
@
pws2rcs automatic delta on Mon Nov  4 13:45:04 MST 1991
@
text
@@


55.1
log
@Automatic bump of revision number for PWS version 3.25A
@
text
@d1286 1
a1286 1
  WRITELN('EPROM TRANSFER UTILITY (12-Aug-91)');
@


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


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


54.1
log
@Automatic bump of revision number for PWS version 3.24
@
text
@a0 1289
					       (*

 (c) Copyright Hewlett-Packard Company, 1985.
All rights are reserved.  Copying or other
reproduction of this program except for archival
purposes is prohibited without the prior
written consent of Hewlett-Packard Company.


	    RESTRICTED RIGHTS LEGEND

Use, duplication, or disclosure by the Government
is subject to restrictions as set forth in
paragraph (b) (3) (B) of the Rights in Technical
Data and Computer Software clause in
DAR 7-104.9(a).

HEWLETT-PACKARD COMPANY
Fort Collins, Colorado                         *)

$COPYRIGHT 'COPYRIGHT (C) 1985 BY HEWLETT-PACKARD COMPANY'$
$SYSPROG$ $DEBUG OFF$ $RANGE OFF$
$ALLOW_PACKED ON$  { JWS 4/10/85 }

PROGRAM ETU(KEYBOARD,INPUT,OUTPUT);
$SEARCH 'LIBR:EDRIVER'$
IMPORT SYSGLOBALS,MISC,FS,CI,EDRIVER,ASM,SYSDEVS;

VAR
  KEYBOARD      : TEXT;

(****************************************************************************)
PROCEDURE COMMANDLEVEL;
CONST
  SH_EXC     = CHR(27);
  K16        = 16384;
  MINSC      = 8;
  MAXSC      = 31;

TYPE
  PROMPTTYPE = STRING80;
  BUFTYPE    = PACKED ARRAY[0..MAXINT] OF CHAR;
  BIGPTR     = ^BUFTYPE;
  PASSTYPE   = (CHECK,BURN,VERIFY);
TYPE
  EPROMPTR   = ^EPROMREC;
  EPROMREC   = RECORD
		 NEXT     : EPROMPTR;
		 BASEADDR : INTEGER;
		 EPSIZE   : INTEGER;
		 EPINC    : INTEGER;
		 PRESENT  : ARRAY[0..7] OF BOOLEAN;
		 ADDRESS  : ARRAY[0..7] OF INTEGER;
	       END;
  DIRSTATUS  = (DNEEDED,DWANTED,DONTCARE);
  CONTROL    = RECORD
		 CFIB      : FIB;
		 PATH      : INTEGER;
		 DIROPEN   : BOOLEAN;
		 FILEOPEN  : BOOLEAN;
		 USEUNIT   : BOOLEAN;
		 MOUNTED   : BOOLEAN;
		 CPVOL     : VID;
		 CVOL      : VID;
		 CFILE     : FID;
		 DSTATUS   : DIRSTATUS;
	       END;

VAR
  SCODE : INTEGER;
  OP    : CHAR;
  FASTBURN      : BOOLEAN;
  TEMP          : INTEGER;
  EPINFO        : EPINFOREC;
  ERROR         : EPERROR;

  HEAPINUSE     : BOOLEAN;

  ININFO        : CONTROL;

  SAVEIO        : INTEGER;
  SAVEESC       : INTEGER;
  LHEAP         : ANYPTR;
  EPROMLIST     : EPROMPTR;
  EPROMDATA     : EPROMPTR;
  LEFTTOXFER    : INTEGER;
  OUTPOSITION   : INTEGER;
  OUTSTARTA     : INTEGER;
  PASS          : INTEGER;

(****************************************************************************)
PROCEDURE FIXLOCK;
BEGIN
  IF LOCKLEVEL<>0 THEN
  BEGIN LOCKLEVEL := 1; LOCKDOWN; END;
END;    { FIXLOCK }

(****************************************************************************)
PROCEDURE PRINTIOERRMSG;
VAR
  MSG   : STRING[80];
BEGIN
  IF IORESULT<>ORD(INOERROR) THEN
  BEGIN
    GETIOERRMSG(MSG,IORESULT);
    WRITELN('Error: ',MSG,CTEOL);
    IF STREAMING THEN ESCAPE(-1);
  END;
END;    { PRINTIOERRMSG }

(****************************************************************************)
PROCEDURE SHOWPROMPT(P : PROMPTTYPE);
BEGIN WRITE(HOMECHAR,P,CTEOL); END;

(****************************************************************************)
PROCEDURE GOODIO;
BEGIN IF IORESULT<>ORD(INOERROR) THEN ESCAPE(0); END;

(****************************************************************************)
PROCEDURE BADIO(IOCODE : IORSLTWD);
BEGIN IORESULT := ORD(IOCODE); ESCAPE(0); END;

(****************************************************************************)
PROCEDURE BADMESSAGE(P : PROMPTTYPE);
BEGIN
  WRITELN(P,CTEOL);
  IF STREAMING THEN ESCAPE(-1) ELSE BADIO(INOERROR);
END;    { BADMESSAGE }

(****************************************************************************)
PROCEDURE BADCOMMAND(C:CHAR);
BEGIN
  WRITELN('BAD COMMAND ''',C,'''',CTEOL);
  IF STREAMING THEN ESCAPE(-1) ELSE BADIO(INOERROR);
END;    { BADCOMMAND }

(****************************************************************************)
PROCEDURE READCHECK;
BEGIN
  IF IORESULT<>ORD(INOERROR) THEN
  BEGIN
    SAVEIO := IORESULT; WRITELN; IORESULT := SAVEIO;
    ESCAPE(0);
  END;
END;    { READCHECK }

(****************************************************************************)
PROCEDURE READNUMBER(VAR INT : INTEGER);
VAR
  I        : INTEGER;
  TI       : INTEGER;
  INSTRING : STRING[20];
BEGIN
  READLN(INSTRING);  GOODIO;
  INSTRING:=STRLTRIM(INSTRING);
  IF STRLEN(INSTRING)>0 THEN
  TRY
    IF INSTRING[1]=SH_EXC THEN ESCAPE(0);
    ZAPSPACES(INSTRING);
    IF STRLEN(INSTRING)>0 THEN
    BEGIN
      TI  := 0;
      FOR I:=1 TO STRLEN(INSTRING) DO
	IF (INSTRING[I]<'0') OR (INSTRING[I]>'9') THEN BADIO(IBADVALUE)
	ELSE TI := TI * 10 + (ORD(INSTRING[I]) - ORD('0'));
      INT := TI;
    END;
  RECOVER
    IF ESCAPECODE=-4 THEN BADIO(IBADVALUE)
		     ELSE ESCAPE(ESCAPECODE);
END;    { READNUMBER }

(****************************************************************************)
FUNCTION UNITNUMBER(VAR FVID : VID):BOOLEAN;
LABEL 1;
VAR
  SL,I : INTEGER;
BEGIN
  UNITNUMBER := FALSE;
  SL := STRLEN(FVID);
  IF SL<2 THEN GOTO 1;
  IF FVID[1]<>'#' THEN GOTO 1;
  FOR I:=2 TO SL DO IF (FVID[I]<'0') OR (FVID[I]>'9') THEN GOTO 1;
  UNITNUMBER := TRUE;
1:END;
	{ UNITNUMBER }
(****************************************************************************)
PROCEDURE UPCCHAR(VAR CH : CHAR);
BEGIN IF ('a'<=CH) AND (CH<='z') THEN CH:=CHR(ORD(CH)-32); END;

(****************************************************************************)
PROCEDURE PROMPTREAD(P:PROMPTTYPE; VAR ANSWER:CHAR; LIST:PROMPTTYPE;
		     DEFAULT:CHAR);
LABEL 1;
VAR
  I    : INTEGER;
BEGIN
  IF (DEFAULT<>SH_EXC) AND STREAMING THEN ANSWER:=DEFAULT
  ELSE
  BEGIN
    WRITE(P,CTEOL);
    REPEAT
      READ(KEYBOARD,ANSWER); READCHECK; UPCCHAR(ANSWER);
      IF ANSWER=SH_EXC THEN  BEGIN WRITELN; BADIO(INOERROR); END;
      FOR I:=1 TO STRLEN(LIST) DO  { IS CHARACTER IN THE LIST ? }
	IF ANSWER=LIST[I] THEN GOTO 1;
      IF STREAMING THEN BADCOMMAND(ANSWER);
    UNTIL FALSE;
   1:WRITELN(ANSWER);
  END;
END;    { PROMPTREAD }

(****************************************************************************)
PROCEDURE PROMPTYORN(P : PROMPTTYPE; VAR ANSWER :CHAR);
BEGIN
  PROMPTREAD(P+' ? (Y/N) ',ANSWER,'YN','Y');
END;    { PROMPTYORN }

(****************************************************************************)
PROCEDURE MOUNTVOLUME(SD : PROMPTTYPE ;VAR FINFO : CONTROL);
VAR
  ANSWER        : CHAR;
  UNIT          : INTEGER;
  TEMPNAME      : VID;

BEGIN
  WITH FINFO DO
  BEGIN
    IF STREAMING THEN
    BEGIN
      WRITELN('VOLUME ',CPVOL,' NOT ONLINE WHILE STREAMING',CTEOL);
      ESCAPE(-1);
    END;

    TEMPNAME := CPVOL;
    UNIT     := FINDVOLUME(TEMPNAME,FALSE); { CHECK FOR BAD UNIT # }
    IORESULT := ORD(INOERROR);

    REPEAT
      { CONSTRUCT THE PROMPT }
      WRITE('Please mount',SD);
      IF STRLEN(CVOL)>0 THEN WRITE(' volume ',CVOL);
      IF ((STRLEN(SD)>0) OR (STRLEN(CVOL)>0)) AND USEUNIT THEN WRITE(' in');
      IF USEUNIT THEN WRITE(' unit ',CPVOL);
      WRITELN(CTEOL);
      PROMPTREAD('''C'' continues, <sh_exc> aborts ',ANSWER,'C','C');

      IF USEUNIT THEN TEMPNAME := CPVOL ELSE TEMPNAME := CVOL;
      CFIB.FUNIT := FINDVOLUME(TEMPNAME,TRUE);

      IF CFIB.FUNIT>0 THEN
      BEGIN
	IF IORESULT=ORD(INODIRECTORY) THEN
	BEGIN
	  IF DSTATUS<>DONTCARE THEN WRITELN('NO DIRECTORY ON ',CPVOL);
	  SETSTRLEN(TEMPNAME,0);
	  CASE DSTATUS OF
	    DNEEDED: CFIB.FUNIT := 0;
	    DWANTED: BEGIN
		       PROMPTYORN('Use current media',ANSWER);
		       IF ANSWER='N' THEN CFIB.FUNIT := 0
				     ELSE DSTATUS    := DONTCARE;
		     END;
	    OTHERWISE
	  END;   { CASE DSTATUS }
	END
	ELSE
	BEGIN
	  IF IORESULT<>ORD(INOERROR) THEN
	  BEGIN
	    PRINTIOERRMSG; CFIB.FUNIT := 0;
	  END
	  ELSE
	  BEGIN { FOUND A DIRECTORY }
	    IF CVOL='' THEN CVOL := TEMPNAME
	    ELSE
	    IF CVOL<>TEMPNAME THEN CFIB.FUNIT := 0;
	  END;
	END;
      END;
    UNTIL CFIB.FUNIT>0;
    CFIB.FVID := CVOL;
    MOUNTED   := TRUE;
  END;
END;    { MOUNT VOLUME }

(****************************************************************************)
PROCEDURE SPACEWAIT;
VAR
  ANSWER        : CHAR;
BEGIN
  PROMPTREAD('<space> continues, <sh_exc> aborts ',ANSWER,' ',' ');
END;    { SPACEWAIT }

(****************************************************************************)
  PROCEDURE PROMPTFORCHAR(PL : PROMPTTYPE; VAR CH : CHAR);
  BEGIN
    FGOTOXY(OUTPUT,0,0); WRITE(PL,' ? ',CTEOL);
    READ(KEYBOARD,CH);    READCHECK;
    UPCCHAR(CH); WRITELN(CH);
    FGOTOXY(OUTPUT,0,1); WRITELN(CTEOL);
  END;    { PROMPTFORCHAR }

$IOCHECK OFF$
(****************************************************************************)
PROCEDURE SETUPFIBFORFILE(FILENAME      : FID;
		      VAR LFIB          : FIB;
		      VAR VNAME         : VID);
VAR
  LKIND : FILEKIND;
  SEGS  : INTEGER;

BEGIN
  SEGS     := 0;
  IORESULT := ORD(INOERROR);
  WITH LFIB DO
    IF SCANTITLE(FILENAME,FVID,FTITLE,SEGS,LKIND) THEN
    BEGIN
      VNAME      := FVID;
      FUNIT      := FINDVOLUME(FVID,TRUE);
      FKIND      := LKIND;      FEFT := EFTTABLE^[LKIND];
      FOPTSTRING := NIL;        FBUFFERED  := TRUE;
      FPOS       := SEGS * 512; FREPTCNT   := 0;
      FANONYMOUS := FALSE;      FMODIFIED  := FALSE;
      FBUFCHANGED:= FALSE;      FSTARTADDRESS := 0;
      FLASTPOS   := -1;         PATHID     := -1;
      FNOSRMTEMP := TRUE;       FLOCKED    := TRUE;
      FEOF       := FALSE;      FEOLN      := FALSE;
    END
    ELSE BADIO(IBADTITLE);
END;    { SETUPFIBFORFILE }

(****************************************************************************)
PROCEDURE CLOSEDIR;
BEGIN
  WITH ININFO, CFIB DO
  BEGIN
    IF DIROPEN THEN
    BEGIN
      LOCKUP;       { LOCK KEYBOARD FOR THIS OPERATION }
      PATHID := PATH;   { RESTORE PATHID }
      CALL(UNITABLE^[FUNIT].DAM,CFIB,FUNIT,CLOSEDIRECTORY);
      DIROPEN := FALSE;
      LOCKDOWN;
    END;
  END;
END;    { CLOSEDIR }

(****************************************************************************)
PROCEDURE OPENDIR(FILENAME      : FID;
	      VAR SOURCEFILE    : FID;
		  PROMPT        : PROMPTTYPE;
	      VAR FINFO         : CONTROL;
	      VAR DIRCATENTRY   : CATENTRY);
VAR
  UNIT     : INTEGER;

BEGIN   { OPENDIR }
  IORESULT := ORD(INOERROR);
  WITH FINFO, CFIB DO
  TRY
    SETUPFIBFORFILE(FILENAME,CFIB,CPVOL);
    USEUNIT := UNITNUMBER(CPVOL);       DSTATUS := DNEEDED;
    IF USEUNIT THEN CVOL := '' ELSE CVOL := CPVOL;
    IF (FUNIT=0) OR UNITNUMBER(FVID) THEN MOUNTVOLUME(PROMPT,FINFO)
				     ELSE MOUNTED := TRUE;
    WITH UNITABLE^[FUNIT] DO
    BEGIN
      LOCKUP;           { LOCK KEYBOARD }
      FWINDOW    := ADDR(DIRCATENTRY);
      CALL(DAM,CFIB,FUNIT,OPENDIRECTORY);
      DIROPEN    := (IORESULT=ORD(INOERROR));
      IF DIROPEN THEN
      BEGIN
	PATH       := PATHID;
	SOURCEFILE := FTITLE;
	CVOL       := DIRCATENTRY.CNAME;
      END;
      LOCKDOWN;         { UNLOCK KEYBOARD }
      IF NOT DIROPEN THEN ESCAPE(0);    { OPENDIRECTORY FAILED }
    END
  RECOVER
    IF ESCAPECODE<>0 THEN ESCAPE(ESCAPECODE);
END;    { OPENDIR }

(****************************************************************************)
PROCEDURE INMOUNT(SWAP : BOOLEAN);
BEGIN
  IF NOT ININFO.MOUNTED THEN
  WITH ININFO, CFIB DO
  BEGIN
    MOUNTVOLUME(' SOURCE',ININFO);
    UNITABLE^[FUNIT].UMEDIAVALID := TRUE;
  END;
END;    { INMOUNT }

(****************************************************************************)
PROCEDURE CLOSEINFILE;
BEGIN
  WITH ININFO ,CFIB DO
  BEGIN
    IF FILEOPEN THEN
    BEGIN
      LOCKUP;
      FMODIFIED := FALSE;
      CALL(UNITABLE^[FUNIT].DAM,CFIB,FUNIT,CLOSEFILE);
      FILEOPEN := FALSE;
      LOCKDOWN;
    END;
  END;
END;    { CLOSEINFILE }


(****************************************************************************)
PROCEDURE CLOSEALL;
BEGIN CLOSEINFILE; CLOSEDIR; END;

(****************************************************************************)
PROCEDURE ANYTOMEM(       FFIB   : FIBP;
		   ANYVAR BUFFER : BIGPTR;
			  MAXBUF : INTEGER);
VAR
  BUFREC    :  ^STRING255;
  BUFPTR    :  ^CHAR;
  LEFTINBUF :  INTEGER;

BEGIN   { ANYTOMEM }
  BUFPTR    := ADDR(BUFFER^);
  BUFPTR^   := CHR(0);  { DATA COMMING }
  BUFREC    := ADDR(BUFPTR^,1);
  SETSTRLEN(BUFREC^,0); { ZERO LENGTH RECORD }
  BUFPTR    := ADDR(BUFREC^,1);
  LEFTINBUF := MAXBUF;

  WITH FFIB^, UNITABLE^[FUNIT] DO
  BEGIN
    CALL(AM,FFIB,READTOEOL,BUFREC^,255,FPOS);
    GOODIO;
    REPEAT
      GOODIO; { CHECK IORESULT FROM LAST READTOEOL }
      LEFTTOXFER := LEFTTOXFER - STRLEN(BUFREC^);
      IF LEFTTOXFER<0 THEN
      BEGIN     { CLIP THIS LINE AND FAKE END OF FILE }
	SETSTRLEN(BUFREC^,STRLEN(BUFREC^)+LEFTTOXFER);
	LEFTTOXFER := 0;
      END;
      BUFPTR := ADDR(BUFPTR^,STRLEN(BUFREC^));

      LEFTINBUF := LEFTINBUF - STRLEN(BUFREC^) - 2;
      IF STRLEN(BUFREC^) = 255 THEN BUFPTR := ADDR(BUFPTR^,-1)
      ELSE
      BEGIN
	IF STRLEN(BUFREC^)=0 THEN
	BEGIN { DISCARD THE LENGTH BYTE }
	  BUFPTR := ADDR(BUFREC^,-1);
	  LEFTINBUF := LEFTINBUF + {1} 2; {BUGFIX SFB 5/2/85--SAME AS IN
					   FILER AND FILEPACK}
	END;

	   { CHECK END OF LINE/FILE }
	CALL(AM,FFIB,READBYTES,BUFPTR^,1,FPOS);
	IF FEOLN THEN
	BEGIN  { END OF LINE }
	  BUFPTR^ := CHR(1);  FEOLN := FALSE;
	  LEFTINBUF := LEFTINBUF - 1; {BUGFIX SFB 5/2/85--SAME AS IN
				       FILER AND FILEPACK}
	  IF IORESULT = ORD(IEOF) THEN BUFPTR := ADDR(BUFPTR^,1);
	END;
	IF (IORESULT=ORD(IEOF)) OR (LEFTTOXFER=0) THEN
	BEGIN  { END OF FILE }
	  BUFPTR^  := CHR(2);
	  IORESULT := ORD(INOERROR);
	  FEOF     := TRUE;
	END;
	GOODIO;       { CHECK IORESULT FROM READBYTES }
      END;
      IF NOT ((LEFTINBUF < 259) OR FEOF) THEN
      BEGIN { SETUP FOR TO READ THE NEXT LINE }
	BUFPTR    := ADDR(BUFPTR^,1);
	BUFPTR^   := CHR(0);  { DATA RECORD }
	BUFREC    := ADDR(BUFPTR^,1);
	SETSTRLEN(BUFREC^,0); { ZERO LENGTH RECORD }
	BUFPTR    := ADDR(BUFREC^,1);
	CALL(AM,FFIB,READTOEOL,BUFREC^,255,FPOS);
      END;
    UNTIL (LEFTINBUF < 259) OR FEOF;
    BUFPTR := ADDR(BUFPTR^,1);    BUFPTR^ := CHR(3); { END BUFFER }
  END;
END;    { ANYTOMEM }

(****************************************************************************)
FUNCTION CHECKSPACE(START,SIZE:INTEGER; VAR OKSIZE:INTEGER):BOOLEAN;

VAR
  POINT : INTEGER;
  PART  : INTEGER;

BEGIN { CHECK SPACE }
  OKSIZE := -1; CHECKSPACE := FALSE;
  WITH EPROMDATA^ DO
  BEGIN
    { FIND THE PART CONTAINING THE START ADDRESS }
    PART := 0;
    WHILE PART<8 DO
    BEGIN
      IF (START>=ADDRESS[PART]) AND
	 (START<(ADDRESS[PART]+EPINC)) THEN
      BEGIN
	IF PRESENT[PART] THEN
	BEGIN   { FOUND START NOW FIND END POINT }
	  POINT := START + SIZE - 1;    { END POINT }
	  WHILE PART<8 DO
	  BEGIN
	    IF PRESENT[PART] THEN
	    BEGIN
	      IF (POINT<(ADDRESS[PART]+EPINC)) THEN
	      BEGIN     { IT ALL FITS }
		OKSIZE := SIZE; CHECKSPACE:=TRUE; PART := 8; { FORCE EXIT }
	      END
	      ELSE     { FIGURE SPACE SO FAR }
	      BEGIN
		OKSIZE := (ADDRESS[PART]+EPINC)-START;
		PART := PART + 1;
	      END;
	    END { IF PRESENT }
	    ELSE PART := 8;     { FORCE EXIT }
	  END;  { WHILE }
	END;    { IF PRESENT }
	PART := 8;      { FORCE EXIT }
      END       { IF ADDRESS IN RANGE }
      ELSE PART := PART + 1;
    END;        { WHILE }
  END;  { WITH EPROMDATA }
END;    { CHECKSPACE }

(****************************************************************************)
PROCEDURE PASSFAILED(FAILCODE:PASSTYPE);
VAR
  PART : INTEGER;
  UL   : CHAR;
  I    : INTEGER;

BEGIN
  WITH EPROMDATA^ DO
  BEGIN
    FOR I := 0 TO 7 DO
      IF (OUTPOSITION>=ADDRESS[I]) AND
	 (OUTPOSITION<(ADDRESS[I]+EPINC)) THEN PART := I;

    IF ODD(OUTPOSITION) THEN UL := 'L' ELSE UL := 'U';
    WRITE(FAILCODE,' FAIL');
    WRITELN(' AT ABSOLUTE ADDRESS ',OUTPOSITION:1);
    WRITELN(' BYTE POSITION ',OUTPOSITION-OUTSTARTA:1,' FROM START LOCATION');
    WRITELN(' EPROM SOCKET ',PART:1,UL,
	    ' BYTE ',(OUTPOSITION-ADDRESS[PART]) DIV 2:1);
  END;
  IF STREAMING THEN ESCAPE(-1) ELSE BADIO(INOERROR);
END;    { PASSFAILED }

(****************************************************************************)
PROCEDURE PRINTBR;
BEGIN
  FGOTOXY(OUTPUT,0,4); WRITE('Burn rate   ');
  IF FASTBURN THEN WRITE('FAST') ELSE WRITE('SLOW');
  WRITELN(CTEOL);
END;

(****************************************************************************)
PROCEDURE BURNIT(ANYVAR BUFFER   : WINDOW;
			SIZE     : INTEGER);
VAR
  OLDPOSIT : INTEGER;
  OLDX,OLDY: INTEGER;
BEGIN
  IF PASS=1 THEN
  BEGIN        { CHECK IF CAN BURN }
    ERROR:=EPROG(SCODE,ECHECK,BUFFER,SIZE,OUTPOSITION);
    IF ERROR<>ENOERROR THEN PASSFAILED(CHECK);
  END
  ELSE
  BEGIN        { TRY TO BURN IT }
    OLDPOSIT := OUTPOSITION;    { SAVE POSITION FOR RETRY }
    ERROR:=EPROG(SCODE,ECWRITE,BUFFER,SIZE,OUTPOSITION);
    IF ERROR<>ENOERROR THEN
      IF NOT FASTBURN THEN
      BEGIN
	IF ERROR=ECFAIL THEN PASSFAILED(VERIFY)
			ELSE PASSFAILED(BURN);
      END
      ELSE
      BEGIN
	FASTBURN := FALSE;      { SET BURN RATE TO SLOW }
	FGETXY(OUTPUT,OLDX,OLDY);       { UPDATE THE DISPLAY }
	PRINTBR;
	FGOTOXY(OUTPUT,OLDX,OLDY);
	ERROR := EBRATE(SCODE,FASTBURN);
	OUTPOSITION := OLDPOSIT;{ RESET POSITION AND RETRY }
	ERROR:=EPROG(SCODE,ECWRITE,BUFFER,SIZE,OUTPOSITION);
	IF ERROR<>ENOERROR THEN
	  IF ERROR=ECFAIL THEN PASSFAILED(VERIFY)
			  ELSE PASSFAILED(BURN);
      END;
  END;
  IORESULT:=ORD(INOERROR);      { CLEAR I/O RESULT }
END;    { BURNIT }

(****************************************************************************)
PROCEDURE MEMTOEPROM(ANYVAR BUFFER : BIGPTR);
VAR
  BYTES : INTEGER;
  BUFPTR: ^CHAR;

BEGIN
  BUFPTR := ADDR(BUFFER^);
  BEGIN
    BYTES := 0;
    REPEAT
      BUFPTR := ADDR(BUFPTR^,BYTES);
      BYTES  := ORD(BUFPTR^);
      BUFPTR := ADDR(BUFPTR^,1);
      CASE BYTES OF
      0: BEGIN          { DATA BYTES }
	   BYTES := ORD(BUFPTR^);       { RECORD LENGTH }
	   BUFPTR:= ADDR(BUFPTR^,1);
	   BURNIT(BUFPTR^,BYTES);
	 END;
      1: BEGIN          { END RECORD }
	   BYTES := 0;
	 END;
      2: BEGIN          { END FILE }
	   BYTES := -1;
	 END;
      3: BYTES := -1;   { END BUFFER }
      OTHERWISE IORESULT := ORD(IBADREQUEST);
      END;
      GOODIO;
    UNTIL BYTES<0;
  END;
END;    { MEMTOEPROM }

(****************************************************************************)
  FUNCTION CHECKCARD(SC:INTEGER):BOOLEAN;
  VAR
    ECODE : EPERROR;
  BEGIN
    ECODE:=EINIT(SC);
    CHECKCARD:=(ECODE=ENOERROR) OR (ECODE=ENOEPROM);
  END;  { CHECKCARD }

(****************************************************************************)
  PROCEDURE CHECKSCODE;
  BEGIN
    IF NOT CHECKCARD(SCODE)
      THEN BADMESSAGE('*** NO PROGRAMMER CARD IN SYSTEM ***');
  END;

(****************************************************************************)
  PROCEDURE CHECKEPROM;
  VAR
    I       : INTEGER;
    DONE    : BOOLEAN;

  BEGIN
    CHECKSCODE;
    ERROR:=EGETINFO(SCODE,EPINFO);
    IF EPINFO.EPSTART=0 THEN
      BADMESSAGE('NO EPROM CARD ATTACHED TO PROGRAMMER CARD');

    EPROMDATA := EPROMLIST;
    DONE := FALSE;
    REPEAT
      IF EPROMDATA=NIL THEN
      BEGIN
	NEW(EPROMDATA);
	WITH EPROMDATA^ , EPINFO DO
	BEGIN
	  BASEADDR  := EPSTART;
	  EPSIZE    := EPEND-EPSTART;
	  EPINC     := EPSIZE DIV 8;
	  ADDRESS[0]:= BASEADDR;
	  PRESENT[0]:= TRUE;
	  FOR I:=1 TO 7 DO
	  BEGIN
	    ADDRESS[I]:= ADDRESS[I-1]+EPINC;
	    PRESENT[I]:= TRUE;
	  END;
	  NEXT := EPROMLIST;
	  EPROMLIST := EPROMDATA;
	  DONE := TRUE;
	END;
      END
      ELSE
      BEGIN
	IF EPROMDATA^.BASEADDR=EPINFO.EPSTART THEN DONE := TRUE
	ELSE EPROMDATA := EPROMDATA^.NEXT;
      END;
    UNTIL DONE;
  END; { CHECKEPROM }

(****************************************************************************)
  PROCEDURE FINDCARD(SCODES:BOOLEAN);
  VAR
    SC : INTEGER;
  BEGIN
    FOR SC:=MINSC TO MAXSC DO
    IF CHECKCARD(SC) THEN
    BEGIN
      IF SCODES THEN WRITE(SC:3);
      SCODE := SC;
    END;
  END; { FINDCARD }

(****************************************************************************)
  PROCEDURE DOCONFIGURE(DOPROMPT:BOOLEAN);
  VAR
    DONE : BOOLEAN;
    OLDSCODE : INTEGER;
    OP       : CHAR;
    I        : INTEGER;

    {-------------------------------------------------------------------------}
    PROCEDURE PRINTSC;
    BEGIN
      FGOTOXY(OUTPUT,0,3);
      WRITELN('Active programmer card at select code ',SCODE:1,CTEOL);
    END;


    {-------------------------------------------------------------------------}
    PROCEDURE PRINTEPINFO;
    BEGIN
      FGOTOXY(OUTPUT,0,5);
      TRY
	CHECKEPROM;
	TEMP := EPINFO.EPEND-EPINFO.EPSTART;
	WRITELN('EPROM at address ',EPINFO.EPSTART:1,' for ',
		  TEMP:1,' bytes',CTEOL);
	WRITELN('EPROM type XX',TEMP DIV 2048:1,CTEOL);
      RECOVER
	IF ESCAPECODE<>0 THEN ESCAPE(ESCAPECODE);
    END;

    {-------------------------------------------------------------------------}
    PROCEDURE PRINTSOCKETS;
    VAR
      I : INTEGER;
    BEGIN
      FGOTOXY(OUTPUT,0,7);
      WRITELN('Socket status (UL means EPROM pair present)');
      WITH EPROMDATA^ DO
      FOR I:= 0 TO 3 DO
      BEGIN
	WRITE(I:1);
	IF PRESENT[I] THEN WRITE('UL    ') ELSE WRITE(' empty');
	WRITE(I+4:4);
	IF PRESENT[I+4] THEN WRITE('UL    ') ELSE WRITE(' empty');
	WRITELN;
      END;
    END;

    {-------------------------------------------------------------------------}
  BEGIN { DOCONFIGURE }
    FGOTOXY(OUTPUT,0,2); WRITE(CTEOS);
    CHECKSCODE;
    OLDSCODE:=SCODE;
    WRITE('Programmer card(s) at ');
    FINDCARD(TRUE);
    SCODE := OLDSCODE;
    PRINTSC;
    PRINTBR;
    PRINTEPINFO;
    IF EPINFO.EPSTART>0 THEN PRINTSOCKETS;
    IF DOPROMPT THEN
    REPEAT
    TRY
      PROMPTFORCHAR('CONFIGURE: Selectcode Burnrate Emptysockets Qt',OP);
      FGOTOXY(OUTPUT,0,13); WRITE(CTEOS);
      IF OP=SH_EXC THEN OP:='Q';

      IF OP='S' THEN
      BEGIN     { NEW SELECT CODE }
	OLDSCODE := SCODE;
	WRITE('New select code (',SCODE:1,') ? '); READNUMBER(SCODE);
	IF (SCODE<MINSC) OR (SCODE>MAXSC) THEN
	BEGIN SCODE := OLDSCODE; BADMESSAGE('SELECT CODE OUT OF RANGE'); END;
	IF NOT CHECKCARD(SCODE) THEN
	BEGIN
	  SCODE := OLDSCODE; BADMESSAGE('SELECT CODE NOT A PROGRAMMER CARD');
	END;
	PRINTSC;
	PRINTBR;
	PRINTEPINFO;
	IF EPINFO.EPSTART>0 THEN PRINTSOCKETS ELSE WRITE(CTEOS);
      END
      ELSE
      IF OP='B' THEN
      BEGIN
	FASTBURN := NOT FASTBURN; PRINTBR;
      END
      ELSE
      IF OP='E' THEN
      BEGIN
	IF EPINFO.EPSTART>0 THEN
	BEGIN
	  I := -1;
	  WRITE('SOCKET (PAIR) NUMBER ? ',CTEOL); READNUMBER(I);
	  IF I>=0 THEN
	    IF (I<0) OR (I>7) THEN BADMESSAGE('SOCKET NUMBER OUT OF RANGE')
	    ELSE
	    BEGIN
	      EPROMDATA^.PRESENT[I] := NOT EPROMDATA^.PRESENT[I];
	      PRINTSOCKETS;
	    END;
	END
	ELSE BEEP;
      END
      ELSE
      IF (OP<>'Q') THEN
	IF STREAMING THEN BADCOMMAND(OP)
		     ELSE BEEP;

    RECOVER
    BEGIN
      LOCKUP;
      SAVEIO       := IORESULT;
      SAVEESC      := ESCAPECODE;
      IORESULT     := SAVEIO;
      IF (SAVEESC<>0) AND (SAVEESC<>-10) THEN IORESULT := ORD(INOERROR);
      LOCKDOWN;
      PRINTIOERRMSG;
      FIXLOCK;
      IF SAVEESC<>0 THEN ESCAPE(SAVEESC) ELSE OP := ' ';
    END;

    UNTIL OP='Q';
  END; { DOCONFIGURE }

(****************************************************************************)
  PROCEDURE DOTRANSFER;
  TYPE
    HEADREC = PACKED ARRAY[0..17] OF BYTE;

    HEADP = RECORD
	      CASE BOOLEAN OF
	      TRUE : (BINT:INTEGER);
	      FALSE: (BPTR:^HEADREC);
	    END;
  VAR
    FILENAME1     : FID;
    SOURCEFILE    : FID;

    FILEMOVED     : BOOLEAN;
    DONE          : BOOLEAN;
    FORMAT        : BOOLEAN;

    I             : INTEGER;
    J             : INTEGER;
    EPART         : INTEGER;
    INSTATE       : INTEGER;
    OUTSTATE      : INTEGER;
    BUF           : BIGPTR;
    POSITION      : INTEGER;
    MOVESIZE      : INTEGER;
    MSIZE         : INTEGER;
    BUFSIZE       : INTEGER;
    OUTSIZE       : INTEGER;
    SAVEIO        : INTEGER;
    SAVEESC       : INTEGER;
    DUMWINDOW     : WINDOWP;
    EDHEADER      : HEADREC;
    MSGLINE       : STRING[255];
    DIRCATENTRY   : CATENTRY;
    BLANKCHK      : HEADP;
    ANSWER        : CHAR;

  BEGIN   { DOTRANSFER }
    DOCONFIGURE(FALSE);
    FGOTOXY(OUTPUT,0,13);
    WRITELN('TRANSFER OPERATION',CTEOS);
    CHECKEPROM;

    WRITE('Source (',DKVID,':) ? ');
    READLN(FILENAME1);     GOODIO;
    FILENAME1 := STRLTRIM(STRRTRIM(FILENAME1));
    IF STRLEN(FILENAME1)=0 THEN FILENAME1:=DKVID+':';
    ZAPSPACES(FILENAME1);
    IF STRLEN(FILENAME1)>0 THEN
    WITH EPROMDATA^ DO
    BEGIN { HAVE A SOURCE NAME }
      WITH ININFO DO
	BEGIN DIROPEN := FALSE; FILEOPEN := FALSE; MOUNTED := FALSE; END;
      MARK(LHEAP);  HEAPINUSE := TRUE;
      NEWWORDS(DUMWINDOW,1);  { DUMMY WINDOW FOR FILE TRANSFER }
      TRY
	WITH ININFO, CFIB DO
	BEGIN
	  { OPEN THE SOURCE }
	  SETUPFIBFORFILE(FILENAME1,CFIB,CPVOL);
	  IF STRLEN(FTITLE)=0 THEN
	  BEGIN { VOLUME -> EPROM }
	    USEUNIT := UNITNUMBER(CPVOL);     DSTATUS := DWANTED;
	    IF USEUNIT THEN CVOL := '' ELSE CVOL := CPVOL;
	    MOUNTED := (FUNIT>0) AND NOT(UNITNUMBER(FVID));
	    IF MOUNTED THEN CVOL := FVID ELSE INMOUNT(TRUE);

	    LOCKUP;   { LOCK THE KEYBOARD THEN OPEN THE VOLUME }
	    FBUFFERED := FALSE;
	    FKIND     := UNTYPEDFILE;     FEFT := EFTTABLE^[FKIND];
	    CALL(UNITABLE^[FUNIT].DAM,CFIB,FUNIT,OPENVOLUME);
	    FILEOPEN  := (IORESULT=ORD(INOERROR));
	    LOCKDOWN; { UNLOCK THE KEYBOARD }
	    GOODIO;
		      { FINISH THE SETUPT }
	    OUTSIZE    := FPEOF;
	    SOURCEFILE := '';
	    FTID       := '';
	    FORMAT     := FALSE;
	    FGOTOXY(OUTPUT,0,14);
	    WRITELN('TRANSFERRING VOLUME ',FVID,':');
	  END { VOLUME -> EPROM }
	  ELSE
	  BEGIN { FILE -> EPROM }
	    OPENDIR(FILENAME1,SOURCEFILE,' SOURCE',ININFO,DIRCATENTRY);
	    IF NOT DIROPEN THEN ESCAPE(0);
	    IF STRLEN(SOURCEFILE)=0 THEN
	       BADMESSAGE('CAN''T TRANSFER A DIRECTORY');
	    FTITLE := SOURCEFILE;
	    FINITB(CFIB,DUMWINDOW,-3);
	    PATHID := PATH;
	    LOCKUP;
	    CALL(UNITABLE^[FUNIT].DAM,CFIB,FUNIT,OPENFILE);
	    FILEOPEN := IORESULT=ORD(INOERROR);
	    LOCKDOWN;
	    GOODIO;
	    FORMAT := (FKIND=ASCIIFILE) OR (FKIND=TEXTFILE);
	    OUTSIZE := FLEOF;
	    FGOTOXY(OUTPUT,0,14);
	    WRITELN('TRANSFERING FILE ',CVOL,':',SOURCEFILE,CTEOL);
	  END; { FILE -> EPROM }
	END;   { WITH ININFO, CFIB -- OPEN THE SOURCE }

	{ ALLOCATE BUFFER SPACE }
	BUFSIZE := (MEMAVAIL DIV 256) * 256 - 30 * 512; {SAME SOME FOR SLOP}
	IF BUFSIZE<512 THEN ESCAPE(-2);       { NOT ENOUGH ROOM }
	NEWWORDS(BUF,BUFSIZE DIV 2);          { ALLOCATE BUFFER SPACE }

	{ GET START ADDRESS ON EPROM }
	MSGLINE := '';
	WITH EPINFO DO
	IF SOURCEFILE='' THEN
	BEGIN     { VOLUME TRANSFER }
	  { SET DEFAULT START BLOCK }
	  TEMP := 0;
	  OUTSTARTA := EPSTART ;
	  DONE := FALSE;
	  REPEAT
	    IF PRESENT[TEMP] THEN
	    BEGIN       { SOCKET PRESENT, CHECK CONTENTS }
	      BLANKCHK.BINT := OUTSTARTA;
	      IF (BLANKCHK.BPTR^[0]=255) AND
		 (BLANKCHK.BPTR^[1]=255) THEN DONE := TRUE
	      ELSE
	      BEGIN     { INCREMENT TO NEXT BLOCK }
		OUTSTARTA := OUTSTARTA+K16;
		IF TEMP<7 THEN
		  IF OUTSTARTA>=ADDRESS[TEMP+1] THEN TEMP := TEMP+1;
	      END;
	    END
	    ELSE
	    BEGIN       { SKIP EMPTY SOCKET PAIR }
	      IF TEMP<7 THEN TEMP := TEMP+1;
	      OUTSTARTA := OUTSTARTA+EPINC;
	    END;
	  UNTIL DONE OR (OUTSTARTA>EPEND);

	  IF OUTSTARTA>EPEND THEN
	  BEGIN
	    WRITELN('*** NO BLANK BLOCK ON THIS EPROM CARD ***');
	    OUTSTARTA:=EPSTART;
	  END;
	  OUTSTARTA := (OUTSTARTA-EPSTART) DIV K16;

	  WRITE('Start at EPROM block offset (',OUTSTARTA:1,') ? ');
	  READNUMBER(OUTSTARTA); OUTSTARTA:=OUTSTARTA*K16;
	  STRWRITE(MSGLINE,1,I,'BLOCK OFFSET NOT IN RANGE 0..',
			       (EPSIZE DIV K16)-1:1);
	END
	ELSE
	BEGIN     { FILE TRANSFER }
	  OUTSTARTA := 0;        { DEFAULT VALUE }
	  WRITE('Start at EPROM byte offset (',OUTSTARTA:1,') ? ');
	  READNUMBER(OUTSTARTA);
	  STRWRITE(MSGLINE,1,I,'BYTE OFFSET NOT IN RANGE 0..',EPSIZE-1:1);
	END;

	IF OUTSTARTA>(EPSIZE-1) THEN BADMESSAGE(MSGLINE);
	OUTSTARTA := OUTSTARTA + EPINFO.EPSTART;

	{ CHECK TO SEE IF DATA WILL FIT IN AVAILABLE EPROM SPACE }
	J := OUTSIZE;     { VOL / FILE SIZE }
	IF SOURCEFILE='' THEN
	BEGIN
	  J := J + 18; { ADD HEADER }
	  J := J + (J DIV K16)*2; { ADD 16K HEADER GAPS }
	END;
	IF NOT CHECKSPACE(OUTSTARTA,J,I) THEN
	BEGIN
	  IF I<=0 THEN
	  BEGIN WRITELN('NO EPROM AT START ADDRESS'); BADIO(INOERROR); END;

	  WRITELN('DATA EXCEEDS EPROM SPACE BY ',J-I:1,' BYTES',CTEOL);
	  IF STREAMING THEN ESCAPE(-1);
	  PROMPTREAD('Abort transfer or Truncate file (A/T) ? ',
		      ANSWER,'AT',SH_EXC);
	  IF ANSWER='A' THEN ESCAPE(0);
	  IF SOURCEFILE='' THEN
	  BEGIN
	    OUTSIZE := (I-18); OUTSIZE := OUTSIZE - (OUTSIZE DIV K16)*2;
	  END
	  ELSE OUTSIZE := I;
	END;

	INSTATE  := 1;
	PASS     := 1;

	BEGIN       { TRY THE TRANSFER }
	    FILEMOVED := FALSE;
	    WITH ININFO, CFIB , EPROMDATA^ DO
	    REPEAT    { MOVE THE FILE }
	      DONE := FALSE;
	      REPEAT
		CASE INSTATE OF
		1: BEGIN      { INITIALIZE SOURCE PARAMETERS }
		     FGOTOXY(OUTPUT,0,16);
		     WRITELN('now on pass ',PASS:1,CTEOS);
		     OUTPOSITION := OUTSTARTA;
		     LEFTTOXFER  := OUTSIZE;
		     POSITION    := 0;
		     FEOF        := FALSE;   FEOLN    := FALSE;
		     FLASTPOS    := -1;      FPOS     := 0;
		     INSTATE     := 2;
		     OUTSTATE    := 1;
		   END;
		2: BEGIN      { READ THE FILE/VOLUME }
		     WRITE('reading ....',CTEOL,CHR(13));
		     IF FORMAT THEN
		     BEGIN    { FORMATED TRANSFER }
		       ANYTOMEM(ADDR(CFIB),BUF,BUFSIZE);
		       DONE := TRUE;
		       IF FEOF THEN LEFTTOXFER := 0;
		       GOODIO;
		     END
		     ELSE
		     BEGIN    { UNFORMATED TRANSFER }
		       IF BUFSIZE>LEFTTOXFER THEN MOVESIZE := LEFTTOXFER
					     ELSE MOVESIZE := BUFSIZE;
		       CALL(UNITABLE^[FUNIT].TM,ADDR(CFIB),READBYTES,
						BUF^,MOVESIZE,POSITION);
		       GOODIO;
		       LEFTTOXFER := LEFTTOXFER - MOVESIZE;
		       DONE := TRUE;
		     END;
		   END;
		END;  { CASE INSTATE }
	      UNTIL DONE;
	      WRITE(CTEOL);

	      DONE := FALSE;
	      IF NOT FILEMOVED THEN
	      REPEAT
		IF PASS=1 THEN WRITE('checking ...',CTEOL,CHR(13))
			  ELSE WRITE('writing ...',CTEOL,CHR(13));
		CASE OUTSTATE OF
		1: BEGIN
		     { SET BURN RATE }
		     ERROR:=EBRATE(SCODE,FASTBURN);
		     IF SOURCEFILE='' THEN
		     BEGIN        { VOLUME TRANSFER }
		       { PUT EDISC VOLUME HEADER }
		       FOR I := 0 TO 17 DO EDHEADER[I]:=0;
		       EDHEADER[0]:=HEX('F0');
		       EDHEADER[1]:=HEX('FF');
		       EDHEADER[2]:=ORD(' ');
		       EDHEADER[3]:=HEX('18');
		       EDHEADER[12]:=HEX('01');
		       EDHEADER[13]:=HEX('02');
		       BURNIT(EDHEADER,18);
		     END;
		     OUTSTATE := 2;
		   END;

		2: BEGIN  { WRITE DATA }
		     IF FORMAT THEN MEMTOEPROM(BUF)
		     ELSE
		     BEGIN
		       IF SOURCEFILE='' THEN
		       BEGIN      { TRANSFERING A VOLUME }
			 I := 0;
			 REPEAT
			   { WATCH FOR 16K BYTE BOUNDARIES }
			   MSIZE:=(((OUTPOSITION+K16) DIV K16)*K16)-OUTPOSITION;
			   IF MSIZE>MOVESIZE THEN MSIZE:=MOVESIZE;
			   BURNIT(BUF^[I],MSIZE);
			   I := I + MSIZE;
			   MOVESIZE := MOVESIZE - MSIZE;
			   IF ((OUTPOSITION MOD K16)=0) AND
			      ((MOVESIZE>0) OR (LEFTTOXFER>0)) THEN
			   BEGIN        { PUT ZEROES IN BOUNDARY BYTES }
			     J:=0; BURNIT(J,2);
			   END;
			 UNTIL MOVESIZE=0;
		       END
		       ELSE
		       BEGIN      { TRANSFERING A FILE }
			 BURNIT(BUF^,MOVESIZE);
		       END;
		     END;
		     DONE:=TRUE;
		     IF LEFTTOXFER=0 THEN
		     BEGIN
		       IF PASS=2 THEN FILEMOVED:=TRUE
		       ELSE
		       BEGIN  PASS:=2; INSTATE := 1; END;
		     END;
		   END;
		END;      { CASE OUTSTATE }
	      UNTIL DONE;
	      WRITE(CTEOL);
	    UNTIL FILEMOVED;
	    WRITELN('TRANSFER COMPLETED');
	    IF FORMAT THEN I := OUTPOSITION-OUTSTARTA
		      ELSE I := OUTSIZE;
	    WRITELN(I:1,' data bytes programmed and verified');
	  END;
	RELEASE(LHEAP);       HEAPINUSE := FALSE;
	CLOSEALL;
      RECOVER
      BEGIN
	LOCKUP;
	RELEASE(LHEAP);       HEAPINUSE := FALSE;
	SAVEIO    := IORESULT;
	SAVEESC   := ESCAPECODE;
	CLOSEALL;
	IORESULT  := SAVEIO;
	LOCKDOWN;
	PRINTIOERRMSG;
	IF SAVEESC<>0 THEN ESCAPE(SAVEESC);
      END;
    END;  { HAVE SOURCE NAME }
  END;    { DOTRANSFER }

(****************************************************************************)
  PROCEDURE PUTMENU(MSTRING:STRING80);
  BEGIN
    FGOTOXY(OUTPUT,0,2);
    WRITE(MSTRING,' ? ',CTEOL);
  END;

(****************************************************************************)
  PROCEDURE DOBLANKCHECK;
  TYPE
    TWOBYTES = PACKED ARRAY[0..1] OF BYTE;
  VAR
    OLDSTART    : INTEGER;
    START       : INTEGER;
    ENDSCAN     : INTEGER;
    NBYTES      : INTEGER;
    BLANKS      : BOOLEAN;
    LINES       : INTEGER;
    I           : INTEGER;
    X,Y         : INTEGER;
    BREC        : RECORD
		    CASE BOOLEAN OF
		    TRUE:(BPTR : ^TWOBYTES);
		    FALSE:(BINT : INTEGER);
		  END;
  BEGIN
    DOCONFIGURE(FALSE);
    FGOTOXY(OUTPUT,0,13);
    WRITELN('BLANK CHECK',CTEOS);
    CHECKEPROM;
    OLDSTART := 0;
    BLANKS := FALSE;
    FGETXY(OUTPUT,X,Y); LINES := 0;
    WITH EPROMDATA^ DO
    FOR I:=0 TO 7 DO    { DO ONE SOCKET PAIR AT A TIME }
    IF NOT PRESENT[I] THEN
    BEGIN       { CLOSE OFF REPORT OF PREVIOUS PAIR }
      IF BLANKS THEN
	 WRITELN(BREC.BINT-1-BASEADDR:1,' (',BREC.BINT-OLDSTART:1,')');
      BLANKS:=FALSE
    END
    ELSE
    BEGIN       { SOCKET PAIR PRESENT SO CHECK IT OUT }
      BREC.BINT := ADDRESS[I] ;
      ENDSCAN := BREC.BINT + EPINC;
      REPEAT
	IF BLANKS THEN
	BEGIN
	  IF BREC.BPTR^[0]<>255 THEN
	  BEGIN
	    WRITELN(BREC.BINT-1-BASEADDR:1,' (',BREC.BINT-OLDSTART:1,')');
	    BLANKS:=FALSE;
	  END;
	END
	ELSE
	BEGIN
	  IF BREC.BPTR^[0]=255 THEN
	  BEGIN
	    IF LINES>5 THEN
	    BEGIN
	      LINES := 0; SPACEWAIT;
	      FGOTOXY(OUTPUT,X,Y); WRITE(CTEOS);
	    END;
	    LINES := LINES + 1;
	    OLDSTART := BREC.BINT; WRITE(OLDSTART-BASEADDR,' - ');
	    BLANKS:=TRUE;
	  END;
	END;
	BREC.BINT := BREC.BINT + 1;
      UNTIL BREC.BINT=ENDSCAN;

      IF BLANKS AND (I=7) THEN
	 WRITELN(BREC.BINT-1-BASEADDR:1,' (',BREC.BINT-OLDSTART:1,')');

    END; { FOR I := ... }
    IF OLDSTART=0 THEN WRITELN('NO BLANK SPACE FOUND');
  END;  { DOBLANKCHECK }

(****************************************************************************)
BEGIN  { COMMANDLEVEL }
  FIXLOCK;
  WITH ININFO DO BEGIN DIROPEN:=FALSE; FILEOPEN:=FALSE; END;
  HEAPINUSE := FALSE;
  IORESULT  := ORD(INOERROR);
  SCODE := 0;     TEMP := 0;
  FASTBURN := FALSE;    { DEFAULT BURN RATE }
  EPROMLIST := NIL;     { NO EPROM CARD INFO YET }
  FINDCARD(FALSE);      { FIND A PROGRAMMER CARD }
  TRY
    DOCONFIGURE(FALSE); { DISPLAY DEFAULT CONFIGURATION }
  RECOVER
    IF ESCAPECODE<>0 THEN ESCAPE(ESCAPECODE);

  FGOTOXY(OUTPUT,0,13);
  WRITELN('Copyright Hewlett-Packard Company, 1983, 1991.');
  WRITELN('          All rights are reserved.');

  REPEAT
    TRY
      PROMPTFORCHAR('ETU: Transfer Configure Blankcheck Quit',OP);
      IF OP=SH_EXC THEN OP:='Q';

      IF OP='T' THEN DOTRANSFER
      ELSE
      IF OP='C' THEN DOCONFIGURE(TRUE)
      ELSE
      IF OP='B' THEN DOBLANKCHECK
      ELSE
      IF OP='Q' THEN BEGIN END
      ELSE
      IF STREAMING THEN BADCOMMAND(OP)
		   ELSE BEEP;
    RECOVER
    BEGIN
      LOCKUP;
      IF HEAPINUSE THEN RELEASE(LHEAP);
      HEAPINUSE    := FALSE;
      SAVEIO       := IORESULT;
      SAVEESC      := ESCAPECODE;
      CLOSEALL;
      IORESULT     := SAVEIO;
      IF (SAVEESC<>0) AND (SAVEESC<>-10) THEN IORESULT := ORD(INOERROR);
      LOCKDOWN;
      PRINTIOERRMSG;
      FIXLOCK;
      IF SAVEESC<>0 THEN ESCAPE(SAVEESC) ELSE OP := ' ';
    END;
  UNTIL OP='Q';
END {COMMANDLEVEL} ;

(****************************************************************************)
BEGIN
  WRITELN(CLEARSCR);
  FGOTOXY(OUTPUT,0,1);
  WRITELN('EPROM TRANSFER UTILITY (16-Mar-91)');
  COMMANDLEVEL;
END.

@


53.3
log
@
pws2rcs automatic delta on Mon Mar 18 13:19:08 MST 1991
@
text
@@


53.2
log
@Updated copyright message.
@
text
@d1286 1
a1286 1
  WRITELN('EPROM TRANSFER UTILITY (10-Mar-91)');
@


53.1
log
@Automatic bump of revision number for PWS version 3.24B
@
text
@d1246 1
a1246 1
  WRITELN('Copyright Hewlett-Packard Company, 1983, 1990.');
@


52.2
log
@
pws2rcs automatic delta on Mon Mar 11 16:41:32 MST 1991
@
text
@@


52.1
log
@Automatic bump of revision number for PWS version 3.24A
@
text
@d1286 1
a1286 1
  WRITELN('EPROM TRANSFER UTILITY (16-Feb-91)');
@


51.2
log
@
pws2rcs automatic delta on Mon Feb 18 20:38:36 MST 1991
@
text
@@


51.1
log
@Automatic bump of revision number for PWS version 3.24d
@
text
@d1286 1
a1286 1
  WRITELN('EPROM TRANSFER UTILITY (28-Jan-91)');
@


50.2
log
@
pws2rcs automatic delta on Wed Jan 30 09:08:19 MST 1991
@
text
@@


50.1
log
@Automatic bump of revision number for PWS version 3.23c
@
text
@d1286 1
a1286 1
  WRITELN('EPROM TRANSFER UTILITY (25-Oct-90)');
@


49.2
log
@
pws2rcs automatic delta on Mon Oct 29 14:00:44 MST 1990
@
text
@@


49.1
log
@Automatic bump of revision number for PWS version 3.24b
@
text
@d1286 1
a1286 1
  WRITELN('EPROM TRANSFER UTILITY (13-Aug-90)');
@


48.2
log
@
pws2rcs automatic delta on Tue Aug 14 09:29:26 MDT 1990
@
text
@@


48.1
log
@Automatic bump of revision number for PWS version 3.24a
@
text
@d1286 1
a1286 1
  WRITELN('EPROM TRANSFER UTILITY (23-Jul-90)');
@


47.2
log
@
pws2rcs automatic delta on Tue Jul 24 14:47:20 MDT 1990
@
text
@@


47.1
log
@Automatic bump of revision number for PWS version 3.23
@
text
@d1286 1
a1286 1
  WRITELN('EPROM TRANSFER UTILITY (03-May-90)');
@


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


45.2
log
@
pws2rcs automatic delta on Fri May  4 14:44:01 MDT 1990
@
text
@@


45.1
log
@Automatic bump of revision number for PWS version 3.23C
@
text
@d1286 1
a1286 1
  WRITELN('EPROM TRANSFER UTILITY (18-Apr-90)');
@


44.2
log
@
pws2rcs automatic delta on Thu Apr 19 13:13:04 MDT 1990
@
text
@@


44.1
log
@Automatic bump of revision number for PWS version 3.23B
@
text
@d1286 1
a1286 1
  WRITELN('EPROM TRANSFER UTILITY (31-Mar-90)');
@


43.3
log
@
pws2rcs automatic delta on Sun Apr  1 16:13:30 MDT 1990
@
text
@@


43.2
log
@Fixed copyright date.
@
text
@d1286 1
a1286 1
  WRITELN('EPROM TRANSFER UTILITY (16-Mar-90)');
@


43.1
log
@Automatic bump of revision number for PWS version 3.23aA
@
text
@d1246 1
a1246 1
  WRITELN('Copyright Hewlett-Packard Company, 1983, 1989.');
@


42.2
log
@
pws2rcs automatic delta on Mon Mar 19 16:00:53 MST 1990
@
text
@@


42.1
log
@Automatic bump of revision number for PWS version 3.23e
@
text
@d1286 1
a1286 1
  WRITELN('EPROM TRANSFER UTILITY (19-Jan-90)');
@


41.2
log
@
pws2rcs automatic delta on Sat Jan 20 16:32:46 MST 1990
@
text
@@


41.1
log
@Automatic bump of revision number for PWS version 3.23d
@
text
@d1286 1
a1286 1
  WRITELN('EPROM TRANSFER UTILITY (19-Dec-89)');
@


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


40.1
log
@Automatic bump of revision number for PWS version 3.23c
@
text
@d1286 1
a1286 1
  WRITELN('EPROM TRANSFER UTILITY (27-Sep-89)');
@


39.2
log
@
pws2rcs automatic delta on Thu Sep 28 17:16:32 MDT 1989
@
text
@@


39.1
log
@Automatic bump of revision number for PWS version 3.23b
@
text
@d1286 1
a1286 1
  WRITELN('EPROM TRANSFER UTILITY (25-Sep-89)');
@


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


38.1
log
@Automatic bump of revision number for PWS version 3.23a
@
text
@d1286 1
a1286 1
  WRITELN('EPROM TRANSFER UTILITY (25-Aug-89)');
@


37.2
log
@
pws2rcs automatic delta on Mon Aug 28 12:16:08 MDT 1989
@
text
@@


37.1
log
@Automatic bump of revision number for PWS version 3.3a
@
text
@d1286 1
a1286 1
  WRITELN('EPROM TRANSFER UTILITY (11-May-89)');
@


36.3
log
@
pws2rcs automatic delta on Fri May 12 09:00:42 MDT 1989
@
text
@@


36.2
log
@
pws2rcs automatic delta on Thu May 11 11:32:36 MDT 1989
@
text
@d1286 1
a1286 1
  WRITELN('EPROM TRANSFER UTILITY (10-May-89)');
@


36.1
log
@Automatic bump of revision number for PWS version 3.22
@
text
@d1286 1
a1286 1
  WRITELN('EPROM TRANSFER UTILITY (20-Jan-89)');
@


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


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


33.2
log
@
pws2rcs automatic delta on Fri Jan 20 16:16:31 MST 1989
@
text
@@


33.1
log
@Automatic bump of revision number for PWS version 3.22D
@
text
@d1286 1
a1286 1
  WRITELN('EPROM TRANSFER UTILITY (12-Jan-89)');
@


32.3
log
@
pws2rcs automatic delta on Fri Jan 13 11:19:22 MST 1989
@
text
@@


32.2
log
@Fix copyright message

@
text
@d1286 1
a1286 1
  WRITELN('EPROM TRANSFER UTILITY (06-Jan-89)');
@


32.1
log
@Automatic bump of revision number for PWS version 3.22C
@
text
@d1246 1
a1246 1
  WRITELN('Copyright Hewlett-Packard Company, 1983, 1987.');
@


31.2
log
@
pws2rcs automatic delta on Mon Jan  9 11:50:34 MST 1989
@
text
@@


31.1
log
@Automatic bump of revision number for PWS version 3.22B
@
text
@d1286 1
a1286 1
  WRITELN('EPROM TRANSFER UTILITY (12-Dec-88)');
@


30.2
log
@
pws2rcs automatic delta on Wed Dec 14 13:22:28 MST 1988
@
text
@@


30.1
log
@Automatic bump of revision number for PWS version 3.22A
@
text
@d1286 1
a1286 1
  WRITELN('EPROM TRANSFER UTILITY (07-Dec-88)');
@


29.2
log
@
pws2rcs automatic delta on Thu Dec  8 15:31:09 MST 1988
@
text
@@


29.1
log
@Automatic bump of revision number for PWS version 3.22b
@
text
@d1286 1
a1286 1
  WRITELN('EPROM TRANSFER UTILITY (27-Oct-88)');
@


28.2
log
@
ipws2rcs automatic delta on Mon Oct 31 10:34:17 MST 1988
:w
:q
@
text
@@


28.1
log
@Automatic bump of revision number for PWS version 3.3b
@
text
@d1286 1
a1286 1
  WRITELN('EPROM TRANSFER UTILITY (4-Oct-88)');
@


27.2
log
@pws2rcs automatic delta on Wed Oct  5 17:32:00 MDT 1988

@
text
@@


27.1
log
@Automatic bump of revision number for PWS version 3.3a
@
text
@d1286 1
a1286 1
  WRITELN('EPROM TRANSFER UTILITY (16-Mar-88)');
@


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


25.3
log
@Pws2unix automatic delta on Fri Mar 18 09:13:54 MST 1988
@
text
@@


25.2
log
@Pws2unix automatic delta on Wed Mar  9 08:03:11 MST 1988
@
text
@d1286 1
a1286 1
  WRITELN('EPROM TRANSFER UTILITY (8-Mar-88)');
@


25.1
log
@Automatic bump of revision number for PWS version 3.2Y
@
text
@d1286 1
a1286 1
  WRITELN('EPROM TRANSFER UTILITY (11-Feb-88)');
@


24.2
log
@Pws2unix automatic delta on Tue Mar  1 09:01:42 MST 1988
@
text
@@


24.1
log
@Automatic bump of revision number for PWS version 3.2
@
text
@d1286 1
a1286 1
  WRITELN('EPROM TRANSFER UTILITY (29-Aug-87)');
@


23.2
log
@Pws2unix automatic delta on Sun Aug 30 14:43:47 MDT 1987
@
text
@@


23.1
log
@Automatic bump of revision number for PWS version 3.2P
@
text
@d1286 1
a1286 1
  WRITELN('EPROM TRANSFER UTILITY (25-Aug-87)');
@


22.2
log
@Pws2unix automatic delta on Tue Aug 25 18:23:33 MDT 1987
@
text
@@


22.1
log
@Automatic bump of revision number for PWS version 3.2N
@
text
@d1246 2
a1247 2
  WRITELN('Copyright 1983 Hewlett-Packard Company.');
  WRITELN('       All rights are reserved.');
d1286 1
a1286 1
  WRITELN('EPROM TRANSFER UTILITY (14-Aug-87)');
@


21.2
log
@Pws2unix automatic delta on Sat Aug 15 16:14:36 MDT 1987
@
text
@@


21.1
log
@Automatic bump of revision number for PWS version 3.2M
@
text
@d1286 1
a1286 1
  WRITELN('EPROM TRANSFER UTILITY (11-Aug-87)');
@


20.2
log
@Pws2unix automatic delta on Wed Aug 12 09:47:30 MDT 1987
@
text
@@


20.1
log
@Automatic bump of revision number for PWS version 3.2L
@
text
@d1286 1
a1286 1
  WRITELN('EPROM TRANSFER UTILITY (28-Jul-87)');
@


19.2
log
@Pws2unix automatic delta on Wed Jul 29 17:29:01 MDT 1987
@
text
@@


19.1
log
@Automatic bump of revision number for PWS version 3.2K
@
text
@d1286 1
a1286 1
  WRITELN('EPROM TRANSFER UTILITY (30-May-87)');
@


18.2
log
@Pws2unix automatic delta on Sun May 31 14:33:16 MDT 1987
@
text
@@


18.1
log
@Automatic bump of revision number for PWS version 3.2J
@
text
@d1286 1
a1286 1
  WRITELN('EPROM TRANSFER UTILITY (18-May-87)');
@


17.2
log
@Pws2unix automatic delta on Wed May 20 09:57:02 MDT 1987
@
text
@@


17.1
log
@Automatic bump of revision number for PWS version 3.2I+
@
text
@d1286 1
a1286 1
  WRITELN('EPROM TRANSFER UTILITY (24-Apr-87)');
@


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


15.2
log
@Pws2unix automatic delta on Fri Apr 24 18:41:36 MDT 1987
@
text
@@


15.1
log
@Automatic bump of revision number for PWS version 3.2H
@
text
@d1286 1
a1286 1
  WRITELN('EPROM TRANSFER UTILITY (11-Apr-87)');
@


14.2
log
@Pws2unix automatic delta on Sun Apr 12 17:10:24 MDT 1987
@
text
@@


14.1
log
@Automatic bump of revision number for PWS version 3.2G
@
text
@d1286 1
a1286 1
  WRITELN('EPROM TRANSFER UTILITY (31-Mar-87)');
@


13.2
log
@Pws2unix automatic delta on Wed Apr  1 08:30:27 MST 1987
@
text
@@


13.1
log
@Automatic bump of revision number for PWS version 3.2F
@
text
@d1286 1
a1286 1
  WRITELN('EPROM TRANSFER UTILITY (27-Feb-87)');
@


12.2
log
@Pws2unix automatic delta on Sat Feb 28 15:17:33 MST 1987
@
text
@@


12.1
log
@Automatic bump of revision number for PWS version 3.2E
@
text
@d1286 1
a1286 1
  WRITELN('EPROM TRANSFER UTILITY (30-Jan-87)');
@


11.2
log
@Pws2unix automatic delta on Mon Feb  2 09:47:34 MST 1987
@
text
@@


11.1
log
@Automatic bump of revision number for PWS version 3.2D
@
text
@d1286 1
a1286 1
  WRITELN('EPROM TRANSFER UTILITY (18-Jan-87)');
@


10.2
log
@Pws2unix automatic delta on Sun Jan 18 18:33:43 MST 1987
@
text
@@


10.1
log
@Manual revision number change for 3.2C
@
text
@d1286 1
a1286 1
  WRITELN('EPROM TRANSFER UTILITY (22-Dec-86)');
@


9.2
log
@Pws2unix automatic delta on Tue Dec 23 16:24:27 MST 1986
@
text
@@


9.1
log
@Automatic bump of revision number for PWS version 3.2B
@
text
@d1286 1
a1286 1
  WRITELN('EPROM TRANSFER UTILITY (10-Dec-86)');
@


8.2
log
@Pws2unix automatic delta on Fri Dec 12 09:42:40 MST 1986
@
text
@@


8.1
log
@Automatic bump of revision number for PWS version 3.2A
@
text
@d1286 1
a1286 1
  WRITELN('EPROM TRANSFER UTILITY (25-Nov-86)');
@


7.2
log
@Pws2unix automatic delta on Wed Nov 26 16:18:22 MST 1986
@
text
@@


7.1
log
@Automatic bump of revision number for PWS version 3.2l
@
text
@d1286 1
a1286 1
  WRITELN('EPROM TRANSFER UTILITY (10-Nov-86)');
@


6.2
log
@Pws2unix automatic delta on Wed Nov 19 15:16:12 MST 1986
@
text
@@


6.1
log
@Automatic bump of revision number for PWS version 3.2k
@
text
@d1286 1
a1286 1
  WRITELN('EPROM TRANSFER UTILITY (3-Nov-86)');
@


5.2
log
@Pws2unix automatic delta on Tue Nov  4 11:36:56 MEZ 1986
@
text
@@


5.1
log
@Automatic bump of revision number for PWS version 3.2j
@
text
@d1286 1
a1286 1
  WRITELN('EPROM TRANSFER UTILITY (23-Oct-86)');
@


4.2
log
@Pws2unix automatic delta on Tue Oct 28 10:57:29 MEZ 1986
@
text
@@


4.1
log
@Automatic bump of revision number for PWS version 3.2i
@
text
@d1286 1
a1286 1
  WRITELN('EPROM TRANSFER UTILITY (26-Sep-86)');
@


3.2
log
@Pws2unix automatic delta on Tue Sep 30 13:50:02 MEZ 1986
@
text
@@


3.1
log
@Automatic bump of revision number for PWS version 3.2h
@
text
@d1286 1
a1286 1
  WRITELN('EPROM TRANSFER UTILITY (28-Aug-86)');
@


2.4
log
@Pws2unix automatic delta on Mon Sep  1 08:51:28 MEZ 1986
@
text
@@


2.3
log
@Pws2unix automatic delta on Wed Aug 20 10:48:54 MEZ 1986
@
text
@d1286 1
a1286 1
  WRITELN('EPROM TRANSFER UTILITY (19-Aug-86)');
@


2.2
log
@Pws2unix automatic delta on Tue Aug 19 10:31:55 MEZ 1986
@
text
@d1286 1
a1286 1
  WRITELN('EPROM TRANSFER UTILITY (18-Aug-86)');
@


2.1
log
@Auto bump rev number to 2.1 for sys 3.2e.
@
text
@d1286 1
a1286 1
  WRITELN('EPROM TRANSFER UTILITY (29-Jul-86)');
@


1.3
log
@Pws2unix automatic delta on Wed Jul 30 09:07:03 MEZ 1986
@
text
@@


1.2
log
@Pws2unix automatic delta on Tue Jul 15 16:35:26 MEZ 1986
@
text
@d1286 1
a1286 1
  WRITELN('EPROM TRANSFER UTILITY (14-Jul-86)');
@


1.1
log
@Initial revision
@
text
@d1286 1
a1286 1
  WRITELN('EPROM TRANSFER UTILITY (12-Jun-86)');
@
