<<< bldker. >>>
$PROD BLDKER,,,,NONE
$NOP
$IFN %1=HELP,P/$GOTO NOHELP
$GOTO HELP
$TAG ARGERR
$NOP ** MISSING A REQUIRED ARGUMENT **
$TAG HELP
$NOP
$NOP  *****  PROCEDURE TO COMPLETELY BUILD MODCOMP KERMIT *****
$NOP
$NOP    ***   ARG 1  = NAME OF SOURCE LIBRARY (NO DEFAULT)
$NOP    ***   ARG 2  = NAME OF OBJECT LIBRARY (NO DEFAULT)
$NOP    ***   ARG 3  = NAME OF LOAD MODULE FILE (NO DEFAULT)
$NOP    ***   ARG 4  = LIST OPTION; IF <> NONE, FORTRAN LISTINGS
$NOP    ***            AND A LINK MAP ARE PRODUCED (DEFAULT = %4)
$NOP
$NOP    *** EXAMPLE --> $BLDKER USL,UL,LM,LO
$NOP
$ENDDO
$NOP
$TAG NOHELP
$IFM %1,P/$GOTO ARGERR
$IFM %2,P/$GOTO ARGERR
$IFM %3,P/$GOTO ARGERR
$DOFR5 BUFEMP,%1,%4,,%2
$DOFR5 BUFILL,%1,%4,,%2
$DOFR5 CTL,%1,%4,,%2
$DOFR5 CTOI,%1,%4,,%2
$DOFR5 DGETCH,%1,%4,,%2
$DOFR5 DGETLI,%1,%4,,%2
$DOFR5 DPUTCH,%1,%4,,%2
$DOFR5 DPUTLI,%1,%4,,%2
$DOFR5 FINDLN,%1,%4,,%2
$DOFR5 FXFILE,%1,%4,,%2
$DOFR5 GETLIN,%1,%4,,%2
$DOFR5 PACK,%1,%4,,%2
$DOFR5 PARSER,%1,%4,,%2
$IF %4=NONE,P/$DOM5A POSUSL,%1,NOLO,%2
$IFN %4=NONE,P/$DOM5A POSUSL,%1,LO,%2
$DOFR5 RDATA,%1,%4,,%2
$DOFR5 RECSW,%1,%4,,%2
$DOFR5 RFILE,%1,%4,,%2
$DOFR5 RINIT,%1,%4,,%2
$DOFR5 RPACK,%1,%4,,%2
$DOFR5 RPAR,%1,%4,,%2
$DOFR5 RSTORE,%1,%4,,%2
$DOFR5 SBREAK,%1,%4,,%2
$DOFR5 SCONNE,%1,%4,,%2
$DOFR5 SCOPY,%1,%4,,%2
$DOFR5 SDATA,%1,%4,,%2
$DOFR5 SENDSW,%1,%4,,%2
$DOFR5 SEOF,%1,%4,,%2
$DOFR5 SFILE,%1,%4,,%2
$DOFR5 SHELP,%1,%4,,%2
$DOFR5 SINIT,%1,%4,,%2
$DOFR5 SKIPBL,%1,%4,,%2
$DOFR5 SPACK,%1,%4,,%2
$DOFR5 SPAR,%1,%4,,%2
$DOFR5 SQUIT,%1,%4,,%2
$DOFR5 SRECEI,%1,%4,,%2
$DOFR5 SSEND,%1,%4,,%2
$DOFR5 SSET,%1,%4,,%2
$DOFR5 SSTATU,%1,%4,,%2
$DOFR5 TOCHAR,%1,%4,,%2
$DOFR5 TPUTCH,%1,%4,,%2
$DOFR5 UFTINI,%1,%4,,%2
$DOFR5 UNCHAR,%1,%4,,%2
$DOFR5 UPPER,%1,%4,,%2
$DOFR5 KERMIT,%1,%4,,%2,,BLKD
$ASSIGN BI=%2,BO=BO,UL=%2
$REWIND BO
$EXECUTE LIB
 POSITION KERMIT
 GET KERMIT
 POSITION B:KERMIT
 COPY
 WEOF BO
 EXIT
$REWIND BO
$ASSIGN BI=BO
$EXECUTE M4EDIT
 LIB UL
 EDIT MAIN BI
 WEOF BO
 EXIT
$REWIND BO
$ASSIGN BI=BO
$EXECUTE TOC
 FILE %3
 OVERLAY KERMIT
 CATALOG
 EXIT
$ENDDO
<<< bufemp. >>>
      SUBROUTINE BUFEMP(BUFFER,LEN)
C
C     ****************************************************************
C
C              KERMIT for the MODCOMP MAXIV operating system
C
C        Compliments of:
C
C                         SETPOINT, Inc.
C                      10245 Brecksville Rd.
C                      Brecksville, Ohio 44141
C
C
C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
C      of this version hereby grant permission to copy this software
C      provided that it is not used for an explicitly commercial
C      purpose and that proper credit be given. SETPOINT, Inc. makes
C      no warranty whatsoever regarding the accuracy of this package
C      and will assume no liability resulting from it's use.
C
C     ****************************************************************
C
C     Abstract:  RECOVERS CONTROL CHARACTERS, STRIPS LINE FEEDS, AND
C                CALLS DPUTCH TO WRITE OUT TO DISK
C
C     MODIFICATION HISTORY
C
C     BY            DATE     REASON            PROGRAMS AFFECTED
C
C     ****************************************************************
C
C     Author: BOB BORGESON          Version: A.0    Date: Oct-86
C
C     Calling Parameters:
C
C     R    BUFFER       - Data to be written to disk
C     R    LEN          - Number of bytes to be written
C
C     ****************************************************************
C
C     Messages generated by this module :  None
C
C     ****************************************************************
C
C     Subroutines called directly :  CTL, DPUTCH
C
C     ****************************************************************
C
C     Files referenced :  None
C
C     ****************************************************************
C
C     Local variable definitions :
C
C     CH     - UFT FOR THE DISK FILE
C
C     ****************************************************************
C
C     Commons referenced :  KER, KERPAR
C
C     ****************************************************************
C
C     (*$END.DOCUMENT*)
C
C     ****************************************************************
C     *                                                              *
C     *         D I M E N S I O N   S T A T E M E N T S              *
C     *                                                              *
C     ****************************************************************
C
      IMPLICIT INTEGER (A-Z)
      INTEGER*2   BUFFER(132)
C
C     ****************************************************************
C     *                                                              *
C     *         T Y P E   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         C O M M O N   S T A T E M E N T S                    *
C     *                                                              *
C     ****************************************************************
C
      INCLUDE USL/KERCOM
      INCLUDE USL/KERPMC
C
C     ****************************************************************
C     *                                                              *
C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         D A T A   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C
C     Code starts here :
C                                     !UFT  OF RECEIVING DISK FILE
      CH=8
C                                     !START WITH THE VERY FIRST CHARACT
      I=1
C                                     !PUT LEN CHARACTERS INTO DISK FILE
  100 CONTINUE
      IF(I.GT.LEN) GO TO 9000
C                                     !GET THE NEXT CHARACTER FROM BUFFE
         T=BUFFER(I)
C                                     !IS THIS MY QUOTE CHARACTER
         IF(T.NE.MYQUOTE)GO TO 200
C                                     !INCREMENT THE COUNTER
            I=I+1
C                                     !GET NEXT CHARACTER FROM BUFFER
            T=BUFFER(I)
C                                     !IS THIS QUOTE CHARACTER THE
            IF(T.NE.MYQUOTE)T=CTL(T)
C                                     !ACTUAL QUOTE CHARACTER
  200    CONTINUE
C                                     !FILTER OUT LF
         IF(T.NE.LF)CALL DPUTCH(T,CH)
         I=I+1
         GO TO 100
C
 9000 CONTINUE
      RETURN
      END
<<< bufill. >>>
      INTEGER FUNCTION BUFILL (BUFFER)
C
C     ****************************************************************
C
C              KERMIT for the MODCOMP MAXIV operating system
C
C        Compliments of:
C
C                         SETPOINT, Inc.
C                      10245 Brecksville Rd.
C                      Brecksville, Ohio 44141
C
C
C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
C      of this version hereby grant permission to copy this software
C      provided that it is not used for an explicitly commercial
C      purpose and that proper credit be given. SETPOINT, Inc. makes
C      no warranty whatsoever regarding the accuracy of this package
C      and will assume no liability resulting from it's use.
C
C     ****************************************************************
C
C     Abstract:  Fill up the buffer with character bytes from the
C                sending disk file.
C
C     MODIFICATION HISTORY
C
C     BY            DATE     REASON            PROGRAMS AFFECTED
C
C
C     ****************************************************************
C
C     Author: BOB BORGESON          Version: A.0    Date: Oct-86
C
C     Calling Parameters:
C
C     R    BUFFER       - Data array to be filled from the disk file
C
C     ****************************************************************
C
C     Messages generated by this module :  None
C
C     ****************************************************************
C
C     Subroutines called directly : CTL, DGETCH
C
C     ****************************************************************
C
C     Files referenced :  None
C
C     ****************************************************************
C
C     Local variable definitions :
C
C     ****************************************************************
C
C     Commons referenced :  KER, KERPAR
C
C     ****************************************************************
C
C     (*$END.DOCUMENT*)
C
C     ****************************************************************
C     *                                                              *
C     *         D I M E N S I O N   S T A T E M E N T S              *
C     *                                                              *
C     ****************************************************************
C
      IMPLICIT INTEGER (A-Z)
C
      INTEGER*2   BUFFER(132)
C
C     ****************************************************************
C     *                                                              *
C     *         T Y P E   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         C O M M O N   S T A T E M E N T S                    *
C     *                                                              *
C     ****************************************************************
C
      INCLUDE USL/KERCOM
      INCLUDE USL/KERPMC
C
C     ****************************************************************
C     *                                                              *
C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         D A T A   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C
C     Code starts here :
C
      I=1
C                                          !FILE DESCRIPTOR OF THE SENDING
C                                          !DISK FILE
      CH=7
  100 CONTINUE
      IF ((DGETCH(T,CH).EQ.EOF))GO TO 1000
C                                          !KEEP READING BYTE FROM THE DISK
C                                          !FILE UNTIL WE REACH AN EOF,OR
C                                          !WE HAVE ENOUGH BYTE TO FILL
C                                          !BUFFER
         IF((T.GE.BLANK).AND.(T.NE.DEL).AND.(T.NE.QUOTE))GO TO 800
C                                          !IT IS THE LINE DELIMITER OF
C                                          !THIS SYSTEM, INSERT THE LF
C                                          !BEFORE THE CR
             IF(T.NE.LF)GO TO 700
                BUFFER(I)=QUOTE
                I=I+1
                BUFFER(I)=CTL(CR)
                I=I+1
  700        CONTINUE
C                                          !WE GOT A QUOTE CHARACTER
             BUFFER(I)=QUOTE
             I=I+1
             IF(T.NE.QUOTE)T=CTL(T)
  800    CONTINUE
         BUFFER(I)=T
         I=I+1
C                                    !READ UP TO SPSIZ-8 BYTE FROM DISK
         IF(I.LE.(SPSIZ-8))GO TO 900
C                                    !I BYTE WAS READ
            BUFILL=I-1
            RETURN
  900    CONTINUE
C
         GO TO 100
C
 1000 CONTINUE
C
      IF(I.NE.1)GO TO 1100
C                                    !ZERO BYTE WAS READ
        BUFILL=EOF
        RETURN
 1100 CONTINUE
C                                    !PARTIAL EOF WAS DETECTED
        BUFILL=I-1
        RETURN
      END
<<< cltoc. >>>
$PROD CLTOC KERMIT KER LMU NONE
$ASS USL %2 SI USL SO SO
$POS %1
$IF %4=NONE,P/$EXE FR5,,$23,$4E,NOLO,NOMAP
$IFN %4=NONE,P/$EXE FR5,,$23,$4E
$WEO SO
$REW SO
$ASS SI SO BI BI BO BO
$EXE M5A,,NOLO,NOSC
$WEO BO
$REW BO
$ASS BI BO
$IF %4=NONE,P/$EXE M4EDIT,,NOMAP;$EXE M4EDIT
 ASS UL ULC
 LIB UL
 EDIT MAIN BI
 EXIT
$WEO BO
$REW BO
$ASS BI BO
$EXE TOC
 FIL %3
 NOVERIFY
 OVER %1
 CAT
 EXIT
$ENDDO
<<< ctl. >>>
      INTEGER FUNCTION CTL (T)
C
C     ****************************************************************
C
C              KERMIT for the MODCOMP MAXIV operating system
C
C        Compliments of:
C
C                         SETPOINT, Inc.
C                      10245 Brecksville Rd.
C                      Brecksville, Ohio 44141
C
C
C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
C      of this version hereby grant permission to copy this software
C      provided that it is not used for an explicitly commercial
C      purpose and that proper credit be given. SETPOINT, Inc. makes
C      no warranty whatsoever regarding the accuracy of this package
C      and will assume no liability resulting from it's use.
C
C     ****************************************************************
C
C     Abstract:  Toggle the control bit of an ASCII character
C                so that a CTRL-A becomes an A and vice versa.
C
C     MODIFICATION HISTORY
C
C     BY            DATE     REASON            PROGRAMS AFFECTED
C
C
C     ****************************************************************
C
C     Author: BOB BORGESON          Version: A.0    Date: Oct-86
C
C     Calling Parameters:
C
C     R    T    -     CHARACTER TO TOGGLE
C
C     ****************************************************************
C
C     Messages generated by this module :  None
C
C     ****************************************************************
C
C     Subroutines called directly :  None
C
C     ****************************************************************
C
C     Files referenced :  None
C
C     ****************************************************************
C
C     Local variable definitions :  None
C
C     ****************************************************************
C
C     Commons referenced :  None
C
C     ****************************************************************
C
C     (*$END.DOCUMENT*)
C
C     ****************************************************************
C     *                                                              *
C     *         D I M E N S I O N   S T A T E M E N T S              *
C     *                                                              *
C     ****************************************************************
C
      IMPLICIT INTEGER (A-Z)
C
C     ****************************************************************
C     *                                                              *
C     *         T Y P E   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         C O M M O N   S T A T E M E N T S                    *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         D A T A   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C
C     Code starts here :
C
C----->  Do an exclusive OR on the control bit which is
C----->  the seventh bit.
C
      CTL=IEOR(T,64)
      RETURN
      END
<<< ctoi. >>>
      INTEGER FUNCTION CTOI(IN, I)
C
C     ****************************************************************
C
C              KERMIT for the MODCOMP MAXIV operating system
C
C        Compliments of:
C
C                         SETPOINT, Inc.
C                      10245 Brecksville Rd.
C                      Brecksville, Ohio 44141
C
C
C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
C      of this version hereby grant permission to copy this software
C      provided that it is not used for an explicitly commercial
C      purpose and that proper credit be given. SETPOINT, Inc. makes
C      no warranty whatsoever regarding the accuracy of this package
C      and will assume no liability resulting from it's use.
C
C     ****************************************************************
C
C     Abstract: CONVERT ASCII TO BINARY INTEGER
C
C     MODIFICATION HISTORY
C
C     BY            DATE     REASON            PROGRAMS AFFECTED
C
C     ****************************************************************
C
C     Author: BOB BORGESON          Version: A.0    Date: Oct-86
C
C     Calling Parameters:
C
C     R    IN      - INPUT ASCII STRING
C     R    I       - POSITION IN STRING TO START CONVERSION
C
C     ****************************************************************
C
C     Messages generated by this module :  None
C
C     ****************************************************************
C
C     Subroutines called directly :  None
C
C     ****************************************************************
C
C     Files referenced :  None
C
C     ****************************************************************
C
C     Local variable definitions :
C
C     S            - Sign flag indicator
C
C     ****************************************************************
C
C     Commons referenced :  KERPAR local common
C
C     ****************************************************************
C
C     (*$END.DOCUMENT*)
C
C     ****************************************************************
C     *                                                              *
C     *         D I M E N S I O N   S T A T E M E N T S              *
C     *                                                              *
C     ****************************************************************
C
      IMPLICIT INTEGER (A-Z)
      INTEGER*2   IN(1)
C
C     ****************************************************************
C     *                                                              *
C     *         T Y P E   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         C O M M O N   S T A T E M E N T S                    *
C     *                                                              *
C     ****************************************************************
C
      INCLUDE USL/KERPMC
C
C     ****************************************************************
C     *                                                              *
C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         D A T A   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C
C     Code starts here :
C
23000 IF(.NOT.(IN(I) .EQ. 32 .OR. IN(I) .EQ. 9))GOTO 23001
      I = I + 1
      GOTO 23000
23001 CONTINUE
      IF(.NOT.(IN(I) .EQ. 45 .OR. IN(I) .EQ. 43))GOTO 23002
      S = IN(I)
      I = I + 1
      GOTO 23003
23002 CONTINUE
      S = 0
23003 CONTINUE
      CTOI = 0
23004 IF(.NOT.(IN(I) .NE. 10002))GOTO 23006
      IF(.NOT.(IN(I) .LT. 48 .OR. IN(I) .GT. 57))GOTO 23007
      GOTO 23006
23007 CONTINUE
      CTOI = 10 * CTOI + IN(I) - 48
23005 I = I + 1
      GOTO 23004
23006 CONTINUE
      IF(.NOT.(S .EQ. 45))GOTO 23009
      CTOI = -CTOI
23009 CONTINUE
      RETURN
      END
<<< dgetch. >>>
      INTEGER FUNCTION DGETCH (XCHAR,CH)
C
C     ****************************************************************
C
C              KERMIT for the MODCOMP MAXIV operating system
C
C        Compliments of:
C
C                         SETPOINT, Inc.
C                      10245 Brecksville Rd.
C                      Brecksville, Ohio 44141
C
C
C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
C      of this version hereby grant permission to copy this software
C      provided that it is not used for an explicitly commercial
C      purpose and that proper credit be given. SETPOINT, Inc. makes
C      no warranty whatsoever regarding the accuracy of this package
C      and will assume no liability resulting from it's use.
C
C     ****************************************************************
C
C     Abstract:  Get a character from the disk file
C
C     MODIFICATION HISTORY
C
C     BY            DATE     REASON            PROGRAMS AFFECTED
C
C
C     ****************************************************************
C
C     Author: BOB BORGESON          Version: A.0    Date: Oct-86
C
C     Calling Parameters:
C
C     W    XCHAR        - THE CHARACTER YOU GOT
C     R    CH           - THE CHANNEL TO READ ON
C
C     ****************************************************************
C
C     Messages generated by this module :  None
C
C     ****************************************************************
C
C     Subroutines called directly :  DGETLIN
C
C     ****************************************************************
C
C     Files referenced :  None
C
C     ****************************************************************
C
C     Local variable definitions :
C
C     ****************************************************************
C
C     Commons referenced :  XBYTE and KER local commons
C
C     ****************************************************************
C
C     (*$END.DOCUMENT*)
C
C     ****************************************************************
C     *                                                              *
C     *         D I M E N S I O N   S T A T E M E N T S              *
C     *                                                              *
C     ****************************************************************
C
      IMPLICIT INTEGER*2 (A-Z)
C
C     ****************************************************************
C     *                                                              *
C     *         T Y P E   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         C O M M O N   S T A T E M E N T S                    *
C     *                                                              *
C     ****************************************************************
C
      COMMON /XBYTE/ XNEW,XCOUNT,XLIN(132),XEOF
      INCLUDE USL/KERPMC
C
C     ****************************************************************
C     *                                                              *
C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         D A T A   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C
C     Code starts here :
C
      IF(XEOF.NE.YES)GO TO 100
         DGETCH=EOF
         RETURN
  100 CONTINUE
      IF(XNEW.NE.YES)GO TO 1000
         X=DGETLIN(XLIN,CH)
         IF(X.NE.EOF)GO TO 800
            DGETCH=EOF
            XEOF=YES
            RETURN
  800    CONTINUE
            IF(XLIN(1).NE.LF)GO TO 900
               XNEW=YES
               DGETCH=OK
               XCHAR=LF
               RETURN
  900       CONTINUE
               XNEW=NO
               DGETCH=OK
               XCHAR=XLIN(1)
               XCOUNT=2
               RETURN
 1000 CONTINUE
          IF(XLIN(XCOUNT).NE.LF)GO TO 1100
             XNEW=YES
             DGETCH=OK
             XCHAR=LF
             RETURN
 1100      CONTINUE
              DGETCH=OK
              XCHAR=XLIN(XCOUNT)
              XCOUNT=XCOUNT+1
              RETURN
      END
<<< dgetli. >>>
      INTEGER FUNCTION DGETLI (ALIN,CH)
C
C     ****************************************************************
C
C              KERMIT for the MODCOMP MAXIV operating system
C
C        Compliments of:
C
C                         SETPOINT, Inc.
C                      10245 Brecksville Rd.
C                      Brecksville, Ohio 44141
C
C
C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
C      of this version hereby grant permission to copy this software
C      provided that it is not used for an explicitly commercial
C      purpose and that proper credit be given. SETPOINT, Inc. makes
C      no warranty whatsoever regarding the accuracy of this package
C      and will assume no liability resulting from it's use.
C
C     ****************************************************************
C
C     Abstract:  Get a line of compressed source from a disk file and
C                uncompress the line, unpack it (convert to 1 char
C                per word) and put a CR/EOS after the last nonblank
C                character.
C
C     MODIFICATION HISTORY
C
C     BY            DATE     REASON            PROGRAMS AFFECTED
C
C     ****************************************************************
C
C     Author:  Rick Burke           Version: A.0    Date: Aug-86
C
C     Calling Parameters:
C
C     W    ALIN         - Line of text to be returned to the caller
C     R    CH           - UFT number to be used for the read
C
C     ****************************************************************
C
C     Messages generated by this module :  None
C
C     ****************************************************************
C
C     Subroutines called directly :  CMR4, IAND, ISHFT
C
C     ****************************************************************
C
C     Files referenced :  None
C
C     ****************************************************************
C
C     Local variable definitions :
C
C     ACOUNT       - Index variable for return array
C     I            - Index variable
C     IEND         - End-of-file indicator
C     LEN          - Length of uncompressed source line
C     MLEFT        - Mask used to extract left byte of a word
C     MRIGHT       - Mask used to extract right byte of a word
C     CLIN(132)    - Uncompressed source read from disk
C
C     ****************************************************************
C
C     Commons referenced :  KERPAR and UFTTBL local commons
C
C     ****************************************************************
C
C     (*$END.DOCUMENT*)
C
C     ****************************************************************
C     *                                                              *
C     *         D I M E N S I O N   S T A T E M E N T S              *
C     *                                                              *
C     ****************************************************************
C
      IMPLICIT INTEGER (A-Z)
      INTEGER*2   ALIN(132),   CLIN(132)
C
C     ****************************************************************
C     *                                                              *
C     *         T Y P E   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         C O M M O N   S T A T E M E N T S                    *
C     *                                                              *
C     ****************************************************************
C
      INCLUDE USL/KERPMC
C
      INCLUDE USL/UFTTBC
C
C     ****************************************************************
C     *                                                              *
C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         D A T A   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
      DATA        MLEFT /Z7F00/,            MRIGHT /Z007F/
C
C     ****************************************************************
C
C     Code starts here :
C
      DO 10 I = 1,132
      ALIN(I) = 0
      CLIN(I) = 0
   10 CONTINUE
C
C----->  Read compressed source from the current file position.
C
      CALL CMR4 (CLIN,IEND,LEN)
      IF (IEND .EQ. 1) GO TO 20
      DGETLI = EOF
      RETURN
   20 CONTINUE
C
C----->  Loop to expand the data to 1 byte per word.
C
      DO 30 I = 1,65
      ACOUNT = I * 2
      ALIN(ACOUNT-1) = ISHFT (IAND (CLIN(I),MLEFT),-8)
      ALIN(ACOUNT) = IAND (CLIN(I),MRIGHT)
   30 CONTINUE
C
C----->  Remove any trailing blanks.
C
      DO 40 I=1,130
      ACOUNT = 131 - I
      IF (ALIN(ACOUNT) .NE.     0 .AND.
     >    ALIN(ACOUNT) .NE. BLANK      ) GO TO 50
   40 CONTINUE
      ACOUNT = 0
   50 CONTINUE
C
C----->  Add LF and EOS at the end.
C
      ALIN(ACOUNT+1) = LF
      ALIN(ACOUNT+2) = EOS
      DGETLI = OK
      RETURN
      END
<<< dofr5. >>>
$PROD DOFR5,,USL,NONE,NOLO,NO,MAP,NOBLK,DIRUL
$IFN %1=HELP,P/$GOTO NOHELP
$NOP
$NOP  ** COMPILE A FORTRAN MODULE AND PLACE OBJECT IN A UL LIBRARY.
$NOP  ** ARG 1 - NAME OF PROGRAM TO BE COMPILED
$NOP  ** ARG 2 - FILE CONTAINING PROGRAM (DEF. %2)
$NOP  ** ARG 3 - LIST OPTION FOR FR5 (DEF. %3)
$NOP  ** ARG 4 - LIST OPTION FOR M5A  (DEF. %4)
$NOP  ** ARG 5 - FILE TO BE USED FOR UL (DEF. %5)
$NOP  ** ARG 6 - IS EXTRA COMPILE OPTION (DEF. %6)
$NOP  ** ARG 7 - IS BLKD IF BLOCK DATA TO DELETE ALSO (DEF. %7)
$NOP  ** ARG 8 - IS DIRUL IF DIRECTORIZED UL (DEF. %8)
$NOP  ** EXAMPLE - $DOFR5 NAME,BSL,LO,,ULU
$NOP
$ENDDO
$TAG NOHELP
$IF %2=SI,7
$ASS USL %2
$IFM %1,5
$EXE SED
ASS SI USL
POS %1
EXI
$REW SO
$NOTE    COMPILING %1 FROM %2 TO %5
$IF %3=NONE,P/$EXE FR5,,NOLO,NOMAP,$23,$4E
$IFN %3=NONE,P/$EXE FR5,,%6,%3,$23,$4E
$WEO SO
$ASS SI SO BO SCA
$REW SI BO
$EXE M5A,,%4,NOSC
$WEO BO
$IF %5=NO,P/$GOTO NOUL
$IFN %8=DIRUL,P/$GOTO NODIR
$ASS SI SCA UL %5
$REW SI
$EXE LIB,,NOLO
REC %1
$IF %7=BLKD,P/REC B:%1
EXIT
$TAG NOUL
$ASS BI BI BO BO
$ENDDO
$TAG NODIR
$ASS SI SCA BI %5 BO SC
$REW BI BO SI
$EXE LIB,,NOLO
LNA
ADD 0
DEL %1
$IF %7=BLKD,P/DEL BLK:D
COP
ASS BI SC BO %5
REW BI BO
COP
EXI
$ASS BI BI BO BO
<<< dom5a. >>>
$PROD DOM5A,,USL,NOLO,NO,DIRUL
$IFN %1=HELP,P/$GOTO NOHELP
$NOP
$NOP  ** PROCEDURE TO ASSEMBLE A SOURCE MODULE AND PLACE
$NOP  ** IN AN OBJECT LIBRARY.
$NOP
$NOP  ** ARG 1 - NAME OF PROGRAM TO BE ASSEMBLED
$NOP  ** ARG 2 - FILE CONTAINING PROGRAM (DEF. %2)
$NOP  ** ARG 3 - LISTING OPTION FOR M5A (DEF. %3)
$NOP  ** ARG 4 - FILE TO BE USED FOR UL (DEF. %4)
$NOP  ** ARG 5 - UL FILE DIRECTORIZED FLAG (DEF.)%5)
$NOP
$NOP  ** EXAMPLE - $DOM5A,NAME,BSL,LO,ULU
$ENDDO
$TAG NOHELP
$ASS USL %2
$IFM %1,4
$EXE SED
 ASS SI USL
 POS %1
 EXI
$ASS  BO SCA
$REW  BO
$NOTE     ASSEMBLING %1 FROM %2 TO %4
$EXE M5A,,%3,NOSC
$WEO BO
$IFN %5=DIRUL,P/$GOTO NODIR
$ASS SI SCA UL %4
$REW SI
$EXE LIB,,NOLO
 REC %1
 EXIT
$ASS BI BI BO BO SI SI
$ENDDO
$TAG NODIR
$ASS SI SCA BI %4 BO SC
$REW BI BO SI
$EXE LIB,,NOLO
LNA
ADD 0
DEL %1
COP
ASS BI SC BO %4
REW BI BO
COP
EXI
$ASS BI BI BO BO
<<< dputch. >>>
      SUBROUTINE DPUTCH (XCHAR,CH)
