(* S+*) (*SWAPPING MODE FOR MORE SYMBOL TABLE SPACE*)

PROGRAM TTY;

(*PROGRAM TO ALLOW MICRO TO ACT AS A TERMINAL TO A REMOTE*)
(*AND TO TRANSFER FILES BETWEEN THE MICRO AND THE REMOTE *)

(*********************************************************)
(*                                                       *)
(*        ERCC Microcomputer Support Unit                *)
(*                                                       *)
(*        Contributors     Austin Tate                   *)
(*                         Stephen Hayes                 *)
(*                                                       *)
(*********************************************************)

CONST SPACE=' ';
      NUL=0;
      CTRLA=1;
      EOT=4;
      BEL=7;
      BS=8;
      LF=10;
      CTRLL=12;
      CR=13;
      DLE=16;
      XON=17;
      XOFF=19;
      CTRLX=24;
      ESC=27;
      DEL=127;

(* HOST SPECIFIC CONSTANTS *)

      REPEATCH=18;  (*CTRL/R BY DEFAULT - CH TO REPEAT CURRENT LINE FROM*)
                    (*HOST.  SET TO 0 IF THIS FACILITY IS NOT AVAILABLE *)

(* VALUES SET IN INITDATA WHICH CAN BE ALTERED BY CONFIGURE *)
(*    PROMPT=':'    CHARACTER WHICH ENDS PROMPTS FROM HOST DURING FILETRANS*)
(*    HALFDUPLEX=FALSE   SET TO TRUE FOR A HALF DUPLEX HOST                *)
(*    CHINMOD=128   MASK FOR CHARACTERS REEIVED IN GETFILE*)

VAR CH:CHAR;
    MCNAME:STRING; (*GIVES LOCAL MACHINE TYPE - INITIALISED BY REMSETUP*)
    STR,SETHOST:STRING;
    CRSTRING,CTRLASTRING:STRING[1];
    PROMPT:CHAR;
    DEBUG,HALFDUPLEX:BOOLEAN;
    CHINMOD,XOFNUM,WAITTIME,I,J:INTEGER;
    binary{aa},ALTFILE,GOODLOCAL,TERMINAL:BOOLEAN;

PROCEDURE PUTTXT(S:STRING);     (*USED BY SET BAUD IN MACHINE SPECIFIC INSERT*)
   FORWARD;
   
PROCEDURE PUTLN;                (*USED BY SET BAUD IN MACHINE SPECIFIC INSERT*)
   FORWARD;

PROCEDURE GETCH(VAR CH:CHAR; PROMPTING,ECHO:BOOLEAN);
   FORWARD;                     (*USED BY SET BAUD IN MACHINE SPECIFIC INSERT*)

PROCEDURE GETLN(VAR S:STRING);  (*USED BY SET BAUD IN MACHINE SPECIFIC INSERT*)
   FORWARD;
   
{PERQ specific part starts here}
   (*REMOTE ROUTINES FOR MCNAME ONLY*)
   (*APPROPRIATE FILE IS RENAMED TO DEV.X.X.TEXT BEFORE COMPILATION*)

(* Special routines for 3RCC PERQ Austin Tate 1 June 81 *)
(*                        altered Austin Tate 24 Nov 81 *)
{ to convert main body to PERQ do:-
  1. $I and $S pragmas replace by <space> I or S
  2. convert CLOSE(...,LOCK) to CLOSE(...)
  3. convert $I pragma to $INCLUDE
  4. Swap over file handling section in NAMECHECK in GETFILE or
     comment out the UCSD specific parts
}

(*********************************************************************
ROUTINES TO HANDLE RS232 LINE AND KEYBOARD SUPPORT
ROUTINES ARE:
   PROCEDURE RemBaud
      SET BAUD RATE ON INTERFACE.
   PROCEDURE REMSETUP
      INITIALISES KEYBOARD ROUTINES AND RS232C ROUTINES
      AND LOCAL MACHINE NAME.
   PROCEDURE REMCLOSE
      CLOSE DOWN SPECIAL ROUTINES
   FUNCTION REMDONE:BOOLEAN
      REMOTE OUTPUT READY TO SEND.
   PROCEDURE REMWRITE(CH:CHAR)
      WRITE A CHARACTER TO REMOTE
   FUNCTION REMPRESS:BOOLEAN
      RETURNS TRUE IF CHARACTER AVAILABLE FROM REMOTE
   PROCEDURE REMREAD(VAR CH:CHAR)
      WAITS FOR CHARACTER FROM REMOTE, AND READS IT.
   FUNCTION KEYPRESS:BOOLEAN
      RETURNS TRUE IF CHARACTER AVAILABLE FROM KEYBOARD
   PROCEDURE KEYREAD(CH:CHAR,PROMPTING,ECHO:BOOLEAN)
      WAITS FOR KEYBOARD CHARACTER, AND READS IT.
      IF PROMPTING IS TRUE CONTROL CH CODES(<' ') ARE CONVERTED TO BEL
      AND LETTERS ARE CONVERTED TO UPPER CASE.
      IF ECHO IS TRUE, CHARACTER IS ECHOED
   FUNCTION PARTX1:CHAR;
      RETURNS A SINGLE CHARACTER CODE FOR MACHINE SPECIFIC PART
   FUNCTION PARTX2:INTEGER;
      RETURNS A REVISION NUMBER FOR MACHINE SPECIFIC PART

********************************************************************)
IMPORTS IOERRORS FROM IOERRORS;
IMPORTS IO_UNIT FROM IO_UNIT;
IMPORTS PERQ_String FROM PERQ_STRING;
IMPORTS RS232Baud FROM RS232BAUD;
IMPORTS SCREEN FROM SCREEN;

CONST IORESULT=0; (*since no IO checking on PERQ*)
      IOC=1; (*good result from IOCWrite and IOCRead*)

VAR   RemChWaiting,KeyChWaiting:BOOLEAN;
      RemChBuff,KeyChBuff:CHAR;

PROCEDURE RemBaud;
VAR S:STRING;
BEGIN
   PUTLN;
   PUTTXT('Baud Rate: ');
   GETLN(S);
   SETBAUD(S,TRUE);
   PUTLN;
END;

