{ File: SG4.UTIL4.TEXT
  Contains routines for the bootstrap copy.


  COPYRIGHT (c) 1982, 1983 SAGE Computer Technology
  All Rights Reserved

}

PROCEDURE GetChar(VAR ch:CHAR);
BEGIN
  READ(ch);
  IF ch IN ['a'..'z'] THEN ch := CHR(ORD(ch)-ORD('a')+ORD('A'));
  IF EOLN THEN
    BEGIN
      ch:='Q';
      READLN;
    END;
END;

{ BootCopy is a utility procedure for moving
  bootstrap code from device to device, a file
  to a device, or a device to a file.  The
  routine verifies that the code is a legal
  SAGE bootstrap routine.
}
PROCEDURE BootCopy;
TYPE
  NameType = (vol,fil);

VAR
  accept:BOOLEAN;
  stype,dtype:NameType;
  blk:INTEGER;
  FileSize:INTEGER;
  I:INTEGER;
  ch:CHAR;
  S,D:STRING;
  dummybool:BOOLEAN;
  buffer:RECORD CASE BOOLEAN OF
	   TRUE: (b:PACKED ARRAY[0..1535] OF CHAR);
	   FALSE:(W:ARRAY[0..767] OF INTEGER);
	 END;

FUNCTION CheckName(VAR s:string):NameType;
BEGIN
  CheckName := fil;
  IF POS(':',s) = LENGTH(s) THEN CheckName := vol
  ELSE
    IF (s[1]='#') AND (POS(':',s) = 0) THEN
      BEGIN
	CheckName := vol;
	s := CONCAT(s,':');
      END;
END;

PROCEDURE SourcePart;

FUNCTION FileAdjust:BOOLEAN;
VAR
  index:INTEGER;
  test:INTEGER;
  test1:RECORD CASE BOOLEAN OF
	  TRUE: (inp:INTEGER);
	  FALSE:(out:PACKED RECORD
		       DataSegNum:0..255;
		       RelocType:(RelocEnd,SegRel,BaseRel,InterpRel,ProcRel);
		     END);
	END;
  
BEGIN
  FileAdjust := FALSE;
  IF stype = vol THEN {No file adjustment necessary}
    BEGIN
      FileAdjust := TRUE;
      index:=511;
      WHILE (index>0) and (buffer.w[index]=0) DO index := index-1;
      FileSize := index+1;
      EXIT(FileAdjust);
    END;
  IF buffer.w[6] <> 1 THEN
    BEGIN
      Exception(TRUE);
      WRITELN('Illegal code file format (byte sex is not 1)');
      EXIT(FileAdjust);
    END;
  index := buffer.w[0];
  IF (index >= 768) OR (index <= 0)  THEN
    BEGIN
      Exception(TRUE);
      WRITELN('Code size out of range - ',index);
      EXIT(FileAdjust);
    END;
  test := buffer.w[index];
  IF test <> 1 THEN
    BEGIN
      Exception(TRUE);
      WRITELN('File has ',test,' instead of 1 procedure.');
      EXIT(FileAdjust);
    END;
  index := index-1;
  test := buffer.w[index];
  IF test <> 12 THEN
    BEGIN
      Exception(TRUE);
      WRITELN('File has improper code address of ',test);
      EXIT(FileAdjust);
    END;
  test := buffer.w[test];
  IF test <> -1 THEN
    BEGIN
      Exception(TRUE);
      WRITELN('File has DataSize of ',test,' instead of -1');
      EXIT(FileAdjust);
    END;
  REPEAT
    index := index-1;
    test1.inp := buffer.w[index];
    IF test1.out.RelocType = ProcRel THEN
      BEGIN
	index := index-1;
	test := buffer.w[index];
	index := index-test; {Bypass relocation entries}
      END
    ELSE
      IF test1.out.RelocType <> RelocEnd THEN
	BEGIN
	  Exception(TRUE);
	  WRITELN('Illegal code relocation type ',ORD(test1.out.RelocType));
	  EXIT(FileAdjust);
	END;
  UNTIL test1.out.RelocType = RelocEnd;
  FileSize := index-13;
  IF FileSize > 512 THEN
    BEGIN
      Exception(TRUE);
      WRITELN('The code size of ',FileSize*2,
	      ' bytes is too big for a 1Kbyte bootstrap');
      EXIT(FileAdjust);
    END;
  IF FileSize <=0 THEN
    BEGIN
      Exception(TRUE);
      WRITELN('Illegal code size of ',FileSize);
      EXIT(FileAdjust);
    END;
  {Finally passed all tests for a good code file}
  FileAdjust := TRUE;
  MOVELEFT(buffer.w[13],buffer.w[0],FileSize*2);
  IF FileSize<512 THEN FILLCHAR(buffer.w[FileSize],(512-FileSize)*2,0);
END;