C
C     ****************************************************************
C
C              KERMIT for the MODCOMP MAXIV operating system
C
C        Compliments of:
C
C                         SETPOINT, Inc.
C                      10245 Brecksville Rd.
C                      Brecksville, Ohio 44141
C
C
C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
C      of this version hereby grant permission to copy this software
C      provided that it is not used for an explicitly commercial
C      purpose and that proper credit be given. SETPOINT, Inc. makes
C      no warranty whatsoever regarding the accuracy of this package
C      and will assume no liability resulting from it's use.
C
C     ****************************************************************
C
C     Abstract: STUFFS CHARACTERS INTO ARRAY FOR OUTPUT UNTIL IT
C               REACHES A <CR> WHEN IT WRITES OUT THE LINE
C
C     MODIFICATION HISTORY
C
C     BY            DATE     REASON            PROGRAMS AFFECTED
C
C
C     ****************************************************************
C
C     Author: BOB BORGESON          Version:  A.0   Date: Oct-86
C
C     Calling Parameters:
C
C     R    XCHAR        - THE LATEST CHARACTER TO PUT IN ARRAY
C     R    CH           - UFT FOR THE DISK FILE
C
C     ****************************************************************
C
C     Messages generated by this module :  None
C
C     ****************************************************************
C
C     Subroutines called directly :  DPUTLI
C
C     ****************************************************************
C
C     Files referenced :  None
C
C     ****************************************************************
C
C     Local variable definitions :
C
C     ****************************************************************
C
C     Commons referenced :  KERPAR and XBYTE local commons
C
C     ****************************************************************
C
C     (*$END.DOCUMENT*)
C
C     ****************************************************************
C     *                                                              *
C     *         D I M E N S I O N   S T A T E M E N T S              *
C     *                                                              *
C     ****************************************************************
C
      IMPLICIT INTEGER (A-Z)
C
C     ****************************************************************
C     *                                                              *
C     *         T Y P E   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         C O M M O N   S T A T E M E N T S                    *
C     *                                                              *
C     ****************************************************************
C
      INCLUDE USL/KERPMC
C
      COMMON /XBYTE/ XNEW,XCOUNT,XLIN(132),XEOF
C
C     ****************************************************************
C     *                                                              *
C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         D A T A   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C
C     Code starts here :
C
      IF(XCHAR.NE.CR)GO TO 100
         XLIN(XCOUNT)=LF
         XLIN(XCOUNT+1)=EOS
         CALL DPUTLIN(XLIN,CH)
         XCOUNT=1
         RETURN
  100 CONTINUE
          XLIN(XCOUNT)=XCHAR
          XCOUNT=XCOUNT+1
      RETURN
      END
<<< dputli. >>>
      SUBROUTINE DPUTLI (ALIN,CH)
C
C     ****************************************************************
C
C              KERMIT for the MODCOMP MAXIV operating system
C
C        Compliments of:
C
C                         SETPOINT, Inc.
C                      10245 Brecksville Rd.
C                      Brecksville, Ohio 44141
C
C
C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
C      of this version hereby grant permission to copy this software
C      provided that it is not used for an explicitly commercial
C      purpose and that proper credit be given. SETPOINT, Inc. makes
C      no warranty whatsoever regarding the accuracy of this package
C      and will assume no liability resulting from it's use.
C
C     ****************************************************************
C
C     Abstract:  Write ALIN to a disk file.
C
C     MODIFICATION HISTORY
C
C     BY            DATE     REASON            PROGRAMS AFFECTED
C
C     ****************************************************************
C
C     Author: BOB BORGESON          Version: A.0    Date: Oct-86
C
C     Calling Parameters:
C
C     R    ALIN         - Unpacked input line to be written to disk
C     R    CH           - This argument is unused, but is kept for
C                         compatibility purposes
C
C     ****************************************************************
C
C     Messages generated by this module :  None
C
C     ****************************************************************
C
C     Subroutines called directly :  CMW4, PACK
C
C     ****************************************************************
C
C     Files referenced :  None
C
C     ****************************************************************
C
C     Local variable definitions :
C
C     I            - Index variable
C     CLIN(65)     - Uncompress, packed ASCII array to be written
C
C     ****************************************************************
C
C     Commons referenced :  None
C
C     ****************************************************************
C
C     (*$END.DOCUMENT*)
C
C     ****************************************************************
C     *                                                              *
C     *         D I M E N S I O N   S T A T E M E N T S              *
C     *                                                              *
C     ****************************************************************
C
      IMPLICIT INTEGER (A-Z)
      INTEGER*2   ALIN(132),   CLIN(65)
C
C     ****************************************************************
C     *                                                              *
C     *         T Y P E   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         C O M M O N   S T A T E M E N T S                    *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         D A T A   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C
C     Code starts here :
C
      DO 10 I=1,65
      CLIN(I) = 4Z2020
   10 CONTINUE
      CALL PACK (ALIN,CLIN)
      CALL CMW4 (CLIN)
      RETURN
      END
<<< findln. >>>
      INTEGER FUNCTION FINDLN (LIN,APAT,A1,Z1)
C
C     ****************************************************************
C
C              KERMIT for the MODCOMP MAXIV operating system
C
C        Compliments of:
C
C                         SETPOINT, Inc.
C                      10245 Brecksville Rd.
C                      Brecksville, Ohio 44141
C
C
C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
C      of this version hereby grant permission to copy this software
C      provided that it is not used for an explicitly commercial
C      purpose and that proper credit be given. SETPOINT, Inc. makes
C      no warranty whatsoever regarding the accuracy of this package
C      and will assume no liability resulting from it's use.
C
C     ****************************************************************
C
C     Abstract:  This function will try to find the pattern within
C                a line.  It alse returns the value of where the
C                pattern begins and ends.
C
C     MODIFICATION HISTORY
C
C     BY            DATE     REASON            PROGRAMS AFFECTED
C
C     ****************************************************************
C
C     Author: Bob Borgeson          Version: A.0    Date: Aug-86
C
C     Calling Parameters:
C
C     R    LIN          - Array that holds the line to search
C     R    APAT         - Array that holds the pattern to search for
C     R/W  A1           - Initially tells this routine where to start
C                         looking for a match.  On return it tells the
C                         caller where the matched pattern begins.
C     W    Z1           - Tells the calling program where the matched
C                         pattern ends. EOS is not counted in the Z1
C                         value.
C     W    FINDLN       - Function value, = YES, pattern was found,
C                         = NO, pattern was not found.
C
C     ****************************************************************
C
C     Messages generated by this module :  None
C
C     ****************************************************************
C
C     Subroutines called directly : None
C
C     ****************************************************************
C
C     Files referenced :  None
C
C     ****************************************************************
C
C     Local variable definitions :
C
C     ****************************************************************
C
C     Commons referenced : KERPAR local common
C
C     ****************************************************************
C
C     (*$END.DOCUMENT*)
C
C     ****************************************************************
C     *                                                              *
C     *         D I M E N S I O N   S T A T E M E N T S              *
C     *                                                              *
C     ****************************************************************
C
      IMPLICIT INTEGER (A-Z)
      INTEGER   LIN(1),      APAT(1)
C
C     ****************************************************************
C     *                                                              *
C     *         T Y P E   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         C O M M O N   S T A T E M E N T S                    *
C     *                                                              *
C     ****************************************************************
C
      INCLUDE USL/KERPMC
C
C     ****************************************************************
C     *                                                              *
C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         D A T A   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C
C     Code starts here :
C
C----->  Assume no match will be found.
C
      FINDLN = NO
      T1=A1
C
C----->  Loop to find the next character in the command line
C----->  that matches the first character in the pattern.
C
   10 CONTINUE
      IF (LIN(T1) .EQ. APAT(1) .OR.
     >    LIN(T1) .EQ.     EOS     ) GO TO 20
      T1 = T1 + 1
      GO TO 10
   20 CONTINUE
C
C----->  If we found the end of the command line then
C----->  no match was found, so return to caller.
C
      IF (LIN(T1) .EQ. EOS) RETURN
C
C----->  We found a possible match, so loop through and compare
C----->  the next characters until a mismatch is found or the
C----->  pattern ends.
C
      A1 = T1
      T2 = 1
      T3 = T1
   30 CONTINUE
      IF (APAT(T2) .NE. LIN(T1) .OR.
     >    APAT(T2) .EQ.     EOS     ) GO TO 40
      T1 = T1 + 1
      T2 = T2 + 1
      GO TO 30
   40 CONTINUE
C
C----->  If the pattern is ended, then we have found a match,
C----->  if not go back and continue looking.
C
      IF (APAT(T2) .EQ. EOS) GO TO 50
      T1 = T3 + 1
      GO TO 10
   50 CONTINUE
      Z1 = T1 - 1
      FINDLN = YES
      RETURN
      END
<<< fxfile. >>>
      SUBROUTINE FXFILE(INNAM,OUTNAM,NCHRFX,IND)
C
C     ****************************************************************
C
C              KERMIT for the MODCOMP MAXIV operating system
C
C        Compliments of:
C
C                         SETPOINT, Inc.
C                      10245 Brecksville Rd.
C                      Brecksville, Ohio 44141
C
C
C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
C      of this version hereby grant permission to copy this software
C      provided that it is not used for an explicitly commercial
C      purpose and that proper credit be given. SETPOINT, Inc. makes
C      no warranty whatsoever regarding the accuracy of this package
C      and will assume no liability resulting from it's use.
C
C     ****************************************************************
C
C     Abstract: FXFILE TRUNCATES THE FILE TO 8 CHARACTERS AND
C               REPLACES ANY NON CAN-CODABLE CHARACTER WITH A "$".
C
C     MODIFICATION HISTORY
C
C     BY            DATE     REASON            PROGRAMS AFFECTED
C
C     ****************************************************************
C
C     Author: BOB BORGESON          Version: A.0    Date: Oct-86
C
C     Calling Parameters:
C
C     R    INNAM   - UNPACKED NAME TO BE FIXED
C     W    OUTNAM  - UNPACKED FIXED FILE NAME
C     R    NCHRFX  - # OF CHARACTERS TO CHECK (MAX = 8)
C     W    IND     - THE # OF CHARACTERS CONVERTED TO $
C
C     ****************************************************************
C
C     Messages generated by this module :  None
C
C     ****************************************************************
C
C     Subroutines called directly : None
C
C     ****************************************************************
C
C     Files referenced :  None
C
C
C     ****************************************************************
C
C     Local variable definitions :
C
C      CHAR - FLAG INDICATES AT LEAST 1 CHARACTER FOUND
C
C     ****************************************************************
C
C     Commons referenced : KER local common
C
C     ****************************************************************
C
C     (*$END.DOCUMENT*)
C
C     ****************************************************************
C     *                                                              *
C     *         D I M E N S I O N   S T A T E M E N T S              *
C     *                                                              *
C     ****************************************************************
C
      IMPLICIT INTEGER (A-Z)
C
      INTEGER*2   INNAM(1),    OUTNAM(1)
C
C     ****************************************************************
C     *                                                              *
C     *         T Y P E   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C     ****************************************************************
C     *                                                              *
C     *         C O M M O N   S T A T E M E N T S                    *
C     *                                                              *
C     ****************************************************************
C
      INCLUDE USL/KERCOM
      INCLUDE USL/KERPMC
C
C     ****************************************************************
C     *                                                              *
C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         D A T A   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C
C     Code starts here :
C
      IND = 0
C
C                             FILL OUTNAM WITH BLANKS
C
      DO 100 I = 1,8
C
        OUTNAM(I) = 4Z0020
C
  100 CONTINUE
C
C                             CHECK FOR CAN CODE CHARCTERS AND
C                             REPLACE NASTY ONES WITH "$"
C
      CHAR = 0
C
      IF(NCHRFX .GT. 8)NCHRFX = 8
C
      NCRFX1 = NCHRFX + 1
C
      DO 1000 J = 1,NCHRFX
C
        I = NCRFX1 - J
C
        IF((INNAM(I) .EQ. BLANK) .AND. (CHAR .EQ. 0))GO TO 300
C
        IF(((INNAM(I) .GE. BIGA) .AND. (INNAM(I) .LE. BIGZ)) .OR.
     >     ((INNAM(I) .GE. DIG0) .AND. (INNAM(I) .LE. DIG9)) .OR.
     >      (INNAM(I) .EQ. COLON)                            .OR.
     >      (INNAM(I) .EQ. PERIOD)                           .OR.
     >      (INNAM(I) .EQ. DOLLAR))GO TO 200
C
        OUTNAM(I) = DOLLAR
        IND = IND + 1
        CHAR = 1
C
        GO TO 1000
C
  200   CONTINUE
C
        OUTNAM(I) = INNAM(I)
        CHAR = 1
        GO TO 1000
C
  300   CONTINUE
C
        OUTNAM(I) = INNAM(I)
C
 1000 CONTINUE
C
 1100 CONTINUE
C
      RETURN
      END
<<< getlin. >>>
      INTEGER FUNCTION GETLIN (ALIN,CH)
C
C     ****************************************************************
C
C              KERMIT for the MODCOMP MAXIV operating system
C
C        Compliments of:
C
C                         SETPOINT, Inc.
C                      10245 Brecksville Rd.
C                      Brecksville, Ohio 44141
C
C
C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
C      of this version hereby grant permission to copy this software
C      provided that it is not used for an explicitly commercial
C      purpose and that proper credit be given. SETPOINT, Inc. makes
C      no warranty whatsoever regarding the accuracy of this package
C      and will assume no liability resulting from it's use.
C
C     ****************************************************************
C
C     Abstract:  Read a line from the specified UFT and unpack the
C                bytes.
C
C     MODIFICATION HISTORY
C
C     BY            DATE     REASON            PROGRAMS AFFECTED
C
C     ****************************************************************
C
C     Author:  Rick Burke           Version: A.0    Date: Aug-86
C
C     Calling Parameters:
C
C     W    ALIN         - Line of input data to return to caller
C                         Each word contains 1 byte of data, right
C                         justified in the word.
C     R    CH           - UFT number to use for the read;
C                         2 = user's terminal
C
C     ****************************************************************
C
C     Messages generated by this module :  None
C
C     ****************************************************************
C
C     Subroutines called directly :  IAND, ISHFT, READ4, WAIT
C
C     ****************************************************************
C
C     Files referenced :  None
C
C     ****************************************************************
C
C     Local variable definitions :
C
C     ACOUNT       - Index counter for ALIN array.
C     BCOUNT       - Index counter for BLIN array.
C     I            - Index variable
C     LEFT         - Flag to indicate that the left byte should be
C                    processed
C     MAXTRY       - # OF TIMES TO WAIT BEFORE TIMEOUT
C     MLEFT        - Mask to extract the left byte of a word
C     MRIGHT       - Mask to extract the right byte of a word
C     NSCH         - UFT # FOR BINARY READ
C     RIGHT        - Flag to indicate that the right byte should be
C                    processed
C     TRYTIM       - MAGNITUDE OF WAIT
C     TRYUNT       - TIME UNIT FOR WAIT (SECONDS,TICKS, ETC)
C     TV1          - Temporary variable
C     TV2          - Temporary variable
C     WHICHS       - Flag for which byte to extract
C     BLIN(132)    - Input line read from I/O device which is to
C                    be unpacked
C     LEOL         - OUR EOL CHAR SHIFTED TO MSB
C     UEOL         - BIT MASK CHOSEN TO SEARCH FOR EOL
C     OLDCHN       - STORAGE FOR OLD READ #
C     IPNT         - POINTER TO WORD WHERE WE EXPECT EOL
C     NTFLO        - # OF CHAR TO FOLLOW (SECOND BYTE OF PACKET)
C     TIMED        - FLAG FOR READ HAS TIMED OUT (IF = 1)
C
C     ****************************************************************
C
C     Commons referenced :  KERPAR and UFTTBL local commons
C
C     ****************************************************************
C
C     (*$END.DOCUMENT*)
C
C     ****************************************************************
C     *                                                              *
C     *         D I M E N S I O N   S T A T E M E N T S              *
C     *                                                              *
C     ****************************************************************
C
      IMPLICIT INTEGER (A-Z)
      INTEGER*2   ALIN(1)
C
C     ****************************************************************
C     *                                                              *
C     *         T Y P E   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         C O M M O N   S T A T E M E N T S                    *
C     *                                                              *
C     ****************************************************************
C
      INCLUDE USL/KERCOM
C
      INCLUDE USL/KERPMC
C
      INCLUDE USL/UFTTBC
C
C     ****************************************************************
C     *                                                              *
C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         D A T A   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
      DATA        MLEFT /ZFF00/,            MRIGHT /Z00FF/
     >          , TRYTIM / 200 /
     >          , TRYUNT/ 1 /  ,            NSCH  / 10 /
C
C     ****************************************************************
C
C     Code starts here :
C
C----->  Initialize the line buffers.
C
      DO 10 I=1,132
      ALIN(I) = 0
   10 CONTINUE
C
C----->  Initialize some local variables.
C
      LEFT = 1
      RIGHT = 2
      WHICHS = LEFT
      ACOUNT = 1
      BCOUNT = 1
      LEOL = ISHFT(EOL,8)
      TIMED = 0
C
C---->    ALL INPUT IS ON UFT 4
C
      UFT = 4
C
C----->  Get the input line and check for an EOF event.
C
      DO 1000 I = 1,20
C
C----->        IF NO CHARACTERS HAVE BEEN READ , LOOP
C
        IF(IAND(IUFT(1,UFT),8) .NE. 0)GO TO 950
C
C----->        GET # OF CHARACTERS TO FOLLOW IN PACKET + EOL
C
        NTFLO = UNCHAR(IAND(BLIN(1,CURCHN),MRIGHT)) + 1
        IF(NTFLO .EQ. -31)GO TO 950
C
C----->        CHOOSE BITMASK TO LOOK FOR EOL
C
        UEOL = LEOL
        IF(MOD(NTFLO,2).EQ.0)UEOL = EOL
C
C----->        CALCULATE WHICH WORD EOL SHOULD BE IN
C
        IPNT = (NTFLO + 1) / 2 + 1
C
        IF(IAND(BLIN(IPNT,CURCHN),UEOL) .EQ. UEOL)GO TO 15
C
C----->        PACKET IS NOT THERE (OR NOT COMPLETE) SO WAIT
C
  950   CONTINUE
C
        CALL WAIT(TRYTIM,TRYUNT,IND)
C
 1000 CONTINUE
C
C----->        WE HAVE TIMED OUT
C
      GETLIN = BAD
      TIMED = 1
      GO TO 1800
C
   15 CONTINUE
C
C----->        GOT A PACKET !!!
C
C
C     IF (IAND (IUFT(1,UFT),4Z0020) .NE. 0) GO TO 100
C
C----->       START NEW READ, TERMINATE OLD, AND UNPACK
C
C
 1800 CONTINUE
C
      IF(CURCHN .NE. 1)GO TO 2000
C
        DO 1900 I = 132
C
          BLIN(I,2) = 0
C
 1900   CONTINUE
C
        CALL TERMIN (IUFT(1,UFT),.FALSE.)
        CALL READ4(IUFT(1,UFT),BLIN(1,2),132,.FALSE.)
        OLDCHN = CURCHN
        CURCHN = 2
        IF(TIMED .EQ. 1)RETURN
        GO TO 20
C
 2000 CONTINUE
C
        DO 2100 I = 1,132
C
          BLIN(I,1) = 0
C
 2100   CONTINUE
        CALL TERMIN (IUFT(1,UFT),.FALSE.)
        CALL READ4(IUFT(1,UFT),BLIN(1,1),132,.FALSE.)
        OLDCHN = CURCHN
        CURCHN = 1
        IF(TIMED .EQ. 1)RETURN
C
C----->  Unpack the input line.
C
   20 CONTINUE
      IF (WHICHS .NE. RIGHT) GO TO 40
C
C----->  Move a char in the right byte of BLIN to a word in ALIN,
C----->  unless we are finished processing the input line.
C
      TV1 = IAND (BLIN(BCOUNT,OLDCHN),MRIGHT)
      IF (TV1 .NE. 0) GO TO 30
      ALIN(ACOUNT) = LF
      ALIN(ACOUNT+1) = EOS
      GETLIN = OK
      RETURN
   30 CONTINUE
      ALIN(ACOUNT) = TV1
      ACOUNT = ACOUNT + 1
      BCOUNT = BCOUNT + 1
      WHICHS = LEFT
   40 CONTINUE
C
C----->  Move a char in the left byte of BLIN to a word in ALIN,
C----->  unless we are finished processing the input line.
C
      TV1 = IAND (BLIN(BCOUNT,OLDCHN),MLEFT)
      TV2 = ISHFT (TV1,-8)
      IF (TV2 .NE. 0) GO TO 50
      ALIN(ACOUNT) = LF
      ALIN(ACOUNT+1) = EOS
      GETLIN = OK
      RETURN
   50 CONTINUE
      ALIN(ACOUNT) = TV2
      WHICHS = RIGHT
      ACOUNT = ACOUNT + 1
   60 CONTINUE
      GO TO 20
  100 CONTINUE
      GETLIN = EOF
      RETURN
      END
<<< kercmp. >>>
$PROC KERCMP
$FR5ULC BUFEMP,KER
$FR5ULC BUFILL,KER
$FR5ULC CTL,KER
$FR5ULC CTOI,KER
$FR5ULC DGETCH,KER
$FR5ULC DGETLI,KER
$FR5ULC DPUTCH,KER
$FR5ULC DPUTLIN,KER
$FR5ULC FINDLN,KER
$FR5ULC GETLIN,KER
$FR5ULC IBMGETLI,KER
$FR5ULC PACK,KER
$FR5ULC PARSER,KER
$M5AUL POSUSL,KER,NOLO,ULC
$FR5ULC PUTLIN,KER
$FR5ULC RDATA,KER
$FR5ULC RECSW,KER
$FR5ULC RFILE,KER
$FR5ULC RINIT,KER
$FR5ULC RPACK,KER
$FR5ULC RPAR,KER
$FR5ULC SBREAK,KER
$FR5ULC SCOPY,KER
$FR5ULC SDATA,KER
$FR5ULC SDUMMY,KER
$FR5ULC SENDSW,KER
$FR5ULC SEOF,KER
$FR5ULC SFILE,KER
$FR5ULC SHELP,KER
$FR5ULC SINIT,KER
$FR5ULC SKIPBL,KER
$FR5ULC SPACK,KER
$FR5ULC SPAR,KER
$FR5ULC SRECEIVE,KER
$FR5ULC SSEND,KER
$FR5ULC SSET,KER
$FR5ULC SSTATUS,KER
$FR5ULC SQUIT,KER
$FR5ULC TOCHAR,KER
$FR5ULC TGETCH,KER
$FR5ULC TPUTCH,KER
$FR5ULC UFTINI,KER
$FR5ULC UNCHAR,KER
$FR5ULC UPPER,KER
$FR5ULC XDELAY,KER
$CLTOC KERMIT KER LMU
<<< kercom. >>>
C
C----->  Kermit local common
C
      COMMON /KER/ DELAY,      EOL,         ESCHAR,      FD,
     >             FILNAM(132),HOSTON,      IBMON,       LOCALI,
     >             LOCALO,     LOCALS,      MAXTRY,      MOREFD,
     >             MYEOL,      MYPAD,       MYPCHA,      MYQUOT,
     >             N,          NUMTRY,      OLDTRY,      PACKET(132),
     >             PAD,        PADCHA,      PAKSIZ,      PARITY,
     >             PROMPT,     QUOTE,       RECPKT(132), RMTINFD,
     >             RMTOUT,     RMTTTY(132), RPSIZ,       SBAUD,
     >             SIZE,       SOH,         SPARITY,     SPEED,
     >             SPORT,      SPSIZ,       STATE,       SUSL
<<< kerdef. >>>
C     DEFINES VARIOUS CONSTANTS FOR THE KERMIT-HP1000 PROGRAM
      PARAMETER (ATSIGN=64)
      PARAMETER (BACKSLASH=92)
      PARAMETER (BACKSPACE=8)
      PARAMETER (BAD=-3)
      PARAMETER (BANG=33)
      PARAMETER (BAR=124)
      PARAMETER (BIGA=65)
      PARAMETER (BIGB=66)
      PARAMETER (BIGC=67)
      PARAMETER (BIGD=68)
      PARAMETER (BIGE=69)
      PARAMETER (BIGF=70)
      PARAMETER (BIGG=71)
      PARAMETER (BIGH=72)
      PARAMETER (BIGI=73)
      PARAMETER (BIGJ=74)
      PARAMETER (BIGK=75)
      PARAMETER (BIGL=76)
      PARAMETER (BIGM=77)
      PARAMETER (BIGN=78)
      PARAMETER (BIGO=79)
      PARAMETER (BIGP=80)
      PARAMETER (BIGQ=81)
      PARAMETER (BIGR=82)
      PARAMETER (BIGS=83)
      PARAMETER (BIGT=84)
      PARAMETER (BIGU=85)
      PARAMETER (BIGV=86)
      PARAMETER (BIGW=87)
      PARAMETER (BIGX=88)
      PARAMETER (BIGY=89)
      PARAMETER (BIGZ=90)
      PARAMETER (BLANK=32)
      PARAMETER (CARET=94)
      PARAMETER (COLON=58)
      PARAMETER (COMMA=44)
      PARAMETER (CR=13)
      PARAMETER (DEL=127)
      PARAMETER (DIG0=48)
      PARAMETER (DIG1=49)
      PARAMETER (DIG2=50)
      PARAMETER (DIG3=51)
      PARAMETER (DIG4=52)
      PARAMETER (DIG5=53)
      PARAMETER (DIG6=54)
      PARAMETER (DIG7=55)
      PARAMETER (DIG8=56)
      PARAMETER (DIG9=57)
      PARAMETER (DIGIT=2)
      PARAMETER (DOLLAR=36)
      PARAMETER (DQUOTE=34)
      PARAMETER (EOF=10003)
      PARAMETER (EOS=10002)
      PARAMETER (HUGE=30000)
      PARAMETER (LETA=97)
      PARAMETER (LETB=98)
      PARAMETER (LETC=99)
      PARAMETER (LETD=100)
      PARAMETER (LETE=101)
      PARAMETER (LETF=102)
      PARAMETER (LETG=103)
      PARAMETER (LETH=104)
      PARAMETER (LETI=105)
      PARAMETER (LETJ=106)
      PARAMETER (LETK=107)
      PARAMETER (LETL=108)
      PARAMETER (LETM=109)
      PARAMETER (LETN=110)
      PARAMETER (LETO=111)
      PARAMETER (LETP=112)
      PARAMETER (LETQ=113)
      PARAMETER (LETR=114)
      PARAMETER (LETS=115)
      PARAMETER (LETT=116)
      PARAMETER (LETU=117)
      PARAMETER (LETV=118)
      PARAMETER (LETW=119)
      PARAMETER (LETX=120)
      PARAMETER (LETY=121)
      PARAMETER (LETZ=122)
      PARAMETER (LF=10)
      PARAMETER (NO=0)
      PARAMETER (OK=-2)
      PARAMETER (PERCENT=37)
      PARAMETER (PERIOD=46)
      PARAMETER (PLUS=43)
      PARAMETER (QMARK=63)
      PARAMETER (SEMICOL=59)
      PARAMETER (SHARP=35)
      PARAMETER (SLASH=47)
      PARAMETER (SQUOTE=39)
      PARAMETER (STAR=42)
      PARAMETER (STDOUT=1)
      PARAMETER (TAB=9)
      PARAMETER (TILDE=126)
      PARAMETER (UNDERLINE=95)
      PARAMETER (YES=1)
<<< kermit. >>>
      PROGRAM KERMIT
C
C     ****************************************************************
C
C              KERMIT for the MODCOMP MAXIV operating system
C
C        Compliments of:
C
C                         SETPOINT, Inc.
C                      10245 Brecksville Rd.
C                      Brecksville, Ohio 44141
C
C
C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
C      of this version hereby grant permission to copy this software
C      provided that it is not used for an explicitly commercial
C      purpose and that proper credit be given. SETPOINT, Inc. makes
C      no warranty whatsoever regarding the accuracy of this package
C      and will assume no liability resulting from it's use.
C
C
C     ****************************************************************
C
C     Abstract:  Kermit communications program for MODCOMP Classic
C                running MAX IV.  This program and all subroutines
C                were adapted from a version written by John Lee
C                of RCA Laboratories.  It was originally written in
C                FORTRAN 77 for an HP-1000 running RTE-6/VM.  The
C                bulk of the conversion effort related to removing
C                the FORTRAN 77 logic constructs, replacing the
C                RTE system calls with MAX IV system calls, and
C                modification of the data file I/O to conform to
C                the requirements of MAX IV.
C
C     MODIFICATION HISTORY
C
C     BY            DATE     REASON
C
C     ****************************************************************
C
C     Author:   Rick Burke             Version: A.0    Date: Aug-86
C
C     ****************************************************************
C
C     Messages generated by this module :  None
C
C     ****************************************************************
C
C     Subroutines called directly :  EXIT, PARSER, UFTINI
C
C     ****************************************************************
C
C     Files referenced :  None
C
C     ****************************************************************
C
C     Local variable definitions :
C
C     DELAY        - # of seconds waited before sending out the first
C                    SINIT packet (only in remote mode).
C     EOL          - End-of-line delimiter required by other Kermits.
C     ESCHAR       - The character used to return back to command parser
C                    from "chat" mode.
C     FILNAM(132)  - The integer array which holds the current working
C                    file name.
C     HOSTON       - Identifies whether this Kermit is running in local
C                    or "chat" mode.
C     LOCALI       - Local (TTY) input channel (login line)
C     LOCALO       - Local (TTY) output channel (login line)
C     MAXTRY       - Maximum number of retries before giving up
C     MYEOL        - The end-of-line delimiter selectable by users
C     MYPAD        - The # of pad characters required by this Kermit
C     MYPCHA       - The pad character required by this Kermit
C     MYQUOT       - The quote used for control-S by this Kermit
C                    This is selectable by the user
C     N            - The number of the current packet frame number
C     NUMTRY       - The number of retry attempts so far
C     OLDTRY       - The number of retries already attempted
C     PACKET(132)  - An integer array to hold the content of a packet
C     PAD          - The # of pad characters required by other Kermit
C     PADCHA       - The pad character to use, if required by other
C                    Kermit
C     PAKSIZ       - The maximum packet size selectable by users
C     PARITY       - One of five parity modes used in sending and
C                    receiving data (local mode only).  Only ODD,
C                    EVEN, and NONE are implemented.
C     PROMPT       - The turnaround control character this Kermit looks
C                    for in file transfer with IBM.
C     QUOTE        - The quote character used for control character used
C                    by the other Kermit.
C     RECPKT(132)  - An integer array which holds the imcoming packet
C     RMTINF       - The remote input channel
C     RMTOUT       - The remote output channel
C     RPSIZ        - Maximum size of packet to be received.
C     SBAUD        - Whether this system supports baud switching
C     SIZE         - Maximum size of data packet to be sent
C     SOH          - The start of header used in sending packet;
C                    selectable by the user
C     SPARIT       - Whether this system supports parity switching
C     SPEED        - Baud rate of the remote TTY line
C     SPORT        - Whether this system supports remote line switching
C     SPSIZ        - Maximum size of packet to be used for sending
C     STATE        - Current state of the file transfer process
C
C     ****************************************************************
C
C     Commons referenced :  KER and KERPAR local commons
C
C     ****************************************************************
C
C     (*$END.DOCUMENT*)
C
C     ****************************************************************
C     *                                                              *
C     *         D I M E N S I O N   S T A T E M E N T S              *
C     *                                                              *
C     ****************************************************************
C
      IMPLICIT INTEGER (A-Z)
      INTEGER*2   ALIN(132),   BLIN(132)