PROCEDURE REMSETUP;
BEGIN
  MCNAME:='3RCC/ICL PERQ';
  SFullWindow;
  ChangeTitle('ERCC Micro Support Unit - X-Talk Communications for ICL PERQ');
  WRITE(CHR(12)); {formfeed to clear screen on PERQ}
  CreateWindow(10,10,25,750,225,'');
  WRITELN;
  WRITELN('PERQ acts as a normal terminal. CTRL/L causes entry to local mode.');
  WRITELN('In this mode there are several commands.');
  WRITELN;
  WRITELN('^(control) is used to send a control character to the host.');
  WRITELN;
  WRITELN('F(iler)    is not available on PERQ.');
  WRITELN;
  WRITELN('G(et file) is used to transfer a file from the remote to the PERQ.');
  WRITELN;
  WRITELN('P(ut file) is used to transfer a file from the PERQ to the remote.');
  WRITELN;
  WRITELN('S(et mode) is used to configure the interface and program,');
  WRITELN('           and set host or local values.');
  WRITELN;
  WRITE('Q(uit)     is used to stop the program.');
  CreateWindow(11,10,250,750,750,'TypeScript');
  RemChWaiting:=FALSE;
  KeyChWaiting:=FALSE;
  SetBaud('1200',TRUE); (* and set receiver enable *)
END;

FUNCTION REMPRESS:BOOLEAN;
   (*TRUE IF A CHARACTER IS WAITING*)
BEGIN
   IF RemChWaiting THEN REMPRESS:=TRUE
   ELSE
     BEGIN
       RemChWaiting:=(IOCREAD(RS232IN,RemChBuff)=IOC);
       REMPRESS:=RemChWaiting;
     END;
END;

PROCEDURE REMCLOSE;
BEGIN
   SFullWindow;
   WRITE(CHR(12));
END;

FUNCTION REMDONE:BOOLEAN;
VAR I:INTEGER;
BEGIN
  REMDONE:=NOT IOInProgress;
END;

PROCEDURE REMWRITE(CH:CHAR);
VAR Res:INTEGER;
BEGIN
   REPEAT
     Res:=IOCWRITE(RS232OUT,CH);
   UNTIL Res=IOC;
END;

PROCEDURE REMREAD(VAR CH:CHAR);
   (*WAIT FOR CHARACTER & READ IT*)
BEGIN
   REPEAT
   UNTIL REMPRESS;
   RemChWaiting:=FALSE;
   CH:=RemChBuff;
END;

(****KEYBOARD ROUTINES*)

FUNCTION KEYPRESS:BOOLEAN;
   (*TRUE IF A CHARACTER IS WAITING*)
BEGIN
   IF KeyChWaiting THEN KEYPRESS:=TRUE
   ELSE
     BEGIN
       KeyChWaiting:=(IOCREAD(TRANSKEY,KeyChBuff)=IOC);
       (*note device is TRANSKEY NOT KEYBOARD*)
       (*The CTRL key adds 128 to the code typed in RAW IO mode*)
       KEYPRESS:=KeyChWaiting;
     END;
END;

PROCEDURE KEYREAD(VAR CH:CHAR;PROMPTING,ECHO:BOOLEAN);
   (*WAIT FOR CHARACTER & READ IT*)
BEGIN
   REPEAT
   UNTIL KEYPRESS;
   KeyChWaiting:=FALSE;
   CH:=KeyChBuff;
   IF PROMPTING THEN BEGIN
       IF CH<(' ') THEN CH:=CHR(BEL) ELSE
         IF ('a'<=CH) AND (CH<='z') THEN CH:=CHR((ORD(CH)-ORD('a'))+ORD('A'))
     END;
   IF ECHO THEN WRITE(CH);
END;

PROCEDURE REMFLUSH;
Var Ch:CHAR;
    I:INTEGER;
BEGIN
  WHILE REMPRESS DO BEGIN
    REMREAD(Ch);
    I:=ORD(Ch) MOD 128;
    IF (I=CR) THEN WRITELN
    ELSE IF (I<>LF) THEN WRITE(CHR(I));
  END;
END;

FUNCTION PARTX1:CHAR;
BEGIN
  (*MACHINE SPECIFIC PART MACHINE CHARACTER*)
  PARTX1:='Q'
END;

FUNCTION PARTX2:INTEGER;
BEGIN
  (*MACHINE SPECIFIC PART REVISION NUMBER*)
  PARTX2:=2
END;


(*KEYRDLN ROUTINE..USE INSTEAD OF READLN FROM KEYBOARD..*)
PROCEDURE KEYRDLN(VAR STR:STRING);
VAR I:INTEGER;
    CH:CHAR;
BEGIN
   STR:='                                                                  ';
   (*OVERLAY ONTO A BED OF SPACES*)
   I:=0;
   KEYREAD(CH,FALSE,FALSE); (*READ..NO ECHO*)
   WHILE NOT (CH=CHR(CR)) DO BEGIN
      IF (CH=CHR(DEL)) OR (CH=CHR(BS)) THEN BEGIN
         IF I<>0 THEN BEGIN
            I:=I-1;
            WRITE(CHR(BS),' ',CHR(BS));
         END;
      END ELSE IF CH<' ' THEN WRITE(CHR(BEL)) ELSE BEGIN
         WRITE(CH); (*ECHO*)
         I:=I+1;
         STR[I]:=CH;
      END;
      KEYREAD(CH,FALSE,FALSE);
   END;
   WRITELN;
   (*$R-*) (* **RANGE CHECK OFF*)
   STR[0]:=CHR(I); (*SET LENGTH*)
   (*$R+*) (* **RANGE CHECK BACK ON*)
END;

FUNCTION KEYRDVAL(VAR VAL:INTEGER):BOOLEAN;
   (*READS LINE AND CONVERTS TO NUMBER*)
   (*RESULT TRUE IF NUMBER OK*)
   (*NUMBER ASSUMED +VE FOR NOW*)
VAR STR:STRING;
    I,J,K:INTEGER;
    SUCC:BOOLEAN;