BEGIN {SourcePart}
  REPEAT
    IF MNU_Fancy THEN SC_Clr_Line(2)
    ELSE
      WRITELN;
    WRITE('Source file or device <just CR quits> ? ');
    READLN(S);
    IF LENGTH(S)=0 THEN EXIT(BootCopy);
    stype := CheckName(S);
    IF MNU_Fancy THEN
      BEGIN
	SC_Clr_Line(4);
	SC_Clr_Line(2);
      END
    ELSE
      WRITELN;
    WRITE('Ready to load bootstrap from ');
    IF stype=vol THEN WRITE('volume ') ELSE WRITE('file ');
    WRITE(S,' ? ');
    GetChar(ch);
    IF ch = 'Q' THEN EXIT(BootCopy);
    IF ch = 'Y' THEN
      BEGIN
	IF MNU_Fancy THEN sc_goto_xy(0,4)
	ELSE
	  BEGIN
	    WRITELN;
	    WRITELN;
	  END;
	{$I-}
	RESET(F,S);
	{$I+}
	IF IORESULT <> 0 THEN
	  BEGIN
	    Exception(TRUE);
	    WRITELN('Could not open ',S);
	  END
	ELSE
	  BEGIN
	    IF stype = vol THEN blk := 0 ELSE blk := 1;
	    FILLCHAR(buffer.w,1536,0);
	    {$I-}
	    I := BLOCKREAD(F,buffer.w,3,blk);
	    {$I+}
	    IF (IORESULT<>0) OR (I=0) THEN
	      BEGIN
		Exception(TRUE);
		WRITELN('Error reading ',S);
	      END
	    ELSE
	      BEGIN
		IF FileAdjust THEN
		  BEGIN
		    IF ((buffer.b[0] = 'B') AND (buffer.b[1] = 'O') AND
			(buffer.b[2] = 'O') AND (buffer.b[3] = 'T'))
			OR
		       ((buffer.b[0] = 'M') AND (buffer.b[1] = 'U') AND
			(buffer.b[2] = 'B') AND (buffer.b[3] = 'T')) THEN
		       BEGIN
			 accept :=true;
			 WRITELN('Bootstrap of ',FileSize*2,
				 ' bytes read successfully');
		       END
		    ELSE
		      BEGIN
			Exception(TRUE);
			IF stype = vol THEN
			  WRITE('Data at block 0 of volume ')
			ELSE
			  WRITE('Data in file ');
			WRITELN(S,' was not SAGE bootstrap code.');
		      END;
		  END;
	      END;
	  END;
      END;
    CLOSE(F);
  UNTIL accept;
END;


BEGIN {BootCopy}
  MNU_ClrScreen;
  WRITELN('Bootstrap Copy Utility');
  accept:=false;
  SourcePart;
  accept := false;
  REPEAT
    IF MNU_Fancy THEN SC_Clr_Line(6)
    ELSE
      BEGIN
	WRITELN;
	WRITELN;
      END;
    WRITE('Destination file or device <just CR quits> ? ');
    READLN(D);
    IF LENGTH(D)=0 THEN EXIT(BootCopy);
    dtype := CheckName(D);
    IF MNU_Fancy THEN
      BEGIN
	SC_Clr_Line(8);
	SC_Clr_Line(6);
      END
    ELSE
      BEGIN
	WRITELN;
	WRITELN;
      END;
    IF dtype = fil THEN
      BEGIN
	WRITELN('Cannot handle bootstrap copy to a file yet.');
	dummyboolean:=sc_space_wait(FALSE);
	EXIT(BootCopy); {Temporary kludge exit}
      END;
    WRITE('Ready to store bootstrap ');
    IF dtype=vol THEN WRITE('on volume ') ELSE WRITE('in file ');
    WRITE(D,' ? ');
    GetChar(ch);
    IF ch = 'Q' THEN EXIT(BootCopy);
    IF ch = 'Y' THEN
      BEGIN
	IF MNU_Fancy THEN sc_goto_xy(0,8)
	ELSE
	  BEGIN
	    WRITELN;
	    WRITELN;
	  END;
	{$I-}
	REWRITE(F,D);
	{$I+}
	IF IORESULT <> 0 THEN
	  BEGIN
	    Exception(TRUE);
	    WRITELN('Could not open ',D);
	  END
	ELSE
	  BEGIN
	    IF dtype = vol THEN blk := 0 ELSE blk := 1;
	    {$I-}
	    I := BLOCKWRITE(F,buffer.w,2,blk);
	    {$I+}
	    IF (IORESULT<>0) OR (I<>2) THEN
	      BEGIN
		Exception(TRUE);
		WRITELN('Error writing ',D);
	      END
	    ELSE
	      BEGIN
		accept :=true;
		WRITELN('Bootstrap data written successfully');
	      END;
	    WRITELN;
	    dummybool:=sc_space_wait(FALSE);
	  END;
      END;
    CLOSE(F);
  UNTIL accept;
END;

                                                                                                         