C
C     ****************************************************************
C     *                                                              *
C     *         T Y P E   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         C O M M O N   S T A T E M E N T S                    *
C     *                                                              *
C     ****************************************************************
C
      INCLUDE USL/KERCOM
      INCLUDE USL/KERPMC
C
C     ****************************************************************
C     *                                                              *
C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         D A T A   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C
C     Code starts here :
C
C----->  Set default parameters.
C
      DELAY = 10
      EOL = 13
      ESCHAR = 29
      IBMON = NO
      QUOTE = 35
      SOH = 1
      SPEED = 9600
      STATE = BIGC
C
      MAXTRY = 5
      MYEOL = 13
      MYPAD = 0
      MYPCHAR = 0
      MYQUOTE = 35
      PAD = 0
      PADCHAR = 0
      PAKSIZ  = 90
C
C----->  1=EVEN, 2=ODD 3=SPACE 4=MARK 5=NONE
C----->  MARK and SPACE not currently implemented.
C
      PARITY = 5
C
C----->  DC1, IBM mode only.
C
      PROMPT = 17
C
C----->  Disable all I/O port modifications.
C
      SPARITY = NO
      SBAUD = NO
      SPORT = NO
C
C----->  Initialize the UFTs.
C
      CALL UFTINI
C
C----->  Initialize UFT numbers for local terminal & Kermit I/O.
C
      LOCALO = 3@KE1
      LOCALI = 3@KE2
      RMTINF = 4
      RMTOUT = 3
C
C----->  Set default USL to current USL.
C
      SUSL = 3@USL
C
      WRITE (LOCALO,99)
      CALL PARSER
      CALL EXIT
   99 FORMAT(' MAX IV KERMIT VERSION 1.0')
      END
      BLOCK DATA
      IMPLICIT INTEGER (A-Z)
      INCLUDE USL/KERPMC
      INCLUDE USL/KERPMD
      END
<<< kermiv. >>>
$PROD KERMIV,CO,OC
$ASS KE1=CO KE2=OC KE3=%1 KE4=%2
$ASS KE5=SCB KE8=SCA KE9=SC KEH=BSL
$EXE KERMIT LMU
$WEO LO
$REW KE9
$ASS JC KE9
$STORE
$ASS JC JC
$ENDDO
<<< kerpmc. >>>
      COMMON /KERPAR/          ATSIGN,      BACKSL,      BACKSP,
     >            BAD,         BANG,        BAR,         BIGA,
     >            BIGB,        BIGC,        BIGD,        BIGE,
     >            BIGF,        BIGG,        BIGH,        BIGI,
     >            BIGJ,        BIGK,        BIGL,        BIGM,
     >            BIGN,        BIGO,        BIGP,        BIGQ,
     >            BIGR,        BIGS,        BIGT,        BIGU,
     >            BIGV,        BIGW,        BIGX,        BIGY,
     >            BIGZ,        BLANK,       CARET,       COLON,
     >            COMMA,       CR,          DEL,         DIG0,
     >            DIG1,        DIG2,        DIG3,        DIG4,
     >            DIG5,        DIG6,        DIG7,        DIG8,
     >            DIG9,        DIGIT,       DOLLAR,      DQUOTE,
     >            EOF,         EOS,         HUGE,        LETA,
     >            LETB,        LETC,        LETD,        LETE,
     >            LETF,        LETG,        LETH,        LETI,
     >            LETJ,        LETK,        LETL,        LETM,
     >            LETN,        LETO,        LETP,        LETQ,
     >            LETR,        LETS,        LETT,        LETU,
     >            LETV,        LETW,        LETX,        LETY,
     >            LETZ,        LF,          NO,          OK,
     >            PERCEN,      PERIOD,      PLUS,        QMARK,
     >            SEMICO,      SHARP,       SLASH,       SQUOTE,
     >            STAR,        STDOUT,      TAB,         TILDE,
     >            UNDERL,      YES
<<< kerpmd. >>>
C
C----->  Block data initialization for Kermit Parameters.
C
      DATA        ATSIGN /   64/,           BACKSL /   92/,
     >            BACKSP /    8/,           BAD    /   -3/,
     >            BANG   /   33/,           BAR    /  124/,
     >            BIGA   /   65/,           BIGB   /   66/,
     >            BIGC   /   67/,           BIGD   /   68/,
     >            BIGE   /   69/,           BIGF   /   70/,
     >            BIGG   /   71/,           BIGH   /   72/,
     >            BIGI   /   73/,           BIGJ   /   74/,
     >            BIGK   /   75/,           BIGL   /   76/,
     >            BIGM   /   77/,           BIGN   /   78/,
     >            BIGO   /   79/,           BIGP   /   80/,
     >            BIGQ   /   81/,           BIGR   /   82/,
     >            BIGS   /   83/,           BIGT   /   84/,
     >            BIGU   /   85/,           BIGV   /   86/,
     >            BIGW   /   87/,           BIGX   /   88/,
     >            BIGY   /   89/,           BIGZ   /   90/,
     >            BLANK  /   32/,           CARET  /   94/,
     >            COLON  /   58/,           COMMA  /   44/,
     >            CR     /   13/,           DEL    /  127/,
     >            DIG0   /   48/,           DIG1   /   49/,
     >            DIG2   /   50/,           DIG3   /   51/,
     >            DIG4   /   52/,           DIG5   /   53/,
     >            DIG6   /   54/,           DIG7   /   55/,
     >            DIG8   /   56/,           DIG9   /   57/,
     >            DIGIT  /    2/,           DOLLAR /   36/,
     >            DQUOTE /   34/,           EOF    /10003/,
     >            EOS    /10002/,           HUGE   /30000/,
     >            LETA   /   97/,           LETB   /   98/,
     >            LETC   /   99/,           LETD   /  100/,
     >            LETE   /  101/,           LETF   /  102/,
     >            LETG   /  103/,           LETH   /  104/,
     >            LETI   /  105/,           LETJ   /  106/,
     >            LETK   /  107/,           LETL   /  108/,
     >            LETM   /  109/,           LETN   /  110/,
     >            LETO   /  111/,           LETP   /  112/,
     >            LETQ   /  113/,           LETR   /  114/,
     >            LETS   /  115/,           LETT   /  116/,
     >            LETU   /  117/,           LETV   /  118/,
     >            LETW   /  119/,           LETX   /  120/,
     >            LETY   /  121/,           LETZ   /  122/,
     >            LF     /   10/,           NO     /    0/,
     >            OK     /   -2/,           PERCEN /   37/,
     >            PERIOD /   46/,           PLUS   /   43/,
     >            QMARK  /   63/,           SEMICO /   59/,
     >            SHARP  /   35/,           SLASH  /   47/,
     >            SQUOTE /   39/,           STAR   /   42/,
     >            STDOUT /    1/,           TAB    /    9/,
     >            TILDE  /  126/,           UNDERL /   95/,
     >            YES    /    1/
<<< lckermit. >>>
$PRODEFAULT LCKERMIT,NOM
$ASS BI ULC UL ULC
$LINK KERMIT,%1,ONE,2,,,,,,,,,,,,,,BLKD
$ASS BI BO
$REW BI BO
$TOCCAT KERMIT,LMU,OVER
$ENDDO
<<< pack. >>>
      SUBROUTINE PACK (ALIN,BLIN)
C
C     ****************************************************************
C
C              KERMIT for the MODCOMP MAXIV operating system
C
C        Compliments of:
C
C                         SETPOINT, Inc.
C                      10245 Brecksville Rd.
C                      Brecksville, Ohio 44141
C
C
C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
C      of this version hereby grant permission to copy this software
C      provided that it is not used for an explicitly commercial
C      purpose and that proper credit be given. SETPOINT, Inc. makes
C      no warranty whatsoever regarding the accuracy of this package
C      and will assume no liability resulting from it's use.
C
C     ****************************************************************
C
C     Abstract:  Pack the INTEGER array ALIN into the array BLIN
C                with the right side of the byte ending with a
C                BLANK, in case there are an odd number of bytes.
C
C     MODIFICATION HISTORY
C
C     BY            DATE     REASON            PROGRAMS AFFECTED
C
C     ****************************************************************
C
C     Author:  Rick Burke           Version: A.0    Date: Aug-86
C
C     Calling Parameters:
C
C     R    ALIN         - Array to be packed
C     W    BLIN         - Packed array to be returned to the user
C
C     ****************************************************************
C
C     Messages generated by this module :  None
C
C     ****************************************************************
C
C     Subroutines called directly : IAND, IOR, ISHFT
C
C     ****************************************************************
C
C     Files referenced :  None
C
C     ****************************************************************
C
C     Local variable definitions :
C
C     ACOUNT       - Index pointer into ALIN
C     BCOUNT       - Index pointer into BLIN
C     LEFT         - Symbolic constant for LEFT byte
C     RIGHT        - Symbolic constant for RIGHT byte
C     WHICHS       - Indicator for left/right side to be processed
C
C     ****************************************************************
C
C     Commons referenced :  KERPAR local common
C
C     ****************************************************************
C
C     (*$END.DOCUMENT*)
C
C     ****************************************************************
C     *                                                              *
C     *         D I M E N S I O N   S T A T E M E N T S              *
C     *                                                              *
C     ****************************************************************
C
      IMPLICIT INTEGER (A-Z)
      INTEGER*2   ALIN(1),     BLIN(1)
C
C     ****************************************************************
C     *                                                              *
C     *         T Y P E   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         C O M M O N   S T A T E M E N T S                    *
C     *                                                              *
C     ****************************************************************
C
      INCLUDE USL/KERPMC
C
C     ****************************************************************
C     *                                                              *
C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         D A T A   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
      DATA        LEFT /0/,    RIGHT /1/
C
C     ****************************************************************
C
C     Code starts here :
C
      WHICHS = LEFT
      ACOUNT = 1
      BCOUNT = 1
C
      BLIN(1) = 4Z2020
      IF (ALIN(ACOUNT) .EQ. LF) GO TO 40
C
C----->  Pack the output line, until LF char is reached.
C
   10 CONTINUE
      IF (WHICHS .NE. LEFT) GO TO 20
      BLIN(BCOUNT) = IOR (ISHFT (ALIN(ACOUNT),8),4Z0020)
      WHICHS = RIGHT
      GO TO 30
   20 CONTINUE
      BLIN(BCOUNT) = IOR (IAND (BLIN(BCOUNT),4ZFF00),ALIN(ACOUNT))
      BCOUNT = BCOUNT + 1
      WHICHS = LEFT
   30 CONTINUE
      ACOUNT = ACOUNT + 1
      IF (ALIN(ACOUNT) .NE. LF) GO TO 10
   40 CONTINUE
      RETURN
      END
<<< parser. >>>
      SUBROUTINE PARSER
C
C     ****************************************************************
C
C              KERMIT for the MODCOMP MAXIV operating system
C
C        Compliments of:
C
C                         SETPOINT, Inc.
C                      10245 Brecksville Rd.
C                      Brecksville, Ohio 44141
C
C
C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
C      of this version hereby grant permission to copy this software
C      provided that it is not used for an explicitly commercial
C      purpose and that proper credit be given. SETPOINT, Inc. makes
C      no warranty whatsoever regarding the accuracy of this package
C      and will assume no liability resulting from it's use.
C
C     ****************************************************************
C
C     Abstract:  Main Command Parser
C
C     MODIFICATION HISTORY
C
C     BY            DATE     REASON            PROGRAMS AFFECTED
C
C     ****************************************************************
C
C     Author:  Rick Burke           Version: A.0    Date:  Aug-86
C
C     Calling Parameters:  None
C
C     ****************************************************************
C
C     Messages generated by this module :  None
C
C     ****************************************************************
C
C     Subroutines called directly :  IAND, ISHFT, READ4, SCONNE,
C                                    SHELP, SKIPBL, SQUIT, SRECEI,
C                                    SSEND, SSET, SSTATU, UPPER
C
C     ****************************************************************
C
C     Files referenced :  None
C
C     ****************************************************************
C
C     Local variable definitions :
C
C     ACOUNT       - Index variable into ALIN
C     CCOUNT       - Index variable into CLIN
C     CMDLEN       - Max length of each command in CMDTBL
C     FOUND        - Number of matches - 1 found in CMDTBL
C     I            - Index variable
C     IEND         - Number of chars in CLIN to search for the
C                    the end of the user-entered word
C     J            - Index variable
C     NDX          - Index variable
C     NUMCMD       - Number of commands in CMDTBL
C     TV1          - Temporary variable
C     WCHCMD       - Index into CMDTBL to command requested by the
C                    the user
C     ALIN(132)    - Command line entered by user
C     CLIN(132)    - Upper case command line entered by user
C     CMDTBL(8,8)  - Table of commands allowed by Kermit
C
C     ****************************************************************
C
C     Commons referenced : KER, KERPAR, and UFTTBL local commons
C
C     ****************************************************************
C
C     (*$END.DOCUMENT*)
C
C     ****************************************************************
C     *                                                              *
C     *         D I M E N S I O N   S T A T E M E N T S              *
C     *                                                              *
C     ****************************************************************
C
      IMPLICIT INTEGER (A-Z)
      INTEGER*2   CMDTBL(8,8)
      INTEGER*2   ALIN(132),   CLIN(132)
C
C     ****************************************************************
C     *                                                              *
C     *         T Y P E   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         C O M M O N   S T A T E M E N T S                    *
C     *                                                              *
C     ****************************************************************
C
      INCLUDE USL/KERCOM
      INCLUDE USL/KERPMC
      INCLUDE USL/UFTTBC
C
C     ****************************************************************
C     *                                                              *
C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         D A T A   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C----->  Implemented commands are:
C
C                 1) CONNECT - hooks to a dummy routine provided
C                 2) EXIT
C                 3) HELP
C                 4) QUIT
C                 5) RECEIVE
C                 6) SET
C                 7) SEND
C                 8) STATUS
C
      DATA        CMDTBL   /67,79,78,78,69,67,84,10002,
     >                      69,88,73,84,10002,0,0,0,
     >                      72,69,76,80,10002,0,0,0,
     >                      81,85,73,84,10002,0,0,0,
     >                      82,69,67,69,73,86,69,10002,
     >                      83,69,84,10002,0,0,0,0,
     >                      83,69,78,68,10002,0,0,0,
     >                      83,84,65,84,85,83,10002,0/
      DATA        NUMCMD /8/,  CMDLEN /8/
C
C     ****************************************************************
C
C     Code starts here :
C
   10 CONTINUE
      WRITE (LOCALO,1000)
 1000 FORMAT (' KERMIT MAXIV> ')
C
C----->  Read a line from the keyboard and convert it to
C----->  uppercase.
C
      DO 11 I=1,32
      ALIN(I) = 0
      CLIN(I) = 0
   11 CONTINUE
      CALL READ4 (IUFT(1,2),CLIN,132,.TRUE.)
      IF (IAND (IUFT(1,2),4Z0020) .NE. 0) CALL SQUIT
C
C----->  Unpack the line so the other character manipulation
C----->  routines will work.
C
      ACOUNT = 1
      CCOUNT = 1
   12 CONTINUE
      TV1 = ISHFT (CLIN(CCOUNT),-8)
      IF (TV1 .EQ. 0) GO TO 13
      ALIN(ACOUNT) = TV1
      ACOUNT = ACOUNT + 1
      TV1 = IAND (CLIN(CCOUNT),4Z00FF)
      IF (TV1 .EQ. 0) GO TO 13
      ALIN(ACOUNT) = TV1
      ACOUNT = ACOUNT + 1
      CCOUNT = CCOUNT + 1
      GO TO 12
   13 CONTINUE
      IF (ALIN(ACOUNT-1) .EQ. BLANK) ACOUNT = ACOUNT - 1
      ALIN(ACOUNT) = LF
      ALIN(ACOUNT+1) = EOS
C
      CALL UPPER (ALIN,CLIN)
C
C----->  Extract the first word in the command line and remove
C----->  any leading blanks.
C
      TV1 = 1
      CALL SKIPBL (CLIN,TV1)
      DO 20 I=1,132
      ALIN(I) = 0
   20 CONTINUE
      IEND = 81 - TV1
      DO 30 NDX=1,IEND
      ALIN(NDX) = CLIN(NDX+TV1-1)
      IF (ALIN(NDX) .EQ.   LF .OR.
     >    ALIN(NDX) .EQ. BLANK     ) GO TO 40
   30 CONTINUE
      NDX = IEND + 1
   40 CONTINUE
      ALIN(NDX) = LF
      ALIN(NDX+1) = EOS
C
C----->  Loop to compare word from command line to all commands.
C
      FOUND = -1
      WCHCMD = 0
      DO 70 J=1,NUMCMD
      DO 50 I=1,CMDLEN
C
C----->  Check for end of word. If end of word then we have a match.
C
      IF (ALIN(I) .EQ. LF) GO TO 60
C
C----->  Check for end of key word. If end of key word found then
C----->  we don't have a match.
C
      IF (CMDTBL(I,J) .EQ. EOS) GO TO 70
C
C----->  Compare the characters.
C
      IF (ALIN(I) .NE. CMDTBL(I,J)) GO TO 70
   50 CONTINUE
      GO TO 70
   60 CONTINUE
C
C----->  Here user's command matches a keyword, so remember which
C----->  command was matched and bump the counter for number of
C----->  matches found and loop back to check the next command.
C
      WCHCMD = J
      FOUND = FOUND + 1
   70 CONTINUE
C
C----->  Branch based on the number of matches found between the
C----->  user's command and the command table.
C
      IF (FOUND) 200,100,300
  100 CONTINUE
C
C----->  User's command matched only one keyword, so process it.
C
      GOTO (110,120,130,120,150,160,170,180),WCHCMD
  110 CONTINUE
C
C----->  CONNECT keyword.
C
      CALL SCONNE
      GO TO 10
  120 CONTINUE
C
C----->  EXIT keyword.
C
      CALL SQUIT
  130 CONTINUE
C
C----->  HELP keyword.
C
      CALL SHELP
      GO TO 10
  150 CONTINUE
C
C----->  RECEIVE keyword.
C
      CALL SRECEI
      GO TO 10
  160 CONTINUE
C
C----->  SET keyword.
C
      CALL SSET (CLIN(TV1+NDX-1))
      GO TO 10
  170 CONTINUE
C
C----->  SEND keyword.
C
      CALL SSEND (CLIN(TV1+NDX-1))
      GO TO 10
  180 CONTINUE
C
C----->  STATUS keyword.
C
      CALL SSTATU
      GO TO 10
  200 CONTINUE
C
C----->  User's command does not match any valid key word.
C
      WRITE (LOCALO,1010)
 1010 FORMAT (' UNRECOGNIZED COMMAND - TYPE "HELP"')
      GO TO 10
  300 CONTINUE
C
C----->  User's command word matches more than 1 valid keyword.
C
      WRITE (LOCALO,1020)
 1020 FORMAT (' AMBIGUOUS COMMAND - TYPE "HELP"')
      GO TO 10
  400 CONTINUE
      RETURN
      END
<<< posusl. >>>
          PGM         POSUSL
          INT         POSUSL
*
*         SUBROUTINE POSUSL (FILNUM,MEMBER,FOUND)
*
*     ****************************************************************
*
*              KERMIT for the MODCOMP MAXIV operating system
*
*        Compliments of:
*
*                         SETPOINT, Inc.
*                      10245 Brecksville Rd.
*                      Brecksville, Ohio 44141
*
*
*      KERMIT is a copyrighted protocol of Columbia Univ. The authors
*      of this version hereby grant permission to copy this software
*      provided that it is not used for an explicitly commercial
*      purpose and that proper credit be given. SETPOINT, Inc. makes
*      no warranty whatsoever regarding the accuracy of this package
*      and will assume no liability resulting from it's use.
*
*     ****************************************************************
*
*     Abstract: Position a FORTRAN file to a SED directory entry.
*
*     MODIFICATION HISTORY
*
*     BY            DATE     REASON            PROGRAMS AFFECTED
*
*     ****************************************************************
*
*     Author:  Rick Burke           Version:  A.0   Date: Aug-86
*
*     Calling Parameters:
*
*     FILNUM       - Integer FORTRAN file number to be positioned
*                    If FILNUM < 1600 then it is assumed to be an
*                    integer FORTRAN logical unit number.  If it
*                    is >= 1600 it is assumed to be the CAN code
*                    of the logical device name.
*
*     MEMBER       - 8 character member name
*
*     FOUND        - Logical status for position,
*                    .TRUE.  = Successful
*                    .FALSE. = Error condition
*
*     ****************************************************************
*
*     Messages generated by this module :  None
*
*     ****************************************************************
*
*     Subroutines called directly : None
*
*     ****************************************************************
*
*     Files referenced :  None
*
*     ****************************************************************
*
*     Local variable definitions :
*
*     ATTACH       - Name of an attached USL directory
*     POSUFT       - UFT assigned to logical file containing
*                    requested entry
*     BUFFER       - Sector-sized file buffer
*
*     ****************************************************************
*
*     Commons referenced :  None
*
*     ****************************************************************
*
*     (*$END.DOCUMENT*)
*
*     ****************************************************************
*
*     Code starts here :
*
POSUSL    TRR,1,8                       SAVE LINKKAGE
          ADX,8,8                       GENERATE RETURN ADDRESS
          ABR,8,15                       *
          LDS,2,0                       CHECK ARGUMENT COUNT
          SBR,2,14                       *
          SBRB,2,15   BADARG             *
          LDS,9,3                       GET "FOUND" ADDRESS
          LDS,3,1                       GET FILE NUMBER
          LDX,3,3                        *
          HNS,FILNAM                    CHECK FILE NUMBER OR NAME
          CRI,3       #0640             CHECK FILE NUMBER / NAME
          HGE,FILNAM                     *
          REX,#3A                       CONVERT TO ASCII
          LLD,2,8                       REPOSIION
          REX,#37                       CONVERT TO CAN CODE
          DFC         RETURN            ERROR - BAD NUMBER
FILNAM    STM,3       POSUFT+1          PLACE IN UFT
          LDS,2,2                       GET MEMBER NAME ADDRESS
          LFX,2,2                       GET MEMBER NAME
          REX,#37                       CAN BYTES 1-3
          DFC         ERROR              *
          XOR,3,4                       SWAP R3 & R4
          XOR,4,3                        *
          XOR,3,4                        *
          LLD,2,8                       POSITION BYTES 4-6
          REX,#37                       CAN BYTES 4-6
          DFC         ERROR              *
          TRR,2,5                       GET BYTES 7-8
          TRR,5,3                       HOLD BYTES 4-6 IN R5
          LBR,3,2                       LAST BYTE IS SPACE
          REX,#37                       CAN BYTES 7-8
          DFC         ERROR              *
          TRR,6,3                       MOVE BYTES 7-8 TO R6
          LDI,2       POSUFT            LOAD UFT
          ZRR,3                         AND RESET IT
          STM,3,2     5                  *
          STM,3       ATTACH            AND RESET ATTACHED FILE
          REX,2                         REWIND INPUT FILE
          REX,0                         READ FIRST RECORD
          DFC         BUFFER             *
          DFC         256                *
          LDM,3       BUFFER            LOAD FIRST WORD
          ABRB,3,15   ERROR             CHECK DIRECTORY PRESENT
          LDM,3       BUFFER+2          GET # ENTRIES PER SECTOR
NXSCTR    LDI,1       BUFFER            LOAD BUFFER ADDRESS
          TRR,8,3                       NUMBER OF ENTRIES PER SECTOR
NXNTRY    LFS,12,2                      LOAD ENTRY NAME
          TRR,2,12                      CHECK END OF LIST
          ABRB,2,15   MORE               *
ERROR     GMR,2,15                      RETURN FOUND = .FALSE.
RETURN    STX,2,9                        *
          BRX,10                         *
MORE      CRI,12      #FEFE             CHECK FILE ENTRY
          HZR,CKNAME                     *
          STM,13      ATTACH            SAVE FILE ENTRY FILE NAME
          HOP,NOTIT                     AND KEEP CHECKING
CKNAME    CRRT,4,12                     CHECK NAME = MEMBER WANTED
          HZR,NOTIT                      *
          LDS,5,8                       LOAD SECTOR ADDRESS OF ENTRY
          LDM,2       ATTACH            CHECK USL FILE
          HZS,POSIT                      *
          STM,2       $+5               NO - ATTACHED FILE
          LDI,2       POSUFT            ASSIGN TO THE ATTACHED FILE
          REX,#A                         *
          DFC         $$                 *
POSIT     LDI,2       POSUFT            POSITION THE FILE
          STM,5,2     3                 SET THE RECORD POSITION
          REX,5                         ADVANCE RECORD
          REX,4                         BACKSPACE RECORD
          ZRR,2                         SET FOUND = .TRUE.
          HOP,RETURN                     *
NOTIT     ADI,1       9                 POINT TO NEXT ENTRY
          SBRB,8,15   NXNTRY            CHECK MORE ENTRIES
          LDM,2       BUFFER+1          LOAD NEXT SECTOR ADDRESS
          STM,2       POSUFT+3          NEXT SECTOR TO READ
          LDI,2       POSUFT            READ NEXT SECTOR
          REX,0                          *
          DFC         BUFFER             *
          DFC         256                *
          BRU         NXSCTR            GO SEARCH NEXT DIRECTORY SECTOR
BADARG    REX,#13                       ABORT
          DFC         @ARG              REASON = "ARG"
ATTACH    DFC         $$
POSUFT    DFC         0,$$,#A400,0,0,0
BUFFER    RES         128
          END
<<< rdata. >>>
      INTEGER FUNCTION RDATA (X)
C
C     ****************************************************************
C
C              KERMIT for the MODCOMP MAXIV operating system
C
C        Compliments of:
C
C                         SETPOINT, Inc.
C                      10245 Brecksville Rd.
C                      Brecksville, Ohio 44141
C
C
C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
C      of this version hereby grant permission to copy this software
C      provided that it is not used for an explicitly commercial
C      purpose and that proper credit be given. SETPOINT, Inc. makes
C      no warranty whatsoever regarding the accuracy of this package
C      and will assume no liability resulting from it's use.
C
C     ****************************************************************
C
C     Abstract:  Read a data packet from the other KERMIT.
C
C     MODIFICATION HISTORY
C
C     BY            DATE     REASON            PROGRAMS AFFECTED
C
C     ****************************************************************
C
C     Author: BOB BORGESON          Version: A.0    Date: Oct-86
C
C     Calling Parameters:
C
C           X           - JUNK VARIABLE NEEDED FOR FORTRAN
C
C     ****************************************************************
C
C     Messages generated by this module :  None
C
C     ****************************************************************
C
C     Subroutines called directly :  BUFEMP, CMWI4, DPUTLI, RNOUT,
C                                    RPACK, SPACK, SPAR
C
C     ****************************************************************
C
C     Files referenced :  None
C
C     ****************************************************************
C
C     Local variable definitions :
C
C      MAXTRY - MAXIMUM NUMBER OF TRIES TO GET PACKET
C      N      - PACKET # MODULO 64
C      NUMTRY - # OF TRIES ON THIS PACKET
C      OLDTRY - # OF TRIES ON LAST PACKET
C
C     ****************************************************************
C
C     Commons referenced :  None
C
C     ****************************************************************
C
C     (*$END.DOCUMENT*)
C
C     ****************************************************************
C     *                                                              *
C     *         D I M E N S I O N   S T A T E M E N T S              *
C     *                                                              *
C     ****************************************************************
C
      IMPLICIT INTEGER (A-Z)