BEGIN
   KEYRDLN(STR);
   K:=0;
   SUCC:=(LENGTH(STR)<>0); (*TRUE IF STRING NOT NULL*)
   IF SUCC THEN FOR I:=1 TO LENGTH(STR) DO BEGIN
      J:=ORD(STR[I])-ORD('0');
      IF (J<0) OR (J>9) THEN SUCC:=FALSE;
      IF SUCC THEN K:=K*10+J;
   END;
   IF SUCC THEN VAL:=K;
   KEYRDVAL:=SUCC;
END;

PROCEDURE PUTTXT;
   (*DEFINED FORWARD..PARAMS S:STRING)  *)
BEGIN
   WRITE(S);
END;

PROCEDURE PUTCH(CH:CHAR);
BEGIN
   WRITE(CH);
END;

PROCEDURE PUTINT(V,S:INTEGER);
BEGIN
   WRITE(V:S);
END;

PROCEDURE PUTLN;
   (*DEFINED FORWARD*)
BEGIN
   WRITELN;
END;

PROCEDURE GETLN;
(* DECLARED FORWARD..PARAMS(VAR S:STRING); *)
BEGIN
   KEYRDLN(S);
END;

PROCEDURE GETCH;
   (* DEFINED FORWARD..PARAMS(VAR CH:CHAR; PROMPTING,ECHO:BOOLEAN); *)
BEGIN
   KEYREAD(CH,PROMPTING,ECHO);
END;

PROCEDURE GIVEREASON(REASON:INTEGER);
BEGIN
  IF (REASON>0) AND (REASON<=18) THEN
    BEGIN
      WRITELN;
      CASE REASON OF
         1: WRITELN('Bad Block, Parity error (CRC).');
         2: WRITELN('Bad Unit Number.');
         3: WRITELN('Illegal I/O Request.');
         4: WRITELN('Data-com timeout.');
         5: WRITELN('Volume is no longer on-line.');
         6: WRITELN('File is no longer in directory.');
         7: WRITELN('Bad file name.');
         8: WRITELN('No room, insufficient space on volume.');
         9: WRITELN('No such volume on line.');
        10: WRITELN('No such file on volume.');
        11: WRITELN('Duplicate directory entry.');
        12: WRITELN('Not closed, attempt to open an open file.');
        13: WRITELN('Not open, attempt to access a closed file.');
        14: WRITELN('Bad format, error in reading real or integer.');
        15: WRITELN('Ring buffer overflow.');
        16: WRITELN('Volume is write-protected.');
        17: WRITELN('Illegal Block Number.');
        18: WRITELN('Illegal Buffer.');
      END (*CASE*)
    END
  ELSE IF REASON<>0 THEN
    BEGIN
      WRITELN;
      WRITELN('I/O error ',REASON);
    END;
END;

FUNCTION SURE(STR:STRING):BOOLEAN;
VAR CH:CHAR;
BEGIN
  REPEAT
    WRITELN;
    WRITE(STR,' - Are you sure (Y/N):');
    KEYREAD(CH,TRUE,TRUE);
  UNTIL (CH='Y') OR (CH='N');
  WRITELN;
  SURE:=(CH='Y');
END;

PROCEDURE REMSINK(ECHO:BOOLEAN);
(* a sink for any characters received from remote *)
VAR I:INTEGER;
    CH:CHAR;
BEGIN
  I:=0;
  WHILE ((I<WAITTIME) AND NOT(REMPRESS)) DO I:=I+1;
  WHILE REMPRESS DO
    BEGIN
      REMREAD(CH);
      CH:=CHR(ORD(CH) MOD 128);
      IF ECHO THEN
        BEGIN
          IF CH=CHR(LF) THEN WRITELN
          ELSE IF CH<>CHR(CR) THEN WRITE(CH)
        END;
      I:=1;
      WHILE ((I<WAITTIME) AND NOT(REMPRESS)) DO I:=I+1;
    END;
END;

PROCEDURE TRANSMIT(STR:STRING;ECHO:BOOLEAN);
VAR CH:CHAR;
    I,J,L:INTEGER;
    (*PROMPT IS GLOBAL*)
BEGIN
  L:=LENGTH(STR);
  FOR I:=1 TO L DO
    BEGIN
      CH:=STR[I];
      IF CH=CHR(CR) THEN
        BEGIN
          REMWRITE(CHR(CR));
          IF ECHO AND HALFDUPLEX THEN WRITELN;
          REPEAT
            REPEAT
              REMREAD(CH);
              CH:=CHR(ORD(CH) MOD 128);
              IF ECHO THEN
                BEGIN
                  IF CH=CHR(LF) THEN WRITELN
                  ELSE IF CH<>CHR(CR) THEN WRITE(CH);
                END;
            UNTIL CH=PROMPT;
            J:=1;
            WHILE ((J<WAITTIME) AND NOT(REMPRESS)) DO J:=J+1;
          UNTIL NOT(REMPRESS);
          (*PROMPT FOUND AND WAIT LOOP EXPIRES*)
        END
      ELSE
        BEGIN
           REMWRITE(CH);
           IF HALFDUPLEX THEN
              BEGIN
                IF ECHO THEN WRITE(CH)
              END
           ELSE
             BEGIN
               REMREAD(CH);
               IF ECHO THEN
                 BEGIN
                   CH:=CHR(ORD(CH) MOD 128);
                   IF CH=CHR(LF) THEN WRITELN
                   ELSE IF CH<>CHR(CR) THEN WRITE(CH);
                 END;
             END;
        END;
      END;
  (* TO CATCH ANY STRAY OUTPUT TO SAVE HANGING ON TRANSMIT *)
  REMSINK(ECHO);
END;

FUNCTION YES(S:STRING):BOOLEAN;
VAR CH:CHAR;
BEGIN
  REPEAT
    WRITELN;
    WRITE(S,' - Y(es),N(o): ');
    KEYREAD(CH,TRUE,TRUE);
  UNTIL (CH='Y') OR (CH='N');
  WRITELN;
  YES:=(CH='Y')
END;

