<<< 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 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 - 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