C
C     ****************************************************************
C     *                                                              *
C     *         T Y P E   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         C O M M O N   S T A T E M E N T S                    *
C     *                                                              *
C     ****************************************************************
C
      INCLUDE USL/KERCOM
      INCLUDE USL/KERPMC
      INCLUDE USL/UFTTBC
C
C     ****************************************************************
C     *                                                              *
C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         D A T A   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C
C     Code starts here :
C
      IF(NUMTRY.LE.MAXTRY)GO TO 200
C                                     !EXCEEDED MAXTRY , GIVES UP
         RDATA=BIGA
         RETURN
  200 CONTINUE
C                                     !TRY IT AGAIN
          NUMTRY=NUMTRY+1
C                                     !READ A PACKET
      STATUS=RPACK(LEN,NUM,PACKET)
C                                     !IF WE ARE RUNNING IN REMOTE
C                                     !MODE DISPLAY THE PACKET #
      IF(HOSTON.EQ.NO) WRITE(LOCALO,100)NUM
C                                     !WE GOT THE DATA PACKET
      IF(STATUS.NE.BIGD)GO TO 1000
         IF(NUM.EQ.N)GO TO 900
            IF(OLDTRY.LE.MAXTRY)GO TO 300
               RDATA=BIGA
               RETURN
  300       CONTINUE
                OLDTRY=OLDTRY+1
            IF(NUM.NE.(N-1))GO TO 400
C                                     !WE GOT A DUPLICTED PACKET
               CALL SPAR(PACKET)
C                                     !JUST ACK IT
               TV1=BIGY
               TV2=6
               CALL SPACK(TV1,NUM,TV2,PACKET)
               NUMTRY=0
               RDATA=STATE
               RETURN
  400       CONTINUE
                RDATA=BIGA
                RETURN
C                                    !WRITE THE DATA PACKET JUST RECEIVE
  900     CONTINUE
         CALL BUFEMP(PACKET,LEN)
C                                    !INTO THE RECEIVING DISK FILE
         TNUM=N
         TV1=BIGY
         TV2=TNUM
         TV3=0
         TV4=0
C                                    !ACK THE JUST RECEIVED PACKET
         CALL SPACK(TV1,TV2,TV3,TV4)
         OLDTRY=NUMTRY
         NUMTRY=0
         N=MOD((N+1),64)
         RDATA=BIGD
         RETURN
 1000 CONTINUE
C
      IF(STATUS.NE.BIGF)GO TO 2000
C                                        !THE PACKET IS THE FILE HEADER
C                                        !WE SHOULD HAVE ALREADY GOTTEN
              IF(OLDTRY.LE.MAXTRY)GO TO 1100
C                                        !EXCEEDED NUMBER OF RETRY, GIVE
                 RDATA=BIGA
                 RETURN
 1100         CONTINUE
                  OLDTRY=OLDTRY+1
C                                        !WE GOT DUPLICATE FILE HEADER P
              IF(NUM.NE.(N-1))GO TO 1200
                 TV1=BIGY
                 TV2=0
                 TV3=0
C                                             !JUST ACK IT
                 CALL SPACK(TV1,NUM,TV2,TV3)
                 NUMTRY=0
                 RDATA=STATE
                 RETURN
 1200         CONTINUE
                  RDATA=BIGA
                  RETURN
C                                             !WE GOT THE EOF PACKET
 2000 CONTINUE
      IF(STATUS.NE.BIGZ)GO TO 3000
              IF(NUM.EQ.N)GO TO 2100
                 RDATA=BIGA
                 RETURN
 2100         CONTINUE
              TNUM=N
              TV1=BIGY
              TV2=0
              TV3=0
C                                           !ACK IT
              CALL SPACK(TV1,TNUM,TV2,TV3)
C                                           !CLOSE THE RECEIVING DISK FI
             CALL RNOUT
             CALL WEOF4 (IUFT(1,8))
C                                          WRITE OUT THE FILE NAME
C
             CALL CMWI4(IUFT(2,5),40)
             CALL DPUTLIN(FILNAM,5)
             CALL RNOUT
C
              N=MOD((N+1),64)
C                                           !CHANGE THE STATE TO LOOK FO
              RDATA=BIGF
C                                           !ANOTHER FILE HEADER
              RETURN
C
 3000 CONTINUE
C
      IF(STATUS.NE.BAD)GO TO 4000
C                                           !THERE WAS AN ERROR IN THE
              RDATA=STATE
C                                           !CHECKSUM
              TNUM=N
              TV1=BIGN
              TV2=0
              TV3=0
C                                           !NAK IT
              CALL SPACK(TV1,TNUM,TV2,TV3)
              RETURN
 4000 CONTINUE
C                                        !WE GOT A UNKNOWN PACKET TYPE
          RDATA=BIGA
C                                        !GIVES UP
      RETURN
100   FORMAT('+PACKET #',I3,'  ')
      END
<<< recsw. >>>
      INTEGER FUNCTION RECSW (X)
C
C     ****************************************************************
C
C              KERMIT for the MODCOMP MAXIV operating system
C
C        Compliments of:
C
C                         SETPOINT, Inc.
C                      10245 Brecksville Rd.
C                      Brecksville, Ohio 44141
C
C
C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
C      of this version hereby grant permission to copy this software
C      provided that it is not used for an explicitly commercial
C      purpose and that proper credit be given. SETPOINT, Inc. makes
C      no warranty whatsoever regarding the accuracy of this package
C      and will assume no liability resulting from it's use.
C
C     ****************************************************************
C
C     Abstract:  Receive a file or group of files from the
C                other Kermit.
C
C     MODIFICATION HISTORY
C
C     BY            DATE     REASON            PROGRAMS AFFECTED
C
C
C     ****************************************************************
C
C     Author: BOB BORGESON          Version: A.0    Date: Oct-86
C
C     Calling Parameters:
C
C          X        - REQUIRED BY FORTRAN
C
C     ****************************************************************
C
C     Messages generated by this module :  None
C
C     ****************************************************************
C
C     Subroutines called directly : RINIT , RDATA , RFILE , PUTLIN
C                                   SPACK , BKFILE , AVFILE
C
C     ****************************************************************
C
C     Files referenced :  None
C
C     ****************************************************************
C
C     Local variable definitions :
C
C     UFTFIL       UFT# FOR THE FILE NAMES SCRATCH
C     UFTDAT       UFT# FOR THE FILE DATA SCRATCH
C
C     ****************************************************************
C
C     Commons referenced :  KERCOM, KERPMC, UFTTBL, XBYTE local commons
C
C     ****************************************************************
C
C     (*$END.DOCUMENT*)
C
C     ****************************************************************
C     *                                                              *
C     *         D I M E N S I O N   S T A T E M E N T S              *
C     *                                                              *
C     ****************************************************************
C
      IMPLICIT INTEGER (A-Z)
C
      INTEGER*2   FILNM(50)
C
C     ****************************************************************
C     *                                                              *
C     *         T Y P E   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         C O M M O N   S T A T E M E N T S                    *
C     *                                                              *
C     ****************************************************************
C
      INCLUDE USL/KERCOM
      INCLUDE USL/KERPMC
      INCLUDE USL/UFTTBC
      COMMON /XBYTE/ XNEW,XCOUNT,XLIN(132),XEOF
C
C     ****************************************************************
C     *                                                              *
C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         D A T A   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
      DATA UFTFIL / 5 /
      DATA UFTDAT / 8 /
C
C     ****************************************************************
C
C     Code starts here :
C
      STATUS=YES
      STATE=BIGR
      XNEW=YES
      XCOUNT=1
      N=0
      NUMTRY=0
C
  100 CONTINUE
C
      IF(STATUS.NE.YES)GO TO 9000
C                                                   !READ A DATA PACKET
               IF(STATE.NE.BIGD)GO TO 200
                  STATE=RDATA(X)
                  GO TO 1000
  200          CONTINUE
C                                                   !READ A SINIT PACKET
               IF(STATE.NE.BIGR)GO TO 300
                  STATE=RINIT(X)
                  GO TO 1000
  300          CONTINUE
C                                                   !READ A FILE HEADER
               IF(STATE.NE.BIGF)GO TO 400
                  STATE=RFILE(FILNM)
                  IF (STATE .EQ. BIGD) CALL CMWI4 (IUFT(2,UFTDAT),40)
                  GO TO 1000
  400          CONTINUE
C                                                   !FILE TRANSFER DONE
               IF(STATE.NE.BIGC)GO TO 500
                  RECSW=YES
C
                  IF (HOSTON .EQ. YES) CALL TERMIN (IUFT(1,4),.FALSE.)
                  RETURN
  500           CONTINUE
C                                                   !WE GOT AN ERROR
                IF(STATE.NE.BIGA)GO TO 1000
                       RECSW=NO
                       TV1=BIGE
                       TV2=N
                       TV3=0
                       TV4=0
C                                                 !SEND AN ERROR PACKET
                       CALL SPACK(TV1,TV2,TV3,TV4)
C                                                  BACK UP SCRATCH TO GET
C                                                   RID OF JUNK
                   CALL BKFILE(IUFT(1,UFTDAT))
                   CALL AVFILE(IUFT(1,UFTDAT))
                   RETURN
 1000           CONTINUE
C
                GO TO 100
C
 9000 CONTINUE
      RETURN
      END
<<< rfile. >>>
      INTEGER FUNCTION RFILE (X)
C
C     ****************************************************************
C
C              KERMIT for the MODCOMP MAXIV operating system
C
C        Compliments of:
C
C                         SETPOINT, Inc.
C                      10245 Brecksville Rd.
C                      Brecksville, Ohio 44141
C
C
C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
C      of this version hereby grant permission to copy this software
C      provided that it is not used for an explicitly commercial
C      purpose and that proper credit be given. SETPOINT, Inc. makes
C      no warranty whatsoever regarding the accuracy of this package
C      and will assume no liability resulting from it's use.
C
C     ****************************************************************
C
C     Abstract:  Read a file header packer from the other Kermit.
C
C     MODIFICATION HISTORY
C
C     BY            DATE     REASON            PROGRAMS AFFECTED
C
C
C     ****************************************************************
C
C     Author: BOB BORGESON          Version: A.0    Date: Oct-86
C
C     Calling Parameters:
C
C       X   - REQUIRED BY FORTRAN
C
C     ****************************************************************
C
C     Messages generated by this module :  None
C
C     ****************************************************************
C
C     Subroutines called directly :  PUTLIN, RPACK, SPACK
C
C     ****************************************************************
C
C     Files referenced :  None
C
C     ****************************************************************
C
C     Local variable definitions :
C
C     N      - CURRENT PACKET SEQUENCE #
C     NUM    - LAST PACKET SEQUENCE #
C     FILNM  - UNPACKED ASCII FILE NAME TO BE RECEIVED
C
C     ****************************************************************
C
C     Commons referenced :  KER, KERPAR local commons
C
C     ****************************************************************
C
C     (*$END.DOCUMENT*)
C
C     ****************************************************************
C     *                                                              *
C     *         D I M E N S I O N   S T A T E M E N T S              *
C     *                                                              *
C     ****************************************************************
C
      IMPLICIT INTEGER (A-Z)
C
      INTEGER*2   ANAME(132)
C
C     ****************************************************************
C     *                                                              *
C     *         T Y P E   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         C O M M O N   S T A T E M E N T S                    *
C     *                                                              *
C     ****************************************************************
C
      INCLUDE USL/KERCOM
      INCLUDE USL/KERPMC
C
C     ****************************************************************
C     *                                                              *
C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         D A T A   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C
C     Code starts here :
C
C
      IF(NUMTRY.LE.MAXTRY)GO TO 100
C                                            !EXCEEDED MAX. # OF RE-TRY
         RFILE=BIGA
C                                            !GIVES UP
         RETURN
  100 CONTINUE
          NUMTRY=NUMTRY+1
C
C                                            PICK UP A PACKET
C
      STATUS=RPACK(LEN,NUM,PACKET)
C                                            !WE GOT A SINIT PACKET
      IF(STATUS.NE.BIGS)GO TO 1000
         IF(OLDTRY.LE.MAXTRY)GO TO 200
C                                            !RE-TRY IT AGAIN
            RFILE=BIGA
            RETURN
  200    CONTINUE
             OLDTRY=OLDTRY+1
         IF(NUM.NE.(N-1))GO TO 300
C                                            !WE ALREADY GOT THE SINIT
C                                            !PACKET, GET MY FILE-TRANSFER
C                                            !REQUIREMENT/PARAMETERS
            CALL SPAR(PACKET)
            TV1=BIGY
            TV2=6
C                                            !ACK IT
            CALL SPACK(TV1,NUM,TV2,PACKET)
            NUMTRY=0
            RFILE=STATE
            RETURN
  300    CONTINUE
C                                            !UNEXPECTED SEQUENCE #
             RFILE=BIGA
C                                            !GIVES UP
             RETURN
C
 1000 CONTINUE
C                                            !WE GOT A EOF PACKET
      IF(STATUS.NE.BIGZ)GO TO 2000
              IF(OLDTRY.LE.MAXTRY)GO TO 1100
C                                            !EXCEEDED MAX # OF RE-TRY
                 RFILE=BIGA
C                                            !GIVES UP
                 RETURN
 1100         CONTINUE
C                                            !RE-TRY ONE MORE TIME
                  OLDTRY=OLDTRY+1
              IF(NUM.NE.(N-1))GO TO 1200
C                                            !WE ALREADY GOT THE EOF PACKET
                 TV1=BIGY
                 TV2=0
                 TV3=0
C                                            !JUST ACK IT
                 CALL SPACK(TV1,NUM,TV2,TV3)
                 NUMTRY=0
                 RFILE=STATE
                 RETURN
 1200         CONTINUE
C                                            !UNEXPECTED SEQUENCE #
                  RFILE=BIGA
                  RETURN
C
 2000 CONTINUE
C                                            !WE GOT THE FILE HEADER PACKET
      IF(STATUS.NE.BIGF)GO TO 3000
              IF(NUM.EQ.N)GO TO 2100
C                                            !UNEXPECTED SEQUENCE #,NAK IT
                 RFILE=BIGA
                 RETURN
 2100         CONTINUE
C                                            !PACKET(LEN) HAS THE INCOMING
C                                            !FILENAME PACKET
              PACKET(LEN+1)=LF
              PACKET(LEN+2)=EOS
C
C                                             STORE FILENAME FOR LATER
C                                             WRITE TO DISK
C
              DO 2125 I = 1,132
C
                FILNAM(I) = 0
                ANAME(I) = 0
C
 2125         CONTINUE
C
              DO 2150 I = 1,LEN
C
               FILNAM(I) = PACKET(I)
               ANAME(I) = ISHFT (PACKET(I),8)
C
 2150         CONTINUE
C
              FILNAM(I+1) = LF
              FILNAM(I+2) = EOS
              IF(HOSTON.NE.NO)GO TO 2300
                 WRITE (LOCALO,2175) (ANAME(I),I=1,LEN)
 2175            FORMAT( ' RECEIVING FILE--> ',60A1)
                 WRITE (LOCALO,2176)
 2176            FORMAT (/)
 2300         CONTINUE
              TNUM=N
              TV1=BIGY
              TV2=0
              TV3=0
C                                            !ACK THE FILE HEADER PACKET
              CALL SPACK(TV1,TNUM,TV2,TV3)
              OLDTRY=NUMTRY
              NUMTRY=0
              N=MOD((N+1),64)
C                                           !CHANGE STATE TO LOOK FOR DATA
C                                           !PACKET
              RFILE=BIGD
              RETURN
C
 3000      CONTINUE
C                                           !WE GOT A BREAK TRANSMISSION
      IF(STATUS.NE.BIGB)GO TO 4000
              IF(NUM.EQ.N)GO TO 3100
                 RFILE=BIGA
                 RETURN
 3100         CONTINUE
              TNUM=N
              TV1=BIGY
              TV2=0
              TV3=0
C                                          !ACK THE BREAK PACKET
              CALL SPACK(TV1,TNUM,TV2,TV3)
C                                          !CHANGE STATE TO COMPLETE STATUS
              RFILE=BIGC
              RETURN
 4000 CONTINUE
C                                          !WE GOT AN ERROR ON THE CHECK SUM
      IF(STATUS.NE.BAD)GO TO 5000
              RFILE=STATE
              TNUM=N
              TV1=BIGN
              TV2=0
              TV3=0
C                                         !NAK IT
              CALL SPACK(TV1,TNUM,TV2,TV3)
              RETURN
 5000 CONTINUE
C                                          !UNEXPECTED PACKET TYPE, GIVE UP
          RFILE=BIGA
      RETURN
      END
<<< rinit. >>>
      INTEGER FUNCTION RINIT (X)
C
C     ****************************************************************
C
C              KERMIT for the MODCOMP MAXIV operating system
C
C        Compliments of:
C
C                         SETPOINT, Inc.
C                      10245 Brecksville Rd.
C                      Brecksville, Ohio 44141
C
C
C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
C      of this version hereby grant permission to copy this software
C      provided that it is not used for an explicitly commercial
C      purpose and that proper credit be given. SETPOINT, Inc. makes
C      no warranty whatsoever regarding the accuracy of this package
C      and will assume no liability resulting from it's use.
C
C     ****************************************************************
C
C     Abstract:  Receive the initial packet from the remote Kermit.
C
C     MODIFICATION HISTORY
C
C     BY            DATE     REASON            PROGRAMS AFFECTED
C
C
C     ****************************************************************
C
C     Author: BOB BORGESON          Version: A.0    Date: Oct-86
C
C     Calling Parameters:
C
C          X            - REQUIRED BY FORTRAN
C
C     ****************************************************************
C
C     Messages generated by this module :  None
C
C     ****************************************************************
C
C     Subroutines called directly : RPACK, RPAR, SPACK, SPAR
C
C     ****************************************************************
C
C     Files referenced :  None
C
C     ****************************************************************
C
C     Local variable definitions :
C
C      STATUS  - RECEIVES KERMIT STATE FLAG
C
C     ****************************************************************
C
C     Commons referenced :  KERCOM , KERPMC
C
C     ****************************************************************
C
C     (*$END.DOCUMENT*)
C
C     ****************************************************************
C     *                                                              *
C     *         D I M E N S I O N   S T A T E M E N T S              *
C     *                                                              *
C     ****************************************************************
C
      IMPLICIT INTEGER (A-Z)
C
C     ****************************************************************
C     *                                                              *
C     *         T Y P E   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         C O M M O N   S T A T E M E N T S                    *
C     *                                                              *
C     ****************************************************************
C
      INCLUDE USL/KERCOM
      INCLUDE USL/KERPMC
C
C     ****************************************************************
C     *                                                              *
C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         D A T A   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C
C     Code starts here :
C
      IF(NUMTRY.LE.MAXTRY)GO TO 100
C                                             !EXCEEDED MAX. # OF RE-TRY
C                                             !GIVES UP
         RINIT=BIGA
         RETURN
  100 CONTINUE
C                                             !TRY-IT AGAIN
          NUMTRY=NUMTRY+1
      DO 200 I=1,40
         PACKET(I)=0
  200 CONTINUE
C                                             !READ A PACKET
      STATUS=RPACK(LEN,NUM,PACKET)
C                                             !WE GOT A SINIT PACKET
      IF(STATUS.NE.BIGS)GO TO 300
C                                  !STORE OTHER KERMIT'S REQUIREMENTS
         CALL RPAR(PACKET)
C                                  !GET OUR PARAMETERS/REQUIRMENTS
         CALL SPAR(PACKET)
         TNUM=N
         TV1=BIGY
         TV2=6
C                                             !SEND OUT REQUIREMENT AND
C                                             !ACK IT ON ONE SHOT
         CALL SPACK(TV1,TNUM,TV2,PACKET)
         OLDTRY=NUMTRY
         NUMTRY=0
         N=MOD((N+1),64)
C                                             !CHANGE STATE TO LOOK FOR
C                                             !THE FILE HEADER PACKET
         RINIT=BIGF
         RETURN
C
  300 CONTINUE
C                                             !WE GOT A CHECKSUM ERROR
      IF(STATUS.NE.BAD)GO TO 400
           RINIT=STATE
           TNUM=N
           TV1=BIGN
           TV2=1
           TV3=0
C                                             !NAK IT
           CALL SPACK(TV1,TNUM,TV2,TV3)
           RETURN
  400 CONTINUE
C                                             !WE GOT AN UNEXPECTED PACK
C                                             !TYPE, GIVES UP
          RINIT=BIGA
      RETURN
      END
<<< rpack. >>>
      INTEGER FUNCTION RPACK (LEN,NUM,XDATA)
C
C     ****************************************************************
C
C              KERMIT for the MODCOMP MAXIV operating system
C
C        Compliments of:
C
C                         SETPOINT, Inc.
C                      10245 Brecksville Rd.
C                      Brecksville, Ohio 44141
C
C
C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
C      of this version hereby grant permission to copy this software
C      provided that it is not used for an explicitly commercial
C      purpose and that proper credit be given. SETPOINT, Inc. makes
C      no warranty whatsoever regarding the accuracy of this package
C      and will assume no liability resulting from it's use.
C
C     ****************************************************************
C
C     Abstract:  Read a packet from the other Kermit.
C
C     MODIFICATION HISTORY
C
C     BY            DATE     REASON            PROGRAMS AFFECTED
C
C
C     ****************************************************************
C
C     Author: BOB BORGESON          Version: A.0    Date: Oct-86
C
C     Calling Parameters:
C
C     W  LEN       - LENGTH OF PACKET
C     W  NUM       - PACKET SEQUENCE NUMBER
C     W  XDATA     - THE PACKET
C
C     ****************************************************************
C
C     Messages generated by this module :  None
C
C     ****************************************************************
C
C     Subroutines called directly :  GETLIN, UNCHAR
C
C     ****************************************************************
C
C     Files referenced :  None
C
C     ****************************************************************
C
C     Local variable definitions :
C
C      CHKSUM  - CALCULATED VALUE OF CHECKSUM
C      GAPTRY  - # OF TIMES WE'VE LOOKED FOR PACKET STARTING WIT SOH
C      MGAPTRY - MAXIMUM ALLOWED VALUE OF GAPTRY
C      XTYPE   - CODE FOR TYPE OF PACKET
C
C     ****************************************************************
C
C     Commons referenced :  KER, KERPAR
C
C     ****************************************************************
C
C     (*$END.DOCUMENT*)
C
C     ****************************************************************
C     *                                                              *
C     *         D I M E N S I O N   S T A T E M E N T S              *
C     *                                                              *
C     ****************************************************************
C
      IMPLICIT INTEGER (A-Z)
      INTEGER*2   XDATA(1),    BUFFER(132)
C
C     ****************************************************************
C     *                                                              *
C     *         T Y P E   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         C O M M O N   S T A T E M E N T S                    *
C     *                                                              *
C     ****************************************************************
C
      INCLUDE USL/KERCOM
      INCLUDE USL/KERPMC
C
C     ****************************************************************
C     *                                                              *
C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         D A T A   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C
C     Code starts here :
C
C                                     !THIS IS THE INPUT CHANNEL TO READ
C                                     !A PACKET FROM
      CH=4
      GAPTRY=1
      MGAPTRY=2
      CHKSUM=0
C
C     READ ME A PACKET THAT BEGINS WITH A SOH AND ENDS WITH MYEOL
C
  100 CONTINUE
C
      IF(GAPTRY.GT.MGAPTRY)GO TO 9000
C                                          !GET A PACKET WITHOUT WAITING
C                                          !FOR A PROMPT
         IF(IBMON .NE. YES)STATUS=GETLIN(BUFFER,CH)
C
C                                           IF TIMEOUT, LOOP
C
         IF(STATUS .EQ. BAD)GO TO 1000
C
         COUNT=1
C
C        SKIPS ALL OTHER CHARACTERS UNTIL WE SEE ONE WITH A SOH IN IT
C
  200    CONTINUE
C
         IF((BUFFER(COUNT).EQ.SOH).OR.(BUFFER(COUNT).EQ.EOS))GO TO 300
C                                          !WAIT FOR A SOH OR EOS
            COUNT=COUNT+1
            GO TO 200
  300    CONTINUE
C                                          !WE GOT THE SOH
         IF(BUFFER(COUNT).NE.SOH)GO TO 1000
C
C           WE GOT A LINE THAT BEGINS WITH A SOH
C
            K=COUNT+1
            CHKSUM=BUFFER(K)
C                                          !GET THE LENGTH OF THE PACKET
            LEN=UNCHAR(BUFFER(K))-3
            K=K+1
            CHKSUM=CHKSUM+BUFFER(K)
C                                          !GET THE SEQUENCE NUMBER OF
C                                          !THE FRAME PACKET
            NUM=UNCHAR(BUFFER(K))
            K=K+1
C                                          !GET THE DATA TYPE
            XTYPE=BUFFER(K)
            CHKSUM=CHKSUM+BUFFER(K)
            K=K+1
C
C           GET THE DATA
C
C           ZERO OUT THE XDATA ARRAY
            DO 400 I=1,132
               XDATA(I)=0
  400       CONTINUE
            IF (LEN .LT. 1) GO TO 510
            DO 500 J=1,LEN
               XDATA(J)=BUFFER(K)
               CHKSUM=CHKSUM+BUFFER(K)
               K=K+1
               COUNT=J
  500       CONTINUE
  510       CONTINUE
C
            XDATA(COUNT+1)=EOS
            T=BUFFER(K)
C
C           CALCULATE THE CHECKSUM OF THE INCOMING PACKET
C
            TV1=IAND(CHKSUM,192)
            TV2=TV1/64
            TV3=CHKSUM+TV2
            CHKSUM=IAND(TV3,63)
C
C           DOES THE CHECKSUM MATCH?
C
            IF(CHKSUM.EQ.UNCHAR(T))GO TO 600
C                                          !BAD CHECKSUM
               RPACK=BAD
               RETURN
  600       CONTINUE
                RPACK=XTYPE
                RETURN
 1000    CONTINUE
C
C        WE GOT THE EOS, THE PACKET HAS NO SOH, READ ANOTHER ONE
C
         GAPTRY=GAPTRY+1
         GO TO 100
 9000 CONTINUE
      RPACK=BAD
      RETURN
      END
<<< rpar. >>>
      SUBROUTINE RPAR (XDATA)
C
C     ****************************************************************
C
C              KERMIT for the MODCOMP MAXIV operating system
C
C        Compliments of:
C
C                         SETPOINT, Inc.
C                      10245 Brecksville Rd.
C                      Brecksville, Ohio 44141
C
C
C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
C      of this version hereby grant permission to copy this software
C      provided that it is not used for an explicitly commercial
C      purpose and that proper credit be given. SETPOINT, Inc. makes
C      no warranty whatsoever regarding the accuracy of this package
C      and will assume no liability resulting from it's use.
C
C     ****************************************************************
C
C     Abstract:  EXTRACT REQUIREMENTS FROM INIT PACKET
C
C     MODIFICATION HISTORY
C
C     BY            DATE     REASON            PROGRAMS AFFECTED
C
C     ****************************************************************
C
C     Author: BOB BORGESON          Version: A.0    Date: Oct-86
C
C     Calling Parameters:
C
C     R    XDATA    -- THE DATA PACKET
C
C     ****************************************************************
C
C     Messages generated by this module :  None
C
C     ****************************************************************
C
C     Subroutines called directly :  CTL, UNCHAR
C
C     ****************************************************************
C
C     Files referenced :  None
C
C     ****************************************************************
C
C     Local variable definitions :
C
C     ****************************************************************
C
C     Commons referenced :  KER, KERPAR
C
C     ****************************************************************
C
C     (*$END.DOCUMENT*)
C
C     ****************************************************************
C     *                                                              *
C     *         D I M E N S I O N   S T A T E M E N T S              *
C     *                                                              *
C     ****************************************************************
C
      IMPLICIT INTEGER*2 (A-Z)
C
      INTEGER*2   XDATA(1)
C
C     ****************************************************************
C     *                                                              *
C     *         T Y P E   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         C O M M O N   S T A T E M E N T S                    *
C     *                                                              *
C     ****************************************************************
C
      INCLUDE USL/KERCOM
      INCLUDE USL/KERPMC
C
C     ****************************************************************
C     *                                                              *
C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         D A T A   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C
C     Code starts here :
C
C     STORE THE OTHER KERMIT'S FILE TRANSFER REQUIREMENTS AWAY
C
      IF(XDATA(1).NE.0)GO TO 100
         SPSIZ=PAKSIZ
         GO TO 200
  100 CONTINUE
           SPSIZ=UNCHAR(XDATA(1))
  200 CONTINUE
      IF(XDATA(3).NE.0)PAD=UNCHAR(XDATA(3))
      IF(XDATA(4).NE.0)PADCHAR=CTL(XDATA(4))
      IF(XDATA(5).NE.0)EOL=UNCHAR(XDATA(5))
      IF(XDATA(6).NE.0)QUOTE=XDATA(6)
      RETURN
      END
<<< rstore. >>>
      SUBROUTINE RSTORE