PROCEDURE SETALT;
VAR CH:CHAR;
BEGIN
   ALTFILE:=YES('Alternative Protocol');
   WRITE('Current no. of XOFFs sent=',XOFNUM);
   IF YES('Alter') THEN
      REPEAT
         WRITE('XOFFs:');
      UNTIL KEYRDVAL(XOFNUM);
   WRITE('Current no. of WAIT units=',WAITTIME);
   IF YES('Alter') THEN
      REPEAT
         WRITE('Wait units:');
      UNTIL KEYRDVAL(WAITTIME);
   IF XOFNUM<=0 THEN XOFNUM:=1;
   IF WAITTIME<=0 THEN WAITTIME:=1;
END;

PROCEDURE SENDCTRL;
VAR CH:CHAR;
BEGIN
  REPEAT
    WRITELN;
    WRITE('Give control letter (A..Z): ');
    KEYREAD(CH,TRUE,TRUE);
  UNTIL CH IN ['A'..'Z'];
  REMWRITE(CHR((ORD(CH)-ORD('A'))+1));
END;

PROCEDURE CONFIGURE;
VAR CH:CHAR;
    FINISH:BOOLEAN;
BEGIN
  FINISH:=FALSE;
  REPEAT
    REPEAT
      WRITELN;
      WRITE('A(lt),B(aud),D(uplex),F(ull mess),M(ask),P(rompt),Q(uit):');
      KEYREAD(CH,TRUE,TRUE);
    UNTIL CH IN ['A','B','D','F','M','P','Q'];
    CASE CH OF
      'A': SETALT;
      'B': BEGIN
             WRITELN;
             RemBaud;
           END;
      'D': BEGIN
             REPEAT
               WRITELN;
               WRITE('Duplex: F(ull),H(alf): ');
               KEYREAD(CH,TRUE,TRUE);
             UNTIL (CH='F') OR (CH='H');
             WRITELN;
             HALFDUPLEX:=(CH='H')
           END;
      'F': DEBUG:=YES('Full messages');
      'M': BEGIN
             REPEAT
               WRITELN;
               WRITELN('Current Mask is ',CHINMOD,'.');
               WRITE('Mask in GetFile: 1(28),2(56): ');
               KEYREAD(CH,TRUE,TRUE);
             UNTIL (CH='1') OR (CH='2');
             WRITELN;
             IF CH='1' THEN CHINMOD:=128 ELSE CHINMOD:=256;
           END;
      'P': BEGIN
             WRITELN;
             WRITELN('Current prompt is "',PROMPT,'".');
             WRITE('Give new prompt: ');
             KEYREAD(CH,TRUE,TRUE);
             WRITELN;
           END;
      'Q': FINISH:=TRUE;
    END (*CASE*);
  UNTIL FINISH;
  WRITELN;
END;

PROCEDURE SETMODE;
VAR CH:CHAR;
BEGIN
  REPEAT
    WRITELN;
    WRITE('S(td Host),C(onfigure),Q(uit):');
    KEYREAD(CH,TRUE,TRUE);
  UNTIL CH IN ['C','S','Q'];
  CASE CH OF
    'C': CONFIGURE;
    'S': TRANSMIT(SETHOST,TRUE); (*PRESUMES A REMWRITE(CHR(CR)) DONE AFTER*)
    'Q': (*QUIT..DO NOTHING*);
  END (*CASE*);
END;

{PART2 for PERQ goes here}

FUNCTION PART2:INTEGER;
BEGIN
  (*PART 2 RELEASE VERSION*)
  PART2:=2
END;

(*  CHECKSUM COMPUTATION
    8 letters made up as follows:-
    a) keep a sum of ordinal values of characters in the transfer
       rounded MOD 16384 in a 16 bit integer.
    b) keep a count of number of characters in the transfer rounded
       MOD 16384 in a 16 bit integer.
    c) for each nibble (4 bits) in the 16 bit quantities kept above
       (starting with the most significant nibble of the ordinal values
       sum and ending with the least significant nibble of the character
       count) add the ordinal code for the letter 'A' and send the
       resulting code as a character.  This means that 8 letters between
       'A' and 'O' are sent.
*)

PROCEDURE GETFILE;
CONST FILLLEVEL=470; (*ALLOWS 42 CHARACTERS OF OVERRUN BY HOST AFTER XOFF*)
      LIMIT=511;
VAR STR,STR2:STRING;
    DFILE:TEXT;
    REASON:INTEGER;
    DOTCNT,CHARS,CHKSM,XOFMAX,I,J,XOFCNT,PTR:INTEGER;
    CH:CHAR;
    OVERRUN,STARTED,FINISHED,ESCAPE,ABORT:BOOLEAN;
    BUFFER:PACKED ARRAY[0..LIMIT] OF CHAR;
    CHKSMOK: (CORRECT,WRONG,ABSENT);
    cflag: boolean; {aa}
    keep: char;
        
PROCEDURE GETCHKSM;
VAR CH:CHAR;
    I:INTEGER;
    EXTRA:RECORD CASE BOOLEAN OF
       TRUE: (DAT:PACKED ARRAY[0..7] OF 0..15);
       FALSE:(CHKSM,CHARS:INTEGER);
    END;
BEGIN
  (* a line feed before 8 characters have been received
     implies no checksum is present*)
  EXTRA.CHKSM:=CHKSM;
  EXTRA.CHARS:=CHARS;
  CHKSMOK:=CORRECT;
  I:=7;
  REPEAT
     REMREAD(CH);
     CH:=CHR(ORD(CH) MOD 128);
     IF (EXTRA.DAT[I]+ORD('A'))<>ORD(CH) THEN CHKSMOK:=WRONG;
     I:=I-1;
  UNTIL (I=0) OR (CH=CHR(LF));
  IF CH=CHR(LF) THEN CHKSMOK:=ABSENT ELSE
     REPEAT
        REMREAD(CH);
        CH:=CHR(ORD(CH) MOD 128);
     UNTIL CH=CHR(LF)
END;

PROCEDURE GETCHAR;
VAR I:INTEGER;
    CH:CHAR;
BEGIN
   REMREAD(CH);
   CH:=CHR(ORD(CH) MOD CHINMOD); (*MASK AS DIRECTED - 128 OR 256*)
   IF ESCAPE THEN BEGIN
      IF CH='B' THEN STARTED:=TRUE ELSE
      IF CH='E' THEN BEGIN
         FINISHED:=TRUE;
         GETCHKSM;
      END ELSE IF CH='C' THEN BEGIN
         BUFFER[PTR]:='*';
         PTR:=PTR+1;
         CHARS:=(CHARS+1) MOD 16384;
         CHKSM:=(CHKSM+ORD('*')) MOD 16384;
      END ELSE BEGIN
         PTR:=0;
         REPEAT
            PTR:=PTR+1;
            BUFFER[PTR]:=CH;
            REMREAD(CH);
            CH:=CHR(ORD(CH) MOD 128);
         UNTIL CH=CHR(LF);
         WRITELN;
         WRITE('*');
         FOR I:=1 TO PTR DO
           IF CH<>CHR(CR) THEN WRITE(BUFFER[I]);
         (* I-*)
         CLOSE(DFILE);
         (* I+*)
         WHILE REMPRESS DO REMREAD(CH); (*DISCARD LAST (PROMPT) CHARACTERS*)
         (*ASSUMES A REMWRITE(CHR(CR)) IS DONE EXTERNALLY
           TO ALLOW PROG TO CONTINUE*)
         EXIT(GETFILE);
      END;
      ESCAPE:=FALSE;
   END ELSE BEGIN
      IF CH='*' THEN ESCAPE:=TRUE ELSE
         IF STARTED AND (PTR<LIMIT) THEN BEGIN
         (*IF BUFFER FULL, THEN CHARACTERS WILL BE LOST *)
         (*SO THE CHECKSUM WILL BE WRONG                *)
         BUFFER[PTR]:=CH;
         PTR:=PTR+1;
         CHARS:=(CHARS+1) MOD 16384;
         CHKSM:=(CHKSM+ORD(CH)) MOD 16384;
      END;
   END;
END;

PROCEDURE NAMECHECK;
(*CHECK LOCAL FILE NAME AND PRINT MESSAGES - CAN SET ABORT AND REASON*)
(*PUT IN SEPARATE PROCEDURE TO GET MORE CODE SPACE IN MAIN PROCEDURE BODY*)
VAR CH:CHAR;
    I:INTEGER;
BEGIN
  (*REMOVE SPACES*)
  WHILE POS(' ',STR2)<>0 DO DELETE(STR2,POS(' ',STR2),1);
  IF (LENGTH(STR)=0) OR (LENGTH(STR2)=0)THEN ABORT:=TRUE
  ELSE
    BEGIN
      IF POS(':',STR2)=LENGTH(STR2) THEN
        BEGIN
          (*DEVICE NAME ENDS IN : - ONLY ALLOW PRINTER: *)
          (*AS CONSOLE: AND REMOUT: USED BY X-TALK      *)
          FOR I:=1 TO LENGTH(STR2) DO
            BEGIN
              CH:=STR2[I];
              IF ('a'<=CH) AND (CH<='z') THEN
                 STR2[I]:=CHR((ORD(CH)-ORD('a'))+ORD('A'));
            END;
          IF STR2<>'PRINTER:' THEN
            BEGIN
              WRITELN('Only PRINTER: allowed for device output.');
              ABORT:=TRUE;
            END;
        END
      ELSE
        BEGIN
          (* I-*)
 (* on PERQ can check if a file exists using a module FILESYSTEM
    from FILESYSTEM.  FSLOOKUP(string file name, Int var 1, Int var 2) returns
    an integer value=0 if file does not exist.
    Can delete file using a routine in module FILEPROCS *)
(*
          RESET(DFILE,STR2);
          IF IORESULT=0 THEN BEGIN
             REPEAT
                WRITE('Destroy old ',STR2,' (Y/N):');
                KEYREAD(CH,TRUE,TRUE);
                WRITELN;
             UNTIL (CH='Y') OR (CH='N');
             IF CH='Y' THEN CLOSE(DFILE,PURGE) ELSE BEGIN
                CLOSE(DFILE);
                ABORT:=TRUE;
             END;
          END ELSE IF IORESULT<>10 THEN BEGIN
             ABORT:=TRUE;
             REASON:=IORESULT;
          END;
*)
          (* I+*)
        END;
    END;
END;

PROCEDURE ENDMESS;
  (*END MESSAGES - PUT HERE TO GET MORE CODE SPACE IN MAIN BODY*)
BEGIN
   IF (ABORT AND (REASON<>0)) OR (CHKSMOK=WRONG) THEN BEGIN
     WRITELN;
     WRITE('**Abnormal termination.');
     IF CHKSMOK=WRONG THEN WRITELN(' Checksum faulty.') ELSE GIVEREASON(REASON)
   END ELSE BEGIN
     WRITELN;
     IF OVERRUN THEN BEGIN
       WRITELN('Overrun occurred with ',XOFNUM,' XOFFs. More XOFFs req??');
     END ELSE BEGIN
       IF CHKSMOK=ABSENT THEN WRITELN('No checksum.');
       IF DEBUG THEN
         BEGIN
           WRITE('        ',CHARS:6,' characters received.');
           WRITELN('  Checksum:',CHKSM:6,'.');
           WRITELN('          Max XOFFs req. ',XOFMAX);
         END;
     END;
   END;
   WRITE('--- Get file finished ---',CHR(BEL));
END;