C
C     ****************************************************************
C
C              KERMIT for the MODCOMP MAXIV operating system
C
C        Compliments of:
C
C                         SETPOINT, Inc.
C                      10245 Brecksville Rd.
C                      Brecksville, Ohio 44141
C
C
C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
C      of this version hereby grant permission to copy this software
C      provided that it is not used for an explicitly commercial
C      purpose and that proper credit be given. SETPOINT, Inc. makes
C      no warranty whatsoever regarding the accuracy of this package
C      and will assume no liability resulting from it's use.
C
C     ****************************************************************
C
C     Abstract: RSTORE ALLOWS THE OPERATOR TO INDIVIDUALLY RENAME
C               AND ASSIGN TO LIBRARIES THE RECEIVED FILE. RSTORE
C               MAKES SURE THAT THE FILE NAME IS FIXED UP FOR MAXIV.
C               IT ALSO CHECKS THAT EACH LIBRARY NAME IS CAN-CODEABLE.
C
C     MODIFICATION HISTORY
C
C     BY            DATE     REASON            PROGRAMS AFFECTED
C
C     ****************************************************************
C
C     Author: BOB BORGESON          Version: A.0    Date: Oct-86
C
C     Calling Parameters:  None
C
C     ****************************************************************
C
C     Messages generated by this module :  None
C
C     ****************************************************************
C
C     Subroutines called directly : CMRI4, CMR4, CMWI4, CMW4, CTA4
C                                   FXFILE, PACK, REW4, RNOUT, WEOF
C
C     ****************************************************************
C
C     Files referenced :  None
C
C     ****************************************************************
C
C     Local variable definitions :
C
C     AUTO      - INDICATES WHETHER ALL DEFAULTS ARE ACCEPTED
C     CAT       - INDICATES WHETHER TO CAT OR RECAT A FILE
C     CHRFND    - # OF CHARACTERS FOUND IN LOGICAL FILE NAME
C     EFLNM     - POINTER TO END OF FILE NAME IN ARRAY
C     FFNAM     - FILE NAME FIXED UP FOR MAXIV
C     MYUSL     - CONTAINS PACK USL NAME
C     NCHARF    - # OF CHARACTERS IN FILE NAME
C     NWRDF     - # OF WORDS IN FILE NAME
C     RFNAM     - FILE NAME AS SENT BY OTHER KERMIT
C     SCRTCH    - SCRATCH ARRAY
C     SFLNM     - POINTER TO START OF FILE NAME
C     SLIB      - POINTER TO START OF LIBRARY NAME
C     UFFNAM    - UNPACKED FIXED UP FILE NAME
C     URFNAM    - UNPACKED FILE NAME FROM SENDER KERMIT
C     USCTCH    - UNPACKED SCRATCH
C
C     ****************************************************************
C
C     Commons referenced :  None
C
C     ****************************************************************
C
C     (*$END.DOCUMENT*)
C
C     ****************************************************************
C     *                                                              *
C     *         D I M E N S I O N   S T A T E M E N T S              *
C     *                                                              *
C     ****************************************************************
C
      IMPLICIT INTEGER(A-Z)
C
      INTEGER*2   MYUSL(3),    RFNAM(20),   FFNAM(4),    URFNAM(40)
      INTEGER*2   UFFNAM(8),   SCRTCH(40),  IUSL(2),     USCTCH(80)
C
C     ****************************************************************
C     *                                                              *
C     *         T Y P E   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         C O M M O N   S T A T E M E N T S                    *
C     *                                                              *
C     ****************************************************************
C
      INCLUDE USL/KERCOM
      INCLUDE USL/KERPMC
      INCLUDE USL/UFTTBC
C
C     ****************************************************************
C     *                                                              *
C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         D A T A   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
      DATA KE5      / 3@KE5 /
     >    ,KE9      / 3@KE9 /
     >    ,MLEFT    / ZFF00 /
     >    ,MRIGHT   / Z00FF /
C
C     ****************************************************************
C
C     Code starts here :
C
C
C                              WRITE EOF TO THE FILE NAME SCRATCH FILE
C
      CALL WEOF(IUFT(1,5))
C
C                              INITIALIZE FOR COMPRESSED READ OR WRITE
C
      CALL CMWI4(IUFT(2,9),40)
      CALL CMRI4(IUFT(2,5),40)
C
C                              REWIND THEM
C
      CALL REW4(IUFT(1,5))
      CALL REW4(IUFT(1,9))
C                              A PROC IS ALWAYS CREATED - THIS IS THE TOP
C
      ENCODE(80,100,SCRTCH)
  100 FORMAT('$PROC STORE')
C
      CALL CMW4(SCRTCH)
C
C                              READ FIRST FILE NAME, IF EOF, THEN PUNT
C                              AND PROC DOES NOTHING
C
      CALL CMR4(SCRTCH,IEOF,NCHARF)
C
      IF(IEOF .EQ. 2)GO TO 9000
C
C                               REWIND THE FILE CUZ WE'LL ACTUALLY READ
C                               THE NAME AGAIN BELOW
C
      CALL REW4(IUFT(1,5))
C
C                               MORE OF THE PROC...
C
      ENCODE(80,300,SCRTCH)
  300 FORMAT('$EXE SED')
C
      CALL CMW4(SCRTCH)
C
      ENCODE(80,325,SCRTCH)
  325 FORMAT('OPT DAT')
C
      CALL CMW4(SCRTCH)
C
      ENCODE(80,400,SCRTCH)
  400 FORMAT('ASS SI KE8')
C
      CALL CMW4(SCRTCH)
C
      ENCODE(80,425,SCRTCH)
  425 FORMAT('REW SI')
C
      CALL CMW4(SCRTCH)
C
      ENCODE(80,500,SCRTCH)
  500 FORMAT('AVF SI,1')
C
      CALL CMW4(SCRTCH)
C
C                              UNCAN-CODE THE DEFAULT USL AND PACK IT
C
      CALL CTA4(SUSL,MYUSL,IND)
C
      MYUSL(1) = IOR(IAND(MYUSL(1),MLEFT),ISHFT(MYUSL(2),-8))
      MYUSL(2) = MYUSL(3)
      MYUSL(3) = 0