BEGIN
   WRITELN;
{aa} if binary then writeln('--- Binary Get file (Version ',part2,') ---') else
   WRITELN('--- Get file (Version ',PART2,') ---');
   WRITELN;
   WRITE('Give remote filename:');
   KEYRDLN(STR);
   WRITE('Give local  filename:');
   KEYRDLN(STR2);
   ABORT:=FALSE;
   REASON:=0;
   cflag := true;  {aa}   
   NAMECHECK; (* OF STR2 - CAN SET ABORT AND REASON*)
   
   STARTED:=FALSE;
   FINISHED:=FALSE;
   ESCAPE:=FALSE;
   CHARS:=0;
   CHKSM:=0;
   XOFMAX:=0;
   OVERRUN:=FALSE;
   IF NOT ABORT THEN
     BEGIN
       (* I-*)
       REWRITE(DFILE,STR2);
       IF IORESULT<>0 THEN
         BEGIN
           ABORT:=TRUE;
           REASON:=IORESULT;
         END
       (* I+*)
       ELSE
         BEGIN
           TRANSMIT('GIVEFILE',FALSE);
           TRANSMIT(CRSTRING,TRUE);
           TRANSMIT(STR,TRUE);
           (*ECHO TO TRAP ERROR MESSAGES FROM HOST*)
           WRITELN;
           DOTCNT:=0;
           REMWRITE(CHR(CR));
           REPEAT
              PTR:=0;
              REPEAT
                GETCHAR;
              UNTIL FINISHED OR (PTR>=FILLLEVEL);
              (* IF NOT FINISHED THEN REMWRITE(CHR(XOFF)); *)
              (*ABOVE LINE SHOULD BE ABLE TO REPLACE NEXT 11 - NOT CHECKED*)
              XOFCNT:=0;
              WHILE (NOT FINISHED) AND (XOFCNT<XOFNUM) DO BEGIN
                 XOFCNT:=XOFCNT+1;
                 REMWRITE(CHR(XOFF));
                 REPEAT
                    IF REMPRESS THEN BEGIN
                       IF XOFCNT>=XOFMAX THEN XOFMAX:=XOFCNT;
                       GETCHAR;
                    END;
                 UNTIL REMDONE;
              END;
              IF NOT FINISHED THEN
                (*WAIT TO CHECK HOST HAS STOPPED SENDING*)
                REPEAT
                  J:=0;
                  WHILE (J<WAITTIME) AND (NOT REMPRESS) DO J:=J+1;
                  IF REMPRESS THEN GETCHAR;
                UNTIL (J=WAITTIME); (*WAIT HAS EXPIRED*)
              IF DOTCNT=40 THEN BEGIN
                 DOTCNT:=0; WRITELN;
              END;
              DOTCNT:=DOTCNT+1;
              WRITE('.');
              I:=0;
             WHILE (I<ptr) AND (NOT ABORT) DO BEGIN
                 CH:=BUFFER[I];
                 (* I-*)
               {Alter this line to capture in a different way for binary}
                if binary then   {aa}
                  begin
                     cflag := not cflag;
                     if cflag then write(dfile,ch,keep) else keep := ch;
                  end else begin
                     IF CH<>CHR(LF) THEN WRITE(DFILE,CH) ELSE WRITELN(DFILE);
                  end;
              if  ioRESULT<>0 THEN
                   BEGIN
                     ABORT:=TRUE;
                     REASON:=IORESULT;
                   END;
                 (* I+*)
                 I:=I+1;
              END;
              WHILE KEYPRESS AND NOT ABORT DO BEGIN
                 KEYREAD(CH,FALSE,FALSE);
                 IF CH=CHR(ESC) THEN ABORT:=ABORT OR SURE('Curtail transfer');
              END;
              IF NOT ABORT THEN BEGIN
                IF (XOFCNT<>0) THEN REMWRITE(CHR(XON));
                (*XON MUST BE SENT IF XOFF HAS BEEN SENT    *)
                (*REGARDLESS OF OVERRUN, FINISHED ETC.      *)
                (*only exception is when aborting with ESC A*)
                IF NOT FINISHED THEN BEGIN
                   IF REMPRESS THEN BEGIN
                     OVERRUN:=TRUE;
                     WRITELN;
                     WRITELN('Overrun, characters from remote lost.');
                     (*GIVE MESSAGE IN CASE OF PREMATURE EXIT DUE TO *E MISSED*)
                     REMWRITE(CHR(CR));
                     (*CR TO HOST IN CASE *E MISSED DURING OVERRUN PERIOD*)
                     (* ** OF HOST TERMIN. MESSAGE WILL CAUSE EXIT IN GETCHAR*)
                   END;
                END;
              END;
           UNTIL FINISHED OR ABORT;
           IF ABORT THEN BEGIN
              REMWRITE(CHR(ESC));
              REMWRITE('A');
              REMWRITE(CHR(CR));
           END;
           (* I-*)
           CLOSE(DFILE    (*  on PERQ    ,LOCK    *)     );
           IF IORESULT<>0 THEN BEGIN
             ABORT:=TRUE;
             REASON:=IORESULT;
           END;
           (* I+*)
         END;
       END;
   ENDMESS; (*ENDING MESSAGES*)
   REMSINK(FALSE);  (* LOOSE ALL OUTSTANDING CHARACTERS FROM HOST*)
   (*ASSUMES REMWRITE(CHR(CR)) DONE ON EXIT TO ALLOW PROG TO CONTINUE*)
END;

PROCEDURE PUTFILE;
CONST TERM='?'; (*TERMINATOR*)
VAR DOTCNT,DOTSUB,TOTXOF,MAXXOF,XOFOCC:INTEGER;
    STR,STR2:STRING;
    ABORT:BOOLEAN;
    CH:CHAR;
    DFILE:TEXT;
    CHARS,CHKSM,REASON:INTEGER;
    
PROCEDURE PUTCHKSM;
VAR I:INTEGER;
    EXTRA:RECORD CASE BOOLEAN OF
       TRUE: (DAT:PACKED ARRAY[0..7] OF 0..15);
       FALSE:(CHKSM,CHARS:INTEGER);
    END;
BEGIN
   EXTRA.CHKSM:=CHKSM;
   EXTRA.CHARS:=CHARS;
   FOR I:=7 DOWNTO 0 DO REMWRITE(CHR(ORD('A')+EXTRA.DAT[I]));
   REMWRITE(CHR(CR));
END;

PROCEDURE REMCHECK;
VAR XOFCNT:INTEGER;
    CH:CHAR;
BEGIN
   XOFCNT:=0;
   REPEAT
      REMREAD(CH);
      CH:=CHR(ORD(CH) MOD 128);
      IF CH=CHR(XOFF) THEN XOFCNT:=XOFCNT+1
      ELSE IF CH<>CHR(XON) THEN BEGIN
        (*BAD CHAR FROM REMOTE - COULD BE A **HOST BREAK IN*)
        IF CH<>CHR(CR) THEN WRITE(CH);
        REMWRITE(TERM); (*IN CASE BAD CHAR WAS NOT A BREAK IN*)
        (* I-*)
        CLOSE(DFILE);
        (* I+*)
        EXIT(PUTFILE); (*EXIT QUICKLY TO CATCH REST OF MESSAGE*)
      END;
   UNTIL (CH=CHR(XON)) OR ABORT;
   TOTXOF:=TOTXOF+XOFCNT;
   IF XOFCNT>MAXXOF THEN MAXXOF:=XOFCNT;
   XOFOCC:=XOFOCC+1
END;
   
PROCEDURE ENDMESS;
  (*ENDING MESSAGES PUT HERE TO GAIN MORE CODE SPACE IN MAIN BODY*)
BEGIN
   IF ABORT AND (REASON<>0) THEN BEGIN
     WRITELN;
     WRITE('**Abnormal termination.');
     GIVEREASON(REASON);
   END ELSE
     BEGIN
       IF DEBUG THEN
         BEGIN
           WRITELN;
           WRITE('        ',CHARS:6,' characters sent.    ');
           WRITELN('  Checksum:',CHKSM:6,'.');
           WRITE('          XOFF occurred ',XOFOCC);
           WRITE(', Max ',MAXXOF);
           WRITELN(', Total ',TOTXOF,'.');
         END;
     END;
   WRITELN;
   WRITE('--- Put file finished ---',CHR(BEL));
END;

BEGIN
   WRITELN;
   WRITELN('--- Put file (Version ',PART2,') ---');
   WRITELN;
   WRITE('Give local  filename:');
   KEYRDLN(STR);
   WRITE('Give remote filename:');
   KEYRDLN(STR2);
   ABORT:=FALSE;
   REASON:=0;
   
   IF (LENGTH(STR)=0) OR (LENGTH(STR2)=0) THEN ABORT:=TRUE
   ELSE
     BEGIN
       (* I-*) (*I/O CHECKING OFF*)
       RESET(DFILE,STR);
       IF IORESULT<>0 THEN BEGIN
          ABORT:=TRUE;
          REASON:=IORESULT
       END;
       (* I+*)
     END;
   
   TOTXOF:=0;
   MAXXOF:=0;
   XOFOCC:=0;
   CHARS:=0;
   CHKSM:=0;
   DOTCNT:=0;
   DOTSUB:=0;
   IF NOT ABORT THEN BEGIN
     TRANSMIT('TAKEFILE',FALSE);
     TRANSMIT(CRSTRING,TRUE);
     TRANSMIT(STR2,TRUE);
     (*MUST ECHO TO ENSURE THAT MESSAGES FROM HOST ARE VISIBLE*)
     WRITELN;
     REMWRITE(CHR(CR));
     REPEAT
        REMREAD(CH);
        CH:=CHR(ORD(CH) MOD 128);
     UNTIL NOT (CH IN [CHR(NUL),CHR(CR),CHR(LF)]);
     IF CH<>CHR(XON) THEN BEGIN
        WRITE(CH);
        (* I-*)
        CLOSE(DFILE);
        (* I+*)
        EXIT(PUTFILE);
        (*EXIT QUICKLY TO CATCH REST OF MESSAGE FROM HOST*)
     END;
     REPEAT
       WHILE (NOT EOLN(DFILE)) AND (NOT ABORT) DO
         BEGIN
           (* I-*)
    {here to try for binary transfers - not so sure about this though}
           READ(DFILE,CH);
           IF IORESULT<>0 THEN
             BEGIN
               ABORT:=TRUE;
               REASON:=IORESULT
             END
           (* I+*)
           ELSE
             BEGIN
               IF ((ORD(CH) MOD 128)=ORD(TERM)) OR ((ORD(CH) MOD 128)=DLE) THEN
                 BEGIN
                   IF REMPRESS THEN REMCHECK;
                   REMWRITE(CHR(DLE)); (*SPECIAL CHARACTER*)
                 END;
               CHARS:=(CHARS+1) MOD 16384;
               CHKSM:=(CHKSM+ORD(CH)) MOD 16384;
               IF REMPRESS THEN REMCHECK;
               REMWRITE(CH);
               DOTSUB:=DOTSUB+1;
            END;
          END;
        IF NOT ABORT THEN BEGIN
          (* I-*)
          READLN(DFILE);
          (* I+*)
          CHARS:=(CHARS+1) MOD 16384;
          CHKSM:=(CHKSM+LF) MOD 16384;
          IF REMPRESS THEN REMCHECK;
          REMWRITE(CHR(LF));
          DOTSUB:=DOTSUB+1;
          IF DOTSUB>=500 THEN BEGIN
             DOTSUB:=DOTSUB-500;
             IF DOTCNT=40 THEN BEGIN
                DOTCNT:=0;
                WRITELN;
             END;
             DOTCNT:=DOTCNT+1;
             WRITE('.');
          END;
          WHILE KEYPRESS AND NOT ABORT DO BEGIN
             KEYREAD(CH,FALSE,FALSE);
             IF CH=CHR(ESC) THEN ABORT:=ABORT OR SURE('Curtail transfer');
          END;
        END;
     UNTIL EOF(DFILE) OR ABORT;
     (* I-*)
     CLOSE(DFILE);
     (* I+*)
     IF REMPRESS THEN REMCHECK;
     REMWRITE(TERM);
     PUTCHKSM; (*PUT OUT CHECKSUM TO HOST*)
   END;
   ENDMESS; (*ENDING MESSAGES*)
   REMSINK(FALSE); (*LOOSE ALL OUTSTANDING CHARACTERS FROM HOST*)
   (* ASSUMES A REMWRITE(CHR(CR)) DONE ON EXIT TO ALLOW PROG TO CONTINUE *)
END;

{dummy part3 entered for PERQ}

FUNCTION PART3:INTEGER;
BEGIN
  (*PART 3 RELEASE VERSION*)
  PART3:=0;  (* 0 INDICATES NULL VERSION OF PART 3 *)
END;

PROCEDURE ALTGET;
BEGIN
   WRITELN;
   WRITELN('--- Alternative Get file (Version ',PART3,') ---');
   WRITELN;
   WRITELN('Not provided.');
   WRITELN;
END;

PROCEDURE ALTPUT;
BEGIN
   WRITELN;
   WRITELN('--- Alternative Put File (Version ',PART3,') ---');
   WRITELN;
   WRITELN('Not provided.');
   WRITELN;