C
      WRITE(LOCALO,600)
  600 FORMAT(' This utility will allow you to rename the received',/
     >       ' files and assign them to the desired library.',//
     >       ' The default file names are truncated to 8 characters',/
     >       ' and any character which is not can-codeable will be',/
     >       ' converted to "$".',///)
C
C                                OPERATOR MAY CHOOSE ALL DEFAULTS
C
  650 CONTINUE
C
      WRITE(LOCALO,700)
  700 FORMAT(' Do you want to accept all defaults? (Y/N):')
C
      CALL READ4(IUFT(1,2),SCRTCH,2,.TRUE.)
C
      AUTO = ISHFT(SCRTCH,-8)
C
      IF((AUTO .NE. BIGY) .AND. (AUTO .NE. BIGN))GO TO 650
C
C                                 OPERATOR MAY CHOOSE TO CAT OR RECAT
C
  800 CONTINUE
C
      IF(AUTO .EQ. BIGN)GO TO 1000
C
      WRITE(LOCALO,900)
  900 FORMAT(' Do you wish to CAT or RECAT all files? (C/R):')
C
      CALL READ4(IUFT(1,2),SCRTCH,2,.TRUE.)
C
      CAT = ISHFT(SCRTCH,-8)
C
      IF((CAT .NE. BIGC) .AND. (CAT .NE. BIGR))GO TO 800
C
C                                   TOP OF MAIN LOOP
C
 1000 CONTINUE
C
C                                   READ NEXT FILE NAME
C
      DO 1050 JJ = 1,20
C
        RFNAM(JJ) = 999
C
 1050 CONTINUE
C
      CALL CMR4(RFNAM,IEOF,NCHARF)
C
C                                   EOF MEANS YOU'RE DONE
C
      IF(IEOF .EQ. 2)GO TO 8500
C
C                                   UNPACK THE NAME
C
      DO 1200 I = 1,20
C
        TEMP = ISHFT(IAND(RFNAM(I),MLEFT),-8)
        IF((TEMP .EQ. 0) .OR. (TEMP .EQ. 999))TEMP = LF
        URFNAM(2*(I-1)+1) = TEMP
        IF(TEMP .EQ. LF)GO TO 1300
C
        TEMP = IAND(RFNAM(I),MRIGHT)
        IF((TEMP .EQ. 0) .OR. (TEMP .EQ. 999))TEMP = LF
        URFNAM(2*I) = TEMP
        IF(TEMP .EQ. LF)GO TO 1300
C
 1200 CONTINUE
C
 1300 CONTINUE
C
C                                   FIX UP NAME TO MAXIV FORMAT
C
      CALL FXFILE(URFNAM,UFFNAM,NCHARF,NUMFIX)
C
C                                   PACK THE STRING
C
      CALL PACK(UFFNAM,FFNAM)
C
      NWRDF = (NCHARF + 1) / 2
C
      IF(AUTO .EQ. BIGY)GO TO 5000
C
C                                      WRITE OUT DEFAULTS
C
      WRITE(LOCALO,1400)RFNAM,FFNAM,(MYUSL(II),II=1,2)
C
 1400 FORMAT(' Received name...........',20A2,/
     >       ' Acceptable name.........',4A2,/
     >       ' Default USL.............',2A2,//)
C
 1450 CONTINUE
C
      WRITE(LOCALO,1500)
 1500 FORMAT(' Enter name and library - <CR> accepts defaults:')
C
C
      DO 1525 JJ = 1,40
C
        SCRTCH(JJ) = 4Z2020
C
 1525 CONTINUE
C
      CALL READ4(IUFT(1,2),SCRTCH,80,.TRUE.)
C
      NCHRC = IUFT(4,2)
C
C                                     NO INPUT MEANS ACCEPT DEFAULT
C
      IF(NCHRC .EQ. 0)GO TO 2100
C
C                                     UNPACK THE INPUT
C
      DO 1600 I = 1,40
C
        USCTCH(2*(I-1)+1) = ISHFT(IAND(SCRTCH(I),MLEFT),-8)
        USCTCH(2*I) = IAND(SCRTCH(I),MRIGHT)
C
 1600 CONTINUE
C
C                                NO INPUT ACCEPTS DEFAULTS
C
      IF(USCTCH(1) .EQ. 0)GO TO 2100
C
C                                SKIP BLANKS TO FIND START OF FILE NAME
C
      DO 1700 I = 1,80
C
        IF(USCTCH(I) .EQ. BLANK)GO TO 1700
C
        SFLNM = I
        GO TO 1750
C
 1700 CONTINUE
C
      GO TO 2100
C
 1750 CONTINUE
C
C                                 FIND END OF FILE NAME
C
      DO 1800 I = SFLNM,80
C
        IF(USCTCH(I) .NE. BLANK)GO TO 1800
C
        EFLNM = I - 1
        EFLNM1 = EFLNM + 1
        USCTCH(EFLNM1) = LF
C
        GO TO 1850
C
 1800 CONTINUE
C
 1850 CONTINUE
C
C                                  FIND START OF LIBRARY
C
      EFLNM2 = EFLNM1 + 1
C
      DO 1900 I = EFLNM2,80
C
        IF((USCTCH(I) .EQ. BLANK) .OR. (USCTCH(I) .EQ. 0) .OR.
     >     (USCTCH(I) .EQ. 2Z0A) .OR. (USCTCH(I) .EQ. LF))GO TO 1900
C
        SLIB = I
        USCTCH(SLIB+3) = LF
C
        GO TO 1950
C
 1900 CONTINUE
C
      SLIB = I
C
 1950 CONTINUE
C
C                                CHECK FILE NAME FOR LEGALITY
C
      NCHARF = EFLNM - SFLNM + 1
C
      CALL FXFILE(USCTCH(SFLNM),UFFNAM,NCHARF,NUMFIX)
C
      IF(NUMFIX .EQ. 0)GO TO 2000
C
      WRITE(LOCALO,1975)
 1975 FORMAT(' File name must be A-Z, 1-9, :, ., or $')
      GO TO 1450
C
 2000 CONTINUE
C
C                                PACK THE FILE NAME
C
      CALL PACK(UFFNAM,FFNAM)
C
C                                IF NO LIB INPUT, USE DEFAULT
C
      IF(SLIB .GE. 80)GO TO 2100
C
C
C                                CHECK IF WE CAN CAN-CODE THE LIBRARY
C
      CHRFND = 0
C
      DO 2025 I = 1,3
C
C
        IPT = SLIB + 3 - I
C
C                                TRAILING BLANKS ARE OK
C
        IF(((USCTCH(IPT) .EQ. BLANK) .OR. (USCTCH(IPT) .EQ. 0))
     >     .AND. (CHRFND .EQ. 0))GO TO 2025
C
        CHRFND = CHRFND + 1
C
        IF(((USCTCH(IPT) .GE. BIGA) .AND. (USCTCH(IPT) .LE. BIGZ)) .OR.
     >     ((USCTCH(IPT) .GE. DIG0) .AND. (USCTCH(IPT) .LE. DIG9)) .OR.
     >     (USCTCH(IPT) .EQ. COLON)                                .OR.
     >     (USCTCH(IPT) .EQ. PERIOD)                               .OR.
     >     (USCTCH(IPT) .EQ. DOLLAR))GO TO 2025
C
        GO TO 2030
C
 2025 CONTINUE
C
      GO TO 2075
C
 2030 CONTINUE
C
C
      WRITE(LOCALO,2050)
 2050 FORMAT(' Improper logical file name')
C
      GO TO 1450
C
 2075 CONTINUE
C
      CALL PACK(USCTCH(SLIB),MYUSL)
C
 2100 CONTINUE
C
C                          ASK CAT OR RECAT THE FILE
C
      WRITE(LOCALO,2200)
 2200 FORMAT(' CAT or RECAT this file? (C/R):')
C
      CALL READ4(IUFT(1,2),SCRTCH,2,.TRUE.)
C
      CAT = ISHFT(SCRTCH,-8)
C
      IF((CAT .NE. BIGC) .AND. (CAT .NE. BIGR))GO TO 2100
C
 5000 CONTINUE
C
C                        OUTPUT SED COMMANDS TO CAT OR RECAT
C                        THIS FILE
C
      ENCODE(80,5010,SCRTCH)MYUSL
5010  FORMAT('ASS USL ',2A2)
C
      CALL CMW4(SCRTCH)
C
      IF(CAT .EQ. BIGC)ENCODE(80,5020,SCRTCH)FFNAM
      IF(CAT .EQ. BIGR)ENCODE(80,5030,SCRTCH)FFNAM
C
 5020 FORMAT('CAT ',4A2)
 5030 FORMAT('REC ',4A2)
C
      CALL CMW4(SCRTCH)
C
C                         LOOP BACK FOR MORE FILES
C
      GO TO 1000
C
 8500 CONTINUE
C
      ENCODE(80,8510,SCRTCH)
 8510 FORMAT('EXI')
C
      CALL CMW4(SCRTCH)
C
C
 9000 CONTINUE
C
      CALL RNOUT
      CALL WEOF(IUFT(1,9))
C
C
C
      RETURN
      END
<<< sbreak. >>>
      INTEGER FUNCTION SBREAK (X)
C
C     ****************************************************************
C
C              KERMIT for the MODCOMP MAXIV operating system
C
C        Compliments of:
C
C                         SETPOINT, Inc.
C                      10245 Brecksville Rd.
C                      Brecksville, Ohio 44141
C
C
C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
C      of this version hereby grant permission to copy this software
C      provided that it is not used for an explicitly commercial
C      purpose and that proper credit be given. SETPOINT, Inc. makes
C      no warranty whatsoever regarding the accuracy of this package
C      and will assume no liability resulting from it's use.
C
C     ****************************************************************
C
C     Abstract:  Send a BREAK packet to signify the end of
C                transmissions
C
C     MODIFICATION HISTORY
C
C     BY            DATE     REASON            PROGRAMS AFFECTED
C
C     ****************************************************************
C
C     Author:  Rick Burke           Version:  A.0   Date: Sep-86
C
C     Calling Parameters:
C
C     R    X            - Dummy argument required by FORTRAN
C
C     ****************************************************************
C
C     Messages generated by this module :  None
C
C     ****************************************************************
C
C     Subroutines called directly : MOD, RPACK, SPACK
C
C     ****************************************************************
C
C     Files referenced :  None
C
C     ****************************************************************
C
C     Local variable definitions :
C
C     LEN          - Length of response packet
C     NUM          - Packet number of response
C     STATUS       - Status of response packet
C     TV1          - Temporary variable
C     TV2          - Temporary variable
C     TV3          - Temporary variable
C
C     ****************************************************************
C
C     Commons referenced :  None
C
C     ****************************************************************
C
C     (*$END.DOCUMENT*)
C
C     ****************************************************************
C     *                                                              *
C     *         D I M E N S I O N   S T A T E M E N T S              *
C     *                                                              *
C     ****************************************************************
C
      IMPLICIT INTEGER (A-Z)
C
C     ****************************************************************
C     *                                                              *
C     *         T Y P E   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         C O M M O N   S T A T E M E N T S                    *
C     *                                                              *
C     ****************************************************************
C
      INCLUDE USL/UFTTBC
      INCLUDE USL/KERCOM
      INCLUDE USL/KERPMC
C
C     ****************************************************************
C     *                                                              *
C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         D A T A   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C
C     Code starts here :
C
C----->  Assume some kind of error.
C
      SBREAK = BIGA
C
C----->  Check whether retry counter exceeded.
C
      IF (NUMTRY .GT. MAXTRY) RETURN
      NUMTRY = NUMTRY + 1
C
C----->  Send BREAK packet and get the response.
C
      TNUM = N
      TV1 = BIGB
      TV2 = 0
      TV3 = 0
      CALL SPACK (TV1,TNUM,TV2,TV3)
      STATUS = RPACK (LEN,NUM,RECPKT)
C
C----->  Branch if response was not a NAK.
C
      IF (STATUS .NE. BIGN) GO TO 10
      IF (N .NE. NUM-1) SBREAK = STATE
      RETURN
   10 CONTINUE
C
C----->  Branch if response was not an ACK.
C
      IF (STATUS .NE. BIGY) GO TO 30
      IF (N .EQ. NUM) GO TO 20
      SBREAK=STATE
      RETURN
   20 CONTINUE
C
C----->  Received good ACK to BREAK packet so reset retry counter,
C----->  bump packet counter, and set the state to "C" (complete).
C
      NUMTRY = 0
      N = MOD (N+1,64)
      SBREAK = BIGC
C
C---->  If we're in HOST mode, terminate the binary read outstanding
C
      IF(HOSTON .EQ. NO)GO TO 25
C
      CALL TERMIN(IUFT(1,4),.FALSE.)
C
   25 CONTINUE
      RETURN
   30 CONTINUE
C
C-----> Handle BAD status or unknown or ERROR packet types.
C
      IF (STATUS .EQ. BAD) SBREAK = STATE
      RETURN
      END
<<< sconne. >>>
      SUBROUTINE SCONNE
C
C     ****************************************************************
C
C              KERMIT for the MODCOMP MAXIV operating system
C
C        Compliments of:
C
C                         SETPOINT, Inc.
C                      10245 Brecksville Rd.
C                      Brecksville, Ohio 44141
C
C
C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
C      of this version hereby grant permission to copy this software
C      provided that it is not used for an explicitly commercial
C      purpose and that proper credit be given. SETPOINT, Inc. makes
C      no warranty whatsoever regarding the accuracy of this package
C      and will assume no liability resulting from it's use.
C
C     ****************************************************************
C
C     Abstract:
C
C     MODIFICATION HISTORY
C
C     BY            DATE     REASON            PROGRAMS AFFECTED
C
C     ****************************************************************
C
C     Author:                       Version:        Date:
C
C     Calling Parameters:  None
C
C
C     ****************************************************************
C
C     Messages generated by this module :  None
C
C     ****************************************************************
C
C     Subroutines called directly :  None
C
C     ****************************************************************
C
C     Files referenced :  None
C
C     ****************************************************************
C
C     Local variable definitions :  None
C
C     ****************************************************************
C
C     Commons referenced :  None
C
C     ****************************************************************
C
C     (*$END.DOCUMENT*)
C
C     ****************************************************************
C     *                                                              *
C     *         D I M E N S I O N   S T A T E M E N T S              *
C     *                                                              *
C     ****************************************************************
C
      IMPLICIT INTEGER (A-Z)
C
C     ****************************************************************
C     *                                                              *
C     *         T Y P E   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         C O M M O N   S T A T E M E N T S                    *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         D A T A   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C
C     Code starts here :
C
C
      RETURN
      END
<<< sconnect. >>>
      SUBROUTINE SCONNECT
C
C
C     Applicable operating system :
C
C                YES     NO     MAYBE
C     GENERIC            X
C     MAXIV       X
C     VMS                X
C     RSX-11M            X
C
C     ****************************************************************
C
C     Abstract:
C
C     MODIFICATION HISTORY
C
C     BY            DATE     REASON            PROGRAMS AFFECTED
C
C     ****************************************************************
C
C     Author:                       Version:        Date:
C
C     Calling Parameters:
C
C     R/W  PARAM 1      - Definition of parameter 1
C     R/W  PARAM 2      - Definition of parameter 2
C     R/W  PARAM n      - Definition of parameter n
C
C     ****************************************************************
C
C     Messages generated by this module :  None
C
C     ****************************************************************
C
C     Subroutines called directly :
C
C     ****************************************************************
C
C     Files referenced :  None
C
C     R/W              File identifier
C
C     ****************************************************************
C
C     Local variable definitions :
C
C     ****************************************************************
C
C     Commons referenced :  KERCOM , KERPMC
C
C     ****************************************************************
C
C     (*$END.DOCUMENT*)
C**********************************************************************
C
C              KERMIT for the MODCOMP MAXIV operating system
C
C        Compliments of:
C
C                         SETPOINT, Inc.
C                      10245 Brecksville Rd.
C                      Brecksville, Ohio 44141
C
C
C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
C      of this version hereby grant permission to copy this software
C      provided that it is not used for an explicitly commercial
C      purpose and that proper credit be given. SETPOINT, Inc. makes
C      no warranty whatsoever regarding the accuracy of this package
C      and will assume no liability resulting from it's use.
C
C
C**********************************************************************
C
C     ****************************************************************
C     *                                                              *
C     *         D I M E N S I O N   S T A T E M E N T S              *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         T Y P E   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
      IMPLICIT INTEGER (A-Z)
C
C
      INTEGER IBUF,ILEN,TV,IWRITE,IESCHAR,STATUS,IA,IB
      INTEGER IFUNC,ICLAS,LUTERM,TLEN,RMTRAW,LOCALRAW
      INTEGER TCODE
C
C     ****************************************************************
C     *                                                              *
C     *         C O M M O N   S T A T E M E N T S                    *
C     *                                                              *
C     ****************************************************************
C
C
      INCLUDE USL/KERCOM
      INCLUDE USL/KERPMC
C
C     ****************************************************************
C     *                                                              *
C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         D A T A   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C
C     Code starts here :
C
C
      RETURN
      END
<<< scopy. >>>
      SUBROUTINE SCOPY (XFROM,I,XTO,J)
C
C     ****************************************************************
C
C              KERMIT for the MODCOMP MAXIV operating system
C
C        Compliments of:
C
C                         SETPOINT, Inc.
C                      10245 Brecksville Rd.
C                      Brecksville, Ohio 44141
C
C
C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
C      of this version hereby grant permission to copy this software
C      provided that it is not used for an explicitly commercial
C      purpose and that proper credit be given. SETPOINT, Inc. makes
C      no warranty whatsoever regarding the accuracy of this package
C      and will assume no liability resulting from it's use.
C
C     ****************************************************************
C
C     Abstract:
C
C     MODIFICATION HISTORY
C
C     BY            DATE     REASON            PROGRAMS AFFECTED
C
C     ****************************************************************
C
C     Author:  Rick Burke           Version: A.0    Date: Sep-86
C
C     Calling Parameters:
C
C     R    XFROM        - Source array
C     R    I            - Initial index in source array
C     W    XTO          - Destination array
C     R    J            - Initial index in destination array
C
C     ****************************************************************
C
C     Messages generated by this module :  None
C
C     ****************************************************************
C
C     Subroutines called directly :  None
C
C     ****************************************************************
C
C     Files referenced :  None
C
C     ****************************************************************
C
C     Local variable definitions :
C
C     K1           - Index into FROM array
C     K2           - Index into TO array
C
C     ****************************************************************
C
C     Commons referenced :  KERPAR
C
C     ****************************************************************
C
C     (*$END.DOCUMENT*)
C
C     ****************************************************************
C     *                                                              *
C     *         D I M E N S I O N   S T A T E M E N T S              *
C     *                                                              *
C     ****************************************************************
C
      IMPLICIT INTEGER (A-Z)
C
      INTEGER*2   XFROM(1),        XTO(1)
C
C     ****************************************************************
C     *                                                              *
C     *         T Y P E   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         C O M M O N   S T A T E M E N T S                    *
C     *                                                              *
C     ****************************************************************
C
      INCLUDE USL/KERPMC
C
C     ****************************************************************
C     *                                                              *
C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         D A T A   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C
C     Code starts here :
C
      K2 = J
      K1 = I
C
   10 CONTINUE
      XTO(K2) = XFROM(K1)
      K2 = K2 + 1
      K1 = K1 + 1
      IF (XFROM(K1-1) .NE. EOS) GO TO 10
      RETURN
      END
<<< sdata. >>>
      INTEGER FUNCTION SDATA (X)
C
C     ****************************************************************
C
C              KERMIT for the MODCOMP MAXIV operating system
C
C        Compliments of:
C
C                         SETPOINT, Inc.
C                      10245 Brecksville Rd.
C                      Brecksville, Ohio 44141
C
C
C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
C      of this version hereby grant permission to copy this software
C      provided that it is not used for an explicitly commercial
C      purpose and that proper credit be given. SETPOINT, Inc. makes
C      no warranty whatsoever regarding the accuracy of this package
C      and will assume no liability resulting from it's use.
C
C     ****************************************************************
C
C     Abstract:  Send a data packet to the remote Kermit.
C
C     MODIFICATION HISTORY
C
C     BY            DATE     REASON            PROGRAMS AFFECTED
C
C     ****************************************************************
C
C     Author:  Rick Burke           Version: A.0    Date: Sep-86
C
C     Calling Parameters:
C
C     R    X            - Dummy argument required by FORTRAN
C
C     ****************************************************************
C
C     Messages generated by this module :  None
C
C     ****************************************************************
C
C     Subroutines called directly : BUFILL, MOD, RPACK, SPACK
C
C     ****************************************************************
C
C     Files referenced :  None
C
C     ****************************************************************
C
C     Local variable definitions :
C
C     LEN          - Length of received packet
C     NUM          - Number of received packet
C     TNUM         - Expected packet number
C     TV1          - Temporary variable
C
C     ****************************************************************
C
C     Commons referenced :  KER and  KERPAR local commons
C
C     ****************************************************************
C
C     (*$END.DOCUMENT*)
C
C     ****************************************************************
C     *                                                              *
C     *         D I M E N S I O N   S T A T E M E N T S              *
C     *                                                              *
C     ****************************************************************
C
      IMPLICIT INTEGER (A-Z)
C
C     ****************************************************************
C     *                                                              *
C     *         T Y P E   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         C O M M O N   S T A T E M E N T S                    *
C     *                                                              *
C     ****************************************************************
C
      INCLUDE USL/KERCOM
      INCLUDE USL/KERPMC
C
C     ****************************************************************
C     *                                                              *
C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         D A T A   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C
C     Code starts here :
C
C
C----->  Assume some kind of error.
C
      SDATA = BIGA
C
C----->  Retry counter exceeded?
C
      IF (NUMTRY .GT. MAXTRY) RETURN
      NUMTRY = NUMTRY + 1
C
C----->  Send the data packet.
C
      TNUM = N
      TV1 = BIGD
      CALL SPACK (TV1,TNUM,SIZE,PACKET)
C
C----->  If we are in local mode then display the packet
C----->  sequence number.
C
      IF (HOSTON .EQ. NO) WRITE (LOCALO,100) TNUM
C
C----->  Get the reply from the remote.
C
      STATUS = RPACK (LEN,NUM,RECPKT)
C
C----->  The next statements are to make sure that we are not one
C----->  packet ahead of the other Kermit. This will happen if the
C----->  other Kermit sends a NAK (due to a timeout detection)
C----->  before we send the first SINIT packet.
C
      IF (STATUS .EQ.  BIGY .AND.
     >    N      .EQ. NUM+1      ) STATUS = RPACK (LEN,NUM,RECPKT)
      IF (STATUS .NE. BIGN) GO TO 10
C
C----->  We got a NAK.
C
      IF (N .EQ. NUM-1) GO TO 50
      SDATA = STATE
      RETURN
   10 CONTINUE
      IF (STATUS .NE. BIGY) GO TO 40
C
C----->  We got an ACK.
C
      IF (N .EQ. NUM) GO TO 20
C
C----->  But, it was for the last packet.
C
      SDATA = STATE
      RETURN
   20 CONTINUE
      NUMTRY = 0
      N = MOD((N+1),64)
      SIZE = BUFILL (PACKET)
      IF (SIZE .NE. EOF) GO TO 30
      SDATA = BIGZ
      RETURN
   30 CONTINUE
      SDATA = BIGD
      RETURN
   40 CONTINUE
      IF (STATUS .NE. BAD) GO TO 50
C
C----->  We got a checksum error, try again.
C
      SDATA = STATE
      RETURN
   50 CONTINUE
C
C----->  Here we got an unknown packet type or an error occurred.
C
      RETURN
100   FORMAT('+PACKET #',I3,'  ')
      END
<<< sendsw. >>>
      INTEGER FUNCTION SENDSW (X)
C
C     ****************************************************************
C
C              KERMIT for the MODCOMP MAXIV operating system
C
C        Compliments of:
C
C                         SETPOINT, Inc.
C                      10245 Brecksville Rd.
C                      Brecksville, Ohio 44141
C
C
C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
C      of this version hereby grant permission to copy this software
C      provided that it is not used for an explicitly commercial
C      purpose and that proper credit be given. SETPOINT, Inc. makes
C      no warranty whatsoever regarding the accuracy of this package
C      and will assume no liability resulting from it's use.
C
C     ****************************************************************
C
C     Abstract: Send a file or group of files to a remote Kermit
C
C     MODIFICATION HISTORY
C
C     BY            DATE     REASON            PROGRAMS AFFECTED
C
C     ****************************************************************
C
C     Author:  Rick Burke           Version: A.0    Date: Sep-86
C
C     Calling Parameters:
C
C     R    X            - Dummy argument requred by functions
C
C     ****************************************************************
C
C     Messages generated by this module :  None
C
C     ****************************************************************
C
C     Subroutines called directly :  SBREAK, SDATA, SEOF, SFILE,
C                                    SINIT, SPACK
C
C     ****************************************************************
C
C     Files referenced :  None
C
C     ****************************************************************
C
C     Local variable definitions :
C
C     STATUS       - Flag to indicate that all work is done
C     TV1          - Packet type for SPACK call
C     TV2          - Packet number for SPACK call
C     TV3          - Packet Length for SPACK call
C     TV4          - Data for packet to be sent to remote Kermit
C
C     ****************************************************************
C
C     Commons referenced :  KER, KERPAR, and XBYTE local commons
C
C     ****************************************************************
C
C     (*$END.DOCUMENT*)
C
C     ****************************************************************
C     *                                                              *
C     *         D I M E N S I O N   S T A T E M E N T S              *
C     *                                                              *
C     ****************************************************************
C
      IMPLICIT INTEGER (A-Z)
C
C     ****************************************************************
C     *                                                              *
C     *         T Y P E   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         C O M M O N   S T A T E M E N T S                    *
C     *                                                              *
C     ****************************************************************
C
      INCLUDE USL/KERCOM
C
      INCLUDE USL/KERPMC
C
      COMMON /XBYTE/ XNEW,XCOUNT,XLIN(132),XEOF
C
C     ****************************************************************
C     *                                                              *
C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         D A T A   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C
C     Code starts here :
C
      STATE = BIGS
      XNEW = YES
      XCOUNT = 1
      XEOF = NO
      N = 0
      NUMTRY = 0
      STATUS = YES
C
C----->  Loop to send a packet, until STATUS <> YES.
C
   10 CONTINUE
      IF (STATUS .NE. YES) RETURN
C
C-----> Is this a data packet?
C
      IF (STATE .NE. BIGD) GO TO 20
      STATE = SDATA (X)
      GO TO 10
C
C----->  Is this a file header packet?
C
   20 CONTINUE
      IF (STATE .NE. BIGF) GO TO 30
      STATE = SFILE (X)
      GO TO 10
   30 CONTINUE
C
C----->  Is this an EOF header packet?
C
      IF (STATE .NE. BIGZ) GO TO 40
      STATE = SEOF (X)
      GO TO 10
   40 CONTINUE
C
C----->  Is this an initialization packet?
C
      IF (STATE .NE. BIGS) GO TO 50
      STATE = SINIT (X)
      GO TO 10
   50 CONTINUE
C
C----->  Is this a BREAK packet?
C
      IF (STATE .NE. BIGB) GO TO 60
      STATE = SBREAK (X)
      GO TO 10
   60 CONTINUE
C
C----->  Is the transfer complete?
C
      IF (STATE .NE. BIGC) GO TO 70
      SENDSW = YES
      RETURN
   70 CONTINUE
C
C----->  Did the file transfer fail?
C
      IF (STATE .NE. BIGA) GO TO 80
      SENDSW = NO
      TV1 = BIGE
      TV2 = N
      TV3 = 0
      TV4 = 0
C
C----->  Send an error packet.
C
      CALL SPACK (TV1,TV2,TV3,TV4)
      RETURN
   80 CONTINUE
C
C----->  Unknown STATE, signal file transfer failure.
C
      SENDSW = NO
      RETURN
      END
<<< seof. >>>
      INTEGER FUNCTION SEOF (X)
C
C     ****************************************************************
C
C              KERMIT for the MODCOMP MAXIV operating system
C
C        Compliments of:
C
C                         SETPOINT, Inc.
C                      10245 Brecksville Rd.
C                      Brecksville, Ohio 44141
C
C
C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
C      of this version hereby grant permission to copy this software
C      provided that it is not used for an explicitly commercial
C      purpose and that proper credit be given. SETPOINT, Inc. makes
C      no warranty whatsoever regarding the accuracy of this package
C      and will assume no liability resulting from it's use.
C
C     ****************************************************************
C
C     Abstract:  Send an EOF packet to the other Kermit.
C
C     MODIFICATION HISTORY
C
C     BY            DATE     REASON            PROGRAMS AFFECTED
C
C     ****************************************************************
C
C     Author:  Rick Burke           Version: A.0    Date: Sep-86
C
C     Calling Parameters:
C
C     R    X            - Dummy argument required by FORTRAN
C
C     ****************************************************************
C
C     Messages generated by this module :  None
C
C     ****************************************************************
C
C     Subroutines called directly :  DGETLI, MOD, PACK, POSUSL,
C                                    PUTLIN, RPACK, SCOPY, SPACK
C
C     ****************************************************************
C
C     Files referenced :  None
C
C     ****************************************************************
C
C     Local variable definitions :
C
C     AONE         - Index variable
C     BONE         - Index variable
C     FOUND        - Flag for existing file found
C     LEN          - Length of received packet
C     NUM          - Number of received packet
C     STATUS       - Status of received packet
C     TEMP         - Function code value from DGETLI
C     TNUM         - Packet number of transmitted packet
C     TV1          - Temporary variable
C     TV2          - Temporary variable
C     TV3          - Temporary variable
C     ALIN(132)    - Line buffer with file name read from
C                    scratch partition
C     FNAM(4)      - Packed file name array
C
C     ****************************************************************
C
C     Commons referenced :  KERCOM, KERPMC and UFTTBC local commons
C
C     ****************************************************************
C
C     (*$END.DOCUMENT*)
C
C     ****************************************************************
C     *                                                              *
C     *         D I M E N S I O N   S T A T E M E N T S              *
C     *                                                              *
C     ****************************************************************
C
      IMPLICIT INTEGER (A-Z)
C
      INTEGER*2 ALIN(132),     FNAM(4)
C
C     ****************************************************************
C     *                                                              *
C     *         T Y P E   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
      LOGICAL*2   FOUND
C
C     ****************************************************************
C     *                                                              *
C     *         C O M M O N   S T A T E M E N T S                    *
C     *                                                              *
C     ****************************************************************
C
      INCLUDE USL/KERCOM
      INCLUDE USL/KERPMC
      INCLUDE USL/UFTTBC
C
C     ****************************************************************
C     *                                                              *
C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         D A T A   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C
C     Code starts here :
C
C----->  Assume an error.
C
      SEOF = BIGA
C
C----->  Check if maximum number of retries exceeded.
C
      IF (NUMTRY .GT. MAXTRY) RETURN
      NUMTRY = NUMTRY+1
C
C----->  Send the EOF packet.
C
      AONE = 1
      BONE = 1
      TNUM = N
      TV1 = BIGZ
      TV2 = 0
      TV3 = 0
      CALL SPACK (TV1,TNUM,TV2,TV3)
      STATUS = RPACK (LEN,NUM,RECPKT)
C
C----->  Branch if response was not a NAK.
C
      IF (STATUS .NE. BIGN) GO TO 10
      IF (N .NE. NUM-1) SEOF = STATE
      RETURN
   10 CONTINUE
C
C----->  Branch if response was not an ACK.
C
      IF (STATUS .NE. BIGY) GO TO 80
      IF (N .EQ. NUM) GO TO 20
      SEOF = STATE
      RETURN
   20 CONTINUE
C
C----->  Reset the retry counter and bump the packet number.
C
      NUMTRY = 0
      N = MOD (N+1,64)
   30 CONTINUE
C
C----->  Check whether there is another file to send.
C
      SCRLUN = IUFT(2,9)
      READ (SCRLUN,1000,END=35) FNAM
 1000 FORMAT (4A2)
      GO TO 40
   35 CONTINUE
      SEOF = BIGB
      RETURN
   40 CONTINUE
C
C----->  There is another file to send, make sure that it exists.
C
      CALL POSUSL (IUFT(2,7),FNAM,FOUND)
      IF (FOUND) GO TO 50
C
C------>  Requested file not present.
C
      IF (HOSTON .NE. NO) GO TO 30
      WRITE (LOCALO,1010) FNAM
 1010 FORMAT (' FILE NOT FOUND--> ',4A2)
      GO TO 30
   50 CONTINUE
C
C----->  We have another valid file to send.
C
      DO 60 I=1,8
      IWORD = FNAM((I+1)/2)
      IF (MOD(I,2) .NE. 0) FILNAM(I) = ISHFT (IWORD,-8)
      IF (MOD(I,2) .EQ. 0) FILNAM(I) = IAND (IWORD,4Z00FF)
      IF (FILNAM(I) .EQ.     0 .OR.
     >    FILNAM(I) .EQ. BLANK     ) GO TO 70
   60 CONTINUE
      I = 9
   70 CONTINUE
      FILNAM(I) = LF
      FILNAM(I+1) = EOS
      SEOF = BIGF
      RETURN
   80 CONTINUE
C
C----->  If there was a checksum error, try again.
C
      IF (STATUS .EQ. BAD) SEOF = STATE
      RETURN
      END
<<< setker. >>>
C**********************************************************************
C
C              KERMIT for the MODCOMP MAXIV operating system
C
C        Compliments of:
C
C                         SETPOINT, Inc.
C                      10245 Brecksville Rd.
C                      Brecksville, Ohio 44141
C
C
C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
C      of this version hereby grant permission to copy this software
C      provided that it is not used for an explicitly commercial
C      purpose and that proper credit be given. SETPOINT, Inc. makes
C      no warranty whatsoever regarding the accuracy of this package
C      and will assume no liability resulting from it's use.
C
C
C**********************************************************************
<<< sfile. >>>
      INTEGER FUNCTION SFILE (X)
C
C     ****************************************************************
C
C              KERMIT for the MODCOMP MAXIV operating system
C
C        Compliments of:
C
C                         SETPOINT, Inc.
C                      10245 Brecksville Rd.
C                      Brecksville, Ohio 44141
C
C
C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
C      of this version hereby grant permission to copy this software
C      provided that it is not used for an explicitly commercial
C      purpose and that proper credit be given. SETPOINT, Inc. makes
C      no warranty whatsoever regarding the accuracy of this package
C      and will assume no liability resulting from it's use.
C
C     ****************************************************************
C
C     Abstract:  Send the file name to the other Kermit
C
C     MODIFICATION HISTORY
C
C
C     BY            DATE     REASON            PROGRAMS AFFECTED
C
C     ****************************************************************
C
C     Author:  Rick Burke           Version: A.0    Date: Sep-86
C
C     Calling Parameters:
C
C     R    X            - Dummy argument required by FORTRAN
C
C     ****************************************************************
C
C     Messages generated by this module :  None
C
C     ****************************************************************
C
C     Subroutines called directly :  BUFILL, MOD, PUTLIN, RPACK,
C                                    SCOPY, SPACK
C
C     ****************************************************************
C
C     Files referenced :  None
C
C     ****************************************************************
C
C     Local variable definitions :
C
C     AONE         - Index variable
C     BONE         - Index variable
C     LEN          - Length of file name
C     NUM          - Packet number of received data
C     STATUS       - Status of the recieved packet
C     TNUM         - Packet number of transmitted data
C     TV1          - Temporary variable
C     ALIN(132)    - Line buffer for file name
C
C     ****************************************************************
C
C     Commons referenced :  KER, KERPAR, and XBYTE local commons
C
C     ****************************************************************
C
C     (*$END.DOCUMENT*)
C
C     ****************************************************************
C     *                                                              *
C     *         D I M E N S I O N   S T A T E M E N T S              *
C     *                                                              *
C     ****************************************************************
C
      IMPLICIT INTEGER (A-Z)
C
      INTEGER*2 ALIN(132)
C
C     ****************************************************************
C     *                                                              *
C     *         T Y P E   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         C O M M O N   S T A T E M E N T S                    *
C     *                                                              *
C     ****************************************************************
C
      INCLUDE USL/KERCOM
      INCLUDE USL/KERPMC
      INCLUDE USL/UFTTBC
C
      COMMON /XBYTE/ XNEW,XCOUNT,XLIN(132),XEOF
C
C     ****************************************************************
C     *                                                              *
C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         D A T A   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C
C     Code starts here :
C
C----->  Assume an error.
C
       SFILE = BIGA
C
C------>  Maximum no. of retries exceeded?
C
      IF (NUMTRY .GT. MAXTRY) RETURN
      NUMTRY = NUMTRY+1
C
C----->  Calculate the length of the file name.
C
      LEN = 1
   10 CONTINUE
      IF (FILNAM(LEN) .EQ. EOS) GO TO 20
      LEN = LEN + 1
      GO TO 10
   20 CONTINUE
      LEN = LEN - 2
C
C----->  If we are running locally then display the file name.
C
      IF (HOSTON .NE. NO .OR.
     >    NUMTRY .GT.  1     ) GO TO 30
      DO 25 I=1,LEN
      ALIN(I) = ISHFT (FILNAM(I),8)
   25 CONTINUE
      WRITE (LOCALO,1000) (ALIN(I),I=1,LEN)
 1000 FORMAT (' SENDING FILE--> ',8A1)
      WRITE (LOCALO,1010)
 1010 FORMAT (/)
   30 CONTINUE
C
C----->  Send the file name packet.
C
      TNUM = N
      TV1 = BIGF
      CALL SPACK (TV1,TNUM,LEN,FILNAME)
      STATUS = RPACK (LEN,NUM,RECPKT)
C
C----->  Branch if the packet was not NAKed.
C
      IF (STATUS .NE. BIGN) GO TO 40
      IF (N .EQ. NUM-1) RETURN
      SFILE = STATE
      RETURN
   40 CONTINUE
C
C----->  Branch if the packet was not ACKed.
C
      IF (STATUS .NE. BIGY) GO TO 60
C
C----->  Branch if packet number was OK.
C
      IF (N .EQ. NUM) GO TO 50
      SFILE = STATE
      RETURN
   50 CONTINUE
C
C----->  Reset retry counter and bump packet number.
C
      NUMTRY = 0
      N = MOD (N+1,64)
C
C----->  Get ready to begin sending the data.
C
      XNEW = YES
      XCOUNT = 1
      XEOF = NO
      CALL CMRI4 (IUFT(2,7),40)
      SIZE = BUFILL (PACKET)
      IF (SIZE .EQ. EOF) RETURN
      SFILE = BIGD
      RETURN
   60 CONTINUE
C
C----->  Handle a checksum error or unexpected packet type.
C
      IF (STATUS .EQ. BAD) SFILE = STATE
      RETURN
      END
<<< shelp. >>>
      SUBROUTINE SHELP
C
C     ****************************************************************
C
C              KERMIT for the MODCOMP MAXIV operating system
C
C        Compliments of:
C
C                         SETPOINT, Inc.
C                      10245 Brecksville Rd.
C                      Brecksville, Ohio 44141
C
C
C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
C      of this version hereby grant permission to copy this software
C      provided that it is not used for an explicitly commercial
C      purpose and that proper credit be given. SETPOINT, Inc. makes
C      no warranty whatsoever regarding the accuracy of this package
C      and will assume no liability resulting from it's use.
C
C     ****************************************************************
C
C     Abstract:  Display the help file contents on the terminal.
C
C     MODIFICATION HISTORY
C
C     BY            DATE     REASON            PROGRAMS AFFECTED
C
C     ****************************************************************
C
C     Author:  Rick Burke           Version: A.0    Date: Aug-86
C
C     Calling Parameters:  None
C
C     ****************************************************************
C
C     Messages generated by this module :  None
C
C     ****************************************************************
C
C     Subroutines called directly :  ASSGN4, CMRI4, DGETLI, PACK,
C                                    POSUSL
C
C     ****************************************************************
C
C     Files referenced :  None
C
C     ****************************************************************
C
C     Local variable definitions :
C
C     FOUND        - Flag for requested file found and positioned
C     HLPUSL       - CAN code of logical file where help file resides
C     HLPFIL(4)    - Help file name in ASCII
C     LEN          - Length of output record
C
C     ****************************************************************
C
C     Commons referenced :  KER, KERPMC
C
C     ****************************************************************
C
C     (*$END.DOCUMENT*)
C
C     ****************************************************************
C     *                                                              *
C     *         D I M E N S I O N   S T A T E M E N T S              *
C     *                                                              *
C     ****************************************************************
C
      IMPLICIT INTEGER (A-Z)
      INTEGER*2   HLPFIL(4),   ALIN(132)
C
C     ****************************************************************
C     *                                                              *
C     *         T Y P E   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
      LOGICAL*2   FOUND
C
C     ****************************************************************
C     *                                                              *
C     *         C O M M O N   S T A T E M E N T S                    *
C     *                                                              *
C     ****************************************************************
C
      INCLUDE USL/KERCOM
      INCLUDE USL/KERPMC
      INCLUDE USL/UFTTBC
C
C     ****************************************************************
C     *                                                              *
C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         D A T A   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
      DATA        HLPFIL /'HELPFILE'/
      DATA        HLPUSL /3@KEH/
C
C     ****************************************************************
C
C     Code starts here :
C
C----->  Assign KE7 (UFT #7) to the USL with the help file and
C----->  position to the help file.
C
      IUFT(3,7) = 4ZA000
      CALL ASSGN4 (IUFT(1,7),HLPUSL)
      CALL POSUSL (IUFT(2,7),HLPFIL,FOUND)
      IF (FOUND) GO TO 10
      WRITE (LOCALO,1000)
 1000 FORMAT (' FILE CONTAINING HELP INFORMATION IS NOT AVAILABLE')
      RETURN
   10 CONTINUE
      CALL CMRI4 (IUFT(2,7),40)
   20 CONTINUE
      IF (DGETLIN (ALIN,7) .EQ. EOF) GO TO 50
      DO 30 LEN=1,82
      IF (ALIN(LEN) .EQ. LF) GO TO 40
      ALIN(LEN) = ISHFT (ALIN(LEN),8)
   30 CONTINUE
   40 CONTINUE
      LEN = LEN - 1
      IF (LEN .GE. 80) LEN = 79
      WRITE (LOCALO,1010) (ALIN(I),I=1,LEN)
 1010 FORMAT (79A1)
      GO TO 20
   50 CONTINUE
      RETURN
      END
<<< sinit. >>>
      INTEGER FUNCTION SINIT (X)
C
C     ****************************************************************
C
C              KERMIT for the MODCOMP MAXIV operating system
C
C        Compliments of:
C
C                         SETPOINT, Inc.
C                      10245 Brecksville Rd.
C                      Brecksville, Ohio 44141
C
C
C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
C      of this version hereby grant permission to copy this software
C      provided that it is not used for an explicitly commercial
C      purpose and that proper credit be given. SETPOINT, Inc. makes
C      no warranty whatsoever regarding the accuracy of this package
C      and will assume no liability resulting from it's use.
C
C     ****************************************************************
C
C     Abstract:  Send an initial packet for the first connection
C                Tell the other Kermit what my parameters are.
C
C     MODIFICATION HISTORY
C
C     BY            DATE     REASON            PROGRAMS AFFECTED
C
C     ****************************************************************
C
C     Author:  Rick Burke           Version: A.0    Date: Sep-86
C
C     Calling Parameters:
C
C     R    X            - Dummy argument required by FORTRAN
C
C     ****************************************************************
C
C     Messages generated by this module :  None
C
C     ****************************************************************
C
C     Subroutines called directly : DGETLI, MOD, PACK, POSUSL,
C                                   RPACK, RPAR, SCOPY, SPACK,
C                                   SPAR
C
C     ****************************************************************
C
C     Files referenced :  None
C
C     ****************************************************************
C
C     Local variable definitions :
C
C     FOUND        - Flag indicating existing file name found
C     LEN          - Length of received apcket
C     NUM          - Number of received packet
C     SCRUFT       - UFT of assigned to scratch partition
C                    with list of files to be sent
C     STATUS       - Status of received packet
C     TNUM         - Number of transmitted packet
C     TEMP         - Function value returned by DGETLI
C     TV1          - Temporary variable
C     TV2          - Temporary variable
C     ALIN(132)    - File name buffer
C
C     ****************************************************************
C
C     Commons referenced :  KER and KERPAR local commons
C
C     ****************************************************************
C
C     (*$END.DOCUMENT*)
C
C     ****************************************************************
C     *                                                              *
C     *         D I M E N S I O N   S T A T E M E N T S              *
C     *                                                              *
C     ****************************************************************
C
      IMPLICIT INTEGER (A-Z)
C
      INTEGER*2 ALIN(132),     FNAM(4)
C
C     ****************************************************************
C     *                                                              *
C     *         T Y P E   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
      LOGICAL*2 FOUND
C
C     ****************************************************************
C     *                                                              *
C     *         C O M M O N   S T A T E M E N T S                    *
C     *                                                              *
C     ****************************************************************
C
      INCLUDE USL/KERCOM
      INCLUDE USL/KERPMC
      INCLUDE USL/UFTTBC
C
C     ****************************************************************
C     *                                                              *
C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         D A T A   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
      DATA        SCRUFT /9/
C
C     ****************************************************************
C
C     Code starts here :
C
C----->  Assume an error.
C
      SINIT = BIGA
C
C----->  Check if maximum number of retries exceeded.
C
      IF (NUMTRY .GT. MAXTRY) RETURN
      NUMTRY = NUMTRY+1
C
C----->  Get my required parameters.
C
      CALL SPAR (PACKET)
C
C----->  and send them to the remote.
C
      TNUM = N
      TV1 = BIGS
      TV2 = 6
      CALL SPACK (TV1,TNUM,TV2,PACKET)
      STATUS = RPACK (LEN,NUM,RECPKT)
C
C----->  Was the reply a NAK?  Branch if not.
C
      IF (STATUS .NE.BIGN) GO TO 10
      IF (N .NE. NUM-1) SINIT = STATE
      RETURN
   10 CONTINUE
C
C----->  Was the reply an ACK?  Branch if not.
C
      IF (STATUS .NE. BIGY) GO TO 60
      IF (N .EQ. NUM) GO TO 20
      SINIT = STATE
      RETURN
   20 CONTINUE
      CALL RPAR (RECPKT)
C
C----->  Reset the retry counter and bump the packet number.
C
      NUMTRY = 0
      N = MOD (N+1,64)
C
C----->  Get a valid file name from the file list.
C
   30 CONTINUE
      SCRLUN = IUFT(2,SCRUFT)
      READ (SCRLUN,1000,END=70) FNAM
 1000 FORMAT (4A2)
      CALL POSUSL (IUFT(2,7),FNAM,FOUND)
      IF (.NOT. FOUND) GO TO 30
      DO 40 I=1,8
      IWORD = FNAM((I+1)/2)
      IF (MOD(I,2) .NE. 0) FILNAM(I) = ISHFT (IWORD,-8)
      IF (MOD(I,2) .EQ. 0) FILNAM(I) = IAND (IWORD,4Z00FF)
      IF (FILNAM(I) .EQ.     0 .OR.
     >    FILNAM(I) .EQ. BLANK     ) GO TO 50
   40 CONTINUE
      I = 9
   50 CONTINUE
      FILNAM(I) = LF
      FILNAM(I+1) = EOS
      SINIT = BIGF
      RETURN
   60 CONTINUE
C
C----->  Handle a checksum error or unexpected packet type.
C
      IF (STATUS .EQ. BAD) SINIT = STATE
      RETURN
   70 CONTINUE
      RETURN
      END
<<< skipbl. >>>
      SUBROUTINE SKIPBL(LIN, I)
C
C     ****************************************************************
C
C              KERMIT for the MODCOMP MAXIV operating system
C
C        Compliments of:
C
C                         SETPOINT, Inc.
C                      10245 Brecksville Rd.
C                      Brecksville, Ohio 44141
C
C
C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
C      of this version hereby grant permission to copy this software
C      provided that it is not used for an explicitly commercial
C      purpose and that proper credit be given. SETPOINT, Inc. makes
C      no warranty whatsoever regarding the accuracy of this package
C      and will assume no liability resulting from it's use.
C
C     ****************************************************************
C
C     Abstract:  SEARCHES STRING FOR FIRST NON-BLANK CHARACTER
C
C     MODIFICATION HISTORY
C
C     BY            DATE     REASON            PROGRAMS AFFECTED
C
C     ****************************************************************
C
C     Author:  BOB BORGESON         Version: A.0    Date: Oct-86
C
C     Calling Parameters:
C
C     R    LIN          - INPUT STRING TO BE SEARCHED
C     R/W  I            - ON INPUT, WHERE TO START LOOKING FOR
C                         CHARACTERS; ON OUTPUT, WHERE FOUND
C
C     ****************************************************************
C
C     Messages generated by this module :  None
C
C     ****************************************************************
C
C     Subroutines called directly :
C
C     ****************************************************************
C
C     Files referenced :  None
C
C     ****************************************************************
C
C     Local variable definitions :
C
C     ****************************************************************
C
C     Commons referenced :  None
C
C     ****************************************************************
C
C     (*$END.DOCUMENT*)
C
C     ****************************************************************
C     *                                                              *
C     *         D I M E N S I O N   S T A T E M E N T S              *
C     *                                                              *
C     ****************************************************************
C
      IMPLICIT INTEGER (A-Z)
C
      INTEGER*2   LIN(1)
C
C     ****************************************************************
C     *                                                              *
C     *         T Y P E   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         C O M M O N   S T A T E M E N T S                    *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         D A T A   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C
C     Code starts here :
C
23000 IF(.NOT.(LIN(I) .EQ. 32 .OR. LIN(I) .EQ. 9))GOTO 23001
      I = I + 1
      GOTO 23000
23001 CONTINUE
      RETURN
      END
<<< spack. >>>
      SUBROUTINE SPACK (XTYPE,NUM,LEN,XDATA)
C
C     ****************************************************************
C
C              KERMIT for the MODCOMP MAXIV operating system
C
C        Compliments of:
C
C                         SETPOINT, Inc.
C                      10245 Brecksville Rd.
C                      Brecksville, Ohio 44141
C
C
C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
C      of this version hereby grant permission to copy this software
C      provided that it is not used for an explicitly commercial
C      purpose and that proper credit be given. SETPOINT, Inc. makes
C      no warranty whatsoever regarding the accuracy of this package
C      and will assume no liability resulting from it's use.
C
C     ****************************************************************
C
C     Abstract:  SEND THIS PACKET TO THE REMOTE KERMIT
C
C
C     MODIFICATION HISTORY
C
C     BY            DATE     REASON            PROGRAMS AFFECTED
C
C
C     ****************************************************************
C
C     Author: BOB BORGESON          Version: A.0    Date: Oct-86
C
C     Calling Parameters:
C
C     R    XTYPE     - DATA PACKET TYPE
C     R    NUM       - PACKET SEQUENCE NUMBER (MODULO 64)
C     R    LEN       - LENGTH IN WORDS OF XDATA
C     R    XDATA     - DATA PORTION OF PACKET
C
C     ****************************************************************
C
C     Messages generated by this module :  None
C
C     ****************************************************************
C
C     Subroutines called directly :  TOCHAR, TPUTCH
C
C     ****************************************************************
C
C     Files referenced :  None
C
C     ****************************************************************
C
C     Local variable definitions :
C
C     BUFFER  - SCRATCH TO PIECE TOGETHER THE WHOLE PACKET
C     CH      - UFT # TO OUTPUT TO
C     CHKSUM  - BLOCK CHECKSUM
C     COUNT   - RUNNING COUNT OF HOW MANY CHARACTERS IN PACKET
C
C     ****************************************************************
C
C     Commons referenced :  KER and KERPAR
C
C     ****************************************************************
C
C     (*$END.DOCUMENT*)
C
C     ****************************************************************
C     *                                                              *
C     *         D I M E N S I O N   S T A T E M E N T S              *
C     *                                                              *
C     ****************************************************************
C
      IMPLICIT INTEGER (A-Z)
C
      INTEGER*2   XDATA(1),    BUFFER(132)
C
C     ****************************************************************
C     *                                                              *
C     *         T Y P E   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         C O M M O N   S T A T E M E N T S                    *
C     *                                                              *
C     ****************************************************************
C
      INCLUDE USL/KERCOM
      INCLUDE USL/KERPMC
C
C     ****************************************************************
C     *                                                              *
C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         D A T A   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C
C     Code starts here :
C
C
C
C                                   !THIS IS THE CHANNEL TO SEND PACKET
C                                   !OUT ON, START WITH THE FIRST BYTE
      CH=RMTOUT
      I=1
C
  100 CONTINUE
C                                     !SEND OUT PADCHAR IF NEEDED
      IF(I.GT.PAD)GO TO 200
         CALL TPUTCH(PADCHAR,CH)
         I=I+1
         GO TO 100
  200 CONTINUE
C                                     !BUILD UP THE PACKET
      COUNT=1
      BUFFER(COUNT)=SOH
      COUNT=COUNT+1
      CHKSUM=TOCHAR(LEN+3)
      BUFFER(COUNT)=TOCHAR(LEN+3)
      COUNT=COUNT+1
      CHKSUM=CHKSUM+TOCHAR(NUM)
      BUFFER(COUNT)=TOCHAR(NUM)
      COUNT=COUNT+1
      CHKSUM=CHKSUM+XTYPE
      BUFFER(COUNT)=XTYPE
      COUNT=COUNT+1
C
C                                    !COPY THE CONTENT OF PACKET INFORMA
      IF (LEN .LT. 1) GO TO 310
      DO 300 I=1,LEN
C                                    !CALCULATE THE CHECKSUM
         BUFFER(COUNT)=XDATA(I)
         COUNT=COUNT+1
         CHKSUM=CHKSUM+XDATA(I)
  300 CONTINUE
  310 CONTINUE
C
      TV1=IAND(CHKSUM,192)
      TV2=TV1/64
      TV3=TV2+CHKSUM
      CHKSUM=IAND(TV3,63)
      BUFFER(COUNT)=TOCHAR(CHKSUM)
      COUNT=COUNT+1
      BUFFER(COUNT)=EOL
      BUFFER(COUNT+1)=EOS
      COUNT=1
      CH=RMTOUT
C
C                                                !SEND OUT THE PACKET
  400 CONTINUE
      IF(BUFFER(COUNT).EQ.EOS)GO TO 500
         CALL TPUTCH(BUFFER(COUNT),CH)
         COUNT=COUNT+1
         GO TO 400
  500 CONTINUE
      RETURN
      END
<<< spar. >>>
      SUBROUTINE SPAR(XDATA)
C
C     ****************************************************************
C
C              KERMIT for the MODCOMP MAXIV operating system
C
C        Compliments of:
C
C                         SETPOINT, Inc.
C                      10245 Brecksville Rd.
C                      Brecksville, Ohio 44141
C
C
C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
C      of this version hereby grant permission to copy this software
C      provided that it is not used for an explicitly commercial
C      purpose and that proper credit be given. SETPOINT, Inc. makes
C      no warranty whatsoever regarding the accuracy of this package
C      and will assume no liability resulting from it's use.
C
C     ****************************************************************
C
C     Abstract:  SET UP THE INIT PACKET (OUR REQUIREMENTS)
C
C     MODIFICATION HISTORY
C
C     BY            DATE     REASON            PROGRAMS AFFECTED
C
C     ****************************************************************
C
C     Author: BOB BORGESON          Version: A.0    Date: Oct-86
C
C     Calling Parameters:
C
C     R/W  XDATA     - THE DATA PACKET
C
C     ****************************************************************
C
C     Messages generated by this module :  None
C
C     ****************************************************************
C
C     Subroutines called directly : CTL, TOCHAR
C
C     ****************************************************************
C
C     Files referenced :  None
C
C     ****************************************************************
C
C     Local variable definitions :
C
C     XZERO   -  CONTAINS THE VALUE ZERO
C
C     ****************************************************************
C
C     Commons referenced :  KER and KERPAR
C
C     ****************************************************************
C
C     (*$END.DOCUMENT*)
C
C     ****************************************************************
C     *                                                              *
C     *         D I M E N S I O N   S T A T E M E N T S              *
C     *                                                              *
C     ****************************************************************
C
      IMPLICIT INTEGER (A-Z)
C
      INTEGER*2   XDATA(1)
C
C     ****************************************************************
C     *                                                              *
C     *         T Y P E   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         C O M M O N   S T A T E M E N T S                    *
C     *                                                              *
C     ****************************************************************
C
      INCLUDE USL/KERCOM
      INCLUDE USL/KERPMC
C
C     ****************************************************************
C     *                                                              *
C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         D A T A   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C
C     Code starts here :
C
      XDATA(1)=TOCHAR(PAKSIZ)
      XDATA(2)=TOCHAR(10)
      XDATA(3)=TOCHAR(MYPAD)
      XDATA(4)=CTL(MYPCHA)
      XDATA(5)=TOCHAR(MYEOL)
      XDATA(6)=MYQUOTE
C
      RETURN
      END
<<< squit. >>>
      SUBROUTINE SQUIT
C
C     ****************************************************************
C
C              KERMIT for the MODCOMP MAXIV operating system
C
C        Compliments of:
C
C                         SETPOINT, Inc.
C                      10245 Brecksville Rd.
C                      Brecksville, Ohio 44141
C
C
C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
C      of this version hereby grant permission to copy this software
C      provided that it is not used for an explicitly commercial
C      purpose and that proper credit be given. SETPOINT, Inc. makes
C      no warranty whatsoever regarding the accuracy of this package
C      and will assume no liability resulting from it's use.
C
C     ****************************************************************
C
C     Abstract:  Final EXIT from Kermit program. If any files have been
C                received, let user change to MAXIV compatible names
C                and select their USL source library.
C
C     MODIFICATION HISTORY
C
C     BY            DATE     REASON            PROGRAMS AFFECTED
C
C     ****************************************************************
C
C     Author:  Rick Burke           Version: A.0    Date:  Aug-86
C
C     Calling Parameters:  None
C
C     ****************************************************************
C
C     Messages generated by this module :  None
C
C     ****************************************************************
C
C     Subroutines called directly : EXIT, RSTORE, WEOF
C
C     ****************************************************************
C
C     Files referenced :  None
C
C     ****************************************************************
C
C     Local variable definitions :  None
C
C     ****************************************************************
C
C     Commons referenced :  UFTTBL
C
C     ****************************************************************
C
C     (*$END.DOCUMENT*)
C
C     ****************************************************************
C     *                                                              *
C     *         D I M E N S I O N   S T A T E M E N T S              *
C     *                                                              *
C     ****************************************************************
C
      IMPLICIT INTEGER (A-Z)
C
C     ****************************************************************
C     *                                                              *
C     *         T Y P E   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         C O M M O N   S T A T E M E N T S                    *
C     *                                                              *
C     ****************************************************************
C
      INCLUDE USL/KERCOM
      INCLUDE USL/KERPMC
      INCLUDE USL/UFTTBC
C
C     ****************************************************************
C     *                                                              *
C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         D A T A   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C
C     Code starts here :
C
C----->  First, write EOF at the end of the received file list.
C
      CALL WEOF(IUFT(1,5))
C
C----->  Next, terminate any read to the remote Kermit.
C
      CALL TERMIN (IUFT(1,4),.FALSE.)
C
C---->   CALL ROUTINE TO CATALOG FILES
C
      CALL RSTORE
C
C
      WRITE(LOCALO,1000)
 1000 FORMAT(' KERMIT-MAXIV EXITING...')
      CALL EXIT
      RETURN
      END
<<< srecei. >>>
      SUBROUTINE SRECEIVE
C
C     ****************************************************************
C
C              KERMIT for the MODCOMP MAXIV operating system
C
C        Compliments of:
C
C                         SETPOINT, Inc.
C                      10245 Brecksville Rd.
C                      Brecksville, Ohio 44141
C
C
C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
C      of this version hereby grant permission to copy this software
C      provided that it is not used for an explicitly commercial
C      purpose and that proper credit be given. SETPOINT, Inc. makes
C      no warranty whatsoever regarding the accuracy of this package
C      and will assume no liability resulting from it's use.
C
C     ****************************************************************
C
C     Abstract:  MONITORS THE RECSW ROUTINE TO RECEIVE FILE
C
C     MODIFICATION HISTORY
C
C     BY            DATE     REASON            PROGRAMS AFFECTED
C
C     ****************************************************************
C
C     Author:  BOB BORGESON         Version: A.0    Date: Oct-86
C
C     Calling Parameters:
C
C     ****************************************************************
C
C     Messages generated by this module :  None
C
C     ****************************************************************
C
C     Subroutines called directly :  RECSW
C
C     ****************************************************************
C
C     Files referenced :  None
C
C     ****************************************************************
C
C     Local variable definitions :
C
C      STATUS   - RECEIVES THE KERMIT STATE CODE
C
C     ****************************************************************
C
C     Commons referenced :  KER and KERPAR
C
C     ****************************************************************
C
C     (*$END.DOCUMENT*)
C
C     ****************************************************************
C     *                                                              *
C     *         D I M E N S I O N   S T A T E M E N T S              *
C     *                                                              *
C     ****************************************************************
C
      IMPLICIT INTEGER (A-Z)
C
C     ****************************************************************
C     *                                                              *
C     *         T Y P E   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         C O M M O N   S T A T E M E N T S                    *
C     *                                                              *
C     ****************************************************************
C
      INCLUDE USL/UFTTBC
      INCLUDE USL/KERCOM
      INCLUDE USL/KERPMC
C
C     ****************************************************************
C     *                                                              *
C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         D A T A   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C
C     Code starts here :
C
C
C                             IF WE'RE IN HOST MODE, ISSUE BINARY READ
C
      IF(HOSTON .EQ. NO)GO TO 10
C
        CALL READ4(IUFT(1,4),BLIN(1,1),132,.FALSE.)
        CURCHN = 1
C
   10 CONTINUE
C
C                             CALL RECSW AND INDICATE SUCCESS OR FAILURE
         STATUS=RECSW(X)
          IF(STATUS.EQ.YES) WRITE(LOCALO,100)
          IF(STATUS.NE.YES) WRITE(LOCALO,101)
      RETURN
100   FORMAT(' FILE TRANSFER COMPLETED')
101   FORMAT(' FILE TRANSFER FAILED')
      END
<<< ssend. >>>
      SUBROUTINE SSEND (ALIN)
C
C     ****************************************************************
C
C              KERMIT for the MODCOMP MAXIV operating system
C
C        Compliments of:
C
C                         SETPOINT, Inc.
C                      10245 Brecksville Rd.
C                      Brecksville, Ohio 44141
C
C
C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
C      of this version hereby grant permission to copy this software
C      provided that it is not used for an explicitly commercial
C      purpose and that proper credit be given. SETPOINT, Inc. makes
C      no warranty whatsoever regarding the accuracy of this package
C      and will assume no liability resulting from it's use.
C
C     ****************************************************************
C
C     Abstract:  Send a file or group of files to a remote Kermit.
C
C
C     MODIFICATION HISTORY
C
C     BY            DATE     REASON            PROGRAMS AFFECTED
C
C     ****************************************************************
C
C     Author:  Rick Burke           Version: A.0    Date: Aug-86
C
C     Calling Parameters:
C
C     R    ALIN         - Command line with name of file or group
C                         of files to be sent.
C
C     ****************************************************************
C
C     Messages generated by this module :  None
C
C     ****************************************************************
C
C     Subroutines called directly :  ASSGN4, CTA4, ISCAN, ISHFT
C                                    PACK, POSUSL, READ4, REW4,
C                                    SENDSW, SKIPBL, WAIT, WEOF4
C
C     ****************************************************************
C
C     Files referenced :  None
C
C     ****************************************************************
C
C     Local variable definitions :
C
C     A1           - Character pointer into ALIN
C     BEGENT       - Index to 1st entry in directory sector
C     BKPTR        - Pointer to previous sector
C     CH           - UFT number for directory reads
C     ERR          - Error indicator for CTA4
C     FILEOK       - Success flag from POSUSL, file was found
C     FRPTR        - Forward pointer to next directory sector
C     I            - Index variable
C     IDX          - Index variable
C     IND          - Error indicator from WAIT call
C     JUSL         - CAN code of directory name to be sent to
C                    the remote Kermit
C     MXENT        - Number of directory entries per sector
C     SCRLUN       - LUN of file for file name list
C     SCRUFT       - UFT number of file to be used for temporary
C                    storage of file names to be sent to remote
C     SECTOR       - Directory partition file position index to read
C     STATUS       - Function value returned by SENDSW
C     TCOUNT       - Index variable
C     X            - Dummy argument required by SENDSW function
C     DIRBUF(128)  - Buffer for directory sector
C     DIRNAM(132)  - Buffer for ASCII name of directory to send
C     ENTRY(9,14)  - Table of directory entries for a sector
C     FILNME(4)    - ASCII file name (packed 2 chars per word)
C     TLINE(12)    - File name buffer (unpacked ASCII)
C
C     ****************************************************************
C
C     Commons referenced :  KER, KERPAR, and UFTTBL local commons
C
C     ****************************************************************
C
C     (*$END.DOCUMENT*)
C
C     ****************************************************************
C     *                                                              *
C     *         D I M E N S I O N   S T A T E M E N T S              *
C     *                                                              *
C     ****************************************************************
C
      IMPLICIT INTEGER (A-Z)
      INTEGER*2   ALIN(1),     DIRNAM(132), ENTRY(9,14), DIRBUF(128)
      INTEGER*2   FILNME(4),   TLINE(12)
C
C     ****************************************************************
C     *                                                              *
C     *         T Y P E   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
      LOGICAL*2   FILEOK
C
C     ****************************************************************
C     *                                                              *
C     *         C O M M O N   S T A T E M E N T S                    *
C     *                                                              *
C     ****************************************************************
C
      INCLUDE USL/KERCOM
      INCLUDE USL/KERPMC
      INCLUDE USL/UFTTBC
C
C     ****************************************************************
C     *                                                              *
C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
C     *                                                              *
C     ****************************************************************
C
      EQUIVALENCE (DIRBUF(1),BKPTR),        (DIRBUF(2),FRPTR)
      EQUIVALENCE (DIRBUF(3),ENTRY(1,1))
C
C     ****************************************************************
C     *                                                              *
C     *         D A T A   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
      DATA        MXENT /14/,  SCRUFT / 9/
C
C     ****************************************************************
C
C     Code starts here :
C
C----->  If we're in HOST mode, issue binary READ.
C
      IF (HOSTON .NE. YES) GO TO 5
      CURCHN = 1
      CALL READ4 (IUFT(1,4),BLIN(1,CURCHN),132,.FALSE.)
    5 CONTINUE
C
C----->  Initialize the logical unit for the file name list.
C
      SCRLUN = IUFT(2,SCRUFT)
C
C----->  Position character pointer to start of file specification.
C
      A1 = 1
      CALL SKIPBL(ALIN,A1)
      IF (ALIN(A1) .NE. LF) GO TO 10
      WRITE (LOCALO,1000)
 1000 FORMAT (' PROPER FORMAT IS "SEND FILENAME" OR ',/
     >        ' "SEND @FILENAME"')
      RETURN
   10 CONTINUE
C
C----->  Check for "@" as next character.  If so then the request is
C----->  to send an entire directory of files.
C
      IF (ALIN(A1) .NE. ATSIGN) GO TO 90
      A1 = A1 + 1
C
C----->  Extract the directory name from the command line and
C----->  convert it to CAN code.
C
      DIRNAM(1) = 4Z2020
      DIRNAM(2) = 4Z2020
      DIRNAM(3) = 4Z2020
      CALL PACK (ALIN(A1),DIRNAM)
      JUSL = ISCAN (DIRNAM)
C
C----->  Set up the UFT for reading the directory.
C
      CH = 7
      IUFT(3,CH) = 4Z9400
      CALL ASSGN4 (IUFT(1,CH),JUSL)
C
C----->  Rewind the scratch file that will contain the names of the
C----->  files to be sent.
C
      CALL REW4 (IUFT(1,SCRUFT))
C
C----->  Read a directory and put the file names into the scratch file.
C
      FRPTR = 0
   20 CONTINUE
      IUFT(4,CH) = FRPTR
      SECTOR = FRPTR
      CALL READ4 (IUFT(1,CH),DIRBUF,256)
      IF (SECTOR .NE. 0) GO TO 30
C
C----->  Was the directory found?
C
      IF (BKPTR .EQ. -1) GO TO 30
      WRITE (1,1010) (DIRNAM(I),I=1,4)
 1010 FORMAT (' DIRECTORY NOT FOUND ON ',3A2)
      RETURN
C
C----->  Loop through this sector to find a file entry.
C
   30 CONTINUE
      BEGENT = 1
      IF (SECTOR .EQ. 0) BEGENT = 2
      DO 40 IDX=BEGENT,MXENT
      IF (ENTRY(1,IDX) .NE.      0 .AND.
     >    ENTRY(1,IDX) .NE. 4ZFEFE      ) GO TO 50
   40 CONTINUE
C
C----->  Entry not found, go read the next sector unless this
C----->  sector was the last (FRPTR = -1).
C
      IF (FRPTR .LT. 0) GO TO 80
      GO TO 20
   50 CONTINUE
      IF (ENTRY(1,IDX) .EQ. 4ZFFFF) GO TO 80
      IF (ENTRY(1,IDX) .EQ.      0 .OR.
     >    ENTRY(1,IDX) .EQ. 4ZFEFE     ) GO TO 75
C
C----->  Got a file entry, so convert the file
C----->  name into the unpacked ASCII string for
C----->  DPUTLIN.
C
      CALL CTA4 (ENTRY(1,IDX),TLINE(1),ERR)
      CALL CTA4 (ENTRY(2,IDX),TLINE(4),ERR)
      CALL CTA4 (ENTRY(3,IDX),TLINE(7),ERR)
      DO 55 I=1,9
      TLINE(I) = ISHFT (TLINE(I),-8)
   55 CONTINUE
C
C----->  Remove trailing blanks.
C
      DO 60 I=1,9
      TCOUNT = 10 - I
      IF (TLINE(TCOUNT) .NE.     0 .AND.
     >    TLINE(TCOUNT) .NE. BLANK      ) GO TO 70
   60 CONTINUE
      TCOUNT = 0
   70 CONTINUE
C
C----->  Add CR/EOS at the end.
C
      TLINE(TCOUNT+1) = LF
      TLINE(TCOUNT+2) = EOS
C
C----->  Write the file name out to the scratch file.
C
      FILNME(1) = '  '
      FILNME(2) = '  '
      FILNME(3) = '  '
      FILNME(4) = '  '
      CALL PACK (TLINE,FILNME)
      WRITE (SCRLUN,1050) FILNME
 1050 FORMAT (4A2)
   75 CONTINUE
C
C----->  Loop back to get another file name.
C
      IDX = IDX + 1
      IF (IDX .LE. MXENT) GO TO 50
      GO TO 20
   80 CONTINUE
C
C----->  Write an EOF after the last name in the scratch partition.
C
      CALL WEOF4 (IUFT(1,SCRUFT))
      GO TO 110
   90 CONTINUE
C
C----->  Write the file name in the command line to the scratch
C----->  partition.
C
C----->  First, try to position to the file.
C
      CH = 7
      CALL ASSGN4 (IUFT(1,CH),SUSL)
      FILNME(1) = '  '
      FILNME(2) = '  '
      FILNME(3) = '  '
      FILNME(4) = '  '
      CALL PACK (ALIN(A1),FILNME)
      CALL POSUSL (IUFT(2,CH),FILNME,FILEOK)
      IF (FILEOK) GO TO 100
      WRITE (LOCALO,1020)
 1020 FORMAT (' REQUESTED SOURCE FILE NOT FOUND.',//)
      RETURN
  100 CONTINUE
C
C----->  Put the file name at the beginning of the scratch.
C
      CALL REW4 (IUFT(1,SCRUFT))
      WRITE (SCRLUN,1050) FILNME
      CALL WEOF4 (IUFT(1,SCRUFT))
  110 CONTINUE
C
C----->  Send the file(s) to the remote Kermit.
C
      CALL REW4 (IUFT(1,SCRUFT))
      CALL WAIT (DELAY,2,IND)
      STATUS = SENDSW (X)
      IF (STATUS .EQ. YES) WRITE (LOCALO,1030)
 1030 FORMAT (' FILE TRANSFER COMPLETED.',//)
      IF (STATUS .NE. YES) WRITE (LOCALO,1040)
 1040 FORMAT (' FILE TRANSFER FAILED.',//)
      RETURN
      END
<<< sset. >>>
      SUBROUTINE SSET (ALIN)
C
C     ****************************************************************
C
C              KERMIT for the MODCOMP MAXIV operating system
C
C        Compliments of:
C
C                         SETPOINT, Inc.
C                      10245 Brecksville Rd.
C                      Brecksville, Ohio 44141
C
C
C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
C      of this version hereby grant permission to copy this software
C      provided that it is not used for an explicitly commercial
C      purpose and that proper credit be given. SETPOINT, Inc. makes
C      no warranty whatsoever regarding the accuracy of this package
C      and will assume no liability resulting from it's use.
C
C     ****************************************************************
C
C     Abstract: PARSE AND SET VARIOUS SELECTABLE PARAMETERS
C
C     MODIFICATION HISTORY
C
C     BY            DATE     REASON            PROGRAMS AFFECTED
C
C     ****************************************************************
C
C     Author:  Bob Borgeson         Version: A.0    Date: Aug-86
C
C     Calling Parameters:
C
C     R    ALIN         - SET COMMAND STRING
C
C     ****************************************************************
C
C     Messages generated by this module :
C
C          SEE THE FORMAT STATEMENTS GROUPED AT THE END OF THE CODE
C
C     ****************************************************************
C
C     Subroutines called directly :  SKIPBL, CTOI
C
C     ****************************************************************
C
C     Files referenced :  None
C
C     ****************************************************************
C
C     Local variable definitions :
C
C           BLIN      SCRATCH FOR CHECKING COMMANDS
C           CHRFND    # OF CHARACTERS FOUND
C           CMDLEN    MAXIMUM LENGTH OF SET COMMANDS
C           CMDTBL    TABLE OF UNPACKED ASCII COMMANDS
C           FOUND     # OF COMMANDS FOUND
C           Fx        CHARACTER POSITIONS TO START SEARCH AT
C           GOODSP    IF = 1 THE SELECTED BAUD RATE IS OK
C           KUSL      UNPACKED USL NAME
C           NUMCMD    # OF COMMANDS SEARCHED FOR
C           NUMPAR    # OF PARITY KEYWORDS SEARCHED FOR
C           PARLEN    MAXIMUM LENGTH OF PARITY KEYWORD
C           TV        STARTING CHARACTER OF COMMAND
C           WCHCMD    WHICH COMMAND WAS FOUND
C           WCHPAR    WHICH PARITY WAS CHOSEN
C           Zx        CHARACTER POSITION TO START SEARCH AT
C
C     ****************************************************************
C
C     Commons referenced :  KER and KERPAR local commons
C
C     ****************************************************************
C
C     (*$END.DOCUMENT*)
C
C     ****************************************************************
C     *                                                              *
C     *         D I M E N S I O N   S T A T E M E N T S              *
C     *                                                              *
C     ****************************************************************
C
      IMPLICIT INTEGER (A-Z)
C
      INTEGER*2   ALIN(1) ,  BLIN(132) , KUSL(3), CMDTBL(8,9)
     >         ,  PARTBL(6,5)
C
C     ****************************************************************
C     *                                                              *
C     *         T Y P E   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         C O M M O N   S T A T E M E N T S                    *
C     *                                                              *
C     ****************************************************************
C
      INCLUDE USL/KERCOM
      INCLUDE USL/KERPMC
C
C     ****************************************************************
C     *                                                              *
C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         D A T A   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
      DATA        CMDTBL       /66,65,85,68,10002,0,0,0,
     >                          68,69,76,65,89,10002,0,0,
     >                          80,65,82,73,84,89,10002,0,
     >                          69,83,67,65,80,69,10002,0,
     >                          80,65,67,75,69,84,10002,0,
     >                          83,79,72,10002,0,0,0,0,
     >                          69,79,76,10002,0,0,0,0,
     >                          77,89,81,85,79,84,69,10002,
     >                          85,83,76,10002,0,0,0,0/
C
      DATA        PARTBL       /79,68,68,10002,0,0,
     >                          69,86,69,78,10002,0,
     >                          77,65,82,75,10002,0,
     >                          83,80,65,67,69,10002,
     >                          78,79,78,69,10002,0/
C
      DATA   NUMPAR   / 5 /
     >      ,NUMCMD   / 9 /
     >      ,PARLEN   / 6 /
     >      ,CMDLEN   / 8 /
C
C     ****************************************************************
C
C     Code starts here :
C
C----->  Skip past SET to start of first parameter.
C
      A1 = 1
      CALL SKIPBL (ALIN,A1)
      TV = A1
C
C----->  Find the SET function - first strip this word
C
      FOUND = -1
      IEND = 81 - TV
C
      DO 10 I = 1,IEND
C
        BLIN(I) = ALIN(TV+I-1)
C
        IF((BLIN(I) .EQ. LF) .OR. (BLIN(I) .EQ. BLANK))GO TO 20
C
   10 CONTINUE
C
   20 CONTINUE
C
      BLIN(I) = LF
      BLIN(I+1) = EOS
C
      TV = I + 2
C
      DO 50 J = 1,NUMCMD
C
        DO 30 I = 1,CMDLEN
C
C-----> If you get LF, then we got a legal command
C
          IF(BLIN(I) .EQ. LF)GO TO 40
C
C-----> If end of command, then no match
C
          IF(CMDTBL(I,J) .EQ. EOS)GO TO 50
C
C-----> Check for matching character
C
          IF(BLIN(I) .NE. CMDTBL(I,J))GO TO 50
C
   30   CONTINUE
C
       GO TO 50
C
   40   CONTINUE
C
C------> Found your keyword
C
        WCHCMD = J
        FOUND = FOUND + 1
C
   50 CONTINUE
C
      IF (FOUND) 70 , 90 , 80
C
   70 CONTINUE
C
C----->   No command was recognized
C
      WRITE(LOCALO,75)
   75 FORMAT(' UNRECOGNIZED COMMAND - TYPE "HELP"')
      RETURN
C
   80 CONTINUE
C
C----->   The command was not unique
C
      WRITE(LOCALO,85)
   85 FORMAT(' AMBIGUOUS COMMAND - TYPE "HELP"')
      RETURN
C
   90 CONTINUE
C
C----->  Service the requested command
C
      GO TO(100,200,300,500,800,900,1000,1100,1200) , WCHCMD
C
  100 CONTINUE
C
C----->  Set BAUD rate.
C
C
C----->  If baud rate setting not supported, or in HOST mode,
C----->  do not allow baud rate to be set.
C
C+++++++
      HOSTON = NO
      SBAUD = YES
C+++++++++
      IF (SBAUD .NE. YES) GO TO 190
      IF (HOSTON .NE. YES) GO TO 120
      WRITE (LOCALO,9100)
      WRITE (LOCALO,9101)
      RETURN
  120 CONTINUE
C
C----->  Get the desired baud rate from the command line and
C----->  convert it to an integer.
C
      F1 = TV
      CALL SKIPBL (ALIN,F1)
      X = CTOI (ALIN,F1)
C
C----->  Validate the speed against the allowable values.
C
      IF (X .EQ.   300 .OR.
     >    X .EQ.  1200 .OR.
     >    X .EQ.  2400 .OR.
     >    X .EQ.  4800 .OR.
     >    X .EQ.  9600 .OR.
     >    X .EQ. 19200     ) GO TO 130
      WRITE (LOCALO,9102)
      RETURN
  130 CONTINUE
      SPEED = X
      RETURN
  190 CONTINUE
      WRITE (LOCALO,9103)
      RETURN
C
  200 CONTINUE
C
C----->  Set the initial packet delay period if not
C----->  in remote host mode.
C
      IF (HOSTON .NE. NO) GO TO 210
      WRITE (LOCALO,9104)
      RETURN
  210 CONTINUE
C
C----->  Get the delay value.
C
      F2 = TV
      CALL SKIPBL (ALIN,F2)
      X = CTOI (ALIN,F2)
      IF (X .GT. 0) GO TO 220
      WRITE (LOCALO,9105)
      RETURN
  220 CONTINUE
C
C----->  Only allow values in range of 0..60.
C
      IF (X .LE. 60) GO TO 230
      DELAY  =  60
      WRITE (LOCALO,9106)
      WRITE (LOCALO,9107)
      RETURN
  230 CONTINUE
      DELAY = X
      RETURN
  300 CONTINUE
C
C----->  Set data parity.
C
C+++++++++
      HOSTON = NO
      SPARITY = YES
C+++++++++++++
      IF (SPARITY  .NE.  YES) GO TO 390
      IF (HOSTON  .NE.  YES) GO TO 310
      WRITE (LOCALO,9108)
      WRITE (LOCALO,9109)
      RETURN
  310 CONTINUE
C
      F3 = TV
      CALL SKIPBL(ALIN,F3)
      TV = F3
C
C----->  Pull out the parity keyword
C
      DO 315 I = 1,6
C
        BLIN(I) = ALIN(TV+I-1)
        IF((BLIN(I) .EQ. LF) .OR. (BLIN(I) .EQ. BLANK))GO TO 320
C
  315 CONTINUE
C
  320 CONTINUE
C
      BLIN(I) = LF
      BLIN(I+1) = EOS
C
      FOUND = -1
C
      DO 345 J = 1,NUMPAR
C
        DO 325 I = 1,PARLEN
C
C------>   If end of keyword, then this is a good answer
C
          IF(BLIN(I) .EQ. LF)GO TO 335
C
C------>   If end of search pattern, no good
C
          IF(PARTBL(I,J) .EQ. EOS)GO TO 345
C
C------>   Check next character
C
          IF(BLIN(I) .NE. PARTBL(I,J))GO TO 345
C
  325   CONTINUE
C
        GO TO 345
C
  335   CONTINUE
C
C------>  Remember which keyword was found
C
        WCHPAR = J
        FOUND = FOUND + 1
C
  345 CONTINUE
C
      IF (FOUND) 385 , 350 , 80
C
  350 CONTINUE
C
      GO TO (360 , 360 , 380 , 370 , 360 ), WCHPAR
C
  360 CONTINUE
C
C----->  Set the selected parity flag
C
      PARITY = WCHPAR
      RETURN
C
  370 CONTINUE
C
C----->  This parity is not supported on MODCOMP
C
      WRITE(LOCALO,9110)
      RETURN
C
  380 CONTINUE
C
C----->  This parity is not supported on MODCOMP
C
      WRITE(LOCALO,9111)
      RETURN
C
  385 CONTINUE
C
      WRITE(LOCALO,9112)
      RETURN
C
  390 CONTINUE
C
C----->  Parity not selectable.
C
      WRITE (LOCALO,9113)
      RETURN
  500 CONTINUE
C
C----->  Set HOST mode escape character.
C
      IF (HOSTON .NE. YES) GO TO 510
      WRITE (LOCALO,9117)
      WRITE (LOCALO,9118)
      RETURN
  510 CONTINUE
      F5 = TV
      CALL SKIPBL (ALIN,F5)
      X = CTOI (ALIN,F5)
      IF (X .LE.  0 .OR.
     >    X .GE. 32      ) GO TO 520
      ESCHAR = X
      RETURN
  520 CONTINUE
      WRITE (LOCALO,9119)
      RETURN
  800 CONTINUE
C
C----->  Set the packet size.
C
      F8 = TV
      CALL SKIPBL(ALIN,F8)
      X = CTOI(ALIN,F8)
      IF (X .LE. 30 .OR.
     >    X .GE. 95     ) GO TO 810
      PAKSIZ = X
      RETURN
  810 CONTINUE
      WRITE (LOCALO,9126)
      RETURN
  900 CONTINUE
C
C----->  Set the start of header character.
C
      F9 = TV
      CALL SKIPBL (ALIN,F9)
      X = CTOI (ALIN,F9)
      IF (HOSTON .NE. YES) GO TO 930
      IF (X .NE. EOL) GO TO 910
      WRITE (LOCALO,9127)
      RETURN
  910 CONTINUE
      IF (X .LE.  0 .OR.
     >    X .GE. 32     ) GO TO 920
      SOH = X
      RETURN
  920 CONTINUE
      WRITE (LOCALO,9128)
      RETURN
  930 CONTINUE
      IF (X .NE.    EOL .AND.
     >    X .NE. PROMPT      ) GO TO 940
      WRITE (LOCALO,9129)
      WRITE (LOCALO,9130)
      RETURN
  940 CONTINUE
      IF (X .LE.  0 .OR.
     >    X .GE. 32     ) GO TO 950
      SOH = X
      RETURN
  950 CONTINUE
      WRITE (LOCALO,9131)
      WRITE (LOCALO,9132)
      RETURN
 1000 CONTINUE
C
C----->  Set the end-of-line character.
C
      F10 = TV
      CALL SKIPBL (ALIN,F10)
      X = CTOI (ALIN,F10)
      IF (HOSTON .NE. YES) GO TO 1030
      IF (X .NE. SOH) GO TO 1010
      WRITE (LOCALO,9133)
      RETURN
 1010 CONTINUE
      IF (X .LE.  0 .OR.
     >    X .GE. 32     ) GO TO 1020
      MYEOL = X
      RETURN
 1020 CONTINUE
      WRITE (LOCALO,9134)
      WRITE (LOCALO,9135)
      RETURN
 1030 CONTINUE
      IF (X .NE.    SOH .AND.
     >    X .NE. PROMPT      ) GO TO 1040
      WRITE (LOCALO,9136)
      WRITE (LOCALO,9137)
      RETURN
 1040 CONTINUE
      IF (X .LE.  0 .OR.
     >    X .GE. 32     )GO TO 1050
      MYEOL = X
      RETURN
 1050 CONTINUE
      WRITE (LOCALO,9138)
      WRITE (LOCALO,9139)
      RETURN
 1100 CONTINUE
C
C----->  Set the quoting character.
C
      F11 = TV
      CALL SKIPBL (ALIN,F11)
      X = CTOI (ALIN,F11)
      IF (X .LE.  32 .OR.
     >    X .GE. 127     ) GO TO 1110
      MYQUOTE = X
      RETURN
 1110 CONTINUE
      WRITE (LOCALO,9140)
      WRITE (LOCALO,9141)
      RETURN
 1200 CONTINUE
C
C----->  Set the USL directory for files to send.
C
        F12 = TV
        CALL SKIPBL (ALIN,F12)
C
C----->  Make the USL name is CAN codeable.
C
      CHRFND = 0
C
      DO 1210 I=1,3
      ICHAR = ALIN(F12+3-I)
C
      IF((ICHAR .EQ. LF) .OR. (ICHAR .EQ. EOS))ALIN(F12+3-I) = BLANK
      IF(((ICHAR .EQ. BLANK) .OR. (ICHAR .EQ. LF) .OR.
     >    (ICHAR .EQ. EOS)) .AND. (CHRFND .EQ. 0))GO TO 1210
      CHRFND = CHRFND + 1
C
      IF ((ICHAR .GE. BIGA .AND. ICHAR .LE. BIGZ) .OR.
     >    (ICHAR .GE. DIG0 .AND. ICHAR .LE. DIG9) .OR.
     >    (ICHAR .EQ. COLON)                      .OR.
     >    (ICHAR .EQ. PERIOD)                     .OR.
     >    (ICHAR .EQ. DOLLAR)                         ) GO TO 1210
      GO TO 1220
 1210 CONTINUE
C
      IF(CHRFND .EQ. 0)GO TO 1220
      GO TO 1230
C
 1220 CONTINUE
C
C-----> USL not can codeable.
C
      WRITE (LOCALO,9143)
      RETURN
 1230 CONTINUE
      KUSL(1) = ISHFT (ALIN(F12),8)
      KUSL(2) = ISHFT (ALIN(F12+1),8)
      KUSL(3) = ISHFT (ALIN(F12+2),8)
      SUSL = IACAN4 (KUSL)
      RETURN
 9100 FORMAT(' BAUD RATE SETTING NOT SUPPORTED')
 9101 FORMAT(' IN REMOTE HOST MODE')
 9102 FORMAT(' INVALID OR UNSUPPORTED BAUD RATE SELECTED')
 9103 FORMAT(' THIS SYSTEM DOES NOT SUPPORT BAUD SELECTION')
 9104 FORMAT(' DELAY SETTING NOT VALID IN LOCAL HOST MODE')
 9105 FORMAT(' INVALID DELAY SETTING')
 9106 FORMAT(' DELAY SETTING TOO LONG')
 9107 FORMAT(' DEFAULTED TO 60 SECONDS')
 9108 FORMAT(' PARITY SETTING NOT SUPPORTED')
 9109 FORMAT(' IN REMOTE HOST MODE')
 9110 FORMAT(' SPACE PARITY NOT SUPPORTED IN MAXIV')
 9111 FORMAT(' MARK PARITY NOT SUPPORTED IN MAXIV')
 9112 FORMAT(' PARITY SELECTED NOT VALID')
 9113 FORMAT(' PARITY SETTING NOT SUPPORTED IN THIS SYSTEM')
 9117 FORMAT(' ESCAPE SETTING NOT VALID IN')
 9118 FORMAT(' REMOTE HOST MODE')
 9119 FORMAT(' ESCAPE CHARACTER MUST BE BETWEEN 0 & 32')
 9126 FORMAT(' INVALID PACKET SIZE SPECIFIED')
 9127 FORMAT(' INVALID; IN CONFLICT WITH EOL')
 9128 FORMAT(' INVALID; SOH MUST BE BETWEEN 0 & 32')
 9129 FORMAT(' INVALID; IN CONFLICT WITH EOL')
 9130 FORMAT(' OR IBM PROMPT')
 9131 FORMAT(' INVALID; SOH MUST BE BETWEEN')
 9132 FORMAT(' 0 & 32')
 9133 FORMAT(' INVALID; IN CONFLICT WITH SOH')
 9134 FORMAT(' INVALID; EOL MUST BE BETWEEN')
 9135 FORMAT(' 0 & 32')
 9136 FORMAT(' INVALID; EOL IN CONFLICT WITH')
 9137 FORMAT(' SOH OR IBM PROMPT')
 9138 FORMAT(' INVALID; EOL MUST BE BETWEEN')
 9139 FORMAT(' 0 & 32')
 9140 FORMAT(' QUOTE CHARACTER MUST BE BETWEEN')
 9141 FORMAT(' 32 & 127')
 9142 FORMAT(' INVALID SET PARAMETER(S) DETECTED')
 9143 FORMAT(' USL NAME NOT CANCODEABLE')
 9144 FORMAT(' INVALID SET HOST MODE SELECTED')
      END
<<< sstatu. >>>
      SUBROUTINE SSTATUS
C
C     ****************************************************************
C
C              KERMIT for the MODCOMP MAXIV operating system
C
C        Compliments of:
C
C                         SETPOINT, Inc.
C                      10245 Brecksville Rd.
C                      Brecksville, Ohio 44141
C
C
C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
C      of this version hereby grant permission to copy this software
C      provided that it is not used for an explicitly commercial
C      purpose and that proper credit be given. SETPOINT, Inc. makes
C      no warranty whatsoever regarding the accuracy of this package
C      and will assume no liability resulting from it's use.
C
C     ****************************************************************
C
C     Abstract:  OUTPUT THE STATUS AND VALUES OF VARIABLES
C
C     MODIFICATION HISTORY
C
C     BY            DATE     REASON            PROGRAMS AFFECTED
C
C     ****************************************************************
C
C     Author: BOB BORGESON          Version: A.0    Date: Oct-86
C
C     Calling Parameters:  None
C
C     ****************************************************************
C
C     Messages generated by this module :  None
C
C     ****************************************************************
C
C     Subroutines called directly :  CTA4
C
C     ****************************************************************
C
C     Files referenced :  None
C
C     ****************************************************************
C
C     Local variable definitions :
C
C     KUSL   -  UNPACKED VERSION OF USL NAME  (IN HIGH ORDER BYTES)
C
C     ****************************************************************
C
C     Commons referenced :  KER, and KERPAR local commons
C
C     ****************************************************************
C
C     (*$END.DOCUMENT*)
C
C     ****************************************************************
C     *                                                              *
C     *         D I M E N S I O N   S T A T E M E N T S              *
C     *                                                              *
C     ****************************************************************
C
      IMPLICIT INTEGER (A-Z)
C
      INTEGER*2   KUSL(3)
C
C     ****************************************************************
C     *                                                              *
C     *         T Y P E   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         C O M M O N   S T A T E M E N T S                    *
C     *                                                              *
C     ****************************************************************
C
      INCLUDE USL/KERCOM
      INCLUDE USL/KERPMC
C
C     ****************************************************************
C     *                                                              *
C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         D A T A   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C
C     Code starts here :
C
C----->  Convert the USL name to ASCII.
C
      CALL CTA4 (SUSL,KUSL,IND)
      IF (IND .EQ. 1) GO TO 10
      KUSL(1) = '?'
      KUSL(2) = '?'
      KUSL(3) = '?'
   10 CONTINUE
C                                    !WE ARE RUNNING IN REMOTE HOST MODE
      IF(HOSTON.NE.YES)GO TO 1000
         WRITE (LOCALO,107)
         WRITE (LOCALO,104)DELAY
         WRITE (LOCALO,103)MYEOL
         WRITE (LOCALO,100)PAKSIZ
         WRITE (LOCALO,102)MYQUOTE
         WRITE (LOCALO,101)SOH
         WRITE (LOCALO,120)KUSL
         IF(STATE.EQ.BIGC) WRITE (LOCALO,108)
         IF(STATE .NE. BIGC)WRITE (LOCALO,109)
         RETURN
 1000 CONTINUE
           WRITE (LOCALO,110)
           WRITE (LOCALO,106)SPEED
           WRITE (LOCALO,103)MYEOL
           WRITE (LOCALO,105)ESCHAR
           IF(IBMON.NE.YES)GO TO 1100
              WRITE (LOCALO,117)
              WRITE (LOCALO,119)PROMPT
              GO TO 1200
 1100      CONTINUE
           WRITE (LOCALO,118)
 1200      CONTINUE
           WRITE (LOCALO,100)PAKSIZ
           IF(PARITY.EQ.1) WRITE (LOCALO,111)
           IF(PARITY.EQ.2) WRITE (LOCALO,112)
           IF(PARITY.EQ.3) WRITE (LOCALO,113)
           IF(PARITY.EQ.4) WRITE (LOCALO,114)
           IF((PARITY .LT. 1) .OR. (PARITY .GT. 4))WRITE (LOCALO,115)
           WRITE (LOCALO,102)MYQUOTE
           WRITE (LOCALO,101)SOH
           WRITE (LOCALO,120)KUSL
           WRITE (LOCALO,116)
           IF(STATE.EQ.BIGC) WRITE (LOCALO,108)
           IF(STATE .NE. BIGC)WRITE (LOCALO,109)
100   FORMAT(' PACKET SIZE = ',I4)
101   FORMAT(' SOH         = ',I4)
102   FORMAT(' MYQUOTE     = ',I4)
103   FORMAT(' MYEOL       = ',I4)
104   FORMAT(' DELAY (SEC) = ',I4)
105   FORMAT(' ESCAPE CHAR = ',I4)
106   FORMAT(' BAUD RATE   = ',I5)
107   FORMAT(' REMOTE HOST KERMIT MODE IN EFFECT')
108   FORMAT(' FILE TRANSFER STATE = C')
109   FORMAT(' FILE TRANSFER STATE = A')
110   FORMAT(' LOCAL KERMIT MODE IN EFFECT')
111   FORMAT(' PARITY      = EVEN')
112   FORMAT(' PARITY      = ODD')
113   FORMAT(' PARITY      = SPACE')
114   FORMAT(' PARITY      = MARK')
115   FORMAT(' PARITY      = NONE')
116   FORMAT(' REMOTE TTY LINE USED IS ??')
117   FORMAT(' IBM FLAG    =   ON')
118   FORMAT(' IBM FLAG    =  OFF')
119   FORMAT(' IBM PROMPT  = ',I4)
120   FORMAT(' USL DIRECTORY = ',3A1)
      RETURN
      END
<<< tochar. >>>
      INTEGER FUNCTION TOCHAR(CH)
C
C     ****************************************************************
C
C              KERMIT for the MODCOMP MAXIV operating system
C
C        Compliments of:
C
C                         SETPOINT, Inc.
C                      10245 Brecksville Rd.
C                      Brecksville, Ohio 44141
C
C
C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
C      of this version hereby grant permission to copy this software
C      provided that it is not used for an explicitly commercial
C      purpose and that proper credit be given. SETPOINT, Inc. makes
C      no warranty whatsoever regarding the accuracy of this package
C      and will assume no liability resulting from it's use.
C
C     ****************************************************************
C
C     Abstract:  CONVERT INTEGER TO ASCII (ADD 32)
C
C     MODIFICATION HISTORY
C
C     BY            DATE     REASON            PROGRAMS AFFECTED
C
C     ****************************************************************
C
C     Author: BOB BORGESON          Version: A.0    Date: Oct-86
C
C     Calling Parameters:
C
C     R    CH          - NUMBER TO TRANSFORM
C
C     ****************************************************************
C
C     Messages generated by this module :  None
C
C     ****************************************************************
C
C     Subroutines called directly :  None
C
C     ****************************************************************
C
C     Files referenced :  None
C
C     ****************************************************************
C
C     Local variable definitions :  None
C
C     ****************************************************************
C
C     Commons referenced :  KERPAR local common
C
C     ****************************************************************
C
C     (*$END.DOCUMENT*)
C
C     ****************************************************************
C     *                                                              *
C     *         D I M E N S I O N   S T A T E M E N T S              *
C     *                                                              *
C     ****************************************************************
C
      IMPLICIT INTEGER (A-Z)
C
C     ****************************************************************
C     *                                                              *
C     *         T Y P E   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         C O M M O N   S T A T E M E N T S                    *
C     *                                                              *
C     ****************************************************************
C
      INCLUDE USL/KERPMC
C
C     ****************************************************************
C     *                                                              *
C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         D A T A   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C
C     Code starts here :
C
      TOCHAR = CH + BLANK
      RETURN
      END
<<< tputch. >>>
      SUBROUTINE TPUTCH (XCHAR,CH)
C
C     ****************************************************************
C
C              KERMIT for the MODCOMP MAXIV operating system
C
C        Compliments of:
C
C                         SETPOINT, Inc.
C                      10245 Brecksville Rd.
C                      Brecksville, Ohio 44141
C
C
C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
C      of this version hereby grant permission to copy this software
C      provided that it is not used for an explicitly commercial
C      purpose and that proper credit be given. SETPOINT, Inc. makes
C      no warranty whatsoever regarding the accuracy of this package
C      and will assume no liability resulting from it's use.
C
C     ****************************************************************
C
C     Abstract:  OUTPUT A CHAR.
C
C     MODIFICATION HISTORY
C
C     BY            DATE     REASON            PROGRAMS AFFECTED
C
C
C     ****************************************************************
C
C     Author: BOB BORGESON          Version: A.0    Date: Oct-86
C
C     Calling Parameters:
C
C     R    XCHAR   - CHARACTER TO OUTPUT (UNPACKED IN 1 WORD)
C     R    CH      - UFT # TO OUTPUT IT ON
C
C     ****************************************************************
C
C     Messages generated by this module :  None
C
C     ****************************************************************
C
C     Subroutines called directly :  WRITE4
C
C     ****************************************************************
C
C     Files referenced :  None
C
C     ****************************************************************
C
C     Local variable definitions :
C
C      IBUF  - SCRATCH TO OUTPUT CHARACTER WITH
C
C     ****************************************************************
C
C     Commons referenced :  KERPAR, UFTTBL
C
C     ****************************************************************
C
C     (*$END.DOCUMENT*)
C
C     ****************************************************************
C     *                                                              *
C     *         D I M E N S I O N   S T A T E M E N T S              *
C     *                                                              *
C     ****************************************************************
C
      IMPLICIT INTEGER (A-Z)
C
C     ****************************************************************
C     *                                                              *
C     *         T Y P E   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         C O M M O N   S T A T E M E N T S                    *
C     *                                                              *
C     ****************************************************************
C
      INCLUDE USL/KERPMC
      INCLUDE USL/UFTTBC
C
C     ****************************************************************
C     *                                                              *
C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         D A T A   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C
C     Code starts here :
C
C                                   !SHIFT BYTE LEFT BY 8 BITS
      IBUF=ISHFT(XCHAR,8)
C                                   !OUTPUT A SINGLE BYTE IN WAIT MODE
      CALL WRITE4(IUFT(1,CH),IBUF,1,.TRUE.)
      RETURN
      END
<<< uftini. >>>
      SUBROUTINE UFTINI
C
C     ****************************************************************
C
C              KERMIT for the MODCOMP MAXIV operating system
C
C        Compliments of:
C
C                         SETPOINT, Inc.
C                      10245 Brecksville Rd.
C                      Brecksville, Ohio 44141
C
C
C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
C      of this version hereby grant permission to copy this software
C      provided that it is not used for an explicitly commercial
C      purpose and that proper credit be given. SETPOINT, Inc. makes
C      no warranty whatsoever regarding the accuracy of this package
C      and will assume no liability resulting from it's use.
C
C     ****************************************************************
C
C     Abstract:  Initialize the UFTs required for the MAX IV Kermit
C                package.
C
C     MODIFICATION HISTORY
C
C     BY            DATE     REASON            PROGRAMS AFFECTED
C
C     ****************************************************************
C
C     Author:  Rick Burke           Version: A.0    Date: Aug-86
C
C     Calling Parameters:  None
C
C     ****************************************************************
C
C     Messages generated by this module :  None
C
C     ****************************************************************
C
C     Subroutines called directly :  BLDUFT, REWIND
C
C     ****************************************************************
C
C     Files referenced :  None
C
C     ****************************************************************
C
C     Local variable definitions :
C
C     DEV1         - Logical device to which KE2 is assigned
C     DEV2         - Logical device to which KE4 is assigned
C     HANOPT       - Handler options word from TASS4
C     LDEVST       - Logical device status returned from TASS4
C     LFNAM        - CAN code of base value of LFN for Kermit I/O
C     RECSIZ       - Record size returned by TASS4
C     SUCCES       - Success indicator of TASS4 calls
C
C     ****************************************************************
C
C     Commons referenced :  KER, KERPAR, and UFTTBL local commons
C
C     ****************************************************************
C
C     (*$END.DOCUMENT*)
C
C     ****************************************************************
C     *                                                              *
C     *         D I M E N S I O N   S T A T E M E N T S              *
C     *                                                              *
C     ****************************************************************
C
      IMPLICIT INTEGER (A-Z)
C
C     ****************************************************************
C     *                                                              *
C     *         T Y P E   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         C O M M O N   S T A T E M E N T S                    *
C     *                                                              *
C     ****************************************************************
C
      INCLUDE USL/KERCOM
      INCLUDE USL/KERPMC
      INCLUDE USL/UFTTBC
C
C     ****************************************************************
C     *                                                              *
C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         D A T A   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
      DATA LFNAM /3@KE0/
C
C     ****************************************************************
C
C     Code starts here :
C
      CALL BLDUFT (IUFT(1,1),0,LFNAM+1,4ZA000)
      CALL BLDUFT (IUFT(1,2),0,LFNAM+2,4ZE000)
      CALL BLDUFT (IUFT(1,3),0,LFNAM+3,4ZC280)
      CALL BLDUFT (IUFT(1,4),0,LFNAM+4,4ZD380,0,0,0,4Z8000,0,BLIN(1,1),
     >             132)
      CALL BLDUFT (IUFT(1,5),0,LFNAM+5,4ZA000)
      CALL BLDUFT (IUFT(1,7),0,LFNAM+7,4ZA000)
      CALL BLDUFT (IUFT(1,8),0,LFNAM+8,4ZA000)
      CALL BLDUFT (IUFT(1,9),0,LFNAM+9,4ZA000)
      CALL BLDUFT (IUFT(1,10),0,LFNAM+4,4ZD380,0,0,0,4Z8000,0,BLIN(1,2),
     >             132)
C
C                 NOW REWIND THE DISK FILES WE WILL ACCESS
C
      CALL REW4 (IUFT(1,5))
      CALL REW4 (IUFT(1,8))
C
      CALL WEOF4 (IUFT(1,8))
C
C----->  If the terminal I/O and Kermit I/O ports are pointing
C----->  at the I/O channel then set HOSTON = YES and defer
C----->  issuing a read to KE4 until either a SEND or
C----->  RECEIVE are issued.
C
      CALL TASS4 (IUFT(1,2),SUCCES,LDEVST,RECSIZ,DEV1,HANOPT)
      IF (SUCCES .NE. 1) CALL EXIT
      CALL TASS4 (IUFT(1,4),SUCCES,LDEVST,RECSIZ,DEV2,HANOPT)
      IF (SUCCES .NE. 1) CALL EXIT
C
C----->  Zero out the buffers we will use for Kermit data.
C
      DO 10 I = 1,132
      BLIN(I,1) = 0
      BLIN(I,2) = 0
   10 CONTINUE
      IF (DEV1 .NE. DEV2) GO TO 20
C
C----->  Kermit has been activated from a remote device, so set
C----->  the HOSTON flag and don't queue an initial read.
C
      HOSTON = YES
      CHRCHN = 0
      RETURN
   20 CONTINUE
C
C----->  Kermit has been activated by a local terminal, so issue
C----->  the initial read, in anticipation of incoming data.
C
      HOSTON = NO
      CURCHN = 1
      CALL READ4 (IUFT(1,4),BLIN(1,CURCHN),132,.FALSE.)
      RETURN
      END
<<< ufttbc. >>>
      COMMON /UFTTBL/ IUFT(10,10) , BLIN(132,2)  , CURCHN
<<< unchar. >>>
      INTEGER FUNCTION UNCHAR (CH)
C
C     ****************************************************************
C
C              KERMIT for the MODCOMP MAXIV operating system
C
C        Compliments of:
C
C                         SETPOINT, Inc.
C                      10245 Brecksville Rd.
C                      Brecksville, Ohio 44141
C
C
C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
C      of this version hereby grant permission to copy this software
C      provided that it is not used for an explicitly commercial
C      purpose and that proper credit be given. SETPOINT, Inc. makes
C      no warranty whatsoever regarding the accuracy of this package
C      and will assume no liability resulting from it's use.
C
C     ****************************************************************
C
C     Abstract: TRANSFORMS ASCII PRINTABLE CHARACTER BACK TO A
C               BINARY INTEGER (0 - 94)
C
C
C     MODIFICATION HISTORY
C
C     BY            DATE     REASON            PROGRAMS AFFECTED
C
C
C     ****************************************************************
C
C     Author: BOB BORGESON          Version: A.0    Date: Oct-86
C
C     Calling Parameters:
C
C     R    CH    - THE CHARACTER THAT GETS CONVERTED
C
C     ****************************************************************
C
C     Messages generated by this module :  None
C
C     ****************************************************************
C
C     Subroutines called directly :  None
C
C     ****************************************************************
C
C     Files referenced :  None
C
C
C     ****************************************************************
C
C     Local variable definitions :  None
C
C     ****************************************************************
C
C     Commons referenced :  KERPAR local common
C
C     ****************************************************************
C
C     (*$END.DOCUMENT*)
C
C     ****************************************************************
C     *                                                              *
C     *         D I M E N S I O N   S T A T E M E N T S              *
C     *                                                              *
C     ****************************************************************
C
      IMPLICIT INTEGER (A-Z)
C
C     ****************************************************************
C     *                                                              *
C     *         T Y P E   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         C O M M O N   S T A T E M E N T S                    *
C     *                                                              *
C     ****************************************************************
C
      INCLUDE USL/KERPMC
C
C     ****************************************************************
C     *                                                              *
C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         D A T A   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C
C     Code starts here :
C
      UNCHAR = CH - BLANK
      RETURN
      END
<<< upper. >>>
      SUBROUTINE UPPER (ALIN,BLIN)
C
C     ****************************************************************
C
C              KERMIT for the MODCOMP MAXIV operating system
C
C        Compliments of:
C
C                         SETPOINT, Inc.
C                      10245 Brecksville Rd.
C                      Brecksville, Ohio 44141
C
C
C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
C      of this version hereby grant permission to copy this software
C      provided that it is not used for an explicitly commercial
C      purpose and that proper credit be given. SETPOINT, Inc. makes
C      no warranty whatsoever regarding the accuracy of this package
C      and will assume no liability resulting from it's use.
C
C     ****************************************************************
C
C     Abstract:  CONVERT LOWER (ALIN) TO UPPER CASE (BLIN)
C
C     MODIFICATION HISTORY
C
C     BY            DATE     REASON            PROGRAMS AFFECTED
C
C
C     ****************************************************************
C
C     Author: BOB BORGESON          Version: A.0    Date: Oct-86
C
C     Calling Parameters:
C
C     R    ALIN          LOWER CASE CHARACTER
C     W    BLIN          UPPER CASE CHARACTER
C
C     ****************************************************************
C
C     Messages generated by this module :  None
C
C     ****************************************************************
C
C     Subroutines called directly :  None
C
C     ****************************************************************
C
C     Files referenced :  None
C
C     ****************************************************************
C
C     Local variable definitions :
C
C       A1   INDEX TO CHARACTER BEING CONVERTED
C
C     ****************************************************************
C
C     Commons referenced :  KERPAR local common
C
C     ****************************************************************
C
C     (*$END.DOCUMENT*)
C
C     ****************************************************************
C     *                                                              *
C     *         D I M E N S I O N   S T A T E M E N T S              *
C     *                                                              *
C     ****************************************************************
C
      IMPLICIT INTEGER (A-Z)
C
      INTEGER*2   ALIN(1),     BLIN(1)
C
C     ****************************************************************
C     *                                                              *
C     *         T Y P E   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         C O M M O N   S T A T E M E N T S                    *
C     *                                                              *
C     ****************************************************************
C
      INCLUDE USL/KERPMC
C
C     ****************************************************************
C     *                                                              *
C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C     *                                                              *
C     *         D A T A   S T A T E M E N T S                        *
C     *                                                              *
C     ****************************************************************
C
C
C     ****************************************************************
C
C     Code starts here :
C
      A1 = 1
  100 CONTINUE
      BLIN(A1) = ALIN(A1)
      IF (BLIN(A1) .EQ. EOS) GO TO 200
      IF (BLIN(A1) .GT.  96 .AND.
     >    BLIN(A1) .LT. 123      ) BLIN(A1) = BLIN(A1) - 32
      A1 = A1 + 1
      GO TO 100
  200 CONTINUE
      RETURN
      END