END;

{dummy Filer}

PROCEDURE FILELEVEL;
VAR FINISH:BOOLEAN;
    CH:CHAR;
BEGIN
  WRITELN;
  WRITE('Filer not available.  ');
  WRITELN('Q(uit from TTY and use normal Filing System.');
END;

FUNCTION PARTF:INTEGER;
BEGIN
  PARTF:=0;
END;

   
PROCEDURE HELPTEXT;
BEGIN
  WRITELN;
  WRITELN('PERQ acts as a normal terminal. CTRL/L causes entry to local mode.');
  WRITELN('In this mode there are several commands.');
  WRITELN;
  WRITELN('^(control) is used to send a control character to the host.');
  WRITELN;
  WRITELN('F(iler)    is not available on PERQ.');
  WRITELN;
  WRITELN('G(et file) is used to transfer a file from the remote to the PERQ.');
  WRITELN;
  WRITELN('P(ut file) is used to transfer a file from the PERQ to the remote.');
  WRITELN;
  WRITELN('S(et mode) is used to configure the interface and program,');
  WRITELN('           and set host or local values.');
  WRITELN;
  WRITE('Q(uit)     is used to stop the program.');
END;

PROCEDURE TTYTITLE;
BEGIN
  WRITELN;
  WRITELN('-----------------------------------------------------------------');
  WRITELN('ERCC - ',MCNAME,' communications - (11Dec81)');
  WRITELN('-----------------------------------------------------------------');
  WRITELN('Micro acts as a normal terminal.');
  WRITELN('CTRL/L enters local mode.');
  WRITELN;
END;

PROCEDURE INITDATA;
BEGIN
  CRSTRING:=' ';
  CRSTRING[1]:=CHR(CR);
  CTRLASTRING:=' ';
  CTRLASTRING[1]:=CHR(CTRLA);
  SETHOST:=CONCAT(CTRLASTRING,'P 5'); (*CR SENT AFTER SETMODE*)
  WAITTIME:=500;
  XOFNUM:=5; (*IF THIS IS >1 THEN REMDONE MUST BE IMPLEMENTED  *)
             (*IN THE MACHINE SPECIFIC PART - IT CANNOT SIMPLY *)
             (*DEFAULT TO RETURNING TRUE - ELSE THE SYSTEM WILL*)
             (*LOOSE CHARACTERS FROM HOST WHILE XOFFS ARE BEING*)
             (*SENT IN GETFILE                                 *)
  ALTFILE:=FALSE;
  CHINMOD:=256; {default Mask - needs to be 256 for binary}
  HALFDUPLEX:=FALSE;
  PROMPT:=':';
  DEBUG:=true;
END;

BEGIN
  INITDATA;
  REMSETUP;
  TERMINAL:=FALSE;
  TTYTITLE;
  REMWRITE(CHR(CR));
  (*ALLOW HOST TO REPEAT PROMPT IF ALREADY LOGGED IN*)

  REPEAT

    RemFlush; {version IV change}

    IF KEYPRESS THEN
      BEGIN
        KEYREAD(CH,FALSE,FALSE);
        IF (CH=CHR(CTRLL)) THEN
          BEGIN (*LOCAL MODE*)
            REPEAT
              WRITELN;
              WRITE('^(ctrl),F(ile),G(et),B(inary get),P(ut),S(et),Q(uit)  ');
              (* ABOVE LINE IS 40 WIDE FOR TIDY APPLE DISPLAY *)
              WRITE('<space> to continue:');
              KEYREAD(CH,TRUE,TRUE);
              WRITELN;
              IF CH IN [' ','C','^','F','G','P','R','S','Q','B'] THEN {aa}
                (*NOTE C AND R ARE COMMANDS NOT ON PROMPT LINE*)
                (*FOR COMPATABILITY WITH VERSION 1*)
                BEGIN (* VALID COMMAND *)
                  GOODLOCAL:=TRUE;
                  CASE CH OF
                    'C',' ': CH:=' '; (*CONTINUE*)
                        '^': SENDCTRL;
                        'F': FILELEVEL;
                        'G':begin
                               binary := false;{aa}
                               getfile;
                            end;
                        'B': begin
                               binary := true;
                               getfile;
                             end;
                        'P': IF ALTFILE THEN ALTPUT ELSE PUTFILE;
                        'R': WRITELN('TTY Revision: 1.3',
                                             ', 2.',PART2,
                                             ', 3.',PART3,
                                             ', F.',PARTF,
                                             ', X.',PARTX1,PARTX2,'.');
                             (*PUTTING A FURTHER FUNCTION CALL IN WRITELN*)
                             (*ABOVE CAUSES STACK OVERFLOW ON APPLE      *)
                        'S': SETMODE;
                        'Q': TERMINAL:=SURE('Quit')
                  END (*CASE *);
                  IF CH=' ' THEN REMWRITE(CHR(REPEATCH)) (*REPEAT PRESENT LINE*)
                  ELSE IF (CH<>'^') AND (CH<>'Q') THEN
                         BEGIN
                           IF HALFDUPLEX THEN WRITELN;
                           REMWRITE(CHR(CR)); (*FORCE PROMPT*)
                         END;
                END
              ELSE
                BEGIN
                  WRITE('Do you need help (Y/N):');
                  (*IF USER TYPES ANYTHING BUT N HELP IS NEEDED*)
                  KEYREAD(CH,TRUE,TRUE);
                  WRITELN;
                  IF (CH<>'N') THEN HELPTEXT;
                END
            UNTIL GOODLOCAL
          END
        ELSE
          BEGIN
            IF HALFDUPLEX THEN BEGIN
              IF CH=CHR(BS) THEN WRITE(CHR(BS),' ',CHR(BS))
              ELSE IF CH=CHR(CR) THEN WRITELN
              ELSE IF (CH<' ') THEN WRITE(CHR(BEL))
              ELSE WRITE(CH);
            END;
            IF CH=CHR(BS) THEN CH:=CHR(DEL); (*CHR(BS) FOR EMAS*)
            REMWRITE(CH)
          END
      END;

    RemFlush; {version IV change}

  UNTIL TERMINAL;
  REMCLOSE;
END.